Context Navigation

phyredem.F90 @ 5144

Last change on this file since 5144 was 5139, checked in by abarral, 4 months ago
Put nuage.h, flux_arp.h, compbl.h into modules Move unused phylmd/ini_hist* to obsolete
File size: 20.9 KB

Rev	Line
[5099]	1
[3927]	2	! $Id: phyredem.F90 3506 2019-05-16 14:38:11Z ymeurdesoif $
[5099]	3
[5106]	4	SUBROUTINE phyredem(fichnom)
[5099]	5
[3927]	6	!-------------------------------------------------------------------------------
	7	! Author: Z.X. Li (LMD/CNRS), 1993/08/18
	8	!-------------------------------------------------------------------------------
	9	! Purpose: Write restart state for physics.
	10	!-------------------------------------------------------------------------------
	11	USE dimphy, ONLY: klon, klev
[5101]	12	USE fonte_neige_mod, ONLY: fonte_neige_final
	13	USE pbl_surface_mod, ONLY: pbl_surface_final
[3940]	14	USE phys_state_var_mod, ONLY: radpas, zmasq, pctsrf, &
	15	ftsol, beta_aridity, delta_tsurf, falb_dir, &
[3927]	16	falb_dif, qsol, fevap, radsol, solsw, sollw, &
[4523]	17	sollwdown, rain_fall, snow_fall, bs_fall, z0m, z0h, &
[3927]	18	agesno, zmea, zstd, zsig, zgam, zthe, zpic, &
	19	zval, rugoro, t_ancien, q_ancien, &
[4523]	20	prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, &
	21	ql_ancien, qs_ancien, qbs_ancien, u_ancien, &
[3927]	22	v_ancien, clwcon, rnebcon, ratqs, pbl_tke, &
	23	wake_delta_pbl_tke, zmax0, f0, sig1, w01, &
	24	wake_deltat, wake_deltaq, wake_s, wake_dens, &
[4056]	25	awake_dens, cv_gen, &
[3927]	26	wake_cstar, &
	27	wake_pe, wake_fip, fm_therm, entr_therm, &
	28	detr_therm, ale_bl, ale_bl_trig, alp_bl, &
	29	ale_wake, ale_bl_stat, &
[3940]	30	du_gwd_rando, du_gwd_front, u10m, v10m, &
	31	treedrg, solswfdiff, delta_sal, ds_ns, dt_ns, &
[4613]	32	delta_sst, ratqs_inter_, dter, dser, dt_ds
[3927]	33	#ifdef ISO
	34	USE phys_state_var_mod, ONLY: xtsol, fxtevap,xtrain_fall, xtsnow_fall, &
	35	xt_ancien, xtl_ancien, xts_ancien, &
	36	wake_deltaxt
	37	#endif
[5112]	38	USE lmdz_geometry, ONLY: longitude_deg, latitude_deg
[3927]	39	USE iostart, ONLY: open_restartphy, close_restartphy, enddef_restartphy, put_field, put_var
[5101]	40	USE traclmdz_mod, ONLY: traclmdz_to_restart
[4389]	41	USE infotrac_phy, ONLY: type_trac, nqtot, tracers, nbtr, niso
[3927]	42	#ifdef ISO
	43	#ifdef ISOVERIF
	44	USE isotopes_verif_mod
	45	#endif
	46	#endif
[5101]	47	USE carbon_cycle_mod, ONLY: carbon_cycle_cpl, co2_send, carbon_cycle_rad, RCO2_glo
[3927]	48	USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic, epsfra
	49	USE surface_data, ONLY: type_ocean, version_ocean
[5101]	50	USE ocean_slab_mod, ONLY: nslay, tslab, seaice, tice, fsic
[3927]	51	USE time_phylmdz_mod, ONLY: annee_ref, day_end, itau_phy, pdtphys
[5117]	52	USE config_ocean_skin_m, ONLY: activate_ocean_skin
[5132]	53	USE lmdz_abort_physic, ONLY: abort_physic
[5134]	54	USE lmdz_alpale
[5137]	55	USE lmdz_clesphys
[5139]	56	USE lmdz_compbl, ONLY: iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
[3927]	57
[5134]	58	IMPLICIT NONE
[3927]	59
	60	include "dimsoil.h"
	61	!======================================================================
	62	CHARACTER() fichnom
	63
	64	! les variables globales ecrites dans le fichier restart
	65
	66	REAL tsoil(klon, nsoilmx, nbsrf)
	67	REAL qsurf(klon, nbsrf)
	68	REAL snow(klon, nbsrf)
