source: LMDZ6/branches/LMDZ-tracers/libf/dyn3d/dynetat0.f90 @ 3895

Last change on this file since 3895 was 3852, checked in by dcugnet, 4 years ago

Extension of the tracers management.

The tracers files can be:

1) "traceur.def": old format, with:

  • the number of tracers on the first line
  • one line for each tracer: <tracer name> <hadv> <vadv> [<parent name>]

2) "tracer.def": new format with one section each model component.
3) "tracer_<name>.def": new format with a single section.

The formats 2 and 3 reading is driven by the "type_trac" key, which can be a

coma-separated list of components.

  • Format 2: read the sections from the "tracer.def" file.
  • format 3: read one section each "tracer_<section name>.def" file.
  • the first line of a section is "&<section name>
  • the other lines start with a tracer name followed by <key>=<val> pairs.
  • the "default" tracer name is reserved ; the other tracers of the section inherit its <key>=<val>, except for the keys that are redefined locally.

This format helps keeping the tracers files compact, thanks to the "default"
special tracer and the three levels of factorization:

  • on the tracers names: a tracer name can be a coma-separated list of tracers => all the tracers of the list have the same <key>=<val> properties
  • on the parents names: the value of the "parent" property can be a coma-separated list of tracers => only possible for geographic tagging tracers
  • on the phases: the property "phases" is [g](l][s] (gas/liquid/solid)

Read information is stored in the vector "tracers(:)", of derived type "tra".

"isotopes_params.def" is a similar file, with one section each isotopes family.
It contains a database of isotopes properties ; if there are second generation
tracers (isotopes), the corresponding sections are read.

Read information is stored in the vector "isotopes(:)", of derived type "iso".

