C++*********************************************************************
C
C  GETDOCDAT.F        CREATED MAR 98 ArDean Leith
C                     LUNDOCREDALL PARAMETERS     DEC   00 ARDEAN LEITH
C                     LUNDOCREDSEQ RETURNS MAXY   APR 2003 ARDEAN LEITH
C                     INCORE OPENDOC              JUL 2003 ARDEAN LEITH
C                     WANTSEQ BUG                 SEP 2003 ARDEAN LEITH
C
C **********************************************************************
C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM.   AUTHOR: J.FRANK  *
C=* Copyright (C) 1985-2005  Health Research Inc.                      *
C=*                                                                    *
C=* HEALTH RESEARCH INCORPORATED (HRI),                                *   
C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455.                   *
C=*                                                                    *
C=* Email:  spider@wadsworth.org                                       *
C=*                                                                    *
C=* This program is free software; you can redistribute it and/or      *
C=* modify it under the terms of the GNU General Public License as     *
C=* published by the Free Software Foundation; either version 2 of the *
C=* License, or (at your option) any later version.                    *
C=*                                                                    *
C=* This program is distributed in the hope that it will be useful,    *
C=* but WITHOUT ANY WARRANTY; without even the implied warranty of     *
C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU  *
C=* General Public License for more details.                           *
C=*                                                                    *
C=* You should have received a copy of the GNU General Public License  *
C=* along with this program; if not, write to the                      *
C=* Free Software Foundation, Inc.,                                    *
C=* 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.      *
C=*                                                                    *
C **********************************************************************
C
C   GETDOCDAT(PROMPT,ASKNAME,DOCNAM,LUNDOC,GETSIZE,MAXXT,MAXYT,
C             RPOINTER,IRTFLG)
C
C   PARAMETERS:
C       PROMPT      PROMPT FOR DOCFILE NAME                       (SENT)
C       ASKNAME     LOGICAL VARIABLE TO ASK FOR DOCNAM            (SENT)
C       DOCNAM      DOC. FILE NAME                           (SENT/RET.)
C       LUNDOC      I/0 UNIT                                      (SENT)
C                   (< 0 IS FLAG FOR GETTING SEQUENTIAL DATA)
C       GETSIZE     LOGICAL VARIABLE TO ASK FOR ARRAY SIZE        (SENT)
C       MAXXT       COL. IN ARRAY RPOINTER                   (SENT/RET.)
C       MAXYT       ROWS IN ARRAY RPOINTER                   (SENT/RET.)
C                   IF GETSIZE IS TRUE, MAXXT & MAXYT SHOULD BE 
C                   SET TO ZERO ON ENTRY, OTHER-WISE THEY INDICATE
C                   MAXIMUM VALUES FOR RPOINTER ARRAY CREATION!!
C       RPOINTER    POINTER TO ARRAY (ALLOCATED HERE)             (RET.)
C       IRTFLG      ERROR FLAG (0 IS NORMAL)                      (RET.)
C
C  NOTES:   THIS PROGRAM ALWAYS ALLOCATES MEMORY OF ARRAY RPOINTER
C           EACH ROW IN RPOINTER HAS THE NUMBER OF THE REGISTERS IN THAT
C           KEY IN THE FIRST COLUMN (ZERO IF KEY NOT PRESENT) FOLLOWED 
C           BY THE REGISTER CONTENTS. (THIS MAY BE DIFFERENT IF GETTING
C           SEQUENTIAL DATA??? al)
C
C23456789 123456789 123456789 123456789 123456789 123456789 123456789 12
C--*********************************************************************

#ifdef NEVER 
        INTERFACE ! -------------UPDATE F90ALLOC.INC FOR PARAMETERS!!
        SUBROUTINE GETDOCDAT(PROMPT,ASKNAME,DOCNAM,LUNDOC,GETSIZE,
     &                       MAXXT, MAXYT,RPOINTER,IRTFLG)
        CHARACTER *(*), INTENT(IN) ::                 PROMPT
        LOGICAL, INTENT(IN) ::                        ASKNAME
        CHARACTER *(*), INTENT(INOUT) ::              DOCNAM
        INTEGER, INTENT(IN) ::                        LUNDOC
        LOGICAL, INTENT(IN) ::                        GETSIZE
        INTEGER, INTENT(INOUT) ::                     MAXXT
        INTEGER, INTENT(INOUT) ::                     MAXYT
        REAL, DIMENSION(:), POINTER  ::               RPOINTER
        INTEGER, INTENT(OUT) ::                       IRTFLG
        END SUBROUTINE GETDOCDAT
        END INTERFACE !--------------------
