source: trunk/LMDZ.COMMON/libf/dyn3d/dynredem.F @ 492

Last change on this file since 492 was 492, checked in by emillour, 13 years ago

Common dynamics: updates to keep up with LMDZ5 Earth (rev 1605)
See file "DOC/chantiers/commit_importants.log" for details.
EM

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