      SUBROUTINE REALCOEF(UNITNM,GRPNAME,SGRPNAME,COEFNAME,
     +                    DD0,DD1,DD2,DD3,RARRAY,CFLAG,STATUS)

C***********************************************************************
C
C  VERSION 1.0   DATE- APRIL 97  PROGRAMMER- DORLISA HOMMEL (HSTX)
C  VERSION 1.1   DATE- 10/16/97  PROGRAMMER- LEAH WILSON (HSTX)
C
C  FUNCTION-   THIS PROGRAM RETRIEVES THE REQUESTED REAL COEFFICIENT VAL
C  VERSION 1.1-  USE RARRAY AS A 1-DIMENSIONAL ARRAY TO ELIMINATE
C                RUN-TIME WARNINGS WHEN COMPILED USING ARRAY BOUNDS
C                CHECKING.  ALSO COMPARE TOTBYTES TO RECLNGTH RATHER
C                THAN TO RECLNGTH/8 WHEN DETERMINING IF COEFFICIENT
C                WRAPS AROUND A RECORD IN ORDER TO CORRECTLY COMPARE
C                BYTES TO BYTES RATHER THAN BYTES TO WORDS.   MODIFY
C                WRAP-AROUND LOGIC.  REPLACE ":" WITH DO LOOPS.  CHANGE
C                DIMENSION OF RARRAY FROM 5500 TO CDBINFO:ARRAYSZ AND
C                PRINT ERROR MESSAGE IF COEFFICIENT EXCEEDS THIS DIM.
C
C  CALLING SEQUENCE PARAMETERS
C  VARIABLE  TYPE  I/O  DESCRIPTION
C  --------  ----  ---  ------------------------------------------------
C  UNITNM    INT    I   CDB FILE UNIT NUMBER, = 16.
C  GRPNAME   CHAR   I   GROUP NAME REQUESTED.
C  SGRPNAME  CHAR   I   SUBGROUP NAME REQUESTED.
C  COEFNAME  CHAR   I   COEFFICIENT NAME REQUESTED.
C  DD0       INT    I   FIRST DIMENSION OF THE REQUESTED COEFFICIENT.
C  DD1       INT    I   SECOND DIMENSION OF THE REQUESTED COEFFICIENT.
C  DD2       INT    I   THIRD DIMENSION OF THE REQUESTED COEFFICIENT.
C  DD3       INT    I   FOURTH DIMENSION OF THE REQUESTED COEFFICIENT.
C  CFLAG     CHAR   I   STRING CONTAINING 'GET' OR 'PUT' FOR RETRIEVING
C                       UPDATING COEFFICIENT VALUES.
C  ARRAYDIM  INT    I   ARRAY SIZE OF THE COEFFCIENT ARRAY.
C  RARRAY    REAL  I/O  ARRAY OF REAL COEFFICIENT VALUES TO BE INPUT/RET
C  STATUS    INT    O   ERROR STATUS
C
C  LOCAL PARAMETERS
C
C  INDEX -      ARRAY INDEX POINTING TO THE COEFFICIENT DATA SPECIFIED B
C  OFFSET -     COEFFICIENT OFFSET FROM THE BEGINNING OF THE COEFFICIENT
C  REC -        RECORD NUMBER IN CDB FILE WHERE COEFFICIENT DATA IS STOR
C  REC_OFFSET - OFFSET WITHIN RECORD TO BEGINNING OF COEFFICIENT DATA.
C  DIM1-3 -     DIMENSIONS OF COEFFICIENT VALUES.
C  TYPE -       DATA TYPE, 1=REAL, 2=INTEGER, OR 3=CHARACTER.
C
C  EXIT STATES - A RETURN TO THE ERROR LABEL IN THE CALLING ROUTINE IF:
C
C                1) THE DIMENSIONS PASSED IN ('D0' - 'D3') DO NOT MATCH
C                   THOSE STORED FOR THE COEFFICIENT IN THE CDB.
C                2) THE DATA TYPE OF THE COEFFICIENT IS NOT REAL.
C
C***********************************************************************

      INCLUDE 'CDBINFO'

