Context Navigation

phyredem.F @ 967

Last change on this file since 967 was 967, checked in by Laurent Fairhead, 16 years ago
Pour des raisons pratiques (besoin de tester facilement les parametrisations physiques en 1D et 3D), les arguments des routines de lecture et d'ecriture de l'etat initial de la physique ont disparu des appels à ces routines et sont maintenant passés par le module phys_state_var_mod LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 27.5 KB

Rev	Line
[524]	1	!
	2	! $Header$
	3	!
	4	c
[967]	5	SUBROUTINE phyredem (fichnom)
[782]	6
[766]	7	USE dimphy
[776]	8	USE mod_grid_phy_lmdz
	9	USE mod_phys_lmdz_para
[782]	10	USE ocean_slab_mod, ONLY : ocean_slab_final
	11	USE fonte_neige_mod, ONLY : fonte_neige_final
	12	USE pbl_surface_mod, ONLY : pbl_surface_final
[967]	13	USE surface_data, ONLY : ocean, ok_veget
	14	USE phys_state_var_mod
[782]	15
[524]	16	IMPLICIT none
	17	c======================================================================
	18	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
	19	c Objet: Ecriture de l'etat de redemarrage pour la physique
	20	c======================================================================
	21	#include "netcdf.inc"
	22	#include "indicesol.h"
	23	#include "dimsoil.h"
	24	#include "clesphys.h"
	25	#include "control.h"
	26	#include "temps.h"
[878]	27	#include "thermcell.h"
	28	#include "compbl.h"
[524]	29	c======================================================================
	30	CHARACTER() fichnom
[967]	31
	32	c les variables globales ecrites dans le fichier restart
	33	REAL rlat_glo(klon_glo), rlon_glo(klon_glo)
	34	REAL pctsrf_glo(klon_glo, nbsrf)
	35	REAL tsol_glo(klon_glo,nbsrf)
	36	REAL alb1_glo(klon_glo,nbsrf)
	37	REAL alb2_glo(klon_glo,nbsrf)
	38	REAL rain_fall_glo(klon_glo)
	39	REAL snow_fall_glo(klon_glo)
	40	real solsw_glo(klon_glo)
	41	real sollw_glo(klon_glo)
	42	REAL radsol_glo(klon_glo)
	43	REAL zmea_glo(klon_glo)
	44	REAL zstd_glo(klon_glo)
	45	REAL zsig_glo(klon_glo)
	46	REAL zgam_glo(klon_glo)
	47	REAL zthe_glo(klon_glo)
	48	REAL zpic_glo(klon_glo)
	49	REAL zval_glo(klon_glo)
	50	REAL rugsrel_glo(klon_glo)
	51	REAL t_ancien_glo(klon_glo,klev), q_ancien_glo(klon_glo,klev)
	52	REAL clwcon_glo(klon_glo,klev)
	53	REAL rnebcon_glo(klon_glo,klev)
	54	REAL ratqs_glo(klon_glo,klev)
	55	REAL pbl_tke_glo(klon_glo,klev,nbsrf)
	56	REAL zmax0_glo(klon_glo), f0_glo(klon)
	57	REAL ema_work1_glo(klon_glo, klev), ema_work2_glo(klon_glo, klev)
	58
	59	cIM "slab" ocean
[766]	60	REAL tsoil_p(klon,nsoilmx,nbsrf)
	61	REAL tslab_p(klon), seaice_p(klon)
	62	REAL qsurf_p(klon,nbsrf)
	63	REAL qsol_p(klon)
	64	REAL snow_p(klon,nbsrf)
	65	REAL evap_p(klon,nbsrf)
	66	real fder_p(klon)
	67	REAL frugs_p(klon,nbsrf)
	68	REAL agesno_p(klon,nbsrf)
	69	REAL run_off_lic_0_p(klon)
	70
[776]	71	REAL tsoil(klon_glo,nsoilmx,nbsrf)
	72	REAL tslab(klon_glo), seaice(klon_glo)
	73	REAL qsurf(klon_glo,nbsrf)
	74	REAL qsol(klon_glo)
	75	REAL snow(klon_glo,nbsrf)
	76	REAL evap(klon_glo,nbsrf)
	77	real fder(klon_glo)
	78	REAL frugs(klon_glo,nbsrf)
	79	REAL agesno(klon_glo,nbsrf)
	80	REAL run_off_lic_0(klon_glo)
	81	REAL masq(klon_glo)
[524]	82	c
	83	INTEGER nid, nvarid, idim1, idim2, idim3
	84	INTEGER ierr
	85	INTEGER length
	86	PARAMETER (length=100)
	87	REAL tab_cntrl(length)
	88	c
	89	INTEGER isoil, nsrf
[967]	90	CHARACTER (len=7) :: str7
	91	CHARACTER (len=2) :: str2
