Context Navigation

phyredem.F @ 902

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

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

Download in other formats:

Original Format