[5117]	69	REAL fder(klon)
[3927]	70	REAL run_off_lic_0(klon)
	71	REAL trs(klon, nbtr)
	72	#ifdef ISO
	73	REAL xtsnow(niso,klon, nbsrf)
	74	REAL xtrun_off_lic_0(niso,klon)
	75	REAL Rland_ice(niso,klon)
	76	#endif
	77
	78	INTEGER nid, nvarid, idim1, idim2, idim3
	79	INTEGER ierr
	80	INTEGER length
	81	PARAMETER (length=100)
	82	REAL tab_cntrl(length)
	83
	84	INTEGER isoil, nsrf,isw
	85	CHARACTER (len=2) :: str2
	86	CHARACTER (len=256) :: nam, lnam
[4056]	87	INTEGER :: it, iq, pass
[3927]	88
	89	!======================================================================
	90
	91	! Get variables which will be written to restart file from module
	92	! pbl_surface_mod
	93	CALL pbl_surface_final(fder, snow, qsurf, tsoil &
	94	#ifdef ISO
	95	,xtsnow,Rland_ice &
	96	#endif
	97	)
	98
	99	! Get a variable calculated in module fonte_neige_mod
	100	CALL fonte_neige_final(run_off_lic_0 &
	101	#ifdef ISO
	102	,xtrun_off_lic_0 &
	103	#endif
	104	)
	105
	106	!======================================================================
	107
	108	CALL open_restartphy(fichnom)
	109
	110
	111	DO ierr = 1, length
	112	tab_cntrl(ierr) = 0.0
	113	ENDDO
	114	tab_cntrl(1) = pdtphys
	115	tab_cntrl(2) = radpas
	116	! co2_ppm : current value of atmospheric CO2
	117	tab_cntrl(3) = co2_ppm
	118	tab_cntrl(4) = solaire
	119	tab_cntrl(5) = iflag_con
	120	tab_cntrl(6) = nbapp_rad
	121
[5082]	122	IF( iflag_cycle_diurne>=1 ) tab_cntrl( 7 ) = iflag_cycle_diurne
[3927]	123	IF( soil_model ) tab_cntrl( 8 ) = 1.
	124	IF( new_oliq ) tab_cntrl( 9 ) = 1.
	125	IF( ok_orodr ) tab_cntrl(10 ) = 1.
	126	IF( ok_orolf ) tab_cntrl(11 ) = 1.
	127
	128	tab_cntrl(13) = day_end
	129	tab_cntrl(14) = annee_ref
	130	tab_cntrl(15) = itau_phy
	131
	132	! co2_ppm0 : initial value of atmospheric CO2
[4298]	133	! tab_cntrl(16) = co2_ppm0
[3927]	134
[4298]	135	! PC -- initial value of RCO2 for the radiation scheme
	136	! tab_cntrl(17) = co2_ppm * 1.0e-06 * RMCO2 / RMD
	137	IF (carbon_cycle_rad) tab_cntrl(17) = RCO2_glo
	138	!PRINT*, "PC : phyredem RCO2_glo =",RCO2_glo
	139
[3927]	140	DO pass=1,2 ! pass=1 netcdf definition ; pass=2 netcdf write
	141
	142	CALL put_var(pass, "controle", "Parametres de controle", tab_cntrl)
	143
	144	CALL put_field(pass,"longitude", &
	145	"Longitudes de la grille physique", longitude_deg)
	146
	147	CALL put_field(pass,"latitude", "Latitudes de la grille physique", latitude_deg)
	148
	149	! PB ajout du masque terre/mer
	150
	151	CALL put_field(pass,"masque", "masque terre mer", zmasq)
	152
	153	! BP ajout des fraction de chaque sous-surface
	154
	155	! Get last fractions from slab ocean
	156	IF (type_ocean == 'slab' .AND. version_ocean == "sicINT") THEN
