Context Navigation

phyetat0_mod.F90 @ 4374

Last change on this file since 4374 was 4374, checked in by lguez, 18 months ago

Report modifications from phylmd into phylmdiso

Report modifications of revision 4370 from phylmd into phylmdiso.

File size: 23.5 KB

Line
1	! $Id: phyetat0.F90 3890 2021-05-05 15:15:06Z jyg $
2
3	MODULE phyetat0_mod
4
5	PRIVATE
6	PUBLIC :: phyetat0
7
8	CONTAINS
9
10	SUBROUTINE phyetat0 (fichnom, clesphy0, tabcntr0)
11
12	USE dimphy, only: klon, zmasq, klev
13	USE iophy, ONLY : init_iophy_new
14	USE ocean_cpl_mod, ONLY : ocean_cpl_init
15	USE fonte_neige_mod, ONLY : fonte_neige_init
16	USE pbl_surface_mod, ONLY : pbl_surface_init
17	#ifdef ISO
18	USE fonte_neige_mod, ONLY : fonte_neige_init_iso
19	USE pbl_surface_mod, ONLY : pbl_surface_init_iso
20	#endif
21	USE phyetat0_get_mod, ONLY : phyetat0_get, phyetat0_srf
22	USE surface_data, ONLY : type_ocean, version_ocean
23	USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, phys_tstep, &
24	qsol, fevap, z0m, z0h, agesno, &
25	du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
26	falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, &
27	ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, rneb_ancien, radpas, radsol, rain_fall, ratqs, &
28	rnebcon, rugoro, sig1, snow_fall, solaire_etat0, sollw, sollwdown, &
29	solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
30	wake_deltat, wake_delta_pbl_TKE, delta_tsurf, beta_aridity, wake_fip, wake_pe, &
31	wake_s, wake_dens, awake_dens, cv_gen, zgam, zmax0, zmea, zpic, zsig, &
32	#ifdef ISO
33	fxtevap, xtsol, xt_ancien, xtl_ancien, xts_ancien, wake_deltaxt, &
34	xtrain_fall,xtsnow_fall, &
35	#endif
36	zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, u10m, v10m, treedrg, &
37	ale_wake, ale_bl_stat, ds_ns, dt_ns, delta_sst, delta_sal, dter, dser, &
38	dt_ds, ratqs_inter
39	!FC
40	USE geometry_mod, ONLY: longitude_deg, latitude_deg
41	USE iostart, ONLY: close_startphy, get_field, get_var, open_startphy
42	USE infotrac_phy, ONLY: nqtot, nbtr, type_trac, types_trac, tracers
43	USE readTracFiles_mod,ONLY: maxlen, new2oldH2O
44	USE traclmdz_mod, ONLY: traclmdz_from_restart
45	USE carbon_cycle_mod, ONLY: carbon_cycle_init, carbon_cycle_cpl, carbon_cycle_tr, carbon_cycle_rad, co2_send, RCO2_glo
46	USE indice_sol_mod, ONLY: nbsrf, is_ter, epsfra, is_lic, is_oce, is_sic
47	USE ocean_slab_mod, ONLY: nslay, tslab, seaice, tice, ocean_slab_init
48	USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
49	#ifdef CPP_XIOS
50	USE wxios, ONLY: missing_val
51	#else
52	use netcdf, only: missing_val => nf90_fill_real
53	#endif
54	use config_ocean_skin_m, only: activate_ocean_skin
55	#ifdef ISO
56	USE infotrac_phy, ONLY: niso
57	USE isotopes_routines_mod, ONLY: phyisoetat0
58	USE isotopes_mod, ONLY: iso_eau
59	#ifdef ISOVERIF
60	USE isotopes_verif_mod, ONLY: iso_verif_egalite_vect2D,iso_verif_egalite
61	#endif
62	#endif
63
64	IMPLICIT none
65	!======================================================================
66	! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
67	! Objet: Lecture de l'etat initial pour la physique
68	!======================================================================
69	include "dimsoil.h"
70	include "clesphys.h"
71	include "alpale.h"
72	include "compbl.h"
73	include "YOMCST.h"
74	!======================================================================
75	CHARACTER() fichnom
76
77	! les variables globales lues dans le fichier restart
78
79	REAL tsoil(klon, nsoilmx, nbsrf)
80	REAL qsurf(klon, nbsrf)
81	REAL snow(klon, nbsrf)
82	real fder(klon)
83	REAL run_off_lic_0(klon)
84	REAL fractint(klon)
85	REAL trs(klon, nbtr)
86	REAL zts(klon)
87	! pour drag arbres FC
88	REAL drg_ter(klon,klev)
89
90	CHARACTER*6 ocean_in
91	LOGICAL ok_veget_in
92
93	INTEGER longcles
94	PARAMETER ( longcles = 20 )
95	REAL clesphy0( longcles )
96
97	REAL xmin, xmax
98
99	INTEGER nid, nvarid
100	INTEGER ierr, i, nsrf, isoil , k
101	INTEGER length
102	PARAMETER (length=100)
103	INTEGER it, iq, isw
104	REAL tab_cntrl(length), tabcntr0(length)
105	CHARACTER*7 str7
106	CHARACTER*2 str2
107	LOGICAL :: found
108	REAL :: lon_startphy(klon), lat_startphy(klon)
109	CHARACTER(LEN=maxlen) :: tname, t(2)
110
111	#ifdef ISO
112	REAL xtsnow(niso,klon, nbsrf)
113	REAL xtrun_off_lic_0(niso,klon)
114	REAL Rland_ice(niso,klon)
115	#endif
116	! FH1D
117	! real iolat(jjm+1)
118	!real iolat(jjm+1-1/(iim*jjm))
119
120	! Ouvrir le fichier contenant l'etat initial:
121
122	CALL open_startphy(fichnom)
123
124	! Lecture des parametres de controle:
125
126	CALL get_var("controle", tab_cntrl)
127
128	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
129	! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
130	! Les constantes de la physiques sont lues dans la physique seulement.
131	! Les egalites du type
132	! tab_cntrl( 5 )=clesphy0(1)
133	! sont remplacees par
134	! clesphy0(1)=tab_cntrl( 5 )
135	! On inverse aussi la logique.
136	! On remplit les tab_cntrl avec les parametres lus dans les .def
137	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
138
139	DO i = 1, length
140	tabcntr0( i ) = tab_cntrl( i )
141	ENDDO
142
143	tab_cntrl(1)=pdtphys
144	tab_cntrl(2)=radpas
145
146	! co2_ppm : value from the previous time step
147
148	! co2_ppm0 : initial value of atmospheric CO2 (from create_etat0_limit.e .def)
149	co2_ppm0 = 284.32
150	! when no initial value is available e.g., from a restart
151	! this variable must be set in a .def file which will then be
152	! used by the conf_phys_m.F90 routine.
153	! co2_ppm0 = 284.32 (illustrative example on how to set the variable in .def
154	! file, for a pre-industrial CO2 concentration value)
155
156	IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
157	co2_ppm = tab_cntrl(3)
158	RCO2 = co2_ppm * 1.0e-06 * RMCO2 / RMD
159	IF (tab_cntrl(17) > 0. .AND. carbon_cycle_rad) THEN
160	RCO2_glo = tab_cntrl(17)
161	ELSE
162	RCO2_glo = co2_ppm0 * 1.0e-06 * RMCO2 / RMD
163	ENDIF
164	! ELSE : keep value from .def
165	ENDIF
166
167	solaire_etat0 = tab_cntrl(4)
168	tab_cntrl(5)=iflag_con
169	tab_cntrl(6)=nbapp_rad
170
171	IF (iflag_cycle_diurne.GE.1) tab_cntrl( 7) = iflag_cycle_diurne
172	IF (soil_model) tab_cntrl( 8) =1.
173	IF (new_oliq) tab_cntrl( 9) =1.
174	IF (ok_orodr) tab_cntrl(10) =1.
175	IF (ok_orolf) tab_cntrl(11) =1.
176	IF (ok_limitvrai) tab_cntrl(12) =1.
177
178	itau_phy = tab_cntrl(15)
179
180	clesphy0(1)=tab_cntrl( 5 )
181	clesphy0(2)=tab_cntrl( 6 )
182	clesphy0(3)=tab_cntrl( 7 )
183	clesphy0(4)=tab_cntrl( 8 )
184	clesphy0(5)=tab_cntrl( 9 )
185	clesphy0(6)=tab_cntrl( 10 )
186	clesphy0(7)=tab_cntrl( 11 )
187	clesphy0(8)=tab_cntrl( 12 )
188	clesphy0(9)=tab_cntrl( 17 )
189
190	! set time iteration
191	CALL init_iteration(itau_phy)
192
193	! read latitudes and make a sanity check (because already known from dyn)
194	CALL get_field("latitude",lat_startphy)
195	DO i=1,klon
196	IF (ABS(lat_startphy(i)-latitude_deg(i))>=1) THEN
197	WRITE(,) "phyetat0: Error! Latitude discrepancy wrt startphy file:",&
198	" i=",i," lat_startphy(i)=",lat_startphy(i),&
199	" latitude_deg(i)=",latitude_deg(i)
200	! This is presumably serious enough to abort run
201	CALL abort_physic("phyetat0","discrepancy in latitudes!",1)
202	ENDIF
203	IF (ABS(lat_startphy(i)-latitude_deg(i))>=0.0001) THEN
204	WRITE(,) "phyetat0: Warning! Latitude discrepancy wrt startphy file:",&
205	" i=",i," lat_startphy(i)=",lat_startphy(i),&
206	" latitude_deg(i)=",latitude_deg(i)
207	ENDIF
208	ENDDO
209
210	! read longitudes and make a sanity check (because already known from dyn)
211	CALL get_field("longitude",lon_startphy)
212	DO i=1,klon
213	IF (ABS(lon_startphy(i)-longitude_deg(i))>=1) THEN
214	IF (ABS(360-ABS(lon_startphy(i)-longitude_deg(i)))>=1) THEN
215	WRITE(,) "phyetat0: Error! Longitude discrepancy wrt startphy file:",&
216	" i=",i," lon_startphy(i)=",lon_startphy(i),&
217	" longitude_deg(i)=",longitude_deg(i)
218	! This is presumably serious enough to abort run
219	CALL abort_physic("phyetat0","discrepancy in longitudes!",1)
220	ENDIF
221	ENDIF
222	IF (ABS(lon_startphy(i)-longitude_deg(i))>=1) THEN
223	IF (ABS(360-ABS(lon_startphy(i)-longitude_deg(i))) > 0.0001) THEN
224	WRITE(,) "phyetat0: Warning! Longitude discrepancy wrt startphy file:",&
225	" i=",i," lon_startphy(i)=",lon_startphy(i),&
226	" longitude_deg(i)=",longitude_deg(i)
227	ENDIF
228	ENDIF
229	ENDDO
230
231	! Lecture du masque terre mer
232
233	CALL get_field("masque", zmasq, found)
234	IF (.NOT. found) THEN
235	PRINT*, 'phyetat0: Le champ <masque> est absent'
236	PRINT *, 'fichier startphy non compatible avec phyetat0'
237	ENDIF
238
239	! Lecture des fractions pour chaque sous-surface
240
241	! initialisation des sous-surfaces
242
243	pctsrf = 0.
244
245	! fraction de terre
246
247	CALL get_field("FTER", pctsrf(:, is_ter), found)
248	IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FTER> est absent'
249
250	! fraction de glace de terre
251
252	CALL get_field("FLIC", pctsrf(:, is_lic), found)
253	IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FLIC> est absent'
254
255	! fraction d'ocean
256
257	CALL get_field("FOCE", pctsrf(:, is_oce), found)
258	IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FOCE> est absent'
259
260	! fraction glace de mer
261
262	CALL get_field("FSIC", pctsrf(:, is_sic), found)
263	IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FSIC> est absent'
264
265	! Verification de l'adequation entre le masque et les sous-surfaces
266
267	fractint( 1 : klon) = pctsrf(1 : klon, is_ter) &
268	+ pctsrf(1 : klon, is_lic)
269	DO i = 1 , klon
270	IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN
271	WRITE(, ) 'phyetat0: attention fraction terre pas ', &
272	'coherente ', i, zmasq(i), pctsrf(i, is_ter) &
273	, pctsrf(i, is_lic)
274	WRITE(, ) 'Je force la coherence zmasq=fractint'
275	zmasq(i) = fractint(i)
276	ENDIF
277	ENDDO
278	fractint (1 : klon) = pctsrf(1 : klon, is_oce) &
279	+ pctsrf(1 : klon, is_sic)
280	DO i = 1 , klon
281	IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN
282	WRITE(, ) 'phyetat0 attention fraction ocean pas ', &
283	'coherente ', i, zmasq(i) , pctsrf(i, is_oce) &
284	, pctsrf(i, is_sic)
285	WRITE(, ) 'Je force la coherence zmasq=1.-fractint'
286	zmasq(i) = 1. - fractint(i)
287	ENDIF
288	ENDDO
289
290	!===================================================================
291	! Lecture des temperatures du sol:
292	!===================================================================
293
294	found=phyetat0_get(ftsol(:,1),"TS","Surface temperature",283.)
295	IF (found) THEN
296	DO nsrf=2,nbsrf
297	ftsol(:,nsrf)=ftsol(:,1)
298	ENDDO
299	ELSE
300	found=phyetat0_srf(ftsol,"TS","Surface temperature",283.)
301	ENDIF
302
303	!===================================================================
304	! Lecture des albedo difus et direct
305	!===================================================================
306
307	DO nsrf = 1, nbsrf
308	DO isw=1, nsw
309	IF (isw.GT.99) THEN
310	PRINT*, "Trop de bandes SW"
311	call abort_physic("phyetat0", "", 1)
312	ENDIF
313	WRITE(str2, '(i2.2)') isw
314	found=phyetat0_srf(falb_dir(:, isw,:),"A_dir_SW"//str2//"srf","Direct Albedo",0.2)
315	found=phyetat0_srf(falb_dif(:, isw,:),"A_dif_SW"//str2//"srf","Direct Albedo",0.2)
316	ENDDO
317	ENDDO
318
319	found=phyetat0_srf(u10m,"U10M","u a 10m",0.)
320	found=phyetat0_srf(v10m,"V10M","v a 10m",0.)
321
322	!===================================================================
323	! Lecture des temperatures du sol profond:
324	!===================================================================
325
326	DO isoil=1, nsoilmx
327	IF (isoil.GT.99) THEN
328	PRINT*, "Trop de couches "
329	call abort_physic("phyetat0", "", 1)
330	ENDIF
331	WRITE(str2,'(i2.2)') isoil
332	found=phyetat0_srf(tsoil(:, isoil,:),"Tsoil"//str2//"srf","Temp soil",0.)
333	IF (.NOT. found) THEN
334	PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
335	PRINT*, " Il prend donc la valeur de surface"
336	tsoil(:, isoil, :)=ftsol(:, :)
337	ENDIF
338	ENDDO
339
340	!=======================================================================
341	! Lecture precipitation/evaporation
342	!=======================================================================
343
344	found=phyetat0_srf(qsurf,"QS","Near surface hmidity",0.)
345	found=phyetat0_get(qsol,"QSOL","Surface hmidity / bucket",0.)
346	found=phyetat0_srf(snow,"SNOW","Surface snow",0.)
347	found=phyetat0_srf(fevap,"EVAP","evaporation",0.)
348	found=phyetat0_get(snow_fall,"snow_f","snow fall",0.)
349	found=phyetat0_get(rain_fall,"rain_f","rain fall",0.)
350
351	!=======================================================================
352	! Radiation
353	!=======================================================================
354
355	found=phyetat0_get(solsw,"solsw","net SW radiation surf",0.)
356	found=phyetat0_get(solswfdiff,"solswfdiff","fraction of SW radiation surf that is diffuse",1.)
357	found=phyetat0_get(sollw,"sollw","net LW radiation surf",0.)
358	found=phyetat0_get(sollwdown,"sollwdown","down LW radiation surf",0.)
359	IF (.NOT. found) THEN
360	sollwdown(:) = 0. ; zts(:)=0.
361	DO nsrf=1,nbsrf
362	zts(:)=zts(:)+ftsol(:,nsrf)*pctsrf(:,nsrf)
363	ENDDO
364	sollwdown(:)=sollw(:)+RSIGMAzts(:)*4
365	ENDIF
366
367	found=phyetat0_get(radsol,"RADS","Solar radiation",0.)
368	found=phyetat0_get(fder,"fder","Flux derivative",0.)
369
370
371	! Lecture de la longueur de rugosite
372	found=phyetat0_srf(z0m,"RUG","Z0m ancien",0.001)
373	IF (found) THEN
374	z0h(:,1:nbsrf)=z0m(:,1:nbsrf)
375	ELSE
376	found=phyetat0_srf(z0m,"Z0m","Roughness length, momentum ",0.001)
377	found=phyetat0_srf(z0h,"Z0h","Roughness length, enthalpy ",0.001)
378	ENDIF
379	!FC
380	IF (ifl_pbltree>0) THEN
381	!CALL get_field("FTER", pctsrf(:, is_ter), found)
382	treedrg(:,1:klev,1:nbsrf)= 0.0
383	CALL get_field("treedrg_ter", drg_ter(:,:), found)
384	! found=phyetat0_srf(treedrg,"treedrg","drag from vegetation" , 0.)
385	!lecture du profile de freinage des arbres
386	IF (.not. found ) THEN
387	treedrg(:,1:klev,1:nbsrf)= 0.0
388	ELSE
389	treedrg(:,1:klev,is_ter)= drg_ter(:,:)
390	! found=phyetat0_get(treedrg,"treedrg","freinage arbres",0.)
391	ENDIF
392	ELSE
393	! initialize treedrg(), because it will be written in restartphy.nc
394	treedrg(:,:,:) = 0.0
395	ENDIF
396
397	! Lecture de l'age de la neige:
398	found=phyetat0_srf(agesno,"AGESNO","SNOW AGE",0.001)
399
400	ancien_ok=.true.
401	ancien_ok=ancien_ok.AND.phyetat0_get(t_ancien,"TANCIEN","TANCIEN",0.)
402	ancien_ok=ancien_ok.AND.phyetat0_get(q_ancien,"QANCIEN","QANCIEN",0.)
403	ancien_ok=ancien_ok.AND.phyetat0_get(ql_ancien,"QLANCIEN","QLANCIEN",0.)
404	ancien_ok=ancien_ok.AND.phyetat0_get(qs_ancien,"QSANCIEN","QSANCIEN",0.)
405	ancien_ok=ancien_ok.AND.phyetat0_get(rneb_ancien,"RNEBANCIEN","RNEBANCIEN",0.)
406	ancien_ok=ancien_ok.AND.phyetat0_get(u_ancien,"UANCIEN","UANCIEN",0.)
407	ancien_ok=ancien_ok.AND.phyetat0_get(v_ancien,"VANCIEN","VANCIEN",0.)
408	ancien_ok=ancien_ok.AND.phyetat0_get(prw_ancien,"PRWANCIEN","PRWANCIEN",0.)
409	ancien_ok=ancien_ok.AND.phyetat0_get(prlw_ancien,"PRLWANCIEN","PRLWANCIEN",0.)
410	ancien_ok=ancien_ok.AND.phyetat0_get(prsw_ancien,"PRSWANCIEN","PRSWANCIEN",0.)
411
412	! Ehouarn: addtional tests to check if t_ancien, q_ancien contain
413	! dummy values (as is the case when generated by ce0l,
414	! or by iniaqua)
415	IF ( (maxval(q_ancien).EQ.minval(q_ancien)) .OR. &
416	(maxval(ql_ancien).EQ.minval(ql_ancien)) .OR. &
417	(maxval(qs_ancien).EQ.minval(qs_ancien)) .OR. &
418	(maxval(rneb_ancien).EQ.minval(rneb_ancien)) .OR. &
419	(maxval(prw_ancien).EQ.minval(prw_ancien)) .OR. &
420	(maxval(prlw_ancien).EQ.minval(prlw_ancien)) .OR. &
421	(maxval(prsw_ancien).EQ.minval(prsw_ancien)) .OR. &
422	(maxval(t_ancien).EQ.minval(t_ancien)) ) THEN
423	ancien_ok=.false.
424	ENDIF
425
426	found=phyetat0_get(clwcon,"CLWCON","CLWCON",0.)
427	found=phyetat0_get(rnebcon,"RNEBCON","RNEBCON",0.)
428	found=phyetat0_get(ratqs,"RATQS","RATQS",0.)
429
430	found=phyetat0_get(run_off_lic_0,"RUNOFFLIC0","RUNOFFLIC0",0.)
431
432	!==================================
433	! TKE
434	!==================================
435	!
436	IF (iflag_pbl>1) then
437	found=phyetat0_srf(pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
438	ENDIF
439
440	IF (iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 ) then
441	found=phyetat0_srf(wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
442	!! found=phyetat0_srf(delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
443	found=phyetat0_srf(delta_tsurf,"DELTATS","Delta Ts wk/env ",0.)
444	!! found=phyetat0_srf(beta_aridity,"BETA_S","Aridity factor ",1.)
445	found=phyetat0_srf(beta_aridity,"BETAS","Aridity factor ",1.)
446	ENDIF !(iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 )
447
448	!==================================
449	! thermiques, poches, convection
450	!==================================
451
452	! Emanuel
453	found=phyetat0_get(sig1,"sig1","sig1",0.)
454	found=phyetat0_get(w01,"w01","w01",0.)
455
456	! Wake
457	found=phyetat0_get(wake_deltat,"WAKE_DELTAT","Delta T wake/env",0.)
458	found=phyetat0_get(wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
459	found=phyetat0_get(wake_s,"WAKE_S","Wake frac. area",0.)
460	!jyg<
461	! Set wake_dens to -1000. when there is no restart so that the actual
462	! initialization is made in calwake.
463	!! found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",0.)
464	found=phyetat0_get(wake_dens,"WAKE_DENS","Wake num. /unit area",-1000.)
465	found=phyetat0_get(awake_dens,"AWAKE_DENS","Active Wake num. /unit area",0.)
466	found=phyetat0_get(cv_gen,"CV_GEN","CB birth rate",0.)
467	!>jyg
468	found=phyetat0_get(wake_cstar,"WAKE_CSTAR","WAKE_CSTAR",0.)
469	found=phyetat0_get(wake_pe,"WAKE_PE","WAKE_PE",0.)
470	found=phyetat0_get(wake_fip,"WAKE_FIP","WAKE_FIP",0.)
471
472	! Thermiques
473	found=phyetat0_get(zmax0,"ZMAX0","ZMAX0",40.)
474	found=phyetat0_get(f0,"F0","F0",1.e-5)
475	found=phyetat0_get(fm_therm,"FM_THERM","Thermals mass flux",0.)
476	found=phyetat0_get(entr_therm,"ENTR_THERM","Thermals Entrain.",0.)
477	found=phyetat0_get(detr_therm,"DETR_THERM","Thermals Detrain.",0.)
478
479	! ALE/ALP
480	found=phyetat0_get(ale_bl,"ALE_BL","ALE BL",0.)
481	found=phyetat0_get(ale_bl_trig,"ALE_BL_TRIG","ALE BL_TRIG",0.)
482	found=phyetat0_get(alp_bl,"ALP_BL","ALP BL",0.)
483	found=phyetat0_get(ale_wake,"ALE_WAKE","ALE_WAKE",0.)
484	found=phyetat0_get(ale_bl_stat,"ALE_BL_STAT","ALE_BL_STAT",0.)
485
486	! fisrtilp/Clouds 0.002 could be ratqsbas. But can stay like this as well
487	found=phyetat0_get(ratqs_inter,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
488
489	!===========================================
490	! Read and send field trs to traclmdz
491	!===========================================
492
493	!--OB now this is for co2i - ThL: and therefore also for inco
494	IF (ANY(types_trac == 'co2i') .OR. ANY(types_trac == 'inco')) THEN
495	IF (carbon_cycle_cpl) THEN
496	ALLOCATE(co2_send(klon), stat=ierr)
497	IF (ierr /= 0) CALL abort_physic('phyetat0', 'pb allocation co2_send', 1)
498	found=phyetat0_get(co2_send,"co2_send","co2 send",co2_ppm0)
499	ENDIF
500	ELSE IF (type_trac == 'lmdz') THEN
501	it = 0
502	DO iq = 1, nqtot
503	IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
504	it = it+1
505	tname = tracers(iq)%name
506	t(1) = 'trs_'//TRIM(tname); t(2) = 'trs_'//TRIM(new2oldH2O(tname))
507	found = phyetat0_get(trs(:,it), t(:), "Surf trac"//TRIM(tname), 0.)
508	END DO
509	CALL traclmdz_from_restart(trs)
510	ENDIF
511
512	#ifdef ISO
513	! initialise les isotopes
514	write(,) 'phyetat0 1069'
515	CALL phyisoetat0 (snow,run_off_lic_0, &
516	& xtsnow,xtrun_off_lic_0, &
517	& Rland_ice)
518	#ifdef ISOVERIF
519	write(,) 'phyetat0 1074'
520	if (iso_eau.gt.0) then
521	call iso_verif_egalite_vect2D( &
522	& xtsnow,snow, &
523	& 'phyetat0 1101a',niso,klon,nbsrf)
524	do i=1,klon
525	call iso_verif_egalite(Rland_ice(iso_eau,i),1.0, &
526	& 'phyetat0 1101b')
527	enddo
528	endif
529	write(,) 'phyetat0 1102'
530	#endif
531	#endif
532
533	!===========================================
534	! ondes de gravite / relief
535	!===========================================
536
537	! ondes de gravite non orographiques
538	IF (ok_gwd_rando) found = &
539	phyetat0_get(du_gwd_rando,"du_gwd_rando","du_gwd_rando",0.)
540	IF (.NOT. ok_hines .AND. ok_gwd_rando) found &
541	= phyetat0_get(du_gwd_front,"du_gwd_front","du_gwd_front",0.)
542
543	! prise en compte du relief sous-maille
544	found=phyetat0_get(zmea,"ZMEA","sub grid orography",0.)
545	found=phyetat0_get(zstd,"ZSTD","sub grid orography",0.)
546	found=phyetat0_get(zsig,"ZSIG","sub grid orography",0.)
547	found=phyetat0_get(zgam,"ZGAM","sub grid orography",0.)
548	found=phyetat0_get(zthe,"ZTHE","sub grid orography",0.)
549	found=phyetat0_get(zpic,"ZPIC","sub grid orography",0.)
550	found=phyetat0_get(zval,"ZVAL","sub grid orography",0.)
551	found=phyetat0_get(zmea,"ZMEA","sub grid orography",0.)
552	found=phyetat0_get(rugoro,"RUGSREL","sub grid orography",0.)
553
554	!===========================================
555	! Initialize ocean
556	!===========================================
557
558	IF ( type_ocean == 'slab' ) THEN
559	CALL ocean_slab_init(phys_tstep, pctsrf)
560	IF (nslay.EQ.1) THEN
561	found=phyetat0_get(tslab,["tslab01","tslab "],"tslab",0.)
562	ELSE
563	DO i=1,nslay
564	WRITE(str2,'(i2.2)') i
565	found=phyetat0_get(tslab(:,i),"tslab"//str2,"tslab",0.)
566	ENDDO
567	ENDIF
568	IF (.NOT. found) THEN
569	PRINT*, "phyetat0: Le champ <tslab> est absent"
570	PRINT*, "Initialisation a tsol_oce"
571	DO i=1,nslay
572	tslab(:,i)=MAX(ftsol(:,is_oce),271.35)
573	ENDDO
574	ENDIF
575
576	! Sea ice variables
577	IF (version_ocean == 'sicINT') THEN
578	found=phyetat0_get(tice,"slab_tice","slab_tice",0.)
579	IF (.NOT. found) THEN
580	PRINT*, "phyetat0: Le champ <tice> est absent"
581	PRINT*, "Initialisation a tsol_sic"
582	tice(:)=ftsol(:,is_sic)
583	ENDIF
584	found=phyetat0_get(seaice,"seaice","seaice",0.)
585	IF (.NOT. found) THEN
586	PRINT*, "phyetat0: Le champ <seaice> est absent"
587	PRINT*, "Initialisation a 0/1m suivant fraction glace"
588	seaice(:)=0.
589	WHERE (pctsrf(:,is_sic).GT.EPSFRA)
590	seaice=917.
591	ENDWHERE
592	ENDIF
593	ENDIF !sea ice INT
594	ENDIF ! Slab
595
596	if (activate_ocean_skin >= 1) then
597	if (activate_ocean_skin == 2 .and. type_ocean == 'couple') then
598	found = phyetat0_get(delta_sal, "delta_sal", &
599	"ocean-air interface salinity minus bulk salinity", 0.)
600	found = phyetat0_get(delta_sst, "delta_SST", &
601	"ocean-air interface temperature minus bulk SST", 0.)
602	found = phyetat0_get(dter, "dter", &
603	"ocean-air interface temperature minus subskin temperature", 0.)
604	found = phyetat0_get(dser, "dser", &
605	"ocean-air interface salinity minus subskin salinity", 0.)
606	found = phyetat0_get(dt_ds, "dt_ds", "(tks / tkt) * dTer", 0.)
607
608	where (pctsrf(:, is_oce) == 0.)
609	delta_sst = missing_val
610	delta_sal = missing_val
611	dter = missing_val
612	dser = missing_val
613	dt_ds = missing_val
614	end where
615	end if
616
617	found = phyetat0_get(ds_ns, "dS_ns", "delta salinity near surface", 0.)
618	found = phyetat0_get(dt_ns, "dT_ns", "delta temperature near surface", &
619	0.)
620
621	where (pctsrf(:, is_oce) == 0.)
622	ds_ns = missing_val
623	dt_ns = missing_val
624	delta_sst = missing_val
625	delta_sal = missing_val
626	end where
627	end if
628
629	! on ferme le fichier
630	CALL close_startphy
631
632	! Initialize module pbl_surface_mod
633
634	#ifdef ISOVERIF
635	write(,) 'phyetat0 572: snow(994,:)=',snow(994,2)
636	write(,) 'xtsnow(:,994,2)=',xtsnow(:,994,2)
637	#endif
638
639	CALL pbl_surface_init(fder, snow, qsurf, tsoil)
640	#ifdef ISO
641	CALL pbl_surface_init_iso(xtsnow,Rland_ice)
642	#endif
643
644	! Initialize module ocean_cpl_mod for the case of coupled ocean
645	IF ( type_ocean == 'couple' ) THEN
646	CALL ocean_cpl_init(phys_tstep, longitude_deg, latitude_deg)
647	ENDIF
648
649	! CALL init_iophy_new(latitude_deg, longitude_deg)
650
651	! Initilialize module fonte_neige_mod
652	CALL fonte_neige_init(run_off_lic_0)
653	#ifdef ISO
654	CALL fonte_neige_init_iso(xtrun_off_lic_0)
655	#endif
656
657	END SUBROUTINE phyetat0
658
659	END MODULE phyetat0_mod
660

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

Download in other formats:

Original Format