dmrclh.f

	SUBROUTINE DM_RCLH  ( iflno, ipos, iheadr, iret )
C************************************************************************
C* DM_RCLH								*
C*									*
C* This subroutine reads a column header from a DM file.		*
C*									*
C* DM_RCLH  ( IFLNO, IPOS, IHEADR, IRET )				*
C*									*
C* Input parameters:							*
C*	IFLNO		INTEGER		File number			*
C*	IPOS		INTEGER		Location			*
C*									*
C* Output parameters:							*
C*	IHEADR (*)	INTEGER		Header array			*
C*	IRET		INTEGER		Return code			*
C*					  0 = normal return		*
C*					 -4 = file is not open		*
C*					 -9 = invalid column		*
C*					-11 = undefined header		*
C**									*
C* Log:									*
C* M. desJardins/GSFC	4/87						*
C* m. gamazaychikov/CWS 04/11   Add code for A2DB connectivity          *
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'dmcmn.cmn'
        INCLUDE         'dbcmn.cmn'  
C
	INTEGER		iheadr (*)
C
        INTEGER         istid(2), intdtf (3)
C------------------------------------------------------------------------
C*      For A2DB requests - set the needed information.
C
        IF (  dbread ) THEN
           IF ( dbdatasrc .eq. 'grid' ) THEN
C
C*            For grid data - set the time.
C
              CALL ST_LSTR  ( dbtime, ldbtime, ier )
              IF ( ldbtime .gt. 0 ) THEN
                 CALL TG_CTOI  ( dbtime, intdtf, ier )
                 CALL TG_ITOF  ( intdtf, iheadr, ier )
              ELSE 
                 iret = -9
                 RETURN
              END IF
           ELSE 
C
C*            For point data - set the station id.
C
              CALL ST_LSTR (dbstid, lstr, ier)
              IF ( lstr .eq. 4 .and. dbstid(1:1) .eq. 'K' ) THEN 
                 ist=2
              ELSE
                 ist = 1
              END IF
              IF ( dbdatasrc .eq. 'metar'  ) THEN
                CALL ST_STOI (dbstid(ist:lstr), 8, nv, istid, ier )
                iheadr(1) = istid(1)
                iheadr(2) = IMISSD
              ELSE IF ( dbdatasrc .eq. 'bufrua' ) THEN 
                iheadr(1) = IMISSD
                CALL ST_NUMB (dbstid(ist:lstr), istid2, ier )
                iheadr(2) = istid2
              END IF
              iheadr(3) = dbstlt
              iheadr(4) = dbstln
              iheadr(5) = dbstel
              iheadr(8) = IMISSD
           END IF 
           iret = 0
           RETURN
        END IF
C
C*	Check that the file number is valid.
C
	CALL DM_CHKF ( iflno, iret )
	IF  ( iret .ne. 0 ) RETURN
C
C*	Check for valid position.
C
	IF ( (ipos .le. 0) .or. (ipos .gt. kcol (iflno))) THEN
	    iret = -9
	    DO  i = 1, kckeys ( iflno )
		iheadr (i) = IMISSD
	    END DO
	  ELSE 
C
C*	    Check that this header is defined.
C
	    jloc = ipos + krow ( iflno )
	    IF  ( kheadr ( 0, jloc, iflno ) .ne. IMISSD )  THEN
C
C*		Retrieve row header.
C
		DO  i = 1, kckeys (iflno)
		    iheadr (i) = kheadr ( i, jloc, iflno )
		END DO
C
C*		Set error return.
C
	      ELSE
		iret = -11
		DO  i = 1, kckeys ( iflno )
		    iheadr (i) = IMISSD
		END DO
	    END IF
	END IF
C*
	RETURN
	END