The "getKey" function helps to get the values of the parameters stored in
"tracers" or "isotopes".
File size: 8.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, niso, tracers, iTraPha, tnat, alpha_ideal, tra
9  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr, &
10                         NF90_CLOSE, NF90_GET_VAR
11  USE strings_mod, ONLY: strIdx
12  USE control_mod, ONLY: planet_type
13  USE assert_eq_m, ONLY: assert_eq
14  USE comvert_mod, ONLY: pa,preff
15  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad
16  USE logic_mod, ONLY: fxyhypb, ysinus
17  USE serre_mod, ONLY: clon, clat, grossismx, grossismy
18  USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time
19  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
20
21  IMPLICIT NONE
22  include "dimensions.h"
23  include "paramet.h"
24  include "comgeom2.h"
25  include "description.h"
26  include "iniprint.h"
27!===============================================================================
28! Arguments:
29  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
30  REAL, INTENT(OUT) ::  vcov(iip1,jjm, llm)        !--- V COVARIANT WIND
31  REAL, INTENT(OUT) ::  ucov(iip1,jjp1,llm)        !--- U COVARIANT WIND
32  REAL, INTENT(OUT) ::  teta(iip1,jjp1,llm)        !--- POTENTIAL TEMP.
33  REAL, INTENT(OUT) ::     q(iip1,jjp1,llm,nqtot)  !--- TRACERS
34  REAL, INTENT(OUT) :: masse(iip1,jjp1,llm)        !--- MASS PER CELL
35  REAL, INTENT(OUT) ::    ps(iip1,jjp1)            !--- GROUND PRESSURE
36  REAL, INTENT(OUT) ::  phis(iip1,jjp1)            !--- GEOPOTENTIAL
37!===============================================================================
38! Local variables:
39  CHARACTER(LEN=256) :: sdum, var, modname, oldH2O(3), newH2O(3)
40  INTEGER, PARAMETER :: length=100
41  INTEGER :: iq, fID, vID, idecal, ix!, iml, jml, lml, nqt
42  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
43 TYPE(tra), POINTER :: tr
44!-------------------------------------------------------------------------------
45  modname="dynetat0"
46  oldH2O=['H2Ov ','H2Ol ','H2Oi ']
47  newH2O=['H2O-g','H2O-l','H2O-s']
48
49!--- Initial state file opening
50  var=fichnom
51  CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)
52  CALL get_var1("controle",tab_cntrl)
53
54!!! AS: idecal is a hack to be able to read planeto starts...
55!!!     .... while keeping everything OK for LMDZ EARTH
56  IF(planet_type=="generic") THEN
57    WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files'
58    idecal = 4
59    annee_ref  = 2000
60  ELSE
61    WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files'
62    idecal = 5
63    annee_ref  = tab_cntrl(5)
64  END IF
65  im         = tab_cntrl(1)
66  jm         = tab_cntrl(2)
67  lllm       = tab_cntrl(3)
68  day_ref    = tab_cntrl(4)
69  rad        = tab_cntrl(idecal+1)
70  omeg       = tab_cntrl(idecal+2)
71  g          = tab_cntrl(idecal+3)
72  cpp        = tab_cntrl(idecal+4)
73  kappa      = tab_cntrl(idecal+5)
74  daysec     = tab_cntrl(idecal+6)
75  dtvr       = tab_cntrl(idecal+7)
76  etot0      = tab_cntrl(idecal+8)
77  ptot0      = tab_cntrl(idecal+9)
78  ztot0      = tab_cntrl(idecal+10)
79  stot0      = tab_cntrl(idecal+11)
80  ang0       = tab_cntrl(idecal+12)
81  pa         = tab_cntrl(idecal+13)
82  preff      = tab_cntrl(idecal+14)
83!
84  clon       = tab_cntrl(idecal+15)
85  clat       = tab_cntrl(idecal+16)
86  grossismx  = tab_cntrl(idecal+17)
87  grossismy  = tab_cntrl(idecal+18)
88!
89  IF ( tab_cntrl(idecal+19)==1. )  THEN
90    fxyhypb  = .TRUE.
91!   dzoomx   = tab_cntrl(25)
92!   dzoomy   = tab_cntrl(26)
93!   taux     = tab_cntrl(28)
94!   tauy     = tab_cntrl(29)
95  ELSE
96    fxyhypb = .FALSE.
97    ysinus  = tab_cntrl(idecal+22)==1.
98  END IF
99
100  day_ini    = tab_cntrl(30)
101  itau_dyn   = tab_cntrl(31)
102  start_time = tab_cntrl(32)
103
104!-------------------------------------------------------------------------------
105  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
106  CALL check_dim(im,iim,'im','im')
107  CALL check_dim(jm,jjm,'jm','jm')
108  CALL check_dim(lllm,llm,'lm','lllm')
109  CALL get_var1("rlonu",rlonu)
110  CALL get_var1("rlatu",rlatu)
111  CALL get_var1("rlonv",rlonv)
112  CALL get_var1("rlatv",rlatv)
113  CALL get_var2("cu"   ,cu)
114  CALL get_var2("cv"   ,cv)
115  CALL get_var2("aire" ,aire)
116  var="temps"
117  IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
118    WRITE(lunout,*)TRIM(modname)//": missing field <temps>"
119    WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; var="Time"
120    CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
121  END IF
122  CALL err(NF90_GET_VAR(fID,vID,time),"get",var)
123  CALL get_var2("phisinit",phis)
124  CALL get_var3("ucov",ucov)
125  CALL get_var3("vcov",vcov)
126  CALL get_var3("teta",teta)
127  CALL get_var3("masse",masse)
128  CALL get_var2("ps",ps)
129
130!--- Tracers
131  DO iq=1,nqtot
132    tr => tracers(iq)
133    var = tr%name
134    IF(NF90_INQ_VARID(fID,var,vID)==NF90_NoErr) THEN
135      CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE
136#ifdef INCA
137    ELSE IF(var == "O3") THEN          !--- INCA and O3 missing: take OX instead
138      WRITE(lunout,*) 'Tracer O3 is missing - it is initialized to OX'
139        IF(NF90_INQ_VARID(fID,"OX",vID) == NF90_NoErr) THEN
140           CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE
141        END IF
142#endif
143    ELSE                               !--- Old file, water: H2Ov/l/i instead of H2O-g/-l/-s
144      ix = strIdx(newH2O, var)         !--- Current tracer is water (new name) ?
145      IF(ix /= 0) THEN                 !--- Then read the field, using the old name.
146        IF(NF90_INQ_VARID(fID,oldH2O(ix),vID) == NF90_NoErr) THEN
147           CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE
148        END IF
149      END IF
150    END IF
151    WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"
152    WRITE(lunout,*)"         It is hence initialized to zero"
153    q(:,:,:,iq)=0.
154    !--- CRisi: for isotops, theoretical initialization using very simplified
155    !           Rayleigh distillation las.
156    IF(niso > 0 .AND. tr%iso_num > 0) THEN
157      IF(tr%iso_zon == 0) q(:,:,:,iq) = q(:,:,:,tr%iprnt)         *        tnat(tr%iso_num)  &
158                                      *(q(:,:,:,tr%iprnt)/30.e-3)**(alpha_ideal(tr%iso_num)-1)
159      IF(tr%iso_zon == 1) q(:,:,:,iq) = q(:,:,:,iTraPha(tr%iso_num,tr%iso_pha))
160    END IF
161  END DO
162
163  CALL err(NF90_CLOSE(fID),"close",fichnom)
164  day_ini=day_ini+INT(time)
165  time=time-INT(time)
166
167
168  CONTAINS
169
170
171SUBROUTINE check_dim(n1,n2,str1,str2)
172  INTEGER,          INTENT(IN) :: n1, n2
173  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
174  CHARACTER(LEN=256) :: s1, s2
175  IF(n1/=n2) THEN
176    s1='value of '//TRIM(str1)//' ='
177    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
178    WRITE(sdum,'(10x,a,i4,2x,a,i4)'),TRIM(ADJUSTL(s1)),n1,TRIM(ADJUSTL(s2)),n2
179    CALL ABORT_gcm(TRIM(modname),TRIM(sdum),1)
180  END IF
181END SUBROUTINE check_dim
182
183
184SUBROUTINE get_var1(var,v)
185  CHARACTER(LEN=*), INTENT(IN)  :: var
186  REAL,             INTENT(OUT) :: v(:)
187  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
188  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
189END SUBROUTINE get_var1
190
191
192SUBROUTINE get_var2(var,v)
193  CHARACTER(LEN=*), INTENT(IN)  :: var
194  REAL,             INTENT(OUT) :: v(:,:)
195  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
196  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
197END SUBROUTINE get_var2
198
199
200SUBROUTINE get_var3(var,v)
201  CHARACTER(LEN=*), INTENT(IN)  :: var
202  REAL,             INTENT(OUT) :: v(:,:,:)
203  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
204  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
205END SUBROUTINE get_var3
206
207
208SUBROUTINE err(ierr,typ,nam)
209  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
210  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
211  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
212  IF(ierr==NF90_NoERR) RETURN
213  SELECT CASE(typ)
214    CASE('inq');   sdum="Field <"//TRIM(nam)//"> is missing"
215    CASE('get');   sdum="Reading failed for <"//TRIM(nam)//">"
216    CASE('open');  sdum="File opening failed for <"//TRIM(nam)//">"
217    CASE('close'); sdum="File closing failed for <"//TRIM(nam)//">"
218  END SELECT
219  CALL ABORT_gcm(TRIM(modname),TRIM(sdum),ierr)
220END SUBROUTINE err
221
222END SUBROUTINE dynetat0
Note: See TracBrowser for help on using the repository browser.