source: LMDZ5/trunk/libf/dyn3d/dynredem.F90 @ 2404

Last change on this file since 2404 was 2299, checked in by dcugnet, 9 years ago

In dyn3d/:
etat0dyn_netcdf.F90: "startget_dyn3d" syntax slightly simplified.
dynredem.F90: Shortcut routines (put_var*, cre_var,
dynredem_write_*, dynredem_read_u)

modified to match dyn3dmem version and put in

module dyredem_mod.F90.
dynetat0.F90 -> *.f90: Few simplifications (no usage of NC_DOUBLE
needed => no precompilation)

Add tracers initialization in the isotope case

suppressed by accident.
dynredem_mod.F90: Created to mimic dyn3dmem equivalent.

In dyn3dmem/:
dynetat0_loc.F -> *.f90: Converted into fortran 90 to match the dyn3d
version.
dynredem_loc.F -> *.F90: Converted into fortran 90.
dynredem_mod.F90: Add some shortcut routines to match the dyn3d
version.

In phylmd/:
phyredem.F90: Bug fix: nsw instead of nsoilmx was used as
Tsoil second maximum index.

Bug fix: fevap instead of snow was saved for

"SNOW".
etat0phys_netcdf.F90: "filtreg_mod" module usage suppressed.

Local variable rugo computation removed (not

used).

In dynlonlat_phylonlat/:
grid_atob_m.F90 -> *.f90 DOUBLE PRECISION variables usage removed.

Precompilation o longer needed => .F90 extension.

