Context Navigation

dynredem_p.F @ 965

Last change on this file since 965 was 907, checked in by emillour, 12 years ago

Generic/common/universal models:

Added possibility to write restartfi.nc files in parallel (MPI)
Added arch files suitable for Ada (IDRIS supercomputer)
Some further cleanup is clearly required to merge generic/universal models
LMDZ.UNIVERSAL/libf/phygeneric/dimphy.F90 to be uptaded in following commit (can't both remove a symbolic link and create a file with the same name in a single commit with svn).

File size: 24.6 KB

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

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

Download in other formats:

Original Format