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

Last change on this file since 1707 was 1707, checked in by Laurent Fairhead, 11 years ago

Version testing basée sur la r1706


Testing release based on r1706

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