find_in_sel.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\find_in_sel.f
00002 !
00064                      SUBROUTINE FIND_IN_SEL
00065 !                    **********************
00066 !
00067      &(RES,NAME,NFIC,FFORMAT,W,OK,RECORD,NP,TIME)
00068 !
00069 !***********************************************************************
00070 ! BIEF   V6P3                                   21/08/2010
00071 !***********************************************************************
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !| NAME           |-->| NAME OF VARIABLE (16 CHARACTERS)
00080 !| NFIC           |-->| NUMERO DU CANAL DU FICHIER
00081 !| NP             |<--| NUMBER OF POINTS (OPTIONAL)
00082 !| OK             |<--| TRUE IF ARRAY IS FOUND
00083 !| RECORD         |-->| NUMBER OF THE REQUESTED RECORD
00084 !| RES            |<--| WHERE TO PUT THE RESULT
00085 !| TIME           |<--| TIME OF RECORD (OPTIONAL)
00086 !| W              |<->| REAL WORK ARRAY OF DIMENSION AT LEAST NPOIN.
00087 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00088 !
00089       USE BIEF, EX_FIND_IN_SEL => FIND_IN_SEL
00090 !
00091       IMPLICIT NONE
00092       INTEGER LNG,LU
00093       COMMON/INFO/LNG,LU
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       TYPE(BIEF_OBJ), INTENT(INOUT) :: RES
00098       CHARACTER(LEN=16), INTENT(IN) :: NAME
00099       LOGICAL, INTENT(OUT)          :: OK
00100       REAL, INTENT(INOUT)           :: W(*)
00101       INTEGER, INTENT(IN) :: NFIC
00102       INTEGER, INTENT(IN),  OPTIONAL          :: RECORD
00103       INTEGER, INTENT(OUT), OPTIONAL          :: NP
00104       DOUBLE PRECISION, INTENT(OUT), OPTIONAL :: TIME
00105       CHARACTER(LEN=8), INTENT(IN)  :: FFORMAT
00106 !
00107 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00108 !
00109       INTEGER NPOIN,ISTAT,I,NVAR,IB(10),REC,IREC
00110 !
00111       DOUBLE PRECISION XB(2)
00112       REAL RB(2)
00113 !
00114       CHARACTER(LEN=1) CB
00115       CHARACTER(LEN=32) TEXTLU(36)
00116 !
00117       CHARACTER(LEN=2) :: RF
00118 !
00119 !-----------------------------------------------------------------------
00120 !
00121 !     RK considering file format
00122 !
00123       IF(FFORMAT.EQ.'SERAFIND') THEN
00124         RF = 'R8'
00125       ELSE
00126         RF = 'R4'
00127       ENDIF
00128 !
00129       IF(PRESENT(RECORD)) THEN
00130         REC = RECORD
00131       ELSE
00132         REC = 1
00133       ENDIF
00134 !
00135       OK = .FALSE.
00136 !
00137 !-----------------------------------------------------------------------
00138 !
00139 !     'QUICKLY' READS UNTIL REACHES A TIME RECORD
00140 !
00141 !     GOES TO THE BEGINNING OF THE FILE
00142 !
00143       REWIND NFIC
00144 !
00145 !     1: TITLE
00146       CALL LIT(XB,RB,IB,CB,1,'CH',NFIC,'STD',ISTAT)
00147 !
00148 !     2: NUMBER OF ARRAYS IN THE RESULT FILE
00149       CALL LIT(XB,RB,IB,CB,2,'I ',NFIC,'STD',ISTAT)
00150       NVAR =  IB(1)  +  IB(2)
00151 !
00152 !     3: NAMES AND UNITS OF VARIABLES
00153       IF(NVAR.GE.1) THEN
00154         DO I=1,NVAR
00155            CALL LIT(XB,RB,IB,TEXTLU(I),32,'CH',NFIC,'STD',ISTAT)
00156         ENDDO
00157       ENDIF
00158 !
00159 !     4: LIST OF 10 INTEGER PARAMETERS
00160       CALL LIT(XB,RB,IB,CB,10,'I ',NFIC,'STD',ISTAT)
00161 !     CASE WHERE DATE AND TIME ARE IN THE FILE
00162       IF(IB(10).EQ.1) CALL LIT(XB,RB,IB,CB,6,'I ',NFIC,'STD',ISTAT)
00163 !
00164 !     5: 4 INTEGERS
00165       CALL LIT(XB,RB,IB,CB,4,'I ',NFIC,'STD',ISTAT)
00166       NPOIN = IB(2)
00167 !
00168       IF(PRESENT(NP)) NP = NPOIN
00169 !
00170 !     6: IKLES (LIKE IKLE BUT INDICES EXCHANGED)
00171       CALL LIT(XB,RB,IB,CB,1,'I ',NFIC,'STD',ISTAT)
00172 !
00173 !     7: IPOBO OR KNOLG
00174       CALL LIT(XB,RB,IB,CB,1,'I ',NFIC,'STD',ISTAT)
00175 !
00176 !     8 AND 9: X AND Y
00177       CALL LIT(XB,W,IB,CB,1,RF,NFIC,'STD',ISTAT)
00178       CALL LIT(XB,W,IB,CB,1,RF,NFIC,'STD',ISTAT)
00179 !
00180 !-----------------------------------------------------------------------
00181 !
00182       IREC = 0
00183 500   IREC = IREC + 1
00184       IF (NVAR.GE.1) THEN
00185 !
00186 !       TIME RECORD
00187 !
00188         CALL LIT(XB,W,IB,CB,1,RF,NFIC,'STD',ISTAT)
00189 !       NOTE JMH : THE FOLLOWING INSTRUCTION RAISES PROBLEMS
00190 !       WHEN TIME IS NOT PRESENT, WITH NAG COMPILER AND OPTION -O4
00191         IF(PRESENT(TIME)) TIME=XB(1)
00192 !
00193         DO I=1,NVAR
00194 !
00195 !         READS THE VARIABLE, OR SKIPS THE RECORD
00196           IF(TEXTLU(I)(1:16).EQ.NAME.AND.REC.EQ.IREC) THEN
00197             CALL LIT(RES%R,W,IB,CB,NPOIN,RF,NFIC,'STD',ISTAT)
00198             OK=.TRUE.
00199           ELSE
00200             CALL LIT(XB,W,IB,CB,1,RF,NFIC,'STD',ISTAT)
00201           ENDIF
00202 !
00203         ENDDO
00204 !
00205       ENDIF
00206       IF(IREC.NE.REC) GO TO 500
00207 !
00208 !-----------------------------------------------------------------------
00209 !
00210       RETURN
00211       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0