rescue.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\rescue.f
00002 !
00061                      SUBROUTINE RESCUE
00062 !                    *****************
00063 !
00064      &(U,V,H,S,ZF,T,TRAC0,NTRAC,ITURB,NPOIN,AKEP,TROUVE)
00065 !
00066 !***********************************************************************
00067 ! TELEMAC2D   V7P0
00068 !***********************************************************************
00069 !
00070 !
00071 !
00072 !
00073 !
00074 !
00075 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00076 !| AKEP           |-->| IF YES, K AND EPSILON TO BE INITIALISED
00077 !| H              |<--| WATER DEPTH
00078 !| ITURB          |-->| TURBULENCE MODEL
00079 !| NPOIN          |-->| NUMBER OF POINTS
00080 !| NTRAC          |-->| NUMBER OF TRACERS
00081 !| S              |<--| FREE SURFACE
00082 !| T              |<--| BLOCK OF TRACERS
00083 !| TRAC0          |-->| INITIAL VALUES OF TRACERS
00084 !| TROUVE         |-->| INTEGER ARRAY SAYING IF VARIABLES HAVE BEEN FOUND
00085 !| ZF             |-->| ELEVATION OF BOTTOM
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !
00088       USE BIEF
00089 !
00090       IMPLICIT NONE
00091       INTEGER LNG,LU
00092       COMMON/INFO/LNG,LU
00093 !
00094 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00095 !
00096       INTEGER, INTENT(IN)             :: TROUVE(*),ITURB,NPOIN,NTRAC
00097       LOGICAL, INTENT(INOUT)          :: AKEP
00098       DOUBLE PRECISION, INTENT(INOUT) :: U(NPOIN),V(NPOIN),H(NPOIN)
00099       DOUBLE PRECISION, INTENT(INOUT) :: S(NPOIN),ZF(NPOIN)
00100       DOUBLE PRECISION, INTENT(IN)    :: TRAC0(NTRAC)
00101       TYPE(BIEF_OBJ)  , INTENT(INOUT) :: T
00102 !
00103 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00104 !
00105       INTEGER ITRAC
00106       DOUBLE PRECISION BID
00107 !
00108 !-----------------------------------------------------------------------
00109 !
00110 !  VELOCITY U-COMPONENT
00111 !
00112       IF(TROUVE(1).NE.1 )  THEN
00113         IF(LNG.EQ.1) WRITE(LU,190)
00114         IF(LNG.EQ.2) WRITE(LU,191)
00115 190     FORMAT(1X,'RESCUE : FICHIER DE RESULTATS DU CALCUL PRECEDENT',
00116      &         /,1X,'         SANS LA VITESSE U, ON LA PREND NULLE')
00117 191     FORMAT(1X,'RESCUE : PREVIOUS COMPUTATION RESULTS FILE',
00118      &         /,1X,'         WITHOUT VELOCITY U, WE FIX IT TO ZERO')
00119         CALL OV( 'X=C     ' , U , U , U , 0.D0 , NPOIN )
00120       ENDIF
00121 !
00122 !-----------------------------------------------------------------------
00123 !
00124 !  VELOCITY V-COMPONENT
00125 !
00126       IF(TROUVE(2).NE.1 )  THEN
00127         IF(LNG.EQ.1) WRITE(LU,200)
00128         IF(LNG.EQ.2) WRITE(LU,201)
00129 200     FORMAT(1X,'RESCUE : FICHIER DE RESULTATS DU CALCUL PRECEDENT',
00130      &         /,1X,'         SANS LA VITESSE V, ON LA PREND NULLE')
00131 201     FORMAT(1X,'RESCUE : PREVIOUS COMPUTATION RESULTS FILE',
00132      &         /,1X,'         WITHOUT VELOCITY V, WE FIX IT TO ZERO')
00133         CALL OV( 'X=C     ' , V , V , V , 0.D0 , NPOIN )
00134       ENDIF
00135 !
00136 !-----------------------------------------------------------------------
00137 !
00138 !  WATER DEPTH
00139 !
00140       IF(TROUVE(4).NE.1) THEN
00141         IF(TROUVE(5).EQ.1) THEN
00142           IF(LNG.EQ.1) WRITE(LU,400)
00143           IF(LNG.EQ.2) WRITE(LU,401)
00144 400       FORMAT(1X,'RESCUE : HAUTEUR D''EAU CALCULEE AVEC LE FOND',
00145      &         /,1X,'         ET LA SURFACE LIBRE')
00146 401       FORMAT(1X,'RESCUE : WATER DEPTH COMPUTED WITH BATHYMETRY',
00147      &         /,1X,'         AND SURFACE ELEVATION')
00148           CALL OV( 'X=Y-Z   ' , H , S , ZF , BID , NPOIN )
00149         ELSE
00150           IF(LNG.EQ.1) WRITE(LU,420)
00151           IF(LNG.EQ.2) WRITE(LU,421)
00152 420       FORMAT(1X,'RESCUE : IMPOSSIBLE DE CALCULER LA HAUTEUR D''EAU')
00153 421       FORMAT(1X,'RESCUE : WATER DEPTH CANNOT BE COMPUTED')
00154           CALL PLANTE(1)
00155           STOP
00156         ENDIF
00157       ENDIF
00158 !
00159 !-----------------------------------------------------------------------
00160 !
00161 !  TRACER
00162 !
00163       IF(NTRAC.GT.0) THEN
00164         DO ITRAC=1,NTRAC
00165           IF(TROUVE(33+ITRAC).EQ.0) THEN
00166             IF(LNG.EQ.1) WRITE(LU,900)
00167             IF(LNG.EQ.2) WRITE(LU,901)
00168 900         FORMAT(1X,'RESCUE : CALCUL PRECEDENT SANS TRACEUR,',
00169      &           /,1X,'         ON PREND TRAC0')
00170 901         FORMAT(1X,'RESCUE : PREVIOUS CALCULATION WITHOUT TRACER',
00171      &           /,1X,'         WE FIX IT TO TRAC0')
00172             CALL OS( 'X=C     ' , X=T%ADR(ITRAC)%P,C=TRAC0(ITRAC))
00173           ENDIF
00174         ENDDO
00175       ENDIF
00176 !
00177 !-----------------------------------------------------------------------
00178 !
00179 !  K AND EPSILON
00180 !
00181       IF(ITURB.EQ.3.AND.TROUVE(10).EQ.1.AND.TROUVE(11).EQ.1) THEN
00182         AKEP=.FALSE.
00183       ENDIF
00184       IF(ITURB.EQ.3.AND.(TROUVE(10).EQ.0.OR.TROUVE(11).EQ.0)) THEN
00185         IF(LNG.EQ.1) WRITE(LU,950)
00186         IF(LNG.EQ.2) WRITE(LU,951)
00187 950     FORMAT(1X,'RESCUE : K ET EPSILON SERONT REINITIALISES')
00188 951     FORMAT(1X,'RESCUE : K ET EPSILON WILL BE SET AGAIN')
00189       ENDIF
00190 !
00191 !-----------------------------------------------------------------------
00192 !
00193       RETURN
00194       END

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