4bfbdad17d
Former-commit-id:8485b90ff8[formerly bf53d06834caa780226121334ac1bcf0534c3f16] Former-commit-id:9f8cb727a5
91 lines
2.5 KiB
Fortran
91 lines
2.5 KiB
Fortran
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
|