drsurr.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\drsurr.f
00002 !
00077                      SUBROUTINE DRSURR
00078 !                    *****************
00079 !
00080      & (DELTAR, TA, BETAC,T0AC,RHO,RHO0,RHOS,DENLAW,SEDI,NTRAC,
00081      &  IND_T,IND_S, MIXTE)
00082 !
00083 !***********************************************************************
00084 ! TELEMAC3D   V6P3                                   21/08/2010
00085 !***********************************************************************
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !
00094 !
00095 !
00096 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00097 !| BETAC          |-->| -(1/RHO)*(DRHO/DT) FOR TRACERS WHEN CONSTANT
00098 !| DELTAR         |<->| (RHO-RHO0)/RHO0
00099 !| DENLAW         |-->| CHOICE OF DENSITY LAW (SEE ABOVE)
00100 !| IND_S          |-->| INDEX FOR SALINITY
00101 !| IND_T          |-->| INDEX FOR TEMPERATURE
00102 !| MIXTE          |-->| LOGICAL, MIXED SEDIMENTS OR NOT
00103 !| NTRAC          |-->| NUMBER OF ACTIVE TRACERS
00104 !| RHO            |<->| WATER DENSITY
00105 !| RHO0           |-->| AVERAGE WATER DENSITY IN THE DOMAIN
00106 !| RHOS           |-->| SEDIMENT DENSITY
00107 !| SEDI           |-->| IF YES, THERE IS SEDIMENT
00108 !| T0AC           |-->| REFERENCE CONCENTRATION OF TRACERS
00109 !| TA             |-->| TRACERS
00110 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00111 !
00112       USE BIEF
00113       USE INTERFACE_TELEMAC3D, EX_DRSURR => DRSURR
00114       IMPLICIT NONE
00115       INTEGER LNG,LU
00116       COMMON/INFO/LNG,LU
00117 !
00118 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00119 !
00120       INTEGER, INTENT(IN)           :: NTRAC, DENLAW,IND_T,IND_S
00121       DOUBLE PRECISION, INTENT(IN)  :: RHO0,RHOS
00122       DOUBLE PRECISION, INTENT(IN)  :: BETAC(NTRAC), T0AC(NTRAC)
00123       TYPE(BIEF_OBJ), INTENT(INOUT) :: DELTAR
00124       TYPE(BIEF_OBJ), INTENT(IN)    :: TA
00125       TYPE(BIEF_OBJ), INTENT(INOUT) :: RHO
00126       LOGICAL, INTENT(IN)           :: SEDI, MIXTE
00127 !
00128 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00129 !
00130       INTEGER ITRAC,NTRACM1
00131 !
00132 !***********************************************************************
00133 !
00134       IF(DENLAW.GE.1.AND.DENLAW.LE.3) THEN
00135 !
00136         IF(DENLAW.EQ.1) THEN
00137 !
00138 !         LAW ACCORDING TO TEMPERATURE
00139 !         RHO = RHOREF(1-(7(T-T0)**2)*1.E-6)
00140 !                                                  -3
00141 !         WITH T0=4degC   AND   RHOREF=999.972 KG.M
00142 !
00143 !         NOTE: ONLY THE GRADIENT OF DELTAR APPEARS IN EQUATIONS
00144 !
00145           CALL OS( 'X=Y+C   ',X=RHO,Y=TA%ADR(IND_T)%P,C=-4.D0)
00146           CALL OS( 'X=XY    ',X=RHO,Y=RHO)
00147           CALL OS( 'X=CX    ',X=RHO,C=7.D-6 )
00148           CALL OS( 'X=X+C   ',X=RHO,C=-1.D0 )
00149           CALL OS( 'X=CX    ',X=RHO,C=-999.972D0)
00150 !
00151         ELSEIF(DENLAW.EQ.2) THEN
00152 !
00153 !         LAW ACCORDING TO SALINITY S
00154 !         RHO = RHOREF(1+750S*1.E-6)
00155 !
00156 !                                 -3
00157 !         WITH RHOREF=999.972 KG.M
00158 !
00159           CALL OS( 'X=CY    ',X=RHO,Y=TA%ADR(IND_S)%P,C=750.D-6)
00160           CALL OS( 'X=X+C   ',X=RHO,C=1.D0)
00161           CALL OS( 'X=CX    ',X=RHO,C=999.972D0)
00162 !
00163         ELSEIF(DENLAW.EQ.3) THEN
00164 !
00165 !         LAW ACCORDING TO BOTH TEMPERATURE AND SALINITY
00166 !         RHO = RHOREF(1-(7(T-T0)**2-750S)*1.E-6)
00167 !                                                  -3
00168 !         WITH T0=4degC   AND   RHOREF=999.972 KG.M
00169 !
00170           CALL OS( 'X=Y+C   ',X=RHO,Y=TA%ADR(IND_T)%P,C=-4.D0  )
00171           CALL OS( 'X=XY    ',X=RHO,Y=RHO)
00172           CALL OS( 'X=CX    ',X=RHO,C=7.D-6 )
00173           CALL OS( 'X=X+CY  ',X=RHO,Y=TA%ADR(IND_S)%P,C=-750.D-6)
00174           CALL OS( 'X=X+C   ',X=RHO,C=-1.D0)
00175           CALL OS( 'X=CX    ',X=RHO,C=-999.972D0 )
00176 !
00177         ENDIF
00178 !
00179 !       COMPUTES DRHO/DRO  = (RHO - RHO0)/RHO0
00180 !       THE VALUE OF RHO0 GIVEN BY THE USER IS TAKEN HERE, IT TAKES INTO
00181 !       ACCOUNT AN AVERAGE TEMPERATURE OR SALINITY IN THE DOMAIN, FOR A
00182 !       BETTER BOUSSINESQ APPROXIMATION
00183 !
00184         CALL OS( 'X=Y+C   ', X=DELTAR , Y=RHO , C=-RHO0 )
00185         CALL OS( 'X=CX    ', X=DELTAR , C=1.D0/RHO0 )
00186 !
00187       ELSEIF(DENLAW.EQ.4) THEN
00188 !
00189 !       COMPUTES DELTAR WITH COEFFICIENTS BETAC GIVEN BY THE USER
00190 !
00191 !       BEWARE : BETA = - (1/RHO0)*(RHO-RHO0)/(TA-T0AC)
00192 !                HENCE - SIGN IN SECOND CALL TO OS
00193 !                BECAUSE DELTAR = (RHO-RHO0)/RHO0
00194 !
00195 !       SEDIMENT (TRACER NUMBER NTRAC) IS REMOVED IN THIS LOOP (AND TREATED AFTER)
00196 !
00197         CALL OS( 'X=0     ' , X=DELTAR )
00198 !
00199         IF(SEDI) THEN
00200           IF(MIXTE) THEN
00201             NTRACM1=NTRAC-2
00202           ELSE
00203             NTRACM1=NTRAC-1
00204           ENDIF
00205         ELSE
00206           NTRACM1=NTRAC
00207         ENDIF
00208 !
00209         IF(NTRACM1.GT.0) THEN
00210           DO ITRAC = 1,NTRACM1
00211             CALL OS('X=X+CY  ',DELTAR,TA%ADR(ITRAC)%P,
00212      &                              TA%ADR(ITRAC)%P, -BETAC(ITRAC) )
00213             CALL OS('X=X+C   ',DELTAR,DELTAR,DELTAR,
00214      &                              T0AC(ITRAC)*BETAC(ITRAC))
00215           ENDDO
00216         ENDIF
00217 !
00218       ELSEIF(DENLAW.EQ.0) THEN
00219 !
00220         CALL OS('X=0     ',X=DELTAR)
00221 !
00222       ELSE
00223 !
00224         IF(LNG.EQ.1) WRITE(LU,*) 'LOI DE DENSITE INCONNUE DANS DRSURR :'
00225         IF(LNG.EQ.2) WRITE(LU,*) 'WRONG DENSITY LAW IN DRSURR'
00226         CALL PLANTE(1)
00227         STOP
00228 !
00229       ENDIF
00230 !
00231 !-----------------------------------------------------------------------
00232 !
00233 !     EFFECT OF SEDIMENT IS ALWAYS ADDED
00234 !
00235 !     SEDIMENT (SEDIMENT MUST BE THE LAST TRACER, HENCE NUMBER NTRAC)
00236 !     ADDS UP THE SEDIMENT EFFECT
00237 !
00238       IF(SEDI) THEN
00239         IF(MIXTE) THEN
00240           CALL OS('X=X+CY  ',X=DELTAR,Y=TA%ADR(NTRAC-1)%P,
00241      &                       C=(RHOS-RHO0)/(RHO0*RHOS))
00242           CALL OS('X=X+CY  ',X=DELTAR,Y=TA%ADR(NTRAC)%P,
00243      &                       C=(RHOS-RHO0)/(RHO0*RHOS))
00244         ELSE
00245           CALL OS('X=X+CY  ',X=DELTAR,Y=TA%ADR(NTRAC)%P,
00246      &                       C=(RHOS-RHO0)/(RHO0*RHOS))
00247         ENDIF
00248       ENDIF
00249 !
00250 !-----------------------------------------------------------------------
00251 !
00252       RETURN
00253       END

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