[782]	92
	93	c======================================================================
	94	c
	95	c Get variables which will be written to restart file from module
	96	c pbl_surface_mod
	97	CALL pbl_surface_final(qsol_p, fder_p, snow_p, qsurf_p,
	98	$ evap_p, frugs_p, agesno_p, tsoil_p)
	99
	100	c Get a variable calculated in module fonte_neige_mod
	101	CALL fonte_neige_final(run_off_lic_0_p)
	102
	103	c If slab ocean then get 2 varaibles from module ocean_slab_mod
	104	IF ( ocean == 'slab' ) THEN
	105	CALL ocean_slab_final(tslab_p, seaice_p)
	106	ELSE
	107	tslab_p(:) = 0.0
	108	seaice_p(:) = 0.0
	109	ENDIF
	110
	111	c======================================================================
	112
[967]	113	call Gather( rlat,rlat_glo)
	114	call Gather( rlon,rlon_glo)
	115	call Gather( pctsrf,pctsrf_glo)
	116	call Gather( ftsol,tsol_glo)
	117	call Gather( falb1,alb1_glo)
	118	call Gather( falb2,alb2_glo)
	119	call Gather( rain_fall,rain_fall_glo)
	120	call Gather( snow_fall,snow_fall_glo)
	121	call Gather( sollw,sollw_glo)
	122	call Gather( solsw,solsw_glo)
	123	call Gather( radsol,radsol_glo)
	124	call Gather( zmea,zmea_glo)
	125	call Gather( zstd,zstd_glo)
	126	call Gather( zsig,zsig_glo)
	127	call Gather( zgam,zgam_glo)
	128	call Gather( zthe,zthe_glo)
	129	call Gather( zpic,zpic_glo)
	130	call Gather( zval,zval_glo)
	131	call Gather( rugoro,rugsrel_glo)
	132	call Gather( t_ancien,t_ancien_glo)
	133	call Gather( q_ancien,q_ancien_glo)
	134	call Gather( clwcon,clwcon_glo)
	135	call Gather( rnebcon,rnebcon_glo)
	136	call Gather( ratqs,ratqs_glo)
	137	call Gather( pbl_tke,pbl_tke_glo)
	138	call Gather( zmax0,zmax0_glo)
	139	call Gather( f0,f0_glo)
	140	call Gather( ema_work1, ema_work1_glo)
	141	call Gather( ema_work2, ema_work2_glo)
	142
[776]	143	call Gather( tsoil_p,tsoil)
	144	call Gather( tslab_p,tslab)
	145	call Gather( seaice_p,seaice)
	146	call Gather( qsurf_p,qsurf)
	147	call Gather( qsol_p,qsol)
	148	call Gather( snow_p,snow)
	149	call Gather( evap_p,evap)
	150	call Gather( fder_p,fder)
	151	call Gather( frugs_p,frugs)
	152	call Gather( agesno_p,agesno)
	153	call Gather( run_off_lic_0_p,run_off_lic_0)
	154	call Gather( zmasq,masq)
[766]	155
	156	c$OMP MASTER
[776]	157	IF (is_mpi_root) THEN
[766]	158
[524]	159	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
	160	IF (ierr.NE.NF_NOERR) THEN
	161	write(6,*)' Pb d''ouverture du fichier '//fichnom
	162	write(6,*)' ierr = ', ierr
	163	CALL ABORT
	164	ENDIF
	165	c
	166	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
	167	. "Fichier redemmarage physique")
	168	c
	169	ierr = NF_DEF_DIM (nid, "index", length, idim1)
[776]	170	ierr = NF_DEF_DIM (nid, "points_physiques", klon_glo, idim2)
	171	ierr = NF_DEF_DIM (nid, "horizon_vertical", klon_glo*klev, idim3)
[524]	172	c
	173	ierr = NF_ENDDEF(nid)
	174	c
	175	DO ierr = 1, length
	176	tab_cntrl(ierr) = 0.0
	177	ENDDO
	178	tab_cntrl(1) = dtime
	179	tab_cntrl(2) = radpas
	180	tab_cntrl(3) = co2_ppm
	181	tab_cntrl(4) = solaire
	182	tab_cntrl(5) = iflag_con
	183	tab_cntrl(6) = nbapp_rad
	184
	185	IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
	186	IF( soil_model ) tab_cntrl( 8 ) = 1.
	187	IF( new_oliq ) tab_cntrl( 9 ) = 1.
	188	IF( ok_orodr ) tab_cntrl(10 ) = 1.
	189	IF( ok_orolf ) tab_cntrl(11 ) = 1.
	190
	191	tab_cntrl(13) = day_end
	192	tab_cntrl(14) = annee_ref
	193	tab_cntrl(15) = itau_phy
	194	c
	195	ierr = NF_REDEF (nid)
	196	#ifdef NC_DOUBLE
	197	ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
	198	#else
	199	ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
	200	#endif
	201	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
	202	. "Parametres de controle")
	203	ierr = NF_ENDDEF(nid)
	204	#ifdef NC_DOUBLE
	205	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
	206	#else
	207	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
	208	#endif
	209	c
	210	ierr = NF_REDEF (nid)
	211	#ifdef NC_DOUBLE
	212	ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
	213	#else
	214	ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
	215	#endif
	216	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
	217	. "Longitudes de la grille physique")
	218	ierr = NF_ENDDEF(nid)
	219	#ifdef NC_DOUBLE
