source: trunk/LMDZ.MARS/libf/dyn3d/dynredem.F @ 937

Last change on this file since 937 was 410, checked in by acolaitis, 13 years ago

Modified NCDF norm of our files from classic to 64bit offset to support variables indices of more than integer*4 maximum length. This is a priori retrocompatible with classic format. I have tested it, it works for all file outputs, newstart (on classic or 64-bit offset files). One can check the format of his .nc with ncdump -k file.nc
File size: 31.6 KB
RevLine 
[38]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#include "advtrac.h"
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      character(len=80) :: txt ! to store some text
38
39c   Variables locales pour NetCDF:
40c
41      INTEGER dims2(2), dims3(3), dims4(4)
42      INTEGER idim_index
43      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
44      INTEGER idim_llm, idim_llmp1
45      INTEGER idim_tim
46      INTEGER nid,nvarid
47
48      REAL zan0,zjulian,hours
49      REAL sigs(llm)
50      INTEGER yyears0,jjour0, mmois0
51      data yyears0 /1/
52      data jjour0 /1/
53      data mmois0 /1/
54      character*30 unites
55
56
57c-----------------------------------------------------------------------
58      modname='dynredem'
59      do l=1,llm
60         sigs(l)=real(l)
61      enddo
62
63      DO l=1,length
64       tab_cntrl(l) = 0.
65      ENDDO
66       tab_cntrl(1)  = REAL(iim)
67       tab_cntrl(2)  = REAL(jjm)
68       tab_cntrl(3)  = REAL(llm)
69       tab_cntrl(4)  = REAL(idayref)
70       tab_cntrl(5)  = rad
71       tab_cntrl(6)  = omeg
72       tab_cntrl(7)  = g
73       tab_cntrl(8)  = cpp
74       tab_cntrl(9) = kappa
75       tab_cntrl(10) = daysec
76       tab_cntrl(11) = dtvr
77       tab_cntrl(12) = etot0
78       tab_cntrl(13) = ptot0
79       tab_cntrl(14) = ztot0
80       tab_cntrl(15) = stot0
81       tab_cntrl(16) = ang0
82       tab_cntrl(17) = pa
83       tab_cntrl(18) = preff
84c
85c    .....    parametres  pour le zoom      ......   
86
87       tab_cntrl(19)  = clon
88       tab_cntrl(20)  = clat
89       tab_cntrl(21)  = grossismx
90       tab_cntrl(22)  = grossismy
91c
92      IF ( fxyhypb )   THEN
93       tab_cntrl(23) = 1.
94       tab_cntrl(24) = dzoomx
95       tab_cntrl(25) = dzoomy
96       tab_cntrl(26) = 0.
97       tab_cntrl(27) = taux
98       tab_cntrl(28) = tauy
99      ELSE
100       tab_cntrl(23) = 0.
101       tab_cntrl(24) = dzoomx
102       tab_cntrl(25) = dzoomy
103       tab_cntrl(26) = 0.
104       tab_cntrl(27) = 0.
105       tab_cntrl(28) = 0.
106       IF( ysinus )  tab_cntrl(26) = 1.
107      ENDIF
108c
109c    .........................................................
110c
111c Creation du fichier:
112c
[410]113      ierr = NF_CREATE(fichnom, IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
[38]114      IF (ierr.NE.NF_NOERR) THEN
115         WRITE(6,*)" Failed creating file "//fichnom
116         WRITE(6,*)' ierr = ', ierr
117         CALL ABORT
118      ENDIF
119c
120c Preciser quelques attributs globaux:
121c
122      ierr = NF_PUT_ATT_TEXT (nid,NF_GLOBAL,"title",18,
123     .                       "Dynamic start file")
124      if (ierr.ne.NF_NOERR) then
125        write(*,*) "dynredem0: Failed writing title in file "//fichnom
126        call abort
127      endif
128c
129c Definir les dimensions du fichiers:
130c
131      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
132      if (ierr.ne.NF_NOERR) then
133        write(*,*) "dynredem0: Failed defining dimension <index> ",
134     &             "in file "//fichnom
135        call abort
136      endif
137
138      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
139      if (ierr.ne.NF_NOERR) then
140        write(*,*) "dynredem0: Failed defining dimension <rlonu> ",
141     &             "in file "//fichnom
142        call abort
143      endif
144
145      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
146      if (ierr.ne.NF_NOERR) then
147        write(*,*) "dynredem0: Failed defining dimension <latitude> ",
148     &             "in file "//fichnom
149        call abort
150      endif
151
152      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
153      if (ierr.ne.NF_NOERR) then
154        write(*,*) "dynredem0: Failed defining dimension <longitude> ",
155     &             "in file "//fichnom
156        call abort
157      endif
158
159      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
160      if (ierr.ne.NF_NOERR) then
161        write(*,*) "dynredem0: Failed defining dimension <rlatv> ",
162     &             "in file "//fichnom
163        call abort
164      endif
165
166      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
167      if (ierr.ne.NF_NOERR) then
168        write(*,*) "dynredem0: Failed defining dimension <altitude> ",
169     &             "in file "//fichnom
170        call abort
171      endif
172
173      ierr = NF_DEF_DIM (nid, "interlayer", llmp1, idim_llmp1)
174      if (ierr.ne.NF_NOERR) then
175        write(*,*) "dynredem0: Failed defining dimension <interlayer> ",
176     &             "in file "//fichnom
177        call abort
178      endif
179
180      ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_tim)
181      if (ierr.ne.NF_NOERR) then
182        write(*,*) "dynredem0: Failed defining dimension <Time> ",
183     &             "in file "//fichnom
184        call abort
185      endif
186
187
188c     CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
189c     ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
190c     ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
191c     ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
192c
193      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
194      if (ierr.ne.NF_NOERR) then
195        write(*,*) "dynredem0: Failed to switch out of define mode",
196     &             "in file "//fichnom
197        call abort
198      endif
199
200
201c
202c Definir et enregistrer certains champs invariants:
203c
204c ----------------------
205c
206      ierr = NF_REDEF (nid)
207      if (ierr.ne.NF_NOERR) then
208        write(*,*) "dynredem0: Failed to switch back to define mode"
209        call abort
210      endif
211#ifdef NC_DOUBLE
212      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
213#else
214      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
215#endif
216      if (ierr.ne.NF_NOERR) then
217        write(*,*) "dynredem0: Failed defining <controle> ",
218     &             "in file "//fichnom
219        call abort
220      endif
221
222      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
223     .                       "Parametres de controle")
224      if (ierr.ne.NF_NOERR) then
225        write(*,*) "dynredem0: Failed writing title attribute ",
226     &             "for <controle> in file "//fichnom
227        call abort
228      endif
229
230      ierr = NF_ENDDEF(nid)
231      if (ierr.ne.NF_NOERR) then
232        write(*,*) "dynredem0: Failed to switch out of define mode"
233        call abort
234      endif
235#ifdef NC_DOUBLE
236      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
237#else
238      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
239#endif
240      if (ierr.ne.NF_NOERR) then
241        write(*,*) "dynredem0: Failed writing <controle> ",
242     &             "in file "//fichnom
243        call abort
244!      else
245!       write(*,*) "dynredem0: controle(1)=",tab_cntrl(1)
246      endif
247
248c
249c ----------------------
250c
251      ierr = NF_REDEF (nid)
252      if (ierr.ne.NF_NOERR) then
253        write(*,*) "dynredem0: Failed to switch back to define mode"
254        call abort
255      endif
256#ifdef NC_DOUBLE
257      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
258#else
259      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
260#endif
261      if (ierr.ne.NF_NOERR) then
262        write(*,*) "dynredem0: Failed defining <rlonu> ",
263     &             "in file "//fichnom
264        call abort
265      endif
266
267      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
268     .                       "Longitudes des points U")
269      if (ierr.ne.NF_NOERR) then
270        write(*,*) "dynredem0: Failed writing title attribute ",
271     &             "for <rlonu> in file "//fichnom
272        call abort
273      endif
274
275      ierr = NF_ENDDEF(nid)
276      if (ierr.ne.NF_NOERR) then
277        write(*,*) "dynredem0: Failed to switch out of define mode"
278        call abort
279      endif
280#ifdef NC_DOUBLE
281      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
282#else
283      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
284#endif
285      if (ierr.ne.NF_NOERR) then
286        write(*,*) "dynredem0: Failed writing <rlonu> ",
287     &             "in file "//fichnom
288        call abort
289      endif
290
291c
292c ----------------------
293c
294      ierr = NF_REDEF (nid)
295      if (ierr.ne.NF_NOERR) then
296        write(*,*) "dynredem0: Failed to switch back to define mode"
297        call abort
298      endif
299#ifdef NC_DOUBLE
300      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
301#else
302      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
303#endif
304      if (ierr.ne.NF_NOERR) then
305        write(*,*) "dynredem0: Failed defining <rlatu> ",
306     &             "in file "//fichnom
307        call abort
308      endif
309
310      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
311     .                       "Latitudes des points U")
312      if (ierr.ne.NF_NOERR) then
313        write(*,*) "dynredem0: Failed writing title attribute ",
314     &             "for <rlatu> in file "//fichnom
315        call abort
316      endif
317
318      ierr = NF_ENDDEF(nid)
319      if (ierr.ne.NF_NOERR) then
320        write(*,*) "dynredem0: Failed to switch out of define mode"
321        call abort
322      endif
323#ifdef NC_DOUBLE
324      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
325#else
326      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
327#endif
328      if (ierr.ne.NF_NOERR) then
329        write(*,*) "dynredem0: Failed writing <rlatu> ",
330     &             "in file "//fichnom
331        call abort
332      endif
333
334c
335c ----------------------
336c
337      ierr = NF_REDEF (nid)
338      if (ierr.ne.NF_NOERR) then
339        write(*,*) "dynredem0: Failed to switch back to define mode"
340        call abort
341      endif
342#ifdef NC_DOUBLE
343      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
344#else
345      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
346#endif
347      if (ierr.ne.NF_NOERR) then
348        write(*,*) "dynredem0: Failed defining <rlonv> ",
349     &             "in file "//fichnom
350        call abort
351      endif
352
353      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
354     .                       "Longitudes des points V")
355      if (ierr.ne.NF_NOERR) then
356        write(*,*) "dynredem0: Failed writing title attribute ",
357     &             "for <rlonv> in file "//fichnom
358        call abort
359      endif
360
361      ierr = NF_ENDDEF(nid)
362      if (ierr.ne.NF_NOERR) then
363        write(*,*) "dynredem0: Failed to switch out of define mode"
364        call abort
365      endif
366#ifdef NC_DOUBLE
367      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
368#else
369      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
370#endif
371      if (ierr.ne.NF_NOERR) then
372        write(*,*) "dynredem0: Failed writing <rlonv> ",
373     &             "in file "//fichnom
374        call abort
375      endif
376
377c
378c ----------------------
379c
380      ierr = NF_REDEF (nid)
381      if (ierr.ne.NF_NOERR) then
382        write(*,*) "dynredem0: Failed to switch back to define mode"
383        call abort
384      endif
385#ifdef NC_DOUBLE
386      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
387#else
388      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
389#endif
390      if (ierr.ne.NF_NOERR) then
391        write(*,*) "dynredem0: Failed defining <rlatv> ",
392     &             "in file "//fichnom
393        call abort
394      endif
395
396      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
397     .                       "Latitudes des points V")
398      if (ierr.ne.NF_NOERR) then
399        write(*,*) "dynredem0: Failed writing title attribute ",
400     &             "for <rlatv> in file "//fichnom
401        call abort
402      endif
403
404      ierr = NF_ENDDEF(nid)
405      if (ierr.ne.NF_NOERR) then
406        write(*,*) "dynredem0: Failed to switch out of define mode"
407        call abort
408      endif
409#ifdef NC_DOUBLE
410      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
411#else
412      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
413#endif
414      if (ierr.ne.NF_NOERR) then
415        write(*,*) "dynredem0: Failed writing <rlatv> ",
416     &             "in file "//fichnom
417        call abort
418      endif
419c
420c ----------------------
421c
422      ierr = NF_REDEF (nid)
423      if (ierr.ne.NF_NOERR) then
424        write(*,*) "dynredem0: Failed to switch back to define mode"
425        call abort
426      endif
427#ifdef NC_DOUBLE
428      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
429#else
430      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
431#endif
432      if (ierr.ne.NF_NOERR) then
433        write(*,*) "dynredem0: Failed defining <ap> ",
434     &             "in file "//fichnom
435        call abort
436      endif
437
438      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
439     .          "Coef A: hybrid pressure levels"  )
440      if (ierr.ne.NF_NOERR) then
441        write(*,*) "dynredem0: Failed writing title attribute ",
442     &             "for <ap> in file "//fichnom
443        call abort
444      endif
445
446      ierr = NF_ENDDEF(nid)
447      if (ierr.ne.NF_NOERR) then
448        write(*,*) "dynredem0: Failed to switch out of define mode"
449        call abort
450      endif
451#ifdef NC_DOUBLE
452      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
453#else
454      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
455#endif
456      if (ierr.ne.NF_NOERR) then
457        write(*,*) "dynredem0: Failed writing <ap> ",
458     &             "in file "//fichnom
459        call abort
460      endif
461
462c
463c ----------------------
464c
465      ierr = NF_REDEF (nid)
466      if (ierr.ne.NF_NOERR) then
467        write(*,*) "dynredem0: Failed to switch back to define mode"
468        call abort
469      endif
470#ifdef NC_DOUBLE
471      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
472#else
473      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
474#endif
475      if (ierr.ne.NF_NOERR) then
476        write(*,*) "dynredem0: Failed defining <bp> ",
477     &             "in file "//fichnom
478        call abort
479      endif
480
481      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
482     .      "Coef B: hybrid sigma levels")
483      if (ierr.ne.NF_NOERR) then
484        write(*,*) "dynredem0: Failed writing title attribute ",
485     &             "for <bp> in file "//fichnom
486        call abort
487      endif
488
489      ierr = NF_ENDDEF(nid)
490      if (ierr.ne.NF_NOERR) then
491        write(*,*) "dynredem0: Failed to switch out of define mode"
492        call abort
493      endif
494#ifdef NC_DOUBLE
495      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
496#else
497      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
498#endif
499      if (ierr.ne.NF_NOERR) then
500        write(*,*) "dynredem0: Failed writing <bp> ",
501     &             "in file "//fichnom
502        call abort
503      endif
504
505c
506c ----------------------
507c
508!      ierr = NF_REDEF (nid)
509!      if (ierr.ne.NF_NOERR) then
510!        write(*,*) "dynredem0: Failed to switch back to define mode"
511!        call abort
512!      endif
513!#ifdef NC_DOUBLE
514!      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
515!#else
516!      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
517!#endif
518!      if (ierr.ne.NF_NOERR) then
519!        write(*,*) "dynredem0: Failed defining <ap> ",
520!     &             "in file "//fichnom
521!        call abort
522!      endif
523!
524!      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
525!     .          "Coef A: hybrid pressure levels"  )
526!      if (ierr.ne.NF_NOERR) then
527!        write(*,*) "dynredem0: Failed writing title attribute ",
528!     &             "for <ap> in file "//fichnom
529!
530!      ierr = NF_ENDDEF(nid)
531!      if (ierr.ne.NF_NOERR) then
532!        write(*,*) "dynredem0: Failed to switch out of define mode"
533!        call abort
534!      endif
535!#ifdef NC_DOUBLE
536!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
537!#else
538!      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
539!#endif
540!      if (ierr.ne.NF_NOERR) then
541!        write(*,*) "dynredem0: Failed writing <bp> ",
542!     &             "in file "//fichnom
543!        call abort
544!      endif
545c
546c ----------------------
547c
548c
549      ierr = NF_REDEF (nid)
550      if (ierr.ne.NF_NOERR) then
551        write(*,*) "dynredem0: Failed to switch back to define mode"
552        call abort
553      endif
554
555#ifdef NC_DOUBLE
556      ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
557#else
558      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
559#endif
560      if (ierr.ne.NF_NOERR) then
561        write(*,*) "dynredem0: Failed defining <aps> ",
562     &             "in file "//fichnom
563        call abort
564      endif
565
566      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 37,
567     .      "Coef AS: hybrid pressure at midlayers")
568      if (ierr.ne.NF_NOERR) then
569        write(*,*) "dynredem0: Failed writing title attribute ",
570     &             "for <aps> in file "//fichnom
571        call abort
572      endif
573
574      ierr = NF_ENDDEF(nid)
575      if (ierr.ne.NF_NOERR) then
576        write(*,*) "dynredem0: Failed to switch out of define mode"
577        call abort
578      endif
579
580#ifdef NC_DOUBLE
581      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
582#else
583      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
584#endif
585      if (ierr.ne.NF_NOERR) then
586        write(*,*) "dynredem0: Failed writing <aps> ",
587     &             "in file "//fichnom
588        call abort
589      endif
590
591c
592c ----------------------
593c
594      ierr = NF_REDEF (nid)
595      if (ierr.ne.NF_NOERR) then
596        write(*,*) "dynredem0: Failed to switch back to define mode"
597        call abort
598      endif
599
600#ifdef NC_DOUBLE
601      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
602#else
603      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
604#endif
605      if (ierr.ne.NF_NOERR) then
606        write(*,*) "dynredem0: Failed defining <bps> ",
607     &             "in file "//fichnom
608        call abort
609      endif
610
611      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 34,
612     .      "Coef BS: hybrid sigma at midlayers")
613      if (ierr.ne.NF_NOERR) then
614        write(*,*) "dynredem0: Failed writing title attribute ",
615     &             "for <bps> in file "//fichnom
616        call abort
617      endif
618
619      ierr = NF_ENDDEF(nid)
620      if (ierr.ne.NF_NOERR) then
621        write(*,*) "dynredem0: Failed to switch out of define mode"
622        call abort
623      endif
624
625#ifdef NC_DOUBLE
626      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
627#else
628      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
629#endif
630      if (ierr.ne.NF_NOERR) then
631        write(*,*) "dynredem0: Failed writing <bps> ",
632     &             "in file "//fichnom
633        call abort
634      endif
635
636c
637c ----------------------
638c
639      ierr = NF_REDEF (nid)
640      if (ierr.ne.NF_NOERR) then
641        write(*,*) "dynredem0: Failed to switch back to define mode"
642        call abort
643      endif
644
645#ifdef NC_DOUBLE
646      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
647#else
648      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
649#endif
650      if (ierr.ne.NF_NOERR) then
651        write(*,*) "dynredem0: Failed defining <presniv> ",
652     &             "in file "//fichnom
653        call abort
654      endif
655
656      ierr = NF_ENDDEF(nid)
657      if (ierr.ne.NF_NOERR) then
658        write(*,*) "dynredem0: Failed to switch out of define mode"
659        call abort
660      endif
661
662#ifdef NC_DOUBLE
663      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
664#else
665      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
666#endif
667      if (ierr.ne.NF_NOERR) then
668        write(*,*) "dynredem0: Failed writing <presniv> ",
669     &             "in file "//fichnom
670        call abort
671      endif
672
673c ------------------------------------------------------------------
674c ------------------------------------------------------------------
675c  Variable uniquement pour visualisation avec Grads ou Ferret
676c ------------------------------------------------------------------
677      ierr = NF_REDEF (nid)
678#ifdef NC_DOUBLE
679      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
680#else
681      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
682#endif
683      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
684      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
685     .      "North latitude")
686      ierr = NF_ENDDEF(nid)
687#ifdef NC_DOUBLE
688      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
689#else
690      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
691#endif
692c ----------------------
693      ierr = NF_REDEF (nid)
694#ifdef NC_DOUBLE
695      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
696#else
697      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
698#endif
699      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
700     .      "East longitude")
701      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
702      ierr = NF_ENDDEF(nid)
703#ifdef NC_DOUBLE
704      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
705#else
706      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
707#endif
708c --------------------------
709      ierr = NF_REDEF (nid)
710#ifdef NC_DOUBLE
711      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
712     .       idim_llm,nvarid)
713#else
714      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
715     .       idim_llm,nvarid)
716#endif
717      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
718      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
719      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
720 
721      ierr = NF_ENDDEF(nid)
722#ifdef NC_DOUBLE
723      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
724#else
725      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
726#endif
727 
728 
729c ----------------------
730c ----------------------
731c
732c Coefficients de passage cov. <-> contra. <--> naturel
733c
734      ierr = NF_REDEF (nid)
735      dims2(1) = idim_rlonu
736      dims2(2) = idim_rlatu
737#ifdef NC_DOUBLE
738      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
739#else
740      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
741#endif
742      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
743     .                       "Coefficient de passage pour U")
744      ierr = NF_ENDDEF(nid)
745#ifdef NC_DOUBLE
746      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
747#else
748      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
749#endif
750c
751c ----------------------
752      ierr = NF_REDEF (nid)
753      dims2(1) = idim_rlonv
754      dims2(2) = idim_rlatv
755#ifdef NC_DOUBLE
756      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
757#else
758      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
759#endif
760      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
761     .                       "Coefficient de passage pour V")
762      ierr = NF_ENDDEF(nid)
763#ifdef NC_DOUBLE
764      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
765#else
766      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
767#endif
768c
769c ----------------------
770c Aire de chaque maille:
771c
772      ierr = NF_REDEF (nid)
773      dims2(1) = idim_rlonv
774      dims2(2) = idim_rlatu
775#ifdef NC_DOUBLE
776      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
777#else
778      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
779#endif
780      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
781     .                       "Aires de chaque maille")
782      ierr = NF_ENDDEF(nid)
783#ifdef NC_DOUBLE
784      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
785#else
786      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
787#endif
788c
789c ----------------------
790c Geopentiel au sol:
791c
792      ierr = NF_REDEF (nid)
793      dims2(1) = idim_rlonv
794      dims2(2) = idim_rlatu
795#ifdef NC_DOUBLE
796      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
797#else
798      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
799#endif
800      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
801     .                       "Geopotentiel au sol")
802      ierr = NF_ENDDEF(nid)
803#ifdef NC_DOUBLE
804      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
805#else
806      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
807#endif
808c
809c ----------------------
810c Definir les variables pour pouvoir les enregistrer plus tard:
811c
812      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
813      if (ierr.ne.NF_NOERR) then
814        write(*,*) "dynredem0: Failed to switch back to define mode"
815        call abort
816      endif
817
818#ifdef NC_DOUBLE
819      ierr = NF_DEF_VAR (nid,"Time",NF_DOUBLE,1,idim_tim,nvarid)
820#else
821      ierr = NF_DEF_VAR (nid,"Time",NF_FLOAT,1,idim_tim,nvarid)
822#endif
823      if (ierr.ne.NF_NOERR) then
824        write(*,*) "dynredem0: Failed defining <Time> ",
825     &             "in file "//fichnom
826        call abort
827      endif
828
829      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
830     &                       "Temps de simulation")
831      if (ierr.ne.NF_NOERR) then
832        write(*,*) "dynredem0: Failed writing title attribute",
833     &             "for <Time> in file "//fichnom
834        call abort
835      endif
836
837
838      write(unites,200)yyears0,mmois0,jjour0
839200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
840      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
841     .                         unites)
842      if (ierr.ne.NF_NOERR) then
843        write(*,*) "dynredem0: Failed writing units attribute",
844     &             "for <Time> in file "//fichnom
845        call abort
846      endif
847
848
849c
850      dims4(1) = idim_rlonu
851      dims4(2) = idim_rlatu
852      dims4(3) = idim_llm
853      dims4(4) = idim_tim
854#ifdef NC_DOUBLE
855      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
856#else
857      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
858#endif
859      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
860     .                       "Vitesse U")
861c
862      dims4(1) = idim_rlonv
863      dims4(2) = idim_rlatv
864      dims4(3) = idim_llm
865      dims4(4) = idim_tim
866#ifdef NC_DOUBLE
867      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
868#else
869      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
870#endif
871      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
872     .                       "Vitesse V")
873c
874      dims4(1) = idim_rlonv
875      dims4(2) = idim_rlatu
876      dims4(3) = idim_llm
877      dims4(4) = idim_tim
878#ifdef NC_DOUBLE
879      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
880#else
881      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
882#endif
883      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
884     .                       "Temperature")
885c
886      dims4(1) = idim_rlonv
887      dims4(2) = idim_rlatu
888      dims4(3) = idim_llm
889      dims4(4) = idim_tim
890      IF(nq.GE.1) THEN
891         DO iq=1,nq
892            IF (iq.GT.99) THEN
893               PRINT*, "Trop de traceurs"
894               CALL abort
895            ELSE
896!               str3(1:1)='q'
897!               WRITE(str3(2:3),'(i2.2)') iq
898!#ifdef NC_DOUBLE
899!               ierr = NF_DEF_VAR (nid,str3,NF_DOUBLE,4,dims4,nvarid)
900!#else
901!               ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid)
902!#endif
903!               ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
904!     .                          "Traceurs "//str3)
905             txt="Traceur "//trim(tnom(iq))
906#ifdef NC_DOUBLE
907               ierr=NF_DEF_VAR(nid,tnom(iq),NF_DOUBLE,4,dims4,nvarid)
908#else
909               ierr=NF_DEF_VAR(nid,tnom(iq),NF_FLOAT,4,dims4,nvarid)
910#endif
911               ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",
912     .                  len_trim(txt),trim(txt))
913            ENDIF
914         ENDDO
915      ENDIF
916c
917      dims4(1) = idim_rlonv
918      dims4(2) = idim_rlatu
919      dims4(3) = idim_llm
920      dims4(4) = idim_tim
921#ifdef NC_DOUBLE
922      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
923#else
924      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
925#endif
926      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
927     .                       "C est quoi ?")
928c
929      dims3(1) = idim_rlonv
930      dims3(2) = idim_rlatu
931      dims3(3) = idim_tim
932#ifdef NC_DOUBLE
933      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
934#else
935      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
936#endif
937      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
938     .                       "Pression au sol")
939c
940      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
941      ierr = NF_CLOSE(nid) ! fermer le fichier
942
943      write(*,*)'dynredem0: iim,jjm,llm,idayref',iim,jjm,llm,idayref
944      write(*,*)'dynredem0: rad,omeg,g,cpp,kappa',
945     &        rad,omeg,g,cpp,kappa
946     
947!      stop "dynredem0 halt"
948     
949      RETURN
950      END
951
952c ================================================================
953c ================================================================
954
955      SUBROUTINE dynredem1(fichnom,time,
956     .                     vcov,ucov,teta,q,nq,masse,ps)
957      IMPLICIT NONE
958c=================================================================
959c  Ecriture du fichier de redemarrage sous format NetCDF
960c=================================================================
961#include "dimensions.h"
962#include "paramet.h"
963#include "description.h"
964#include "netcdf.inc"
965#include "comvert.h"
966#include "comgeom.h"
967#include"advtrac.h"
968
969      INTEGER nq, l
970      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
971      REAL teta(ip1jmp1,llm)                   
972      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
973      REAL q(iip1,jjp1,llm,nqmx)
974      REAL q3d(iip1,jjp1,llm) !temporary variable
975      CHARACTER*(*) fichnom
976     
977      REAL time
978      INTEGER nid, nvarid
979      INTEGER ierr
980      INTEGER iq
981      CHARACTER str3*3
982      character*20 modname
983      character*80 abort_message
984c
985      INTEGER nb,i,j
986      SAVE nb
987      DATA nb / 0 /
988
989      modname = 'dynredem1'
990      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
991      IF (ierr .NE. NF_NOERR) THEN
992         PRINT*, "Pb. d ouverture "//fichnom
993         CALL abort
994      ENDIF
995
996c  Ecriture/extension de la coordonnee temps
997
998      nb = nb + 1
999      ierr = NF_INQ_VARID(nid, "Time", nvarid)
1000      IF (ierr .NE. NF_NOERR) THEN
1001         print *, NF_STRERROR(ierr)
1002         abort_message='Variable Time n est pas definie'
1003         CALL abort_gcm(modname,abort_message,ierr)
1004      ENDIF
1005#ifdef NC_DOUBLE
1006      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
1007#else
1008      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
1009#endif
1010      PRINT*, "Enregistrement pour ", nb, time
1011
1012c  Ecriture des champs
1013c
1014      ierr = NF_INQ_VARID(nid, "ucov", nvarid)
1015      IF (ierr .NE. NF_NOERR) THEN
1016         PRINT*, "Variable ucov n est pas definie"
1017         CALL abort
1018      ENDIF
1019#ifdef NC_DOUBLE
1020      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
1021#else
1022      ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
1023#endif
1024
1025      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
1026      IF (ierr .NE. NF_NOERR) THEN
1027         PRINT*, "Variable vcov n est pas definie"
1028         CALL abort
1029      ENDIF
1030#ifdef NC_DOUBLE
1031      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
1032#else
1033      ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
1034#endif
1035
1036      ierr = NF_INQ_VARID(nid, "teta", nvarid)
1037      IF (ierr .NE. NF_NOERR) THEN
1038         PRINT*, "Variable teta n est pas definie"
1039         CALL abort
1040      ENDIF
1041#ifdef NC_DOUBLE
1042      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
1043#else
1044      ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
1045#endif
1046
1047      IF (nq.GT.99) THEN
1048         PRINT*, "Trop de traceurs"
1049         CALL abort
1050      ENDIF
1051      IF(nq.GE.1) THEN
1052         DO iq=1,nq
1053!            str3(1:1)='q'
1054!            WRITE(str3(2:3),'(i2.2)') iq
1055!            ierr = NF_INQ_VARID(nid, str3, nvarid)
1056            ierr=NF_INQ_VARID(nid,tnom(iq),nvarid)
1057            IF (ierr .NE. NF_NOERR) THEN
1058!               PRINT*, "Variable "//str3//" n est pas definie"
1059              PRINT*, "Variable "//trim(tnom(iq))//" n est pas definie"
1060              CALL abort
1061            ENDIF
1062            do l=1,llm
1063               do j=1,jjp1
1064                  do i=1,iip1
1065                     q3d(i,j,l)=q(i,j,l,iq)
1066                  enddo
1067               enddo
1068            enddo
1069#ifdef NC_DOUBLE
1070            ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q3d)
1071#else
1072            ierr = NF_PUT_VAR_REAL (nid,nvarid,q3d)
1073#endif
1074            IF (ierr .NE. NF_NOERR) THEN
1075               PRINT*, "Error: ", NF_STRERROR(ierr)
1076               CALL abort
1077            ENDIF
1078         ENDDO
1079      ENDIF
1080c
1081      ierr = NF_INQ_VARID(nid, "masse", nvarid)
1082      IF (ierr .NE. NF_NOERR) THEN
1083         PRINT*, "Variable masse n est pas definie"
1084         CALL abort
1085      ENDIF
1086#ifdef NC_DOUBLE
1087      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
1088#else
1089      ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
1090#endif
1091c
1092      ierr = NF_INQ_VARID(nid, "ps", nvarid)
1093      IF (ierr .NE. NF_NOERR) THEN
1094         PRINT*, "Variable ps n est pas definie"
1095         CALL abort
1096      ENDIF
1097#ifdef NC_DOUBLE
1098      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
1099#else
1100      ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
1101#endif
1102
1103      ierr = NF_CLOSE(nid)
1104c
1105      RETURN
1106      END
1107
Note: See TracBrowser for help on using the repository browser.