source: LMDZ6/trunk/libf/dyn3dmem/dynredem_loc.F90 @ 5134

Last change on this file since 5134 was 5084, checked in by Laurent Fairhead, 12 months ago

Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks
AB, LF

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