source: LMDZ5/branches/LMDZ5V1.0-dev/libf/dyn3dpar/dynredem_p.F @ 5139

Last change on this file since 5139 was 1403, checked in by Laurent Fairhead, 14 years ago

Merged LMDZ4V5.0-dev branch changes r1292:r1399 to trunk.

Validation:
Validation consisted in compiling the HEAD revision of the trunk,
LMDZ4V5.0-dev branch and the merged sources and running different
configurations on local and SX8 machines comparing results.

Local machine: bench configuration, 32x24x11, gfortran

  • IPSLCM5A configuration (comparison between trunk and merged sources):
    • numerical convergence on dynamical fields over 3 days
    • start files are equivalent (except for RN and PB fields)
    • daily history files equivalent
  • MH07 configuration, new physics package (comparison between LMDZ4V5.0-dev branch and merged sources):
    • numerical convergence on dynamical fields over 3 days
    • start files are equivalent (except for RN and PB fields)
    • daily history files equivalent

SX8 machine (brodie), 96x95x39 on 4 processors:

  • IPSLCM5A configuration:
    • start files are equivalent (except for RN and PB fields)
    • monthly history files equivalent
  • MH07 configuration:
    • start files are equivalent (except for RN and PB fields)
    • monthly history files equivalent

Changes to the makegcm and create_make_gcm scripts to take into account
main programs in F90 files

Fusion de la branche LMDZ4V5.0-dev (r1292:r1399) au tronc principal

Validation:
La validation a consisté à compiler la HEAD de le trunk et de la banche
LMDZ4V5.0-dev et les sources fusionnées et de faire tourner le modéle selon
différentes configurations en local et sur SX8 et de comparer les résultats

En local: 32x24x11, config bench/gfortran

  • pour une config IPSLCM5A (comparaison tronc/fusion):
    • convergence numérique sur les champs dynamiques après 3 jours
    • restart et restartphy égaux (à part sur RN et Pb)
    • fichiers histoire égaux
  • pour une config nlle physique (MH07) (comparaison LMDZ4v5.0-dev/fusion):
    • convergence numérique sur les champs dynamiques après 3 jours
    • restart et restartphy égaux
    • fichiers histoire équivalents

Sur brodie, 96x95x39 sur 4 proc:

  • pour une config IPSLCM5A:
    • restart et restartphy égaux (à part sur RN et PB)
    • pas de différence dans les fichiers histmth.nc
  • pour une config MH07
    • restart et restartphy égaux (à part sur RN et PB)
    • pas de différence dans les fichiers histmth.nc

