Context Navigation

dynredem_p.F @ 1732

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

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

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

Download in other formats:

Original Format