Context Navigation

dynredem.F @ 3403

Last change on this file since 3403 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: 20.3 KB

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

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

Download in other formats:

Original Format