source: trunk/MESOSCALE/LMDZ.MARS/libf_gcm/dyn3d/dynredem.F @ 815

Last change on this file since 815 was 57, checked in by aslmd, 14 years ago

mineur LMD_MM_MARS: ajout du GCM ancienne physique, systeme maintenant complet sur SVN (ne manque que la base de donnees d'etats initiaux)

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