[5082]	157	WHERE (1.-zmasq(:)>EPSFRA)
[3927]	158	pctsrf(:,is_oce)=(1.-fsic(:))*(1.-zmasq(:))
	159	pctsrf(:,is_sic)=fsic(:)*(1.-zmasq(:))
	160	END WHERE
	161	END IF
	162
	163	! 1. fraction de terre
	164
	165	CALL put_field(pass,"FTER", "fraction de continent", pctsrf(:, is_ter))
	166
	167	! 2. Fraction de glace de terre
	168
	169	CALL put_field(pass,"FLIC", "fraction glace de terre", pctsrf(:, is_lic))
	170
	171	! 3. fraction ocean
	172
	173	CALL put_field(pass,"FOCE", "fraction ocean", pctsrf(:, is_oce))
	174
	175	! 4. Fraction glace de mer
	176
	177	CALL put_field(pass,"FSIC", "fraction glace mer", pctsrf(:, is_sic))
	178
[4389]	179	IF(nbsrf >99) CALL abort_physic("phyredem", "Trop de sous-mailles", 1)
	180	IF(nsoilmx>99) CALL abort_physic("phyredem", "Trop de sous-mailles", 1)
	181	IF(nsw >99) CALL abort_physic("phyredem", "Trop de bandes", 1)
[3927]	182
[3940]	183	! Surface variables
[3927]	184	CALL put_field_srf1(pass,"TS","Temperature",ftsol(:,:))
	185
[5116]	186	IF (iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1) THEN
[4056]	187	CALL put_field_srf1(pass, "DELTATS", &
	188	"w-x surface temperature difference", delta_tsurf(:,:))
	189	CALL put_field_srf1(pass, "BETAS", "Aridity factor", beta_aridity(:,:))
	190	end IF
[3940]	191	! End surface variables
	192
[3927]	193	! ================== Albedo =======================================
[5103]	194	PRINT*,'PHYREDEM NOUVEAU'
[3927]	195	CALL put_field_srf2(pass,"A_dir_SW","Albedo direct",falb_dir(:,:,:))
	196	CALL put_field_srf2(pass,"A_dif_SW","Albedo diffus",falb_dif(:,:,:))
	197
	198	CALL put_field_srf1(pass,"U10M", "u a 10m", u10m)
	199
	200	CALL put_field_srf1(pass,"V10M", "v a 10m", v10m)
	201
	202
	203	! ================== Tsoil =========================================
	204	CALL put_field_srf2(pass,"Tsoil","Temperature",tsoil(:,:,:))
	205	!FC
	206	! CALL put_field_srf2("treedrg","freinage arbres",treedrg(:,:,:))
	207	CALL put_field(pass,"treedrg_ter","freinage arbres",treedrg(:,:,is_ter))
	208
	209
	210	CALL put_field_srf1(pass,"QS" , "Humidite",qsurf(:,:))
	211
	212	CALL put_field (pass,"QSOL", "Eau dans le sol (mm)", qsol)
	213
	214	CALL put_field_srf1(pass,"EVAP", "Evaporation", fevap(:,:))
	215
	216	CALL put_field_srf1(pass,"SNOW", "Neige", snow(:,:))
	217
	218	CALL put_field(pass,"RADS", "Rayonnement net a la surface", radsol)
	219
	220	CALL put_field(pass,"solsw", "Rayonnement solaire a la surface", solsw)
	221
[3940]	222	CALL put_field(pass,"solswfdiff", "Fraction du rayonnement solaire a la surface qui est diffus", solswfdiff)
	223
