source: LMDZ4/trunk/libf/dyn3d/dynredem.F @ 1378

Last change on this file since 1378 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

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