Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

PHY_SISVAT_RUN.f90 @ 5434

Last change on this file since 5434 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: 54.4 KB

Line
1	subroutine PHY_SISVAT_RUN( &
2	!------------------------------------------------------------------------------+
3	! \|
4	! SubRoutine PHY_SISVAT_RUN interfaces 3d-grid Wed 26-Jun-2013 MAR \|
5	! with SISVAT 2d-grid \|
6	! SISVAT as Soil \|
7	! Ice \|
8	! Snow \|
9	! Vegetation \|
10	! Atmosphere \|
11	! Transfer Scheme \|
12	! \|
13	! version 3.p.4.1 created by H. Gallee, Tue 26-Feb-2013 \|
14	! Last Modification by H. Gallee, Wed 26-Jun-2013 \|
15	! \|
16	!------------------------------------------------------------------------------+
17	! #TC& qxTC,uqTC ,qsTC , & ! Aerosols: Atm.Conc., Surf.Flux
18	& )
19
20	!------------------------------------------------------------------------------+
21	! \|
22	! INPUT: it_RUN: Run Iterations Counter \|
23	! ^^^^^ \|
24	! \|
25	! INPUT (via module Mod_SISVAT_ctr) \|
26	! ^^^^^ VegMod: SISVAT is set up when .T. \|
27	! SnoMod: Snow Pack is set up when .T. \|
28	! inpSBC: Update Bound.Condit.when .T. \|
29	! \|
30	! INPUT (via common block) \|
31	! ^^^^^ xxxxTV: SISVAT/MAR interfacing variables \|
32	! \|
33	! Preprocessing Option: SISVAT PHYSICS \|
34	! ^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^ \|
35	! # #SN: Snow Model \|
36	! # #GP LAI and GLF Variations not specified \|
37	! # #OP SST is interactive \|
38	! \|
39	! # #DS: diffuse radiation differing from direct \|
40	! (variable RADsod must still be included) \|
41	! \|
42	! Preprocessing Option: SISVAT PHYSICS: Col de Porte \|
43	! ^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ \|
44	! # #CP: SBL, Col de Porte \|
45	! # #cp Solar Radiation, Col de Porte \|
46	! # #AG: Snow Ageing, Col de Porte \|
47	! \|
48	! \|
49	! Preprocessing Option: STANDARD Possibility \|
50	! ^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^ \|
51	! #HY: Explicit Cloud MICROPHYSICS may be turned ON \|
52	! #BS: Explicit Cloud MICROPHYSICS: Blow. *(Snow) Model) \|
53	! #SI: SISVAT: Sea-Ice Fraction calculated from prescribed SST \|
54	! #IP: SISVAT: Sea-Ice Fraction prescribed from SMMR and SSM/I \|
55	! #SN: SNOW Model may be turned ON \|
56	! #AO: COUPLING with NEMO Ocean-Sea-Ice Model using OASIS \|
57	! #AE: TURBULENCE: Aerosols Erosion / Turbulent Diffusion Coeff. \|
58	! #BD: TraCer Aeolian Erosion Submodel is turned ON \|
59	! #OR: SBL: Orography Roughness included from z0__SV (MARdom) \|
60	! #SZ: SBL: Mom.: Roughn.Length= F(u*) Andreas &al.(1995) Snow \|
61	! #ZM: SBL: M/H Roughn.Length: Box Moving Average (in Time) \|
62	! #IB: OUTPUT: Ice-Sheet Surface Mass Balance (on NetCDF File ) \|
63	! #vL: PORTABILITY: Vectorization enhanced \|
64	! #vS: PORTABILITY: Vectorization enhanced: Snow Model * \|
65	! #vD: PORTABILITY: Vectorization enhanced: Blowing Dust . \|
66	! #vZ: PORTABILITY: Vectorization enhanced: Av.Roughness Length \|
67	! #AA TURBULENCE: SBL Time Mean (BOX Moving Average) \|
68	! #AW TURBULENCE: Wind Time Mean (BOX Moving Average) \|
69	! #AH TURBULENCE: Ta-T Time Mean (BOX Moving Average) \|
70	! \|
71	! \|
72	! Preprocessing Option: OBSOLETE \|
73	! ^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^ \|
74	! #AM TURBULENCE: u* Time Mean (BOX Moving Average) \|
75	! #AT TURBULENCE: uT Time Mean (BOX Moving Average) \|
76	! #AS TURBULENCE: us Time Mean (BOX Moving Average) \|
77	! \|
78	! \|
79	! Preprocessing Option: \|
80	! ^^^^^^^^^^^^^^^^^^^^^ \|
81	! #TC: TraCer Advection-Diffusion Equation is turned ON \|
82	! #CM: Update Green Leaf Fraction may be performed (in routine INIglf) \|
83	! #VM: TURBULENCE: Ua minimum is prescribed \|
84	! #GP: Soil /Vegetation Model: LAI, GLF Variations NOT prescrib. \|
85	! #OP: SISVAT: Interactive Sea Surface Temperature turned ON \|
86	! #op: SISVAT: SST Nudging --> prescribed values turned ON \|
87	! #RE: SISVAT: SST Condition modified by epsilon \|
88	! #PO: POLYNYA Model may be turned ON \|
89	! \|
90	! \|
91	! Preprocessing Option: SISVAT IO (not always a standard preprocess.) \|
92	! ^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^ \|
93	! FILE \| CONTENT \|
94	! ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ \|
95	! # SISVAT_iii_jjj_n \| #e0: OUTPUT on ASCII File (SISVAT Variables) \|
96	! # \|(#e0 MUST BE PREPROCESSED BEFORE #e1 & #e2 !) \|
97	! # SISVAT_iii_jjj_n \| #e1: OUTPUT/Verification: Energy Conservation \|
98	! # SISVAT_iii_jjj_n \| #e2: OUTPUT/Verification: Energy Consrv.2e pt. \|
99	! \| (no premature stop) \|
100	! # SISVAT_iii_jjj_n \| #e3: OUTPUT/Verification: Energy Consrv. (HL) \|
101	! # SISVAT_iii_jjj_n \| #e4: OUTPUT/Verification: Energy Consrv. (HLS) \|
102	! # SISVAT_iii_jjj_n \| #el: OUTPUT Format : Addition.Frame Line \|
103	! \| \|
104	! # SISVAT_iii_jjj_n \| #m0: OUTPUT/Verification: H2O Conservation \|
105	! # SISVAT_iii_jjj_n \| #m1: OUTPUT/Verification: * Mass Conservation \|
106	! # SISVAT_iii_jjj_n \| #m2: OUTPUT/Verification: SeaIce Conservation \|
107	! # stdout \| #mw: OUTPUT/Verification: H2O Conservation \|
108	! \| unit 6, SubRoutine SISVAT_qSo ONLY \|
109	! \| \|
110	! # SISVAT_iii_jjj_n \| #mb: OUTPUT/Verification: Blowing Snow \|
111	! \| SubRoutine PHY_SISVAT ONLY \|
112	! \| \|
113	! # SISVAT_zSn.vz \| #vz: OUTPUT/Verification: Snow Layers Agrega. \|
114	! \| unit 41, SubRoutine SISVAT_zSn ONLY \|
115	! # SISVAT_qSo.vw \| #vw: OUTPUT/Verif+Detail: H2O Conservation \|
116	! \| unit 42, SubRoutine SISVAT_qSo ONLY \|
117	! # SISVAT_qSn.vm \| #vm: OUTPUT/Verification: Energy/Water Budget \|
118	! \| unit 43, SubRoutine SISVAT_qSn ONLY \|
119	! # SISVAT_qSn.vu \| #vu: OUTPUT/Verification: Slush Parameteriz. \|
120	! \| unit 44, SubRoutine SISVAT_qSn ONLY \|
121	! # SISVAT_wEq.ve \| #ve: OUTPUT/Verification: Snow/Ice Water Eqv. \|
122	! \| unit 45, SubRoutine SISVAT_wEq ONLY \|
123	! # SnOptP____.va \| #va: OUTPUT/Verification: Albedo Parameteriz. \|
124	! \| unit 46, SubRoutine SnOptP ONLY \|
125	! # SISVAT_GSn.vp \| #vp: OUTPUT/Verification: Snow Properties \|
126	! \| unit 47, SubRoutines SISVAT_zSn, _GSn \|
127	! # PHY_SISVAT.v0 \| #v0: OUTPUT/Verification: DUMP \|
128	! \| unit 50, SubRoutine PHY_SISVAT ONLY \|
129	! \| \|
130	! # stdout \| #b0: OUTPUT of Snow Erosion Variables \|
131	! \| unit 6, SubRoutine SISVAT_BSn ONLY \|
132	! # stdout \| #b1: OUTPUT of Snow Erosion Turbulence \|
133	! \| unit 6, SubRoutine SISVATeSBL ONLY \|
134	! # stdout \| #b2: OUTPUT of Snow Erosion Turbulence (2) \|
135	! \| unit 6, SubRoutine SISVATeSBL ONLY \|
136	! \| \|
137	! # stdout \| #s0: OUTPUT of Snow Buffer Layer \|
138	! \| unit 6, SubRoutine SISVAT ONLY \|
139	! # stdout \| #s1: OUTPUT of Snow Layers Agregation \|
140	! \| unit 6, SubRoutine SISVAT_zSn, _zAg \|
141	! # stdout \| #s2: OUTPUT of SnowFall, Snow Buffer \|
142	! \| unit 6, SubRoutine SISVAT_BSn, _qSn \|
143	! # stdout \| #sb: OUTPUT/Verification: SISVAT_SBL \|
144	! \| unit 6, SubRoutine SISVAT_SBL ONLY \|
145	! # stdout \| #sd: OUTPUT/Verification: Snow Thinest Layer \|
146	! \| unit 6, SubRoutine SISVAT_zSn ONLY \|
147	! # stdout \| #sf: OUTPUT of SnowFall, Z0 and Drag Coeff. \|
148	! \| unit 6, SubRoutines PHY_SISVAT, SISVAT \|
149	! # stdout \| #sg: OUTPUT/Verification: Gravitational Front \|
150	! \| unit 6, SubRoutine SISVAT_qSo ONLY \|
151	! # stdout \| #sh: OUTPUT/Verification: SBL Turbulent Fluxes \|
152	! \| unit 6, SubRoutine PHY_SISVAT ONLY \|
153	! # stdout \| #si: OUTPUT of Sea Ice Fraction, Temperature \|
154	! \| unit 6, SubRoutine PHY_SISVAT ONLY \|
155	! # stdout \| #sm: OUTPUT/Verification: Mosaic Fractions Sum \|
156	! \| unit 6, SubRoutine PHY_SISVAT ONLY \|
157	! # stdout \| #so: OUTPUT/Verification: Soil Vertic.Discret. \|
158	! \| unit 6, SubRoutine SISVAT_ini ONLY \|
159	! # stdout \| #ss: OUTPUT of Blowing Snow Variables \|
160	! \| unit 6, SubRoutine SISVATeSBL ONLY \|
161	! # stdout \| #sz: OUTPUT of Roughness Length & Drag Coeff. \|
162	! \| unit 6, SubRoutine SISVAT ONLY \|
163	! \| \|
164	!------------------------------------------------------------------------------+
165
166
167	! Global Variables
168	! ================
169
170	use Mod_Real
171	use Mod_PHY____dat
172	use Mod_PHY____grd
173	use Mod_SISVAT_dim
174	use Mod_SISVAT_grd
175	use Mod_SISVAT_ctr
176	use Mod_SISVAT_gpt
177
178	use Mod_PHY_S0_dat
179	use Mod_PHY_S0_kkl
180	use Mod_PHY_RT_kkl
181	use Mod_PHY_DY_kkl
182	use Mod_PHY_AT_kkl
183	use Mod_PHY_CM_kkl
184
185
186	! INTERFACE Variables
187	! ===================
188
189	use Mod_SISVAT_dat
190	use Mod_SISVAT_dzS
191	use Mod_SISVAT_kkl
192	use Mod_SISVAT_loc
193	! #AW use Mod_SISVAT_xAW
194	! #AH use Mod_SISVAT_xAH
195	! #ZM use Mod_SISVAT_xZM
196	! #WL use Mod_SISVAT_xWL
197
198
199
200	IMPLICIT NONE
201
202
203
204	INTEGER ntrac
205	PARAMETER (ntrac=1)
206
207
208	! Tracers
209	! ^^^^^^^
210	! #TC real uqTC ( mx, my, ntrac) ! q* (Tracer)
211	! #TC real qsTC ( mx, my, ntrac) ! qSurf (Tracer)
212	! #TC real qxTC ( mx, my, mz,ntrac) ! q (Tracer)
213
214	! Auxiliary Variables
215	! ^^^^^^^^^^^^^^^^^^^
216	! #CM integer :: newglfSIS !
217	! #IP integer :: newsicSI !
218
219
220
221
222	! Internal Variables
223	! ===================
224
225	logical glfFIX
226
227	character(len=1) cha ,chb
228	integer jjtime
229	integer iwr
230	! #SI integer l
231	integer isl ,isn
232	integer i ,j ,k ,ikp
233	integer n ,nm
234
235	real(kind=real8) rhAir ! Air Densitity
236	real(kind=real8) Ua_min ! Minimum Air Velocity
237	real(kind=real8) d_snow,SnowOK ! Snow Precip.: Total
238	! #BS real(kind=real8) dbsnow ! Snow Precip.: from Drift
239	! #WL real(kind=real8) uqstar ! uq
240
241	! #SI real(kind=real8) SrfSIC,SIc0OK ! Oceanic Fraction: previous
242	! #SI real(kind=real8) FraOcn,SIceOK ! Oceanic Fraction
243
244	! #Za real(kind=real8) S_Eros ! Snow Erosion (status) = (1,0)
245	! #Za real(kind=real8) SnEros ! Snow Erosion (status) = (1,0)
246
247	! OUTPUT/Verification: Blowing Snow
248	! #mb integer noUNIT
249	! #mb real(kind=real8) BlowST,SnowSB
250
251
252	! DATA
253	! ====
254
255	data glfFIX / .false./
256	data cha /'-'/
257	data chb /':'/
258
259
260
261	! SISVAT Time
262	! ===========
263
264	jjtime = HourTU3600+minuTU60+Sec_TU
265
266
267
268
269	! SISVAT Variables: (x,y,z) Domain
270	! =====================================
271
272	DO ikp=1,kcolp
273	DO nm =1,mwp
274
275
276	! SISVAT Variables: Interpolation of V at 10 m a.g.l.
277	! ---------------------------------------------------
278
279	IF (k_SL.EQ.mzp) THEN
280	VV10SV(ikp,nm) = r_SL10 * WindSV(ikp,nm,k_SL) !
281	ELSE
282	VV10SV(ikp,nm) = WindSV(ikp,nm,k_SL) &!
283	& + r_SL10 *(WindSV(ikp,nm,k_SL-1) &!
284	& -WindSV(ikp,nm,k_SL)) !
285	END IF
286
287
288	! Sastrugi Height decreased by Precipitation if V < 6 m/s (Kotlyakov, 1961)
289	! -------------------------------------------------------------------------
290
291	! #ZS dz0_SV(ikp,nm) = max(zer0,(SnowCM(ikp)-Sno0CM(ikp)) &!
292	! #ZS& /max(0.05,0.104*sqrt(max(zer0, WindSV(ikp,nm,mzp)-6.00)))) !
293	! #ZS dz0_SV(ikp,nm) = dz0_SV(ikp,nm) 0.01max(2-n,0)! dz0(Sastrugi dh)
294
295
296	! Influence of the Angle(Wind,Sastrugi) (Andreas, 1995, CCREL report 95-16)
297	! -------------------------------------------------------------------------
298
299	! #Za S_Eros = max(zer0,sign(un_1,-uss_CM(ikp) -eps9))
300	! #Za SnEros = max(zer0,sign(un_1, uss_CM(ikp) +eps9))
301	! #Za VVs_SV(ikp,nm) = VVs_SV(ikp,nm) * RRsxSV(ikp,nm)
302	! #Za VVs_SV(ikp,nm) = &
303	! #Za& SnEros* VVs_SV(ikp,nm) &
304	! #Za& + S_Eros(VVs_SV(ikp,nm) Adz0dt + VV10SV(ikp,nm))
305	! #Za RRsxSV(ikp,nm) = &
306	! #Za& SnEros* RRsxSV(ikp,nm) &
307	! #Za& + S_Eros(RRsxSV(ikp,nm) Adz0dt + 1.0 )
308	! #Za DDsxSV(ikp,nm) = &
309	! #Za& SnEros* DDsxSV(ikp,nm) &
310	! #Za& + S_Eros* DDsxSV(ikp,nm) * Adz0dt &
311	! #Za& + (Va__SV(ikp,nm) *(Ua__SV(ikp,nm) -Ua0_SV(ikp,nm)) &
312	! #Za& -Ua__SV(ikp,nm) *(Va__SV(ikp,nm) -Va0_SV(ikp,nm))) &
313	! #Za& /(degradmax(.3,WindSV(ikp,nm,mzp) WindSV(ikp,nm,mzp)))
314	! #Za IF (DDsxSV(ikp,nm) .GT.360.) DDsxSV(ikp,nm) = DDsxSV(ikp,nm) - 360.
315	! #Za IF (DDsxSV(ikp,nm) .LT. 0.) DDsxSV(ikp,nm) = DDsxSV(ikp,nm) + 360.
316	END DO
317	END DO
318
319
320	! Water Vapor Flux Limitor
321	! ------------------------
322
323	! #WL DO ikp=1,kcolp
324	! #WL DO nm =1,mwp
325
326	! #WL DO n=1,nLimi-1
327	! #WL WL_mem(ikp,nm,n) = WL_mem(ikp,nm,n+1)
328	! #WL END DO
329
330	! #WL uqstar = max(abs(uqs_SV_gpt(ikp),eps6)*sign(1.,uqs_SV_gpt(ikp))
331	! #WL WL_mem(ikp,nm,n) &
332	! #WL& = Kzh_AT(ikp,nm,k1m(mzp))
333	! #WL& *(qv__SV(ikp,nm,mzpp-k2m(mzp))-qv__SV(ikp,nm,mzpp-k1m(mzp))) &
334	! #WL& /(uqstar *(hsigma(k2m(mzp)) -hsigma(k1m(mzp))))
335
336	! #WL WLmmem(ikp,nm) = 0.
337	! #WL DO n=1,nLimi
338	! #WL WLmmem(ikp,nm) = WLmmem(ikp,nm)+WL_mem(ikp,nm,n)
339	! #WL ENDDO
340	! #WL WLmmem(ikp,nm) = WLmmem(ikp,nm)/nLimit
341
342	! #WL END DO
343	! #WL END DO
344
345
346
347	! SWD / SWA INPUT
348	! ---------------
349
350	DO ikp = 1,kcolp
351
352	IF (.NOT.InpSWD) THEN
353	SWDsRT(ikp) = SWAsRT(ikp)/(1.d0-Alb_SV_gpt(ikp)) ! => downward Solar
354	END IF
355
356
357	! Grid Averages
358	! -------------
359
360	Alb_SV_gpt(ikp) = 0.
361	EmisSV_gpt(ikp) = 0.
362	LWUsRT (ikp) = 0.
363	LMO_SV_gpt(ikp) = 0.
364	us__SV_gpt(ikp) = 0.
365	uts_SV_gpt(ikp) = 0.
366	uqs_SV_gpt(ikp) = 0.
367	uss_CM(ikp) = 0.
368	qs__CM(ikp,mzpp) = 0.
369	hFraSV_gpt(ikp) = 0.
370	Tas_SV_gpt(ikp) = 0.
371	qv__DY(ikp,mzpp) = 0.
372	! #TC uqTC(i,j,1) = 0.
373	! #TC qsTC(i,j,1) = 0.
374	END DO
375
376
377
378	! SISVAT Variables: from (x,y,z) Domain to (vector,mosaic) Domain
379	! ===============================================================
380
381	! SISVAT Variables Update
382	! ^^^^^^^^^^^^^^^^^^^^^^^
383	DO ikp = 1,kcolp
384	DO nm = 1,mwp
385	i = ii__AP(ikp)
386	j = jj__AP(ikp)
387
388	! OUTPUT of SnowFall, Roughness Length and Drag Coefficients
389	! #sf IF (ikp.EQ.1 .AND. Sec_TU.EQ.0)
390	! #sf& write(6,6659)
391	! #sf 6659 format(20x,' dsn_SV us__SV Z0SaSi Z0Sa_N' &
392	! #sf& ,' Z0SaSV Z0m_Sn Z0m_SV')
393
394	! Atmospheric Forcing (INPUT)
395	! ^^^^^^^^^^^^^^^^^^^ ^^^^^
396	DO isn=1,mzp
397	isl = mzp + 1 - isn !
398	Kz__SV(ikp,nm,isn) = Kzh_AT(ikp,isl) !
399	pktaSV(ikp,nm,isn) = pkt0SV(ikp,nm,isn) !
400	ENDDO
401	za__SV(ikp,nm) = zza_SV(ikp,nm,1) ! [m]
402	!
403	VV__SV(ikp,nm) = WindSV(ikp,nm,mzp) !
404
405	Ua_min = eps6 !
406	! #VM Ua_min = 0.2 * sqrt(za__SV(ikp,nm) ) !
407	VV__SV(ikp,nm) = max(Ua_min,VV__SV(ikp,nm) ) !
408	!
409	! #Za VVs_SV(ikp,nm) = VVs_SV(ikp,nm) / RRsxSV(ikp,nm) !
410	! #Za DDs_SV(ikp,nm) = max(zer0,DDsxSV(ikp,nm)-180.) &
411	! #Za& +180.*min(un_1,zer0-min(zer0,DDsxSV(ikp,nm) -180.)) &
412	! #Za& +min(zer0,DDsxSV(ikp,nm) -180.)
413	rhT_SV(ikp,nm) = pkPaSV(ikp,nm) *1.e3 &! [kg/m3]
414	& /(TaT_SV(ikp,nm) *R_DAir) !
415	QaT_SV(ikp,nm) = qv__SV(ikp,nm,1) !
416	! #WL dQa_SV(ikp,nm) = max(0.,1.-WLmmem(ikp,nm)) &! Water Vapor
417	! #WL& * dt__SV/hsigma(mzp) ! Flux Limitor
418	qsnoSV(ikp,nm) = 0. &!
419	& + qs__CM(ikp,mzp) &!
420	! #TC& + qxTC(i,j,mzp,1) &!
421	& + 0.
422
423	! Energy Fluxes (INPUT)
424	! ^^^^^^^^^^^^^ ^^^^^
425	coszSV(ikp,nm) = max(cszEPS,csz_S0(ikp)) ! cos(zenith.Dist.)
426	sol_SV(ikp,nm) = SWDsRT(ikp) ! downward Solar
427	IRd_SV(ikp,nm) = LWDsRT(ikp) ! downward IR
428
429	! Water Fluxes (INPUT)
430	! ^^^^^^^^^^^^^ ^^^^^
431	drr_SV(ikp,nm) =(RainCM(ikp)-Rai0CM(ikp)) *1.e3 /dt__SV ! [m/s] -> [mm/s] .OR. [kg/m2/s]
432	d_snow = SnowCM(ikp)-SnobCM(ikp) ! Only SnowFall
433	dsn_SV(ikp,nm) = d_snow *1.e3 /dt__SV ! Erosion NOT incl.
434	SnowOK = &! Correction
435	& max(zer0,sign(un_1, qs__CM(ikp,mzp)-eps6)) &!
436	& *max(zer0,sign(un_1,Tf_Sno-TaT_SV(ikp,nm) -eps6)) !
437	dsn_SV(ikp,nm) = dsn_SV(ikp,nm)+drr_SV(ikp,nm)*SnowOK !
438	drr_SV(ikp,nm) = drr_SV(ikp,nm) *(1.-SnowOK) !
439	! #BS dbsnow =-ussxSV(ikp,nm) &! Erosion
440	! #BS& dt__SV rhT_SV(ikp,nm) !
441	! #bS dsnbSV(ikp,nm) =min(max(zer0,dbsnow) &!
442	! #bS& / max(eps6,d_snow),un_1) !
443	! #BS dsnbSV(ikp,nm) =1.0-min(qs__CM(ikp,k_zb) &! k_zb level ~ 25 magl
444	! #BS& /max(qs__CM(ikp,mzp ),epsn),un_1) !(BS negligib.at k_zb)
445	! dsnbSV is used and modified in SISVAT_BSn,
446	! then used for Buffer Layer Update
447	! #BS dbs_SV(ikp,nm) = ussbSV(ikp,nm) ! [kg/m2]
448
449	! Soil/Canopy (INPUT)
450	! ^^^^^^^^^^^ ^^^^^
451	slorSV(ikp,nm) = atan(slopSV(ikp,nm)) ! Fall Line Slope [radian]
452
453	! Energy Fluxes (INPUT/OUTPUT)
454	! ^^^^^^^^^^^^^ ^^^^^^^^^^^^
455	cld_SV(ikp,nm) = ClouRT(ikp) ! Cloudiness
456
457	! Water Fluxes (INPUT/OUTPUT)
458	! ^^^^^^^^^^^^^ ^^^^^^^^^^^^
459	! #BS uss_SV(ikp,nm) = ussxSV(ikp,nm) ! us
460
461	! #vL ENDDO
462	! #vL ENDDO
463
464	! Snow Roughness (INPUT/OUTPUT)
465	! ^^^^^^^^^^^^^^ ^^^^^^^^^^^^
466	! #vL DO ikp = 1,kcolp
467	! #vL DO nm = 1,mwp
468
469	! #ZM Z0mmSV(ikp,nm) = 0. !
470	! #ZM Z0emSV(ikp,nm) = 0. !
471	! #ZM Z0hmSV(ikp,nm) = 0. !
472	! #ZM DO k = 1,ntavz !
473	! #ZM Z0mmSV(ikp,nm) = Z0mmSV(ikp,nm) &!
474	! #ZM& + z0_mem(ikp,nm,k) !
475	! #ZM Z0emSV(ikp,nm) = Z0emSV(ikp,nm) &!
476	! #ZM& + b0_mem(ikp,nm,k) !
477	! #ZM Z0hmSV(ikp,nm) = Z0hmSV(ikp,nm) !
478	! #ZM& + r0_mem(ikp,nm,k) !
479	! #ZM ENDDO !
480	! #ZM Z0mmSV(ikp,nm) = min(Z0mmSV(ikp,nm) /ntavz &! z0(Mom., Box Av.)
481	! #ZM& ,hsigma(mzp) / 3.) !
482	! #ZM Z0emSV(ikp,nm) = Z0emSV(ikp,nm) /ntavz ! b0(Eros, Box Av.)
483	! #ZM Z0hmSV(ikp,nm) = Z0hmSV(ikp,nm) /ntavz ! r0(Heat, Box Av.)
484
485	! V, dT(a-s) Time Moving Averages
486	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
487	! #AA DO k = 1,ntaver-1
488	! #AW V__mem(ikp,nm,k ) = V__mem(ikp,nm,k+1)
489	! #AH T__mem(ikp,nm,k ) = T__mem(ikp,nm,k+1)
490	! #AA ENDDO
491	! #AW V__mem(ikp,nm,ntave) = VV__SV(ikp,nm)
492	! #AH T__mem(ikp,nm,ntave) = TaT_SV(ikp,nm)-Ts__SV(ikp,nm)
493
494	! #AW VVmmem(ikp,nm) = 0.0
495	! #AH dTmmem(ikp,nm) = 0.0
496	! #AA DO k=1,ntaver
497	! #AW VVmmem(ikp,nm) = VVmmem(ikp,nm)+V__mem(ikp,nm,k)
498	! #AH dTmmem(ikp,nm) = dTmmem(ikp,nm)+T__mem(ikp,nm,k)
499	! #AA ENDDO
500	! #AW VVmmem(ikp,nm) = VVmmem(ikp,nm)/ntaver
501	! #AH dTmmem(ikp,nm) = dTmmem(ikp,nm)/ntaver
502
503	! #vL ENDDO
504	! #vL ENDDO
505
506	! Snow Pack (INPUT/OUTPUT)
507	! ^^^^^^^^^ ^^^^^^^^^^^^
508	! #vS DO ikp = 1,kcolp
509	! #vS DO nm = 1,mwp
510	dsn_SV(ikp,nm) = dsn_SV(ikp,nm) &!
511	& +max(BufsSV(ikp,nm)-SMndSV,0.) &!
512	& / dt__SV !
513	BufsSV(ikp,nm) = min(BufsSV(ikp,nm),SMndSV ) !
514	! #vS ENDDO
515	! #vS ENDDO
516
517	DO isn = 1,nsnow
518	! #vS DO ikp = 1,kcolp
519	! #vS DO nm = 1,mwp
520	G1snSV(ikp,nm,isn) = max(-G1_dSV,min(G1_dSV, &!
521	& G1snSV(ikp,nm,isn))) ! [-] [-]
522	G2snSV(ikp,nm,isn) = max(-G1_dSV,min(G1_dSV, &!
523	& G2snSV(ikp,nm,isn))) ! [-] [0.0001 m]
524	! #vS END DO
525	! #vS END DO
526	END DO
527
528	! #vL DO ikp = 1,kcolp
529	! #vL DO nm = 1,mwp
530	! #vL i = ii__AP(ikp)
531	! #vL j = jj__AP(ikp)
532
533	! #SI HFraSV(ikp,nm) = 0. ! Frazil Thickness
534
535	! RunOFF Intensity (INPUT/OUTPUT)
536	! ^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^
537	RnofSV(ikp,nm) = 0. ! RunOFF Intensity
538
539	! Blown Snow OUTPUT for a specific Grid Point
540	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
541	! #mb IF (lwriSV(ikp,nm).ne.0.AND.it_RUN.gt.0) THEN
542	! #mb noUNIT = no__SV(lwriSV(ikp,nm))
543	! #mb write(noUNIT,5012)
544	! #mb 5012 format(/,1x)
545	! #mb write(noUNIT,5013)
546	! #mb 5013 format(' -----+--------+--------+--------+--------+', &
547	! #mb& '--------+--------+--------+--------+--------+', &
548	! #mb& '--------+')
549	! #mb write(noUNIT,5014)
550	! #mb 5014 format(' n \| z \| qs \| V \| \|', &
551	! #mb& ' T \| TKE^0.5\| \| \| \|', &
552	! #mb& ' \|', &
553	! #mb& /,' \| [m] \| [g/kg] \| [m/s] \| \|', &
554	! #mb& ' [K] \| [m/s] \| \| \| \|', &
555	! #mb& ' \|')
556	! #mb BlowST=0.
557	! #mb k=0
558	! #mb 5011 CONTINUE
559	! #mb k=k+1
560	! #mb IF ( k .gt.mzp ) GO TO 5010
561	! #mb IF (Z___DY (ikp,k)-sh__AP(ikp).lt.100.) THEN
562	! #mb BlowST=BlowST+WindSV(ikp,nm,k)*qs__CM (ikp,k) &
563	! #mb& 1.e3(pkPaSV(ikp,nm) -pt__DY)d1Sigm(k) Grav_I
564	! #mb write(noUNIT,5015) mzpp-k &
565	! #mb& , Z___DY(ikp,k) -sh__AP(ikp) &
566	! #mb& , qs__CM(ikp,k) *1.e3 &
567	! #mb& , WindSV(ikp,nm,k),Ta__DY(ikp,k) &
568	! #mb& ,sqrt(TKE_AT(ikp,k))
569	! #mb 5015 format(i5,' \|',f7.2,' \|',f7.3,' \|',f7.2,' \|', &
570	! #mb& 8x,'\|',f7.2,' \|',f7.3,' \|', 4(8x,'\|'))
571	! #mb END IF
572	! #mb GO TO 5011
573	! #mb 5010 CONTINUE
574
575	! #mb SnowSB = BufsSV(ikp,nm)
576	! #mb IF ( isnoSV(ikp,nm) .GT. 0 ) THEN
577	! #mb DO isn=max(0,isnoSV(ikp,nm) ) ,isnoSV(ikp,nm)
578	! #mb SnowSB = SnowSB &
579	! #mb& + dzsnSV(ikp,nm,isn)*ro__SV(ikp,nm,isn)
580	! #mb END DO
581	! #mb END IF
582
583	! #mb write(noUNIT,5016) BlowST,SnowSB
584	! #mb 5016 format(' * TRANSPORT = ',e12.3,' kg/m/s' , 8x,'\|', &
585	! #mb& ' * BUDGET = ',f12.6,' mm w.e.\|',2(8x,'\|'))
586	! #mb write(noUNIT,5013)
587	! #mb END IF
588
589	! OUTPUT, for Stand-Alone VERIFICATION
590	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
591	! #v0 IF (ikp .le. kcolp .and. nm .le. mxpp) THEN
592	! #v0 write(50,5001) it_RUN,ikp,nm &
593	! #v0& za__SV(ikp,nm),VV__SV(ikp,nm),TaT_SV(ikp,nm), &
594	! #v0& rhT_SV(ikp,nm),QaT_SV(ikp,nm),qsnoSV(ikp,nm), &
595	! #v0& coszSV(ikp,nm),sol_SV(ikp,nm),IRd_SV(ikp,nm), &
596	! #v0& drr_SV(ikp,nm),dsn_SV(ikp,nm),dbs_SV(ikp,nm), &
597	! #v0& LSmask(ikp,nm),isotSV(ikp,nm),alb0SV(ikp,nm), &
598	! #v0& IRs_SV(ikp,nm), &
599	! #v0& ivgtSV(ikp,nm),LAI0SV(ikp,nm),glf0SV(ikp,nm), &
600	! #v0& TvegSV(ikp,nm),LMO_SV(ikp,nm),us__SV(ikp,nm), &
601	! #v0& uqs_SV(ikp,nm),uts_SV(ikp,nm),uss_SV(ikp,nm), &
602	! #v0& snCaSV(ikp,nm),rrCaSV(ikp,nm),psivSV(ikp,nm)
603	! #v0 5001 format(/,'c #INFO it_RUN = ',i15 , &
604	! #v0& /,'c #INFO ikp = ',i15 , &
605	! #v0& /,'c #INFO nm = ',i15 , &
606	! #v0& /,' za__SV(ikp,nm) = ',e15.6, &
607	! #v0& /,' VV__SV(ikp,nm) = ',e15.6, &
608	! #v0& /,' TaT_SV(ikp,nm) = ',e15.6, &
609	! #v0& /,' rhT_SV(ikp,nm) = ',e15.6, &
610	! #v0& /,' QaT_SV(ikp,nm) = ',e15.6, &
611	! #v0& /,' qsnoSV(ikp,nm) = ',e15.6, &
612	! #v0& /,' coszSV(ikp,nm) = ',e15.6, &
613	! #v0& /,' sol_SV(ikp,nm) = ',e15.6, &
614	! #v0& /,' IRd_SV(ikp,nm) = ',e15.6, &
615	! #v0& /,' drr_SV(ikp,nm) = ',e15.6, &
616	! #v0& /,' dsn_SV(ikp,nm) = ',e15.6, &
617	! #v0& /,' dbs_SV(ikp,nm) = ',e15.6, &
618	! #v0& /,' LSmask(ikp,nm) = ',i15 , &
619	! #v0& /,' isotSV(ikp,nm) = ',i15 , &
620	! #v0& /,' alb0SV(ikp,nm) = ',e15.6, &
621	! #v0& /,' IRs_SV(ikp,nm) = ',e15.6, &
622	! #v0& /,' ivgtSV(ikp,nm) = ',i15 , &
623	! #v0& /,' LAI0SV(ikp,nm) = ',e15.6, &
624	! #v0& /,' glf0SV(ikp,nm) = ',e15.6, &
625	! #v0& /,' TvegSV(ikp,nm) = ',e15.6, &
626	! #v0& /,' LMO_SV(ikp,nm) = ',e15.6, &
627	! #v0& /,' us__SV(ikp,nm) = ',e15.6, &
628	! #v0& /,' uqs_SV(ikp,nm) = ',e15.6, &
629	! #v0& /,' uts_SV(ikp,nm) = ',e15.6, &
630	! #v0& /,' uss_SV(ikp,nm) = ',e15.6, &
631	! #v0& /,' snCaSV(ikp,nm) = ',e15.6, &
632	! #v0& /,' rrCaSV(ikp,nm) = ',e15.6, &
633	! #v0& /,' psivSV(ikp,nm) = ',e15.6)
634	! #v0 DO isl = -nsoil,0
635	! #v0 write(50,5002) isl,TsisSV(ikp,nm,isl), &
636	! #v0& isl,eta_SV(ikp,nm,isl)
637	! #v0 5002 format(' TsisSV(ikp,nm,',i2,') = ',e15.6, &
638	! #v0& ' eta_SV(ikp,nm,',i2,') = ',e15.6)
639	! #v0 END DO
640	! #v0 DO isl = 1,nsnow
641	! #v0 write(50,5003) isl,TsisSV(ikp,nm,isl), &
642	! #v0& isl,dzsnSV(ikp,nm,isl)
643	! #v0 5003 format(' TsisSV(ikp,nm,',i2,') = ',e15.6, &
644	! #v0& ' dzsnSV(ikp,nm,',i2,') = ',e15.6)
645	! #v0 END DO
646	! #v0 END IF
647	END DO
648	END DO
649
650	! SISVAT Execution
651	! ^^^^^^^^^^^^^^^^
652	write(daHost,'(i2,a3,i4,i3,2(a1,i2))') &
653	& Day_TU,LabMon(Mon_TU),YearTU, &
654	& HourTU,chb,minuTU,chb,Sec_TU
655
656	! OUTPUT of SnowFall, Roughness Length and Drag Coefficients
657	! #sf write(6,666) Day_TU,Mon_TU,YearTU,HourTU,minuTU,Sec_TU
658	! #sf 666 format(2(i2,'-'),2i4,2(':',i2),3x,$)
659
660
661
662	! ******
663	call SISVAT(jjtime,kcolv)
664	! ******
665
666
667
668	! MAR Variables Update
669	! ^^^^^^^^^^^^^^^^^^^^^^^
670	DO ikp = 1,kcolp
671	DO k = 1,mzp
672	dpktSV_gpt(ikp,k) = 0.
673	ENDDO
674	ENDDO
675
676	DO ikp = 1,kcolp
677	DO nm = 1,mwp
678
679	! Atmospheric Forcing (OUTPUT)
680	! ^^^^^^^^^^^^^^^^^^^ ^^^^^^
681	DO isn=1,mzp
682	k = mzp + 1 - isn !
683	dpktSV_gpt(ikp,k) = &!
684	& dpktSV_gpt(ikp,k) + &!
685	& FracSV(ikp,nm) * &!
686	& (pktaSV(ikp,nm,isn)-pkt0SV(ikp,nm,isn)) / dt__SV !
687	ENDDO
688
689	! Water Fluxes (INPUT/OUTPUT)
690	! ^^^^^^^^^^^^^ ^^^^^^^^^^^^
691	! #BS ussxSV(ikp,nm) = 0. !
692	! #BS ussxSV(ikp,nm) = &! MAX Erosion
693	! #BS& (ussbSV(ikp,nm) - dbs_SV(ikp,nm)) &!-unconsumed Erosion
694	! #BS& /(dt__SVrhT_SV(ikp,nm)) ! ==> actual us*
695	! #vL ENDDO
696	! #vL ENDDO
697
698	! #vL DO ikp = 1,kcolp
699	! #vL DO nm = 1,mwp
700	! #BS ussbSV(ikp,nm) = dt__SV*uss_SV(ikp,nm) &! NEW MAX Erosion
701	! #BS& rhT_SV(ikp,nm) ! rho us* dt[kg/m2]
702
703	! Soil/Canopy (INPUT/OUTPUT)
704	! ^^^^^^^^^^^ ^^^^^^^^^^^^
705	Z0m_SV(ikp,nm) = min(Z0m_SV(ikp,nm) &! Moment.Roughn.L.
706	& ,hsigma(mzp)/3.) !
707	! #vL END DO
708	! #vL END DO
709
710	! Snow Roughness (INPUT/OUTPUT)
711	! ^^^^^^^^^^^^^^ ^^^^^^^^^^^^
712	! #vZ DO ikp = 1,kcolp
713	! #vZ DO nm = 1,mwp
714	! #ZM DO k=1,ntavz-1 !
715	! #ZM z0_mem(ikp,nm,k) = z0_mem(ikp,nm,k+1) !
716	! #ZM b0_mem(ikp,nm,k) = b0_mem(ikp,nm,k+1) !
717	! #ZM r0_mem(ikp,nm,k) = r0_mem(ikp,nm,k+1) !
718	! #ZM ENDDO !
719	! #vZ ENDDO
720	! #vZ ENDDO
721
722	! #vL DO ikp = 1,kcolp
723	! #vL DO nm = 1,mwp
724	! #ZM z0_mem(ikp,nm,ntavz) = Z0mnSV(ikp,nm) ! z0(Momentum)
725	! #ZM b0_mem(ikp,nm,ntavz) = Z0enSV(ikp,nm) ! z0(Mom., Erosion)
726	! #ZM r0_mem(ikp,nm,ntavz) = Z0hnSV(ikp,nm) ! z0(Heat)
727	! #vL END DO
728	! #vL END DO
729
730	! Dust Fluxes (INPUT/OUTPUT)
731	! ^^^^^^^^^^^^^
732	! #vD DO ikp = 1,kcolp
733	! #vD DO nm = 1,mwp
734	! #BD uds_SV(ikp,nm) =(1-min(1,isnoSV(ikp,nm))) &! Snow Free Surface
735	! #BD& *uss_SV(ikp,nm) &! DUST Erosion
736	! #BD& max(1,(2-my)3) ! Tuning Factor (2D)
737	! #vD END DO
738	! #vD END DO
739
740	! Snow Pack (INPUT/OUTPUT)
741	! ^^^^^^^^^ ^^^^^^^^^^^^
742	! #vL DO ikp = 1,kcolp
743	! #vL DO nm = 1,mwp
744	! #IB wes0SV(ikp,nm) = dwesSV(ikp,nm) ! Depo. / Subli.
745	! #IB wem0SV(ikp,nm) = dwemSV(ikp,nm) ! Melting
746	! #IB wer0SV(ikp,nm) = dwerSV(ikp,nm) ! Refreezing
747
748	! Radiative Properties (OUTPUT)
749	! ^^^^^^^^^^^^^^^^^^^^ ^^^^^^
750	albcSV(ikp,nm) = alb_SV(ikp,nm) &! Mosaic Albedo
751	! #AO& * LSmask(ikp,nm) &!
752	! #AO& + Alb_AO(ikp,nm) &! Mosaic AlbedoNEMO
753	! #AO& *(1-LSmask(ikp,nm)) &!
754	& + 0.
755	ROF_SV(ikp,nm) = RnofSV(ikp,nm) *dt__SV &!
756	& + ROF_SV(ikp,nm) ! Integrated Run OFF
757
758	END DO
759	END DO
760
761
762
763	! Surface Temperature: Prescription of relevant Medium (Snow, precribed SST)
764	! ==========================================================================
765
766	! Control Martin
767	!PRINT*, 'nsoil=',nsoil
768	!PRINT*, 'FixSST=',FixSST
769	!PRINT*, 'LSMask=',LSMask
770	! Control Martin
771
772	DO ikp=1,kcolp
773	DO isl = -nsoil,0 !
774
775
776	! Open Ocean
777	! ----------
778
779	eta_SV(ikp,1,isl) = &!
780	& eta_SV(ikp,1,isl) * LSMask(ikp,1) &!
781	& +(1-LSMask(ikp,1) ) ! Sea: Humidity:=1
782
783	TsisSV(ikp,1,isl) = &!
784	& (TsisSV(ikp,1,isl) * LSMask(ikp,1) &! Soil Temperature
785	& +sst_SB(ikp) (1-LSMask(ikp,1) )) FixSST &! Prescribed SST
786	! #OP& * FixSST &!
787	! #OP& +(TsisSV(ikp,1,isl) &!
788	! #op& +(sst_SB(ikp) &!~Prescribed SST
789	! #op& -TsisSV(ikp,1,isl))(1-LSMask(ikp,1) ) SSTnud &! (Nudging)
790	! #OP& ) * VarSST &! Interactive SST
791	& + 0.
792
793
794	! Sea Ice
795	! -------
796
797	! #AO eta_SV(ikp,2,isl) = &!
798	! #AO& eta_SV(ikp,2,isl) * LSMask(ikp,2) ! Sea: Humidity:=0
799
800	! #AO TsisSV(ikp,2,isl) = &!
801	! #AO& (TsisSV(ikp,2,isl) = LSMask(ikp,2) &! Soil Temperature
802	! #AO& + 271.2 *(1-LSMask(ikp,2) )) ! Prescribed ST
803	END DO
804
805	! #AO DO isl = 0,nsnow !
806	! #AO TsisSV(ikp,2,isl) = &!
807	! #AO& s_T_AO(ikp,2) *(1-LSMask(ikp,2) ) ! Prescribed SIT
808	! #AO END DO
809	ENDDO
810
811
812	DO ikp = 1,kcolp
813	DO nm = 1,mwp
814	Ts__SV(ikp,nm) = &! Surf.Temperature
815	& TsisSV(ikp,nm,0) &!
816	& *(1-min(1,isnoSV (ikp,nm) )) &!
817	& +TsisSV(ikp,nm, max(1,isnoSV (ikp,nm) )) &!
818	& * min(1,isnoSV (ikp,nm) ) &!
819	& +0.
820	ENDDO
821	ENDDO
822
823
824
825	! Mosaic Cleaning
826	! ===============
827
828	DO ikp = 1,kcolp
829	IF (LSMask(ikp,1) .EQ. 0) THEN
830	isnoSV (ikp,1) = 0
831	ispiSV (ikp,1) = 0
832	iiceSV (ikp,1) = 0
833	DO ISL=1,nsnow
834	TsisSV (ikp,1,isl) = 0.
835	dzsnSV (ikp,1,isl) = 0.
836	ro__SV (ikp,1,isl) = 0.
837	eta_SV (ikp,1,isl) = 0.
838	G1snSV (ikp,1,isl) = 0.
839	G2snSV (ikp,1,isl) = 0.
840	agsnSV (ikp,1,isl) = 0.
841	istoSV (ikp,1,isl) = 0.
842	ENDDO
843	ENDIF
844	IF (FracSV(ikp,n2) .LT. epsn .AND. n2 .GT. 1) THEN
845	Ts__SV(ikp,n2) = Ts__SV(ikp,1)
846	DO isl=-nsoil,0
847	TsisSV (ikp,n2,isl) = TsisSV(ikp,1,isl)
848	ENDDO ! #n2
849	isnoSV (ikp,n2 ) = isnoSV(ikp,1 ) * LSMask(ikp,n2)
850	ispiSV (ikp,n2 ) = ispiSV(ikp,1 ) * LSMask(ikp,n2)
851	iiceSV (ikp,n2 ) = iiceSV(ikp,1 ) * LSMask(ikp,n2)
852	DO isl=1,nsnow !
853	TsisSV (ikp,n2,isl) = TsisSV(ikp,1,isl) * LSMask(ikp,n2)
854	dzsnSV (ikp,n2,isl) = dzsnSV(ikp,1,isl) * LSMask(ikp,n2)
855	ro__SV (ikp,n2,isl) = ro__SV(ikp,1,isl) * LSMask(ikp,n2)
856	eta_SV (ikp,n2,isl) = eta_SV(ikp,1,isl) * LSMask(ikp,n2)
857	G1snSV (ikp,n2,isl) = G1snSV(ikp,1,isl) * LSMask(ikp,n2)
858	G2snSV (ikp,n2,isl) = G2snSV(ikp,1,isl) * LSMask(ikp,n2)
859	agsnSV (ikp,n2,isl) = agsnSV(ikp,1,isl) * LSMask(ikp,n2)
860	istoSV (ikp,n2,isl) = istoSV(ikp,1,isl) * LSMask(ikp,n2)
861	ENDDO ! #n2
862	ENDIF ! #n2
863	ENDDO
864
865
866
867	! Grid Averages / Diagnostics
868	! ===========================
869
870	! Grid Averages (OUTPUT)
871	! ^^^^^^^^^^^^^ ^^^^^^
872	DO ikp = 1,kcolp
873	DO nm = 1,mwp
874	! #IB wes_SV (ikp,nm)= - wes0SV(ikp,nm) + wes_SV(ikp,nm) ! Depo. / Subli.
875	! #IB wem_SV (ikp,nm)= wem0SV(ikp,nm) + wem_SV(ikp,nm) ! Melting
876	! #IB wer_SV (ikp,nm)= wer0SV(ikp,nm) + wer_SV(ikp,nm) ! Refreezing
877	! #IB wee_SV (ikp,nm)= - uqs_SV(ikp,nm) + wee_SV(ikp,nm) &! Evapotranspiration
878	! #IB& * dt__SV * roa_SV(ikp,nm,1) !
879
880	Alb_SV_gpt(ikp) = Alb_SV_gpt(ikp) &! Grid Albedo
881	& + FracSV (ikp,nm) * albcSV (ikp,nm) ! Mosaic Albedo
882	EmisSV_gpt(ikp) = EmisSV_gpt(ikp) &! Grid Emissivity
883	& + FracSV (ikp,nm) * emi_SV (ikp,nm) ! Mosaic Emissivity
884	LWUsRT (ikp) = LWUsRT (ikp) &!
885	& + FracSV (ikp,nm) * IRu_SV (ikp,nm) ! Mosaic Upw.IR
886	LMO_SV_gpt(ikp) = LMO_SV_gpt(ikp) &!
887	& + FracSV (ikp,nm) * LMO_SV (ikp,nm) ! Mosaic Mon.Ob.
888	us__SV_gpt(ikp) = us__SV_gpt(ikp) &! Grid u*
889	& + FracSV (ikp,nm) * us__SV (ikp,nm) ! Mosaic u*
890	uts_SV_gpt(ikp) = uts_SV_gpt(ikp) &! Grid uT
891	& + FracSV (ikp,nm) * uts_SV (ikp,nm) ! Mosaic uT
892	uqs_SV_gpt(ikp) = uqs_SV_gpt(ikp) &! Grid uq
893	& + FracSV (ikp,nm) * uqs_SV (ikp,nm) ! Mosaic uq
894	! #BS uss_CM (ikp) = uss_CM (ikp) &! Grid us
895	! #BS& + FracSV (ikp,nm) * ussxSV (ikp,nm) ! Mosaic us
896	! NO ! ussxSV (ikp,nm) = uss_SV (ikp,nm) ! us
897	! ! Upper Update = wrong Source of Atmospher.Snow !
898	! #BS qs__CM (ikp,mzpp) = &! Salt.Part.Concent.
899	! #BS& qs__CM (ikp,mzpp) &!
900	! #BS& + FracSV (ikp,nm) * qSalSV (ikp,nm) &!
901	! #BS& *min(1,isnoSV (ikp,nm) ) !
902	! #PO hFraSV_gpt(ikp) = hFraSV_gpt(ikp) &! Frazil Thickness
903	! #PO& + FracSV (ikp,nm) * HFraSV (ikp,nm) !
904	Tas_SV_gpt(ikp) = Tas_SV_gpt(ikp) &! Surface Air
905	& + FracSV (ikp,nm) * Ts__SV (ikp,nm) ! Temperatur
906	qv__DY (ikp,mzpp)= qv__DY (ikp,mzpp) &!
907	& + FracSV (ikp,nm) * SHumSV (ikp,nm) ! Surf.Specif.Humid.
908	! to adapt over soil
909	! #TC uqTC (i,j,1) = uqTC (i,j,1) &! Grid ud
910	! #TC& + FracSV (ikp,nm) * uds_SV (ikp,nm) ! Mosaic ud
911	! #TC qsTC (i,j,1) = qsTC (i,j,1) &! Salt.Part.Concent.
912	! #TC& + FracSV (ikp,nm) * qSalSV (ikp,nm) &!
913	! #TC& *(1-min(1,isnoSV (ikp,nm) )) !
914	ENDDO
915	ENDDO
916
917
918
919	! De la grille "SISVAT" vers la grille "AtmPHY"
920	! =============================================
921
922	DO ikp = 1,kcolp
923	Sno0CM (ikp) = SnowCM (ikp) !
924	rhAir = roa_SV (ikp,1,1) ! Air Densitity
925	Ta__DY (ikp,mzpp) = &!
926	& Tas_SV_gpt(ikp) !
927	pkt_DY (ikp,mzpp) = &!
928	& Tas_SV_gpt(ikp) /pkPaSV(ikp,1) ** RCp !
929	HsenSV_gpt(ikp) =-uts_SV_gpt(ikp) rhAir CpdAir ! Sensible Heat Flux
930	HLatSV_gpt(ikp) =-uqs_SV_gpt(ikp) rhAir LhvH2O ! Latent Heat Flux
931	WE2aSV_gpt(ikp) = WE2aSV_gpt(ikp) &! Total Evaporat.
932	& -uqs_SV_gpt(ikp) rhAir dt__SV ! [mm w.e.]
933	END DO
934
935
936
937	! Blown Snow/Dust Accumulation
938	! ============================
939
940	! #AE DO ikp=1,kcolp
941	! #AE DO nm =1,mwp
942
943	! #BS SnowCM(ikp) = SnowCM(ikp) &!
944	! #BS& + dt__SV 1.e-3 roa_SV(ikp,1) *uss_CM(ikp)
945
946	! #AE END DO
947	! #AE END DO
948
949
950
951	! Formation of Lakes \VER
952	! ==================
953
954
955
956	! Sea-Ice Ice Floe Size
957	! =====================
958
959	! Prescription from SST
960	! ---------------------
961
962	! #SI IF (VarSST.le.eps6) THEN
963	! #SI DO ikp=1,kcolp
964	! #SI FraOcn =(TsisSV (ikp,1,0)-TOF_SV)/TSIdSV ! Prescribed
965	! ! from SST
966	! #IP FraOcn = 1.-sif_SB(ikp) ! Prescribed
967	! ! from SSM/I
968	! #SI FraOcn = min( un_1,FraOcn) ! UpperLimit
969	! #SI FraOcn = max(OcnMin,FraOcn) ! LowerLimit
970	! #SI FracSV(ikp,1) = LSMask(ikp,1) * FracSV(ikp,1) &! New Ocean
971	! #SI& + (1-LSMask(ikp,1) )* FraOcn !
972	! #SI SrfSIC = FracSV(ikp,2) ! Old Sea Ice
973	! #SI SIc0OK = max(zer0, sign(un_1,SrfSIC-eps6)) !
974	! #SI FracSV(ikp,2) * LSMask(ikp,2) * FracSV(ikp,2) &! New Sea Ice
975	! #SI& + (1-LSMask(ikp,2) )*(1.-FraOcn) !
976	! #SI SIceOK = max(zer0, sign(un_1,FracSV(ikp,2) &!
977	! #SI& -eps6)) !
978
979	! Sea-Ice Vertical Discretization
980	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
981	! #SI isnoSV(ikp,2) = &
982	! #SI& isnoSV(ikp,2) * LSMask(ikp,2) &
983	! #SI& +(max(1 &
984	! #SI& ,isnoSV(ikp,2) ) *SIc0OK &
985	! #SI& + 3 (1.-SIc0OK)SIceOK)*(1-LSMask(ikp,2))
986
987	! #SI iiceSV(ikp,2) = &
988	! #SI& iiceSV(ikp,2) * LSMask(ikp,2) &
989	! #SI& +(max(1 &
990	! #SI& ,iiceSV(ikp,2) ) *SIc0OK &
991	! #SI& + 3 (1.-SIc0OK)SIceOK)*(1-LSMask(ikp,2))
992	! #SI ispiSV(ikp,2) = iiceSV(ikp,2)
993
994	! #SI DO l=1,nsnow
995	! #SI dzsnSV(ikp,2,l) = &
996	! #SI& dzsnSV(ikp,2,l) * LSMask(ikp,2) &
997	! #SI& +(max &
998	! #SI& (SIc_OK(min(2,l))* SIcMIN &
999	! #SI& ,dzsnSV(ikp,2,l))*SIc0OK &
1000	! #SI& +dzSIce(min(4,l))(1.-SIc0OK)SIceOK)*(1-LSMask(ikp,2))
1001
1002	! #SI TsisSV(ikp,2,l) = &
1003	! #SI& TsisSV(ikp,2,l) * LSMask(ikp,2) &
1004	! #SI& +(TsisSV(ikp,2,l) * SIc0OK &
1005	! #SI& +TsisSV(ikp,1,0) (1.-SIc0OK) )(1-LSMask(ikp,2))
1006
1007	! #SI ro__SV(ikp,2,l) = &
1008	! #SI& ro__SV(ikp,2,l) * LSMask(ikp,2) &
1009	! #SI& +(max &
1010	! #SI& (SIc_OK(min(2,l))*rhoIce &
1011	! #SI& ,ro__SV(ikp,2,l))*SIc0OK &
1012	! #SI& +rhoIce (1.-SIc0OK)SIceOK)*(1-LSMask(ikp,2))
1013
1014	! #SI G1snSV(ikp,2,l) = &
1015	! #SI& G1snSV(ikp,2,l) * LSMask(ikp,2) &
1016	! #SI& +(G1snSV(ikp,2,l) *SIc0OK &
1017	! #SI& +G1_dSV (1.-SIc0OK)SIceOK)*(1-LSMask(ikp,2))
1018
1019	! #SI G2snSV(ikp,2,l) = &
1020	! #SI& G2snSV(ikp,2,l) * LSMask(ikp,2) &
1021	! #SI& +(G2snSV(ikp,2,l) *SIc0OK &
1022	! #SI& +30. (1.-SIc0OK)SIceOK)*(1-LSMask(ikp,2))
1023
1024	! #SI istoSV(ikp,2,l) = &
1025	! #SI& istoSV(ikp,2,l) * LSMask(ikp,2) &
1026	!!#SI&new +(istoSV(ikp,2,l) *SIc0OK &
1027	!!#SI&new +istdSV(2) (1.-SIc0OK)SIceOK)*(1-LSMask(ikp,2)) &
1028	! #SI& + istdSV(2) * (1-LSMask(ikp,2))
1029	! #SI END DO
1030	! #SI DO l=-nsoil,0
1031	! #SI TsisSV(ikp,2,l) = &
1032	! #SI& TsisSV(ikp,2,l) * LSMask(ikp,2) &
1033	! #SI& +(TsisSV(ikp,2,l) * SIc0OK &
1034	! #SI& +TsisSV(ikp,1,l) (1.-SIc0OK) )(1-LSMask(ikp,2))
1035
1036	! #SI eta_SV(ikp,2,l) = &
1037	! #SI& eta_SV(ikp,2,l) * LSMask(ikp,2) &
1038	! #SI& + eta_SV(ikp,2,l) * SIc0OK *(1-LSMask(ikp,2))
1039	! No Pore in Ice => No Water
1040	! #SI END DO
1041
1042	! OUTPUT of Sea Ice Fraction, Temperature, Discretization
1043	! #si write(6,6001) Day_TU,LabMon(Mon_TU),YearTU &
1044	! #si& ,HourTU,minuTU,Sec_TU ,TsisSV(ikp,1,0) &
1045	! #si& ,FraOcn,FracSV(ikp,1) ,TsisSV(ikp,2,0) &
1046	! #si& , iiceSV(ikp,2) ,isnoSV(ikp,2)
1047
1048	! #SI END DO
1049	! #SI END IF
1050
1051	! Otherwise SST and FrLead have been computed in the Sea-Ice Polynya Model
1052	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1053
1054
1055	! Rainfall, Snowfall Time Integral at previous Time Step
1056	! ------------------------------------------------------
1057
1058	DO ikp = 1,kcolp
1059	Rai0CM(ikp) = RainCM(ikp) ! Rainfall Time Integral
1060	SnobCM(ikp) = SnowCM(ikp) ! Snowfall Time Integral
1061	! Erosion skipped
1062
1063
1064	! Wind Horizontal Components at previous Time Step
1065	! --------------------------------------------------------
1066
1067	DO nm=1,mwp
1068	! #Za Ua0_SV(ikp,nm) = Ua__SV(ikp,nm) !
1069	! #Za Va0_SV(ikp,nm) = Va__SV(ikp,nm) !
1070	END DO
1071	END DO
1072
1073
1074	! Additional OUTPUT for VERIFICATION
1075	! ----------------------------------
1076
1077	! OUTPUT/Verification: SBL Turbulent Fluxes
1078	! #sh i = i_x0 + 10.*111.111e3/dxHOST
1079	! #sh j = j_y0
1080	! #sh nm = 1
1081	! #sh ikp = ikl_AP(i,j)
1082	! #sh write(6,6060) it_EXP,Day_TU,LabMon(Mon_TU),YearTU &
1083	! #sh& ,HourTU,minuTU ,lat__r(ikp)/Dg2Rad &
1084	! #sh& ,TaT_SV (ikp,nm) ,roa_SV(ikp,nm,1) &
1085	! #sh& ,HsenSV_gpt(ikp),HLatSV_gpt(ikp),-86400.*uqs_SV_gpt(ikp) &
1086	! #sh& ,1.e3*RainCM(ikp),WE2aSV_gpt(ikp), ROF_SV (ikp,nm)
1087	! #sh 6060 format(i6,i3,'-',a3,'-',i4,':',i2,':',i2,f6.2,' N', &
1088	! #sh& f9.3,' K' ,f6.3,' kg/m3',2(f6.1,' W/m2'), &
1089	! #sh& f6.3,' mm/day',3(f9.3,' mm'))
1090
1091
1092
1093	! SISVAT OUTPUTs
1094	! ==============
1095
1096	! IF (WRIsbc) THEN
1097
1098	! **************
1099	! CALL PHY_SISVAT_IOs
1100	! **************
1101
1102	! END IF
1103
1104
1105
1106	return
1107	end subroutine PHY_SISVAT_RUN

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

Download in other formats:

Original Format