source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90 @ 5115

Last change on this file since 5115 was 5114, checked in by abarral, 5 months ago

Rename modules in misc from *_mod > lmdz_*
Turn description.h into lmdz_description.f90

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 12.3 KB
RevLine 
[2299]1SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,teta,q,masse,ps,phis,time)
[5099]2
[2299]3!-------------------------------------------------------------------------------
4! Authors: P. Le Van , L.Fairhead
5!-------------------------------------------------------------------------------
6! Purpose: Initial state reading.
7!-------------------------------------------------------------------------------
8  USE parallel_lmdz
[4325]9  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
[4436]10  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx
[5101]11  USE netcdf,      ONLY: nf90_open,  nf90_nowrite, nf90_inquire_dimension, nf90_inq_varid, &
12                         nf90_close, nf90_get_var, nf90_inquire_variable,  nf90_noerr
[4325]13  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
[2299]14  USE control_mod, ONLY: planet_type
[5113]15  USE lmdz_assert_eq, ONLY: assert_eq
[2600]16  USE comvert_mod, ONLY: pa,preff
[4120]17  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad
[2603]18  USE logic_mod, ONLY: fxyhypb, ysinus
[2598]19  USE serre_mod, ONLY: clon, clat, grossismx, grossismy
[4120]20  USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time
[2622]21  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
[5091]22  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
[5114]23  USE lmdz_description, ONLY: descript
[4120]24
[2299]25  IMPLICIT NONE
26  include "dimensions.h"
27  include "paramet.h"
28  include "comgeom.h"
29  include "iniprint.h"
30!===============================================================================
31! Arguments:
32  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
33  REAL, INTENT(OUT) ::  vcov(ijb_v:ije_v,llm)      !--- V COVARIANT WIND
34  REAL, INTENT(OUT) ::  ucov(ijb_u:ije_u,llm)      !--- U COVARIANT WIND
35  REAL, INTENT(OUT) ::  teta(ijb_u:ije_u,llm)      !--- POTENTIAL TEMP.
36  REAL, INTENT(OUT) ::     q(ijb_u:ije_u,llm,nqtot)!--- TRACERS
37  REAL, INTENT(OUT) :: masse(ijb_u:ije_u,llm)      !--- MASS PER CELL
38  REAL, INTENT(OUT) ::    ps(ijb_u:ije_u)          !--- GROUND PRESSURE
39  REAL, INTENT(OUT) ::  phis(ijb_u:ije_u)          !--- GEOPOTENTIAL
40!===============================================================================
41! Local variables:
[4120]42  CHARACTER(LEN=maxlen) :: mesg, var, modname, oldVar
[2299]43  INTEGER, PARAMETER :: length=100
[4301]44  INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase, ix
[4984]45  REAL    :: time,tab_cntrl(length)    !--- RUN PARAMS TABLE
46  REAL    :: tnat, alpha_ideal
[2299]47  REAL,             ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:),   ps_glo(:)
48  REAL,             ALLOCATABLE :: ucov_glo(:,:),    q_glo(:,:), phis_glo(:)
49  REAL,             ALLOCATABLE :: teta_glo(:,:)
[4301]50  LOGICAL :: lSkip, ll
[4984]51  LOGICAL,PARAMETER :: tnat1=.TRUE.
[2299]52!-------------------------------------------------------------------------------
53  modname="dynetat0_loc"
[1632]54
[2299]55!--- Initial state file opening
56  var=fichnom
[5100]57  CALL err(nf90_open(var,nf90_nowrite,fID),"open",var)
[2299]58  CALL get_var1("controle",tab_cntrl)
[1632]59
[2299]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
[4120]63    CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname)
[2299]64    idecal = 4
65    annee_ref  = 2000
66  ELSE
[4120]67    CALL msg('NOTE NOTE NOTE : Earth-like start files', modname)
[2299]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)
[5099]89
[2299]90  clon       = tab_cntrl(idecal+15)
91  clat       = tab_cntrl(idecal+16)
92  grossismx  = tab_cntrl(idecal+17)
93  grossismy  = tab_cntrl(idecal+18)
[5099]94
[2299]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
[1632]105
[2299]106  day_ini    = tab_cntrl(30)
107  itau_dyn   = tab_cntrl(31)
[2615]108  start_time = tab_cntrl(32)
[1632]109
[2299]110!-------------------------------------------------------------------------------
[4120]111  CALL msg('rad, omeg, g, cpp, kappa = '//TRIM(strStack(real2str([rad,omeg,g,cpp,kappa]))), modname)
[2299]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_var1("cu"  ,cu)
120  CALL get_var1("cv"  ,cv)
121  CALL get_var1("aire",aire)
[1632]122
[2299]123  var="temps"
[5101]124  IF(nf90_inq_varid(fID,var,vID)/=nf90_noerr) THEN
[4120]125    CALL msg('missing field <temps> ; trying with <Time>', modname)
126    var="Time"
[5101]127    CALL err(nf90_inq_varid(fID,var,vID),"inq",var)
[2299]128  END IF
[5099]129  CALL err(nf90_get_var(fID,vID,time),"get",var)
[1632]130
[2299]131  ALLOCATE(phis_glo(ip1jmp1))
132  CALL get_var1("phisinit",phis_glo)
133  phis (ijb_u:ije_u)  =phis_glo(ijb_u:ije_u);    DEALLOCATE(phis_glo)
[1632]134
[2299]135  ALLOCATE(ucov_glo(ip1jmp1,llm))
136  CALL get_var2("ucov",ucov_glo)
137  ucov (ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:);  DEALLOCATE(ucov_glo)
[1673]138
[2299]139  ALLOCATE(vcov_glo(ip1jm,llm))
140  CALL get_var2("vcov",vcov_glo)
141  vcov (ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:);  DEALLOCATE(vcov_glo)
[1632]142
[2299]143  ALLOCATE(teta_glo(ip1jmp1,llm))
144  CALL get_var2("teta",teta_glo)
145  teta (ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:);  DEALLOCATE(teta_glo)
[1632]146
[2299]147  ALLOCATE(masse_glo(ip1jmp1,llm))
148  CALL get_var2("masse",masse_glo)
149  masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:); DEALLOCATE(masse_glo)
150 
151  ALLOCATE(ps_glo(ip1jmp1))
152  CALL get_var1("ps",ps_glo)
153  ps   (ijb_u:ije_u)  =   ps_glo(ijb_u:ije_u);   DEALLOCATE(ps_glo)
[1632]154
[2299]155!--- Tracers
156  ALLOCATE(q_glo(ip1jmp1,llm))
[4301]157  ll = .FALSE.
[4263]158#ifdef REPROBUS
[5101]159  ll = nf90_inq_varid(fID, 'HNO3tot', vID) /= nf90_noerr                                 !--- DETECT OLD REPRO start.nc FILE
[4263]160#endif
[2299]161  DO iq=1,nqtot
[4120]162    var = tracers(iq)%name
[4301]163    oldVar = new2oldH2O(var)
164    lSkip = ll .AND. var == 'HNO3'                                                       !--- FORCE "HNO3_g" READING FOR "HNO3"
165#ifdef REPROBUS
166    ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix)                          !--- REPROBUS HNO3 exceptions
167#endif
[5091]168    IF (CPPKEY_INCA) THEN
169      IF(var == 'O3') oldVar = 'OX'                                                        !--- DEAL WITH INCA OZONE EXCEPTION
170    END IF
[4265]171    !--------------------------------------------------------------------------------------------------------------------------
[5101]172    IF(nf90_inq_varid(fID, var, vID) == nf90_noerr .AND. .NOT.lSkip) THEN                !=== REGULAR CASE: AVAILABLE VARIABLE
[4265]173      CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
174    !--------------------------------------------------------------------------------------------------------------------------
[5101]175    ELSE IF(nf90_inq_varid(fID, oldVar, vID) == nf90_noerr) THEN                         !=== TRY WITH ALTERNATE NAME
[4265]176      CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname)
177      CALL get_var2(oldVar, q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
178    !--------------------------------------------------------------------------------------------------------------------------
[4120]179    ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN                          !=== WATER ISOTOPES
[4143]180      iName    = tracers(iq)%iso_iName
[4120]181      iPhase   = tracers(iq)%iso_iPhase
182      iqParent = tracers(iq)%iqParent
183      IF(tracers(iq)%iso_iZone == 0) THEN
[4984]184         if (tnat1) then
185                 tnat=1.0
186                 alpha_ideal=1.0
187                 write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
188         else
189          IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
[4325]190            CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
[4984]191         endif
[4120]192         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname)
[4325]193         q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.)
[4490]194         ! Camille 9 mars 2023: point de vigilence: initialisation incohérente
195         ! avec celle de xt_ancien dans la physiq.
[4120]196      ELSE
197         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)
[4490]198         ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à
199         ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme
200         ! les parents. Sinon, c'est nul.
201         ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en
202         ! remplacant 1 par izone_init dans la ligne qui suit.
203         IF(tracers(iq)%iso_iZone == 1) THEN
[4984]204           q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
[4490]205         ELSE
206           q(ijb_u:ije_u,:,iq) =  0.
207         ENDIF
[4120]208      END IF
209    !--------------------------------------------------------------------------------------------------------------------------
210    ELSE                                                                                 !=== MISSING: SET TO 0
211      CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to zero', modname)
212      q(ijb_u:ije_u,:,iq)=0.
213    !--------------------------------------------------------------------------------------------------------------------------
[2299]214    END IF
215  END DO
216  DEALLOCATE(q_glo)
[5100]217  CALL err(nf90_close(fID),"close",fichnom)
[2299]218  day_ini=day_ini+INT(time)
219  time=time-INT(time)
[1673]220
221
[2299]222  CONTAINS
[1632]223
224
[2299]225SUBROUTINE check_dim(n1,n2,str1,str2)
226  INTEGER,          INTENT(IN) :: n1, n2
227  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
[4046]228  CHARACTER(LEN=maxlen) :: s1, s2
[4301]229  IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "'//TRIM(str1)//'" = '//TRIM(int2str(n1))// &
230   ' read in starting file differs from gcm value of "'//TRIM(str2)//'" = '//TRIM(int2str(n2)), 1)
[2299]231END SUBROUTINE check_dim
[1632]232
233
[2299]234SUBROUTINE get_var1(var,v)
235  CHARACTER(LEN=*), INTENT(IN)  :: var
236  REAL,             INTENT(OUT) :: v(:)
237  REAL,             ALLOCATABLE :: w2(:,:), w3(:,:,:)
238  INTEGER :: nn(3), dids(3), k, nd, ntot
[1632]239
[5101]240  CALL err(nf90_inq_varid(fID,var,vID),"inq",var)
241  ierr=nf90_inquire_variable(fID,vID,ndims=nd)
[2299]242  IF(nd==1) THEN
[5099]243    CALL err(nf90_get_var(fID,vID,v),"get",var); RETURN
[2299]244  END IF
[5101]245  ierr=nf90_inquire_variable(fID,vID,dimids=dids)
[5099]246  DO k=1,nd; ierr=nf90_inquire_dimension(fID,dids(k),len=nn(k)); END DO
[2299]247  ntot=PRODUCT(nn(1:nd))
248  SELECT CASE(nd)
249    CASE(2); ALLOCATE(w2(nn(1),nn(2)))
[5099]250      CALL err(nf90_get_var(fID,vID,w2),"get",var)
[2299]251      v=RESHAPE(w2,[ntot]); DEALLOCATE(w2)
252    CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
[5099]253      CALL err(nf90_get_var(fID,vID,w3),"get",var)
[2299]254      v=RESHAPE(w3,[ntot]); DEALLOCATE(w3)
255  END SELECT
256END SUBROUTINE get_var1
[1632]257
[2299]258SUBROUTINE get_var2(var,v)
259  CHARACTER(LEN=*), INTENT(IN)  :: var
260  REAL,             INTENT(OUT) :: v(:,:)
[3967]261  REAL,             ALLOCATABLE :: w4(:,:,:,:), w3(:,:,:)
[2299]262  INTEGER :: nn(4), dids(4), k, nd
[3967]263
264
[5101]265  CALL err(nf90_inq_varid(fID,var,vID),"inq",var)
266  ierr=nf90_inquire_variable(fID,vID,ndims=nd)
[3967]267
268  IF(nd==1) THEN
[5099]269    CALL err(nf90_get_var(fID,vID,v),"get",var); RETURN
[3967]270  END IF
[5101]271  ierr=nf90_inquire_variable(fID,vID,dimids=dids)
[3967]272
[5099]273  DO k=1,nd; ierr=nf90_inquire_dimension(fID,dids(k),len=nn(k)); END DO
[3967]274
275  SELECT CASE(nd)
276  CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
[5099]277     CALL err(nf90_get_var(fID,vID,w3),"get",var)
[3967]278     v=RESHAPE(w3,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w3)
279  CASE(4);  ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4)))
[5099]280     CALL err(nf90_get_var(fID,vID,w4),"get",var)
[3967]281     v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4)
282  END SELECT
[2299]283END SUBROUTINE get_var2
[1632]284
285
[2299]286SUBROUTINE err(ierr,typ,nam)
287  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
288  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
289  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
[5099]290  IF(ierr==nf90_noerr) RETURN
[2299]291  SELECT CASE(typ)
[4120]292    CASE('inq');   mesg="Field <"//TRIM(nam)//"> is missing"
293    CASE('get');   mesg="Reading failed for <"//TRIM(nam)//">"
294    CASE('open');  mesg="File opening failed for <"//TRIM(nam)//">"
295    CASE('close'); mesg="File closing failed for <"//TRIM(nam)//">"
[2299]296  END SELECT
[4120]297  CALL ABORT_gcm(TRIM(modname),TRIM(mesg),ierr)
[2299]298END SUBROUTINE err
[1632]299
[2299]300END SUBROUTINE dynetat0_loc
Note: See TracBrowser for help on using the repository browser.