[967]	220	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon_glo)
[524]	221	#else
[967]	222	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon_glo)
[524]	223	#endif
	224	c
	225	ierr = NF_REDEF (nid)
	226	#ifdef NC_DOUBLE
	227	ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
	228	#else
	229	ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
	230	#endif
	231	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
	232	. "Latitudes de la grille physique")
	233	ierr = NF_ENDDEF(nid)
	234	#ifdef NC_DOUBLE
[967]	235	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat_glo)
[524]	236	#else
[967]	237	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat_glo)
[524]	238	#endif
	239	c
	240	C PB ajout du masque terre/mer
	241	C
	242	ierr = NF_REDEF (nid)
	243	#ifdef NC_DOUBLE
	244	ierr = NF_DEF_VAR (nid, "masque", NF_DOUBLE, 1, idim2,nvarid)
	245	#else
	246	ierr = NF_DEF_VAR (nid, "masque", NF_FLOAT, 1, idim2,nvarid)
	247	#endif
	248	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 16,
	249	. "masque terre mer")
	250	ierr = NF_ENDDEF(nid)
	251	#ifdef NC_DOUBLE
[766]	252	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masq)
[524]	253	#else
[766]	254	ierr = NF_PUT_VAR_REAL (nid,nvarid,masq)
[524]	255	#endif
	256	c BP ajout des fraction de chaque sous-surface
	257	C
	258	C 1. fraction de terre
	259	C
	260	ierr = NF_REDEF (nid)
	261	#ifdef NC_DOUBLE
	262	ierr = NF_DEF_VAR (nid, "FTER", NF_DOUBLE, 1, idim2,nvarid)
	263	#else
	264	ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 1, idim2,nvarid)
	265	#endif
	266	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
	267	. "fraction de continent")
	268	ierr = NF_ENDDEF(nid)
	269	#ifdef NC_DOUBLE
[967]	270	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf_glo(1 : klon_glo, &
	271	& is_ter))
[524]	272	#else
[967]	273	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf_glo(1 : klon_glo, &
	274	& is_ter))
[524]	275	#endif
	276	C
	277	C 2. Fraction de glace de terre
	278	C
	279	ierr = NF_REDEF (nid)
	280	#ifdef NC_DOUBLE
	281	ierr = NF_DEF_VAR (nid, "FLIC", NF_DOUBLE, 1, idim2,nvarid)
	282	#else
	283	ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 1, idim2,nvarid)
	284	#endif
	285	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 24,
	286	. "fraction glace de terre")
	287	ierr = NF_ENDDEF(nid)
	288	#ifdef NC_DOUBLE
[967]	289	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf_glo(1 : klon_glo,
	290	& is_lic))
[524]	291	#else
[967]	292	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf_glo(1 : klon_glo,
	293	& is_lic))
[524]	294	#endif
	295	C
	296	C 3. fraction ocean
	297	C
	298	ierr = NF_REDEF (nid)
	299	#ifdef NC_DOUBLE
	300	ierr = NF_DEF_VAR (nid, "FOCE", NF_DOUBLE, 1, idim2,nvarid)
	301	#else
	302	ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 1, idim2,nvarid)
	303	#endif
	304	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
	305	. "fraction ocean")
	306	ierr = NF_ENDDEF(nid)
	307	#ifdef NC_DOUBLE
[967]	308	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf_glo(1 : klon_glo,
	309	& is_oce))
[524]	310	#else
[967]	311	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf_glo(1 : klon_glo,
	312	& is_oce))
[524]	313	#endif
	314	C
	315	C 4. Fraction glace de mer
	316	C
	317	ierr = NF_REDEF (nid)
	318	#ifdef NC_DOUBLE
	319	ierr = NF_DEF_VAR (nid, "FSIC", NF_DOUBLE, 1, idim2,nvarid)
	320	#else
	321	ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 1, idim2,nvarid)
	322	#endif
	323	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
	324	. "fraction glace mer")
	325	ierr = NF_ENDDEF(nid)
	326	#ifdef NC_DOUBLE
[967]	327	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf_glo(1 : klon_glo,
	328	& is_sic))
[524]	329	#else
[967]	330	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf_glo(1 : klon_glo,
	331	& is_sic))
