source: LMDZ4/branches/LMDZ4_V2_patch/libf/dyn3dpar/dynredem_p.F @ 1385

Last change on this file since 1385 was 630, checked in by Laurent Fairhead, 20 years ago

Import d'une version parallele de la dynamique YM
LF

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