source: LMDZ5/branches/testing/libf/dyn3d/dynredem.F @ 1664

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

Version testing basée sur la r1575


Testing release based on r1575

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