Context Navigation

dynredem_p.F @ 2173

Last change on this file since 2173 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 19.4 KB

Rev	Line
[630]	1	!
[1279]	2	! $Id: dynredem_p.F 1907 2013-11-26 13:10:46Z jescribano $
[630]	3	!
	4	c
[1146]	5	SUBROUTINE dynredem0_p(fichnom,iday_end,phis)
[1279]	6	#ifdef CPP_IOIPSL
[630]	7	USE IOIPSL
[1279]	8	#endif
[1823]	9	USE parallel_lmdz
[1146]	10	USE infotrac
[1635]	11	use netcdf95, only: NF95_PUT_VAR
	12
[630]	13	IMPLICIT NONE
	14	c=======================================================================
	15	c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
	16	c=======================================================================
	17	c Declarations:
	18	c -------------
	19	#include "dimensions.h"
	20	#include "paramet.h"
	21	#include "comconst.h"
	22	#include "comvert.h"
[1635]	23	#include "comgeom2.h"
[630]	24	#include "temps.h"
	25	#include "ener.h"
	26	#include "logic.h"
	27	#include "netcdf.inc"
	28	#include "description.h"
	29	#include "serre.h"
	30
	31	c Arguments:
	32	c ----------
	33	INTEGER iday_end
[1635]	34	REAL phis(iip1, jjp1)
[630]	35	CHARACTER() fichnom
	36
	37	c Local:
	38	c ------
	39	INTEGER iq,l
	40	INTEGER length
	41	PARAMETER (length = 100)
	42	REAL tab_cntrl(length) ! tableau des parametres du run
	43	INTEGER ierr
	44	character*20 modname
	45	character*80 abort_message
	46
	47	c Variables locales pour NetCDF:
	48	c
	49	INTEGER dims2(2), dims3(3), dims4(4)
	50	INTEGER idim_index
	51	INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
	52	INTEGER idim_s, idim_sig
	53	INTEGER idim_tim
	54	INTEGER nid,nvarid
	55
	56	REAL zan0,zjulian,hours
	57	INTEGER yyears0,jjour0, mmois0
	58	character*30 unites
	59
[1635]	60
[630]	61	c-----------------------------------------------------------------------
	62	if (mpi_rank==0) then
	63
[1279]	64	modname='dynredem0_p'
[630]	65
[1279]	66	#ifdef CPP_IOIPSL
[630]	67	call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
	68	call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
[1279]	69	#else
	70	! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
	71	yyears0=0
	72	mmois0=1
	73	jjour0=1
[1635]	74	#endif
[630]	75
	76	DO l=1,length
	77	tab_cntrl(l) = 0.
	78	ENDDO
[1635]	79	tab_cntrl(1) = REAL(iim)
	80	tab_cntrl(2) = REAL(jjm)
	81	tab_cntrl(3) = REAL(llm)
	82	tab_cntrl(4) = REAL(day_ref)
	83	tab_cntrl(5) = REAL(annee_ref)
[630]	84	tab_cntrl(6) = rad
	85	tab_cntrl(7) = omeg
	86	tab_cntrl(8) = g
	87	tab_cntrl(9) = cpp
	88	tab_cntrl(10) = kappa
	89	tab_cntrl(11) = daysec
	90	tab_cntrl(12) = dtvr
	91	tab_cntrl(13) = etot0
	92	tab_cntrl(14) = ptot0
	93	tab_cntrl(15) = ztot0
	94	tab_cntrl(16) = stot0
	95	tab_cntrl(17) = ang0
	96	tab_cntrl(18) = pa
	97	tab_cntrl(19) = preff
	98	c
	99	c ..... parametres pour le zoom ......
	100
	101	tab_cntrl(20) = clon
	102	tab_cntrl(21) = clat
	103	tab_cntrl(22) = grossismx
	104	tab_cntrl(23) = grossismy
	105	c
	106	IF ( fxyhypb ) THEN
	107	tab_cntrl(24) = 1.
	108	tab_cntrl(25) = dzoomx
	109	tab_cntrl(26) = dzoomy
	110	tab_cntrl(27) = 0.
	111	tab_cntrl(28) = taux
	112	tab_cntrl(29) = tauy
	113	ELSE
	114	tab_cntrl(24) = 0.
	115	tab_cntrl(25) = dzoomx
	116	tab_cntrl(26) = dzoomy
	117	tab_cntrl(27) = 0.
	118	tab_cntrl(28) = 0.
	119	tab_cntrl(29) = 0.
	120	IF( ysinus ) tab_cntrl(27) = 1.
	121	ENDIF
	122
