condih.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\artemis\condih.f
00002 !
00088                      SUBROUTINE CONDIH
00089 !                    *****************
00090 !
00091 !
00092 !***********************************************************************
00093 ! ARTEMIS   V6P1                                   21/08/2010
00094 !***********************************************************************
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !
00101 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00102 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00103 !
00104       USE BIEF
00105       USE DECLARATIONS_TELEMAC
00106       USE DECLARATIONS_ARTEMIS
00107 !
00108       IMPLICIT NONE
00109       INTEGER LNG,LU
00110       COMMON/INFO/LNG,LU
00111 !
00112       INTEGER I
00113 !
00114       DOUBLE PRECISION COTE
00115       DOUBLE PRECISION PI,BID,DHTEST,T1REF,T2REF
00116       PARAMETER( PI = 3.1415926535897932384626433D0 )
00117 !
00118       INTRINSIC SINH, SQRT
00119 !
00120       DOUBLE PRECISION AMPLC
00121 
00122 !-----------------------------------------------------------------------
00123 !
00124       CALL MAJUS(CDTINI)
00125 !
00126 !-----------------------------------------------------------------------
00127 !
00128 !   INITIALISES THE WATER DEPTH H
00129 !
00130       IF(INCLUS(CDTINI,'COTE NULLE').OR.
00131      &   INCLUS(CDTINI,'ZERO ELEVATION') ) THEN
00132         COTE = 0.D0
00133         CALL OS( 'X=C     ' , H , SBID , SBID , COTE )
00134         CALL OS( 'X=X-Y   ' , H , ZF  , SBID , BID  )
00135       ELSEIF(INCLUS(CDTINI,'COTE CONSTANTE').OR.
00136      &       INCLUS(CDTINI,'CONSTANT ELEVATION') ) THEN
00137         COTE = COTINI
00138         CALL OS( 'X=C     ' , H , SBID , SBID , COTE )
00139         CALL OS( 'X=X-Y   ' , H , ZF  , SBID , BID  )
00140       ELSEIF(INCLUS(CDTINI,'HAUTEUR NULLE').OR.
00141      &       INCLUS(CDTINI,'ZERO DEPTH') ) THEN
00142         CALL OS( 'X=C     ' , H , SBID , SBID , 0.D0 )
00143       ELSEIF(INCLUS(CDTINI,'HAUTEUR CONSTANTE').OR.
00144      &       INCLUS(CDTINI,'CONSTANT DEPTH') ) THEN
00145         CALL OS( 'X=C     ' , H , SBID , SBID , HAUTIN )
00146       ELSEIF(INCLUS(CDTINI,'PARTICULIERES').OR.
00147      &       INCLUS(CDTINI,'SPECIAL')        ) THEN
00148 !  TO BE MODIFIED BY USER
00149         IF(LNG.EQ.1) WRITE(LU,10)
00150         IF(LNG.EQ.2) WRITE(LU,11)
00151 10      FORMAT(1X,'CONDIH : AVEC DES CONDITIONS INITIALES PARTICULIERES'
00152      &         ,/,'         VOUS DEVEZ MODIFIER CONDIH')
00153 11      FORMAT(1X,'CONDIH : WITH SPECIAL INITIAL CONDITIONS'
00154      &         ,/,'         YOU HAVE TO MODIFY CONDIH')
00155         CALL PLANTE(0)
00156         STOP
00157 !  END OF CODE TO BE MODIFIED BY USER
00158       ELSE
00159         IF(LNG.EQ.1) WRITE(LU,20) CDTINI
00160         IF(LNG.EQ.2) WRITE(LU,21) CDTINI
00161 20      FORMAT(1X,'CONDIH : CONDITION INITIALE INCONNUE :',/,A72)
00162 21      FORMAT(1X,'CONDIH : UNKNOWN INITIAL CONDITION :',/,A72)
00163         CALL PLANTE(0)
00164         STOP
00165       ENDIF
00166 !
00167 !-----------------------------------------------------------------------
00168 !
00169 !  CLIPS H (VALUES LOWER THAN 1.D-2 NOT ALLOWED)
00170 !
00171       CALL CLIP(H,1.D-2,.TRUE.,1.D6,.FALSE.,NPOIN)
00172 !
00173 !-----------------------------------------------------------------------
00174 !
00175 !   COMPUTES THE WAVE NUMBER: K
00176 !   USING AN EXPLICIT FORMULATION (SEE EDF'S EXCELLENT REPORT BY
00177 !   F. DHELLEMMES 'PRECIS SUR LES VAGUES' )
00178 !
00179 !
00180       OMEGA = 2.D0*PI/PER
00181       CALL OS('X=CY    ', T1 , H , SBID , OMEGA**2/GRAV )
00182 !
00183 !     INITIALISES DHTEST
00184 !
00185       DHTEST = 1.D6
00186 !
00187       DO I=1,NPOIN
00188         T2%R(I) = 1.D0 + T1%R(I) *( 0.6522D0 +
00189      &                   T1%R(I) *( 0.4622D0 +
00190      &                   T1%R(I) *
00191      &                   T1%R(I) *( 0.0864D0 +
00192      &                   T1%R(I) *( 0.0675D0 ) )))
00193         T2%R(I) = SQRT( T1%R(I)*(T1%R(I) + 1.D0/T2%R(I)) )
00194         K%R(I)  = T2%R(I)/H%R(I)
00195         DHTEST  = MIN( DHTEST , H%R(I) )
00196       ENDDO
00197 !
00198 !     COMPUTE REFERENCE WAVE NUMBER KPHREF FOR AUTOMATIC PHASE CALCULATION
00199       IF (LPHASEAUTO) THEN
00200 !       CHECKS THE REFERENCE DEPTH HAS BEEN GIVEN
00201         IF (DEPREF.LT.0D0) THEN
00202           IF(LNG.EQ.1) THEN
00203             WRITE(LU,220)
00204           ENDIF
00205           IF(LNG.EQ.2) THEN
00206             WRITE(LU,221)
00207           ENDIF
00208 220       FORMAT(1X,'CONDIH : ERREUR. SI VOUS UTILISEZ LE CALCUL      '
00209      &           ,/,'         AUTOMATIQUE DES PHASES, IL FAUT         '
00210      &           ,/,'         RENSEIGNER UNE PROFONDEUR DE REFERENCE  '
00211      &           ,/,'         MOT CLEF : PROFONDEUR DE REFERENCE POUR '
00212      &           ,/,'         LA PHASE AUTOMATIQUE                    ')
00213 
00214 221       FORMAT(1X,'CONDIH : ERROR. IF YOU USE AUTOMATIC PHASE       '
00215      &           ,/,'         CALCULATION, YOU HAVE TO GIVE A         '
00216      &           ,/,'         REFERENCE WATER DEPTH                   '
00217      &           ,/,'         KEY WORD :                              '
00218      &           ,/,'        REFERENCE WATER DEPTH FOR AUTOMATIC PHASE')
00219           CALL PLANTE(1)
00220           STOP
00221         ENDIF
00222         T1REF= OMEGA**2/GRAV * DEPREF
00223         T2REF = 1.D0 + T1REF *( 0.6522D0 +
00224      &                 T1REF *( 0.4622D0 +
00225      &                 T1REF *
00226      &                 T1REF *( 0.0864D0 +
00227      &                 T1REF *( 0.0675D0 ) )))
00228         T2REF = SQRT( T1REF*(T1REF + 1.D0/T2REF) )
00229         KPHREF  = T2REF/DEPREF
00230       ENDIF
00231 !   CHECKS WHETHER H HAS BEEN CLIPPED OR NOT
00232 !
00233       IF (DHTEST.LE.1.01D-2) THEN
00234         IF(LNG.EQ.1) WRITE(LU,120)
00235         IF(LNG.EQ.2) WRITE(LU,121)
00236 120     FORMAT(1X,'CONDIH : ATTENTION !! VOUS AVEZ ATTEINT LE SEUIL '
00237      &         ,/,'         MINI DE HAUTEUR D''EAU (1 CM).'
00238      &         ,/,'         VERIFIEZ BATHY OU CONDITIONS INITIALES')
00239 121     FORMAT(1X,'CONDIH : WARNING !! YOU REACHED MINIMUM THRESHOLD'
00240      &         ,/,'         FOR WATER DEPTH (1 CM). CHECK THE'
00241      &         ,/,'         BATHYMETRY OR INITIAL CONDITIONS')
00242       ENDIF
00243 !
00244 !-----------------------------------------------------------------------
00245 !
00246 !   COMPUTES PHASE VELOCITY
00247 !
00248       CALL OS('X=CY    ', T1    , K     , SBID , 1.D0/OMEGA )
00249       CALL OS('X=1/Y   ', C     , T1    , SBID , BID        )
00250 !
00251 !-----------------------------------------------------------------------
00252 !
00253 !   COMPUTES GROUP VELOCITY
00254 !
00255       DO I=1,NPOIN
00256         CG%R(I) = C%R(I)/2.D0 *
00257      &            (1.D0 + 2.D0*K%R(I)*H%R(I)/SINH(2.D0*K%R(I)*H%R(I)))
00258       ENDDO
00259 !
00260 !
00261 !-----------------------------------------------------------------------
00262 !-----------------------------------------------------------------------
00263 !         CURRENT DEFINITION ON THE DOMAIN : DEFAULT 0
00264 !                       (EXAMPLE IS GIVEN BELOW)
00265 !----------------------------------------------------------------------
00266 !   => DEFINE YOUR CURRENT VALUES IN THE FOLLOWING LOOP
00267       IF(COURANT) THEN
00268         AMPLC=0D0
00269         DO I=1,NPOIN
00270         UC%R(I)=AMPLC
00271         VC%R(I)=AMPLC
00272         ENDDO
00273       ENDIF
00274 !
00275 !=====================================
00276 ! === EXAMPLE OF X,Y DEPENDENT CURRENT
00277 !=====================================
00278 !      IF(COURANT) THEN
00279 !
00280 !       AMPLC=1.D0
00281 !       DO I=1,NPOIN
00282 !        UC%R(I)=0.D0
00283 !        VC%R(I)=0.D0
00284 !        IF(X(I).GE.5.D0.AND.X(I).LT.13.D0)THEN
00285 !          UC%R(I)=AMPLC*((X(I)-5.D0)/8.D0)
00286 !         ELSEIF(X(I).GE.13.D0)THEN
00287 !          UC%R(I)=AMPLC
00288 !        ENDIF
00289 !       ENDDO
00290 !
00291 !      ENDIF
00292 
00293 
00294 !-----------------------------------------------------------------------
00295 !
00296       RETURN
00297       END SUBROUTINE

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