source: LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/dynetat0.F90 @ 5313

Last change on this file since 5313 was 4727, checked in by idelkadi, 13 months ago

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