Changement sur makegcm et create_make-gcm pour pouvoir prendre en compte des
programmes principaux en *F90
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 21.5 KB
Line 
1!
2! $Id: dynredem_p.F 1403 2010-07-01 09:02:53Z abarral $
3!
4c
5      SUBROUTINE dynredem0_p(fichnom,iday_end,phis)
6#ifdef CPP_IOIPSL
7      USE IOIPSL
8#endif
9      USE parallel
10      USE infotrac
11      IMPLICIT NONE
12c=======================================================================
13c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
14c=======================================================================
15c   Declarations:
16c   -------------
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
29c   Arguments:
30c   ----------
31      INTEGER iday_end
32      REAL phis(ip1jmp1)
33      CHARACTER*(*) fichnom
34
35c   Local:
36c   ------
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
45c   Variables locales pour NetCDF:
46c
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
58c-----------------------------------------------------------------------
59      if (mpi_rank==0) then
60     
61      modname='dynredem0_p'
62
63#ifdef CPP_IOIPSL
64      call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
65      call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
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               
72
73      DO l=1,length
74       tab_cntrl(l) = 0.
75      ENDDO
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)
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
95c
96c    .....    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
102c
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
120       tab_cntrl(30) =  REAL(iday_end)
121       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
122c
123c    .........................................................
124c
125c Creation du fichier:
126c
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
133c
134c Preciser quelques attributs globaux:
135c
136      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
137     .                       "Fichier demmarage dynamique")
138c
139c Definir les dimensions du fichiers:
140c
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)
149c
150      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
151c
152c Definir et enregistrer certains champs invariants:
153c
154      ierr = NF_REDEF (nid)
155cIM 220306 BEG
156#ifdef NC_DOUBLE
157      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
158#else
159      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
160#endif
161cIM 220306 END
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
170c
171      ierr = NF_REDEF (nid)
172cIM 220306 BEG
173#ifdef NC_DOUBLE
174      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
175#else
176      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
177#endif
178cIM 220306 END
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
187c
188      ierr = NF_REDEF (nid)
189cIM 220306 BEG
190#ifdef NC_DOUBLE
191      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
192#else
193      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
194#endif
195cIM 220306 END
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
204c
205      ierr = NF_REDEF (nid)
206cIM 220306 BEG
207#ifdef NC_DOUBLE
208      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
209#else
210      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
211#endif
212cIM 220306 END
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
221c
222      ierr = NF_REDEF (nid)
223cIM 220306 BEG
224#ifdef NC_DOUBLE
225      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
226#else
227      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
228#endif
229cIM 220306 END
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
238c
239      ierr = NF_REDEF (nid)
240cIM 220306 BEG
241#ifdef NC_DOUBLE
242      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
243#else
244      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
245#endif
246cIM 220306 END
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
255c
256      ierr = NF_REDEF (nid)
257cIM 220306 BEG
258#ifdef NC_DOUBLE
259      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
260#else
261      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
262#endif
263cIM 220306 END
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
272c
273      ierr = NF_REDEF (nid)
274cIM 220306 BEG
275#ifdef NC_DOUBLE
276      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
277#else
278      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
279#endif
280cIM 220306 END
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
289c
290      ierr = NF_REDEF (nid)
291cIM 220306 BEG
292#ifdef NC_DOUBLE
293      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
294#else
295      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
296#endif
297cIM 220306 END
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
306c
307      ierr = NF_REDEF (nid)
308cIM 220306 BEG
309#ifdef NC_DOUBLE
310      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
311#else
312      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
313#endif
314cIM 220306 END
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
321c
322c Coefficients de passage cov. <-> contra. <--> naturel
323c
324      ierr = NF_REDEF (nid)
325      dims2(1) = idim_rlonu
326      dims2(2) = idim_rlatu
327cIM 220306 BEG
328#ifdef NC_DOUBLE
329      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
330#else
331      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
332#endif
333cIM 220306 END
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
342c
343      ierr = NF_REDEF (nid)
344      dims2(1) = idim_rlonv
345      dims2(2) = idim_rlatv
346cIM 220306 BEG
347#ifdef NC_DOUBLE
348      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
349#else
350      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
351#endif
352cIM 220306 END
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
361c
362c Aire de chaque maille:
363c
364      ierr = NF_REDEF (nid)
365      dims2(1) = idim_rlonv
366      dims2(2) = idim_rlatu
367cIM 220306 BEG
368#ifdef NC_DOUBLE
369      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
370#else
371      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
372#endif
373cIM 220306 END
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
382c
383c Geopentiel au sol:
384c
385      ierr = NF_REDEF (nid)
386      dims2(1) = idim_rlonv
387      dims2(2) = idim_rlatu
388cIM 220306 BEG
389#ifdef NC_DOUBLE
390      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
391#else
392      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
393#endif
394cIM 220306 END
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
403c
404c Definir les variables pour pouvoir les enregistrer plus tard:
405c
406      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
407c
408cIM 220306 BEG
409#ifdef NC_DOUBLE
410      ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
411#else
412      ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
413#endif
414cIM 220306 END
415      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
416     .                       "Temps de simulation")
417      write(unites,200)yyears0,mmois0,jjour0
418200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
419      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
420     .                         unites)
421
422c
423      dims4(1) = idim_rlonu
424      dims4(2) = idim_rlatu
425      dims4(3) = idim_s
426      dims4(4) = idim_tim
427cIM 220306 BEG
428#ifdef NC_DOUBLE
429      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
430#else
431      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
432#endif
433cIM 220306 END
434      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
435     .                       "Vitesse U")
436c
437      dims4(1) = idim_rlonv
438      dims4(2) = idim_rlatv
439      dims4(3) = idim_s
440      dims4(4) = idim_tim
441cIM 220306 BEG
442#ifdef NC_DOUBLE
443      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
444#else
445      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
446#endif
447cIM 220306 END
448      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
449     .                       "Vitesse V")
450c
451      dims4(1) = idim_rlonv
452      dims4(2) = idim_rlatu
453      dims4(3) = idim_s
454      dims4(4) = idim_tim
455cIM 220306 BEG
456#ifdef NC_DOUBLE
457      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
458#else
459      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
460#endif
461cIM 220306 END
462      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
463     .                       "Temperature")
464c
465      dims4(1) = idim_rlonv
466      dims4(2) = idim_rlatu
467      dims4(3) = idim_s
468      dims4(4) = idim_tim
469
470      DO iq=1,nqtot
471cIM 220306 BEG
472#ifdef NC_DOUBLE
473      ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
474#else
475      ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
476#endif
477cIM 220306 END
478      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
479      ENDDO
480c
481      dims4(1) = idim_rlonv
482      dims4(2) = idim_rlatu
483      dims4(3) = idim_s
484      dims4(4) = idim_tim
485cIM 220306 BEG
486#ifdef NC_DOUBLE
487      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
488#else
489      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
490#endif
491cIM 220306 END
492      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
493     .                       "C est quoi ?")
494c
495      dims3(1) = idim_rlonv
496      dims3(2) = idim_rlatu
497      dims3(3) = idim_tim
498cIM 220306 BEG
499#ifdef NC_DOUBLE
500      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
501#else
502      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
503#endif
504cIM 220306 END
505      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
506     .                       "Pression au sol")
507c
508      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
509      ierr = NF_CLOSE(nid) ! fermer le fichier
510
511
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,
520     .                     vcov,ucov,teta,q,masse,ps)
521      USE parallel
522      USE infotrac
523      USE control_mod
524      IMPLICIT NONE
525c=================================================================
526c  Ecriture du fichier de redemarrage sous format NetCDF
527c=================================================================
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
536      INTEGER l
537      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
538      REAL teta(ip1jmp1,llm)                   
539      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
540      REAL q(ip1jmp1,llm,nqtot)
541      CHARACTER*(*) fichnom
542     
543      REAL time
544      INTEGER nid, nvarid, nid_trac, nvarid_trac
545      REAL trac_tmp(ip1jmp1,llm)     
546      INTEGER ierr, ierr_file
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
553c
554      INTEGER nb
555      SAVE nb
556      DATA nb / 0 /
557
558      logical exist_file
559
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     
566      do iq=1,nqtot
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
580c  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
596c
597c  Re-ecriture du tableau de controle, itaufin n'est plus defini quand
598c  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
610       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
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
617c  Ecriture des champs
618c
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
652      IF (config_inca /= 'none') THEN
653! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc
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
665      END IF
666
667      do iq=1,nqtot
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
675#ifdef NC_DOUBLE
676            ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
677#else
678            ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
679#endif
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     
736      ENDDO
737
738
739
740c
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
751c
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)
764c
765      endif ! mpi_rank==0
766     
767      RETURN
768      END
769
Note: See TracBrowser for help on using the repository browser.