source: LMDZ6/branches/LMDZ-tracers/libf/dyn3d/dynetat0.F90 @ 3961

Last change on this file since 3961 was 3957, checked in by dcugnet, 3 years ago

In readTracFiles: the separator between the tracer name and its phase is no longer hardcoded and equal to "-",
but is a parameter ("phases_sep") which default value is "_".
Few more fixes.
File size: 8.0 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 readTracFiles_mod, ONLY: known_phases, old_phases, nphases, phases_sep
9  USE infotrac,    ONLY: nqtot, niso, tracers, iTraPha, tnat, alpha_ideal, tra
10  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr, &
11                         NF90_CLOSE, NF90_GET_VAR
12  USE strings_mod, ONLY: strIdx
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=256) :: sdum, var, modname, oldH2O
41  INTEGER, PARAMETER :: length=100
42  INTEGER :: iq, fID, vID, idecal, ix, ip
43  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
44  TYPE(tra), POINTER :: tr
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    WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files'
57    idecal = 4
58    annee_ref  = 2000
59  ELSE
60    WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files'
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  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
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    WRITE(lunout,*)TRIM(modname)//": missing field <temps>"
118    WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; 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  DO iq=1,nqtot
131    tr => tracers(iq)
132    var = tr%name
133    ix = strIdx([('H2O'//phases_sep//known_phases(ip:ip), ip=1, nphases)], var)
134    IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr) THEN
135      CALL get_var3(var, q(:,:,:,iq))
136#ifdef INCA
137    ELSE IF(NF90_INQ_VARID(fID, 'OX', vID) == NF90_NoErr .AND. var == 'O3') THEN
138      WRITE(lunout,*)TRIM(modname)//': Tracer <O3> is missing => initialized to OX'
139      CALL get_var3('OX', q(:,:,:,iq))
140#endif
141    ELSE IF(ix /= 0) THEN              !--- Old file, water: H2Ov/l/i instead of H2O_g/_l/_s
142      oldH2O = 'H2O'//old_phases(ix:ix)
143      IF(NF90_INQ_VARID(fID, oldH2O, vID) == NF90_NoErr) THEN
144        WRITE(lunout,*)TRIM(modname)//': Tracer <'//TRIM(var)//'> is missing => initialized to '//TRIM(oldH2O)
145        CALL get_var3(oldH2O, q(:,:,:,iq))
146      END IF
147    ELSE
148      WRITE(lunout,*)TRIM(modname)//': Tracer <'//TRIM(var)//'> is missing => initialized to zero'
149      q(:,:,:,iq)=0.
150      !--- CRisi: for isotopes, theoretical initialization using very simplified Rayleigh distillation law
151      IF(niso > 0 .AND. tr%iso_num > 0) THEN
152        IF(tr%iso_zon == 0) q(:,:,:,iq) = q(:,:,:,tr%iprnt)         *        tnat(tr%iso_num)  &
153                                        *(q(:,:,:,tr%iprnt)/30.e-3)**(alpha_ideal(tr%iso_num)-1)
154        IF(tr%iso_zon == 1) q(:,:,:,iq) = q(:,:,:,iTraPha(tr%iso_num,tr%iso_pha))
155      END IF
156    END IF
157  END DO
158  CALL err(NF90_CLOSE(fID),"close",fichnom)
159  day_ini=day_ini+INT(time)
160  time=time-INT(time)
161
162
163  CONTAINS
164
165
166SUBROUTINE check_dim(n1,n2,str1,str2)
167  INTEGER,          INTENT(IN) :: n1, n2
168  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
169  CHARACTER(LEN=256) :: s1, s2
170  IF(n1/=n2) THEN
171    s1='value of '//TRIM(str1)//' ='
172    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
173    WRITE(sdum,'(10x,a,i4,2x,a,i4)'),TRIM(s1),n1,TRIM(s2),n2
174    CALL ABORT_gcm(TRIM(modname),TRIM(sdum),1)
175  END IF
176END SUBROUTINE check_dim
177
178
179SUBROUTINE get_var1(var, v)
180  CHARACTER(LEN=*), INTENT(IN)  :: var
181  REAL,             INTENT(OUT) :: v(:)
182  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
183  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
184END SUBROUTINE get_var1
185
186
187SUBROUTINE get_var2(var, v)
188  CHARACTER(LEN=*), INTENT(IN)  :: var
189  REAL,             INTENT(OUT) :: v(:,:)
190  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
191  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
192END SUBROUTINE get_var2
193
194
195SUBROUTINE get_var3(var, v)
196  CHARACTER(LEN=*), INTENT(IN)  :: var
197  REAL,             INTENT(OUT) :: v(:,:,:)
198  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
199  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
200END SUBROUTINE get_var3
201
202
203SUBROUTINE err(ierr, typ, nam)
204  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
205  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
206  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
207  IF(ierr==NF90_NoERR) RETURN
208  SELECT CASE(typ)
209    CASE('inq');   sdum="Field <"//TRIM(nam)//"> is missing"
210    CASE('get');   sdum="Reading failed for <"//TRIM(nam)//">"
211    CASE('open');  sdum="File opening failed for <"//TRIM(nam)//">"
212    CASE('close'); sdum="File closing failed for <"//TRIM(nam)//">"
213  END SELECT
214  CALL ABORT_gcm(TRIM(modname),TRIM(sdum),ierr)
215END SUBROUTINE err
216
217END SUBROUTINE dynetat0
Note: See TracBrowser for help on using the repository browser.