Context Navigation

dynredem.F @ 2236

Last change on this file since 2236 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: 31.8 KB

Rev	Line
[1416]	1	SUBROUTINE dynredem0(fichnom,idayref,phis)
	2	use infotrac, only: tname,nqtot
[1422]	3	USE comvert_mod, ONLY: ap,bp,aps,bps,pa,preff,presnivs,pseudoalt
	4	USE comconst_mod, ONLY: daysec,dtvr,rad,omeg,g,cpp,kappa,pi
	5	USE logic_mod, ONLY: fxyhypb,ysinus
	6	USE serre_mod, ONLY: clon,clat,grossismx,grossismy,
	7	. dzoomx,dzoomy,taux,tauy
	8	USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
[135]	9	IMPLICIT NONE
	10	c=======================================================================
	11	c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
	12	c=======================================================================
	13	c Declarations:
	14	c -------------
	15	#include "dimensions.h"
	16	#include "paramet.h"
	17	#include "comgeom.h"
	18	#include "netcdf.inc"
[1216]	19	!#include "advtrac.h"
[135]	20	c Arguments:
	21	c ----------
[1416]	22	INTEGER*4 idayref
[135]	23	REAL phis(ip1jmp1)
	24	CHARACTER() fichnom
	25
	26	c Local:
	27	c ------
	28	INTEGER iq,l
	29	CHARACTER str3*3
	30	INTEGER length
	31	PARAMETER (length = 100)
	32	REAL tab_cntrl(length) ! tableau des parametres du run
	33	INTEGER ierr
	34	character*20 modname
	35	character*80 abort_message
	36	character(len=80) :: txt ! to store some text
	37
	38	c Variables locales pour NetCDF:
	39	c
	40	INTEGER dims2(2), dims3(3), dims4(4)
	41	INTEGER idim_index
	42	INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
	43	INTEGER idim_llm, idim_llmp1
	44	INTEGER idim_tim
	45	INTEGER nid,nvarid
	46
	47	REAL zan0,zjulian,hours
	48	REAL sigs(llm)
	49	INTEGER yyears0,jjour0, mmois0
	50	data yyears0 /1/
	51	data jjour0 /1/
	52	data mmois0 /1/
	53	character*30 unites
	54
	55
	56	c-----------------------------------------------------------------------
	57	modname='dynredem'
	58	do l=1,llm
	59	sigs(l)=float(l)
	60	enddo
	61
	62	DO l=1,length
	63	tab_cntrl(l) = 0.
	64	ENDDO
	65	tab_cntrl(1) = FLOAT(iim)
	66	tab_cntrl(2) = FLOAT(jjm)
	67	tab_cntrl(3) = FLOAT(llm)
	68	tab_cntrl(4) = FLOAT(idayref)
	69	tab_cntrl(5) = rad
	70	tab_cntrl(6) = omeg
	71	tab_cntrl(7) = g
	72	tab_cntrl(8) = cpp
	73	tab_cntrl(9) = kappa
	74	tab_cntrl(10) = daysec
	75	tab_cntrl(11) = dtvr
	76	tab_cntrl(12) = etot0
	77	tab_cntrl(13) = ptot0
	78	tab_cntrl(14) = ztot0
	79	tab_cntrl(15) = stot0
	80	tab_cntrl(16) = ang0
	81	tab_cntrl(17) = pa
	82	tab_cntrl(18) = preff
	83	c
	84	c ..... parametres pour le zoom ......
	85
	86	tab_cntrl(19) = clon
	87	tab_cntrl(20) = clat
	88	tab_cntrl(21) = grossismx
	89	tab_cntrl(22) = grossismy
	90	c
	91	IF ( fxyhypb ) THEN
	92	tab_cntrl(23) = 1.
	93	tab_cntrl(24) = dzoomx
	94	tab_cntrl(25) = dzoomy
	95	tab_cntrl(26) = 0.
	96	tab_cntrl(27) = taux
	97	tab_cntrl(28) = tauy
	98	ELSE
	99	tab_cntrl(23) = 0.
	100	tab_cntrl(24) = dzoomx
	101	tab_cntrl(25) = dzoomy
	102	tab_cntrl(26) = 0.
	103	tab_cntrl(27) = 0.
	104	tab_cntrl(28) = 0.
	105	IF( ysinus ) tab_cntrl(26) = 1.
	106	ENDIF
	107	c
	108	c .........................................................
	109	c
	110	c Creation du fichier:
	111	c
	112	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
	113	IF (ierr.NE.NF_NOERR) THEN
	114	WRITE(6,*)" Failed creating file "//fichnom
	115	WRITE(6,*)' ierr = ', ierr
	116	CALL ABORT
	117	ENDIF
	118	c
	119	c Preciser quelques attributs globaux:
	120	c
	121	ierr = NF_PUT_ATT_TEXT (nid,NF_GLOBAL,"title",18,
	122	. "Dynamic start file")
	123	if (ierr.ne.NF_NOERR) then
	124	write(,) "dynredem0: Failed writing title in file "//fichnom
	125	call abort
	126	endif
	127	c
	128	c Definir les dimensions du fichiers:
	129	c
	130	ierr = NF_DEF_DIM (nid, "index", length, idim_index)
	131	if (ierr.ne.NF_NOERR) then
	132	write(,) "dynredem0: Failed defining dimension <index> ",
	133	& "in file "//fichnom
	134	call abort
	135	endif
	136
	137	ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
	138	if (ierr.ne.NF_NOERR) then
	139	write(,) "dynredem0: Failed defining dimension <rlonu> ",
	140	& "in file "//fichnom
	141	call abort
	142	endif
	143
	144	ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
	145	if (ierr.ne.NF_NOERR) then
	146	write(,) "dynredem0: Failed defining dimension <latitude> ",
	147	& "in file "//fichnom
	148	call abort
	149	endif
	150
	151	ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
	152	if (ierr.ne.NF_NOERR) then
	153	write(,) "dynredem0: Failed defining dimension <longitude> ",
	154	& "in file "//fichnom
	155	call abort
	156	endif
	157
	158	ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
	159	if (ierr.ne.NF_NOERR) then
	160	write(,) "dynredem0: Failed defining dimension <rlatv> ",
	161	& "in file "//fichnom
	162	call abort
	163	endif
	164
	165	ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
	166	if (ierr.ne.NF_NOERR) then
	167	write(,) "dynredem0: Failed defining dimension <altitude> ",
	168	& "in file "//fichnom
	169	call abort
	170	endif
	171
	172	ierr = NF_DEF_DIM (nid, "interlayer", llmp1, idim_llmp1)
	173	if (ierr.ne.NF_NOERR) then
	174	write(,) "dynredem0: Failed defining dimension <interlayer> ",
	175	& "in file "//fichnom
	176	call abort
	177	endif
	178
	179	ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_tim)
	180	if (ierr.ne.NF_NOERR) then
	181	write(,) "dynredem0: Failed defining dimension <Time> ",
	182	& "in file "//fichnom
	183	call abort
	184	endif
	185
	186
	187	c CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
	188	c ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
	189	c ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
	190	c ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
	191	c
	192	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
	193	if (ierr.ne.NF_NOERR) then
	194	write(,) "dynredem0: Failed to switch out of define mode",
	195	& "in file "//fichnom
	196	call abort
	197	endif
	198
	199
	200	c
	201	c Definir et enregistrer certains champs invariants:
	202	c
	203	c ----------------------
	204	c
	205	ierr = NF_REDEF (nid)
	206	if (ierr.ne.NF_NOERR) then
	207	write(,) "dynredem0: Failed to switch back to define mode"
	208	call abort
	209	endif
	210	#ifdef NC_DOUBLE
	211	ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
	212	#else
	213	ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
	214	#endif
	215	if (ierr.ne.NF_NOERR) then
	216	write(,) "dynredem0: Failed defining <controle> ",
	217	& "in file "//fichnom
	218	call abort
	219	endif
	220
	221	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
	222	. "Parametres de controle")
	223	if (ierr.ne.NF_NOERR) then
	224	write(,) "dynredem0: Failed writing title attribute ",
	225	& "for <controle> in file "//fichnom
	226	call abort
	227	endif
	228
	229	ierr = NF_ENDDEF(nid)
	230	if (ierr.ne.NF_NOERR) then
	231	write(,) "dynredem0: Failed to switch out of define mode"
	232	call abort
	233	endif
	234	#ifdef NC_DOUBLE
	235	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
	236	#else
	237	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
	238	#endif
	239	if (ierr.ne.NF_NOERR) then
	240	write(,) "dynredem0: Failed writing <controle> ",
	241	& "in file "//fichnom
	242	call abort
	243	! else
	244	! write(,) "dynredem0: controle(1)=",tab_cntrl(1)
	245	endif
	246
	247	c
	248	c ----------------------
	249	c
	250	ierr = NF_REDEF (nid)
	251	if (ierr.ne.NF_NOERR) then
	252	write(,) "dynredem0: Failed to switch back to define mode"
	253	call abort
	254	endif
	255	#ifdef NC_DOUBLE
	256	ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
	257	#else
	258	ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
	259	#endif
	260	if (ierr.ne.NF_NOERR) then
	261	write(,) "dynredem0: Failed defining <rlonu> ",
	262	& "in file "//fichnom
	263	call abort
	264	endif
	265
	266	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
	267	. "Longitudes des points U")
	268	if (ierr.ne.NF_NOERR) then
	269	write(,) "dynredem0: Failed writing title attribute ",
	270	& "for <rlonu> in file "//fichnom
	271	call abort
	272	endif
	273
	274	ierr = NF_ENDDEF(nid)
	275	if (ierr.ne.NF_NOERR) then
	276	write(,) "dynredem0: Failed to switch out of define mode"
	277	call abort
	278	endif
	279	#ifdef NC_DOUBLE
	280	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
	281	#else
	282	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
	283	#endif
	284	if (ierr.ne.NF_NOERR) then
	285	write(,) "dynredem0: Failed writing <rlonu> ",
	286	& "in file "//fichnom
	287	call abort
	288	endif
	289
	290	c
	291	c ----------------------
	292	c
	293	ierr = NF_REDEF (nid)
	294	if (ierr.ne.NF_NOERR) then
	295	write(,) "dynredem0: Failed to switch back to define mode"
	296	call abort
	297	endif
	298	#ifdef NC_DOUBLE
	299	ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
	300	#else
	301	ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
	302	#endif
	303	if (ierr.ne.NF_NOERR) then
	304	write(,) "dynredem0: Failed defining <rlatu> ",
	305	& "in file "//fichnom
	306	call abort
	307	endif
	308
	309	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
	310	. "Latitudes des points U")
	311	if (ierr.ne.NF_NOERR) then
	312	write(,) "dynredem0: Failed writing title attribute ",
	313	& "for <rlatu> in file "//fichnom
	314	call abort
	315	endif
	316
	317	ierr = NF_ENDDEF(nid)
	318	if (ierr.ne.NF_NOERR) then
	319	write(,) "dynredem0: Failed to switch out of define mode"
	320	call abort
	321	endif
	322	#ifdef NC_DOUBLE
	323	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
	324	#else
	325	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
	326	#endif
	327	if (ierr.ne.NF_NOERR) then
	328	write(,) "dynredem0: Failed writing <rlatu> ",
	329	& "in file "//fichnom
	330	call abort
	331	endif
	332
	333	c
	334	c ----------------------
	335	c
	336	ierr = NF_REDEF (nid)
	337	if (ierr.ne.NF_NOERR) then
	338	write(,) "dynredem0: Failed to switch back to define mode"
	339	call abort
	340	endif
	341	#ifdef NC_DOUBLE
	342	ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
	343	#else
	344	ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
	345	#endif
	346	if (ierr.ne.NF_NOERR) then
	347	write(,) "dynredem0: Failed defining <rlonv> ",
	348	& "in file "//fichnom
	349	call abort
	350	endif
	351
	352	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
	353	. "Longitudes des points V")
	354	if (ierr.ne.NF_NOERR) then
	355	write(,) "dynredem0: Failed writing title attribute ",
	356	& "for <rlonv> in file "//fichnom
	357	call abort
	358	endif
	359
	360	ierr = NF_ENDDEF(nid)
	361	if (ierr.ne.NF_NOERR) then
	362	write(,) "dynredem0: Failed to switch out of define mode"
	363	call abort
	364	endif
	365	#ifdef NC_DOUBLE
	366	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
	367	#else
	368	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
	369	#endif
	370	if (ierr.ne.NF_NOERR) then
	371	write(,) "dynredem0: Failed writing <rlonv> ",
	372	& "in file "//fichnom
	373	call abort
	374	endif
	375
	376	c
	377	c ----------------------
	378	c
	379	ierr = NF_REDEF (nid)
	380	if (ierr.ne.NF_NOERR) then
	381	write(,) "dynredem0: Failed to switch back to define mode"
	382	call abort
	383	endif
	384	#ifdef NC_DOUBLE
	385	ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
	386	#else
	387	ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
	388	#endif
	389	if (ierr.ne.NF_NOERR) then
	390	write(,) "dynredem0: Failed defining <rlatv> ",
	391	& "in file "//fichnom
	392	call abort
	393	endif
	394
	395	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
	396	. "Latitudes des points V")
	397	if (ierr.ne.NF_NOERR) then
	398	write(,) "dynredem0: Failed writing title attribute ",
	399	& "for <rlatv> in file "//fichnom
	400	call abort
	401	endif
	402
	403	ierr = NF_ENDDEF(nid)
	404	if (ierr.ne.NF_NOERR) then
	405	write(,) "dynredem0: Failed to switch out of define mode"
	406	call abort
	407	endif
	408	#ifdef NC_DOUBLE
	409	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
	410	#else
	411	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
	412	#endif
	413	if (ierr.ne.NF_NOERR) then
	414	write(,) "dynredem0: Failed writing <rlatv> ",
	415	& "in file "//fichnom
	416	call abort
	417	endif
	418	c
	419	c ----------------------
	420	c
	421	ierr = NF_REDEF (nid)
	422	if (ierr.ne.NF_NOERR) then
	423	write(,) "dynredem0: Failed to switch back to define mode"
	424	call abort
	425	endif
	426	#ifdef NC_DOUBLE
	427	ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
	428	#else
	429	ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
	430	#endif
	431	if (ierr.ne.NF_NOERR) then
	432	write(,) "dynredem0: Failed defining <ap> ",
	433	& "in file "//fichnom
	434	call abort
	435	endif
	436
	437	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
	438	. "Coef A: hybrid pressure levels" )
	439	if (ierr.ne.NF_NOERR) then
	440	write(,) "dynredem0: Failed writing title attribute ",
	441	& "for <ap> in file "//fichnom
	442	call abort
	443	endif
	444
	445	ierr = NF_ENDDEF(nid)
	446	if (ierr.ne.NF_NOERR) then
	447	write(,) "dynredem0: Failed to switch out of define mode"
	448	call abort
	449	endif
	450	#ifdef NC_DOUBLE
	451	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
	452	#else
	453	ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
	454	#endif
	455	if (ierr.ne.NF_NOERR) then
	456	write(,) "dynredem0: Failed writing <ap> ",
	457	& "in file "//fichnom
	458	call abort
	459	endif
	460
	461	c
	462	c ----------------------
	463	c
	464	ierr = NF_REDEF (nid)
	465	if (ierr.ne.NF_NOERR) then
	466	write(,) "dynredem0: Failed to switch back to define mode"
	467	call abort
	468	endif
	469	#ifdef NC_DOUBLE
	470	ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
	471	#else
	472	ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
	473	#endif
	474	if (ierr.ne.NF_NOERR) then
	475	write(,) "dynredem0: Failed defining <bp> ",
	476	& "in file "//fichnom
	477	call abort
	478	endif
	479
	480	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
	481	. "Coef B: hybrid sigma levels")
	482	if (ierr.ne.NF_NOERR) then
	483	write(,) "dynredem0: Failed writing title attribute ",
	484	& "for <bp> in file "//fichnom
	485	call abort
	486	endif
	487
	488	ierr = NF_ENDDEF(nid)
	489	if (ierr.ne.NF_NOERR) then
	490	write(,) "dynredem0: Failed to switch out of define mode"
	491	call abort
	492	endif
	493	#ifdef NC_DOUBLE
	494	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
	495	#else
	496	ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
	497	#endif
	498	if (ierr.ne.NF_NOERR) then
	499	write(,) "dynredem0: Failed writing <bp> ",
	500	& "in file "//fichnom
	501	call abort
	502	endif
	503
	504	c
	505	c ----------------------
	506	c
	507	! ierr = NF_REDEF (nid)
	508	! if (ierr.ne.NF_NOERR) then
	509	! write(,) "dynredem0: Failed to switch back to define mode"
	510	! call abort
	511	! endif
	512	!#ifdef NC_DOUBLE
	513	! ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
	514	!#else
	515	! ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
	516	!#endif
	517	! if (ierr.ne.NF_NOERR) then
	518	! write(,) "dynredem0: Failed defining <ap> ",
	519	! & "in file "//fichnom
	520	! call abort
	521	! endif
	522	!
	523	! ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
	524	! . "Coef A: hybrid pressure levels" )
	525	! if (ierr.ne.NF_NOERR) then
	526	! write(,) "dynredem0: Failed writing title attribute ",
	527	! & "for <ap> in file "//fichnom
	528	!
	529	! ierr = NF_ENDDEF(nid)
	530	! if (ierr.ne.NF_NOERR) then
	531	! write(,) "dynredem0: Failed to switch out of define mode"
	532	! call abort
	533	! endif
	534	!#ifdef NC_DOUBLE
	535	! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
	536	!#else
	537	! ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
	538	!#endif
	539	! if (ierr.ne.NF_NOERR) then
	540	! write(,) "dynredem0: Failed writing <bp> ",
	541	! & "in file "//fichnom
	542	! call abort
	543	! endif
	544	c
	545	c ----------------------
	546	c
	547	c
	548	ierr = NF_REDEF (nid)
	549	if (ierr.ne.NF_NOERR) then
	550	write(,) "dynredem0: Failed to switch back to define mode"
	551	call abort
	552	endif
	553
	554	#ifdef NC_DOUBLE
	555	ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
	556	#else
	557	ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
	558	#endif
	559	if (ierr.ne.NF_NOERR) then
	560	write(,) "dynredem0: Failed defining <aps> ",
	561	& "in file "//fichnom
	562	call abort
	563	endif
	564
	565	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 37,
	566	. "Coef AS: hybrid pressure at midlayers")
	567	if (ierr.ne.NF_NOERR) then
	568	write(,) "dynredem0: Failed writing title attribute ",
	569	& "for <aps> in file "//fichnom
	570	call abort
	571	endif
	572
	573	ierr = NF_ENDDEF(nid)
	574	if (ierr.ne.NF_NOERR) then
	575	write(,) "dynredem0: Failed to switch out of define mode"
	576	call abort
	577	endif
	578
	579	#ifdef NC_DOUBLE
	580	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
	581	#else
	582	ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
	583	#endif
	584	if (ierr.ne.NF_NOERR) then
	585	write(,) "dynredem0: Failed writing <aps> ",
	586	& "in file "//fichnom
	587	call abort
	588	endif
	589
	590	c
	591	c ----------------------
	592	c
	593	ierr = NF_REDEF (nid)
	594	if (ierr.ne.NF_NOERR) then
	595	write(,) "dynredem0: Failed to switch back to define mode"
	596	call abort
	597	endif
	598
	599	#ifdef NC_DOUBLE
	600	ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
	601	#else
	602	ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
	603	#endif
	604	if (ierr.ne.NF_NOERR) then
	605	write(,) "dynredem0: Failed defining <bps> ",
	606	& "in file "//fichnom
	607	call abort
	608	endif
	609
	610	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 34,
	611	. "Coef BS: hybrid sigma at midlayers")
	612	if (ierr.ne.NF_NOERR) then
	613	write(,) "dynredem0: Failed writing title attribute ",
	614	& "for <bps> in file "//fichnom
	615	call abort
	616	endif
	617
	618	ierr = NF_ENDDEF(nid)
	619	if (ierr.ne.NF_NOERR) then
	620	write(,) "dynredem0: Failed to switch out of define mode"
	621	call abort
	622	endif
	623
	624	#ifdef NC_DOUBLE
	625	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
	626	#else
	627	ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
	628	#endif
	629	if (ierr.ne.NF_NOERR) then
	630	write(,) "dynredem0: Failed writing <bps> ",
	631	& "in file "//fichnom
	632	call abort
	633	endif
	634
	635	c
	636	c ----------------------
	637	c
	638	ierr = NF_REDEF (nid)
	639	if (ierr.ne.NF_NOERR) then
	640	write(,) "dynredem0: Failed to switch back to define mode"
	641	call abort
	642	endif
	643
	644	#ifdef NC_DOUBLE
	645	ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
	646	#else
	647	ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
	648	#endif
	649	if (ierr.ne.NF_NOERR) then
	650	write(,) "dynredem0: Failed defining <presniv> ",
	651	& "in file "//fichnom
	652	call abort
	653	endif
	654
	655	ierr = NF_ENDDEF(nid)
	656	if (ierr.ne.NF_NOERR) then
	657	write(,) "dynredem0: Failed to switch out of define mode"
	658	call abort
	659	endif
	660
	661	#ifdef NC_DOUBLE
	662	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
	663	#else
	664	ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
	665	#endif
	666	if (ierr.ne.NF_NOERR) then
	667	write(,) "dynredem0: Failed writing <presniv> ",
	668	& "in file "//fichnom
	669	call abort
	670	endif
	671
	672	c ------------------------------------------------------------------
	673	c ------------------------------------------------------------------
	674	c Variable uniquement pour visualisation avec Grads ou Ferret
	675	c ------------------------------------------------------------------
	676	ierr = NF_REDEF (nid)
	677	#ifdef NC_DOUBLE
	678	ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
	679	#else
	680	ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
	681	#endif
	682	ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
	683	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
	684	. "North latitude")
	685	ierr = NF_ENDDEF(nid)
	686	#ifdef NC_DOUBLE
	687	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
	688	#else
	689	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
	690	#endif
	691	c ----------------------
	692	ierr = NF_REDEF (nid)
	693	#ifdef NC_DOUBLE
	694	ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
	695	#else
	696	ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
	697	#endif
	698	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
	699	. "East longitude")
	700	ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
	701	ierr = NF_ENDDEF(nid)
	702	#ifdef NC_DOUBLE
	703	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
	704	#else
	705	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
	706	#endif
	707	c --------------------------
	708	ierr = NF_REDEF (nid)
	709	#ifdef NC_DOUBLE
	710	ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
	711	. idim_llm,nvarid)
	712	#else
	713	ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
	714	. idim_llm,nvarid)
	715	#endif
	716	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
	717	ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
	718	ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
	719
	720	ierr = NF_ENDDEF(nid)
	721	#ifdef NC_DOUBLE
	722	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
	723	#else
	724	ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
	725	#endif
	726
	727
	728	c ----------------------
	729	c ----------------------
	730	c
	731	c Coefficients de passage cov. <-> contra. <--> naturel
	732	c
	733	ierr = NF_REDEF (nid)
	734	dims2(1) = idim_rlonu
	735	dims2(2) = idim_rlatu
	736	#ifdef NC_DOUBLE
	737	ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
	738	#else
	739	ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
	740	#endif
	741	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
	742	. "Coefficient de passage pour U")
	743	ierr = NF_ENDDEF(nid)
	744	#ifdef NC_DOUBLE
	745	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
	746	#else
	747	ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
	748	#endif
	749	c
	750	c ----------------------
	751	ierr = NF_REDEF (nid)
	752	dims2(1) = idim_rlonv
	753	dims2(2) = idim_rlatv
	754	#ifdef NC_DOUBLE
	755	ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
	756	#else
	757	ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
	758	#endif
	759	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
	760	. "Coefficient de passage pour V")
	761	ierr = NF_ENDDEF(nid)
	762	#ifdef NC_DOUBLE
	763	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
	764	#else
	765	ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
	766	#endif
	767	c
	768	c ----------------------
	769	c Aire de chaque maille:
	770	c
	771	ierr = NF_REDEF (nid)
	772	dims2(1) = idim_rlonv
	773	dims2(2) = idim_rlatu
	774	#ifdef NC_DOUBLE
	775	ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
	776	#else
	777	ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
	778	#endif
	779	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
	780	. "Aires de chaque maille")
	781	ierr = NF_ENDDEF(nid)
	782	#ifdef NC_DOUBLE
	783	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
	784	#else
	785	ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
	786	#endif
	787	c
	788	c ----------------------
	789	c Geopentiel au sol:
	790	c
	791	ierr = NF_REDEF (nid)
	792	dims2(1) = idim_rlonv
	793	dims2(2) = idim_rlatu
	794	#ifdef NC_DOUBLE
	795	ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
	796	#else
	797	ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
	798	#endif
	799	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
	800	. "Geopotentiel au sol")
	801	ierr = NF_ENDDEF(nid)
	802	#ifdef NC_DOUBLE
	803	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
	804	#else
	805	ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
	806	#endif
	807	c
	808	c ----------------------
	809	c Definir les variables pour pouvoir les enregistrer plus tard:
	810	c
	811	ierr = NF_REDEF (nid) ! entrer dans le mode de definition
	812	if (ierr.ne.NF_NOERR) then
	813	write(,) "dynredem0: Failed to switch back to define mode"
	814	call abort
	815	endif
	816
	817	#ifdef NC_DOUBLE
	818	ierr = NF_DEF_VAR (nid,"Time",NF_DOUBLE,1,idim_tim,nvarid)
	819	#else
	820	ierr = NF_DEF_VAR (nid,"Time",NF_FLOAT,1,idim_tim,nvarid)
	821	#endif
	822	if (ierr.ne.NF_NOERR) then
	823	write(,) "dynredem0: Failed defining <Time> ",
	824	& "in file "//fichnom
	825	call abort
	826	endif
	827
	828	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
	829	& "Temps de simulation")
	830	if (ierr.ne.NF_NOERR) then
	831	write(,) "dynredem0: Failed writing title attribute",
	832	& "for <Time> in file "//fichnom
	833	call abort
	834	endif
	835
	836
	837	write(unites,200)yyears0,mmois0,jjour0
	838	200 format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
	839	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
	840	. unites)
	841	if (ierr.ne.NF_NOERR) then
	842	write(,) "dynredem0: Failed writing units attribute",
	843	& "for <Time> in file "//fichnom
	844	call abort
	845	endif
	846
	847
	848	c
	849	dims4(1) = idim_rlonu
	850	dims4(2) = idim_rlatu
	851	dims4(3) = idim_llm
	852	dims4(4) = idim_tim
	853	#ifdef NC_DOUBLE
	854	ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
	855	#else
	856	ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
	857	#endif
	858	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
	859	. "Vitesse U")
	860	c
	861	dims4(1) = idim_rlonv
	862	dims4(2) = idim_rlatv
	863	dims4(3) = idim_llm
	864	dims4(4) = idim_tim
	865	#ifdef NC_DOUBLE
	866	ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
	867	#else
	868	ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
	869	#endif
	870	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
	871	. "Vitesse V")
	872	c
	873	dims4(1) = idim_rlonv
	874	dims4(2) = idim_rlatu
	875	dims4(3) = idim_llm
	876	dims4(4) = idim_tim
	877	#ifdef NC_DOUBLE
	878	ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
	879	#else
	880	ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
	881	#endif
	882	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
	883	. "Temperature")
	884	c
	885	dims4(1) = idim_rlonv
	886	dims4(2) = idim_rlatu
	887	dims4(3) = idim_llm
	888	dims4(4) = idim_tim
