Context Navigation

dynredem.F @ 1311

Last change on this file since 1311 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

tous les FLOAT() sont remplacés par des REAL()
tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

all FLOAT() instructions have been replaced by REAL() instructions
all STOP instructions in phylmd have been replaced by calls to abort_gcm
the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
$Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 20.9 KB

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

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

Download in other formats:

Original Format