Context Navigation

phyetat0.F90 @ 4184

Last change on this file since 4184 was 4170, checked in by dcugnet, 2 years ago

The variable "types_trac" is the equivalent of "type_trac" in case multiple sections must be read
and used in "tracer.def" file.
Tests on the "type_trac" were replaced with tests on the vector "types_trac".
Most of the time, there are two components: 'lmdz' and a second one. The later has priority on 'lmdz'
and must be used for the tests. For more components, care must be taken to execute specific parts
of the code on the right tracers ; the tracers(:)%component has been created in that respect.

File size: 24.7 KB

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

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

Download in other formats:

Original Format