[1635]	123	tab_cntrl(30) = REAL(iday_end)
	124	tab_cntrl(31) = REAL(itau_dyn + itaufin)
[1577]	125	c start_time: start_time of simulation (not necessarily 0.)
	126	tab_cntrl(32) = start_time
[630]	127	c
	128	c .........................................................
	129	c
	130	c Creation du fichier:
	131	c
	132	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
	133	IF (ierr.NE.NF_NOERR) THEN
	134	WRITE(6,*)" Pb d ouverture du fichier "//fichnom
	135	WRITE(6,*)' ierr = ', ierr
	136	CALL ABORT
	137	ENDIF
	138	c
	139	c Preciser quelques attributs globaux:
	140	c
	141	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
	142	. "Fichier demmarage dynamique")
	143	c
	144	c Definir les dimensions du fichiers:
	145	c
	146	ierr = NF_DEF_DIM (nid, "index", length, idim_index)
	147	ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
	148	ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
	149	ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
	150	ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
	151	ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
	152	ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
	153	ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
	154	c
	155	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
	156	c
	157	c Definir et enregistrer certains champs invariants:
	158	c
	159	ierr = NF_REDEF (nid)
[764]	160	cIM 220306 BEG
	161	#ifdef NC_DOUBLE
	162	ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
	163	#else
[630]	164	ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
[764]	165	#endif
	166	cIM 220306 END
[630]	167	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
	168	. "Parametres de controle")
	169	ierr = NF_ENDDEF(nid)
[1635]	170	call NF95_PUT_VAR(nid,nvarid,tab_cntrl)
[630]	171	c
	172	ierr = NF_REDEF (nid)
[764]	173	cIM 220306 BEG
	174	#ifdef NC_DOUBLE
	175	ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
	176	#else
[630]	177	ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
[764]	178	#endif
	179	cIM 220306 END
[630]	180	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
	181	. "Longitudes des points U")
	182	ierr = NF_ENDDEF(nid)
[1635]	183	call NF95_PUT_VAR(nid,nvarid,rlonu)
[630]	184	c
	185	ierr = NF_REDEF (nid)
[764]	186	cIM 220306 BEG
	187	#ifdef NC_DOUBLE
	188	ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
	189	#else
[630]	190	ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
[764]	191	#endif
	192	cIM 220306 END
[630]	193	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
	194	. "Latitudes des points U")
	195	ierr = NF_ENDDEF(nid)
[1635]	196	call NF95_PUT_VAR (nid,nvarid,rlatu)
[630]	197	c
	198	ierr = NF_REDEF (nid)
[764]	199	cIM 220306 BEG
	200	#ifdef NC_DOUBLE
	201	ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
	202	#else
[630]	203	ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
[764]	204	#endif
	205	cIM 220306 END
[630]	206	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
	207	. "Longitudes des points V")
	208	ierr = NF_ENDDEF(nid)
[1635]	209	call NF95_PUT_VAR(nid,nvarid,rlonv)
[630]	210	c
	211	ierr = NF_REDEF (nid)
[764]	212	cIM 220306 BEG
	213	#ifdef NC_DOUBLE
	214	ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
	215	#else
[630]	216	ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
[764]	217	#endif
	218	cIM 220306 END
[630]	219	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
	220	. "Latitudes des points V")
	221	ierr = NF_ENDDEF(nid)
[1635]	222	call NF95_PUT_VAR(nid,nvarid,rlatv)
[630]	223	c
	224	ierr = NF_REDEF (nid)
[764]	225	cIM 220306 BEG
	226	#ifdef NC_DOUBLE
	227	ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
	228	#else
[630]	229	ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
[764]	230	#endif
	231	cIM 220306 END