[3927]	224	CALL put_field(pass,"sollw", "Rayonnement IF a la surface", sollw)
	225
	226	CALL put_field(pass,"sollwdown", "Rayonnement down IF a la surface", sollwdown)
	227
	228	CALL put_field(pass,"fder", "Derive de flux", fder)
	229
	230	CALL put_field(pass,"rain_f", "precipitation liquide", rain_fall)
	231
	232	CALL put_field(pass,"snow_f", "precipitation solide", snow_fall)
	233
	234	CALL put_field_srf1(pass,"Z0m", "rugosite", z0m(:,:))
	235
	236	CALL put_field_srf1(pass,"Z0h", "rugosite", z0h(:,:))
	237
	238	CALL put_field_srf1(pass,"AGESNO", "Age de la neige", agesno(:,:))
	239
	240	CALL put_field(pass,"ZMEA", "ZMEA", zmea)
	241
	242	CALL put_field(pass,"ZSTD", "ZSTD", zstd)
	243
	244	CALL put_field(pass,"ZSIG", "ZSIG", zsig)
	245
	246	CALL put_field(pass,"ZGAM", "ZGAM", zgam)
	247
	248	CALL put_field(pass,"ZTHE", "ZTHE", zthe)
	249
	250	CALL put_field(pass,"ZPIC", "ZPIC", zpic)
	251
	252	CALL put_field(pass,"ZVAL", "ZVAL", zval)
	253
	254	CALL put_field(pass,"RUGSREL", "RUGSREL", rugoro)
	255
	256	CALL put_field(pass,"TANCIEN", "TANCIEN", t_ancien)
	257
	258	CALL put_field(pass,"QANCIEN", "QANCIEN", q_ancien)
	259
	260	CALL put_field(pass,"QLANCIEN", "QLANCIEN", ql_ancien)
	261
	262	CALL put_field(pass,"QSANCIEN", "QSANCIEN", qs_ancien)
	263
[4523]	264	IF (ok_bs) THEN
	265	CALL put_field(pass,"bs_f", "precipitation neige soufflee", bs_fall)
	266	CALL put_field(pass,"QBSANCIEN", "QBSANCIEN", qbs_ancien)
	267	CALL put_field(pass,"PRBSWANCIEN", "PRBSWANCIEN", prbsw_ancien)
	268	ENDIF
	269
[3927]	270	CALL put_field(pass,"PRWANCIEN", "PRWANCIEN", prw_ancien)
	271
	272	CALL put_field(pass,"PRLWANCIEN", "PRLWANCIEN", prlw_ancien)
	273
	274	CALL put_field(pass,"PRSWANCIEN", "PRSWANCIEN", prsw_ancien)
	275
	276	CALL put_field(pass,"UANCIEN", "UANCIEN", u_ancien)
	277
	278	CALL put_field(pass,"VANCIEN", "VANCIEN", v_ancien)
	279
	280	CALL put_field(pass,"CLWCON", "Eau liquide convective", clwcon)
	281
	282	CALL put_field(pass,"RNEBCON", "Nebulosite convective", rnebcon)
	283
	284	CALL put_field(pass,"RATQS", "Ratqs", ratqs)
	285
	286	! run_off_lic_0
	287
	288	CALL put_field(pass,"RUNOFFLIC0", "Runofflic0", run_off_lic_0)
	289
	290	! DEB TKE PBL !
	291
[5116]	292	IF (iflag_pbl>1) THEN
[3927]	293	CALL put_field_srf3(pass,"TKE", "Energ. Cineti. Turb.", &
	294	pbl_tke(:,:,:))
	295	CALL put_field_srf3(pass,"DELTATKE", "Del TKE wk/env.", &
	296	wake_delta_pbl_tke(:,:,:))
	297	END IF
	298
	299	! FIN TKE PBL !
	300	!IM ajout zmax0, f0, sig1, w01
	301	!IM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_pe, wake_fip
	302
	303	CALL put_field(pass,"ZMAX0", "ZMAX0", zmax0)
	304
	305	CALL put_field(pass,"F0", "F0", f0)
	306
	307	CALL put_field(pass,"sig1", "sig1 Emanuel", sig1)
	308
	309	CALL put_field(pass,"w01", "w01 Emanuel", w01)
	310
	311	! wake_deltat
	312	CALL put_field(pass,"WAKE_DELTAT", "WAKE_DELTAT", wake_deltat)
	313
	314	CALL put_field(pass,"WAKE_DELTAQ", "WAKE_DELTAQ", wake_deltaq)
	315
	316	CALL put_field(pass,"WAKE_S", "Wake frac. area", wake_s)
	317
	318	CALL put_field(pass,"WAKE_DENS", "Wake num. /unit area", wake_dens)
	319
