source: LMDZ6/branches/cirrus/libf/dyn3dmem/dynetat0_loc.F90 @ 5210

Last change on this file since 5210 was 5203, checked in by Laurent Fairhead, 7 weeks ago

Merge with trunk revision 5202 before reintegration to trunk
  • 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)
[1632]2!
[2299]3!-------------------------------------------------------------------------------
4! Authors: P. Le Van , L.Fairhead
5!-------------------------------------------------------------------------------
6! Purpose: Initial state reading.
7!-------------------------------------------------------------------------------
8  USE parallel_lmdz
[5203]9  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName, &
10                         new2oldH2O, newHNO3, oldHNO3, getKey
[4436]11  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx
[4120]12  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, &
13                         NF90_CLOSE, NF90_GET_VAR, NF90_INQUIRE_VARIABLE,  NF90_NoErr
[2299]14  USE control_mod, ONLY: planet_type
15  USE assert_eq_m, 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
[5203]22#ifdef CPP_IOIPSL
23  USE IOIPSL,   ONLY: getin
24#else
25  USE ioipsl_getincom, ONLY: getin
26#endif
[4120]27
[2299]28  IMPLICIT NONE
29  include "dimensions.h"
30  include "paramet.h"
31  include "comgeom.h"
32  include "description.h"
33  include "iniprint.h"
34!===============================================================================
35! Arguments:
36  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
37  REAL, INTENT(OUT) ::  vcov(ijb_v:ije_v,llm)      !--- V COVARIANT WIND
38  REAL, INTENT(OUT) ::  ucov(ijb_u:ije_u,llm)      !--- U COVARIANT WIND
39  REAL, INTENT(OUT) ::  teta(ijb_u:ije_u,llm)      !--- POTENTIAL TEMP.
40  REAL, INTENT(OUT) ::     q(ijb_u:ije_u,llm,nqtot)!--- TRACERS
41  REAL, INTENT(OUT) :: masse(ijb_u:ije_u,llm)      !--- MASS PER CELL
42  REAL, INTENT(OUT) ::    ps(ijb_u:ije_u)          !--- GROUND PRESSURE
43  REAL, INTENT(OUT) ::  phis(ijb_u:ije_u)          !--- GEOPOTENTIAL
44!===============================================================================
45! Local variables:
[4120]46  CHARACTER(LEN=maxlen) :: mesg, var, modname, oldVar
[2299]47  INTEGER, PARAMETER :: length=100
[4301]48  INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase, ix
[5202]49  REAL    :: time,tab_cntrl(length)    !--- RUN PARAMS TABLE
50  REAL    :: tnat, alpha_ideal
[2299]51  REAL,             ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:),   ps_glo(:)
52  REAL,             ALLOCATABLE :: ucov_glo(:,:),    q_glo(:,:), phis_glo(:)
53  REAL,             ALLOCATABLE :: teta_glo(:,:)
[5203]54  LOGICAL :: lSkip, ll, ltnat1
[2299]55!-------------------------------------------------------------------------------
56  modname="dynetat0_loc"
[1632]57
[2299]58!--- Initial state file opening
59  var=fichnom
60  CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)
61  CALL get_var1("controle",tab_cntrl)
[1632]62
[2299]63!!! AS: idecal is a hack to be able to read planeto starts...
64!!!     .... while keeping everything OK for LMDZ EARTH
65  IF(planet_type=="generic") THEN
[4120]66    CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname)
[2299]67    idecal = 4
68    annee_ref  = 2000
69  ELSE
[4120]70    CALL msg('NOTE NOTE NOTE : Earth-like start files', modname)
[2299]71    idecal = 5
72    annee_ref  = tab_cntrl(5)
73  END IF
74  im         = tab_cntrl(1)
75  jm         = tab_cntrl(2)
76  lllm       = tab_cntrl(3)
77  day_ref    = tab_cntrl(4)
78  rad        = tab_cntrl(idecal+1)
79  omeg       = tab_cntrl(idecal+2)
80  g          = tab_cntrl(idecal+3)
81  cpp        = tab_cntrl(idecal+4)
82  kappa      = tab_cntrl(idecal+5)
83  daysec     = tab_cntrl(idecal+6)
84  dtvr       = tab_cntrl(idecal+7)
85  etot0      = tab_cntrl(idecal+8)
86  ptot0      = tab_cntrl(idecal+9)
87  ztot0      = tab_cntrl(idecal+10)
88  stot0      = tab_cntrl(idecal+11)
89  ang0       = tab_cntrl(idecal+12)
90  pa         = tab_cntrl(idecal+13)
91  preff      = tab_cntrl(idecal+14)
92!
93  clon       = tab_cntrl(idecal+15)
94  clat       = tab_cntrl(idecal+16)
95  grossismx  = tab_cntrl(idecal+17)
96  grossismy  = tab_cntrl(idecal+18)
97!
98  IF ( tab_cntrl(idecal+19)==1. )  THEN
99    fxyhypb  = .TRUE.
100!   dzoomx   = tab_cntrl(25)
101!   dzoomy   = tab_cntrl(26)
102!   taux     = tab_cntrl(28)
103!   tauy     = tab_cntrl(29)
104  ELSE
105    fxyhypb = .FALSE.
106    ysinus  = tab_cntrl(idecal+22)==1.
107  END IF
[1632]108
[2299]109  day_ini    = tab_cntrl(30)
110  itau_dyn   = tab_cntrl(31)
[2615]111  start_time = tab_cntrl(32)
[1632]112
[2299]113!-------------------------------------------------------------------------------
[4120]114  CALL msg('rad, omeg, g, cpp, kappa = '//TRIM(strStack(real2str([rad,omeg,g,cpp,kappa]))), modname)
[2299]115  CALL check_dim(im,iim,'im','im')
116  CALL check_dim(jm,jjm,'jm','jm')
117  CALL check_dim(lllm,llm,'lm','lllm')
118  CALL get_var1("rlonu",rlonu)
119  CALL get_var1("rlatu",rlatu)
120  CALL get_var1("rlonv",rlonv)
121  CALL get_var1("rlatv",rlatv)
122  CALL get_var1("cu"  ,cu)
123  CALL get_var1("cv"  ,cv)
124  CALL get_var1("aire",aire)
[1632]125
[2299]126  var="temps"
127  IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
[4120]128    CALL msg('missing field <temps> ; trying with <Time>', modname)
129    var="Time"
[2299]130    CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
131  END IF
132  CALL err(NF90_GET_VAR(fID,vID,time),"get",var)
[1632]133
[2299]134  ALLOCATE(phis_glo(ip1jmp1))
135  CALL get_var1("phisinit",phis_glo)
136  phis (ijb_u:ije_u)  =phis_glo(ijb_u:ije_u);    DEALLOCATE(phis_glo)
[1632]137
[2299]138  ALLOCATE(ucov_glo(ip1jmp1,llm))
139  CALL get_var2("ucov",ucov_glo)
140  ucov (ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:);  DEALLOCATE(ucov_glo)
[1673]141
[2299]142  ALLOCATE(vcov_glo(ip1jm,llm))
143  CALL get_var2("vcov",vcov_glo)
144  vcov (ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:);  DEALLOCATE(vcov_glo)
[1632]145
[2299]146  ALLOCATE(teta_glo(ip1jmp1,llm))
147  CALL get_var2("teta",teta_glo)
148  teta (ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:);  DEALLOCATE(teta_glo)
[1632]149
[2299]150  ALLOCATE(masse_glo(ip1jmp1,llm))
151  CALL get_var2("masse",masse_glo)
152  masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:); DEALLOCATE(masse_glo)
153 
154  ALLOCATE(ps_glo(ip1jmp1))
155  CALL get_var1("ps",ps_glo)
156  ps   (ijb_u:ije_u)  =   ps_glo(ijb_u:ije_u);   DEALLOCATE(ps_glo)
[1632]157
[2299]158!--- Tracers
159  ALLOCATE(q_glo(ip1jmp1,llm))
[4301]160  ll = .FALSE.
[4263]161#ifdef REPROBUS
[4301]162  ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= NF90_NoErr                                 !--- DETECT OLD REPRO start.nc FILE
[4263]163#endif
[5203]164  ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
[2299]165  DO iq=1,nqtot
[4120]166    var = tracers(iq)%name
[4301]167    oldVar = new2oldH2O(var)
168    lSkip = ll .AND. var == 'HNO3'                                                       !--- FORCE "HNO3_g" READING FOR "HNO3"
169#ifdef REPROBUS
170    ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix)                          !--- REPROBUS HNO3 exceptions
171#endif
172#ifdef INCA
173    IF(var == 'O3') oldVar = 'OX'                                                        !--- DEAL WITH INCA OZONE EXCEPTION
174#endif
[4265]175    !--------------------------------------------------------------------------------------------------------------------------
[4301]176    IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr .AND. .NOT.lSkip) THEN                !=== REGULAR CASE: AVAILABLE VARIABLE
[4265]177      CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
178    !--------------------------------------------------------------------------------------------------------------------------
[4301]179    ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN                         !=== TRY WITH ALTERNATE NAME
[5203]180      CALL msg('Missing tracer <'//TRIM(var)//'> => initialized to <'//TRIM(oldVar)//'>', modname)
[4265]181      CALL get_var2(oldVar, q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
182    !--------------------------------------------------------------------------------------------------------------------------
[4120]183    ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN                          !=== WATER ISOTOPES
[4143]184      iName    = tracers(iq)%iso_iName
[4120]185      iPhase   = tracers(iq)%iso_iPhase
186      iqParent = tracers(iq)%iqParent
187      IF(tracers(iq)%iso_iZone == 0) THEN
[5203]188         IF(ltnat1) THEN
189            tnat = 1.0
190            alpha_ideal = 1.0
191            CALL msg(' !!!  Beware: alpha_ideal put to 1  !!!', modname)
192         ELSE
[5202]193          IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
[4325]194            CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
[5203]195         END IF
196         CALL msg('Missing tracer <'//TRIM(var)//'> => initialized with a simplified Rayleigh distillation law.', modname)
[4325]197         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]198         ! Camille 9 mars 2023: point de vigilence: initialisation incohérente
199         ! avec celle de xt_ancien dans la physiq.
[4120]200      ELSE
[5203]201         CALL msg('Missing tracer <'//TRIM(var)//'> => initialized to its parent isotope concentration.', modname)
[4490]202         ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à
203         ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme
204         ! les parents. Sinon, c'est nul.
205         ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en
206         ! remplacant 1 par izone_init dans la ligne qui suit.
207         IF(tracers(iq)%iso_iZone == 1) THEN
[5202]208           q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
[4490]209         ELSE
210           q(ijb_u:ije_u,:,iq) =  0.
211         ENDIF
[4120]212      END IF
213    !--------------------------------------------------------------------------------------------------------------------------
214    ELSE                                                                                 !=== MISSING: SET TO 0
[5203]215      CALL msg('missing tracer <'//TRIM(var)//'> => initialized to zero', modname)
[4120]216      q(ijb_u:ije_u,:,iq)=0.
217    !--------------------------------------------------------------------------------------------------------------------------
[2299]218    END IF
219  END DO
220  DEALLOCATE(q_glo)
221  CALL err(NF90_CLOSE(fID),"close",fichnom)
222  day_ini=day_ini+INT(time)
223  time=time-INT(time)
[1673]224
225
[2299]226  CONTAINS
[1632]227
228
[2299]229SUBROUTINE check_dim(n1,n2,str1,str2)
230  INTEGER,          INTENT(IN) :: n1, n2
231  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
[4046]232  CHARACTER(LEN=maxlen) :: s1, s2
[4301]233  IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "'//TRIM(str1)//'" = '//TRIM(int2str(n1))// &
234   ' read in starting file differs from gcm value of "'//TRIM(str2)//'" = '//TRIM(int2str(n2)), 1)
[2299]235END SUBROUTINE check_dim
[1632]236
237
[2299]238SUBROUTINE get_var1(var,v)
239  CHARACTER(LEN=*), INTENT(IN)  :: var
240  REAL,             INTENT(OUT) :: v(:)
241  REAL,             ALLOCATABLE :: w2(:,:), w3(:,:,:)
242  INTEGER :: nn(3), dids(3), k, nd, ntot
[1632]243
[2299]244  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
245  ierr=NF90_INQUIRE_VARIABLE(fID,vID,ndims=nd)
246  IF(nd==1) THEN
247    CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN
248  END IF
249  ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids)
250  DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO
251  ntot=PRODUCT(nn(1:nd))
252  SELECT CASE(nd)
253    CASE(2); ALLOCATE(w2(nn(1),nn(2)))
254      CALL err(NF90_GET_VAR(fID,vID,w2),"get",var)
255      v=RESHAPE(w2,[ntot]); DEALLOCATE(w2)
256    CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
257      CALL err(NF90_GET_VAR(fID,vID,w3),"get",var)
258      v=RESHAPE(w3,[ntot]); DEALLOCATE(w3)
259  END SELECT
260END SUBROUTINE get_var1
[1632]261
[2299]262SUBROUTINE get_var2(var,v)
263  CHARACTER(LEN=*), INTENT(IN)  :: var
264  REAL,             INTENT(OUT) :: v(:,:)
[3967]265  REAL,             ALLOCATABLE :: w4(:,:,:,:), w3(:,:,:)
[2299]266  INTEGER :: nn(4), dids(4), k, nd
[3967]267
268
[2299]269  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
[3967]270  ierr=NF90_INQUIRE_VARIABLE(fID,vID,ndims=nd)
271
272  IF(nd==1) THEN
273    CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN
274  END IF
275  ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids)
276
[2299]277  DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO
[3967]278
279  SELECT CASE(nd)
280  CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
281     CALL err(NF90_GET_VAR(fID,vID,w3),"get",var)
282     v=RESHAPE(w3,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w3)
283  CASE(4);  ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4)))
284     CALL err(NF90_GET_VAR(fID,vID,w4),"get",var)
285     v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4)
286  END SELECT
[2299]287END SUBROUTINE get_var2
[1632]288
289
[2299]290SUBROUTINE err(ierr,typ,nam)
291  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
292  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
293  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
294  IF(ierr==NF90_NoERR) RETURN
295  SELECT CASE(typ)
[4120]296    CASE('inq');   mesg="Field <"//TRIM(nam)//"> is missing"
297    CASE('get');   mesg="Reading failed for <"//TRIM(nam)//">"
298    CASE('open');  mesg="File opening failed for <"//TRIM(nam)//">"
299    CASE('close'); mesg="File closing failed for <"//TRIM(nam)//">"
[2299]300  END SELECT
[4120]301  CALL ABORT_gcm(TRIM(modname),TRIM(mesg),ierr)
[2299]302END SUBROUTINE err
[1632]303
[2299]304END SUBROUTINE dynetat0_loc
Note: See TracBrowser for help on using the repository browser.