source: LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F90 @ 5407

Last change on this file since 5407 was 2622, checked in by Ehouarn Millour, 8 years ago

Some code tidying: turn ener.h into ener_mod.F90
EM

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