[524]	332	#endif
	333	C
	334	C
	335	c
	336	DO nsrf = 1, nbsrf
	337	IF (nsrf.LE.99) THEN
	338	WRITE(str2,'(i2.2)') nsrf
	339	ierr = NF_REDEF (nid)
	340	#ifdef NC_DOUBLE
	341	ierr = NF_DEF_VAR (nid, "TS"//str2, NF_DOUBLE, 1, idim2,nvarid)
	342	#else
	343	ierr = NF_DEF_VAR (nid, "TS"//str2, NF_FLOAT, 1, idim2,nvarid)
	344	#endif
	345	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	346	. "Temperature de surface No."//str2)
	347	ierr = NF_ENDDEF(nid)
	348	ELSE
	349	PRINT*, "Trop de sous-mailles"
	350	CALL abort
	351	ENDIF
	352	#ifdef NC_DOUBLE
[967]	353	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol_glo(1,nsrf))
[524]	354	#else
[967]	355	ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol_glo(1,nsrf))
[524]	356	#endif
	357	ENDDO
	358	c
	359	DO nsrf = 1, nbsrf
	360	DO isoil=1, nsoilmx
	361	IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
	362	WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
	363	ierr = NF_REDEF (nid)
	364	#ifdef NC_DOUBLE
	365	ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_DOUBLE,1,idim2,nvarid)
	366	#else
	367	ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_FLOAT,1,idim2,nvarid)
	368	#endif
	369	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 29,
	370	. "Temperature du sol No."//str7)
	371	ierr = NF_ENDDEF(nid)
	372	ELSE
	373	PRINT*, "Trop de couches"
	374	CALL abort
	375	ENDIF
	376	#ifdef NC_DOUBLE
	377	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil,nsrf))
	378	#else
	379	ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil,nsrf))
	380	#endif
	381	ENDDO
	382	ENDDO
	383	c
[644]	384	cIM "slab" ocean
[524]	385	ierr = NF_REDEF (nid)
	386	#ifdef NC_DOUBLE
[644]	387	ierr = NF_DEF_VAR (nid, "TSLAB", NF_DOUBLE, 1, idim2,nvarid)
[524]	388	#else
[644]	389	ierr = NF_DEF_VAR (nid, "TSLAB", NF_FLOAT, 1, idim2,nvarid)
[524]	390	#endif
	391	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 33,
	392	. "Ecart de la SST (pour slab-ocean)")
	393	ierr = NF_ENDDEF(nid)
	394	#ifdef NC_DOUBLE
[644]	395	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tslab)
[524]	396	#else
[644]	397	ierr = NF_PUT_VAR_REAL (nid,nvarid,tslab)
[524]	398	#endif
	399	c
[644]	400	ierr = NF_REDEF (nid)
	401	#ifdef NC_DOUBLE
	402	ierr = NF_DEF_VAR (nid, "SEAICE", NF_DOUBLE, 1, idim2,nvarid)
	403	#else
	404	ierr = NF_DEF_VAR (nid, "SEAICE", NF_FLOAT, 1, idim2,nvarid)
	405	#endif
	406	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 33,
	407	. "Glace de mer kg/m2 (pour slab-ocean)")
	408	ierr = NF_ENDDEF(nid)
	409	#ifdef NC_DOUBLE
	410	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,seaice)
	411	#else
	412	ierr = NF_PUT_VAR_REAL (nid,nvarid,seaice)
	413	#endif
	414	c
