Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

PHY_MAR___.f90 @ 5423

Last change on this file since 5423 was 2160, checked in by Laurent Fairhead, 10 years ago
Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand
File size: 73.6 KB

Line
1	subroutine PHY_MAR &
2
3	!------------------------------------------------------------------------------+
4	! Mon 1-Jul-2013 MAR \|
5	! subroutine PHY_MAR is the MAR PHYsics Driver \|
6	! interfaces HOST variables \|
7	! and SISVAT variables \|
8	! \|
9	! Applied to: MARthusalem (variables in MAR***.inc files) \|
10	! \|
11	! \|
12	! # OPTIONS: #dT Distinction among Tendencies of MAR Physical Parametr. \|
13	! # ^^^^^^^^ #cw Cloud Condensation Nuclei (CCNw) Microphysics Activation \|
14	! \|
15	! \|
16	! version 3.p.4.1 created by H. Gallee, Tue 12-Mar-2013 \|
17	! Last Modification by H. Gallee, Mon 1-Jul-2013 \|
18	! \|
19	!------------------------------------------------------------------------------+
20
21	& (FlagSV & ! FLAG for SISVAT: (T,F) = (active OR NOT)
22	& ,FlagSV_Veg & ! FLAG for SISVAT: (T,F) = (Variable Vegetation OR NOT)
23	& ,FlagSV_SNo & ! FLAG for SISVAT: (T,F) = (Snow Model active OR NOT)
24	& ,FlagSV_BSn & ! FLAG for SISVAT: (T,F) = (Blowing Snow Model active OR NOT)
25	& ,FlagSV_KzT & ! FLAG for SISVAT: (T,F) = (pkt Turb.Transfert active OR NOT in SISVAT)
26	& ,FlagSV_SWD & ! FLAG for SISVAT: (T,F) = (Modify SW INPUT->downward OR NOT)
27	& ,FlagSV_SBC & ! FLAG for SISVAT: (T,F) = (INPUT of Soil & Vege DATA OR NOT in SISVAT)
28	& ,FlagSV_UBC & ! FLAG for SISVAT: (T,F) = (pkt UpperBC is Von Neuman OR NOT in SISVAT)
29	& ,FlagAT & ! FLAG for Atm_AT: (T,F) = (Turbulent Transfer active OR NOT)
30	& ,TypeAT & ! TYPE of Atm_AT: (e= Ee Duynkerke, K= Ee Kitada, L= EL, H= Ee Huan-R)
31	& ,FlagAT_TKE & ! FLAG for genTKE: (T,F) = (TKE-e Model active OR NOT)
32	& ,FlagCM & ! FLAG for CMiPhy: (T,F) = (Cloud Microphysics active OR NOT)
33	& ,FlagCM_UpD & ! FLAG for CMiPhy: (T,F) = (qv & hydrometeors updated OR NOT IN CMiPhy)
34	& ,FlagCP & ! FLAG for Convection Paramet.
35	& ,FlagRT & ! FLAG for Radiative Transfer
36	& ,FlagS0_SLO & ! FLAG for Insolation, Surfac.Slope Impact included NEW
37	& ,FlagS0_MtM & ! FLAG for Insolation, Surfac.Slope & Mountain Mask Impacts included NEW
38	& ,Flag_O & ! FLAG for OUTPUT
39	& ,FlagVR & ! FLAG for OUTPUT for VERIFICATION
40	& ,dt0DYn & ! Time STEP between 2 CALLs of PHY_MAR [s] I, fix
41	& ,dt0_SV & ! Time STEP between 2 CALLs of SISVAT [s] I, fix
42	& ,dt0_AT & ! Time STEP between 2 CALLs of Atm_AT [s] I, fix
43	& ,dt0_CM & ! Time STEP between 2 CALLs of CMiPhy [s] I, fix
44	& ,dt0_CP & ! Time STEP between 2 CALLs of CVamnh [s] I, fix
45	& ,dt0_RT & ! Time STEP between 2 CALLs of radCEP [s] I, fix
46	& ,dx & ! Grid Mesh size (Horizontal) [m] I, fix
47	& ,DD_AxX & ! Grid x-Axis Direction [degree] I, fix
48	& ,s_HOST & ! Grid (Vertical) of HOST (NORMALIZED PRESSURE assumed) [-] I, fix
49	& ,sh___HOST & ! Topography [m] I, fix
50	& ,sh_a_HOST & ! Topography Anomaly [m] I, fix NEW
51	& ,slopxHOST & ! Slope, x-direction [-] I, fix NEW
52	& ,slopyHOST & ! Slope, y-direction [-] I, fix NEW
53	& ,slopeHOST & ! Slope [-] I, fix NEW
54	& ,MMaskHOST & ! Mountain Mask [-] I, fix NEW
55	& ,lonh_HOST & ! Longitude [hour] I, fix
56	& ,latr_HOST & ! Latitude [radian] I, fix
57	& ,pkta_HOST & ! Reduced Potential Temperature [XK] I, O
58	& ,ptop_HOST & ! Pressure, Model Top [kPa] I, fix
59	& ,psa__HOST & ! Pressure Thickness [kPa] I
60	& ,gZa__HOST & ! Geopotential Height [m2/s2] I
61	& ,gZam_HOST & ! Geopotential Height, mid-level [m2/s2] I
62	& ,Ua___HOST & ! Wind , x-Direction [m/s] I
63	& ,Va___HOST & ! Wind , y-Direction [m/s] I
64	& ,Wa___HOST & ! Wind , z-Direction [m/s] I
65	& ,qv___HOST & ! Specific Humidity [kg/kg] I, O
66	& ,qw___HOST & ! Cloud Droplets Concentration [kg/kg] I, O
67	! #cw& ,CCN__HOST & ! CCN Concentration [-/kg]
68	& ,qi___HOST & ! Cloud Crystals Concentration [kg/kg] I, O
69	& ,CIN__HOST & ! CIN Concentration [-/kg] I, O
70	& ,CF___HOST & ! Cloud Fraction [-] I, O
71	& ,qs___HOST & ! Snow Particles Concentration [kg/kg] I, O
72	& ,qr___HOST & ! Rain Drops Concentration [kg/kg] I, O
73	& ,TKE__HOST & ! Turbulent Kinetic Energy [m2/s2] I, O
74	& ,eps__HOST & ! Turbulent Kinetic Energy Dissipation [m2/s3] I, O
75	& ,dpkt___dt & ! Reduced Potential Temperature TENDENCY, ALL Contribut.[KX/s] O
76	& ,dua____dt & ! Wind Speed (x-direc.) TENDENCY, ALL Contribut.[m/s2] O
77	& ,dva____dt & ! Wind Speed (y-direc.) TENDENCY, ALL Contribut.[m/s2] O
78	& ,dqv____dt & ! Specific Humidity TENDENCY, ALL Contr. [kg/kg/s] O
79	& ,dqw____dt & ! Cloud Droplets Concentration TENDENCY, ALL Contr. [kg/kg/s] O
80	! #cw& ,dCw____dt & ! CCN Concentration TENDENCY, ALL Contr. [1/s]
81	& ,dqi____dt & ! Cloud Crystals Concentration TENDENCY, ALL Contr. [kg/kg/s] O
82	& ,dCi____dt & ! CIN Concentration TENDENCY, ALL Contr. [1/s] O
83	& ,dCF____dt & ! Cloud Fraction TENDENCY, ALL Contr. [1/s] O
84	& ,dqs____dt & ! Snow Particles Concentration TENDENCY, ALL Contr. [kg/kg/s] O
85	& ,dqr____dt & ! Rain Drops Concentration TENDENCY, ALL Contr. [kg/kg/s] O
86	! #dT& ,dpktSV_dt & ! Reduced Potential Temperature TENDENCY, SISVAT [KX/s] (O)
87	! #dT& ,dpktAT_dt & ! Reduced Potential Temperature TENDENCY, Atm_AT [KX/s] (O)
88	! #dT& ,dqv_AT_dt & ! Specific Humidity TENDENCY, Atm_AT [kg/kg/s] (O)
89	! #dT& ,dqw_AT_dt & ! Cloud Droplets Concentration TENDENCY, Atm_AT [kg/kg/s] (O)
90	! #dT& ,dqi_AT_dt & ! Cloud Crystals Concentration TENDENCY, Atm_AT [kg/kg/s] (O)
91	! #dT& ,dqs_AT_dt & ! Snow Particles Concentration TENDENCY, Atm_AT [kg/kg/s] (O)
92	! #dT& ,dqr_AT_dt & ! Rain Drops Concentration TENDENCY, Atm_AT [kg/kg/s] (O)
93	! #cw& ,dCw_AT_dt & ! CCN Concentration TENDENCY, Atm_AT [1/s] (O)
94	! #dT& ,dCi_AT_dt & ! CIN Concentration TENDENCY, Atm_AT [1/s] (O)
95	! #dT& ,dpktCM_dt & ! Reduced Potential Temperature TENDENCY, CMiPhy [KX/s] (O)
96	! #dT& ,dqv_CM_dt & ! Specific Humidity TENDENCY, CMiPhy [kg/kg/s] (O)
97	! #dT& ,dqw_CM_dt & ! Cloud Droplets Concentration TENDENCY, CMiPhy [kg/kg/s] (O)
98	! #dT& ,dCF_CM_dt & ! Cloud Fraction TENDENCY, CMiPhy [1/s] (O)
99	! #dT& ,dqi_CM_dt & ! Cloud Crystals Concentration TENDENCY, CMiPhy [kg/kg/s] (O)
100	! #dT& ,dqs_CM_dt & ! Snow Particles Concentration TENDENCY, CMiPhy [kg/kg/s] (O)
101	! #dT& ,dqr_CM_dt & ! Rain Drops Concentration TENDENCY, CMiPhy [kg/kg/s] (O)
102	! #cw& ,dCw_CM_dt & ! CCN Concentration TENDENCY, CMiPhy [1/s] (O)
103	! #dT& ,dCi_CM_dt & ! CIN Concentration TENDENCY, CMiPhy [1/s] (O)
104	! #dT& ,dpktCP_dt & ! Reduced Potential Temperature TENDENCY, CVAmnh [KX/s] (O)
105	! #dT& ,dqv_CP_dt & ! Specific Humidity TENDENCY, CVAmnh [kg/kg/s] (O)
106	! #dT& ,dqw_CP_dt & ! Cloud Droplets Concentration TENDENCY, CVAmnh [kg/kg/s] (O)
107	! #dT& ,dqi_CP_dt & ! Cloud Crystals Concentration TENDENCY, CVAmnh [kg/kg/s] (O)
108	! #dT& ,dpktRT_dt & ! Reduced Potential Temperature TENDENCY, radCEP [KX/s] (O)
109	& ,sst__HOST & ! Ocean FORCING (SST) [K] I
110	! #IP& ,sif__HOST & ! Ocean FORCING (Sea-Ice Fraction ) [-] I
111	! #AO& ,s_T__HOST & ! Ocean COUPLING (Surface Temperat.) n=1: Open Ocean [-] I,NEMO
112	! #AO& ,Alb__HOST & ! Ocean COUPLING (Surface Albedo ) n=2: Sea Ice [-] I,NEMO
113	! #AO& ,dSdT2HOST & ! Ocean COUPLING ( d(SH Flux) / dT ) [W/m2/K] O
114	! #AO& ,dLdT2HOST & ! Ocean COUPLING ( d(LH Flux) / dT ) [W/m2/K] O
115	!dead& ,it0EXP,it0RUN & ! Iteration
116	& ,Year_H,Mon__H,Day__H,Hour_H,minu_H,sec__H & ! Time
117	& ,ixq1 ,i0x0 ,mxqq & ! Domain Dimension: x
118	& ,jyq1 ,j0y0 ,myqq & ! Domain Dimension: y
119	& ,mzq ,mzqq & ! Domain Dimension: z
120	& ,mwq & ! Domain Dimension: mosaic
121	& ,kcolq & ! Domain Dimension: x * y
122	& ,kcolw & ! Domain Dimension: x * y * mosaic
123	& ,m_azim & ! Mountain Mask, nb of directions taken into account [-]
124	& ,IOi0SV,IOj0SV,n0pt) ! Indices of OUTPUT Grid Point
125
126	!------------------------------------------------------------------------------+
127	! Sat 29-Jun-2013 MAR \|
128	! subroutine PHY_MAR is the MAR PHYsics Driver \|
129	! interfaces HOST variables \|
130	! and SISVAT variables \|
131	! \|
132	! Applied to: MARthusalem (variables in MAR***.inc files) \|
133	! \|
134	! \|
135	! # OPTIONS: #dT Distinction among Tendencies of MAR Physical Parametr. \|
136	! # ^^^^^^^^ #cw Cloud Condensation Nuclei (CCNw) Microphysics Activation \|
137	! \|
138	! \|
139	! version 3.p.4.1 created by H. Gallee, Tue 12-Mar-2013 \|
140	! Last Modification by H. Gallee, Sat 29-Jun-2013 \|
141	! \|
142	!------------------------------------------------------------------------------+
143
144	use Mod_Real
145	use Mod_PHY____dat
146	use Mod_PHY____grd
147	use Mod_PHY____kkl
148	use Mod_PHY_CM_ctr
149	use Mod_PHY_S0_ctr
150	use Mod_SISVAT_ctr
151	use Mod_PHY_CM_dat
152	use Mod_PHY_AT_grd
153	use Mod_PHY_CM_grd
154	use Mod_PHY_CP_grd
155	use Mod_PHY_RT_grd
156	use Mod_PHY_S0_grd
157	use Mod_SISVAT_grd
158	use Mod_PHY_DY_kkl
159	use Mod_PHY_AT_kkl
160	use Mod_PHY_CM_kkl
161	use Mod_PHY_CP_kkl
162	use Mod_PHY_RT_kkl
163	use Mod_PHY_S0_kkl
164	use Mod_SISVAT_kkl
165	use Mod_SISVAT_gpt
166
167	IMPLICIT NONE
168
169	logical :: FlagSV ! Flag (SISVAT)
170	logical :: FlagSV_Veg ! Flag (SISVAT: Vegetation)
171	logical :: FlagSV_SNo ! Flag (SISVAT: Surface * )
172	logical :: FlagSV_BSn ! Flag (SISVAT: Blowing * )
173	logical :: FlagSV_KzT ! Flag (SISVAT: d(KdT/dz)/dz)
174	logical :: FlagSV_SWD ! Flag: T/F : (SISVAT: SW=Down/Abs.)
175	logical :: FlagSV_SBC ! Flag: T/F : (SISVAT: SBC=INP/FIX.)
176	logical :: FlagSV_UBC ! Flag: T/F : (SISVAT: UBC=VonN/Dr.)
177	logical :: FlagAT ! Flag (Turbulent Transfer)
178	character(len=1) :: TypeAT ! Type (Turbulent Transfer)
179	logical :: FlagAT_TKE ! Flag (Turbulent Transfer, TKE-e Model: ON / OFF)
180	logical :: FlagCM ! Flag (Cloud Microphysics)
181	logical :: FlagCM_UpD ! Flag: T/F : (Cloud Microphysics: Update in/out PHY_MAR)
182	logical :: FlagCP ! Flag (Convection Param. )
183	logical :: FlagRT ! Flag (Radiative Transfer)
184	logical :: FlagS0_SLO ! FLAG (Insolation, Surfac.Slope )
185	logical :: FlagS0_MtM ! FLAG (Insolation, Surfac.Slope & Mountain Mask)
186
187	logical :: Flag_O ! Flag (OUTPUT)
188	logical :: FlagVR ! Flag (OUTPUT for VERIFICATION)
189
190	real :: dt0DYn ! Time Step (DYnamics, the shortest) [s]
191	real :: dt0_SV ! Time Step (SISVAT) [s]
192	real :: dt0_AT ! Time Step (Atmo Turb.) [s]
193	real :: dt0_CM ! Time Step (Cloud Mic.) [s]
194	real :: dt0_CP ! Time Step (Convection) [s]
195	real :: dt0_RT ! Time Step (Radiat.Tr.) [s]
196	real :: dx ! Grid Size [m]
197	real :: DD_AxX ! x-Axis Direction [degree]
198	real, dimension(mzqq) :: s_HOST ! Vertical Coordinate [-]
199	real , dimension(kcolq) :: sh___HOST ! Topography [m]
200	real(kind=real8), dimension(kcolq) :: sh_a_HOST ! Topography Anomaly [m]
201	real(kind=real8), dimension(kcolq) :: slopxHOST ! Slope, x-direction [-]
202	real(kind=real8), dimension(kcolq) :: slopyHOST ! Slope, y-direction [-]
203	real(kind=real8), dimension(kcolq) :: slopeHOST ! Slope [-]
204	real(kind=real8), dimension(kcolq,m_azim) :: MMaskHOST ! Mountain Mask [-]
205	real, dimension(kcolq) :: lonh_HOST ! Longitude [hour]
206	real, dimension(kcolq) :: latr_HOST ! Latitude [radian]
207	real :: ptop_HOST ! Pressure Model Top [kPa]
208
209	real, dimension(kcolq,mzqq) :: pkta_HOST ! Reduced Potential Temperature [KX/s]
210	real, dimension(kcolq) :: psa__HOST ! Pressure Thickness [kPa]
211	real, dimension(kcolq,mzqq) :: gZa__HOST ! Geopotential Height [m2/s2]
212	real, dimension(kcolq,mzqq) :: gZam_HOST ! Geopotential Height, mid-level [m2/s2]
213	real, dimension(kcolq,mzq) :: Ua___HOST ! Wind Speed, x-direction [m/s]
214	real, dimension(kcolq,mzq) :: Va___HOST ! Wind Speed, y-direction [m/s]
215	real, dimension(kcolq,mzq) ,INTENT(IN) :: Wa___HOST ! Wind Speed, z-direction [m/s]
216	real, dimension(kcolq,mzqq) :: qv___HOST ! Specific Humidity [kg/kg]
217	real, dimension(kcolq,mzq) :: qw___HOST ! Cloud Droplets Concentration [kg/kg]
218	real, dimension(kcolq,mzq) :: CCN__HOST ! CCN Concentration [-/kg]
219	real, dimension(kcolq,mzq) :: qi___HOST ! Cloud Crystals Concentration [kg/kg]
220	real, dimension(kcolq,mzq) :: CIN__HOST ! CIN Concentration [-/kg]
221	real, dimension(kcolq,mzq) :: CF___HOST ! Cloud Fraction [-/kg]
222	real, dimension(kcolq,mzq) :: qs___HOST ! Snow Particles Concentration [kg/kg]
223	real, dimension(kcolq,mzq) :: qr___HOST ! Rain Drops Concentration [kg/kg]
224	real, dimension(kcolq,mzq) :: TKE__HOST ! Turbulent Kinetic Energy [m2/s2]
225	real, dimension(kcolq,mzq) :: eps__HOST ! Turbulent Kinetic Energy Dissipation [m2/s3]
226
227	real, dimension(kcolq,mzq) :: dpkt___dt ! Reduced Potential Temperature TENDENCY, ALL Contribut.[KX/s]
228	real, dimension(kcolq,mzq) :: dua____dt ! Wind Speed (x-direc.) TENDENCY, ALL Contribut.[m/s2]
229	real, dimension(kcolq,mzq) :: dva____dt ! Wind Speed (y-direc.) TENDENCY, ALL Contribut.[m/s2]
230	real, dimension(kcolq,mzq) :: dqv____dt ! Specific Humidity TENDENCY, ALL Contr. [kg/kg/s]
231	real, dimension(kcolq,mzq) :: dqw____dt ! Cloud Droplets Concentration TENDENCY, ALL Contr. [kg/kg/s]
232	! #cw real, dimension(kcolq,mzq) :: dCw____dt ! CCN Concentration TENDENCY, ALL Contr. [1/kg/s]
233	real, dimension(kcolq,mzq) :: dqi____dt ! Cloud Crystals Concentration TENDENCY, ALL Contr. [kg/kg/s]
234	real, dimension(kcolq,mzq) :: dCi____dt ! CIN Concentration TENDENCY, ALL Contr. [1/kg/s]
235	real, dimension(kcolq,mzq) :: dCF____dt ! Cloud Fraction TENDENCY, ALL Contr. [kg/kg/s]
236	real, dimension(kcolq,mzq) :: dqs____dt ! Snow Particles Concentration TENDENCY, ALL Contr. [kg/kg/s]
237	real, dimension(kcolq,mzq) :: dqr____dt ! Rain Drops Concentration TENDENCY, ALL Contr. [kg/kg/s]
238
239	real, dimension(kcolq,mzq) :: dpktSV_dt ! Reduced Potential Temperature Tendency, SISVAT [KX/s]
240	real, dimension(kcolq,mzq) :: dpktAT_dt ! Reduced Potential Temperature Tendency, Atm_AT [KX/s]
241	real, dimension(kcolq,mzq) :: dqv_AT_dt ! Specific Humidity TENDENCY, Atm_AT [kg/kg/s]
242	real, dimension(kcolq,mzq) :: dqw_AT_dt ! Cloud Droplets Concentration TENDENCY, Atm_AT [kg/kg/s]
243	! #cw real, dimension(kcolq,mzq) :: dCw_AT_dt ! CCN Concentration TENDENCY, Atm_AT [1/s]
244	real, dimension(kcolq,mzq) :: dqi_AT_dt ! Cloud Crystals Concentration TENDENCY, Atm_AT [kg/kg/s]
245	real, dimension(kcolq,mzq) :: dCi_AT_dt ! CIN Concentration TENDENCY, Atm_AT [1/s]
246	real, dimension(kcolq,mzq) :: dqs_AT_dt ! Snow Particles Concentration TENDENCY, Atm_AT [kg/kg/s]
247	real, dimension(kcolq,mzq) :: dqr_AT_dt ! Rain Drops Concentration TENDENCY, Atm_AT [kg/kg/s]
248	real, dimension(kcolq,mzq) :: dpktCM_dt ! Reduced Potential Temperature Tendency, CMiPhy [KX/s]
249	real, dimension(kcolq,mzq) :: dqv_CM_dt ! Specific Humidity TENDENCY, CMiPhy [kg/kg/s]
250	real, dimension(kcolq,mzq) :: dqw_CM_dt ! Cloud Droplets Concentration TENDENCY, CMiPhy [kg/kg/s]
251	! #cw real, dimension(kcolq,mzq) :: dCw_CM_dt ! CCN Concentration TENDENCY, CMiPhy [1/s]
252	real, dimension(kcolq,mzq) :: dqi_CM_dt ! Cloud Crystals Concentration TENDENCY, CMiPhy [kg/kg/s]
253	real, dimension(kcolq,mzq) :: dCi_CM_dt ! CIN Concentration TENDENCY, CMiPhy [1/s]
254	real, dimension(kcolq,mzq) :: dCF_CM_dt ! Cloud Fraction TENDENCY, CMiPhy [1/s]
255	real, dimension(kcolq,mzq) :: dqs_CM_dt ! Snow Particles Concentration TENDENCY, CMiPhy [kg/kg/s]
256	real, dimension(kcolq,mzq) :: dqr_CM_dt ! Rain Drops Concentration TENDENCY, CMiPhy [kg/kg/s]
257	real, dimension(kcolq,mzq) :: dpktCP_dt ! Reduced Potential Temperature TENDENCY, CVAmnh [KX/s]
258	real, dimension(kcolq,mzq) :: dqv_CP_dt ! Specific Humidity TENDENCY, CVAmnh [kg/kg/s]
259	real, dimension(kcolq,mzq) :: dqw_CP_dt ! Cloud Droplets Concentration TENDENCY, CVAmnh [kg/kg/s]
260	real, dimension(kcolq,mzq) :: dqi_CP_dt ! Cloud Crystals Concentration TENDENCY, CVAmnh [kg/kg/s]
261	real, dimension(kcolq,mzq) :: dpktRT_dt ! Reduced Potential Temperature TENDENCY, radCEP [KX/s]
262
263	!dead integer :: it0EXP !
264	!dead integer :: it0RUN !
265	integer :: Year_H ! Time [year]
266	integer :: Mon__H ! Time [month]
267	integer :: Day__H ! Time [Day]
268	integer :: Hour_H ! Time [hour]
269	integer :: minu_H ! Time [minute]
270	integer :: sec__H ! Time [s]
271	integer :: ixq1,i0x0,mxqq ! Domain Dimension: x [-]
272	integer :: jyq1,j0y0,myqq ! Domain Dimension: y [-]
273	integer :: mzq ! Domain Dimension: z [-]
274	integer :: mzqq ! Domain Dimension: z [-]
275	integer :: mwq ! Domain Dimension: mosaic [-]
276	integer :: kcolq ! Domain Dimension: x * y [-]
277	integer :: kcolw ! Domain Dimension: x * y * mosaic [-]
278	integer :: m_azim ! Mountain Mask, nb of directions taken into account [-]
279	integer, dimension(n0pt) :: IOi0SV !
280	integer, dimension(n0pt) :: IOj0SV !
281	integer :: n0pt !
282
283	real, dimension(kcolq) :: sst__HOST ! Ocean FORCING (SST) [K]
284	! #IP real, dimension(kcolq) :: sif__HOST ! Ocean FORCING (Sea-Ice Fraction ) [-]
285	! #AO real, dimension(ixq1:mxqq,jyq1:myqq,mwq) :: s_T__HOST ! A - O COUPLING n=1: Open Ocean [K]
286	! #AO real, dimension(ixq1:mxqq,jyq1:myqq,mwq) :: Alb__HOST ! A - O COUPLING (Surface Albedo ) n=2: Sea Ice [-]
287	! #AO real, dimension(ixq1:mxqq,jyq1:myqq,mwq) :: dSdT2HOST ! A - O COUPLING ( d(SH Flux) / dT ) [W/m2/K]
288	! #AO real, dimension(ixq1:mxqq,jyq1:myqq,mwq) :: dLdT2HOST ! A - O COUPLING ( d(SH Flux) / dT ) [W/m2/K]
289
290	! #TC integer, parameter :: ntrac = 28 !
291	! #TC real, dimension(ixq1:mxqq,jyq1:myqq,mzq,ntrac) :: qxTC ! Aerosols: Atmospheric Contentration
292	! #TC real, dimension(ixq1:mxqq,jyq1:myqq ,ntrac) :: qsTC ! Aerosols: Near Surface Contentration
293	! #TC real, dimension(ixq1:mxqq,jyq1:myqq ,ntrac) :: uqTC ! Aerosols: Surf.Flux
294	! ---------------------------------------------------------------------------------!
295
296
297
298
299	! LOCAL VARIABLES
300	! ===============
301
302	real(kind=real8), dimension(kcolq,mzq) :: Wind_HOST ! Wind Speed, Horizontal [m/s]
303	real(kind=real8) :: dTdz = 0.0065 ! -d(T) / dz Lapse Rate [K/m]
304	real(kind=real8) :: dTimAT ! d(Time) between 2 calls of Atmos.Turbul. [s]
305
306	integer :: i ,j ,ikl ,ikp !
307	integer :: k ,mn !
308	integer :: n ,ipt ,iwr ,kk !
309
310
311
312
313
314	!dead it_RUN = it0RUN
315	!dead it_EXP = it0EXP
316
317
318
319
320	! INITIALIZATION
321	! ==============
322
323	! Initialization of local Variables (used each Time Step)
324	! -------------------------------------------------------
325
326	DO k = 1,mzq
327	DO ikl=1,kcolq
328	Wind_HOST(ikl,k) = sqrt(Ua___HOST(ikl,k)Ua___HOST(ikl,k)+Va___HOST(ikl,k)Va___HOST(ikl,k))
329	ENDDO
330	ENDDO
331
332
333
334	! Initialization of the run
335	! -------------------------
336
337	! Martin Control
338	PRINT*, 'Dans PHY_MAR:'
339	PRINT*, 'it_RUN=',it_RUN
340	! Martin Control
341
342	IF (it_RUN.LE.1) THEN
343
344
345
346	! Initialization of Mod_SISVAT_grd
347	! --------------------------------
348
349	jt__SV = max(1,int(dt0_SV /dt0DYn))
350	dt__SV = real(jt__SV)*dt0DYn
351	IF (dt__SV .NE. dt0_SV) write(6,61) dt__SV ,dt0_SV
352	61 format ('dt__SV =',f9.3,' differs from dt0_SV =',f9.3)
353
354
355	! Initialization of Mod_PHY_AT_grd
356	! --------------------------------
357
358	jt__AT = max(1,int(dt0_AT /dt0DYn))
359	dt__AT = real(jt__AT)*dt0DYn
360	IF (dt__AT .NE. dt0_AT) write(6,62) dt__AT ,dt0_AT
361	62 format ('dt__AT =',f9.3,' differs from dt0_AT =',f9.3)
362
363
364	! Initialization of Mod_PHY_CM_grd
365	! --------------------------------
366
367	jt__CM = max(1,int(dt0_CM /dt0DYn))
368	dt__CM = real(jt__CM)*dt0DYn
369	IF (dt__CM .NE. dt0_CM) write(6,63) dt__CM ,dt0_CM
370	63 format ('dt__CM =',f9.3,' differs from dt0_CM =',f9.3)
371
372
373	! Initialization of Mod_PHY_CP_grd
374	! --------------------------------
375
376	jt__CP = max(1,int(dt0_CP /dt0DYn))
377	dt__CP = real(jt__CP)*dt0DYn
378	IF (dt__CP .NE. dt0_CP) write(6,64) dt__CP ,dt0_CP
379	64 format ('dt__CP =',f9.3,' differs from dt0_CP =',f9.3)
380
381
382	! Initialization of Mod_PHY_RT_grd
383	! --------------------------------
384
385	jt__RT = max(1,int(dt0_RT /dt0DYn))
386	dt__RT = real(jt__RT)*dt0DYn
387	IF (dt__RT .NE. dt0_RT) write(6,65) dt__RT ,dt0_RT
388	65 format ('dt__RT =',f9.3,' differs from dt0_RT =',f9.3)
389
390
391	! Initialization
392	! --------------
393
394	! Initialization of 1-D Axes Variables: Vertical Axis (Atmosphere)
395	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
396	pt__DY = ptop_HOST
397	DO k=1,mzpp
398	sigma(k) = s_HOST(k)
399	ENDDO
400
401	! Martin control
402	!PRINT*,'s_HOST=',s_HOST
403	! Martin control
404
405	DO k=1,mzp
406	k1m(k) = max(k-1, 1)
407	k1p(k) = min(k+1,mzp)
408	k2m(k) = max(k-2, 1)
409	dsigma(k) = sigma(k+1) - sigma(k)
410	sigmi(k+1) = (sigma(k+1) + sigma(k)) * 0.5
411	END DO
412	sigmi(1) = 0.0
413	sigmi(mzpp)= 1.0
414
415	DO k=1,mzp
416	dsigmi(k) = sigmi(k+1) - sigmi(k)
417
418	! Guess of sigma-levels Height
419	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
420	hsigma(k) =-(288./.0065)(sigma(k) * (287.*.0065/9.81)-1.)
421	END DO
422
423	write(6,501) (sigma(k),k=1,mzpp)
424	501 format(/,' sigma: ',10f8.5 &
425	& ,5(/,' ',10f8.5))
426
427	write(6,502)(hsigma(k),k=1,mzp)
428	502 format(/,' hsigma: ',10f8.1 &
429	& ,5(/,' ',10f8.1))
430
431
432
433	! Initialization of Mod_PHY____dat & Mod_PHY____kkl
434	! -------------------------------------------------
435
436	! Topography
437	! ~~~~~~~~~~
438	sh_MAX = 0.
439	DO ikl = 1,kcolp
440	sh__AP(ikl) = sh___HOST(ikl)
441	sha_AP(ikl) = sh_a_HOST(ikl)
442
443	! Surface Slope
444	! ~~~~~~~~~~~~~
445	sloxAP(ikl) = slopxHOST(ikl)
446	sloyAP(ikl) = slopyHOST(ikl)
447	slopAP(ikl) = slopeHOST(ikl)
448	sh_MAX = max(sh_MAX,sh__AP (ikl))
449	END DO
450	dzaMIN = hsigma(mzp) *(hsigma(1) -sh_MAX) /hsigma(1)
451
452
453	DO ikl = 1,kcolp
454
455	! Geographic Coordinates
456	! ~~~~~~~~~~~~~~~~~~~~~~
457
458	! Martin rearrangement pour que RADACA ne plante plus:
459
460	! lon__r(ikl) = lonh_HOST(ikl) * 2.0 * piNmbr / 24.0
461	IF ((lonh_HOST(ikl) ) .LT. 0) THEN
462	lon__r(ikl) = 360 + (lonh_HOST(ikl) * 2.0 * piNmbr / 24.0)
463	ELSE
464	lon__r(ikl) = (lonh_HOST(ikl) * 2.0 * piNmbr / 24.0)
465	ENDIF
466	lon__h(ikl) = lonh_HOST(ikl)
467	lat__r(ikl) = latr_HOST(ikl)
468	sinLat(ikl) = sin(lat__r(ikl))
469	cosLat(ikl) = cos(lat__r(ikl))
470
471	ENDDO
472
473
474
475	! -----------------------------------------------------------------------------!
476	! Initialization of Atm_DY (Counterpart of dynamical variables in PHY_MAR)
477	! -------------------------
478
479	! Martin control
480	!PRINT*,'Avant PHY_Atm_DY_INI'
481	!PRINT*,'size(psa_DY)=',size(psa_DY)
482	! Martin control
483
484	! **************
485	CALL PHY_Atm_DY_INI
486	! **************
487
488	! Initialization of Atm_DY: needs plausible Atmospheric Conditions
489	! ~~~~~~~~~~~~~~~~~~~~~~~~~ (here idealized for Temperature Vertical Gradient)
490	! Martin control
491	!PRINT*,'Apres PHY_Atm_DY_INI'
492	!PRINT*,'size(psa_DY)=',size(psa_DY)
493	!PRINT*,'Dans PHY_MAR, calcul de Ta__DY:'
494	!PRINT*,'mzpp=',mzpp
495	!PRINT*,'pt__DY=',pt__DY
496	!PRINT*,'Dtdz=',dTdz
497	!PRINT*,'RCp=',RCp
498	!PRINT*,'minval(pkta(:,mzpp))=',minval(pkta_HOST(:,mzpp))
499	!PRINT*,'minval(psa__HOST(:))=',minval(psa__HOST(:))
500	!PRINT*,'minval(Z___DY(:,:))=',minval(Z___DY(:,:))
501	!PRINT*,'minval(Ta__DY(:,mzpp))=',minval(Ta__DY(:,mzpp))
502	! Martin control
503
504	DO ikl = 1,kcolp
505	i = ii__AP (ikl)
506	j = jj__AP (ikl)
507	psa_DY (ikl ) = psa__HOST(ikl)
508	Ta__DY (ikl,mzpp) = pkta_HOST(ikl,mzpp)(psa_DY(ikl)+pt__DY)*RCp
509	!gilles : init
510	Z___DY (ikl,mzpp) = 0.
511	qv__DY (ikl,mzpp) = 0.001
512	DO k = mzp,1,-1
513	Z___DY (ikl,k ) = &
514	& Ta__DY(ikl,mzpp) &
515	& * (1.0 - ((psa_DY(ikl)*sigma (k)+pt__DY) &
516	& /(psa_DY(ikl) +pt__DY)) &
517	& *(R_DAir dTdz /Grav_F)) / dTdz
518	Ta__DY (ikl,k) = &
519	& Ta__DY(ikl,mzpp) -Z___DY(ikl,k) * dTdz
520
521	qv__DY (ikl,k) = 0.001
522
523	WindDY (ikl,k) = Wind_HOST(ikl,k)
524	ua__DY (ikl,k) = Ua___HOST(ikl,k)
525	va__DY (ikl,k) = va___HOST(ikl,k)
526	wa__DY (ikl,k) = Wa___HOST(ikl,k)
527	ENDDO
528	ENDDO
529
530	! Martin Control
531	!PRINT*,'Avant PHY_Atm_S0_INI'
532	!PRINT*,'minval(Ta__DY(:,:))=',minval(Ta__DY(:,:))
533
534
535	! -----------------------------------------------------------------------------!
536	! Initialization of Atm_S0 (Insolation and cos of Sun Zenithal Distance)
537	! -------------------------
538
539	! **************
540	CALL PHY_Atm_S0_INI
541	! **************
542
543	! Initialization of Mod_PHY_S0_ctr and Mod_PHY_S0_kkl
544	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
545	FaceS0 = FlagS0_SLO
546	MMskS0 = FlagS0_MtM
547	IF (FlagS0_SLO .AND. FlagS0_MtM) THEN
548	DO k = 1,m_azim
549	DO ikl = 1,kcolp
550	cszkS0(ikl,k) = MMaskHOST(ikl,k)
551	ENDDO
552	ENDDO
553	ENDIF
554
555
556	! -----------------------------------------------------------------------------!
557	! Initialization of SISVAT
558	! -------------------------
559
560	! Initialization of Mod_SISVAT_ctr (SISVAT Switches
561	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ & Time/Space control Variables)
562	VegMod = FlagSV_Veg
563	SnoMod = FlagSV_SNo
564	BloMod = FlagSV_BSn
565	InpSWD = FlagSV_SWD
566	InpSBC = FlagSV_SBC
567	SVaKzT = FlagSV_KzT
568	SVaUBC = FlagSV_UBC
569
570
571	! Initialization of Mod_SISVAT_kkl (from INPUT from HOST Model)
572	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
573	DO ikp = 1,kcolp
574	i = ii__AP(ikp)
575	j = jj__AP(ikp)
576	DO mn = 1,mwp
577	DO k = 1,mzp
578	kk = mzpp - k
579	WindSV(ikp,mn,k) = Wind_HOST(ikp,k)
580	pkt0SV(ikp,mn,kk)= pkta_HOST(ikp,k)
581	END DO
582	Ua__SV(ikp,mn) = Ua___HOST(ikp,mzp)
583	Va__SV(ikp,mn) = Va___HOST(ikp,mzp)
584	END DO
585	END DO
586
587
588	! Initialization of SISVAT Variables
589	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
590	! **************
591	CALL PHY_SISVAT_INI
592	! **************
593
594
595	! Initialization of Mod_SISVAT_kkl (SISVAT OUTPUT Grid Points)
596	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
597	iwr = 0
598	DO ipt = 1,NbPts
599	IF (IOi0SV(ipt).EQ.0) THEN
600	IOi_SV(ipt)=i_x0
601	ELSE
602	IOi_SV(ipt)=IOi0SV(ipt)
603	END IF
604	IF (IOj0SV(ipt).EQ.0) THEN
605	IOj_SV(ipt)=j_y0
606	ELSE
607	IOj_SV(ipt)=IOj0SV(ipt)
608	END IF
609	write(6,*) 'ipt , IOi_SV, IOj_SV = ' &
610	& ,ipt , IOi_SV(ipt), IOj_SV(ipt)
611	DO n = 1,mwp
612	iwr = 1+iwr
613	IF (iwr.LE.nbwri) THEN
614	no__SV(iwr) = 0
615	i___SV(iwr) = IOi_SV(ipt)
616	j___SV(iwr) = IOj_SV(ipt)
617	n___SV(iwr) = n
618	write(6,*) 'n , i___SV, j___SV, n___SV, iwr = ' &
619	& ,n , i___SV(iwr), j___SV(iwr), n___SV(iwr), iwr
620	END IF
621	END DO
622	END DO
623
624
625
626	! -----------------------------------------------------------------------------!
627	! Initialization of Atm_RT (Radiative Transfert through the Atmosphere)
628	! -------------------------
629
630	!gilles: PHY_Atm_RT_INI requires correct dates
631	YearTU = Year_H
632	Mon_TU = Mon__H
633	Day_TU = Day__H
634	HourTU = Hour_H
635	minuTU = minu_H
636	sec_TU = sec__H
637
638	! **************
639	CALL PHY_Atm_RT_INI
640	! **************
641
642	! -----------------------------------------------------------------------------!
643	! Initialization of Atm_AT (Turbulent Transfert through the Atmosphere)
644	! -------------------------
645
646	! **************
647	CALL PHY_Atm_AT_INI(FlagAT_TKE,TypeAT)
648	! **************
649
650
651
652	! -----------------------------------------------------------------------------!
653	! Initialization of Atm_CP (Convectiv Transfert through the Atmosphere)
654	! -------------------------
655
656	! **************
657	CALL PHY_Atm_CP_INI(mzp,kcolp)
658	! **************
659
660
661
662	! -----------------------------------------------------------------------------!
663	! Initialization of CMiPhy (Cloud Microphysical Scheme)
664	! -------------------------
665
666	! Initialization of Mod_PHY_CM_ctr (CMiPhy Switches
667	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ & Time/Space control Variables)
668	CM_UpD = FlagCM_UpD
669
670	! **************
671	CALL PHY_Atm_CM_INI
672	! **************
673
674	END IF
675
676
677	! Martin CONTROL
678	!PRINT*, 'Impressions control'
679	!call iophys_ecrit('TA__DY_surf',1,'surface temperature','K',Ta__DY(:,61))
680	!call iophys_ecrit('TA__DY_air',60,'air temperature','K',Ta__DY(:,1:60))
681
682	!PRINT*,'TA__DY(:,61)=',TA__DY(kcolq/2,61)
683
684	! Interface: From HOST Model Variables to MARp Physics Variables
685	! ==============================================================
686
687
688	! Time
689	! ----
690
691	YearTU = Year_H
692	Mon_TU = Mon__H
693	Day_TU = Day__H
694	HourTU = Hour_H
695	minuTU = minu_H
696	sec_TU = sec__H
697
698	TimeTU = (float(351)+(float(YearTU) -float(1902)) *float(365)&! Nb Days before YearTU
699	& +(float(YearTU) -float(1901)) /float( 4)&! Nb Leap Years
700	& + float(njYear(Mon_TU)) &! Nb Days before Mon_TU
701	& + float(njLeap(Mon_TU)) &! (including Leap Day)
702	& *max(zer0,un_1-mod(float(YearTU),float(4))) &!
703	& + float(Day_TU)-float(1) ) *float( 24)&!
704	& +float(HourTU) &!
705	& + (float(minuTU) *float(60) +float(sec_TU))/3600. !
706
707
708
709	! -----------------------------------------------------------------------------!
710	! Assignation of Mod_PHY_AT_grd
711	! ---------------------------------
712	IF (it_RUN .EQ. 1) THEN
713	TimeAT = TimeTU-dt0_AT/3600. ! Initialisation à la première itération
714	END IF
715	IF (FlagAT .AND. mod(it_RUN-1,jt__AT).EQ.0) THEN
716	!gilles: leapfrog scheme stops time integration regularly
717	! dTimAT = (TimeTU-TimeAT) * 3600.
718	dTimAT = dt0_AT
719	TimeAT = TimeTU
720	END IF
721
722	! Martin CONTROL
723	PRINT*,'CONTROL PHY_MAR temps'
724	PRINT*,' Year_H =', Year_H
725	PRINT*,' Mon__H =', Mon__H
726	PRINT*,' Day__H =', Day__H
727	PRINT*,' Hour_H =', Hour_H
728	PRINT*,' minu_H =', minu_H
729	PRINT*,' sec__H =', sec__H
730	PRINT*,'jt__AT=',jt__AT
731	PRINT*,'TimeTU=',TimeTU
732	PRINT*,'TimeAT=',TimeAT
733	PRINT*,'dTimAT=',dTimAT
734	! Martin CONTROL
735
736
737	! -----------------------------------------------------------------------------!
738	! Assignation of Mod_PHY_DY_kkl
739	! ---------------------------------
740
741	DO ikl=1,kcolp
742	i = ii__AP(ikl)
743	j = jj__AP(ikl)
744	k = mzpp
745	ExnrDY (ikl,k) = exp(RCp log(psa__HOST(ikl)sigma(k)+pt__DY))
746	pkt_DY (ikl,k) = pkta_HOST(ikl,k)
747	Ta__DY (ikl,k) = pkta_HOST(ikl,k) * ExnrDY(ikl,k)
748	! CAUTION: Tas_SV_xy is not allowed to be changed by data coming from outside this routine
749	Z___DY (ikl,k) = gZa__HOST(ikl,k) *Grav_I
750	ZmidDY (ikl,k) = gZam_HOST(ikl,k) *Grav_I
751	qv__DY (ikl,k) = qv___HOST(ikl,k)
752
753	DO k = 1,mzp
754	ExnrDY (ikl,k) = exp(RCp log(psa__HOST(ikl)sigma(k )+pt__DY))
755	pkt_DY (ikl,k) = pkta_HOST(ikl,k)
756	Ta__DY (ikl,k) = pkta_HOST(ikl,k) * ExnrDY(ikl,k)
757	roa_DY (ikl,k) = (psa__HOST(ikl)*sigma(k )+pt__DY) &
758	& /(Ta__DY (ikl,k) *R_DAir)
759	roamDY (ikl,k) = (psa__HOST(ikl)*sigmi(k+1)+pt__DY) &
760	& /(Ta__DY (ikl,k) *R_DAir)
761	Z___DY (ikl,k) = gZa__HOST(ikl,k) *Grav_I
762	ZmidDY (ikl,k) = gZam_HOST(ikl,k) *Grav_I
763	qv__DY (ikl,k) = qv___HOST(ikl,k)
764
765
766
767	! -----------------------------------------------------------------------------!
768	! Assignation of Mod_PHY_AT_kkl
769	! ---------------------------------
770
771
772	IF (FlagAT.AND.it_EXP.GT.1.AND.mod(it_RUN-1,jt__AT).EQ.0) THEN
773	TKE_AT (ikl,k) = TKE__HOST(ikl,k)
774	eps_AT (ikl,k) = eps__HOST(ikl,k)
775	TrT_AT (ikl,k) = (TKE_AT (ikl,k) - TrT_AT (ikl,k)) &
776	& / dTimAT
777	END IF
778
779
780
781	! -----------------------------------------------------------------------------!
782	! Assignation of Mod_PHY_CM_kkl
783	! ---------------------------------
784
785	IF (FlagCM.AND.it_EXP.GT.1.AND.mod(it_RUN-1,jt__CM).EQ.0) THEN
786
787	! IF (qw___HOST(ikl,k).LT.qh_MIN) THEN
788	! qv__DY(ikl,k) = qv__DY(ikl,k) + qw__CM(ikl,k)
789	! qw__CM(ikl,k) = 0.
790	! #cw CCNwCM(ikl,k) = 0.
791	! ELSE
792	qw__CM(ikl,k) = qw___HOST(ikl,k)
793	! #cw CCNwCM(ikl,k) = CCN__HOST(ikl,k)
794	! END IF
795
796	! IF (qi___HOST(ikl,k).LT.qh_MIN) THEN
797	! qv__DY(ikl,k) = qv__DY(ikl,k) + qi__CM(ikl,k)
798	! qi__CM(ikl,k) = 0.
799	! CCNiCM(ikl,k) = 0.
800	! ELSE
801	qi__CM(ikl,k) = qi___HOST(ikl,k)
802	CCNiCM(ikl,k) = CIN__HOST(ikl,k)
803	! END IF
804
805	! Gilles: CF___HOST non sauve & CFraCM reinitialise ici
806	! CFraCM(ikl,k) = CF___HOST(ikl,k)
807
808	! IF (qw__CM(ikl,k).LT.qh_MIN .AND. &
809	! & qi__CM(ikl,k).LT.qh_MIN) THEN
810	! CFraCM(ikl,k) = 0.
811	! ELSE
812	! CFraCM(ikl,k) = max(CFrMIN,CF___HOST(ikl,k))
813	! END IF
814
815	qs__CM(ikl,k) = qs___HOST(ikl,k)
816	qr__CM(ikl,k) = qr___HOST(ikl,k)
817	END IF
818
819	ENDDO
820
821
822
823	! -----------------------------------------------------------------------------!
824	! Assignation of Mod_SISVAT_gpt (A-O FORCING OR COUPLING)
825	! ---------------------------------
826
827	sst_SB (ikl) = sst__HOST(ikl)
828	! #IP sif_SB (ikl) = sif__HOST(ikl)
829	! #AO DO k = 1,mwp
830	! #AO s_T_AO_xyn(i,j,k) = s_T__HOST(ikl,k)
831	! #AO Alb_AO_xyn(i,j,k) = Alb__HOST(ikl,k)
832	! #AO ENDDO
833
834	ENDDO
835
836	! -----------------------------------------------------------------------------!
837	! Assignation of Mod_PHY_DY_kkl
838	! ---------------------------------
839	DO ikl = 1,kcolp
840	i = ii__AP(ikl)
841	j = jj__AP(ikl)
842	psa_DY(ikl) = psa__HOST(ikl)
843	DO k = 1,mzp
844	WindDY(ikl,k) = Wind_HOST(ikl,k)
845	ua__DY(ikl,k) = Ua___HOST(ikl,k)
846	va__DY(ikl,k) = va___HOST(ikl,k)
847	wa__DY(ikl,k) = Wa___HOST(ikl,k) + sqrt(2.*max(eps6,TKE_AT(ikl,k))/3.)
848	END DO
849	END DO
850
851	! **************
852	CALL PHY_Atm_DY_RUN ! Assignation of MAR Dyn. Variables
853	! **************
854
855	IF(FlagVR) THEN
856	! **************
857	CALL PHY________OUT('After PHY_Atm_DY_RUN ')
858	! ************** 12345678901234567890123456789012345678901234567890
859	! 1 2 3 4 5
860	END IF
861
862
863
864	! -----------------------------------------------------------------------------!
865	! Saturation Specific Humidity
866	! ----------------------------
867
868	IF (FlagCM .OR. &! ***************
869	& FlagSV) CALL PHY_Atm_CM_QSat
870	! ***************
871
872
873
874	! -----------------------------------------------------------------------------!
875	! Execution of Atm_S0 (Insolation and cos of Sun Zenithal Distance)
876	! -------------------------
877
878	! **************
879	CALL PHY_Atm_S0_RUN
880	! **************
881
882	IF(FlagVR) THEN
883	! **************
884	CALL PHY________OUT('After PHY_Atm_S0_RUN ')
885	! ************** 12345678901234567890123456789012345678901234567890
886	! 1 2 3 4 5
887	END IF
888
889
890
891	! -----------------------------------------------------------------------------!
892	! Execution of Atm_RT (Radiative Transfer through the Atmosphere)
893	! -------------------------
894
895	IF (FlagRT .AND. mod(it_RUN-1,jt__RT).EQ.0) THEN
896
897	! **************
898	CALL PHY_Atm_RT_RUN(kcolp,ikl0)
899	! **************
900
901	IF(FlagVR) THEN
902	! **************
903	CALL PHY________OUT('After PHY_Atm_RT_RUN ')
904	! ************** 12345678901234567890123456789012345678901234567890
905	! 1 2 3 4 5
906	END IF
907	END IF
908
909
910
911	! -----------------------------------------------------------------------------!
912	! Execution of SISVAT (Soil-Ice-Snow-Vegetation-Atmosphere-Transfer Scheme)
913	! -------------------------
914
915	IF (FlagSV) THEN
916
917	! Assignation of Mod_SISVAT_kkl (from INPUT from HOST Model)
918	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
919	DO ikp = 1,kcolp
920	DO mn = 1,mwp
921	pkPaSV(ikp,mn) = psa__HOST(ikp) +pt__DY
922	ExnrSV(ikp,mn) = exp(RCp log(psa__HOST(ikp)sigma(mzp)+pt__DY))
923	DO k = 1,mzp
924	kk = mzpp - k
925	WindSV(ikp,mn,k) = Wind_HOST(ikp,k)
926	pkt0SV(ikp,mn,kk)= pkta_HOST(ikp,k)
927	qv__SV(ikp,mn,kk)= qv___HOST(ikp,k)
928	zza_SV(ikp,mn,kk)= (gZa__HOST(ikp,k) & !
929	& -gZa__HOST(ikp,mzpp)) *Grav_I !
930	roa_SV(ikp,mn,kk)= roa_DY (ikp,k) * 1.e3 ! [kg/m3]
931	END DO
932	Ua__SV(ikp,mn) = Ua___HOST(ikp,mzp)
933	Va__SV(ikp,mn) = Va___HOST(ikp,mzp)
934	TaT_SV(ikp,mn) = pkta_HOST(ikp,mzp) * ExnrSV(ikp,mn)
935	END DO
936	END DO
937
938
939	! **************
940	CALL PHY_SISVAT_RUN( &
941	! **************
942	! -----------------------------------------------------------------------------!
943	! #TC& qxTC,uqTC ,qsTC , & ! Aerosols: Atm.Conc., Surf.Flux
944	! -----------------------------------------------------------------------------!
945	& )
946
947	IF(FlagVR) THEN
948	! **************
949	CALL PHY________OUT('After PHY_SISVAT_RUN ')
950	! ************** 12345678901234567890123456789012345678901234567890
951	! 1 2 3 4 5
952	END IF
953	END IF
954
955
956
957	! -----------------------------------------------------------------------------!
958	! Execution of Atm_AT (Atmospheric Turbulence Contribution)
959	! -------------------------
960
961	IF (FlagAT .AND. mod(it_RUN-1,jt__AT).EQ.0) THEN
962
963	! **************
964	CALL PHY_Atm_AT_RUN(FlagSV_KzT,FlagCM)
965	! **************
966
967	IF(FlagVR) THEN
968	! **************
969	CALL PHY________OUT('After PHY_Atm_AT_RUN ')
970	! ************** 12345678901234567890123456789012345678901234567890
971	! 1 2 3 4 5
972	END IF
973	END IF
974
975
976
977	! -----------------------------------------------------------------------------!
978	! Execution of Atm_CP (Convection Parameterisation - Mass Flux Scheme)
979	! -------------------------
980
981	IF (FlagCP .AND. mod(it_RUN-1,jt__CP).EQ.0) THEN
982
983	! **************
984	CALL PHY_Atm_CP_RUN(mzp,kcolp)
985	! CALL PHY_Atm_CP_RUN(mxp,kcolp) ! ancien bug
986	! **************
987
988	IF(FlagVR) THEN
989	! **************
990	CALL PHY________OUT('After PHY_Atm_CP_RUN ')
991	! ************** 12345678901234567890123456789012345678901234567890
992	! 1 2 3 4 5
993	END IF
994	END IF
995
996
997
998	! -----------------------------------------------------------------------------!
999	! Execution of Atm_CM (Cloud Microphysics)
1000	! -------------------------
1001
1002	IF (FlagCM .AND. mod(it_RUN-1,jt__CM).EQ.0) THEN
1003
1004	! **************
1005	CALL PHY_Atm_CM_RUN
1006	! **************
1007
1008
1009	IF(FlagVR) THEN
1010	! **************
1011	CALL PHY________OUT('After PHY_Atm_CM_RUN ')
1012	! ************** 12345678901234567890123456789012345678901234567890
1013	! 1 2 3 4 5
1014	END IF
1015	END IF
1016
1017
1018
1019
1020	! Assignation of the Tendencies to transfer outside the physical Parameterizations Package
1021	! ========================================================================================
1022
1023	DO ikl=1,kcolp
1024	i = ii__AP(ikl)
1025	j = jj__AP(ikl)
1026
1027
1028
1029	! -----------------------------------------------------------------------------!
1030	! Reinitialization of the Tendencies
1031	! ----------------------------------
1032
1033	DO k= 1,mzp
1034
1035	dpkt___dt(ikl,k) = 0.0 !
1036	dua____dt(ikl,k) = 0.0 !
1037	dva____dt(ikl,k) = 0.0 !
1038	dqv____dt(ikl,k) = 0.0 !
1039	dqw____dt(ikl,k) = 0.0 !
1040	dCF____dt(ikl,k) = 0.0 !
1041	dqi____dt(ikl,k) = 0.0 !
1042	dCi____dt(ikl,k) = 0.0 !
1043	dqs____dt(ikl,k) = 0.0 !
1044	dqr____dt(ikl,k) = 0.0 !
1045
1046
1047
1048	! -----------------------------------------------------------------------------!
1049	! Tendencies from SISVAT
1050	! ----------------------
1051
1052	IF (FlagSV .AND. mod(it_RUN-1,jt__SV).EQ.0) THEN!
1053	dpktSV_dt(ikl,k) = dpktSV_gpt(ikl,k) ! Reduced Potential Temperature TENDENCY, SISVAT [KX/s]
1054	END IF
1055
1056	! Update of the tendencies
1057	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1058	IF (FlagSV) THEN!
1059	dpkt___dt(ikl,k) = dpkt___dt(ikl,k) + dpktSV_gpt(ikl,k) !
1060	END IF
1061
1062
1063
1064	! -----------------------------------------------------------------------------!
1065	! Tendencies from Atm_AT
1066	! ----------------------
1067
1068	IF (FlagAT .AND. mod(it_RUN-1,jt__AT).EQ.0) THEN!
1069	dua____dt(ikl,k) = dua_AT(ikl,k) ! Wind Speed (x-direc.) TENDENCY, ALL Contribut.[m/s2]
1070	dva____dt(ikl,k) = dva_AT(ikl,k) ! Wind Speed (y-direc.) TENDENCY, ALL Contribut.[m/s2]
1071	dpktAT_dt(ikl,k) = dpktAT(ikl,k) ! Reduced Potential Temperature TENDENCY, Atm_AT [KX/s]
1072	dqv_AT_dt(ikl,k) = dqv_AT(ikl,k) ! Specific Humidity TENDENCY, Atm_AT [kg/kg/s]
1073	dqw_AT_dt(ikl,k) = dqw_AT(ikl,k) ! Cloud Droplets Concentration TENDENCY, Atm_AT [kg/kg/s]
1074	dqi_AT_dt(ikl,k) = dqi_AT(ikl,k) ! Cloud Crystals Concentration TENDENCY, Atm_AT [kg/kg/s]
1075	dqs_AT_dt(ikl,k) = dqs_AT(ikl,k) ! Snow Particles Concentration TENDENCY, Atm_AT [kg/kg/s]
1076	dqr_AT_dt(ikl,k) = dqr_AT(ikl,k) ! Rain Drops Concentration TENDENCY, Atm_AT [kg/kg/s]
1077	! #cw dCw_AT_dt(ikl,k) = dCW_AT(ikl,k) ! CCN Concentration TENDENCY, Atm_AT [1/s]
1078	dCi_AT_dt(ikl,k) = dCi_AT(ikl,k) ! CIN Concentration TENDENCY, Atm_AT [1/s]
1079
1080	! NO Tendencies on TKE and its dissipation ==> TKE__HOST and eps__HOST are updated
1081	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1082	TKE__HOST(ikl,k) = TKE_AT(ikl,k) !
1083	eps__HOST(ikl,k) = eps_AT(ikl,k) !
1084
1085	! Re-Initialization of the TKE Transport Rate
1086	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1087	TrT_AT (ikl,k) = TKE_AT(ikl,k) !
1088	END IF
1089
1090	! Update of the tendencies
1091	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1092	IF (FlagAT) THEN!
1093	dpkt___dt(ikl,k) = dpkt___dt(ikl,k) + dpktAT(ikl,k) !
1094	dqv____dt(ikl,k) = dqv____dt(ikl,k) + dqv_AT(ikl,k) !
1095	dqw____dt(ikl,k) = dqw____dt(ikl,k) + dqw_AT(ikl,k) !
1096	dqi____dt(ikl,k) = dqi____dt(ikl,k) + dqi_AT(ikl,k) !
1097	dqs____dt(ikl,k) = dqs____dt(ikl,k) + dqs_AT(ikl,k) !
1098	dqr____dt(ikl,k) = dqr____dt(ikl,k) + dqr_AT(ikl,k) !
1099	! #cw dCw____dt(ikl,k) = dCw____dt(ikl,k) + dCw_AT(ikl,k) !
1100	dCi____dt(ikl,k) = dCi____dt(ikl,k) + dCi_AT(ikl,k) !
1101	END IF
1102
1103
1104
1105	! -----------------------------------------------------------------------------!
1106	! Tendencies from CMiPhy (dqw_CM, dCw_CM, dqi_CM, dCi_CM
1107	! ---------------------- dqs_CM, dqr_CM are consumed in CMiPhy then reset to 0
1108	! if FlagCM_UpD = .TRUE. )
1109
1110	IF (FlagCM .AND. mod(it_RUN-1,jt__CM).EQ.0) THEN!
1111	dpktCM_dt(ikl,k) = dpktCM(ikl,k) ! Reduced Potential Temperature TENDENCY, CMiPhy [KX/s]
1112	dqv_CM_dt(ikl,k) = dqv_CM(ikl,k) ! Specific Humidity TENDENCY, CMiPhy [kg/kg/s]
1113	dqw_CM_dt(ikl,k) = dqw_CM(ikl,k) ! Cloud Droplets Concentration TENDENCY, CMiPhy [kg/kg/s]
1114	dCF_CM_dt(ikl,k) = dCF_CM(ikl,k) ! Cloud Fraction TENDENCY, CMiPhy [kg/kg/s]
1115	dqi_CM_dt(ikl,k) = dqi_CM(ikl,k) ! Cloud Crystals Concentration TENDENCY, CMiPhy [kg/kg/s]
1116	dqs_CM_dt(ikl,k) = dqs_CM(ikl,k) ! Snow Particles Concentration TENDENCY, CMiPhy [kg/kg/s]
1117	dqr_CM_dt(ikl,k) = dqr_CM(ikl,k) ! Rain Drops Concentration TENDENCY, CMiPhy [kg/kg/s]
1118	! #cw dCw_CM_dt(ikl,k) = dCW_CM(ikl,k) ! CCN Concentration TENDENCY, CMiPhy [1/s]
1119	dCi_CM_dt(ikl,k) = dCi_CM(ikl,k) ! CIN Concentration TENDENCY, CMiPhy [1/s]
1120	END IF
1121
1122	! Update of the tendencies
1123	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1124	IF (FlagCM) THEN!
1125	dpkt___dt(ikl,k) = dpkt___dt(ikl,k) + dpktCM(ikl,k) !
1126	dqv____dt(ikl,k) = dqv____dt(ikl,k) + dqv_CM(ikl,k) !
1127	dqw____dt(ikl,k) = dqw____dt(ikl,k) + dqw_CM(ikl,k) !
1128	dCF____dt(ikl,k) = dCF____dt(ikl,k) + dCF_CM(ikl,k) !
1129	dqi____dt(ikl,k) = dqi____dt(ikl,k) + dqi_CM(ikl,k) !
1130	dqs____dt(ikl,k) = dqs____dt(ikl,k) + dqs_CM(ikl,k) !
1131	dqr____dt(ikl,k) = dqr____dt(ikl,k) + dqr_CM(ikl,k) !
1132	! #cw dCw____dt(ikl,k) = dCw____dt(ikl,k) + dCw_CM(ikl,k) !
1133	dCi____dt(ikl,k) = dCi____dt(ikl,k) + dCi_CM(ikl,k) !
1134	END IF
1135
1136
1137
1138	! -----------------------------------------------------------------------------!
1139	! Tendencies from CVAmnh
1140	! ----------------------
1141
1142	IF (FlagCP .AND. mod(it_RUN-1,jt__CP).EQ.0) THEN!
1143	dpktCP_dt(ikl,k) = dpktCP(ikl,k) ! Reduced Potential Temperature TENDENCY, CVAmnh [KX/s]
1144	dqv_CP_dt(ikl,k) = dqv_CP(ikl,k) ! Specific Humidity TENDENCY, CVAmnh [kg/kg/s]
1145	dqw_CP_dt(ikl,k) = dqw_CP(ikl,k) ! Cloud Droplets Concentration TENDENCY, CVAmnh [kg/kg/s]
1146	dqi_CP_dt(ikl,k) = dqi_CP(ikl,k) ! Cloud Crystals Concentration TENDENCY, CVAmnh [kg/kg/s]
1147	END IF
1148
1149	! Update of the tendencies
1150	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1151	IF (FlagCP) THEN!
1152	dpkt___dt(ikl,k) = dpkt___dt(ikl,k) + dpktCP(ikl,k) !
1153	dqv____dt(ikl,k) = dqv____dt(ikl,k) + dqv_CP(ikl,k) !
1154	dqw____dt(ikl,k) = dqw____dt(ikl,k) + dqw_CP(ikl,k) !
1155	dqi____dt(ikl,k) = dqi____dt(ikl,k) + dqi_CP(ikl,k) !
1156	END IF
1157
1158
1159
1160	! -----------------------------------------------------------------------------!
1161	! Tendencies from radCEP
1162	! ----------------------
1163
1164	IF (FlagRT .AND. mod(it_RUN-1,jt__RT).EQ.0) THEN!
1165	dpktRT_dt(ikl,k) = dpktRT(ikl,k) ! Reduced Potential Temperature TENDENCY, radCEP [KX/s]
1166	END IF
1167
1168	! Update of the tendencies
1169	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1170	IF (FlagRT) THEN!
1171	dpkt___dt(ikl,k) = dpkt___dt(ikl,k) + dpktRT(ikl,k) !
1172	END IF
1173
1174	ENDDO
1175
1176
1177
1178
1179
1180	! Assignation of the Variables to keep inside the Physical Parameterizations Package
1181	! ========================================================================================
1182
1183	! ... NOTHING up to now
1184
1185
1186
1187	! Assignation of the Variables to transfer outside the Physical Parameterizations Package
1188	! ========================================================================================
1189
1190	! -----------------------------------------------------------------------------!
1191	! Update of pkta_HOST, qv___HOST
1192	! -------------------------------
1193
1194	DO k=1,mzpp
1195	pkta_HOST(ikl,k) = pkt_DY(ikl,k) ! Always on k=mzpp, possible from 1 to mzp (with dpkt = 0.)
1196	qv___HOST(ikl,k) = qv__DY(ikl,k) !
1197	ENDDO
1198
1199
1200
1201	! -----------------------------------------------------------------------------!
1202	! Update of qw___HOST, CF___HOST, qi___HOST, CIN__HOST, qs___HOST, qr___HOST
1203	! ---------------------------------------------------------------------------
1204
1205	IF (FlagCM) THEN
1206	DO k=1,mzp
1207	qw___HOST(ikl,k) = qw__CM(ikl,k)
1208	! #cw CCN__HOST(ikl,k) = CCNwCM(ikl,k)
1209	CF___HOST(ikl,k) = CFraCM(ikl,k)
1210	qi___HOST(ikl,k) = qi__CM(ikl,k)
1211	CIN__HOST(ikl,k) = CCNiCM(ikl,k)
1212	qs___HOST(ikl,k) = qs__CM(ikl,k)
1213	qr___HOST(ikl,k) = qr__CM(ikl,k)
1214	ENDDO
1215	END IF
1216
1217
1218
1219	! -----------------------------------------------------------------------------!
1220	! Update of d(S,LH)/dT (needed in NEMO)
1221	! ---------------------
1222
1223	! #AO DO k=1,mwpp
1224	! #AO dSdT2HOST(ikl,k) = dSdTAO_xyn(i,j,k)
1225	! #AO dLdT2HOST(ikl,k) = dLdTAO_xyn(i,j,k)
1226	! #AO ENDDO
1227
1228
1229
1230	ENDDO
1231
1232
1233
1234
1235	! OUTPUT
1236	! ======
1237
1238	! OUTPUT of Tendencies
1239	! --------------------
1240
1241	IF (FlagVR .OR. &
1242	& (FLAG_O .AND. ((minuTU.EQ.0 .AND. sec_TU.EQ.0) .OR. &
1243	& it_RUN.EQ.1 ))) THEN
1244	ikl = ikl0
1245	i = ii__AP(ikl)
1246	j = jj__AP(ikl)
1247
1248	! pkt TENDENCIES
1249	! ~~~~~~~~~~~~~~
1250	write(4,400)
1251	400 format(//,' pkt TENDENCIES',/,' **************'/,1x)
1252	write(4,403) Day_TU,Mon_TU,YearTU,HourTU,MinuTU,Sec_TU,it_EXP
1253	403 format(3x,2(i2,'-'),i4,4x,3(i2,'-'),' Simulation Iteration No ',i6,/,1x)
1254	write(4,404)
1255	write(4,401)
1256	401 format(' \| SISVAT \| Atm_AT \| CMiPhy \| CVAmnh \| radCEP \|')
1257	write(4,402)
1258	402 format(' \| [K/d] \| [K/d] \| [K/d] \| [K/d] \| [K/d] \|')
1259	write(4,404)
1260	404 format(4('-'),'+',5(13('-'),'+'))
1261	DO k=1,mzp
1262	write(4,405) k &
1263	& , ExnrDY(ikl,k)dpktSV_gpt(ikl,k)86400. &
1264	& , ExnrDY(ikl,k)dpktAT (ikl,k)86400. &
1265	& , ExnrDY(ikl,k)dpktCM (ikl,k)86400. &
1266	& , ExnrDY(ikl,k)dpktCP (ikl,k)86400. &
1267	& , ExnrDY(ikl,k)dpktRT (ikl,k)86400.
1268	405 format(i3,' \|',5(f12.6,' \|'))
1269
1270	IF (mod(k,20).EQ.0) THEN
1271	write(4,404)
1272	write(4,401)
1273	write(4,402)
1274	write(4,404)
1275	END IF
1276	ENDDO
1277	write(4,404)
1278
1279	! pkt TENDENCIES
1280	! ~~~~~~~~~~~~~~
1281	write(4,410)
1282	410 format(//,' Qv TENDENCIES',/,' **************'/,1x)
1283	write(4,403) Day_TU,Mon_TU,YearTU,HourTU,MinuTU,Sec_TU,it_EXP
1284	!403 format(3x,2(i2,'-'),i4,4x,3(i2,'-'),' Simulation Iteration No ',i6,/,1x)
1285	write(4,404)
1286	write(4,411)
1287	411 format(' \| SISVAT \| Atm_AT \| CMiPhy \| CVAmnh \| TOTAL \|')
1288	write(4,412)
1289	412 format(' \| [g/kg/min] \| [g/kg/min] \| [g/kg/min] \| [g/kg/min] \| [g/kg/min] \|')
1290	write(4,404)
1291	!404 format(4('-'),'+',5(13('-'),'+'))
1292	DO k=1,mzp
1293	write(4,415) k &
1294	& , dqv_AT (ikl,k)*60000. &
1295	& , dqv_CM (ikl,k)*60000. &
1296	& , dqv_CP (ikl,k)*60000. &
1297	& , dqv____dt(ikl,k)*60000.
1298	415 format(i3,' \|',12x,' \|',4(f12.6,' \|'))
1299
1300	IF (mod(k,20).EQ.0) THEN
1301	write(4,404)
1302	write(4,411)
1303	write(4,412)
1304	write(4,404)
1305	END IF
1306	ENDDO
1307	write(4,404)
1308	END IF
1309
1310	IF (FLAG_O .AND. ((minuTU.EQ.0 .AND. sec_TU.EQ.0) .OR. &
1311	& it_RUN.EQ.1 )) THEN
1312
1313	! **************
1314	CALL PHY________OUT('After PHY_MAR ')
1315	! ************** 12345678901234567890123456789012345678901234567890
1316	! 1 2 3 4 5
1317	END IF
1318
1319
1320
1321	return
1322	end

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format