File size: 9.4 KB
Line 
1SUBROUTINE dynredem0(fichnom,iday_end,phis)
2!
3!-------------------------------------------------------------------------------
4! Write the NetCDF restart file (initialization).
5!-------------------------------------------------------------------------------
6#ifdef CPP_IOIPSL
7  USE IOIPSL
8#endif
9  USE infotrac
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  IMPLICIT NONE
14  include "dimensions.h"
15  include "paramet.h"
16  include "comconst.h"
17  include "comvert.h"
18  include "comgeom2.h"
19  include "temps.h"
20  include "ener.h"
21  include "logic.h"
22  include "description.h"
23  include "serre.h"
24  include "iniprint.h"
25!===============================================================================
26! Arguments:
27  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
28  INTEGER,          INTENT(IN) :: iday_end         !---
29  REAL,             INTENT(IN) :: phis(iip1, jjp1) !--- GROUND GEOPOTENTIAL
30!===============================================================================
31! Local variables:
32  INTEGER :: iq, l
33  INTEGER, PARAMETER :: length=100
34  REAL    :: tab_cntrl(length)                     !--- RUN PARAMETERS TABLE
35!   For NetCDF:
36  CHARACTER(LEN=30) :: unites
37  INTEGER :: indexID
38  INTEGER :: rlonuID, rlonvID, rlatuID, rlatvID
39  INTEGER :: sID, sigID, nID, vID, timID
40  INTEGER :: yyears0, jjour0, mmois0
41  REAL    :: zan0, zjulian, hours
42!===============================================================================
43  modname='dynredem0'; fil=fichnom
44#ifdef CPP_IOIPSL
45  CALL ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
46  CALL ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
47#else
48! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
49  yyears0=0
50  mmois0=1
51  jjour0=1
52#endif       
53
54  tab_cntrl(:)  = 0.
55  tab_cntrl(1)  = REAL(iim)
56  tab_cntrl(2)  = REAL(jjm)
57  tab_cntrl(3)  = REAL(llm)
58  tab_cntrl(4)  = REAL(day_ref)
59  tab_cntrl(5)  = REAL(annee_ref)
60  tab_cntrl(6)  = rad
61  tab_cntrl(7)  = omeg
62  tab_cntrl(8)  = g
63  tab_cntrl(9)  = cpp
64  tab_cntrl(10) = kappa
65  tab_cntrl(11) = daysec
66  tab_cntrl(12) = dtvr
67  tab_cntrl(13) = etot0
68  tab_cntrl(14) = ptot0
69  tab_cntrl(15) = ztot0
70  tab_cntrl(16) = stot0
71  tab_cntrl(17) = ang0
72  tab_cntrl(18) = pa
73  tab_cntrl(19) = preff
74
75!    .....    parameters for zoom    ......   
76  tab_cntrl(20) = clon
77  tab_cntrl(21) = clat
78  tab_cntrl(22) = grossismx
79  tab_cntrl(23) = grossismy
80!
81  IF ( fxyhypb )   THEN
82    tab_cntrl(24) = 1.
83    tab_cntrl(25) = dzoomx
84    tab_cntrl(26) = dzoomy
85    tab_cntrl(27) = 0.
86    tab_cntrl(28) = taux
87    tab_cntrl(29) = tauy
88  ELSE
89    tab_cntrl(24) = 0.
90    tab_cntrl(25) = dzoomx
91    tab_cntrl(26) = dzoomy
92    tab_cntrl(27) = 0.
93    tab_cntrl(28) = 0.
94    tab_cntrl(29) = 0.
95    IF( ysinus )  tab_cntrl(27) = 1.
96  END IF
97  tab_cntrl(30) = REAL(iday_end)
98  tab_cntrl(31) = REAL(itau_dyn + itaufin)
99! start_time: start_time of simulation (not necessarily 0.)
100  tab_cntrl(32) = start_time
101
102!--- File creation
103  CALL err(NF90_CREATE(fichnom,NF90_CLOBBER,nid))
104
105!--- Some global attributes
106  CALL err(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique"))
107
108!--- Dimensions
109  CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
110  CALL err(NF90_DEF_DIM(nid,"rlonu", iip1,   rlonuID))
111  CALL err(NF90_DEF_DIM(nid,"rlatu", jjp1,   rlatuID))
112  CALL err(NF90_DEF_DIM(nid,"rlonv", iip1,   rlonvID))
113  CALL err(NF90_DEF_DIM(nid,"rlatv", jjm,    rlatvID))
114  CALL err(NF90_DEF_DIM(nid,"sigs",  llm,        sID))
115  CALL err(NF90_DEF_DIM(nid,"sig",   llmp1,    sigID))
116  CALL err(NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID))
117
118!--- Define and save invariant fields
119  CALL put_var1(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl)
120  CALL put_var1(nid,"rlonu"   ,"Longitudes des points U",[rlonuID],rlonu)
121  CALL put_var1(nid,"rlatu"   ,"Latitudes des points U" ,[rlatuID],rlatu)
122  CALL put_var1(nid,"rlonv"   ,"Longitudes des points V",[rlonvID],rlonv)
123  CALL put_var1(nid,"rlatv"   ,"Latitudes des points V" ,[rlatvID],rlatv)
124  CALL put_var1(nid,"nivsigs" ,"Numero naturel des couches s"    ,[sID]  ,nivsigs)
125  CALL put_var1(nid,"nivsig"  ,"Numero naturel des couches sigma",[sigID],nivsig)
126  CALL put_var1(nid,"ap"      ,"Coefficient A pour hybride"      ,[sigID],ap)
127  CALL put_var1(nid,"bp"      ,"Coefficient B pour hybride"      ,[sigID],bp)
128  CALL put_var1(nid,"presnivs",""                                ,[sID]  ,presnivs)
129! covariant <-> contravariant <-> natural conversion coefficients
130  CALL put_var2(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
131  CALL put_var2(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
132  CALL put_var2(nid,"aire","Aires de chaque maille"     ,[rlonvID,rlatuID],aire)
133  CALL put_var2(nid,"phisinit","Geopotentiel au sol"    ,[rlonvID,rlatuID],phis)
134
135!--- Define fields saved later
136  WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),&
137               yyears0,mmois0,jjour0
138  CALL cre_var(nid,"temps","Temps de simulation",[timID],unites)
139  CALL cre_var(nid,"ucov" ,"Vitesse U"  ,[rlonuID,rlatuID,sID,timID])
140  CALL cre_var(nid,"vcov" ,"Vitesse V"  ,[rlonvID,rlatvID,sID,timID])
141  CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
142  DO iq=1,nqtot
143    CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID])
144  END DO
145  CALL cre_var(nid,"masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
146  CALL cre_var(nid,"ps"   ,"Pression au sol",[rlonvID,rlatuID    ,timID])
147  CALL err(NF90_CLOSE (nid))
148
149  WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
150  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
151
152END SUBROUTINE dynredem0
153!
154!-------------------------------------------------------------------------------
155
156
157!-------------------------------------------------------------------------------
158!
159SUBROUTINE dynredem1(fichnom,time,vcov,ucov,teta,q,masse,ps)
160!
161!-------------------------------------------------------------------------------
162! Purpose: Write the NetCDF restart file (append).
163!-------------------------------------------------------------------------------
164  USE infotrac
165  USE control_mod
166  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
167                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
168  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &
169                          err, modname, fil, msg
170  IMPLICIT NONE
171  include "dimensions.h"
172  include "paramet.h"
173  include "description.h"
174  include "comvert.h"
175  include "comgeom.h"
176  include "temps.h"
177  include "iniprint.h"
178!===============================================================================
179! Arguments:
180  CHARACTER(LEN=*), INTENT(IN) :: fichnom              !-- FILE NAME
181  REAL, INTENT(IN)    ::  time                         !-- TIME
182  REAL, INTENT(IN)    ::  vcov(iip1,jjm, llm)          !-- V COVARIANT WIND
183  REAL, INTENT(IN)    ::  ucov(iip1,jjp1,llm)          !-- U COVARIANT WIND
184  REAL, INTENT(IN)    ::  teta(iip1,jjp1,llm)          !-- POTENTIAL TEMPERATURE
185  REAL, INTENT(INOUT) ::     q(iip1,jjp1,llm,nqtot)    !-- TRACERS
186  REAL, INTENT(IN)    :: masse(iip1,jjp1,llm)          !-- MASS PER CELL
187  REAL, INTENT(IN)    ::    ps(iip1,jjp1)              !-- GROUND PRESSURE
188!===============================================================================
189! Local variables:
190  INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac
191  INTEGER, SAVE :: nb=0
192  INTEGER, PARAMETER :: length=100
193  REAL               :: tab_cntrl(length) ! tableau des parametres du run
194  CHARACTER(LEN=256) :: var, dum
195  LOGICAL            :: lread_inca
196!===============================================================================
197
198  modname='dynredem1'; fil=fichnom
199  CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)
200
201!--- Write/extend time coordinate
202  nb = nb + 1
203  var="temps"
204  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
205  CALL err(NF90_PUT_VAR(nid,vID,[time]),"put",var)
206  WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time
207
208!--- Rewrite control table (itaufin undefined in dynredem0)
209  var="controle"
210  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
211  CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var)
212  tab_cntrl(31)=DBLE(itau_dyn + itaufin)
213  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
214  CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)
215
216!--- Save fields
217  CALL dynredem_write_u(nid,"ucov" ,ucov ,llm)
218  CALL dynredem_write_v(nid,"vcov" ,vcov ,llm)
219  CALL dynredem_write_u(nid,"teta" ,teta ,llm)
220  CALL dynredem_write_u(nid,"masse",masse,llm)
221  CALL dynredem_write_u(nid,"ps"   ,ps   ,1)
222
223!--- Tracers in file "start_trac.nc" (added by Anne)
224  lread_inca=.FALSE.; fil="start_trac.nc"
225  IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
226  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
227
228!--- Save tracers
229  DO iq=1,nqtot; var=tname(iq); ierr=-1
230    IF(lread_inca) THEN                  !--- Possibly read from "start_trac.nc"
231      fil="start_trac.nc"
232      ierr=NF90_INQ_VARID(nid_trac,var,vID_trac)
233      dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
234      WRITE(lunout,*)msg(dum,var)
235
236
237      IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,:,iq),llm)
238    END IF
239    fil=fichnom
240    CALL dynredem_write_u(nid,var,q(:,:,:,iq),llm)
241  END DO
242  CALL err(NF90_CLOSE(nid),"close")
243  fil="start_trac.nc"
244  IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close")
245
246END SUBROUTINE dynredem1
247
Note: See TracBrowser for help on using the repository browser.