source: LMDZ5/branches/testing/libf/dyn3dmem/dynredem_loc.F @ 1669

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

Version testing basée sur la r1668

http://lmdz.lmd.jussieu.fr/utilisateurs/distribution-du-modele/versions-intermediaires


Testing release based on r1668

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