#endif

        SUBROUTINE GETDOCDAT(PROMPT,ASKNAME,DOCNAM,LUNDOC,GETSIZE,
     &                       MAXXT, MAXYT,RPOINTER,IRTFLG)

C       F90 SPECIFIC CODE
C       UPDATE F90ALLOC.INC FOR PARAMETERS!!

        CHARACTER *(*), INTENT(IN) ::                 PROMPT
        LOGICAL, INTENT(IN) ::                        ASKNAME
        CHARACTER *(*), INTENT(INOUT) ::              DOCNAM
        INTEGER, INTENT(IN) ::                        LUNDOC
        LOGICAL, INTENT(IN) ::                        GETSIZE
        INTEGER, INTENT(INOUT) ::                     MAXXT
        INTEGER, INTENT(INOUT) ::                     MAXYT
        REAL, DIMENSION(:,:), POINTER   ::            RPOINTER
        INTEGER, INTENT(OUT) ::                       IRTFLG
        LOGICAL ::                                    WARNIT
        LOGICAL ::                                    WANTSEQ

        PARAMETER         (NMAX = 10)
        DIMENSION         PLIST(NMAX)


        INCLUDE 'CMBLOCK.INC' 

        IRTFLG  = 1
C       FLAG TO RECOVER MULTIPLE VALUES HAVEING SAME KEY ('DOC RE')
        WANTSEQ = (LUNDOC .LT. 0)
        LUNDOCFT = ABS(LUNDOC)

        IF (ASKNAME) THEN
C          INPUT DOCUMENT FILENAME, NF == 9 ALLOWS DIFFERENT EXTENSION
           NF = 9         
           CALL FILERD(DOCNAM,NLETD,DATEXC,PROMPT,NF)
           IF (NF .NE. 0) RETURN
        ENDIF

        CALL OPENDOC(DOCNAM,.FALSE.,NLET,LUNDOCFT,LUNDOCF,.FALSE.,' ',
     &             .TRUE.,.FALSE.,.TRUE.,NEWFILE,IRTFLG)
        IF (IRTFLG .NE. 0) RETURN

C       ECHO FIRST HEADER FROM FILE
        CALL LUNDOCSAYHDR(LUNDOCF,NOUT,IRTFLG)

        IF (GETSIZE) THEN
C          FIND MAXY & MAXY BY READING DOC FILE
           CALL LUNDOCINFO(LUNDOCF,MAXY,MAXX,KEYUSED,.TRUE.,IRTFLG)
           IF (IRTFLG .NE. 0) THEN
              CLOSE(LUNDOCFT)
              RETURN
           ENDIF
           IF (LUNDOCF .GT. 0) REWIND(LUNDOCF)

           IF (WANTSEQ) THEN
C             WANT JUST DATA ARRAY
              IWANTY = MAXY
              MAXY   = KEYUSED
           ELSE
C             WANT KEYED ARRAY
              MAXX = MAXX + 1
           ENDIF
           IF (MAXXT .GT. 0) MAXX = MIN(MAXX,MAXXT)
           IF (MAXYT .GT. 0) MAXY = MIN(MAXY,MAXYT)
        ELSE
C          USE MAXX & MAXY SENT BY CALLING PROGRAM
           MAXX = MAXXT
           MAXY = MAXYT
        ENDIF

        ALLOCATE(RPOINTER(MAXX,MAXY),STAT=IRTFLG)
        IF (IRTFLG.NE.0) THEN  
           CALL  ERRT(46,'GETDOCDAT, RPOINTER',MAXX*MAXY)
           RETURN
        ENDIF
 
C       RETRIEVE DATA
        IF (WANTSEQ) THEN
C          TO RECOVER MULTIPLE VALUES HAVING SAME KEY
           CALL LUNDOCREDSEQ(LUNDOCF,RPOINTER,MAXX,MAXY,IWANTY,MAXYT,
     &                       IRTFLG)
        ELSE
           CALL LUNDOCREDALL(LUNDOCF,RPOINTER,MAXX,MAXY,.TRUE.,
     &                       NGOT,IRTFLG)
           MAXYT = MAXY
        ENDIF

        MAXXT  = MAXX
        CLOSE(LUNDOCFT)
        IF (IRTFLG .NE. 0) RETURN

        IRTFLG = 0

        RETURN
        END