Context Navigation

phyredem.F @ 862

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

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

Download in other formats:

Original Format