C DECLARATIONS

      INTEGER     I, UNITNM, LENGTH, STATUS, FLAG, ONCE, NUMVALS
      INTEGER     DD0, DD1, DD2, DD3
      INTEGER     D0, D1, D2, D3, INDEX, TOTBYTES,ARRAYDIM, I12, I34
      INTEGER     OFFSET1, OFFSET2, OFFSET3, RECORD1, MORE 
C REPLACED REAL BY REAL*8
C     REAL        RARRAY(ARRAYSZ)
C     REAL        RBUFFER(RECLNGTH/8)
      REAL*8        RARRAY(ARRAYSZ)
      REAL*8        RBUFFER(RECLNGTH/8)
      CHARACTER*3 CFLAG, CDBUNIT
      CHARACTER*4 CHDIM0, CHDIM1, CHDIM2, CHDIM3, CHREC
      CHARACTER*8 GRP,SGRP,COF,GRPNAME, SGRPNAME, COEFNAME
      CHARACTER*100 MESSAGE

C INITIALIZATIONS

      STATUS = 0
      I = 0
      FLAG = 0
      INDEX = 0
      MORE = 1
      CDBUNIT = 'NO '
      NUMCDB = 1
      ONCE = 0
      D0 = DD0
      D1 = DD1
      D2 = DD2
      D3 = DD3

C DETERMINE WHICH CDB IS BEING ACCESSED.

      DO WHILE (CDBUNIT .EQ. 'NO ')
        IF (COFCOUNT(NUMCDB) .EQ. UNITNM) THEN
          CDBINDX = NUMCDB
          CDBUNIT = 'YES'
        END IF
        NUMCDB = NUMCDB + 1
      END DO

C FIND THE COEFFICIENT INDEX FOR THE COEFFICIENT SPECIFIED.

      DO WHILE (FLAG .EQ. 0)
         I = I + 1
         IF (GROUP(I,CDBINDX) .EQ. 'XXXXXXXX') THEN
            FLAG = 1
         ELSE
            GRP = GROUP(I,CDBINDX)
            SGRP = SUBGROUP(I,CDBINDX)
            COF = COEFF(I,CDBINDX)
            IF ((GRP .EQ. GRPNAME) .AND. (SGRP .EQ.
     +         SGRPNAME) .AND. (COF .EQ. COEFNAME)) THEN
               INDEX = I
               FLAG = 1
            END IF
         END IF
      END DO

C  CHECK TO MAKE SURE THAT THE COEFFICIENT WAS FOUND.

      IF (INDEX .EQ. 0) GOTO 800

C  CHECK TO MAKE SURE THAT THE DATA TYPE IS REAL.

      IF (DTYPE(INDEX,CDBINDX) .NE. 1) GOTO 810

C  CHECK TO MAKE SURE THAT THE INPUT DIMENSIONS ARE 
C  EQUAL TO THOSE CONTAINED IN THE CDB DATA FILE FOR 
C  THE COEFFICIENT SPECIFIED.
 
      IF (DD0 .EQ. 0) D0 = 1
      IF (DD1 .EQ. 0) D1 = 1
      IF (DD2 .EQ. 0) D2 = 1
      IF (DD3 .EQ. 0) D3 = 1
      IF (DIM0(INDEX,CDBINDX) .EQ. 0) DIM0(INDEX,CDBINDX) = 1
      IF (DIM1(INDEX,CDBINDX) .EQ. 0) DIM1(INDEX,CDBINDX) = 1
      IF (DIM2(INDEX,CDBINDX) .EQ. 0) DIM2(INDEX,CDBINDX) = 1
      IF (DIM3(INDEX,CDBINDX) .EQ. 0) DIM3(INDEX,CDBINDX) = 1

      IF (DIM0(INDEX,CDBINDX) .NE. D0 .OR. DIM1(INDEX,CDBINDX) .NE.
     +    D1 .OR. DIM2(INDEX,CDBINDX) .NE. D2 .OR. DIM3(INDEX,CDBINDX)
     +    .NE. D3) then
       WRITE(6,*) 'DIMENSIONS ARE NOT EQUAL FOR',COEFNAME
       WRITE(6,*) DIM0(INDEX,CDBINDX),DIM1(INDEX,CDBINDX),
     > DIM2(INDEX,CDBINDX),DIM3(INDEX,CDBINDX)
       WRITE(6,*) D0,D1,D2,D3
       GOTO 820
      ENDIF



