source: LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/dyn3d/dynredem.F @ 5373

Last change on this file since 5373 was 524, checked in by lmdzadmin, 21 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.8 KB
Line 
1!
2! $Header$
3!
4c
5      SUBROUTINE dynredem0(fichnom,iday_end,phis,nq)
6      USE IOIPSL
7      IMPLICIT NONE
8c=======================================================================
9c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
10c=======================================================================
11c   Declarations:
12c   -------------
13#include "dimensions.h"
14#include "paramet.h"
15#include "comconst.h"
16#include "comvert.h"
17#include "comgeom.h"
18#include "temps.h"
19#include "ener.h"
20#include "logic.h"
21#include "netcdf.inc"
22#include "description.h"
23#include "serre.h"
24#include "advtrac.h"
25
26c   Arguments:
27c   ----------
28      INTEGER iday_end
29      REAL phis(ip1jmp1)
30      CHARACTER*(*) fichnom
31      INTEGER nq
32
33c   Local:
34c   ------
35      INTEGER iq,l
36      INTEGER length
37      PARAMETER (length = 100)
38      REAL tab_cntrl(length) ! tableau des parametres du run
39      INTEGER ierr
40      character*20 modname
41      character*80 abort_message
42
43c   Variables locales pour NetCDF:
44c
45      INTEGER dims2(2), dims3(3), dims4(4)
46      INTEGER idim_index
47      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
48      INTEGER idim_s, idim_sig
49      INTEGER idim_tim
50      INTEGER nid,nvarid
51
52      REAL zan0,zjulian,hours
53      INTEGER yyears0,jjour0, mmois0
54      character*30 unites
55
56
57c-----------------------------------------------------------------------
58      modname='dynredem'
59
60      call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
61      call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
62       
63
64      DO l=1,length
65       tab_cntrl(l) = 0.
66      ENDDO
67       tab_cntrl(1)  = FLOAT(iim)
68       tab_cntrl(2)  = FLOAT(jjm)
69       tab_cntrl(3)  = FLOAT(llm)
70       tab_cntrl(4)  = FLOAT(day_ref)
71       tab_cntrl(5)  = FLOAT(annee_ref)
72       tab_cntrl(6)  = rad
73       tab_cntrl(7)  = omeg
74       tab_cntrl(8)  = g
75       tab_cntrl(9)  = cpp
76       tab_cntrl(10) = kappa
77       tab_cntrl(11) = daysec
78       tab_cntrl(12) = dtvr
79       tab_cntrl(13) = etot0
80       tab_cntrl(14) = ptot0
81       tab_cntrl(15) = ztot0
82       tab_cntrl(16) = stot0
83       tab_cntrl(17) = ang0
84       tab_cntrl(18) = pa
85       tab_cntrl(19) = preff
86c
87c    .....    parametres  pour le zoom      ......   
88
89       tab_cntrl(20)  = clon
90       tab_cntrl(21)  = clat
91       tab_cntrl(22)  = grossismx
92       tab_cntrl(23)  = grossismy
93c
94      IF ( fxyhypb )   THEN
95       tab_cntrl(24) = 1.
96       tab_cntrl(25) = dzoomx
97       tab_cntrl(26) = dzoomy
98       tab_cntrl(27) = 0.
99       tab_cntrl(28) = taux
100       tab_cntrl(29) = tauy
101      ELSE
102       tab_cntrl(24) = 0.
103       tab_cntrl(25) = dzoomx
104       tab_cntrl(26) = dzoomy
105       tab_cntrl(27) = 0.
106       tab_cntrl(28) = 0.
107       tab_cntrl(29) = 0.
108       IF( ysinus )  tab_cntrl(27) = 1.
109      ENDIF
110
111       tab_cntrl(30) = FLOAT(iday_end)
112       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
113c
114c    .........................................................
115c
116c Creation du fichier:
117c
118      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
119      IF (ierr.NE.NF_NOERR) THEN
120         WRITE(6,*)" Pb d ouverture du fichier "//fichnom
121         WRITE(6,*)' ierr = ', ierr
122         CALL ABORT
123      ENDIF
124c
125c Preciser quelques attributs globaux:
126c
127      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
128     .                       "Fichier demmarage dynamique")
129c
130c Definir les dimensions du fichiers:
131c
132      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
133      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
134      ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
135      ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
136      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
137      ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
138      ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
139      ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
140c
141      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
142c
143c Definir et enregistrer certains champs invariants:
144c
145      ierr = NF_REDEF (nid)
146      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
147      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
148     .                       "Parametres de controle")
149      ierr = NF_ENDDEF(nid)
150#ifdef NC_DOUBLE
151      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
152#else
153      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
154#endif
155c
156      ierr = NF_REDEF (nid)
157      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
158      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
159     .                       "Longitudes des points U")
160      ierr = NF_ENDDEF(nid)
161#ifdef NC_DOUBLE
162      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
163#else
164      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
165#endif
166c
167      ierr = NF_REDEF (nid)
168      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
169      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
170     .                       "Latitudes des points U")
171      ierr = NF_ENDDEF(nid)
172#ifdef NC_DOUBLE
173      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
174#else
175      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
176#endif
177c
178      ierr = NF_REDEF (nid)
179      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
180      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
181     .                       "Longitudes des points V")
182      ierr = NF_ENDDEF(nid)
183#ifdef NC_DOUBLE
184      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
185#else
186      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
187#endif
188c
189      ierr = NF_REDEF (nid)
190      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
191      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
192     .                       "Latitudes des points V")
193      ierr = NF_ENDDEF(nid)
194#ifdef NC_DOUBLE
195      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
196#else
197      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
198#endif
199c
200      ierr = NF_REDEF (nid)
201      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
202      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
203     .                       "Numero naturel des couches s")
204      ierr = NF_ENDDEF(nid)
205#ifdef NC_DOUBLE
206      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
207#else
208      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
209#endif
210c
211      ierr = NF_REDEF (nid)
212      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
213      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
214     .                       "Numero naturel des couches sigma")
215      ierr = NF_ENDDEF(nid)
216#ifdef NC_DOUBLE
217      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
218#else
219      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
220#endif
221c
222      ierr = NF_REDEF (nid)
223      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
224      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
225     .                       "Coefficient A pour hybride")
226      ierr = NF_ENDDEF(nid)
227#ifdef NC_DOUBLE
228      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
229#else
230      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
231#endif
232c
233      ierr = NF_REDEF (nid)
234      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
235      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
236     .                       "Coefficient B pour hybride")
237      ierr = NF_ENDDEF(nid)
238#ifdef NC_DOUBLE
239      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
240#else
241      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
242#endif
243c
244      ierr = NF_REDEF (nid)
245      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
246      ierr = NF_ENDDEF(nid)
247#ifdef NC_DOUBLE
248      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
249#else
250      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
251#endif
252c
253c Coefficients de passage cov. <-> contra. <--> naturel
254c
255      ierr = NF_REDEF (nid)
256      dims2(1) = idim_rlonu
257      dims2(2) = idim_rlatu
258      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
259      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
260     .                       "Coefficient de passage pour U")
261      ierr = NF_ENDDEF(nid)
262#ifdef NC_DOUBLE
263      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
264#else
265      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
266#endif
267c
268      ierr = NF_REDEF (nid)
269      dims2(1) = idim_rlonv
270      dims2(2) = idim_rlatv
271      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
272      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
273     .                       "Coefficient de passage pour V")
274      ierr = NF_ENDDEF(nid)
275#ifdef NC_DOUBLE
276      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
277#else
278      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
279#endif
280c
281c Aire de chaque maille:
282c
283      ierr = NF_REDEF (nid)
284      dims2(1) = idim_rlonv
285      dims2(2) = idim_rlatu
286      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
287      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
288     .                       "Aires de chaque maille")
289      ierr = NF_ENDDEF(nid)
290#ifdef NC_DOUBLE
291      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
292#else
293      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
294#endif
295c
296c Geopentiel au sol:
297c
298      ierr = NF_REDEF (nid)
299      dims2(1) = idim_rlonv
300      dims2(2) = idim_rlatu
301      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
302      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
303     .                       "Geopotentiel au sol")
304      ierr = NF_ENDDEF(nid)
305#ifdef NC_DOUBLE
306      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
307#else
308      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
309#endif
310c
311c Definir les variables pour pouvoir les enregistrer plus tard:
312c
313      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
314c
315      ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
316      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
317     .                       "Temps de simulation")
318      write(unites,200)yyears0,mmois0,jjour0
319200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
320      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
321     .                         unites)
322
323c
324      dims4(1) = idim_rlonu
325      dims4(2) = idim_rlatu
326      dims4(3) = idim_s
327      dims4(4) = idim_tim
328      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
329      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
330     .                       "Vitesse U")
331c
332      dims4(1) = idim_rlonv
333      dims4(2) = idim_rlatv
334      dims4(3) = idim_s
335      dims4(4) = idim_tim
336      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
337      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
338     .                       "Vitesse V")
339c
340      dims4(1) = idim_rlonv
341      dims4(2) = idim_rlatu
342      dims4(3) = idim_s
343      dims4(4) = idim_tim
344      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
345      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
346     .                       "Temperature")
347c
348      dims4(1) = idim_rlonv
349      dims4(2) = idim_rlatu
350      dims4(3) = idim_s
351      dims4(4) = idim_tim
352      IF(nq.GE.1) THEN
353      DO iq=1,nq
354      ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
355      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
356      ENDDO
357      ENDIF
358c
359      dims4(1) = idim_rlonv
360      dims4(2) = idim_rlatu
361      dims4(3) = idim_s
362      dims4(4) = idim_tim
363      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
364      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
365     .                       "C est quoi ?")
366c
367      dims3(1) = idim_rlonv
368      dims3(2) = idim_rlatu
369      dims3(3) = idim_tim
370      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
371      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
372     .                       "Pression au sol")
373c
374      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
375      ierr = NF_CLOSE(nid) ! fermer le fichier
376
377      PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
378      PRINT*,'rad,omeg,g,cpp,kappa',
379     ,        rad,omeg,g,cpp,kappa
380
381      RETURN
382      END
383      SUBROUTINE dynredem1(fichnom,time,
384     .                     vcov,ucov,teta,q,nq,masse,ps)
385      IMPLICIT NONE
386c=================================================================
387c  Ecriture du fichier de redemarrage sous format NetCDF
388c=================================================================
389#include "dimensions.h"
390#include "paramet.h"
391#include "description.h"
392#include "netcdf.inc"
393#include "comvert.h"
394#include "comgeom.h"
395#include "advtrac.h"
396
397      INTEGER nq, l
398      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
399      REAL teta(ip1jmp1,llm)                   
400      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
401      REAL q(ip1jmp1,llm,nq)
402      CHARACTER*(*) fichnom
403     
404      REAL time
405      INTEGER nid, nvarid
406      INTEGER ierr
407      INTEGER iq
408      character*20 modname
409      character*80 abort_message
410c
411      INTEGER nb
412      SAVE nb
413      DATA nb / 0 /
414
415      modname = 'dynredem1'
416      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
417      IF (ierr .NE. NF_NOERR) THEN
418         PRINT*, "Pb. d ouverture "//fichnom
419         CALL abort
420      ENDIF
421
422c  Ecriture/extension de la coordonnee temps
423
424      nb = nb + 1
425      ierr = NF_INQ_VARID(nid, "temps", nvarid)
426      IF (ierr .NE. NF_NOERR) THEN
427         print *, NF_STRERROR(ierr)
428         abort_message='Variable temps n est pas definie'
429         CALL abort_gcm(modname,abort_message,ierr)
430      ENDIF
431#ifdef NC_DOUBLE
432      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
433#else
434      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
435#endif
436      PRINT*, "Enregistrement pour ", nb, time
437
438c  Ecriture des champs
439c
440      ierr = NF_INQ_VARID(nid, "ucov", nvarid)
441      IF (ierr .NE. NF_NOERR) THEN
442         PRINT*, "Variable ucov n est pas definie"
443         CALL abort
444      ENDIF
445#ifdef NC_DOUBLE
446      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
447#else
448      ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
449#endif
450
451      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
452      IF (ierr .NE. NF_NOERR) THEN
453         PRINT*, "Variable vcov n est pas definie"
454         CALL abort
455      ENDIF
456#ifdef NC_DOUBLE
457      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
458#else
459      ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
460#endif
461
462      ierr = NF_INQ_VARID(nid, "teta", nvarid)
463      IF (ierr .NE. NF_NOERR) THEN
464         PRINT*, "Variable teta n est pas definie"
465         CALL abort
466      ENDIF
467#ifdef NC_DOUBLE
468      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
469#else
470      ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
471#endif
472
473      IF(nq.GE.1) THEN
474       do iq=1,nq   
475        ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
476        IF (ierr .NE. NF_NOERR) THEN
477           PRINT*, "Variable  tname(iq) n est pas definie"
478           CALL abort
479        ENDIF
480#ifdef NC_DOUBLE
481          ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
482#else
483          ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
484#endif
485      ENDDO
486      ENDIF
487c
488      ierr = NF_INQ_VARID(nid, "masse", nvarid)
489      IF (ierr .NE. NF_NOERR) THEN
490         PRINT*, "Variable masse n est pas definie"
491         CALL abort
492      ENDIF
493#ifdef NC_DOUBLE
494      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
495#else
496      ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
497#endif
498c
499      ierr = NF_INQ_VARID(nid, "ps", nvarid)
500      IF (ierr .NE. NF_NOERR) THEN
501         PRINT*, "Variable ps n est pas definie"
502         CALL abort
503      ENDIF
504#ifdef NC_DOUBLE
505      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
506#else
507      ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
508#endif
509
510      ierr = NF_CLOSE(nid)
511c
512      RETURN
513      END
514
Note: See TracBrowser for help on using the repository browser.