Context Navigation

phyredem.F @ 883

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

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

Download in other formats:

Original Format