Context Navigation

dynredem_p.F @ 1175

Last change on this file since 1175 was 1114, checked in by jghattas, 16 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: 21.4 KB

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

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

Download in other formats:

Original Format