litenr.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\litenr.f
00002 !
00060                      SUBROUTINE LITENR
00061 !                    *****************
00062 !
00063      &(VARSOR,CLAND,
00064      & NPRE,STD,HIST,NHIST,NPOIN,AT,TEXTPR,TEXTLU,
00065      & NVAR,VARCLA,NVARCL,TROUVE,ALIRE,W,LISTIN,MAXVAR,
00066      & NPOIN_PREV,NPLAN_PREV,WD)
00067 !
00068 !***********************************************************************
00069 ! BIEF   V6P1                                   21/08/2010
00070 !***********************************************************************
00071 !
00072 !
00073 !
00074 !
00075 !
00076 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00077 !| ALIRE          |-->| INTEGERS, IF 1 VARIABLE TO BE READ
00078 !|                |   | CLANDESTINE VARIABLES ARE SYSTEMATICALLY READ
00079 !| AT             |-->| TIME
00080 !| CLAND          |<--| CLANDESTINE VARIABLES
00081 !| HIST           |-->| ARRAY OF VALUES PUT IN THE RECORD OF TIME
00082 !| LISTIN         |-->| IF YES, PRINTS A LOG.
00083 !| MAXVAR         |-->| MAXIMUM NUMBER OF VARIABLES
00084 !| NHIST          |-->| NUMBER OF VALUES IN HIST.
00085 !| NPLAN_PREV     |-->| NUMBER OF PLANES IN SELAFIN FILE OF LOGICAL UNIT
00086 !|                |   | NPRE
00087 !| NPOIN          |-->| NUMBER OF POINTS
00088 !| NPOIN_PREV     |-->| NUMBER OF POINTS IN SELAFIN FILE OF LOGICAL UNIT
00089 !|                |   | NPRE
00090 !| NPRE           |-->| LOGICAL UNIT OF PREVIOUS RESULTS FILE
00091 !| NVAR           |-->| NUMBER OF VARIABLES IN FILE
00092 !| NVARCL         |-->| NUMBER OF CLANDESTINE VARIABLES.
00093 !|                |   | NVAR + NVARCL WILL BE THE TOTAL NUMBER.
00094 !| STD            |-->| FILE FORMAT
00095 !| TEXTLU         |-->| NAMES AND UNITS OF VARIABLES IN FILE
00096 !| TEXTPR         |-->| NAMES AND UNITS OF VARIABLES IN PROGRAM
00097 !| TROUVE         |<--| SAYS (TROUVE(K)=1) IF VARIABLES HAVE BEEN FOUND
00098 !|                |   | FROM K =  1 TO MAXVAR NORMAL VARIABLES
00099 !|                |   | FROM K = MAXVAR+1 TO MAXVAR+10 CLANDESTINES VAR.
00100 !| VARCLA         |-->| BLOCK WHERE TO PUT THE CLANDESTINE VARIABLES
00101 !| VARSOR         |<--| BLOCK WHERE TO PUT THE VARIABLES
00102 !| W              |-->| REAL WORK ARRAY, OF SIZE NPOIN
00103 !| WD             |<--| OPTIONAL REAL WORK ARRAY, OF SIZE NPOIN
00104 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00105 !
00106       USE BIEF_DEF
00107 !
00108       IMPLICIT NONE
00109       INTEGER LNG,LU
00110       COMMON/INFO/LNG,LU
00111 !
00112 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00113 !
00114       TYPE(BIEF_OBJ), INTENT(INOUT)   :: VARSOR,CLAND
00115       INTEGER, INTENT(IN)             :: NPRE,NHIST,NPOIN,MAXVAR,NVARCL
00116       INTEGER, INTENT(IN)             :: NVAR,ALIRE(MAXVAR)
00117       INTEGER, INTENT(OUT)            :: TROUVE(MAXVAR)
00118       INTEGER, INTENT(IN), OPTIONAL   :: NPOIN_PREV,NPLAN_PREV
00119       CHARACTER(LEN=*)                :: STD
00120       CHARACTER(LEN=32)               :: TEXTPR(MAXVAR),TEXTLU(MAXVAR)
00121       CHARACTER(LEN=32)               :: VARCLA(NVARCL)
00122       DOUBLE PRECISION, INTENT(INOUT) :: HIST(*)
00123       DOUBLE PRECISION, INTENT(OUT)   :: AT
00124       REAL                            :: W(NPOIN)
00125       LOGICAL, INTENT(IN)             :: LISTIN
00126 !
00127       DOUBLE PRECISION, INTENT(OUT), OPTIONAL :: WD(*)
00128 !
00129 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00130 !
00131       INTEGER ISTAT,L,IBID(1),NVAL,K,IHIST,NPLAN,NPOIN2,IPLAN,IP1,IP2,I
00132       DOUBLE PRECISION AAT(20),TETA,ARG
00133       CHARACTER(LEN=1) CBID
00134       LOGICAL OK,INTERP
00135 !
00136 !-----------------------------------------------------------------------
00137 !
00138 !     INTERPOLATES ?
00139 !
00140       INTERP=.FALSE.
00141       IF(PRESENT(NPOIN_PREV).AND.PRESENT(NPLAN_PREV)) THEN
00142         IF(NPOIN_PREV.NE.NPOIN) THEN
00143           INTERP=.TRUE.
00144           NPOIN2=NPOIN_PREV/NPLAN_PREV
00145           NPLAN=NPOIN/NPOIN2
00146           IF(.NOT.PRESENT(WD)) THEN
00147             IF(LNG.EQ.1) WRITE(LU,*) 'WD N EST PAS DANS LITENR'
00148             IF(LNG.EQ.2) WRITE(LU,*) 'WD NOT PRESENT IN LITENR'
00149             CALL PLANTE(1)
00150             STOP
00151           ENDIF
00152         ENDIF
00153       ENDIF
00154 !
00155 !-----------------------------------------------------------------------
00156 !
00157       DO L=1,MAXVAR
00158         TROUVE(L) = 0
00159       ENDDO
00160 !
00161 !-----------------------------------------------------------------------
00162 !
00163 !  READS THE TIME
00164 !
00165       NVAL = 1 + NHIST
00166       CALL LIT(AAT ,W,IBID,CBID,NVAL,'R4',NPRE,STD,ISTAT)
00167       AT = AAT(1)
00168 !
00169 !  GETS THE VALUES WRITTEN IN THE TIME RECORD
00170 !
00171       IF(NHIST.NE.0) THEN
00172         DO IHIST = 1, NHIST
00173           HIST(IHIST) = AAT(1+IHIST)
00174         ENDDO ! IHIST
00175       ENDIF
00176 !
00177       IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,140) AT
00178       IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,141) AT
00179 140   FORMAT(//,1X,'TEMPS DE L''ENREGISTREMENT : ',G16.7,' S')
00180 141   FORMAT(//,1X,'TIME OF RECORD: ',G16.7,' S')
00181 !
00182 !-----------------------------------------------------------------------
00183 !
00184 !  READS THE REQUIRED VARIABLES (IF THEY ARE FOUND)
00185 !
00186 !     CORRECTION JMH 16/12/03: NVARCL IS TAKEN INTO ACCOUNT HERE IN NVAR
00187 !                              AS AN OUPUT OF SKIPGEO
00188 !     DO K=1,NVAR+NVARCL
00189       DO K=1,NVAR
00190 !
00191         OK = .FALSE.
00192 !
00193       DO L=1,MAXVAR
00194 !
00195       IF (TEXTLU(K)(1:32).EQ.TEXTPR(L)(1:32) ) THEN
00196 !
00197         OK = .TRUE.
00198 !
00199         IF(ALIRE(L).EQ.1) THEN
00200 !
00201           IF(.NOT.INTERP) THEN
00202 !
00203             CALL LIT(VARSOR%ADR(L)%P%R,
00204      &               W,IBID,CBID,NPOIN,'R4',NPRE,STD,ISTAT)
00205 !
00206           ELSE
00207             CALL LIT(WD,W,IBID,CBID,NPOIN_PREV,'R4',NPRE,STD,ISTAT)
00208 !           COPIES BOTTOM AND FREE SURFACE
00209             CALL OV('X=Y     ',VARSOR%ADR(L)%P%R,WD,WD,0.D0,NPOIN2)
00210             CALL OV('X=Y     ',VARSOR%ADR(L)%P%R(NPOIN-NPOIN2+1:NPOIN),
00211      &                         WD(NPOIN_PREV-NPOIN2+1:NPOIN_PREV),
00212      &                         WD,0.D0,NPOIN2)
00213 !           INTERPOLATES OTHER PLANES
00214             IF(NPLAN.GT.2) THEN
00215               DO IPLAN=2,NPLAN-1
00216                 ARG=(NPLAN_PREV-1)*FLOAT(IPLAN-1)/FLOAT(NPLAN-1)
00217                 TETA=ARG-INT(ARG)
00218 !               IP1 : LOWER PLANE NUMBER - 1
00219                 IP1=INT(ARG)
00220 !               IP2 : UPPER PLANE NUMBER - 1
00221                 IP2=IP1+1
00222                 DO I=1,NPOIN2
00223                   VARSOR%ADR(L)%P%R(I+NPOIN2*(IPLAN-1))=
00224      &            TETA *WD(I+NPOIN2*IP2)+(1.D0-TETA)*WD(I+NPOIN2*IP1)
00225                 ENDDO
00226               ENDDO
00227             ENDIF
00228           ENDIF
00229 !
00230         ELSE
00231 !
00232           IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,75) TEXTLU(K)
00233           IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,76) TEXTLU(K)
00234 75        FORMAT(/,1X,'LA VARIABLE : ',A32,/,1X,
00235      &                'EST DANS LE FICHIER MAIS ELLE N''EST PAS LUE')
00236 76        FORMAT(/,1X,'VARIABLE : ',A32,/,1X,
00237      &                'IS IN THE FILE BUT WILL NOT BE READ')
00238           CALL LIT(AAT,W,IBID,CBID ,2,'R4',NPRE,STD,ISTAT)
00239 !
00240         ENDIF
00241 !
00242         TROUVE(L)=1
00243 !
00244       ENDIF
00245 !
00246       ENDDO ! L
00247 !
00248 !     THIS SHOULD NEVER HAPPEN NOW ?????
00249 !
00250       IF(NVARCL.NE.0) THEN
00251 !
00252       DO L=1,NVARCL
00253 !
00254       IF(TEXTLU(K)(1:32).EQ.VARCLA(L)(1:32) ) THEN
00255         OK = .TRUE.
00256         CALL LIT(CLAND%ADR(L)%P%R,
00257      &           W,IBID,CBID,NPOIN,'R4',NPRE,STD,ISTAT)
00258         TROUVE(MAXVAR+L)=1
00259       ENDIF
00260 !
00261       ENDDO ! L
00262       ENDIF
00263 !
00264         IF(.NOT.OK) THEN
00265           IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,77) TEXTLU(K)
00266           IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,78) TEXTLU(K)
00267 77        FORMAT(/,1X,'LA VARIABLE : ',A32,/,1X,
00268      &                'EST INCONNUE, ELLE NE SERA PAS CONSERVEE')
00269 78        FORMAT(/,1X,'VARIABLE : ',A32,/,1X,
00270      &                'UNKNOWN, IT WILL NOT BE KEPT')
00271           CALL LIT(AAT,W,IBID,CBID ,2,'R4',NPRE,STD,ISTAT)
00272         ENDIF
00273 !
00274       ENDDO ! K
00275 !
00276 !-----------------------------------------------------------------------
00277 !
00278       RETURN
00279       END

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