[524]	415	DO nsrf = 1, nbsrf
	416	IF (nsrf.LE.99) THEN
	417	WRITE(str2,'(i2.2)') nsrf
	418	ierr = NF_REDEF (nid)
	419	#ifdef NC_DOUBLE
	420	ierr = NF_DEF_VAR (nid,"QS"//str2,NF_DOUBLE,1,idim2,nvarid)
	421	#else
	422	ierr = NF_DEF_VAR (nid,"QS"//str2,NF_FLOAT,1,idim2,nvarid)
	423	#endif
	424	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
	425	. "Humidite de surface No."//str2)
	426	ierr = NF_ENDDEF(nid)
	427	ELSE
	428	PRINT*, "Trop de sous-mailles"
	429	CALL abort
	430	ENDIF
	431	#ifdef NC_DOUBLE
	432	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,nsrf))
	433	#else
	434	ierr = NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,nsrf))
	435	#endif
	436	END DO
	437	C
	438	ierr = NF_REDEF (nid)
	439	#ifdef NC_DOUBLE
	440	ierr = NF_DEF_VAR (nid,"QSOL",NF_DOUBLE,1,idim2,nvarid)
	441	#else
	442	ierr = NF_DEF_VAR (nid,"QSOL",NF_FLOAT,1,idim2,nvarid)
	443	#endif
	444	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
	445	. "Eau dans le sol (mm)")
	446	ierr = NF_ENDDEF(nid)
	447	#ifdef NC_DOUBLE
	448	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsol)
	449	#else
	450	ierr = NF_PUT_VAR_REAL (nid,nvarid,qsol)
	451	#endif
	452	c
	453	DO nsrf = 1, nbsrf
	454	IF (nsrf.LE.99) THEN
	455	WRITE(str2,'(i2.2)') nsrf
	456	ierr = NF_REDEF (nid)
	457	#ifdef NC_DOUBLE
	458	ierr = NF_DEF_VAR (nid,"ALBE"//str2,NF_DOUBLE,1,idim2,nvarid)
	459	#else
	460	ierr = NF_DEF_VAR (nid,"ALBE"//str2,NF_FLOAT,1,idim2,nvarid)
	461	#endif
	462	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
	463	. "albedo de surface No."//str2)
	464	ierr = NF_ENDDEF(nid)
	465	ELSE
	466	PRINT*, "Trop de sous-mailles"
	467	CALL abort
	468	ENDIF
	469	#ifdef NC_DOUBLE
[967]	470	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,alb1_glo(1,nsrf))
[524]	471	#else
[967]	472	ierr = NF_PUT_VAR_REAL (nid,nvarid,alb1_glo(1,nsrf))
[524]	473	#endif
	474	ENDDO
	475
	476	DO nsrf = 1, nbsrf
	477	IF (nsrf.LE.99) THEN
	478	WRITE(str2,'(i2.2)') nsrf
	479	ierr = NF_REDEF (nid)
	480	#ifdef NC_DOUBLE
	481	ierr = NF_DEF_VAR (nid,"ALBLW"//str2,NF_DOUBLE,1,idim2,nvarid)
	482	#else
	483	ierr = NF_DEF_VAR (nid,"ALBLW"//str2,NF_FLOAT,1,idim2,nvarid)
	484	#endif
	485	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
	486	. "albedo LW de surface No."//str2)
	487	ierr = NF_ENDDEF(nid)
	488	ELSE
	489	PRINT*, "Trop de sous-mailles"
	490	CALL abort
	491	ENDIF
	492	#ifdef NC_DOUBLE
[967]	493	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,alb2_glo(1,nsrf))
[524]	494	#else
[967]	495	ierr = NF_PUT_VAR_REAL (nid,nvarid,alb2_glo(1,nsrf))
[524]	496	#endif
	497	ENDDO
	498	c
[888]	499	c
[524]	500	DO nsrf = 1, nbsrf
	501	IF (nsrf.LE.99) THEN
	502	WRITE(str2,'(i2.2)') nsrf
	503	ierr = NF_REDEF (nid)
	504	#ifdef NC_DOUBLE
	505	ierr = NF_DEF_VAR (nid,"EVAP"//str2,NF_DOUBLE,1,idim2,nvarid)
	506	#else
	507	ierr = NF_DEF_VAR (nid,"EVAP"//str2,NF_FLOAT,1,idim2,nvarid)
	508	#endif
	509	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	510	. "Evaporation de surface No."//str2)
	511	ierr = NF_ENDDEF(nid)
	512	ELSE
	513	PRINT*, "Trop de sous-mailles"
	514	CALL abort
	515	ENDIF
	516	#ifdef NC_DOUBLE
	517	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,evap(1,nsrf))
	518	#else
	519	ierr = NF_PUT_VAR_REAL (nid,nvarid,evap(1,nsrf))
	520	#endif
	521	ENDDO
	522
	523	c
	524	DO nsrf = 1, nbsrf
	525	IF (nsrf.LE.99) THEN
	526	WRITE(str2,'(i2.2)') nsrf
	527	ierr = NF_REDEF (nid)
	528	#ifdef NC_DOUBLE
	529	ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_DOUBLE,1,idim2,nvarid)
	530	#else
	531	ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_FLOAT,1,idim2,nvarid)
	532	#endif
	533	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
	534	. "Neige de surface No."//str2)
	535	ierr = NF_ENDDEF(nid)
	536	ELSE
	537	PRINT*, "Trop de sous-mailles"
	538	CALL abort
	539	ENDIF
	540	#ifdef NC_DOUBLE
	541	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow(1,nsrf))
	542	#else
	543	ierr = NF_PUT_VAR_REAL (nid,nvarid,snow(1,nsrf))
	544	#endif
	545	ENDDO
	546
	547	c
	548	ierr = NF_REDEF (nid)
	549	#ifdef NC_DOUBLE
	550	ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
	551	#else
	552	ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
	553	#endif
	554	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	555	. "Rayonnement net a la surface")
	556	ierr = NF_ENDDEF(nid)
	557	#ifdef NC_DOUBLE
[967]	558	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol_glo)
[524]	559	#else
[967]	560	ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol_glo)
[524]	561	#endif
	562	c
	563	ierr = NF_REDEF (nid)
	564	#ifdef NC_DOUBLE
	565	ierr = NF_DEF_VAR (nid, "solsw", NF_DOUBLE, 1, idim2,nvarid)
	566	#else
	567	ierr = NF_DEF_VAR (nid, "solsw", NF_FLOAT, 1, idim2,nvarid)
	568	#endif
	569	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
	570	. "Rayonnement solaire a la surface")
	571	ierr = NF_ENDDEF(nid)
	572	#ifdef NC_DOUBLE
