source: LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90 @ 5159

Last change on this file since 5159 was 5159, checked in by abarral, 7 weeks ago

Put dimensions.h and paramet.h into modules
File size: 10.2 KB
Line 
1SUBROUTINE dynetat0(fichnom,vcov,ucov,teta,q,masse,ps,phis,time)
2
3!-------------------------------------------------------------------------------
4! Authors: P. Le Van , L.Fairhead
5!-------------------------------------------------------------------------------
6! Purpose: Initial state reading.
7!-------------------------------------------------------------------------------
8  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
9  USE lmdz_strings, ONLY: maxlen, msg, strStack, real2str, int2str
10  USE netcdf,      ONLY: nf90_open,  nf90_nowrite, nf90_inq_varid, &
11                         nf90_close, nf90_get_var, nf90_noerr
12  USE lmdz_readTracFiles, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
13  USE control_mod, ONLY: planet_type
14  USE lmdz_assert_eq, ONLY: assert_eq
15  USE comvert_mod, ONLY: pa,preff
16  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad
17  USE logic_mod, ONLY: fxyhypb, ysinus
18  USE serre_mod, ONLY: clon, clat, grossismx, grossismy
19  USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time
20  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
21  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
22  USE lmdz_description, ONLY: descript
23  USE lmdz_iniprint, ONLY: lunout, prt_level
24  USE lmdz_comgeom2
25
26USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
27  USE lmdz_paramet
28  IMPLICIT NONE
29
30
31!===============================================================================
32! Arguments:
33  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
34  REAL, INTENT(OUT) ::  vcov(iip1,jjm, llm)        !--- V COVARIANT WIND
35  REAL, INTENT(OUT) ::  ucov(iip1,jjp1,llm)        !--- U COVARIANT WIND
36  REAL, INTENT(OUT) ::  teta(iip1,jjp1,llm)        !--- POTENTIAL TEMP.
37  REAL, INTENT(OUT) ::     q(iip1,jjp1,llm,nqtot)  !--- TRACERS
38  REAL, INTENT(OUT) :: masse(iip1,jjp1,llm)        !--- MASS PER CELL
39  REAL, INTENT(OUT) ::    ps(iip1,jjp1)            !--- GROUND PRESSURE
40  REAL, INTENT(OUT) ::  phis(iip1,jjp1)            !--- GEOPOTENTIAL
41!===============================================================================
42! Local variables:
43  CHARACTER(LEN=maxlen) :: mesg, var, modname, oldVar
44  INTEGER, PARAMETER :: length=100
45  INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase
46  REAL    :: time, tnat, alpha_ideal, tab_cntrl(length)    !--- RUN PARAMS TABLE
47  LOGICAL :: lSkip, ll
48  LOGICAL,PARAMETER :: tnat1=.TRUE.
49!-------------------------------------------------------------------------------
50  modname="dynetat0"
51
52!--- Initial state file opening
53  var=fichnom
54  CALL err(nf90_open(var,nf90_nowrite,fID),"open",var)
55  CALL get_var1("controle",tab_cntrl)
56
57!!! AS: idecal is a hack to be able to read planeto starts...
58!!!     .... while keeping everything OK for LMDZ EARTH
59  IF(planet_type=="generic") THEN
60    CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname)
61    idecal = 4
62    annee_ref  = 2000
63  ELSE
64    CALL msg('NOTE NOTE NOTE : Earth-like start files', modname)
65    idecal = 5
66    annee_ref  = tab_cntrl(5)
67  END IF
68  im         = tab_cntrl(1)
69  jm         = tab_cntrl(2)
70  lllm       = tab_cntrl(3)
71  day_ref    = tab_cntrl(4)
72  rad        = tab_cntrl(idecal+1)
73  omeg       = tab_cntrl(idecal+2)
74  g          = tab_cntrl(idecal+3)
75  cpp        = tab_cntrl(idecal+4)
76  kappa      = tab_cntrl(idecal+5)
77  daysec     = tab_cntrl(idecal+6)
78  dtvr       = tab_cntrl(idecal+7)
79  etot0      = tab_cntrl(idecal+8)
80  ptot0      = tab_cntrl(idecal+9)
81  ztot0      = tab_cntrl(idecal+10)
82  stot0      = tab_cntrl(idecal+11)
83  ang0       = tab_cntrl(idecal+12)
84  pa         = tab_cntrl(idecal+13)
85  preff      = tab_cntrl(idecal+14)
86
87  clon       = tab_cntrl(idecal+15)
88  clat       = tab_cntrl(idecal+16)
89  grossismx  = tab_cntrl(idecal+17)
90  grossismy  = tab_cntrl(idecal+18)
91
92  IF ( tab_cntrl(idecal+19)==1. )  THEN
93    fxyhypb  = .TRUE.
94!   dzoomx   = tab_cntrl(25)
95!   dzoomy   = tab_cntrl(26)
96!   taux     = tab_cntrl(28)
97!   tauy     = tab_cntrl(29)
98  ELSE
99    fxyhypb = .FALSE.
100    ysinus  = tab_cntrl(idecal+22)==1.
101  END IF
102
103  day_ini    = tab_cntrl(30)
104  itau_dyn   = tab_cntrl(31)
105  start_time = tab_cntrl(32)
106
107!-------------------------------------------------------------------------------
108  CALL msg('rad, omeg, g, cpp, kappa = '//TRIM(strStack(real2str([rad,omeg,g,cpp,kappa]))), modname)
109  CALL check_dim(im,iim,'im','im')
110  CALL check_dim(jm,jjm,'jm','jm')
111  CALL check_dim(lllm,llm,'lm','lllm')
112  CALL get_var1("rlonu",rlonu)
113  CALL get_var1("rlatu",rlatu)
114  CALL get_var1("rlonv",rlonv)
115  CALL get_var1("rlatv",rlatv)
116  CALL get_var2("cu"   ,cu)
117  CALL get_var2("cv"   ,cv)
118  CALL get_var2("aire" ,aire)
119  var="temps"
120  IF(nf90_inq_varid(fID,var,vID)/=nf90_noerr) THEN
121    CALL msg('missing field <temps> ; trying with <Time>', modname)
122    var="Time"
123    CALL err(nf90_inq_varid(fID,var,vID),"inq",var)
124  END IF
125  CALL err(nf90_get_var(fID,vID,time),"get",var)
126  CALL get_var2("phisinit",phis)
127  CALL get_var3("ucov",ucov)
128  CALL get_var3("vcov",vcov)
129  CALL get_var3("teta",teta)
130  CALL get_var3("masse",masse)
131  CALL get_var2("ps",ps)
132
133!--- Tracers
134  ll=.FALSE.
135#ifdef REPROBUS
136  ll = nf90_inq_varid(fID, 'HNO3tot', vID) /= nf90_noerr                                 !--- DETECT OLD REPRO start.nc FILE
137#endif
138  DO iq=1,nqtot
139    var = tracers(iq)%name
140    oldVar = new2oldH2O(var)
141    lSkip = ll .AND. var == 'HNO3'                                                       !--- FORCE "HNO3_g" READING FOR "HNO3"
142#ifdef REPROBUS
143    ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix)                          !--- REPROBUS HNO3 exceptions
144#endif
145    IF (CPPKEY_INCA) THEN
146      IF(var == 'O3') oldVar = 'OX'                                                        !--- DEAL WITH INCA OZONE EXCEPTION
147    END IF
148    !--------------------------------------------------------------------------------------------------------------------------
149    IF(nf90_inq_varid(fID, var, vID) == nf90_noerr .AND. .NOT.lSkip) THEN                !=== REGULAR CASE: AVAILABLE VARIABLE
150      CALL err(nf90_get_var(fID,vID,q(:,:,:,iq)),"get",var)
151    !--------------------------------------------------------------------------------------------------------------------------
152    ELSE IF(nf90_inq_varid(fID, oldVar, vID) == nf90_noerr) THEN                         !=== TRY WITH ALTERNATE NAME
153      CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname)
154      CALL err(nf90_get_var(fID,vID,q(:,:,:,iq)),"get",oldVar)
155    !--------------------------------------------------------------------------------------------------------------------------
156    ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN                          !=== WATER ISOTOPES
157      iName    = tracers(iq)%iso_iName
158      iPhase   = tracers(iq)%iso_iPhase
159      iqParent = tracers(iq)%iqParent
160      IF(tracers(iq)%iso_iZone == 0) THEN
161         IF (tnat1) THEN
162                 tnat=1.0
163                 alpha_ideal=1.0
164                 WRITE(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
165         else
166          IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
167            CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
168         endif
169         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname)
170         q(:,:,:,iq) = q(:,:,:,iqParent)*tnat*(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal-1.)
171      ELSE
172         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)
173         ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à
174         ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme
175         ! les parents. Sinon, c'est nul.
176         ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en
177         ! remplacant 1 par izone_init dans la ligne qui suit.
178         IF(tracers(iq)%iso_iZone == 1) THEN
179           q(:,:,:,iq) = q(:,:,:,iqIsoPha(iName,iPhase))
180         ELSE
181           q(:,:,:,iq) = 0.
182         END IF
183      END IF
184    !--------------------------------------------------------------------------------------------------------------------------
185    ELSE                                                                                 !=== MISSING: SET TO 0
186      CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to zero', modname)
187      q(:,:,:,iq)=0.
188    !--------------------------------------------------------------------------------------------------------------------------
189    END IF
190  END DO
191
192  CALL err(nf90_close(fID),"close",fichnom)
193  day_ini=day_ini+INT(time)
194  time=time-INT(time)
195
196
197  CONTAINS
198
199
200SUBROUTINE check_dim(n1,n2,str1,str2)
201  INTEGER,          INTENT(IN) :: n1, n2
202  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
203  CHARACTER(LEN=maxlen) :: s1, s2
204  IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "'//TRIM(str1)//'" = '//TRIM(int2str(n1))// &
205   ' read in starting file differs from gcm value of "'//TRIM(str2)//'" = '//TRIM(int2str(n2)), 1)
206END SUBROUTINE check_dim
207
208
209SUBROUTINE get_var1(var,v)
210  CHARACTER(LEN=*), INTENT(IN)  :: var
211  REAL,             INTENT(OUT) :: v(:)
212  CALL err(nf90_inq_varid(fID,var,vID),"inq",var)
213  CALL err(nf90_get_var(fID,vID,v),"get",var)
214END SUBROUTINE get_var1
215
216
217SUBROUTINE get_var2(var,v)
218  CHARACTER(LEN=*), INTENT(IN)  :: var
219  REAL,             INTENT(OUT) :: v(:,:)
220  CALL err(nf90_inq_varid(fID,var,vID),"inq",var)
221  CALL err(nf90_get_var(fID,vID,v),"get",var)
222END SUBROUTINE get_var2
223
224
225SUBROUTINE get_var3(var,v)
226  CHARACTER(LEN=*), INTENT(IN)  :: var
227  REAL,             INTENT(OUT) :: v(:,:,:)
228  CALL err(nf90_inq_varid(fID,var,vID),"inq",var)
229  CALL err(nf90_get_var(fID,vID,v),"get",var)
230END SUBROUTINE get_var3
231
232
233SUBROUTINE err(ierr,typ,nam)
234  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
235  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
236  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
237  IF(ierr==nf90_noerr) RETURN
238  SELECT CASE(typ)
239    CASE('inq');   mesg="Field <"//TRIM(nam)//"> is missing"
240    CASE('get');   mesg="Reading failed for <"//TRIM(nam)//">"
241    CASE('open');  mesg="File opening failed for <"//TRIM(nam)//">"
242    CASE('close'); mesg="File closing failed for <"//TRIM(nam)//">"
243  END SELECT
244  CALL ABORT_gcm(TRIM(modname),TRIM(mesg),ierr)
245END SUBROUTINE err
246
247END SUBROUTINE dynetat0
Note: See TracBrowser for help on using the repository browser.