[4056]	320	CALL put_field(pass,"AWAKE_DENS", "Active Wake num. /unit area", awake_dens)
	321
	322	CALL put_field(pass,"CV_GEN", "CB birth rate", cv_gen)
	323
[3927]	324	CALL put_field(pass,"WAKE_CSTAR", "WAKE_CSTAR", wake_cstar)
	325
	326	CALL put_field(pass,"WAKE_PE", "WAKE_PE", wake_pe)
	327
	328	CALL put_field(pass,"WAKE_FIP", "WAKE_FIP", wake_fip)
	329
	330	! thermiques
	331
	332	CALL put_field(pass,"FM_THERM", "FM_THERM", fm_therm)
	333
	334	CALL put_field(pass,"ENTR_THERM", "ENTR_THERM", entr_therm)
	335
	336	CALL put_field(pass,"DETR_THERM", "DETR_THERM", detr_therm)
	337
	338	CALL put_field(pass,"ALE_BL", "ALE_BL", ale_bl)
	339
	340	CALL put_field(pass,"ALE_BL_TRIG", "ALE_BL_TRIG", ale_bl_trig)
	341
	342	CALL put_field(pass,"ALP_BL", "ALP_BL", alp_bl)
	343
	344	CALL put_field(pass,"ALE_WAKE", "ALE_WAKE", ale_wake)
	345
	346	CALL put_field(pass,"ALE_BL_STAT", "ALE_BL_STAT", ale_bl_stat)
	347
	348
[3940]	349	! fisrtilp/clouds
[4613]	350	CALL put_field(pass,"RATQS_INTER","Relative width of the lsc sugrid scale water",ratqs_inter_)
[3940]	351
	352
[4389]	353	IF (ANY(type_trac == ['co2i','inco'])) THEN
[4170]	354	IF (carbon_cycle_cpl) THEN
	355	IF (.NOT. ALLOCATED(co2_send)) THEN
	356	! This is the case of create_etat0_limit, ce0l
	357	ALLOCATE(co2_send(klon))
	358	co2_send(:) = co2_ppm0
	359	END IF
	360	CALL put_field(pass,"co2_send", "co2_ppm for coupling", co2_send)
	361	END IF
	362
[3927]	363	! trs from traclmdz_mod
[4389]	364	ELSE IF (type_trac == 'lmdz') THEN
[3927]	365	CALL traclmdz_to_restart(trs)
[4056]	366	it = 0
	367	DO iq = 1, nqtot
[4071]	368	IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
[4056]	369	it = it+1
	370	CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it))
[3927]	371	END DO
[4056]	372	END IF
	373
[3927]	374	! Restart variables for Slab ocean
	375	IF (type_ocean == 'slab') THEN
