Context Navigation

dynredem_p.F @ 2600

Last change on this file since 2600 was 2600, checked in by Ehouarn Millour, 8 years ago
Cleanup in the dynamics: turn comvert.h into module comvert_mod.F90 EM
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 19.6 KB

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

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

Download in other formats:

Original Format