The TELEMAC-MASCARET system  trunk
calcs2d_thermic.f
Go to the documentation of this file.
1 ! **************************
2  SUBROUTINE calcs2d_thermic
3 ! **************************
4 !
5  & (npoin,tn,texp,hprop,patmos)
6 !
7 !
8 !***********************************************************************
9 ! WAQTEL V8P1
10 !***********************************************************************
11 !
12 !brief COMPUTES SOURCE TERMS FOR WAQ THERMIC PROCESS
13 !
14 !history R. ATA
15 !+ 21/09/2014
16 !+ V7P0
17 !+ CREATION
18 !
19 !history S.E. BOURBAN (HRW)
20 !+ 07/06/2017
21 !+ V7P3
22 !+ Indexing tracer (IND_*) to avoid conflicting naming convention
23 !+ between user defined tracers, water quality processes and
24 !+ ice processes. Introduction of the array RANK_*.
25 !
26 !history S.E. BOURBAN (HRW)
27 !+ 25/09/2017
28 !+ V7P3
29 !+ TEXP and TIMP are now additive to account for a variety of
30 !+ of sources / sinks on a given TRACER
31 !
32 !history C.-T. PHAM
33 !+ 17/01/2018
34 !+ V7P3
35 !+ The calculation of P_VAP_SAT has been moved before used in
36 !+ the calculation of PATMC
37 !
38 !history C.-T. PHAM
39 !+ 13/11/2019
40 !+ V8P1
41 !+ The calculation of HA is to be done with P_VAP, not P_VAP_SAT
42 !+ so PATMC is not to used for HA, only for HA_SAT
43 !
44 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
45 !| AT |-->| TIME IN SECONDS
46 !| DT |-->| TIME STEP
47 !| DIMM |-->| 2D OR 3D
48 !| HPROP |-->| PROPAGATION DEPTH
49 !| MASSOU |<--| MASS OF TRACER ADDED BY SOURCE TERM
50 !| MAXSCE |-->| MAXIMUM NUMBER OF SOURCES
51 !| MAXTRA |-->| MAXIMUM NUMBER OF TRACERS
52 !| NPOIN |-->| NUMBER OF NODES IN THE MESH
53 !| NTRAC |-->| NUMBER OF TRACERS
54 !| PATMOS |-->| ATMOSPHERIC PRESSURE
55 !| TETAT |-->| COEFFICIENT OF IMPLICITATION FOR TRACERS.
56 !| TEXP |-->| EXPLICIT SOURCE TERM.
57 !| TIMP |-->| IMPLICIT SOURCE TERM.
58 !| TN |-->| TRACERS AT TIME N
59 !| TSCE |-->| PRESCRIBED VALUES OF TRACERS AT POINT SOURCES
60 !| TSCEXP |<--| EXPLICIT SOURCE TERM OF POINT SOURCES
61 !| | | IN TRACER EQUATION, EQUAL TO:
62 !| | | TSCE - ( 1 - TETAT ) TN
63 !| VOLU2D |-->| BASES AREA (NON ASSEMBLED)
64 !| YASMI |<--| IF YES, THERE ARE IMPLICIT SOURCE TERMS
65 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
66 !-----------------------------------------------------------------------
67 !***********************************************************************
68 !
69  USE bief_def
72  & cp_air,emi_eau,ro0,ind_t
74 ! USE EXCHANGE_WITH_ATMOSPHERE
75  USE interface_waqtel, ex_calcs2d_thermic => calcs2d_thermic
76  IMPLICIT NONE
77 !
78 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
79 !
80  INTEGER, INTENT(IN) :: npoin
81  TYPE(bief_obj), INTENT(IN) :: tn
82  TYPE(bief_obj), INTENT(INOUT) :: texp
83  TYPE(bief_obj), INTENT(IN) :: hprop
84  TYPE(bief_obj), INTENT(IN) :: patmos
85 !
86 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
87 !
88 ! LOCAL VARIABLES
89 !
90  INTEGER :: i
91  DOUBLE PRECISION, PARAMETER :: eps=1.d-3
92  DOUBLE PRECISION :: ce,cv,re,l_vap
93  DOUBLE PRECISION :: ra,patmc
94  DOUBLE PRECISION :: temper,ha_sat
95  DOUBLE PRECISION :: roa,ha,p_vap_sat
96  DOUBLE PRECISION :: constce,constcv,constra,constss,constre
97 !
98  INTRINSIC max
99 !
100 ! ----------------------------------------------------------------
101 !
102 ! SOME OPTIMIZATION
103  constre = emi_eau*boltz
104 !
105 ! MAJORATED RADIATION
106 !
107  constss = 1.d0/(ro0*cp_eau)
108 !
109 ! LOOP OVER ALL MESH POINTS
110 !
111  DO i=1,npoin
112  constcv = cp_air*(cfaer(1)+cfaer(2)*winds%R(i))
113  constce = cfaer(1)+cfaer(2)*winds%R(i)
114  temper = tn%ADR(ind_t)%P%R(i)
115 ! PRESSURE OF EVAPORATION
116  p_vap_sat = 6.11d0*exp(17.27d0*temper /(temper+237.3d0))
117 ! AIR DENSITY
118  roa = 100.d0*patmos%R(i)/((tair%R(i)+273.15d0)*287.d0)
119 ! AIR SPECIFIC MOISTURE
120  patmc=patmos%R(i)-0.378d0*p_vap_sat
121  ha = 0.622d0*pvap%R(i)/(max(patmos%R(i)-0.378d0*pvap%R(i),eps))
122 ! RADIATION ON WATER SURFACE
123  re = constre*(temper+273.15d0)**4
124 ! ADVECTIVE HEAT FLUX
125  cv = roa*constcv*(temper-tair%R(i))
126 ! VAPOR LATENT HEAT
127  l_vap = 2500900.d0 - 2365.d0*temper
128 ! AIR MOISTURE AT SATURATION
129  IF(abs(patmc).GT.eps) THEN
130  ha_sat = 0.622d0*p_vap_sat/patmc
131  ELSE
132  ha_sat = 0.d0
133  ENDIF
134 ! EVAPORATION HEAT FLUX
135  ce = roa*l_vap*constce*(ha_sat-ha)
136 ! ATMOSPHERIC RADIATION
137  constra = ema*boltz *(tair%R(i)+273.15d0)**4 *
138  & (1.d0+coef_k*(cldc%R(i)/8.d0)**2)
139  IF(ha_sat.LT.ha) THEN
140  ra = 1.8d0*constra
141  ELSE
142  ra = constra
143  ENDIF
144 ! READY TO INTRODUCE SOURCE TERM
145  texp%ADR(ind_t)%P%R(i) = texp%ADR(ind_t)%P%R(i) +
146  & constss*(ray3%R(i)+ra-re-cv-ce) / max(hprop%R(i),eps)
147  ENDDO
148 !
149 !-----------------------------------------------------------------------
150 !
151  RETURN
152 !
153  END SUBROUTINE
type(bief_obj), target, public tair
Definition: meteo_telemac.f:44
type(bief_obj), target, public pvap
double precision coef_k
type(bief_obj), target, public winds
double precision, dimension(2) cfaer
double precision, parameter boltz
double precision, target cp_eau
type(bief_obj), target, public ray3
type(bief_obj), target, public cldc
Definition: meteo_telemac.f:86