[5082]	376	IF (nslay==1) THEN
[3927]	377	CALL put_field(pass,"tslab", "Slab ocean temperature", tslab)
	378	ELSE
	379	DO it=1,nslay
	380	WRITE(str2,'(i2.2)') it
	381	CALL put_field(pass,"tslab"//str2, "Slab ocean temperature", tslab(:,it))
	382	END DO
	383	END IF
	384	IF (version_ocean == 'sicINT') THEN
	385	CALL put_field(pass,"seaice", "Slab seaice (kg/m2)", seaice)
	386	CALL put_field(pass,"slab_tice", "Slab sea ice temperature", tice)
	387	END IF
	388	END IF
	389
[5117]	390	IF (ok_gwd_rando) CALL put_field(pass,"du_gwd_rando", &
[3927]	391	"tendency on zonal wind due to flott gravity waves", du_gwd_rando)
	392
[5117]	393	IF (.NOT. ok_hines .AND. ok_gwd_rando) CALL put_field(pass,"du_gwd_front", &
[3927]	394	"tendency on zonal wind due to acama gravity waves", du_gwd_front)
	395
[5117]	396	IF (activate_ocean_skin >= 1) THEN
	397	IF (activate_ocean_skin == 2 .AND. type_ocean == 'couple') THEN
[3940]	398	CALL put_field(pass, "delta_sal", &
	399	"ocean-air interface salinity minus bulk salinity", delta_sal)
	400	CALL put_field(pass, "delta_SST", &
	401	"ocean-air interface temperature minus bulk SST", delta_sst)
[4374]	402	CALL put_field(pass, "dter", &
	403	"ocean-air interface temperature minus subskin temperature", &
	404	dter)
	405	CALL put_field(pass, "dser", &
	406	"ocean-air interface salinity minus subskin salinity", dser)
	407	CALL put_field(pass, "dt_ds", &
	408	"(tks / tkt) * dTer", dt_ds)
[3940]	409	end if
	410
	411	CALL put_field(pass, "dS_ns", "delta salinity near surface", ds_ns)
	412	CALL put_field(pass, "dT_ns", "delta temperature near surface", dT_ns)
	413	end if
	414
[3927]	415	#ifdef ISO
[5116]	416	WRITE(,) 'phyredem 342'
[5103]	417	CALL phyisoredem (pass, &
[5087]	418	xtsnow, &
	419	xtrun_off_lic_0,Rland_ice, &
	420	run_off_lic_0)
[3927]	421	#endif
	422
	423	IF (pass==1) CALL enddef_restartphy
	424	IF (pass==2) CALL close_restartphy
	425	ENDDO ! DO pass=1,2 ! pass=1 netcdf definition ; pass=2 netcdf write
	426
	427	!$OMP BARRIER
	428
	429
	430	CONTAINS
	431
	432
	433	SUBROUTINE put_field_srf1(pass,nam,lnam,field)
	434
	435	IMPLICIT NONE
[4056]	436	INTEGER, INTENT(IN) :: pass
[3927]	437	CHARACTER(LEN=*), INTENT(IN) :: nam, lnam
	438	REAL, INTENT(IN) :: field(:,:)
	439	CHARACTER(LEN=256) :: nm, lm, str
	440	DO nsrf = 1, SIZE(field,2)
	441	WRITE(str, '(i2.2)') nsrf
	442	nm=TRIM(nam)//TRIM(str)
	443	lm=TRIM(lnam)//" de surface No. "//TRIM(str)
	444	CALL put_field(pass,nm,lm,field(:,nsrf))
	445	END DO
	446
	447	END SUBROUTINE put_field_srf1
	448
	449
	450	SUBROUTINE put_field_srf2(pass,nam,lnam,field)
	451
	452	IMPLICIT NONE
	453	INTEGER, INTENT(IN) :: pass
	454	CHARACTER(LEN=*), INTENT(IN) :: nam, lnam
	455	REAL, INTENT(IN) :: field(:,:,:)
	456	CHARACTER(LEN=256) :: nm, lm, str
	457	DO nsrf = 1, SIZE(field,3)
	458	DO isoil=1, SIZE(field,2)
	459	WRITE(str, '(i2.2,"srf",i2.2)')isoil,nsrf
	460	! WRITE(lunout,*)"PHYREDEM ",TRIM(nam)//TRIM(str)
	461	nm=TRIM(nam)//TRIM(str)
	462	lm=TRIM(lnam)//" du sol No. "//TRIM(str)
	463	CALL put_field(pass,nm,lm,field(:,isoil,nsrf))
	464	END DO
	465	END DO
	466
	467	END SUBROUTINE put_field_srf2
	468
	469
	470	SUBROUTINE put_field_srf3(pass,nam,lnam,field)
	471
	472	IMPLICIT NONE
	473	INTEGER, INTENT(IN) :: pass
	474	CHARACTER(LEN=*), INTENT(IN) :: nam, lnam
	475	REAL, INTENT(IN) :: field(:,:,:)
	476	CHARACTER(LEN=256) :: nm, lm, str
	477	DO nsrf = 1, SIZE(field,3)
	478	WRITE(str, '(i2.2)') nsrf
	479	nm=TRIM(nam)//TRIM(str)
	480	lm=TRIM(lnam)//TRIM(str)
	481	CALL put_field(pass,nm,lm,field(:,1:klev+1,nsrf))
	482	END DO
	483
	484	END SUBROUTINE put_field_srf3
	485
	486	#ifdef ISO
[5103]	487	! je voulais mettre cette SUBROUTINE dans isotopes_mod, mais elle a besoin de put_field_srf1 qui est contenue dans la SUBROUTINE phyredem. Si on veut mettre cette routine dans isotopes_mod, il faudrait convertir ce fichier en module pour pouvoir en appeler des routines
[3927]	488
[5106]	489	SUBROUTINE phyisoredem(pass, &
[5087]	490	xtsnow, &
	491	xtrun_off_lic_0,Rland_ice, &
	492	run_off_lic_0)
[3927]	493	USE dimphy
[5110]	494	!USE lmdz_grid_phy
	495	!USE lmdz_phys_para
[3927]	496	USE phys_state_var_mod, ONLY: q_ancien,xt_ancien,wake_deltaq,wake_deltaxt, &
	497	xtrain_fall,xtsnow_fall, ql_ancien,xtl_ancien,qs_ancien,xts_ancien, &
	498	xtsol,fxtevap
[4143]	499	USE infotrac_phy,ONLY: niso, ntiso
[3927]	500	!USE control_mod
	501	USE indice_sol_mod, ONLY: nbsrf
	502	USE iostart, ONLY: put_field
[4149]	503	USE isotopes_mod, ONLY: isoName,iso_eau
[3927]	504	#ifdef ISOVERIF
	505	USE isotopes_verif_mod
	506	#endif
	507	#ifdef ISOTRAC
[5117]	508	USE isotrac_mod, ONLY: index_zone,index_iso,strtrac
[3927]	509	#endif
	510	!USE phyredem, ONLY: put_field_srf1
[5134]	511	USE lmdz_alpale
[5137]	512	USE lmdz_clesphys
[5139]	513	USE lmdz_compbl, ONLY: iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
[3927]	514
[5113]	515	IMPLICIT NONE
[3927]	516
	517	! equivalent isotopique de phyredem
	518
[5103]	519	include "dimsoil.h"
[3927]	520	! inputs
	521	!REAL xtsol(niso,klon)
	522	REAL xtsnow(niso,klon,nbsrf)
[4143]	523	!REAL xtevap(ntiso,klon,nbsrf)
[3927]	524	REAL xtrun_off_lic_0(niso,klon)
	525	REAL Rland_ice(niso,klon)
[5117]	526	REAL run_off_lic_0(klon)
	527	INTEGER, INTENT(IN) :: pass
[3927]	528
	529	! locals
[5117]	530	REAL iso_tmp(klon)
	531	REAL iso_tmp_lonlev(klon,klev)
	532	REAL iso_tmp_lonsrf(klon,nbsrf)
	533	INTEGER i,ixt,k,nsrf
[3927]	534	INTEGER nid, nvarid
	535	INTEGER ierr
	536	CHARACTER*7 str7
	537	CHARACTER*2 str2
[4056]	538	CHARACTER*50 outiso
[5117]	539	INTEGER lnblnk
[3927]	540	#ifdef ISOTRAC
[5117]	541	INTEGER iiso,izone
[3927]	542	#endif
	543
[5116]	544	WRITE(,) 'phyisoredem 41: entrée'
[3927]	545	#ifdef ISOVERIF
[5117]	546	IF (iso_eau.gt.0) THEN
[3927]	547	do k=1,klev
	548	do i=1,klon
[5103]	549	CALL iso_verif_egalite(xt_ancien(iso_eau,i,k),q_ancien(i,k), &
[5087]	550	'phyisoredem 50a')
[5103]	551	CALL iso_verif_egalite(xtl_ancien(iso_eau,i,k),ql_ancien(i,k), &
[5087]	552	'phyisoredem 50b')
[5103]	553	CALL iso_verif_egalite(xts_ancien(iso_eau,i,k),qs_ancien(i,k), &
[5087]	554	'phyisoredem 50c')
[3927]	555
	556	enddo !do i=1,klon
	557	enddo !do k=1,klev
	558	do i=1,klon
	559	DO nsrf = 1, nbsrf
[5103]	560	CALL iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf), &
[5087]	561	'phyisoredem 50d')
[3927]	562	enddo !DO nsrf = 1, nbsrf
	563	enddo
