dmpart.f

	SUBROUTINE DM_PART  ( iflno, prtnam, lenhdr, ityprt, nparms,
     +			      prmnam, iscale, ioffst, nbits, iret )
C************************************************************************
C* DM_PART								*
C*									*
C* This subroutine returns information for a specific part.		*
C*									*
C* DM_PART  ( IFLNO, PRTNAM, LENHDR, ITYPRT, NPARMS, PRMNAM, ISCALE,	*
C*            IOFFST, NBITS, IRET )					*
C*									*
C* Input parameters:							*
C*	IFLNO		INTEGER		File number			*
C*	PRTNAM		CHAR*4		Part name			*
C*									*
C* Output parameters:							*
C*	LENHDR		INTEGER		Length of data header		*
C*	ITYPRT		INTEGER		Data type			*
C*	NPARMS		INTEGER		Number of parameters		*
C*	PRMNAM (NPARMS)	CHAR*4		Parameter names			*
C*	ISCALE (NPARMS)	INTEGER		Scaling term			*
C*	IOFFST (NPARMS)	INTEGER		Offset				*
C*	NBITS  (NPARMS)	INTEGER		Number of bits			*
C*	IRET		INTEGER		Return code			*
C*					  0 = normal return		*
C*					 -4 = file not open		*
C*					-10 = invalid part name		*
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
	CHARACTER*(*)	prtnam, prmnam (*)
	INTEGER		iscale (*), ioffst (*), nbits (*)
C
        CHARACTER*4     mandpp (6), sigtpp (3), sigwpp (3), troppp (5),
     +                  maxwpp (3)
        DATA            mandpp  / 'PRES', 'TEMP', 'DWPT',
     +                            'DRCT', 'SPED', 'HGHT' /
        DATA            sigtpp  / 'PRES', 'TEMP', 'DWPT' /
        DATA            sigwpp  / 'HGHT', 'DRCT', 'SPED' /
        DATA            troppp  / 'PRES', 'TEMP', 'DWPT',
     +                            'DRCT', 'SPED' /
        DATA            maxwpp  / 'PRES', 'DRCT', 'SPED' /
C-----------------------------------------------------------------------
C*      For A2DB requests - set needed common block info.
C
        IF ( dbread ) THEN
C
C*         Get parameter list from packing file 
C
           IF ( INDEX(dbdatasrc,'metar') .gt. 0 .or.
     +          INDEX(dbdatasrc,'synop') .gt. 0 ) THEN 
              lenhdr = 1
              ityprt = 4
              CALL IN_PRMF  ( dbprmfile, nparms, prmnam, iscale,
     +                        ioffst, nbits, pkflg, ier )
              IF ( ier .eq. 0 ) THEN 
                 iret = 0
              ELSE 
                 iret = ier
                 RETURN
              END IF
           ELSE IF ( INDEX(dbdatasrc,'bufrua') .gt. 0 .and.
     +               prtnam .eq. 'SNDT' ) THEN 
              iret = -4
           ELSE IF ( INDEX(dbdatasrc,'bufrua') .gt. 0 .and. 
     +               prtnam .ne. 'SNDT' ) THEN 
              lenhdr = 1
              ityprt = 4
              IF ( prtnam .eq. 'TTCC' .or. prtnam .eq. 'TTAA' ) THEN
                 nparms = 6
                 DO iparm = 1, nparms
                    prmnam (iparm) = mandpp (iparm)
                 END DO
              ELSE IF (prtnam .eq. 'TRPC' .or. prtnam .eq. 'TRPA' ) THEN
                 nparms = 5
                 DO iparm = 1, nparms
                    prmnam (iparm) = troppp (iparm)
                 END DO
              ELSE IF (prtnam .eq. 'MXWC' .or. prtnam .eq. 'MXWA' ) THEN
                 nparms = 3
                 DO iparm = 1, nparms
                    prmnam (iparm) = maxwpp (iparm)
                 END DO
              ELSE IF (prtnam .eq. 'PPCC' .or. prtnam .eq. 'PPCA' ) THEN
                 DO  i = 1, 3
                    ii = i + 2
                    IF ( i . eq. 1 ) ii = i
                    prmnam (i) = mandpp (ii)
                 END DO
                 nparms = i
              ELSE IF (prtnam .eq. 'TTDD' .or. prtnam .eq. 'TTBB' ) THEN
                 nparms = 3
                 DO iparm = 1, nparms
                    prmnam (iparm) = sigtpp (iparm)
                 END DO
              ELSE IF (prtnam .eq. 'PPDD' .or. prtnam .eq. 'PPBB' ) THEN
                 nparms = 3
                 DO iparm = 1, nparms
                    prmnam (iparm) = sigwpp (iparm)
                 END DO
              END IF
              iret = 0
           ELSE IF ( INDEX(dbdatasrc,'grid') .gt. 0 ) THEN 
              lenhdr = 128
              ityprt = 5
              nparms = 1
              prmnam(1) = 'GRID'
              gridtmdb = .true.
              igdtim = 1
              DO ii = 1, 200
                 dbtimes(ii) = ''
              END DO
           END IF
           RETURN
        END IF
C
C*	Check that the file is open.
C
	CALL DM_CHKF  ( iflno, iret )
	IF  ( iret .ne. 0 )  RETURN
C
C*	Find this part name.
C
	knt = 0
	DO  i = 1, kprt ( iflno )
	    IF  ( kprtnm ( i, iflno ) .eq. prtnam )  knt = i
	END DO
C
C*	Return if part name was not found.
C
	IF  ( knt .eq. 0 )  THEN
	    iret = -10
	    RETURN
	END IF
C
C*	Retrieve part information from common area.
C
	lenhdr = klnhdr ( knt, iflno )
	ityprt = ktyprt ( knt, iflno )
	nparms = kparms ( knt, iflno )
	DO  i = 1, nparms
	    prmnam ( i ) = kprmnm ( i, knt, iflno )
	    iscale ( i ) = kscale ( i, knt, iflno )
	    ioffst ( i ) = koffst ( i, knt, iflno )
	    nbits  ( i ) = kbits  ( i, knt, iflno )
	END DO
C*
	RETURN
	END