Context Navigation

dynredem_p.F @ 3776

Last change on this file since 3776 was 2622, checked in by Ehouarn Millour, 8 years ago
Some code tidying: turn ener.h into ener_mod.F90 EM
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.8 KB

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

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

Download in other formats:

Original Format