mesures.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\mesures.f
00002 !
00083                      SUBROUTINE MESURES
00084 !                    ******************
00085 !
00086      &(ITER,TT)
00087 !
00088 !***********************************************************************
00089 ! TELEMAC2D   V6P3                                  21/08/2010
00090 !***********************************************************************
00091 !
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !
00098 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00099 !| ITER           |-->| ITERATION WHERE TO LOOK FOR THE MEASUREMENTS
00100 !| TT             |-->| CORRESPONDING TIME (TO CHECK)
00101 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00102 !
00103       USE BIEF
00104       USE DECLARATIONS_TELEMAC2D
00105 !
00106       IMPLICIT NONE
00107       INTEGER LNG,LU
00108       COMMON/INFO/LNG,LU
00109 !
00110 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00111 !
00112       INTEGER, INTENT(IN) :: ITER
00113       DOUBLE PRECISION, INTENT(IN) :: TT
00114 !
00115 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00116 !
00117       DOUBLE PRECISION TPS,C
00118       LOGICAL OKH,OKU,OKV
00119       INTEGER I,DISCLIN
00120 !
00121 !-----------------------------------------------------------------------
00122 !
00123       IF(T2D_FILES(T2DREF)%NAME(1:1).NE.' ') THEN
00124 !
00125 !-----------------------------------------------------------------------
00126 !
00127 !       WHEN MEASUREMENTS ARE IN A SELAFIN FILE
00128 !
00129         CALL FIND_IN_SEL(HD,TEXTE(4)(1:16),T2D_FILES(T2DREF)%LU,
00130      &         T2D_FILES(T2DREF)%FMT,W,OKH,RECORD=ITER,TIME=TPS)
00131         CALL FIND_IN_SEL(UD,TEXTE(1)(1:16),T2D_FILES(T2DREF)%LU,
00132      &         T2D_FILES(T2DREF)%FMT,W,OKU,RECORD=ITER,TIME=TPS)
00133         CALL FIND_IN_SEL(VD,TEXTE(2)(1:16),T2D_FILES(T2DREF)%LU,
00134      &         T2D_FILES(T2DREF)%FMT,W,OKV,RECORD=ITER,TIME=TPS)
00135 !
00136         IF(.NOT.OKH.OR..NOT.OKU.OR..NOT.OKV) THEN
00137           IF(LNG.EQ.1) THEN
00138             WRITE(LU,*) 'MESURES : PROBLEME DE LECTURE DE HD, UD OU VD'
00139           ENDIF
00140           IF(LNG.EQ.2) THEN
00141             WRITE(LU,*) 'MESURES : PROBLEM WHEN READIND HD, UD, OR VD'
00142           ENDIF
00143           CALL PLANTE(1)
00144           STOP
00145         ENDIF
00146         IF(ABS(TT-TPS).GT.1.D-3) THEN
00147           IF(LNG.EQ.1) THEN
00148             WRITE(LU,*) 'MESURES : PROBLEME DE LECTURE DU TEMPS'
00149           ENDIF
00150           IF(LNG.EQ.2) THEN
00151             WRITE(LU,*) 'MESURES : PROBLEM WHEN READIND TIME'
00152           ENDIF
00153           CALL PLANTE(1)
00154           STOP
00155         ENDIF
00156 !       UD AND VD MAY BE QUASI-BUBBLE
00157 !       (BUT ALPHA2 AND ALPHA3 WILL BE SET TO 0)
00158         IF(UD%ELM.EQ.12) THEN
00159           DISCLIN=11
00160           CALL CHGDIS(UD,DISCLIN,12,MESH)
00161           CALL CHGDIS(VD,DISCLIN,12,MESH)
00162         ENDIF
00163 !
00164 !-----------------------------------------------------------------------
00165 !
00166       ELSE
00167 !
00168 !-----------------------------------------------------------------------
00169 !
00170 !      CASE TO BE IMPLEMENTED BY USER HERE (OTHER FILE FORMAT, ETC.)
00171 !
00172         IF(LNG.EQ.1) WRITE(LU,*) 'MESURES A PROGRAMMER DANS MESURES'
00173         IF(LNG.EQ.2) WRITE(LU,*) 'MEASUREMENTS TO IMPLEMENT IN MESURES'
00174         CALL PLANTE(1)
00175         STOP
00176 !
00177 !-----------------------------------------------------------------------
00178 !
00179       ENDIF
00180 !
00181 !-----------------------------------------------------------------------
00182 !
00183 !     WEIGHT FUNCTIONS FOR ALL THE TIMESTEPS
00184 !
00185       CALL VECTOR(T1,'=','MASBAS          ',
00186      &            HD%ELM,1.D0,T3,T3,T3,T3,T3,
00187      &            T3,MESH,MSK,MASKEL)
00188       CALL OS( 'X=Y     ' , ALPHA1 , T1 , T1 , C )
00189 !
00190 !     CASE OF QUASI-BUBBLE ELEMENT FOR UD
00191       IF(HD%ELM.NE.UD%ELM) THEN
00192         CALL VECTOR(T1,'=','MASBAS          ',
00193      &              UD%ELM,1.D0,T3,T3,T3,T3,T3,
00194      &              T3,MESH,MSK,MASKEL)
00195       ENDIF
00196 !
00197       CALL OS( 'X=Y     ' , ALPHA2 , T1 , T1 , C )
00198       CALL OS( 'X=Y     ' , ALPHA3 , T1 , T1 , C )
00199 !
00200 !     CANCELS WEIGHTS FOR QUASI-BUBBLE POINTS
00201 !
00202       IF(UD%ELM.EQ.12) THEN
00203         DO I=NPOIN+1,NPOIN+NELEM
00204           ALPHA2%R(I)=0.D0
00205           ALPHA3%R(I)=0.D0
00206         ENDDO
00207       ENDIF
00208 !
00209 !-----------------------------------------------------------------------
00210 !
00211       RETURN
00212       END

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