source: trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem.F90 @ 1508

Last change on this file since 1508 was 1508, checked in by emillour, 9 years ago

Common dynamics:
Updates in the dynamics (seq and ) to keep up with updates
in LMDZ5 (up to LMDZ5 trunk, rev 2325):
IMPORTANT: Modifications for isotopes are only done in dyn3d, not in dyn3dpar

as in LMDZ5 these modifications were done in dyn3dmem.
Related LMDZ5 revisions are r2270 and r2281

  • in dynlonlat_phylonlat:
  • add module "grid_atob_m.F90" (a regridding utility so far only used by phylmd/ce0l.F90, used to be dyn3d_common/grid_atob.F)
  • in misc:
  • follow up updates on wxios.F (add missing_val module variable)
  • in dyn3d_common:
  • pression.F => pression.F90
  • misc_mod.F90: moved from misc to dyn3d_common
  • added new iso_verif_dyn.F
  • covcont.F => covcont.F90
  • infotrac.F90 : add handling of isotopes (reading of corresponding traceur.def for planets not implemented)
  • dynetat0.F => dynetat0.F90 with some code factorization
  • dynredem.F => dynredem.F90 with some code factorization
  • added dynredem_mod.F90: routines used by dynredem
  • iniacademic.F90 : added isotopes-related initialization for Earth case
  • in dyn3d:
  • added check_isotopes.F
  • modified (isotopes) advtrac.F90, caladvtrac.F
  • guide_mod.F90: ported updates
  • leapfrog.F : (isotopes) updates (NB: call integrd with nqtot tracers)
  • qminimium.F : adaptations for isotopes (copied over, except that #include comvert.h is not needed).
  • vlsplt.F: adaptations for isotopes (copied over, except than #include logic.h, comvert.h not needed, and replace "include comconst.h" with use comconst_mod, ONLY: pi)
  • vlspltqs.F : same as vlsplt.F, but also keeping added modification for CP(T)
  • in dyn3dpar:
  • leapfrog_p.F: remove unecessary #ifdef CPP_EARTH cpp flag. and call integrd_p with nqtot tracers (only important for Earth)
  • dynredem_p.F => dynredem_p.F90 and some code factorization
  • and no isotopes-relates changes in dyn3dpar (since these changes have been made in LMDZ5 dyn3dmem).

EM
File size: 14.3 KB
Line 
1!
2! $Id: dynredem.F 1635 2012-07-12 11:37:16Z lguez $
3!
4!
5SUBROUTINE dynredem0(fichnom,iday_end,phis)
6#ifdef CPP_IOIPSL
7  USE IOIPSL
8#endif
9  USE infotrac, ONLY: nqtot, tname, ttext
10  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
11                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER
12  USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, err, modname, fil
13  use netcdf95, only: NF95_PUT_VAR
14  use control_mod, only : planet_type
15  USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff, &
16                        nivsig,nivsigs
17  USE comconst_mod, ONLY: daysec,dtvr,rad,omeg,g,cpp,kappa,pi
18  USE logic_mod, ONLY: fxyhypb,ysinus
19  USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
20                        taux,tauy
21  USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn,itaufin, &
22                        start_time,hour_ini
23  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
24
25  IMPLICIT NONE
26!=======================================================================
27! Writting the NetCDF restart file (initialisation)
28!=======================================================================
29!   Declarations:
30!   -------------
31  include "dimensions.h"
32  include "paramet.h"
33  include "comgeom2.h"
34  include "netcdf.inc"
35  include "iniprint.h"
36
37!===============================================================================
38! Arguments:
39  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
40  INTEGER,          INTENT(IN) :: iday_end         !---
41  REAL,             INTENT(IN) :: phis(iip1, jjp1) !--- GROUND GEOPOTENTIAL
42!===============================================================================
43! Local variables:
44  INTEGER :: iq,l
45  INTEGER, PARAMETER :: length=100
46  REAL :: tab_cntrl(length) ! run parameters
47  INTEGER :: ierr
48  CHARACTER(LEN=80) :: abort_message
49
50!   For NetCDF:
51  CHARACTER(LEN=30) :: unites
52  INTEGER :: indexID
53  INTEGER :: rlonuID, rlonvID, rlatuID, rlatvID
54  INTEGER :: sID, sigID, nID, vID, timID
55  INTEGER :: yyears0, jjour0, mmois0
56  REAL    :: zan0, zjulian, hours
57
58  CHARACTER(len=12) :: start_file_type="earth" ! default start file type
59  INTEGER :: idecal
60
61!===============================================================================
62  ! fill dynredem_mod module variables
63  modname='dynredem0'; fil=fichnom
64
65#ifdef CPP_IOIPSL
66  call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
67  call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
68#else
69! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
70  yyears0=0
71  mmois0=1
72  jjour0=1
73#endif       
74
75  !!! AS: idecal is a hack to be able to read planeto starts...
76  !!!     .... while keeping everything OK for LMDZ EARTH
77  if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
78    write(lunout,*) trim(modname),' : Planeto-like start file'
79    start_file_type="planeto"
80    idecal = 4
81  else
82    write(lunout,*) trim(modname),' : Earth-like start file'
83    idecal = 5
84  endif
85
86  tab_cntrl(:)  = 0.
87  tab_cntrl(1)  = REAL(iim)
88  tab_cntrl(2)  = REAL(jjm)
89  tab_cntrl(3)  = REAL(llm)
90  if (start_file_type.eq."earth") then
91    tab_cntrl(4)=REAL(day_ref)
92  else
93    !tab_cntrl(4)=REAL(day_end)
94    tab_cntrl(4)=REAL(iday_end)
95  endif
96  tab_cntrl(5)  = REAL(annee_ref)
97  tab_cntrl(idecal+1)  = rad
98  tab_cntrl(idecal+2)  = omeg
99  tab_cntrl(idecal+3)  = g
100  tab_cntrl(idecal+4)  = cpp
101  tab_cntrl(idecal+5) = kappa
102  tab_cntrl(idecal+6) = daysec
103  tab_cntrl(idecal+7) = dtvr
104  tab_cntrl(idecal+8) = etot0
105  tab_cntrl(idecal+9) = ptot0
106  tab_cntrl(idecal+10) = ztot0
107  tab_cntrl(idecal+11) = stot0
108  tab_cntrl(idecal+12) = ang0
109  tab_cntrl(idecal+13) = pa
110  tab_cntrl(idecal+14) = preff
111
112!    .....    parameters for the zoom      ......   
113  tab_cntrl(idecal+15)  = clon
114  tab_cntrl(idecal+16)  = clat
115  tab_cntrl(idecal+17)  = grossismx
116  tab_cntrl(idecal+18)  = grossismy
117!
118  IF ( fxyhypb )   THEN
119    tab_cntrl(idecal+19) = 1.
120    tab_cntrl(idecal+20) = dzoomx
121    tab_cntrl(idecal+21) = dzoomy
122    tab_cntrl(idecal+22) = 0.
123    tab_cntrl(idecal+23) = taux
124    tab_cntrl(idecal+24) = tauy
125  ELSE
126    tab_cntrl(idecal+19) = 0.
127    tab_cntrl(idecal+20) = dzoomx
128    tab_cntrl(idecal+21) = dzoomy
129    tab_cntrl(idecal+22) = 0.
130    tab_cntrl(idecal+23) = 0.
131    tab_cntrl(idecal+24) = 0.
132    IF( ysinus )  tab_cntrl(idecal+22) = 1.
133  ENDIF
134
135  if (start_file_type.eq."earth") then
136    tab_cntrl(idecal+25) = REAL(iday_end)
137    tab_cntrl(idecal+26) = REAL(itau_dyn + itaufin)
138! start_time: start_time of simulation (not necessarily 0.)
139    tab_cntrl(idecal+27) = start_time
140  endif
141
142  if (planet_type=="mars") then ! For Mars only
143    tab_cntrl(29)=hour_ini
144  endif
145
146!--- File creation
147  CALL err(NF90_CREATE(fichnom,NF90_CLOBBER,nid))
148
149!--- Some global attributes
150  CALL err(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique"))
151
152!--- Dimensions
153  if (start_file_type.eq."earth") then
154    CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
155    CALL err(NF90_DEF_DIM(nid,"rlonu", iip1,   rlonuID))
156    CALL err(NF90_DEF_DIM(nid,"rlatu", jjp1,   rlatuID))
157    CALL err(NF90_DEF_DIM(nid,"rlonv", iip1,   rlonvID))
158    CALL err(NF90_DEF_DIM(nid,"rlatv", jjm,    rlatvID))
159    CALL err(NF90_DEF_DIM(nid,"sigs",  llm,        sID))
160    CALL err(NF90_DEF_DIM(nid,"sig",   llmp1,    sigID))
161    CALL err(NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID))
162  else
163    CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
164    CALL err(NF90_DEF_DIM(nid,"rlonu", iip1,   rlonuID))
165    CALL err(NF90_DEF_DIM(nid,"latitude", jjp1,   rlatuID))
166    CALL err(NF90_DEF_DIM(nid,"longitude", iip1,   rlonvID))
167    CALL err(NF90_DEF_DIM(nid,"rlatv", jjm,    rlatvID))
168    CALL err(NF90_DEF_DIM(nid,"altitude",  llm,        sID))
169    CALL err(NF90_DEF_DIM(nid,"interlayer",   llmp1,    sigID))
170    CALL err(NF90_DEF_DIM(nid,"Time", NF90_UNLIMITED, timID))
171  endif
172
173!--- Define and save invariant fields
174  CALL put_var1(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl)
175  CALL put_var1(nid,"rlonu"   ,"Longitudes des points U",[rlonuID],rlonu)
176  CALL put_var1(nid,"rlatu"   ,"Latitudes des points U" ,[rlatuID],rlatu)
177  CALL put_var1(nid,"rlonv"   ,"Longitudes des points V",[rlonvID],rlonv)
178  CALL put_var1(nid,"rlatv"   ,"Latitudes des points V" ,[rlatvID],rlatv)
179  if (start_file_type.eq."earth") then
180    CALL put_var1(nid,"nivsigs" ,"Numero naturel des couches s"    ,[sID]  ,nivsigs)
181    CALL put_var1(nid,"nivsig"  ,"Numero naturel des couches sigma",[sigID],nivsig)
182  endif ! of if (start_file_type.eq."earth")
183  CALL put_var1(nid,"ap"      ,"Coefficient A pour hybride"      ,[sigID],ap)
184  CALL put_var1(nid,"bp"      ,"Coefficient B pour hybride"      ,[sigID],bp)
185  if (start_file_type.ne."earth") then
186    CALL put_var1(nid,"aps","Coef AS: hybrid pressure at midlayers",[sID],aps)
187    CALL put_var1(nid,"bps","Coef BS: hybrid sigma at midlayers",[sID],bps)
188  endif ! of if (start_file_type.eq."earth")
189  CALL put_var1(nid,"presnivs",""                                ,[sID]  ,presnivs)
190  if (start_file_type.ne."earth") then
191        ierr = NF_REDEF (nid)
192#ifdef NC_DOUBLE
193        ierr = NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,rlatuID,vID)
194#else
195        ierr = NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,rlatuID,vID)
196#endif
197        ierr =NF_PUT_ATT_TEXT(nid,vID,'units',13,"degrees_north")
198        ierr = NF_PUT_ATT_TEXT (nid,vID,"long_name", 14, &
199              "North latitude")
200        ierr = NF_ENDDEF(nid)
201        call NF95_PUT_VAR(nid,vID,rlatu*180/pi)
202!
203        ierr = NF_REDEF (nid)
204#ifdef NC_DOUBLE
205        ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,rlonvID,vID)
206#else
207        ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,rlonvID,vID)
208#endif
209        ierr = NF_PUT_ATT_TEXT (nid,vID,"long_name", 14, &
210              "East longitude")
211        ierr = NF_PUT_ATT_TEXT(nid,vID,'units',12,"degrees_east")
212        ierr = NF_ENDDEF(nid)
213        call NF95_PUT_VAR(nid,vID,rlonv*180/pi)
214!
215        ierr = NF_REDEF (nid)
216#ifdef NC_DOUBLE
217        ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1, &
218             sID,vID)
219#else
220        ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1, &
221             sID,vID)
222#endif
223        ierr = NF_PUT_ATT_TEXT(nid,vID,"long_name",10,"pseudo-alt")
224        ierr = NF_PUT_ATT_TEXT (nid,vID,'units',2,"km")
225        ierr = NF_PUT_ATT_TEXT (nid,vID,'positive',2,"up")
226        ierr = NF_ENDDEF(nid)
227        call NF95_PUT_VAR(nid,vID,pseudoalt)
228        CALL err(NF_REDEF(nid))
229  endif ! of if (start_file_type.ne."earth")
230
231! covariant <-> contravariant <-> natural conversion coefficients
232  CALL put_var2(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
233  CALL put_var2(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
234  CALL put_var2(nid,"aire","Aires de chaque maille"     ,[rlonvID,rlatuID],aire)
235  CALL put_var2(nid,"phisinit","Geopotentiel au sol"    ,[rlonvID,rlatuID],phis)
236
237
238! Define variables that will be stored later:
239  WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),&
240               yyears0,mmois0,jjour0
241  IF (planet_type.eq."earth") THEN
242    CALL cre_var(nid,"temps","Temps de simulation",[timID],unites)
243  ELSE
244    CALL cre_var(nid,"Time","Temps de simulation",[timID],unites)
245  ENDIF
246
247  CALL cre_var(nid,"ucov" ,"Vitesse U"  ,[rlonuID,rlatuID,sID,timID])
248  CALL cre_var(nid,"vcov" ,"Vitesse V"  ,[rlonvID,rlatvID,sID,timID])
249  CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
250
251  IF(nqtot.GE.1) THEN
252    DO iq=1,nqtot
253      CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID])
254    END DO
255  ENDIF
256
257  CALL cre_var(nid,"masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
258  CALL cre_var(nid,"ps"   ,"Pression au sol",[rlonvID,rlatuID    ,timID])
259
260  CALL err(NF90_CLOSE (nid)) ! close file
261
262  WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
263  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
264
265END SUBROUTINE dynredem0
266
267!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
268
269SUBROUTINE dynredem1(fichnom,time,vcov,ucov,teta,q,masse,ps)
270!
271!-------------------------------------------------------------------------------
272! Purpose: Write the NetCDF restart file (append).
273!-------------------------------------------------------------------------------
274  USE infotrac, ONLY: nqtot, tname, type_trac
275  USE control_mod, only : planet_type
276  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
277                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
278  use netcdf95, only: NF95_PUT_VAR
279  USE temps_mod, ONLY: itaufin,itau_dyn
280  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &
281                          err, modname, fil, msg
282 
283  IMPLICIT NONE
284  include "dimensions.h"
285  include "paramet.h"
286  include "netcdf.inc"
287  include "comgeom.h"
288  include "iniprint.h"
289!===============================================================================
290! Arguments:
291  CHARACTER(LEN=*), INTENT(IN) :: fichnom              !-- FILE NAME
292  REAL, INTENT(IN)    ::  time                         !-- TIME
293  REAL, INTENT(IN)    ::  vcov(iip1,jjm, llm)          !-- V COVARIANT WIND
294  REAL, INTENT(IN)    ::  ucov(iip1,jjp1,llm)          !-- U COVARIANT WIND
295  REAL, INTENT(IN)    ::  teta(iip1,jjp1,llm)          !-- POTENTIAL TEMPERATURE
296  REAL, INTENT(INOUT) ::     q(iip1,jjp1,llm,nqtot)    !-- TRACERS
297  REAL, INTENT(IN)    :: masse(iip1,jjp1,llm)          !-- MASS PER CELL
298  REAL, INTENT(IN)    ::    ps(iip1,jjp1)              !-- GROUND PRESSURE
299!===============================================================================
300! Local variables:
301  INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac
302  INTEGER,SAVE :: nb=0
303  INTEGER, PARAMETER :: length=100
304  REAL               :: tab_cntrl(length) ! tableau des parametres du run
305  CHARACTER(LEN=256) :: var, dum
306  LOGICAL            :: lread_inca
307  CHARACTER(LEN=80) :: abort_message
308  CHARACTER(len=12) :: start_file_type="earth" ! default start file type
309
310  ! fill dynredem_mod module variables
311  modname='dynredem1'; fil=fichnom
312
313  if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
314      write(lunout,*) trim(modname),' : Planeto-like start file'
315      start_file_type="planeto"
316  else
317      write(lunout,*) trim(modname),' : Earth-like start file'
318  endif
319
320  CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)
321
322!--- Write/extend time coordinate
323  nb = nb + 1
324  if (start_file_type.eq."earth") then
325        ierr = NF_INQ_VARID(nid, "temps", vID)
326        IF (ierr .NE. NF_NOERR) THEN
327          write(lunout,*) NF_STRERROR(ierr)
328          abort_message='Variable temps n est pas definie'
329          CALL abort_gcm(modname,abort_message,ierr)
330        ENDIF
331 else
332        ierr = NF_INQ_VARID(nid,"Time", vID)
333        IF (ierr .NE. NF_NOERR) THEN
334          write(lunout,*) NF_STRERROR(ierr)
335          abort_message='Variable Time not found'
336          CALL abort_gcm(modname,abort_message,ierr)
337        ENDIF
338  endif ! of if (start_file_type.eq."earth")
339  call NF95_PUT_VAR(nid,vID,time,start=(/nb/))
340  WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time
341
342!--- Rewrite control table (itaufin undefined in dynredem0)
343  var="controle"
344  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
345  CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var)
346  if (start_file_type=="earth") then
347    tab_cntrl(31) = REAL(itau_dyn + itaufin)
348  else
349    tab_cntrl(31) = 0
350  endif
351  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
352  CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)
353
354!--- Save fields
355  CALL dynredem_write_u(nid,"ucov" ,ucov ,llm, nb)
356  CALL dynredem_write_v(nid,"vcov" ,vcov ,llm, nb)
357  CALL dynredem_write_u(nid,"teta" ,teta ,llm, nb)
358  CALL dynredem_write_u(nid,"masse",masse,llm, nb)
359  CALL dynredem_write_u(nid,"ps"   ,ps   ,1, nb)
360
361!--- Tracers in file "start_trac.nc" (added by Anne)
362  lread_inca=.FALSE.; fil="start_trac.nc"
363  IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
364  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
365
366!--- Save tracers
367  IF(nqtot.GE.1) THEN
368    DO iq=1,nqtot
369      var=tname(iq); ierr=-1
370      IF(lread_inca) THEN                  !--- Possibly read from "start_trac.nc"
371        fil="start_trac.nc"
372        ierr=NF90_INQ_VARID(nid_trac,var,vID_trac)
373        dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
374        WRITE(lunout,*)msg(dum,var)
375
376
377        IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,:,iq),llm)
378      END IF ! of IF(lread_inca)
379      fil=fichnom
380      CALL dynredem_write_u(nid,var,q(:,:,:,iq),llm,nb)
381    END DO ! of DO iq=1,nqtot
382  ENDIF ! of IF(nqtot.GE.1)
383
384  CALL err(NF90_CLOSE(nid),"close")
385  fil="start_trac.nc"
386  IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close")
387
388END SUBROUTINE dynredem1
389
Note: See TracBrowser for help on using the repository browser.