Context Navigation

dynredem.F @ 1129

Last change on this file since 1129 was 1114, checked in by jghattas, 17 years ago

Creation du module infotrac:

contient les variables de advtrac.h
contient la subroutine iniadvtrac renommer en infotrac_init
le nombre des traceurs est lu dans tracer.def en dynamique (ou par default ou recu par INCA)
ce module est utilise dans la dynamique et la physique
contient aussi la variable nbtr qui avant etait stockee dans dimphy

Le fichier advtrac.h n'existe plus.
La compilation ne prend plus en compte le nombre de traceur.

/JG

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 20.7 KB

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

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

Download in other formats:

Original Format