[967]	573	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,solsw_glo)
[524]	574	#else
[967]	575	ierr = NF_PUT_VAR_REAL (nid,nvarid,solsw_glo)
[524]	576	#endif
	577	c
	578	ierr = NF_REDEF (nid)
	579	#ifdef NC_DOUBLE
	580	ierr = NF_DEF_VAR (nid, "sollw", NF_DOUBLE, 1, idim2,nvarid)
	581	#else
	582	ierr = NF_DEF_VAR (nid, "sollw", NF_FLOAT, 1, idim2,nvarid)
	583	#endif
	584	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
	585	. "Rayonnement IF a la surface")
	586	ierr = NF_ENDDEF(nid)
	587	#ifdef NC_DOUBLE
[967]	588	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sollw_glo)
[524]	589	#else
[967]	590	ierr = NF_PUT_VAR_REAL (nid,nvarid,sollw_glo)
[524]	591	#endif
	592	c
	593	ierr = NF_REDEF (nid)
	594	#ifdef NC_DOUBLE
	595	ierr = NF_DEF_VAR (nid, "fder", NF_DOUBLE, 1, idim2,nvarid)
	596	#else
	597	ierr = NF_DEF_VAR (nid, "fder", NF_FLOAT, 1, idim2,nvarid)
	598	#endif
	599	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
	600	. "Derive de flux")
	601	ierr = NF_ENDDEF(nid)
	602	#ifdef NC_DOUBLE
	603	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,fder)
	604	#else
	605	ierr = NF_PUT_VAR_REAL (nid,nvarid,fder)
	606	#endif
	607	c
	608	ierr = NF_REDEF (nid)
	609	#ifdef NC_DOUBLE
	610	ierr = NF_DEF_VAR (nid, "rain_f", NF_DOUBLE, 1, idim2,nvarid)
	611	#else
	612	ierr = NF_DEF_VAR (nid, "rain_f", NF_FLOAT, 1, idim2,nvarid)
	613	#endif
	614	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
	615	. "precipitation liquide")
	616	ierr = NF_ENDDEF(nid)
	617	#ifdef NC_DOUBLE
[967]	618	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rain_fall_glo)
[524]	619	#else
[967]	620	ierr = NF_PUT_VAR_REAL (nid,nvarid,rain_fall_glo)
[524]	621	#endif
	622	c
	623	ierr = NF_REDEF (nid)
	624	#ifdef NC_DOUBLE
	625	ierr = NF_DEF_VAR (nid, "snow_f", NF_DOUBLE, 1, idim2,nvarid)
	626	#else
	627	ierr = NF_DEF_VAR (nid, "snow_f", NF_FLOAT, 1, idim2,nvarid)
	628	#endif
	629	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
	630	. "precipitation solide")
	631	ierr = NF_ENDDEF(nid)
	632	#ifdef NC_DOUBLE
[967]	633	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow_fall_glo)
[524]	634	#else
[967]	635	ierr = NF_PUT_VAR_REAL (nid,nvarid,snow_fall_glo)
[524]	636	#endif
	637	c
[766]	638	endif
	639	c$OMP END MASTER
	640	cc ----> necessaire pour eviter bug openMP sur SX6
	641	c$OMP MASTER
[776]	642	if (is_mpi_root) then
[524]	643	DO nsrf = 1, nbsrf
	644	IF (nsrf.LE.99) THEN
	645	WRITE(str2,'(i2.2)') nsrf
	646	ierr = NF_REDEF (nid)
	647	#ifdef NC_DOUBLE
	648	ierr = NF_DEF_VAR (nid,"RUG"//str2,NF_DOUBLE,1,idim2,nvarid)
	649	#else
	650	ierr = NF_DEF_VAR (nid,"RUG"//str2,NF_FLOAT,1,idim2,nvarid)
	651	#endif
	652	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
	653	. "rugosite de surface No."//str2)
	654	ierr = NF_ENDDEF(nid)
	655	ELSE
	656	PRINT*, "Trop de sous-mailles"
	657	CALL abort
	658	ENDIF
	659	#ifdef NC_DOUBLE
	660	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,frugs(1,nsrf))
	661	#else
	662	ierr = NF_PUT_VAR_REAL (nid,nvarid,frugs(1,nsrf))
	663	#endif
	664	ENDDO
	665	c
	666	DO nsrf = 1, nbsrf
	667	IF (nsrf.LE.99) THEN
	668	WRITE(str2,'(i2.2)') nsrf
	669	ierr = NF_REDEF (nid)
	670	#ifdef NC_DOUBLE
	671	ierr = NF_DEF_VAR (nid,"AGESNO"//str2,NF_DOUBLE,1,idim2
	672	$ ,nvarid)
	673	#else
	674	ierr = NF_DEF_VAR (nid,"AGESNO"//str2,NF_FLOAT,1,idim2
	675	$ ,nvarid)
	676	#endif
	677	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
	678	. "Age de la neige surface No."//str2)
	679	ierr = NF_ENDDEF(nid)
	680	ELSE
	681	PRINT*, "Trop de sous-mailles"
	682	CALL abort
	683	ENDIF
	684	#ifdef NC_DOUBLE
	685	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,agesno(1,nsrf))
	686	#else
	687	ierr = NF_PUT_VAR_REAL (nid,nvarid,agesno(1,nsrf))
	688	#endif
	689	ENDDO
	690	c
	691	ierr = NF_REDEF (nid)
	692	#ifdef NC_DOUBLE
	693	ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
	694	#else
	695	ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
	696	#endif
	697	ierr = NF_ENDDEF(nid)
	698	#ifdef NC_DOUBLE