[1416]	889	IF(nqtot.GE.1) THEN
	890	DO iq=1,nqtot
[135]	891	IF (iq.GT.99) THEN
	892	PRINT*, "Trop de traceurs"
	893	CALL abort
	894	ELSE
	895	! str3(1:1)='q'
	896	! WRITE(str3(2:3),'(i2.2)') iq
	897	!#ifdef NC_DOUBLE
	898	! ierr = NF_DEF_VAR (nid,str3,NF_DOUBLE,4,dims4,nvarid)
	899	!#else
	900	! ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid)
	901	!#endif
	902	! ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
	903	! . "Traceurs "//str3)
[1216]	904	txt="Traceur "//trim(tname(iq))
[135]	905	#ifdef NC_DOUBLE
[1216]	906	ierr=NF_DEF_VAR(nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
[135]	907	#else
[1216]	908	ierr=NF_DEF_VAR(nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
[135]	909	#endif
	910	ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",
	911	. len_trim(txt),trim(txt))
	912	ENDIF
	913	ENDDO
	914	ENDIF
	915	c
	916	dims4(1) = idim_rlonv
	917	dims4(2) = idim_rlatu
	918	dims4(3) = idim_llm
	919	dims4(4) = idim_tim
	920	#ifdef NC_DOUBLE
	921	ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
	922	#else
	923	ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
	924	#endif
	925	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
	926	. "C est quoi ?")
	927	c
	928	dims3(1) = idim_rlonv
	929	dims3(2) = idim_rlatu
	930	dims3(3) = idim_tim
	931	#ifdef NC_DOUBLE
	932	ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
	933	#else
	934	ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
	935	#endif
	936	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
	937	. "Pression au sol")
	938	c
	939	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
	940	ierr = NF_CLOSE(nid) ! fermer le fichier
	941
	942	write(,)'dynredem0: iim,jjm,llm,idayref',iim,jjm,llm,idayref
	943	write(,)'dynredem0: rad,omeg,g,cpp,kappa',
	944	& rad,omeg,g,cpp,kappa
	945
	946	! stop "dynredem0 halt"
	947
	948	RETURN
	949	END
	950
	951	c ================================================================
	952	c ================================================================
	953
	954	SUBROUTINE dynredem1(fichnom,time,
[1416]	955	. vcov,ucov,teta,q,masse,ps)
[1216]	956	use infotrac, only: nqtot, tname
[135]	957	IMPLICIT NONE
	958	c=================================================================
	959	c Ecriture du fichier de redemarrage sous format NetCDF
	960	c=================================================================
	961	#include "dimensions.h"
	962	#include "paramet.h"
	963	#include "netcdf.inc"
	964	#include "comgeom.h"
