source: LMDZ4/branches/LMDZ4_V3_patches/libf/dyn3d/dynredem.F @ 5404

Last change on this file since 5404 was 845, checked in by Laurent Fairhead, 17 years ago

Création de la branche LMDZ4_V3_patches: à partir de la version de référence LMDZ4_V3,

on corrige différents bugs qui sont sur la branche de développement HEAD pour établir
une version de référence LMDZ4_V3 pour les utilisateurs non-développeurs

Cette branche ne servira que pour les corrections de bugs et les version y seront tagguées

LF

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