rescue_sisyphe.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\rescue_sisyphe.f
00002 !
00060                      SUBROUTINE RESCUE_SISYPHE
00061 !                    *************************
00062 !
00063      &(QU,QV,Q,U,V,H,S,ZF,HW,TW,THETAW,NPOIN,TROUVE,ALIRE,PASS,
00064      & ICF,LISTI,MAXVAR)
00065 !
00066 !***********************************************************************
00067 ! SISYPHE   V6P1                                   21/07/2011
00068 !***********************************************************************
00069 !
00070 !
00071 !
00072 !
00073 !
00074 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00075 !| ALIRE          |-->| LIST VARIABLES TO BE READ
00076 !| H              |<->| WATER DEPTH
00077 !| HW             |<->| WAVE DEPTH
00078 !| ICF            |-->| BED-LOAD OR TOTAL LOAD TRANSPORT FORMULAS
00079 !| LISTI          |-->| LOGICAL, IF YES PRINT MESSAGES
00080 !| MAXVAR         |-->| MAXIMUM NUMBER OF OUTPUT VARIABLES
00081 !| NPOIN          |-->| NUMBER OF MESH NODES
00082 !| PASS           |-->| LOGICAL, IF YES BEGIN OF COMPUTATION
00083 !| Q              |<->| LIQUID DISCHARGE
00084 !| QU             |<->| LIQUID DISCHARGE X
00085 !| QV             |<->| LIQUID DISCHARGE Y
00086 !| S              |<->| WATER SURFACE ELEVATION
00087 !| THETAW         |<->| ANGLE BETWEEN WAVE AND CURRENT
00088 !| TROUVE         |-->| LOGIQUE INDIQUANT LES VARIABLES TROUVEES
00089 !|                |   | DANS LE SOUS-PROGRAMME SUITE
00090 !| TW             |<->| WAVE PERIOD
00091 !| U              |<->| VELOCITY COMPONENT X
00092 !| V              |<->| VELOCITY COMPONENT Y
00093 !| ZF             |<->| BED LEVEL
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !
00096       USE BIEF
00097 !
00098       USE INTERFACE_SISYPHE, EX_RESCUE_SISYPHE
00099      &           => RESCUE_SISYPHE
00100 !
00101       IMPLICIT NONE
00102       INTEGER LNG,LU
00103       COMMON/INFO/LNG,LU
00104 !
00105 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00106 !
00107       INTEGER, INTENT(IN) :: MAXVAR
00108       INTEGER, INTENT(IN) :: TROUVE(MAXVAR),ALIRE(MAXVAR),NPOIN,ICF
00109       LOGICAL, INTENT(IN) :: PASS,LISTI
00110 !
00111       DOUBLE PRECISION, INTENT(INOUT) :: QU(NPOIN), QV(NPOIN), Q(NPOIN)
00112       DOUBLE PRECISION, INTENT(INOUT) :: U(NPOIN) , V(NPOIN)
00113       DOUBLE PRECISION, INTENT(INOUT) :: S(NPOIN) , ZF(NPOIN), H(NPOIN)
00114       DOUBLE PRECISION, INTENT(INOUT) :: HW(NPOIN), TW(NPOIN)
00115       DOUBLE PRECISION, INTENT(INOUT) :: THETAW(NPOIN)
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119       INTEGER K
00120 !
00121 !-----------------------------------------------------------------------
00122 !
00123 ! PRINTOUTS :
00124 ! -----------
00125       IF(PASS.AND.LISTI) THEN
00126         WRITE(LU,200)
00127 200     FORMAT(80('-'))
00128         IF(ALIRE(8).EQ.1) THEN
00129           IF(LNG.EQ.1) WRITE(LU,300)
00130           IF(LNG.EQ.2) WRITE(LU,301)
00131 300       FORMAT(1X,'RESCUE : FICHIER HYDRODYNAMIQUE')
00132 301       FORMAT(1X,'RESCUE : HYDRODYNAMIC FILE')
00133         ELSE
00134           IF(LNG.EQ.1) WRITE(LU,310)
00135           IF(LNG.EQ.2) WRITE(LU,311)
00136 310       FORMAT(1X,'RESCUE : FICHIER SEDIMENTOLOGIQUE')
00137 311       FORMAT(1X,'RESCUE : SEDIMENTOLOGICAL FILE')
00138         ENDIF
00139       ENDIF
00140 !
00141 ! ------------------------------------------------------------------
00142 !  WATER DEPTH :
00143 !  -------------
00144       IF((ALIRE(3).EQ.1).AND.(TROUVE(3).NE.1)) THEN
00145         IF(TROUVE(4).EQ.1.AND.TROUVE(5).EQ.1) THEN
00146           IF (LISTI) THEN
00147             IF(LNG.EQ.1) WRITE(LU,400)
00148             IF(LNG.EQ.2) WRITE(LU,401)
00149           ENDIF
00150           CALL OV( 'X=Y-Z   ' , H , S , ZF , 0.D0 , NPOIN )
00151         ELSE
00152           IF (LISTI) THEN
00153             IF(LNG.EQ.1) WRITE(LU,420)
00154             IF(LNG.EQ.2) WRITE(LU,421)
00155           ENDIF
00156           CALL PLANTE(1)
00157           STOP
00158         ENDIF
00159       ENDIF
00160 !
00161 400       FORMAT(1X,'HAUTEUR D''EAU CALCULEE AVEC LE FOND',
00162      &         /,1X,'ET LA SURFACE LIBRE')
00163 401       FORMAT(1X,'WATER DEPTH COMPUTED WITH BATHYMETRY',
00164      &         /,1X,' AND SURFACE ELEVATION')
00165 420       FORMAT(1X,'IMPOSSIBLE DE CALCULER LA HAUTEUR D''EAU')
00166 421       FORMAT(1X,'WATER DEPTH UNABLE TO BE COMPUTED')
00167 !
00168 ! ----------------------------------------------------------------------
00169 !
00170 ! CLIPS NEGATIVE WATER DEPTHS :
00171 ! -------------------------------------
00172 !
00173       DO K = 1,NPOIN
00174         H(K) = MAX(H(K),0.D0)
00175       ENDDO
00176 !
00177 !------------------------------------------------------------------------
00178 !
00179 !  WAVE HEIGHT AND PERIOD
00180 !
00181       IF(ICF==4.OR.ICF==5.OR.ICF==8.OR.ICF==9) THEN
00182 !
00183         IF(ALIRE(12).EQ.1.AND.TROUVE(12).EQ.0) THEN
00184           IF(LNG.EQ.1) WRITE(LU,900)
00185           IF(LNG.EQ.2) WRITE(LU,901)
00186           CALL OV( 'X=C     ' , HW , U , V , 0.D0 , NPOIN )
00187         ENDIF
00188 !
00189 900     FORMAT(1X,'CALCUL PRECEDENT SANS LA HAUTEUR DE HOULE : ON',
00190      &          ' PREND ZERO')
00191 901     FORMAT(1X,'PREVIOUS COMPUTATION WITHOUT WAVE HEIGHT : IT IS',
00192      &          ' FIXED TO ZERO')
00193 !
00194         IF(ALIRE(13).EQ.1.AND.TROUVE(13).EQ.0) THEN
00195           IF(LNG.EQ.1) WRITE(LU,902)
00196           IF(LNG.EQ.2) WRITE(LU,903)
00197           CALL OV( 'X=C     ' , TW , U , V , 0.D0 , NPOIN )
00198         ENDIF
00199 902     FORMAT(1X,'CALCUL PRECEDENT SANS LA PERIODE DE HOULE : ON',
00200      &          ' PREND ZERO')
00201 903     FORMAT(1X,'PREVIOUS COMPUTATION WITHOUT WAVE PERIOD : IT IS',
00202      &          ' FIXED TO ZERO')
00203 !
00204         IF(ALIRE(14).EQ.1.AND.TROUVE(14).EQ.0) THEN
00205           IF(LNG.EQ.1) WRITE(LU,902)
00206           IF(LNG.EQ.2) WRITE(LU,903)
00207           CALL OV( 'X=C     ' , THETAW , U , V , 90.D0  , NPOIN )
00208         ENDIF
00209       ENDIF
00210 !909   FORMAT(1X,'CALCUL PRECEDENT SANS ANGLE DE HOULE : ON',
00211 !     &          ' PREND ZERO')
00212 !910   FORMAT(1X,'PREVIOUS COMPUTATION WITHOUT WAVE ANGLE : IT IS',
00213 !     &          ' FIXED TO ZERO')
00214 !
00215 !-----------------------------------------------------------------------
00216 !  NON-ERODABLE BED
00217 !
00218       IF(ALIRE(9).EQ.1.AND.TROUVE(9).EQ.0) THEN
00219         IF(LNG.EQ.1) WRITE(LU,907)
00220         IF(LNG.EQ.2) WRITE(LU,908)
00221       ENDIF
00222 907   FORMAT(1X,'CALCUL PRECEDENT SANS FOND NON ERODABLE')
00223 908   FORMAT(1X,'PREVIOUS CALCULATION WITHOUT NON ERODABLE',
00224      &         /,1X,'BOTTOM')
00225 !
00226 !-----------------------------------------------------------------------
00227 !  BED ELEVATION
00228 !
00229       IF(ALIRE(5).EQ.1.AND.TROUVE(5).EQ.0) THEN
00230 !
00231         IF(TROUVE(4).EQ.1.AND.TROUVE(3).EQ.1) THEN
00232           IF (LISTI) THEN
00233           IF(LNG.EQ.1) WRITE(LU,410)
00234           IF(LNG.EQ.2) WRITE(LU,411)
00235 410       FORMAT(1X,'FOND CALCULE AVEC LA HAUTEUR D''EAU',
00236      &         /,1X,'ET LA SURFACE LIBRE')
00237 411       FORMAT(1X,'BATHYMETRY COMPUTED FROM WATER DEPTH',
00238      &         /,1X,'AND SURFACE ELEVATION')
00239           ENDIF
00240           CALL OV( 'X=Y-Z   ' , ZF , S , H , 0.D0 , NPOIN )
00241         ELSE
00242           CALL  OV( 'X=C     ' , ZF , ZF, ZF, 0.D0 , NPOIN )
00243           IF(LNG.EQ.1) WRITE(LU,960)
00244           IF(LNG.EQ.2) WRITE(LU,961)
00245         ENDIF
00246 960     FORMAT(1X,'COTE DU FOND NON TROUVEE',/,
00247      &            'LA COTE EST INITIALISEE A ZERO')
00248 961     FORMAT(1X,'BOTTOM TOPOGRAPHY NOT FOUND',/,
00249      &            'IT IS SET TO ZERO')
00250 !
00251       ENDIF
00252 !
00253       IF (PASS.AND.LISTI) THEN
00254         WRITE(LU,970)
00255 970     FORMAT(80('-'))
00256       ENDIF
00257 !
00258 !-----------------------------------------------------------------------
00259 !
00260       RETURN
00261       END SUBROUTINE RESCUE_SISYPHE

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