[1216]	965	!#include"advtrac.h"
[135]	966
[1416]	967	INTEGER l
[135]	968	REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
	969	REAL teta(ip1jmp1,llm)
	970	REAL ps(ip1jmp1),masse(ip1jmp1,llm)
[1216]	971	REAL q(iip1,jjp1,llm,nqtot)
[135]	972	REAL q3d(iip1,jjp1,llm) !temporary variable
	973	CHARACTER() fichnom
	974
	975	REAL time
	976	INTEGER nid, nvarid
	977	INTEGER ierr
	978	INTEGER iq
	979	CHARACTER str3*3
	980	character*20 modname
	981	character*80 abort_message
	982	c
	983	INTEGER nb,i,j
	984	SAVE nb
	985	DATA nb / 0 /
	986
	987	modname = 'dynredem1'
	988	ierr = NF_OPEN(fichnom, NF_WRITE, nid)
	989	IF (ierr .NE. NF_NOERR) THEN
	990	PRINT*, "Pb. d ouverture "//fichnom
	991	CALL abort
	992	ENDIF
	993
	994	c Ecriture/extension de la coordonnee temps
	995
	996	nb = nb + 1
	997	ierr = NF_INQ_VARID(nid, "Time", nvarid)
	998	IF (ierr .NE. NF_NOERR) THEN
	999	print *, NF_STRERROR(ierr)
	1000	abort_message='Variable Time n est pas definie'
	1001	CALL abort_gcm(modname,abort_message,ierr)
	1002	ENDIF
	1003	#ifdef NC_DOUBLE
	1004	ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
	1005	#else
	1006	ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
	1007	#endif
	1008	PRINT*, "Enregistrement pour ", nb, time
	1009
	1010	c Ecriture des champs
	1011	c
	1012	ierr = NF_INQ_VARID(nid, "ucov", nvarid)
	1013	IF (ierr .NE. NF_NOERR) THEN
	1014	PRINT*, "Variable ucov n est pas definie"
	1015	CALL abort
	1016	ENDIF
	1017	#ifdef NC_DOUBLE
	1018	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
	1019	#else
	1020	ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
	1021	#endif
	1022
	1023	ierr = NF_INQ_VARID(nid, "vcov", nvarid)
	1024	IF (ierr .NE. NF_NOERR) THEN
	1025	PRINT*, "Variable vcov n est pas definie"
	1026	CALL abort
	1027	ENDIF
	1028	#ifdef NC_DOUBLE
	1029	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
	1030	#else
	1031	ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
	1032	#endif
	1033
	1034	ierr = NF_INQ_VARID(nid, "teta", nvarid)
	1035	IF (ierr .NE. NF_NOERR) THEN
	1036	PRINT*, "Variable teta n est pas definie"
	1037	CALL abort
	1038	ENDIF
	1039	#ifdef NC_DOUBLE
	1040	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
	1041	#else
	1042	ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
	1043	#endif
	1044
