Context Navigation

dynredem.F @ 1299

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

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

Download in other formats:

Original Format