source: LMDZ6/trunk/libf/dyn3d/dynetat0.f90 @ 5274

Last change on this file since 5274 was 5272, checked in by abarral, 8 months ago

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