[1416]	1045	IF (nqtot.GT.99) THEN
[135]	1046	PRINT*, "Trop de traceurs"
	1047	CALL abort
	1048	ENDIF
[1416]	1049	IF(nqtot.GE.1) THEN
	1050	DO iq=1,nqtot
[135]	1051	! str3(1:1)='q'
	1052	! WRITE(str3(2:3),'(i2.2)') iq
	1053	! ierr = NF_INQ_VARID(nid, str3, nvarid)
[1216]	1054	ierr=NF_INQ_VARID(nid,tname(iq),nvarid)
[135]	1055	IF (ierr .NE. NF_NOERR) THEN
	1056	! PRINT*, "Variable "//str3//" n est pas definie"
[1216]	1057	PRINT*,"Variable "//trim(tname(iq))//" n est pas definie"
[135]	1058	CALL abort
	1059	ENDIF
	1060	do l=1,llm
	1061	do j=1,jjp1
	1062	do i=1,iip1
	1063	q3d(i,j,l)=q(i,j,l,iq)
	1064	enddo
	1065	enddo
	1066	enddo
	1067	#ifdef NC_DOUBLE
	1068	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q3d)
	1069	#else
	1070	ierr = NF_PUT_VAR_REAL (nid,nvarid,q3d)
	1071	#endif
	1072	IF (ierr .NE. NF_NOERR) THEN
	1073	PRINT*, "Error: ", NF_STRERROR(ierr)
	1074	CALL abort
	1075	ENDIF
	1076	ENDDO
	1077	ENDIF
	1078	c
	1079	ierr = NF_INQ_VARID(nid, "masse", nvarid)
	1080	IF (ierr .NE. NF_NOERR) THEN
	1081	PRINT*, "Variable masse n est pas definie"
	1082	CALL abort
	1083	ENDIF
	1084	#ifdef NC_DOUBLE
	1085	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
	1086	#else
	1087	ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
	1088	#endif
	1089	c
	1090	ierr = NF_INQ_VARID(nid, "ps", nvarid)
	1091	IF (ierr .NE. NF_NOERR) THEN
	1092	PRINT*, "Variable ps n est pas definie"
	1093	CALL abort
	1094	ENDIF
	1095	#ifdef NC_DOUBLE
	1096	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
	1097	#else
	1098	ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
	1099	#endif
	1100
	1101	ierr = NF_CLOSE(nid)
	1102	c
	1103	RETURN
	1104	END
	1105

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

Download in other formats:

Original Format