C SET VALUES FOR ACCESSING THE CDB FILE. 

      ARRAYDIM = D0*D1*D2*D3
      TOTBYTES = (D0*D1*D2*D3*8) + OFFSET(INDEX,CDBINDX) 
      OFFSET1 = 1
      OFFSET3 = (OFFSET(INDEX,CDBINDX)+8)/8
      RECORD1 = RECORD(INDEX,CDBINDX) 
      NUMVALS = (RECLNGTH+8)/8 - OFFSET3

      DO WHILE (MORE .EQ. 1)
         IF (TOTBYTES .GT. RECLNGTH) THEN
            IF (CFLAG .EQ. 'GET') THEN
               READ(UNIT=UNITNM,REC=RECORD1,IOSTAT=IOERR) RBUFFER
               IF (IOERR .NE. 0) GOTO 830
               OFFSET2 = OFFSET1 + NUMVALS - 1
               IF(OFFSET2.GT.ARRAYSZ) GO TO 850
               I34 = OFFSET3
               DO I12=OFFSET1,OFFSET2
                  RARRAY(I12) = RBUFFER(I34)
                  I34 = I34 + 1
               END DO
            ELSE IF (CFLAG .EQ. 'PUT') THEN
               IF (ONCE .EQ. 0) THEN
                  READ(UNIT=UNITNM,REC=RECORD1,IOSTAT=IOERR) RBUFFER
                  IF (IOERR .NE. 0) GOTO 830
                  ONCE = 1
               END IF
               OFFSET2 = OFFSET1 + NUMVALS - 1
               IF(OFFSET2.GT.ARRAYSZ) GO TO 850
               I34 = OFFSET3
               DO I12=OFFSET1,OFFSET2
                  RBUFFER(I34) = RARRAY(I12)
                  I34 = I34 + 1
               END DO
               WRITE(UNIT=UNITNM,REC=RECORD1,IOSTAT=IOERR) RBUFFER
               IF (IOERR .NE. 0) GOTO 840
            END IF
            OFFSET1 = OFFSET1 + NUMVALS
            TOTBYTES = TOTBYTES - (NUMVALS*8) - OFFSET(INDEX,CDBINDX)
            IF(TOTBYTES.LE.0) TOTBYTES=TOTBYTES+OFFSET(INDEX,CDBINDX)
            NUMVALS = TOTBYTES/8
            IF(NUMVALS.GT.RECLNGTH/8) NUMVALS=RECLNGTH/8
            ARRAYDIM = NUMVALS
            RECORD1 = RECORD1 +1
            OFFSET3 = 1
         ELSE
            IF (CFLAG .EQ. 'GET') THEN
               READ(UNIT=UNITNM,REC=RECORD1,IOSTAT=IOERR) RBUFFER
               IF (IOERR .NE. 0) GOTO 830
               OFFSET2 = OFFSET1 + ARRAYDIM - 1
               IF(OFFSET2.GT.ARRAYSZ) GO TO 850
               I34 = OFFSET3
               DO I12=OFFSET1,OFFSET2
                  RARRAY(I12) = RBUFFER(I34)
                  I34 = I34 + 1
               END DO
            ELSE IF (CFLAG .EQ. 'PUT') THEN
               READ(UNIT=UNITNM,REC=RECORD1,IOSTAT=IOERR) RBUFFER
               IF (IOERR .NE. 0) GOTO 830
               OFFSET2 = OFFSET1 + ARRAYDIM - 1
               IF(OFFSET2.GT.ARRAYSZ) GO TO 850
               I34 = OFFSET3
               DO I12=OFFSET1,OFFSET2
                  RBUFFER(I34) = RARRAY(I12)
                  I34 = I34 + 1
               END DO
               WRITE(UNIT=UNITNM,REC=RECORD1,IOSTAT=IOERR) RBUFFER
               IF (IOERR .NE. 0) GOTO 840
            END IF
            MORE = 0
         END IF
      END DO

      RETURN

 800  CONTINUE
      MESSAGE = 'CFLAG = '
      MESSAGE(9:12) = CFLAG
      CALL KIDS (KDUNIT,PROGNAME,2,MESSAGE,0)

      MESSAGE = '*** ERROR *** Could Not Find Coefficient:
     +        /        /          .'
      MESSAGE(56:63) = GRPNAME
      MESSAGE(65:72) = SGRPNAME
      MESSAGE(74:81) = COEFNAME
      CALL KIDS (KDUNIT,PROGNAME,0,MESSAGE,0)
      STATUS = 1
      RETURN

 810  CONTINUE
      MESSAGE = 'CFLAG = '
      MESSAGE(9:12) = CFLAG
      CALL KIDS (KDUNIT,PROGNAME,2,MESSAGE,0)

      MESSAGE = '*** ERROR *** Data Type for coefficient
     +        /        /         .'
      MESSAGE(45:52) = GRPNAME
      MESSAGE(54:61) = SGRPNAME
      MESSAGE(63:70) = COEFNAME
      CALL KIDS (KDUNIT,PROGNAME,0,MESSAGE,0)
      STATUS = 1
      RETURN

 820  CONTINUE
      MESSAGE = 'CFLAG = '
      MESSAGE(9:12) = CFLAG
      CALL KIDS (KDUNIT,PROGNAME,2,MESSAGE,0)

      WRITE(CHDIM0,'(I4)') D0
      WRITE(CHDIM1,'(I4)') D1
      WRITE(CHDIM2,'(I4)') D2
      WRITE(CHDIM3,'(I4)') D3
      MESSAGE(1:46)='*** ERROR *** Dimensions (    ,    ,    ,    )'
      MESSAGE(27:30) = CHDIM0
      MESSAGE(32:35) = CHDIM1
      MESSAGE(37:40) = CHDIM2
      MESSAGE(42:45) = CHDIM3
      MESSAGE(47:100)=' incorrect for         /        /        .'
      MESSAGE(62:69) = GRPNAME
      MESSAGE(71:78) = SGRPNAME
      MESSAGE(80:87) = COEFNAME
      CALL KIDS (KDUNIT,PROGNAME,0,MESSAGE,0)
      STATUS = 1
      RETURN

 830  CONTINUE
      MESSAGE = 'CFLAG = '
      MESSAGE(9:12) = CFLAG
      CALL KIDS (KDUNIT,PROGNAME,2,MESSAGE,0)

      WRITE(CHREC,'(I4)') RECORD1
      MESSAGE = '*** ERROR *** Writing CDB record      for
     +coefficient =         /        /         .'
      MESSAGE(64:71) = GRPNAME
      MESSAGE(73:80) = SGRPNAME
      MESSAGE(82:89) = COEFNAME
      MESSAGE(36:39) = CHREC
      CALL KIDS (KDUNIT,PROGNAME,0,MESSAGE,0)
      STATUS = 1
      RETURN

 840  CONTINUE
      MESSAGE = 'CFLAG = '
      MESSAGE(9:12) = CFLAG
      CALL KIDS (KDUNIT,PROGNAME,2,MESSAGE,0)

      WRITE(CHREC,'(I4)') RECORD1
      MESSAGE = '*** ERROR *** Writing CDB record      for
     +coefficient =         /        /       .'
      MESSAGE(64:71) = GRPNAME
      MESSAGE(73:80) = SGRPNAME
      MESSAGE(82:89) = COEFNAME
      MESSAGE(36:39) = CHREC
      CALL KIDS (KDUNIT,PROGNAME,0,MESSAGE,0)
      STATUS = 1
      RETURN

  850 MESSAGE(1:50)='*** CDB Error ***         /        /         excee'
      MESSAGE(19:26) = GRPNAME
      MESSAGE(28:35) = SGRPNAME
      MESSAGE(37:44) = COEFNAME
      MESSAGE(51:100)='ds max size of      (i.e. too big for CDB)     '
      WRITE(CHREC,'(I4)') ARRAYSZ
      MESSAGE(66:69) = CHREC
      CALL KIDS (KDUNIT,PROGNAME,0,MESSAGE,0)
      RETURN
 
      END

