source: LMDZ6/trunk/libf/dyn3d/dynetat0.F90 @ 4170

Last change on this file since 4170 was 4143, checked in by dcugnet, 3 years ago
  • Some variables are renamed or replaced by direct equivalents:
    • iso_indnum -> tracers(:)%iso_iName
    • niso_possibles -> niso
    • iqiso -> iqIsoPha ; index_trac -> itZonIso
    • ok_iso_verif -> isoCheck
    • ntraceurs_zone -> nzone ; ntraciso -> ntiso
    • qperemin -> min_qparent ; masseqmin -> min_qmass ; ratiomin -> min_ratio
  • Some renamed variables are only aliased with the older name (using USE <module>, ONLY: <oldName> => <newName>) in routines where they are repeated many times.
  • Few hard-coded indexes are now computed (examples: ilic, iso, ivap, irneb, iq_vap, iq_liq, iso_H2O, iso_HDO, iso_HTO, iso_O17, iso_O18).
  • The IF(isoCheck) test is now embedded in the check_isotopes_seq and check_isotopes_loc routines (lighter calling).
File size: 9.0 KB
RevLine 
[2293]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!-------------------------------------------------------------------------------
[4143]8  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, tnat, alpha_ideal, iH2O
[4120]9  USE strings_mod, ONLY: maxlen, msg, strStack, real2str
10  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, &
11                         NF90_CLOSE, NF90_GET_VAR, NF90_NoErr
12  USE readTracFiles_mod, ONLY: new2oldName
[2293]13  USE control_mod, ONLY: planet_type
14  USE assert_eq_m, ONLY: assert_eq
[2600]15  USE comvert_mod, ONLY: pa,preff
[2597]16  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad
[2603]17  USE logic_mod, ONLY: fxyhypb, ysinus
[2598]18  USE serre_mod, ONLY: clon, clat, grossismx, grossismy
[2601]19  USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time
[2622]20  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
[2600]21
[2293]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:
[4120]40  CHARACTER(LEN=maxlen) :: mesg, var, modname, oldVar
[2293]41  INTEGER, PARAMETER :: length=100
[4050]42  INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase
[2293]43  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
44!-------------------------------------------------------------------------------
45  modname="dynetat0"
46
47!--- Initial state file opening
48  var=fichnom
49  CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)
50  CALL get_var1("controle",tab_cntrl)
51
52!!! AS: idecal is a hack to be able to read planeto starts...
53!!!     .... while keeping everything OK for LMDZ EARTH
54  IF(planet_type=="generic") THEN
[4120]55    CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname)
[2293]56    idecal = 4
57    annee_ref  = 2000
58  ELSE
[4120]59    CALL msg('NOTE NOTE NOTE : Earth-like start files', modname)
[2293]60    idecal = 5
61    annee_ref  = tab_cntrl(5)
62  END IF
63  im         = tab_cntrl(1)
64  jm         = tab_cntrl(2)
65  lllm       = tab_cntrl(3)
66  day_ref    = tab_cntrl(4)
67  rad        = tab_cntrl(idecal+1)
68  omeg       = tab_cntrl(idecal+2)
69  g          = tab_cntrl(idecal+3)
70  cpp        = tab_cntrl(idecal+4)
71  kappa      = tab_cntrl(idecal+5)
72  daysec     = tab_cntrl(idecal+6)
73  dtvr       = tab_cntrl(idecal+7)
74  etot0      = tab_cntrl(idecal+8)
75  ptot0      = tab_cntrl(idecal+9)
76  ztot0      = tab_cntrl(idecal+10)
77  stot0      = tab_cntrl(idecal+11)
78  ang0       = tab_cntrl(idecal+12)
79  pa         = tab_cntrl(idecal+13)
80  preff      = tab_cntrl(idecal+14)
81!
82  clon       = tab_cntrl(idecal+15)
83  clat       = tab_cntrl(idecal+16)
84  grossismx  = tab_cntrl(idecal+17)
85  grossismy  = tab_cntrl(idecal+18)
86!
87  IF ( tab_cntrl(idecal+19)==1. )  THEN
88    fxyhypb  = .TRUE.
89!   dzoomx   = tab_cntrl(25)
90!   dzoomy   = tab_cntrl(26)
91!   taux     = tab_cntrl(28)
92!   tauy     = tab_cntrl(29)
93  ELSE
94    fxyhypb = .FALSE.
95    ysinus  = tab_cntrl(idecal+22)==1.
96  END IF
97
98  day_ini    = tab_cntrl(30)
99  itau_dyn   = tab_cntrl(31)
100  start_time = tab_cntrl(32)
101
102!-------------------------------------------------------------------------------
[4120]103  CALL msg('rad, omeg, g, cpp, kappa = '//TRIM(strStack(real2str([rad,omeg,g,cpp,kappa]))), modname)
[2293]104  CALL check_dim(im,iim,'im','im')
105  CALL check_dim(jm,jjm,'jm','jm')
106  CALL check_dim(lllm,llm,'lm','lllm')
107  CALL get_var1("rlonu",rlonu)
108  CALL get_var1("rlatu",rlatu)
109  CALL get_var1("rlonv",rlonv)
110  CALL get_var1("rlatv",rlatv)
111  CALL get_var2("cu"   ,cu)
112  CALL get_var2("cv"   ,cv)
113  CALL get_var2("aire" ,aire)
114  var="temps"
115  IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
[4120]116    CALL msg('missing field <temps> ; trying with <Time>', modname)
117    var="Time"
[2293]118    CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
119  END IF
120  CALL err(NF90_GET_VAR(fID,vID,time),"get",var)
[2299]121  CALL get_var2("phisinit",phis)
[2293]122  CALL get_var3("ucov",ucov)
123  CALL get_var3("vcov",vcov)
124  CALL get_var3("teta",teta)
125  CALL get_var3("masse",masse)
126  CALL get_var2("ps",ps)
127
128!--- Tracers
129  DO iq=1,nqtot
[4120]130    var = tracers(iq)%name
131    oldVar = new2oldName(var)
132    !--------------------------------------------------------------------------------------------------------------------------
133    IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr) THEN                                 !=== REGULAR CASE
134      CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var)
135    !--------------------------------------------------------------------------------------------------------------------------
136    ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN                         !=== OLD NAME
137      CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname)
138      CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",oldVar)
139    !--------------------------------------------------------------------------------------------------------------------------
140#ifdef INCA
141    ELSE IF(NF90_INQ_VARID(fID, 'OX',   vID) == NF90_NoErr .AND. var == 'O3') THEN       !=== INCA: OX INSTEAD OF O3
142      CALL msg('Tracer <O3> is missing => initialized to <OX>', modname)
143      CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",'OX')
144    !--------------------------------------------------------------------------------------------------------------------------
145#endif
146    ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN                          !=== WATER ISOTOPES
[4143]147      iName    = tracers(iq)%iso_iName
[4120]148      iPhase   = tracers(iq)%iso_iPhase
149      iqParent = tracers(iq)%iqParent
150      IF(tracers(iq)%iso_iZone == 0) THEN
151         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname)
152         q(:,:,:,iq) = q(:,:,:,iqParent)*tnat(iName)*(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.)
153      ELSE
154         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)
[4143]155         q(:,:,:,iq) = q(:,:,:,iqIsoPha(iName,iPhase))
[4120]156      END IF
157    !--------------------------------------------------------------------------------------------------------------------------
158    ELSE                                                                                 !=== MISSING: SET TO 0
159      CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to zero', modname)
160      q(:,:,:,iq)=0.
161    !--------------------------------------------------------------------------------------------------------------------------
[2293]162    END IF
163  END DO
164
165  CALL err(NF90_CLOSE(fID),"close",fichnom)
166  day_ini=day_ini+INT(time)
167  time=time-INT(time)
168
169
170  CONTAINS
171
172
173SUBROUTINE check_dim(n1,n2,str1,str2)
174  INTEGER,          INTENT(IN) :: n1, n2
175  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
[4046]176  CHARACTER(LEN=maxlen) :: s1, s2
[2293]177  IF(n1/=n2) THEN
178    s1='value of '//TRIM(str1)//' ='
179    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
[4120]180    WRITE(mesg,'(10x,a,i4,2x,a,i4)')TRIM(ADJUSTL(s1)),n1,TRIM(ADJUSTL(s2)),n2
181    CALL ABORT_gcm(TRIM(modname),TRIM(mesg),1)
[2293]182  END IF
183END SUBROUTINE check_dim
184
185
186SUBROUTINE get_var1(var,v)
187  CHARACTER(LEN=*), INTENT(IN)  :: var
188  REAL,             INTENT(OUT) :: v(:)
189  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
190  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
191END SUBROUTINE get_var1
192
193
194SUBROUTINE get_var2(var,v)
195  CHARACTER(LEN=*), INTENT(IN)  :: var
196  REAL,             INTENT(OUT) :: v(:,:)
197  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
198  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
199END SUBROUTINE get_var2
200
201
202SUBROUTINE get_var3(var,v)
203  CHARACTER(LEN=*), INTENT(IN)  :: var
204  REAL,             INTENT(OUT) :: v(:,:,:)
205  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
206  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
207END SUBROUTINE get_var3
208
209
210SUBROUTINE err(ierr,typ,nam)
211  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
212  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
213  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
214  IF(ierr==NF90_NoERR) RETURN
215  SELECT CASE(typ)
[4120]216    CASE('inq');   mesg="Field <"//TRIM(nam)//"> is missing"
217    CASE('get');   mesg="Reading failed for <"//TRIM(nam)//">"
218    CASE('open');  mesg="File opening failed for <"//TRIM(nam)//">"
219    CASE('close'); mesg="File closing failed for <"//TRIM(nam)//">"
[2293]220  END SELECT
[4120]221  CALL ABORT_gcm(TRIM(modname),TRIM(mesg),ierr)
[2293]222END SUBROUTINE err
223
224END SUBROUTINE dynetat0
Note: See TracBrowser for help on using the repository browser.