[630]	232	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
	233	. "Numero naturel des couches s")
	234	ierr = NF_ENDDEF(nid)
[1635]	235	call NF95_PUT_VAR(nid,nvarid,nivsigs)
[630]	236	c
	237	ierr = NF_REDEF (nid)
[764]	238	cIM 220306 BEG
	239	#ifdef NC_DOUBLE
	240	ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
	241	#else
[630]	242	ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
[764]	243	#endif
	244	cIM 220306 END
[630]	245	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
	246	. "Numero naturel des couches sigma")
	247	ierr = NF_ENDDEF(nid)
[1635]	248	call NF95_PUT_VAR(nid,nvarid,nivsig)
[630]	249	c
	250	ierr = NF_REDEF (nid)
[764]	251	cIM 220306 BEG
	252	#ifdef NC_DOUBLE
	253	ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
	254	#else
[630]	255	ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
[764]	256	#endif
	257	cIM 220306 END
[630]	258	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
	259	. "Coefficient A pour hybride")
	260	ierr = NF_ENDDEF(nid)
[1635]	261	call NF95_PUT_VAR(nid,nvarid,ap)
[630]	262	c
	263	ierr = NF_REDEF (nid)
[764]	264	cIM 220306 BEG
	265	#ifdef NC_DOUBLE
	266	ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
	267	#else
[630]	268	ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
[764]	269	#endif
	270	cIM 220306 END
[630]	271	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
	272	. "Coefficient B pour hybride")
	273	ierr = NF_ENDDEF(nid)
[1635]	274	call NF95_PUT_VAR(nid,nvarid,bp)
[630]	275	c
	276	ierr = NF_REDEF (nid)
[764]	277	cIM 220306 BEG
	278	#ifdef NC_DOUBLE
	279	ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
	280	#else
[630]	281	ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
[764]	282	#endif
	283	cIM 220306 END
[630]	284	ierr = NF_ENDDEF(nid)
[1635]	285	call NF95_PUT_VAR(nid,nvarid,presnivs)
[630]	286	c
	287	c Coefficients de passage cov. <-> contra. <--> naturel
	288	c
	289	ierr = NF_REDEF (nid)
	290	dims2(1) = idim_rlonu
	291	dims2(2) = idim_rlatu
[764]	292	cIM 220306 BEG
	293	#ifdef NC_DOUBLE
	294	ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
	295	#else
[630]	296	ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
[764]	297	#endif
	298	cIM 220306 END
[630]	299	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
	300	. "Coefficient de passage pour U")
	301	ierr = NF_ENDDEF(nid)
[1635]	302	call NF95_PUT_VAR(nid,nvarid,cu)
[630]	303	c
	304	ierr = NF_REDEF (nid)
	305	dims2(1) = idim_rlonv
	306	dims2(2) = idim_rlatv
[764]	307	cIM 220306 BEG
	308	#ifdef NC_DOUBLE
	309	ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
	310	#else
[630]	311	ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
[764]	312	#endif
	313	cIM 220306 END
[630]	314	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
	315	. "Coefficient de passage pour V")
	316	ierr = NF_ENDDEF(nid)
[1635]	317	call NF95_PUT_VAR(nid,nvarid,cv)
[630]	318	c
	319	c Aire de chaque maille:
	320	c
	321	ierr = NF_REDEF (nid)
	322	dims2(1) = idim_rlonv
	323	dims2(2) = idim_rlatu
[764]	324	cIM 220306 BEG
	325	#ifdef NC_DOUBLE
	326	ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
	327	#else
[630]	328	ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
[764]	329	#endif
	330	cIM 220306 END
[630]	331	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
	332	. "Aires de chaque maille")
	333	ierr = NF_ENDDEF(nid)
[1635]	334	call NF95_PUT_VAR(nid,nvarid,aire)
[630]	335	c
	336	c Geopentiel au sol:
	337	c
	338	ierr = NF_REDEF (nid)
	339	dims2(1) = idim_rlonv
	340	dims2(2) = idim_rlatu
[764]	341	cIM 220306 BEG
	342	#ifdef NC_DOUBLE
	343	ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
	344	#else
[630]	345	ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
[764]	346	#endif
	347	cIM 220306 END
