Context Navigation

phyredem.F @ 935

Last change on this file since 935 was 927, checked in by lmdzadmin, 17 years ago
Ajout variables zmax0, f0 dans le startphy.nc FH IM
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 27.7 KB

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

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

Download in other formats:

Original Format