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

Last change on this file since 1972 was 1939, checked in by lguez, 11 years ago

Same as revision 1930: replaced abort by abort_gcm.

Also replaced real*8 by real(kind=8) (was done way back in revision 1220 for
dyn3d/fxhyp.F but not dyn3dpar/fxhyp.F).

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 19.2 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_lmdz
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_GCM("DYNREDEM0", "", 1)
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_lmdz
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_gcm("dynredem1", "", 1)
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.