Context Navigation

dynredem.F @ 1995

Last change on this file since 1995 was 1930, checked in by lguez, 11 years ago
abort, dfloat and pause are not in the Fortran standard. Replaced abort by abort_gcm and dfloat by dble. Note: I modified dyn3dpar files that were identical to dyn3d modified files.
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.9 KB

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

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

Download in other formats:

Original Format