source: LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F @ 1632

Last change on this file since 1632 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

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