Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

sisvat_zag.F @ 5229

Last change on this file since 5229 was 3792, checked in by evignon, 4 years ago
Ajout de INLANDSIS, nouvelle interface entre LMDZ et la neige de SISVAT Etienne, 04/01/2021
File size: 11.8 KB

Line
1
2
3	subroutine SISVAT_zAg
4	. (isagra,isagrb,WEagra
5	. ,dzagra,dzagrb,T_agra,T_agrb
6	. ,roagra,roagrb,etagra,etagrb
7	. ,G1agra,G1agrb,G2agra,G2agrb
8	. ,agagra,agagrb,Agreg1
9	. )
10
11	C +------------------------------------------------------------------------+
12	C \| MAR SURFACE Sat 30-Apr-2004 MAR \|
13	C \| SubRoutine SISVAT_zAg aggregates two contiguous snow layers \|
14	C \| \|
15	C +------------------------------------------------------------------------+
16	C \| \|
17	C \| PARAMETERS: knonv: Total Number of columns = \|
18	C \| ^^^^^^^^^^ = Total Number of continental grid boxes \|
19	C \| X Number of Mosaic Cell per grid box \|
20	C \| \|
21	C \| INPUT: isagrb : 2nd Layer History \|
22	C \| ^^^^^ \|
23	C \| \|
24	C \| INPUT: dzagrb : 2nd Layer Thickness \|
25	C \| ^^^^^ T_agrb : 2nd Layer Temperature \|
26	C \| roagrb : 2nd Layer Density \|
27	C \| etagrb : 2nd Layer Water Content \|
28	C \| G1agrb : 2nd Layer Dendricity/Spher. \|
29	C \| G2agrb : 2nd Layer Sphericity/Size \|
30	C \| agagrb : 2nd Age \|
31	C \| Agreg1 : 1. when Agregation constrained \|
32	C \| \|
33	C \| INPUT / isagra : 1st Layer History \|
34	C \| OUTPUT: \|
35	C \| ^^^^^^ \|
36	C \| \|
37	C \| INPUT / dzagra : 1st Layer Thickness \|
38	C \| OUTPUT: T_agra : 1st Layer Temperature \|
39	C \| ^^^^^^ roagra : 1st Layer Density \|
40	C \| etagra : 1st Layer Water Content \|
41	C \| G1agra : 1st Layer Dendricity/Spher. \|
42	C \| G2agra : 1st Layer Sphericity/Size \|
43	C \| agagra : 1st Age \|
44	C \| \|
45	C +------------------------------------------------------------------------+
46
47
48
49
50	C +--Global Variables
51	C + ================
52
53	use VARphy
54	use VAR_SV
55	use VARdSV
56	use VAR0SV
57	use VARxSV
58
59	IMPLICIT NONE
60
61
62	C +--INPUT
63	C + -----
64
65	integer isagrb(knonv) ! 2nd Layer History
66	real dzagrb(knonv) ! 2nd Layer Thickness
67	real T_agrb(knonv) ! 2nd Layer Temperature
68	real roagrb(knonv) ! 2nd Layer Density
69	real etagrb(knonv) ! 2nd Layer Water Content
70	real G1agrb(knonv) ! 2nd Layer Dendricity/Spher.
71	real G2agrb(knonv) ! 2nd Layer Sphericity/Size
72	real agagrb(knonv) ! 2nd Layer Age
73
74
75	C +--INPUT/OUTPUT
76	C + ------------
77
78	integer isagra(knonv) ! 1st Layer History
79	real WEagra(knonv) ! 1st Layer Height [mm w.e.]
80	real Agreg1(knonv) ! 1. ===> Agregates
81	real dzagra(knonv) ! 1st Layer Thickness
82	real T_agra(knonv) ! 1st Layer Temperature
83	real roagra(knonv) ! 1st Layer Density
84	real etagra(knonv) ! 1st Layer Water Content
85	real G1agra(knonv) ! 1st Layer Dendricity/Spher.
86	real G2agra(knonv) ! 1st Layer Sphericity/Size
87	real agagra(knonv) ! 1st Layer Age
88
89
90	C +--Internal Variables
91	C + ==================
92
93	integer ikl
94	integer nh ! Averaged Snow History
95	integer nh__OK ! 1=>Conserve Snow History
96	real rh !
97	real dz ! Thickness
98	real dzro_1 ! Thickness X Density, Lay.1
99	real dzro_2 ! Thickness X Density, Lay.2
100	real dzro ! Thickness X Density, Aver.
101	real ro ! Averaged Density
102	real wn ! Averaged Water Content
103	real tn ! Averaged Temperature
104	real ag ! Averaged Snow Age
105	real SameOK ! 1. => Same Type of Grains
106	real G1same ! Averaged G1, same Grains
107	real G2same ! Averaged G2, same Grains
108	real typ__1 ! 1. => Lay1 Type: Dendritic
109	real zroNEW ! dz X ro, if fresh Snow
110	real G1_NEW ! G1, if fresh Snow
111	real G2_NEW ! G2, if fresh Snow
112	real zroOLD ! dz X ro, if old Snow
113	real G1_OLD ! G1, if old Snow
114	real G2_OLD ! G2, if old Snow
115	real SizNEW ! Size, if fresh Snow
116	real SphNEW ! Spheric.,if fresh Snow
117	real SizOLD ! Size, if old Snow
118	real SphOLD ! Spheric.,if old Snow
119	real Siz_av ! Averaged Grain Size
120	real Sph_av ! Averaged Grain Spher.
121	real Den_av ! Averaged Grain Dendr.
122	real DendOK ! 1. => Average is Dendr.
123	real G1diff ! Averaged G1, diff. Grains
124	real G2diff ! Averaged G2, diff. Grains
125	real G1 ! Averaged G1
126	real G2 ! Averaged G2
127
128
129
130	C +--Mean Properties
131	C + =================
132
133	C +-- 1 Densite, Contenu en Eau, Temperature /
134	C + Density, Water Content, Temperature
135	C + ------------------------------------
136
137	DO ikl = 1,knonv
138	dz = dzagra(ikl) + dzagrb(ikl)
139	dzro_1 = roagra(ikl) * dzagra(ikl)
140	dzro_2 = roagrb(ikl) * dzagrb(ikl)
141	dzro = dzro_1 + dzro_2
142	ro = dzro
143	. /max(epsi,dz)
144	wn = (dzro_1etagra(ikl) + dzro_2etagrb(ikl))
145	. /max(epsi,dzro)
146	tn = (dzro_1T_agra(ikl) + dzro_2T_agrb(ikl))
147	. /max(epsi,dzro)
148	ag = (dzro_1agagra(ikl) + dzro_2agagrb(ikl))
149	. /max(epsi,dzro)
150
151	rh = max(zero,sign(unun,zWEcSV(ikl)
152	. -0.5*WEagra(ikl)))
153	nh__OK = rh
154	nh = max(isagra(ikl),isagrb(ikl))
155	c #HB. * nh__OK
156	c #HB. + (1-nh__OK)* min(isagra(ikl),isagrb(ikl))
157
158
159
160	C +-- 2 Nouveaux Types de Grains / new Grain Types
161	C + -------------------------------------------
162
163	C +-- 2.1. Meme Type de Neige / same Grain Type
164	C + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
165	SameOK = max(zero,
166	. sign(unun, G1agra(ikl) *G1agrb(ikl) - eps_21))
167	G1same = (dzro_1G1agra(ikl) + dzro_2G1agrb(ikl))
168	. /max(epsi,dzro)
169	G2same = (dzro_1G2agra(ikl) + dzro_2G2agrb(ikl))
170	. /max(epsi,dzro)
171
172	C +-- 2.2. Types differents / differents Types
173	C + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
174	typ__1 = max(zero,sign(unun,epsi-G1agra(ikl))) ! =1.=> Dendritic
175	zroNEW = typ__1 *dzro_1 ! ro of Dendr.Lay.
176	. + (1.-typ__1) *dzro_2 !
177	G1_NEW = typ__1 *G1agra(ikl) ! G1 of Dendr.Lay.
178	. + (1.-typ__1) *G1agrb(ikl) !
179	G2_NEW = typ__1 *G2agra(ikl) ! G2 of Dendr.Lay.
180	. + (1.-typ__1) *G2agrb(ikl) !
181	zroOLD = (1.-typ__1) *dzro_1 ! ro of Spher.Lay.
182	. + typ__1 *dzro_2 !
183	G1_OLD = (1.-typ__1) *G1agra(ikl) ! G1 of Spher.Lay.
184	. + typ__1 *G1agrb(ikl) !
185	G2_OLD = (1.-typ__1) *G2agra(ikl) ! G2 of Spher.Lay.
186	. + typ__1 *G2agrb(ikl) !
187	SizNEW = -G1_NEW *DDcdSV/G1_dSV ! Size Dendr.Lay.
188	. +(1.+G1_NEW /G1_dSV) !
189	. (G2_NEW DScdSV/G1_dSV !
190	. +(1.-G2_NEW /G1_dSV)*DFcdSV) !
191	SphNEW = G2_NEW /G1_dSV ! Spher.Dendr.Lay.
192	SizOLD = G2_OLD ! Size Spher.Lay.
193	SphOLD = G1_OLD /G1_dSV ! Spher.Spher.Lay.
194	Siz_av = (zroNEWSizNEW+zroOLDSizOLD) ! Averaged Size
195	. /max(epsi,dzro) !
196	Sph_av = (zroNEWSphNEW+zroOLDSphOLD) ! Averaged Sphericity
197	. /max(epsi,dzro) !
198	Den_av = (Siz_av -( Sph_av *DScdSV !
199	. +(1.-Sph_av)*DFcdSV)) !
200	. / (DDcdSV -( Sph_av *DScdSV !
201	. +(1.-Sph_av)*DFcdSV)) !
202	DendOK = max(zero, !
203	. sign(unun, Sph_av *DScdSV ! Small Grains Contr.
204	. +(1.-Sph_av)*DFcdSV ! Faceted Grains Contr.
205	. - Siz_av ))!
206	C +... REMARQUE: le type moyen (dendritique ou non) depend
207	C + ^^^^^^^^ de la comparaison avec le diametre optique
208	C + d'une neige recente de dendricite nulle
209	C +... REMARK: the mean type (dendritic or not) depends
210	C + ^^^^^^ on the comparaison with the optical diameter
211	C + of a recent snow having zero dendricity
212
213	G1diff =( -DendOK *Den_av
214	. +(1.-DendOK)Sph_av) G1_dSV
215	G2diff = DendOK Sph_av G1_dSV
216	. +(1.-DendOK)*Siz_av
217	G1 = SameOK *G1same
218	. +(1.-SameOK)*G1diff
219	G2 = SameOK *G2same
220	. +(1.-SameOK)*G2diff
221
222
223	C +--Assignation to new Properties
224	C + =============================
225
226	isagra(ikl) = Agreg1(ikl) nh +(1.-Agreg1(ikl)) isagra(ikl)
227	dzagra(ikl) = Agreg1(ikl) dz +(1.-Agreg1(ikl)) dzagra(ikl)
228	T_agra(ikl) = Agreg1(ikl) tn +(1.-Agreg1(ikl)) T_agra(ikl)
229	roagra(ikl) = Agreg1(ikl) ro +(1.-Agreg1(ikl)) roagra(ikl)
230	etagra(ikl) = Agreg1(ikl) wn +(1.-Agreg1(ikl)) etagra(ikl)
231	G1agra(ikl) = Agreg1(ikl) G1 +(1.-Agreg1(ikl)) G1agra(ikl)
232	G2agra(ikl) = Agreg1(ikl) G2 +(1.-Agreg1(ikl)) G2agra(ikl)
233	agagra(ikl) = Agreg1(ikl) ag +(1.-Agreg1(ikl)) agagra(ikl)
234
235	END DO
236
237	return
238	end

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

Download in other formats:

Original Format