Context Navigation

dynredem.F @ 1459

Last change on this file since 1459 was 1422, checked in by milmd, 10 years ago
In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).
File size: 25.7 KB

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

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

Download in other formats:

Original Format