[967]	699	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea_glo)
[524]	700	#else
[967]	701	ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea_glo)
[524]	702	#endif
	703	c
	704	ierr = NF_REDEF (nid)
	705	#ifdef NC_DOUBLE
	706	ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
	707	#else
	708	ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
	709	#endif
	710	ierr = NF_ENDDEF(nid)
	711	#ifdef NC_DOUBLE
[967]	712	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd_glo)
[524]	713	#else
[967]	714	ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd_glo)
[524]	715	#endif
	716	ierr = NF_REDEF (nid)
	717	#ifdef NC_DOUBLE
	718	ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
	719	#else
	720	ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
	721	#endif
	722	ierr = NF_ENDDEF(nid)
	723	#ifdef NC_DOUBLE
[967]	724	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig_glo)
[524]	725	#else
[967]	726	ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig_glo)
[524]	727	#endif
	728	ierr = NF_REDEF (nid)
	729	#ifdef NC_DOUBLE
	730	ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
	731	#else
	732	ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
	733	#endif
	734	ierr = NF_ENDDEF(nid)
	735	#ifdef NC_DOUBLE
[967]	736	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam_glo)
[524]	737	#else
[967]	738	ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam_glo)
[524]	739	#endif
	740	ierr = NF_REDEF (nid)
	741	#ifdef NC_DOUBLE
	742	ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
	743	#else
	744	ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
	745	#endif
	746	ierr = NF_ENDDEF(nid)
	747	#ifdef NC_DOUBLE
[967]	748	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe_glo)
[524]	749	#else
[967]	750	ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe_glo)
[524]	751	#endif
	752	ierr = NF_REDEF (nid)
	753	#ifdef NC_DOUBLE
	754	ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
	755	#else
	756	ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
	757	#endif
	758	ierr = NF_ENDDEF(nid)
	759	#ifdef NC_DOUBLE
[967]	760	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic_glo)
[524]	761	#else
[967]	762	ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic_glo)
[524]	763	#endif
	764	ierr = NF_REDEF (nid)
	765	#ifdef NC_DOUBLE
	766	ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
	767	#else
	768	ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
	769	#endif
	770	ierr = NF_ENDDEF(nid)
	771	#ifdef NC_DOUBLE
[967]	772	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval_glo)
[524]	773	#else
[967]	774	ierr = NF_PUT_VAR_REAL (nid,nvarid,zval_glo)
[524]	775	#endif
	776	ierr = NF_REDEF (nid)
	777	#ifdef NC_DOUBLE
	778	ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid)
	779	#else
	780	ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid)
	781	#endif
	782	ierr = NF_ENDDEF(nid)
	783	#ifdef NC_DOUBLE
[967]	784	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugsrel_glo)
[524]	785	#else
[967]	786	ierr = NF_PUT_VAR_REAL (nid,nvarid,rugsrel_glo)
[524]	787	#endif
	788	c
	789	ierr = NF_REDEF (nid)
	790	#ifdef NC_DOUBLE
	791	ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
	792	#else
	793	ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
	794	#endif
	795	ierr = NF_ENDDEF(nid)
	796	#ifdef NC_DOUBLE
[967]	797	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien_glo)
[524]	798	#else
[967]	799	ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien_glo)
[524]	800	#endif
	801	c
	802	ierr = NF_REDEF (nid)
	803	#ifdef NC_DOUBLE
	804	ierr = NF_DEF_VAR (nid, "QANCIEN", NF_DOUBLE, 1, idim3,nvarid)
	805	#else
	806	ierr = NF_DEF_VAR (nid, "QANCIEN", NF_FLOAT, 1, idim3,nvarid)
	807	#endif
	808	ierr = NF_ENDDEF(nid)
	809	#ifdef NC_DOUBLE
