calcs2d_thermic.f

Go to the documentation of this file.

!                     **************************
                      SUBROUTINE calcs2d_thermic
!                     **************************
!
     & (npoin,tn,texp,hprop,patmos)
!
!
!***********************************************************************
! WAQTEL   V8P1
!***********************************************************************
!
!brief    COMPUTES SOURCE TERMS FOR  WAQ THERMIC PROCESS
!
!history  R. ATA
!+        21/09/2014
!+        V7P0
!+       CREATION
!
!history  S.E. BOURBAN (HRW)
!+        07/06/2017
!+        V7P3
!+        Indexing tracer (IND_*) to avoid conflicting naming convention
!+        between user defined tracers, water quality processes and
!+        ice processes. Introduction of the array RANK_*.
!
!history  S.E. BOURBAN (HRW)
!+        25/09/2017
!+        V7P3
!+        TEXP and TIMP are now additive to account for a variety of
!+        of sources / sinks on a given TRACER
!
!history  C.-T. PHAM
!+        17/01/2018
!+        V7P3
!+        The calculation of P_VAP_SAT has been moved before used in
!+        the calculation of PATMC
!
!history  C.-T. PHAM
!+        13/11/2019
!+        V8P1
!+        The calculation of HA is to be done with P_VAP, not P_VAP_SAT
!+        so PATMC is not to used for HA, only for HA_SAT
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| AT             |-->| TIME IN SECONDS
!| DT             |-->| TIME STEP
!| DIMM           |-->| 2D OR 3D
!| HPROP          |-->| PROPAGATION DEPTH
!| MASSOU         |<--| MASS OF TRACER ADDED BY SOURCE TERM
!| MAXSCE         |-->| MAXIMUM NUMBER OF SOURCES
!| MAXTRA         |-->| MAXIMUM NUMBER OF TRACERS
!| NPOIN          |-->| NUMBER OF NODES IN THE MESH
!| NTRAC          |-->| NUMBER OF TRACERS
!| PATMOS         |-->| ATMOSPHERIC PRESSURE
!| TETAT          |-->| COEFFICIENT OF IMPLICITATION FOR TRACERS.
!| TEXP           |-->| EXPLICIT SOURCE TERM.
!| TIMP           |-->| IMPLICIT SOURCE TERM.
!| TN             |-->| TRACERS AT TIME N
!| TSCE           |-->| PRESCRIBED VALUES OF TRACERS AT POINT SOURCES
!| TSCEXP         |<--| EXPLICIT SOURCE TERM OF POINT SOURCES
!|                |   | IN TRACER EQUATION, EQUAL TO:
!|                |   | TSCE - ( 1 - TETAT ) TN
!| VOLU2D         |-->| BASES AREA (NON ASSEMBLED)
!| YASMI          |<--| IF YES, THERE ARE IMPLICIT SOURCE TERMS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!-----------------------------------------------------------------------
!***********************************************************************
!
      USE bief_def
      USE declarations_special
      USE declarations_waqtel,ONLY: coef_k,ema,cfaer,boltz,cp_eau,
     &                              cp_air,emi_eau,ro0,ind_t
      USE meteo_telemac, ONLY: tair,pvap,ray3,winds,cldc
!      USE EXCHANGE_WITH_ATMOSPHERE
      USE interface_waqtel, ex_calcs2d_thermic => calcs2d_thermic
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)             :: npoin
      TYPE(bief_obj), INTENT(IN)      :: tn
      TYPE(bief_obj), INTENT(INOUT)   :: texp
      TYPE(bief_obj), INTENT(IN)      :: hprop
      TYPE(bief_obj), INTENT(IN)      :: patmos
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
!  LOCAL VARIABLES
!
      INTEGER                     :: i
      DOUBLE PRECISION, PARAMETER :: eps=1.d-3
      DOUBLE PRECISION            :: ce,cv,re,l_vap
      DOUBLE PRECISION            :: ra,patmc
      DOUBLE PRECISION            :: temper,ha_sat
      DOUBLE PRECISION            :: roa,ha,p_vap_sat
      DOUBLE PRECISION   :: constce,constcv,constra,constss,constre
!
      INTRINSIC max
!
! ----------------------------------------------------------------
!
!     SOME OPTIMIZATION
      constre = emi_eau*boltz
!
!     MAJORATED RADIATION
!
      constss = 1.d0/(ro0*cp_eau)
!
!     LOOP OVER ALL MESH POINTS
!
      DO i=1,npoin
        constcv = cp_air*(cfaer(1)+cfaer(2)*winds%R(i))
        constce = cfaer(1)+cfaer(2)*winds%R(i)
        temper = tn%ADR(ind_t)%P%R(i)
!       PRESSURE OF EVAPORATION
        p_vap_sat = 6.11d0*exp(17.27d0*temper /(temper+237.3d0))
!       AIR DENSITY
        roa = 100.d0*patmos%R(i)/((tair%R(i)+273.15d0)*287.d0)
!       AIR SPECIFIC MOISTURE
        patmc=patmos%R(i)-0.378d0*p_vap_sat
        ha  = 0.622d0*pvap%R(i)/(max(patmos%R(i)-0.378d0*pvap%R(i),eps))
!       RADIATION ON WATER SURFACE
        re = constre*(temper+273.15d0)**4
!       ADVECTIVE HEAT FLUX
        cv = roa*constcv*(temper-tair%R(i))
!       VAPOR LATENT HEAT
        l_vap = 2500900.d0 - 2365.d0*temper
!       AIR MOISTURE AT SATURATION
        IF(abs(patmc).GT.eps) THEN
          ha_sat = 0.622d0*p_vap_sat/patmc
        ELSE
          ha_sat = 0.d0
        ENDIF
!       EVAPORATION HEAT FLUX
        ce = roa*l_vap*constce*(ha_sat-ha)
!       ATMOSPHERIC RADIATION
        constra = ema*boltz *(tair%R(i)+273.15d0)**4 *
     &            (1.d0+coef_k*(cldc%R(i)/8.d0)**2)
        IF(ha_sat.LT.ha) THEN
          ra = 1.8d0*constra
        ELSE
          ra = constra
        ENDIF
!       READY TO INTRODUCE SOURCE TERM
        texp%ADR(ind_t)%P%R(i) = texp%ADR(ind_t)%P%R(i) +
     &            constss*(ray3%R(i)+ra-re-cv-ce) / max(hprop%R(i),eps)
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
!
      END SUBROUTINE