Context Navigation

dynredem_p.F @ 1068

Last change on this file since 1068 was 985, checked in by Laurent Fairhead, 16 years ago
Mise a jour de dyn3dpar par rapport a dyn3d, inclusion OpenMP et filtre FFT YM LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 21.2 KB

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

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

Download in other formats:

Original Format