[967]	810	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q_ancien_glo)
[524]	811	#else
[967]	812	ierr = NF_PUT_VAR_REAL (nid,nvarid,q_ancien_glo)
[524]	813	#endif
	814	c
	815	ierr = NF_REDEF (nid)
	816	#ifdef NC_DOUBLE
	817	ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid)
	818	#else
	819	ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid)
	820	#endif
	821	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	822	. "Longueur de rugosite sur mer")
	823	ierr = NF_ENDDEF(nid)
	824	#ifdef NC_DOUBLE
	825	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,frugs(1,is_oce))
	826	#else
	827	ierr = NF_PUT_VAR_REAL (nid,nvarid,frugs(1,is_oce))
	828	#endif
	829	c
	830	ierr = NF_REDEF (nid)
	831	#ifdef NC_DOUBLE
	832	ierr = NF_DEF_VAR (nid, "CLWCON", NF_DOUBLE, 1, idim2,nvarid)
	833	#else
	834	ierr = NF_DEF_VAR (nid, "CLWCON", NF_FLOAT, 1, idim2,nvarid)
	835	#endif
	836	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	837	. "Eau liquide convective")
	838	ierr = NF_ENDDEF(nid)
	839	#ifdef NC_DOUBLE
[967]	840	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,clwcon_glo)
[524]	841	#else
[967]	842	ierr = NF_PUT_VAR_REAL (nid,nvarid,clwcon_glo)
[524]	843	#endif
	844	c
	845	ierr = NF_REDEF (nid)
	846	#ifdef NC_DOUBLE
	847	ierr = NF_DEF_VAR (nid, "RNEBCON", NF_DOUBLE, 1, idim2,nvarid)
	848	#else
	849	ierr = NF_DEF_VAR (nid, "RNEBCON", NF_FLOAT, 1, idim2,nvarid)
	850	#endif
	851	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	852	. "Nebulosite convective")
	853	ierr = NF_ENDDEF(nid)
	854	#ifdef NC_DOUBLE
[967]	855	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rnebcon_glo)
[524]	856	#else
[967]	857	ierr = NF_PUT_VAR_REAL (nid,nvarid,rnebcon_glo)
[524]	858	#endif
	859	c
	860	ierr = NF_REDEF (nid)
	861	#ifdef NC_DOUBLE
	862	ierr = NF_DEF_VAR (nid, "RATQS", NF_DOUBLE, 1, idim2,nvarid)
	863	#else
	864	ierr = NF_DEF_VAR (nid, "RATQS", NF_FLOAT, 1, idim2,nvarid)
	865	#endif
	866	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	867	. "Ratqs")
	868	ierr = NF_ENDDEF(nid)
	869	#ifdef NC_DOUBLE
[967]	870	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ratqs_glo)
[524]	871	#else
[967]	872	ierr = NF_PUT_VAR_REAL (nid,nvarid,ratqs_glo)
[524]	873	#endif
	874	c
	875	c run_off_lic_0
	876	c
	877	ierr = NF_REDEF (nid)
	878	#ifdef NC_DOUBLE
	879	ierr=NF_DEF_VAR(nid,"RUNOFFLIC0",NF_DOUBLE,1,idim2,nvarid)
	880	#else
	881	ierr=NF_DEF_VAR(nid,"RUNOFFLIC0",NF_FLOAT, 1,idim2,nvarid)
	882	#endif
	883	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	884	. "Runofflic0")
	885	ierr = NF_ENDDEF(nid)
	886	#ifdef NC_DOUBLE
	887	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,run_off_lic_0)
	888	#else
	889	ierr = NF_PUT_VAR_REAL (nid,nvarid,run_off_lic_0)
	890	#endif
	891	c
	892	c
[878]	893	!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
	894	c
	895	IF (iflag_pbl>1) then
	896	DO nsrf = 1, nbsrf
	897	IF (nsrf.LE.99) THEN
	898	WRITE(str2,'(i2.2)') nsrf
	899	ierr = NF_REDEF (nid)
	900	#ifdef NC_DOUBLE
	901	ierr = NF_DEF_VAR (nid,"TKE"//str2,NF_DOUBLE,1,idim3
	902	$ ,nvarid)
	903	#else
	904	ierr = NF_DEF_VAR (nid,"TKE"//str2,NF_FLOAT,1,idim3
	905	$ ,nvarid)
	906	#endif
	907	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
	908	. "Energ. Cineti. Turb."//str2)
	909	ierr = NF_ENDDEF(nid)
	910	ELSE
	911	PRINT*, "Trop de sous-mailles"
	912	CALL abort
	913	ENDIF
	914	#ifdef NC_DOUBLE
[967]	915	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pbl_tke_glo(:,:,nsrf))
[878]	916	#else
[967]	917	ierr = NF_PUT_VAR_REAL (nid,nvarid,pbl_tke_glo(:,:,nsrf))
[878]	918	#endif
	919	ENDDO
	920	ENDIF
	921
	922	!!!!!!!!!!!!!!!!!!!! FIN TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
	923	c
[524]	924	ierr = NF_CLOSE(nid)
	925	c
[776]	926	endif ! is_mpi_root
[766]	927	c$OMP END MASTER
[524]	928	RETURN
	929	END

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

Download in other formats:

Original Format