calcs_o2.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\calcs_o2.f
00002 !
00059                       SUBROUTINE CALCS_O2
00060 !                    **********************
00061      & (NPOIN,WATTEMP,O2SATU,DEMBEN,FORMK2,K1,K44,K22,
00062      &  PHOTO,RESP,TN,TEXP,NTRAC)
00063 !
00064 !
00065 !***********************************************************************
00066 ! TELEMAC2D   V7P0                                        21/09/2014
00067 !***********************************************************************
00068 !
00069 !
00070 !
00071 !-----------------------------------------------------------------------
00072 !                             ARGUMENTS
00073 ! .___________.____.____.______________________________________________.
00074 ! !    NOM    !TYPE!MODE!                   ROLE                       !
00075 ! !___________!____!____!______________________________________________!
00076 ! ! NBTRA     ! E  ! M  ! NOMBRE DE TRACEURS                           !
00077 ! !  Q        ! TR ! D  ! DEBIT                                        !
00078 ! !  A        ! TR ! D  ! SECTION MOUILLEE                             !
00079 ! !  Z        ! TR ! D  ! HAUTEUR D EAU                                !
00080 ! !  RH       ! TR ! D  ! RAYON HYDRAULIQUE                            !
00081 ! !  ST       ! TR ! D  ! STRICKLER                                    !
00082 ! !  IM       ! E  ! M  ! NOMBRE DE SECTIONS DE CALCUL                 !
00083 ! !  C        ! TR ! D  ! CONCENTRATIONS                               !
00084 ! !  SVA      ! TR ! D  ! TERMES SOURCES VOLUMIQUE AJOUTES             !
00085 ! !  SSA      ! TR ! D  ! TERME SOURCE SURFACIQUE  AJOUTES             !
00086 ! !  T        !  R ! D  ! TEMPS                                        !
00087 ! !  DT       !  R ! D  ! PAS DE TEMPS                                 !
00088 !  RESULTATS------------------------------------------------------------
00089 ! !  RNUV     ! TR ! D  ! TERMES SOURCES VOLUMIQUES IMPLICITES         !
00090 ! !  RNUS     ! TR ! D  ! TERME SOURCE SURFACIQUE IMPLICITES           !
00091 ! !  SV       ! TR ! D  ! TERMES SOURCES  EXPLICITES                   !
00092 ! !          !
00093 ! !___________!____!____!______________________________________________!
00094 !                               COMMON
00095 ! .___________.____.____.______________________________________________.
00096 ! !    NOM    !TYPE!MODE!                   ROLE                       !
00097 ! !___________!____!____!______________________________________________!
00098 ! !  NMSCAL   ! E  ! M  ! NOMBRE MAXIMUM DE SECTIONS DE CALCUL         !
00099 ! !  NMTRA    ! E  ! M  ! NOMBRE MAXIMUM DE TRACEURS                   !
00100 ! !___________!____!____!______________________________________________!
00101 !                          VARIABLES INTERNES
00102 ! .___________.____.____.______________________________________________.
00103 ! !    NOM    !TYPE!MODE!                   ROLE                       !
00104 ! !___________!____!____!______________________________________________!
00105 ! !   U       ! TR ! D  ! VITESSE DE L'EAU                             !
00106 ! !   J       ! TR ! D  ! PENTE DE LA LIGNE DE CHARGE                  !
00107 ! !   K1      ! R  !    ! CONST DE CINET. DE DEGRAD. DE LA CHARGE ORG. !
00108 ! !   K44      ! R  !    ! CONST DE CINET. DE NITRIFICATION             !
00109 ! !  DEMBEN     ! R  !    ! DEMANDE BENTHIQUE                            !
00110 ! !   RESP    ! R  !    ! RESPIRATION VEGETALE                         !
00111 ! !   PHOTO   ! R  !    ! PHOTOSYNTHESE                                !
00112 ! !   K2      ! R  !    ! COEFFICIENT DE REAERATION                    !
00113 ! !   FORMK2  ! E  !    ! FORMULE DE CALCUL DE K2                      !
00114 ! !   O2SATU     ! R  !    ! CONC DE SATURATION EN OXYGENE DE L'EAU (CS)      !
00115 ! !   FORMCS  ! E  !    ! FORMULE DE CALCUL DE CS                      !
00116 ! !   CORECT  ! R  !    ! COEF DE CORRECTION DES FORMULES AVEC TEMP    !
00117 ! !   WATTEMP ! R  !    ! TEMPERATURE  DE L'EAU                                !
00118 ! !   RS      ! R  !    ! COEFFICIENT DE REAERATION AUX SEUILS         !
00119 ! !   FORMRS  ! E  !    ! FORMULE DE CALCUL DE RS                      !
00120 ! !   ARS     ! R  !    ! COEFFICIENT A DES FORMULES DE CALCUL DE R    !
00121 ! !   BRS     ! R  !    ! COEFFICIENT B DES FORMULES DE CALCUL DE R    !
00122 ! !___________!____!____!______________________________________________!
00123 !  MODE: -->(DONNEE NON MODIFIEE),<--(RESULTAT),<-->(DONNEE MODIFIEE)
00124 !               (ENTREE)              (SORTIE)       (ENTREE/SORTIE)
00125 !-----------------------------------------------------------------------
00126 !***********************************************************************
00127 !
00128       USE BIEF
00129       USE DECLARATIONS_WAQTEL,ONLY: FORMCS,K2
00130       USE DECLARATIONS_TELEMAC2D,ONLY: GRAV,HPROP,UN,VN,ZF
00131       USE INTERFACE_TELEMAC2D, EX_CALCS_O2 => CALCS_O2
00132 
00133       IMPLICIT NONE
00134       INTEGER LNG,LU
00135       COMMON/INFO/LNG,LU
00136 !
00137       INTEGER          , INTENT(IN   ) :: FORMK2,NPOIN,NTRAC
00138 !      LOGICAL          , INTENT(IN   ) :: YATEMP  ! IF TEMPERATURE IS VARIABLE
00139       DOUBLE PRECISION , INTENT(IN   ) :: DEMBEN,WATTEMP
00140       DOUBLE PRECISION , INTENT(IN   ) :: PHOTO,RESP,K1,K44
00141 !
00142       DOUBLE PRECISION , INTENT(INOUT) :: O2SATU,K22
00143       TYPE(BIEF_OBJ)   , INTENT(IN   ) :: TN
00144       TYPE(BIEF_OBJ)   , INTENT(INOUT) :: TEXP
00145 !
00146 !     LOCAL VARIABLES
00147       INTEGER                     :: I,RANKTR1,RANKTR2
00148       INTEGER         , PARAMETER :: ADDTR = 3
00149       DOUBLE PRECISION, PARAMETER :: EPS=1.D-3
00150       DOUBLE PRECISION, PARAMETER :: CORR1=1.065D0
00151       DOUBLE PRECISION, PARAMETER :: CORR2=1.0241D0
00152       DOUBLE PRECISION            :: UNORM,BENCORR,PJ,DAYTOSEC
00153       DOUBLE PRECISION            :: CORR1T,CORR2T,POWER
00154       INTRINSIC MAX,SQRT
00155 !
00156 !     PRELIMINARY COMPUTATIONS
00157 !
00158       POWER   = WATTEMP-20.D0
00159 !     HERE TEMPERATURE IS FIXED WHICH IS NOT PHYSICAL
00160 !     TO INVESTIGATE IF NECESSARY TO USE T VARIABLE !
00161       CORR1T  = CORR1**POWER
00162       CORR2T  = CORR2**POWER
00163       BENCORR = DEMBEN*CORR1T
00164       DAYTOSEC=1.D0/86400.D0
00165 !      DEUXG   = 2.D0*GRAV
00166 !
00167 !   IF CS (O2SATU) IS CHANGING
00168 !
00169       IF(FORMCS.NE.0)THEN
00170         IF(FORMCS.EQ.1)THEN
00171           O2SATU = 14.652D0 - 0.41022D0 * WATTEMP
00172      &         + 0.007991D0 * WATTEMP**2
00173      &         - 7.7774D-5 * WATTEMP**3
00174         ELSEIF(FORMCS.EQ.2)THEN
00175           IF(ABS(31.6D0+WATTEMP).GT.EPS)THEN
00176             O2SATU = 468.D0/(31.6D0+WATTEMP)
00177           ELSE
00178             O2SATU = 468.D0/EPS
00179           ENDIF
00180         ELSE
00181           IF(LNG.EQ.1)THEN
00182             WRITE(LU,100)FORMCS
00183           ELSE
00184             WRITE(LU,101)FORMCS
00185           ENDIF
00186           CALL PLANTE(1)
00187           STOP
00188         ENDIF
00189       ENDIF
00190 !
00191 !     COMPUTE K2
00192 !
00193       IF(FORMK2.EQ.0)THEN ! ==> CONSTANT K2
00194         CALL OS('X=C     ',K2,K2,K2,K22)
00195       ELSE  ! ==> VARIABLE K2
00196         DO I =1,NPOIN
00197 !
00198           UNORM = SQRT(UN%R(I)**2+VN%R(I)**2) !  GENERALIZATION OF U IN 1D
00199 !         HEAD OR WATER DEPTH TO REPLACE RH ?
00200           PJ = HPROP%R(I)  !ZF%R(I)+HPROP%R(I)+UNORM**2/DEUXG
00201 !         FORMULA OF THE TENESSEE VALLEY AUTHORITY
00202           IF( FORMK2.EQ.1 ) THEN
00203             K2%R(I) = 5.23D0*UNORM* MAX(HPROP%R(I),EPS)**(-1.67D0)
00204 !         FORMULA OF OWENS ET AL.
00205           ELSEIF(FORMK2.EQ.2)THEN
00206             K2%R(I) = 5.33D0*(UNORM**0.67D0)*
00207      &              MAX(HPROP%R(I),EPS)**(-1.85D0)
00208 !         FORMULA OF CHURCHILL ET AL.
00209           ELSEIF(FORMK2.EQ.3)THEN
00210             K2%R(I) = 0.746D0 * (UNORM**2.695D0) /
00211      &      (MAX(HPROP%R(I),EPS)**(-3.085D0) *
00212      &       MAX(ABS(PJ),EPS)**0.823D0) ! VERIFY THE FORMULA, SOME DOUBT ?
00213 !         FORMULA OF O CONNOR & DOBBINS'
00214           ELSEIF(FORMK2.EQ.4)THEN
00215             K2%R(I) = (3.90D0 * UNORM**0.5D0 ) /
00216      &               MAX(HPROP%R(I),EPS)**(1.5D0)
00217 !         FORMULA OF ?? INVISIBLE MAN :) : IT SEEMS TO BE A COMBINATION OF THE 3 LAST FORMULA ?!
00218           ELSEIF( FORMK2.EQ.5 ) THEN
00219             IF( HPROP%R(I).LE.0.6D0 ) THEN
00220               K2%R(I) = 5.33D0 * (UNORM**0.67D0) *
00221      &                MAX(HPROP%R(I),EPS)**(-1.85D0)
00222             ELSEIF (HPROP%R(I).LT.(12.D0*UNORM-6.6D0)) THEN
00223               K2%R(I) =  0.746D0*(UNORM**2.695D0)/
00224      &                (MAX(HPROP%R(I),EPS)**(-3.085D0) *
00225      &                 MAX(ABS(PJ),EPS)**0.823D0)
00226             ELSE
00227               K2%R(I) = 3.90D0 * (UNORM**0.5D0)/
00228      &                MAX(HPROP%R(I),EPS)**1.5D0
00229             ENDIF
00230           ELSE
00231             IF(LNG.EQ.1)THEN
00232               WRITE(LU,110)FORMK2
00233             ELSE
00234               WRITE(LU,111)FORMK2
00235             ENDIF
00236             CALL PLANTE(1)
00237             STOP
00238           ENDIF
00239         ENDDO
00240       ENDIF
00241 !
00242 !     COMPUTE RS (DONE IN DIFSOU)
00243 !
00244 !----------------------------------------------------------------------
00245 !     -II- LET'S NOW COMPUTE SOURCE TERMS
00246 !
00247       RANKTR1 = NTRAC-ADDTR+1
00248       RANKTR2 = RANKTR1+1
00249 !     RANKTR3 =NTRAC
00250       DO I=1,NPOIN
00251 !        FIRST TRACER O2 (RANK NTRAC-ADDTR+1) (EXPLICIT ?)
00252          TEXP%ADR(RANKTR1)%P%R(I) =
00253      &    K2%R(I) * CORR2T * (O2SATU-TN%ADR(RANKTR1)%P%R(I)) -
00254      &    K1 * TN%ADR(RANKTR2)%P%R(I) -
00255      &    K44 * TN%ADR(NTRAC)%P%R(I)  +
00256      &    PHOTO - RESP - BENCORR/MAX(EPS,HPROP%R(I))
00257 !
00258 !        SECOND TRACER [L] ORGANIC LOAD
00259 !
00260          TEXP%ADR(RANKTR2)%P%R(I) =
00261      &       -K1*TN%ADR(RANKTR2)%P%R(I)
00262 !        THIRD TRACER [NH4]
00263          TEXP%ADR(NTRAC)%P%R(I) =
00264      &       -K44*TN%ADR(NTRAC)%P%R(I)
00265 !
00266       ENDDO
00267 !     CONVERT DAYS TO SECONDS
00268       CALL OS('X=CX    ',X=TEXP%ADR(RANKTR1)%P,C=DAYTOSEC)
00269       CALL OS('X=CX    ',X=TEXP%ADR(RANKTR2)%P,C=DAYTOSEC)
00270       CALL OS('X=CX    ',X=TEXP%ADR(NTRAC  )%P,C=DAYTOSEC)
00271 !
00272 !
00273 !     ERROR MESSAGES
00274 !
00275 100   FORMAT(1X,'FORMULE DE CS:',I3,/,1X, 'NON PROGRAMMEE')
00276 101   FORMAT(1X,'CS FORMULA :',I3,/,1X, 'NOT AVAILABLE')
00277 !
00278 110   FORMAT(1X,'FORMULE DE K2:',I3,/,1X, 'NON PROGRAMMEE')
00279 111   FORMAT(1X,'K2 FORMULA :',I3,/,1X, 'NOT AVAILABLE')
00280 !
00281 !
00282 !-----------------------------------------------------------------------
00283 !
00284       RETURN
00285       END

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