Context Navigation

phyetat0_mod.F90 @ 5087

Last change on this file since 5087 was 5084, checked in by Laurent Fairhead, 12 months ago
Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks AB, LF
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 23.1 KB

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

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

Download in other formats:

Original Format