[5116]	564	endif !if (iso_eau.gt.0) THEN
[3927]	565	do i=1,klon
	566	do ixt=1,niso
[5103]	567	CALL iso_verif_noNaN(xtsol(ixt,i),'phyisoredem 72')
[3927]	568	enddo !do ixt=1,niso
	569	enddo !do i=1,klon
	570	#ifdef ISOTRAC
	571	do k=1,klev
	572	do i=1,klon
[5103]	573	CALL iso_verif_traceur(xt_ancien(1,i,k), &
[5087]	574	'phyisoredem 60')
[3927]	575	enddo !do i=1,klon
	576	enddo !do k=1,kle
	577	#endif
	578	#endif
	579
[4143]	580	do ixt=1,ntiso
[3927]	581
[4149]	582	outiso = TRIM(isoName(ixt))
	583	i = INDEX(outiso, '_', .TRUE.)
	584	outiso = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso))
[5116]	585	WRITE(,) 'phyredem 550: ixt,outiso=',ixt,TRIM(outiso)
[3927]	586
	587	iso_tmp_lonsrf(:,:)=fxtevap(ixt,:,:)
[4056]	588	CALL put_field_srf1(pass, "XTEVAP"//TRIM(outiso), "Evaporation de surface",iso_tmp_lonsrf)
[3927]	589
	590	iso_tmp(:)=xtrain_fall(ixt,:)
[4056]	591	CALL put_field(pass, "xtrain_f"//TRIM(outiso), "precipitation liquide",iso_tmp)
[3927]	592
	593	iso_tmp(:)=xtsnow_fall(ixt,:)
[4056]	594	CALL put_field(pass, "xtsnow_f"//TRIM(outiso), "precipitation solide",iso_tmp)
[3927]	595
	596	iso_tmp_lonlev(:,:)=xt_ancien(ixt,:,:)
[4056]	597	CALL put_field(pass, "XTANCIEN"//TRIM(outiso), "QANCIEN", iso_tmp_lonlev)
[3927]	598
	599	iso_tmp_lonlev(:,:)=xtl_ancien(ixt,:,:)
[4056]	600	CALL put_field(pass, "XTLANCIEN"//TRIM(outiso), "QLANCIEN", iso_tmp_lonlev)
[3927]	601
	602	iso_tmp_lonlev(:,:)=xts_ancien(ixt,:,:)
[4056]	603	CALL put_field(pass, "XTSANCIEN"//TRIM(outiso), "QSANCIEN", iso_tmp_lonlev)
[3927]	604
	605	iso_tmp_lonlev(:,:)=wake_deltaxt(ixt,:,:)
[4056]	606	CALL put_field(pass,"WAKE_DELTAXT"//TRIM(outiso), "WAKE_DELTAQ", iso_tmp_lonlev)
[3927]	607
	608	iso_tmp_lonlev(:,:)=wake_deltaxt(ixt,:,:)
[4056]	609	CALL put_field(pass,"WAKE_DELTAXT"//TRIM(outiso), "WAKE_DELTAXT",iso_tmp_lonlev)
[3927]	610
	611	! variables seulement pour niso:
[5117]	612	IF (ixt.le.niso) THEN
[4491]	613	iso_tmp_lonsrf(:,:)=xtsnow(ixt,:,:)
	614	CALL put_field_srf1(pass, "XTSNOW"//TRIM(outiso), "NEIGE", iso_tmp_lonsrf)
	615
[3927]	616	iso_tmp(:)=xtsol(ixt,:)
[4056]	617	CALL put_field(pass, "XTSOL"//TRIM(outiso), "Eau dans le sol (mm)",iso_tmp)
[3927]	618
	619	iso_tmp(:)=Rland_ice(ixt,:)
[4056]	620	CALL put_field(pass, "Rland_ice"//TRIM(outiso), "ratio land ice", iso_tmp)
[3927]	621
[4491]	622	iso_tmp(:)=xtrun_off_lic_0(ixt,:)
	623	CALL put_field(pass,"XTRUNOFFLIC0"//TRIM(outiso), "Runofflic0", iso_tmp)
	624
[5116]	625	endif ! if (ixt.le.niso) THEN
[3927]	626	enddo !do ixt=1,niso
	627
[5116]	628	WRITE(,) 'phyisoredem 261: sortie'
[3927]	629	END SUBROUTINE phyisoredem
	630	#endif
	631
	632	END SUBROUTINE phyredem

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

Download in other formats:

Original Format