[630]	348	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
	349	. "Geopotentiel au sol")
	350	ierr = NF_ENDDEF(nid)
[1635]	351	call NF95_PUT_VAR(nid,nvarid,phis)
[630]	352	c
	353	c Definir les variables pour pouvoir les enregistrer plus tard:
	354	c
	355	ierr = NF_REDEF (nid) ! entrer dans le mode de definition
	356	c
[764]	357	cIM 220306 BEG
	358	#ifdef NC_DOUBLE
	359	ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
	360	#else
[630]	361	ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
[764]	362	#endif
	363	cIM 220306 END
[630]	364	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
	365	. "Temps de simulation")
	366	write(unites,200)yyears0,mmois0,jjour0
	367	200 format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
	368	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
	369	. unites)
	370
	371	c
	372	dims4(1) = idim_rlonu
	373	dims4(2) = idim_rlatu
	374	dims4(3) = idim_s
	375	dims4(4) = idim_tim
[764]	376	cIM 220306 BEG
	377	#ifdef NC_DOUBLE
	378	ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
	379	#else
[630]	380	ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
[764]	381	#endif
	382	cIM 220306 END
[630]	383	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
	384	. "Vitesse U")
	385	c
	386	dims4(1) = idim_rlonv
	387	dims4(2) = idim_rlatv
	388	dims4(3) = idim_s
	389	dims4(4) = idim_tim
[764]	390	cIM 220306 BEG
	391	#ifdef NC_DOUBLE
	392	ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
	393	#else
[630]	394	ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
[764]	395	#endif
	396	cIM 220306 END
[630]	397	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
	398	. "Vitesse V")
	399	c
	400	dims4(1) = idim_rlonv
	401	dims4(2) = idim_rlatu
	402	dims4(3) = idim_s
	403	dims4(4) = idim_tim
[764]	404	cIM 220306 BEG
	405	#ifdef NC_DOUBLE
	406	ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
	407	#else
[630]	408	ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
[764]	409	#endif
	410	cIM 220306 END
[630]	411	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
	412	. "Temperature")
	413	c
	414	dims4(1) = idim_rlonv
	415	dims4(2) = idim_rlatu
	416	dims4(3) = idim_s
	417	dims4(4) = idim_tim
[1146]	418
	419	DO iq=1,nqtot
[764]	420	cIM 220306 BEG
	421	#ifdef NC_DOUBLE
	422	ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
	423	#else
[630]	424	ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
[764]	425	#endif
	426	cIM 220306 END
[630]	427	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
	428	ENDDO
	429	c
	430	dims4(1) = idim_rlonv
	431	dims4(2) = idim_rlatu
	432	dims4(3) = idim_s
	433	dims4(4) = idim_tim
[764]	434	cIM 220306 BEG
	435	#ifdef NC_DOUBLE
	436	ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
	437	#else
[630]	438	ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
[764]	439	#endif
	440	cIM 220306 END
[630]	441	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
	442	. "C est quoi ?")
	443	c
	444	dims3(1) = idim_rlonv
	445	dims3(2) = idim_rlatu
	446	dims3(3) = idim_tim
[764]	447	cIM 220306 BEG
	448	#ifdef NC_DOUBLE
	449	ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
	450	#else
[630]	451	ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
[764]	452	#endif
	453	cIM 220306 END
[630]	454	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
	455	. "Pression au sol")
	456	c
	457	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
	458	ierr = NF_CLOSE(nid) ! fermer le fichier
	459
	460	PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
	461	PRINT*,'rad,omeg,g,cpp,kappa',
	462	, rad,omeg,g,cpp,kappa
	463
	464	endif ! mpi_rank==0
	465	RETURN
	466	END
	467	SUBROUTINE dynredem1_p(fichnom,time,
[1146]	468	. vcov,ucov,teta,q,masse,ps)
[1823]	469	USE parallel_lmdz
[1146]	470	USE infotrac
[1403]	471	USE control_mod
[1635]	472	use netcdf, only: NF90_get_VAR
	473	use netcdf95, only: NF95_PUT_VAR
	474
