source: trunk/LMDZ.GENERIC/libf/dyn3d/dynredem.F @ 588

Last change on this file since 588 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET

File size: 31.6 KB
RevLine 
[135]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)=float(l)
61      enddo
62
63      DO l=1,length
64       tab_cntrl(l) = 0.
65      ENDDO
66       tab_cntrl(1)  = FLOAT(iim)
67       tab_cntrl(2)  = FLOAT(jjm)
68       tab_cntrl(3)  = FLOAT(llm)
69       tab_cntrl(4)  = FLOAT(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
113      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
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.