6d90dce0b7
Added files to index. Former-commit-id:7324dcd368[formerlye3d3629375] [formerlycf1383a412] [formerly7324dcd368[formerlye3d3629375] [formerlycf1383a412] [formerlybeae8e7e59[formerlycf1383a412[formerly 874ae116e412c39b73dc3cc74ee3f3a3b02d82f7]]]] Former-commit-id:beae8e7e59Former-commit-id:901d493ecf[formerly49dfa99cc5] [formerly c8669b5ab7910607c5f11760fd75aaf1865a062e [formerlye1fc0b48c1]] Former-commit-id: 58f45807010c2a34d66569d325b876da780850a4 [formerly03ad145679] Former-commit-id:57bc02d754
91 lines
2.5 KiB
Fortran
Executable file
91 lines
2.5 KiB
Fortran
Executable file
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************************************************************************
|
|
INCLUDE 'GEMPRM.PRM'
|
|
INCLUDE 'dmcmn.cmn'
|
|
INCLUDE 'dbcmn.cmn'
|
|
C
|
|
CHARACTER*(*) keynam (*)
|
|
INTEGER iloval (*), ihival (*)
|
|
CHARACTER type*4
|
|
C------------------------------------------------------------------------
|
|
C* Check that file is open.
|
|
C
|
|
CALL DM_CHKF ( iflno, iret )
|
|
IF ( iret .ne. 0 ) RETURN
|
|
IF ( dbread ) THEN
|
|
iret = 0
|
|
RETURN
|
|
END IF
|
|
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
|