[630]	475	IMPLICIT NONE
	476	c=================================================================
	477	c Ecriture du fichier de redemarrage sous format NetCDF
	478	c=================================================================
	479	#include "dimensions.h"
	480	#include "paramet.h"
	481	#include "description.h"
	482	#include "netcdf.inc"
	483	#include "comvert.h"
	484	#include "comgeom.h"
	485	#include "temps.h"
	486
[1635]	487
[1146]	488	INTEGER l
[1635]	489	REAL vcov(iip1,jjm,llm),ucov(iip1, jjp1,llm)
	490	REAL teta(iip1, jjp1,llm)
	491	REAL ps(iip1, jjp1),masse(iip1, jjp1,llm)
	492	REAL q(iip1, jjp1, llm, nqtot)
[630]	493	CHARACTER() fichnom
	494
	495	REAL time
[985]	496	INTEGER nid, nvarid, nid_trac, nvarid_trac
	497	REAL trac_tmp(ip1jmp1,llm)
[1635]	498	INTEGER ierr, ierr_file
[630]	499	INTEGER iq
	500	INTEGER length
	501	PARAMETER (length = 100)
	502	REAL tab_cntrl(length) ! tableau des parametres du run
	503	character*20 modname
	504	character*80 abort_message
	505	c
	506	INTEGER nb
	507	SAVE nb
	508	DATA nb / 0 /
	509
[1084]	510	logical exist_file
	511
[630]	512	call Gather_Field(ucov,ip1jmp1,llm,0)
	513	call Gather_Field(vcov,ip1jm,llm,0)
	514	call Gather_Field(teta,ip1jmp1,llm,0)
	515	call Gather_Field(masse,ip1jmp1,llm,0)
	516	call Gather_Field(ps,ip1jmp1,1,0)
	517
[1146]	518	do iq=1,nqtot
[1635]	519	call Gather_Field(q(:,:,:,iq),ip1jmp1,llm,0)
[630]	520	enddo
	521
	522
	523	if (mpi_rank==0) then
	524
	525	modname = 'dynredem1'
	526	ierr = NF_OPEN(fichnom, NF_WRITE, nid)
	527	IF (ierr .NE. NF_NOERR) THEN
	528	PRINT*, "Pb. d ouverture "//fichnom
	529	CALL abort
	530	ENDIF
	531
	532	c Ecriture/extension de la coordonnee temps
	533
	534	nb = nb + 1
	535	ierr = NF_INQ_VARID(nid, "temps", nvarid)
	536	IF (ierr .NE. NF_NOERR) THEN
	537	print *, NF_STRERROR(ierr)
	538	abort_message='Variable temps n est pas definie'
	539	CALL abort_gcm(modname,abort_message,ierr)
	540	ENDIF
[1635]	541	call NF95_PUT_VAR(nid,nvarid,time,start=(/nb/))
[630]	542	PRINT*, "Enregistrement pour ", nb, time
	543
	544	c
	545	c Re-ecriture du tableau de controle, itaufin n'est plus defini quand
	546	c on passe dans dynredem0
	547	ierr = NF_INQ_VARID (nid, "controle", nvarid)
	548	IF (ierr .NE. NF_NOERR) THEN
	549	abort_message="dynredem1: Le champ <controle> est absent"
	550	ierr = 1
	551	CALL abort_gcm(modname,abort_message,ierr)
	552	ENDIF
[1635]	553	ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl)
	554	tab_cntrl(31) = REAL(itau_dyn + itaufin)
	555	call NF95_PUT_VAR(nid,nvarid,tab_cntrl)
[630]	556
	557	c Ecriture des champs
	558	c
	559	ierr = NF_INQ_VARID(nid, "ucov", nvarid)
	560	IF (ierr .NE. NF_NOERR) THEN
	561	PRINT*, "Variable ucov n est pas definie"
	562	CALL abort
	563	ENDIF
[1635]	564	call NF95_PUT_VAR(nid,nvarid,ucov)
[630]	565
	566	ierr = NF_INQ_VARID(nid, "vcov", nvarid)
	567	IF (ierr .NE. NF_NOERR) THEN
	568	PRINT*, "Variable vcov n est pas definie"
	569	CALL abort
	570	ENDIF
