dmpsrc.f

	SUBROUTINE DM_PSRC (iflno, nkeys, keynam, iloval, ihival, iret)
C************************************************************************
C* DM_PSRC								*
C*									*
C* This subroutine defines criteria for the primary search.  If		*
C* the result of this primary search is false for any location, no	*
C* conditional search will be made.					*
C*									*
C* DM_PSRC  ( IFLNO, NKEYS, KEYNAM, ILOVAL, IHIVAL, IRET )		*
C*									*
C* Input parameters:							*
C*	IFLNO		INTEGER		File number			*
C*	NKEYS		INTEGER		Number of keys used in search	*
C*	KEYNAM (NKEYS)	CHAR*4		Key names			*
C*	ILOVAL (NKEYS)	INTEGER		Low values			*
C*	IHIVAL (NKEYS)	INTEGER		High values			*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code			*
C*					  0 = normal return		*
C*					 -4 = file not open		*
C*					-14 = invalid key 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*(*)	keynam (*)
	INTEGER		iloval (*), ihival (*)
	CHARACTER	type*4
C------------------------------------------------------------------------
C*      For A2DB requests - set the iret to 0 and return.
C
        IF  ( dbread ) THEN
            iret = 0
            RETURN
        END IF
C
C*	Check that file is open.
C
	CALL DM_CHKF ( iflno, iret )
	IF  ( iret .ne. 0 ) RETURN
C
C*	Check that at least one key is to be used in search.
C
	IF  ( ( nkeys .lt. 1 ) .or. ( nkeys .gt. MMKEY ) ) THEN
	    iret = -14
	    RETURN
	END IF
C
C*	Reset search pointers.
C
	srcflg (iflno) = .false.
	ksrow  (iflno) = 0
	kscol  (iflno) = 0
C
C*	Set number of row, column searches.
C
	ksnrow ( 0, iflno ) = 0
	ksncol ( 0, iflno ) = 0
C
C*	For each key name, determine type and save in common.
C
	DO  i = 1, nkeys
	    CALL DM_FKEY ( iflno, keynam (i), type, loc, ier )
	    IF ( ier .ne. 0 ) THEN
		iret = ier
	      ELSE IF ( type .eq. 'ROW' ) THEN
		ksnrow ( 0, iflno ) = ksnrow ( 0, iflno ) + 1
		kslrow ( ksnrow (0,iflno), 0, iflno ) = loc
		ksrlov ( ksnrow (0,iflno), 0, iflno ) = iloval (i)
		ksrhiv ( ksnrow (0,iflno), 0, iflno ) = ihival (i)
	      ELSE IF ( type .eq. 'COL' ) THEN
		ksncol ( 0, iflno ) = ksncol ( 0, iflno ) + 1
		kslcol ( ksncol (0,iflno), 0, iflno ) = loc
		ksclov ( ksncol (0,iflno), 0, iflno ) = iloval (i)
		kschiv ( ksncol (0,iflno), 0, iflno ) = ihival (i)
	    END IF
	END DO
C
C*	If all keys were found, set search flag.
C
	IF  ( iret .eq. 0 ) THEN
	    srcflg (iflno) = .true.
	  ELSE
	    ksnrow ( 0, iflno ) = 0
	    ksncol ( 0, iflno ) = 0
	END IF
C*
	RETURN
	END