source: LMDZ4/branches/LMDZ4V5.0-LF/libf/dyn3d/dynredem.F @ 5214

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

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

  • tous les FLOAT() sont remplacés par des REAL()
  • tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
  • le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
  • des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper


General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

  • all FLOAT() instructions have been replaced by REAL() instructions
  • all STOP instructions in phylmd have been replaced by calls to abort_gcm
  • the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
  • $Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me

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