[1635]	571	call NF95_PUT_VAR(nid,nvarid,vcov)
[630]	572
	573	ierr = NF_INQ_VARID(nid, "teta", nvarid)
	574	IF (ierr .NE. NF_NOERR) THEN
	575	PRINT*, "Variable teta n est pas definie"
	576	CALL abort
	577	ENDIF
[1635]	578	call NF95_PUT_VAR(nid,nvarid,teta)
[630]	579
[1563]	580	IF (type_trac == 'inca') THEN
[985]	581	! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc
[1084]	582	inquire(FILE="start_trac.nc", EXIST=exist_file)
	583	print *, "EXIST", exist_file
	584	if (exist_file) then
	585	ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
	586	IF (ierr_file .NE.NF_NOERR) THEN
	587	write(6,*)' Pb d''ouverture du fichier start_trac.nc'
	588	write(6,*)' ierr = ', ierr_file
	589	ENDIF
	590	else
	591	ierr_file = 2
	592	endif
[985]	593	END IF
	594
[1146]	595	do iq=1,nqtot
[985]	596
[1563]	597	IF (type_trac /= 'inca') THEN
[985]	598	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
	599	IF (ierr .NE. NF_NOERR) THEN
	600	PRINT*, "Variable tname(iq) n est pas definie"
	601	CALL abort
	602	ENDIF
[1635]	603	call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq))
[1563]	604	ELSE ! type_trac = inca
[985]	605	! lecture de la valeur du traceur dans start_trac.nc
	606	IF (ierr_file .ne. 2) THEN
	607	ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
	608	IF (ierr .NE. NF_NOERR) THEN
	609	PRINT*, tname(iq),"est absent de start_trac.nc"
	610	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
	611	IF (ierr .NE. NF_NOERR) THEN
	612	PRINT*, "Variable ", tname(iq)," n est pas definie"
	613	CALL abort
	614	ENDIF
[1635]	615	call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq))
[985]	616
	617	ELSE
	618	PRINT*, tname(iq), "est present dans start_trac.nc"
[1635]	619	ierr = NF90_GET_VAR(nid_trac, nvarid_trac, trac_tmp)
[985]	620	IF (ierr .NE. NF_NOERR) THEN
	621	PRINT*, "Lecture echouee pour", tname(iq)
	622	CALL abort
	623	ENDIF
	624	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
	625	IF (ierr .NE. NF_NOERR) THEN
	626	PRINT*, "Variable ", tname(iq)," n est pas definie"
	627	CALL abort
	628	ENDIF
[1635]	629	call NF95_PUT_VAR(nid, nvarid, trac_tmp)
[985]	630
	631	ENDIF ! IF (ierr .NE. NF_NOERR)
	632	! fin lecture du traceur
	633	ELSE ! si il n'y a pas de fichier start_trac.nc
	634	! print *, 'il n y a pas de fichier start_trac'
	635	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
	636	IF (ierr .NE. NF_NOERR) THEN
	637	PRINT*, "Variable tname(iq) n est pas definie"
	638	CALL abort
	639	ENDIF
[1635]	640	call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq))
[985]	641	ENDIF ! (ierr_file .ne. 2)
[1635]	642	END IF !type_trac
[985]	643
[630]	644	ENDDO
[985]	645
	646
	647
[630]	648	c
	649	ierr = NF_INQ_VARID(nid, "masse", nvarid)
	650	IF (ierr .NE. NF_NOERR) THEN
	651	PRINT*, "Variable masse n est pas definie"
	652	CALL abort
	653	ENDIF
[1635]	654	call NF95_PUT_VAR(nid,nvarid,masse)
[630]	655	c
	656	ierr = NF_INQ_VARID(nid, "ps", nvarid)
	657	IF (ierr .NE. NF_NOERR) THEN
	658	PRINT*, "Variable ps n est pas definie"
	659	CALL abort
	660	ENDIF
[1635]	661	call NF95_PUT_VAR(nid,nvarid,ps)
[630]	662
	663	ierr = NF_CLOSE(nid)
	664	c
	665	endif ! mpi_rank==0
	666
	667	RETURN
	668	END
	669

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

Download in other formats:

Original Format