Context Navigation

dynredem.F @ 1606

Last change on this file since 1606 was 1577, checked in by Laurent Fairhead, 13 years ago

Modifications au code qui permettent de commencer une simulation à n'importe
quelle heure de la journée. On fait toujours un nombre entier de jours de
simulation.
On spécifie cette heure de départ dans la variable starttime du run.def (la
valeur est en jour et elle est à zéro par défaut).
La valeur est sauvegardée dans le fichier restart.nc. Les valeurs lues dans
le fichier start et le run.def sont comparées en début de simulation. La
simulation s'arrête si elles ne sont pas égales sauf si une remise à zéro de
la date a été demandée.
Par ailleurs, la fréquence de lecture des conditions aux limites a été modifiée
pour qu'à chaque changement de jour, celles-ci soient mises à jour (jusqu'à
maintenant elles étaient mises à jour à une fréquence donnée qui, en cas de
départ de simulation à une heure différente de minuit, ne correspondait pas
forcèment à un changement dans la date).
Validation effectuée en traçant le flux solaire descendant au sommet de
l'atmosphère à différentes heures de la journée, après un redémarrage, en
s'assurant que le maximum est bien là où il est sensé être.

Modifications to the code to enable it to be started at any time of the day.
The code still runs for an integer number of days.
The start time is specified using variable starttime in the run.def file (the
value is in days and is zero by default).
The start time is saved in the restart.nc file at the end of the simulation.
The values read in from the start.nc file and the run.def file are compared
at the start of the simulation. If they differ, the simulation is aborted
unless the raz_date variable has been set.
Furthermore, the frequency at which boundary conditions are read in has been
modified so that they are updated everyday at midnight (until now, they were
updated at a certain frequency that, in case of a simulation starting at a time
other than midnight, did not ensure that those conditions would be updated each
day at midnight)
The modifications were validated by plotting the downward solaf flux at TOA at
different times of the day (and after having restarted the simulation) and
ensuring that the maximum of flux was at the right place according to local
time.

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

File size: 22.1 KB

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

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

Download in other formats:

Original Format