source: LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90 @ 5100

Last change on this file since 5100 was 5100, checked in by abarral, 4 months ago

Remove CPP_1D key. It was used once in a single file to wrap a whole internal module -> can't even compile if key is enabled.
(lint) Set NF90_* to lowercase
File size: 10.1 KB
RevLine 
[2293]1SUBROUTINE dynetat0(fichnom,vcov,ucov,teta,q,masse,ps,phis,time)
[5099]2
[2293]3!-------------------------------------------------------------------------------
4! Authors: P. Le Van , L.Fairhead
5!-------------------------------------------------------------------------------
6! Purpose: Initial state reading.
7!-------------------------------------------------------------------------------
[4325]8  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
[4193]9  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str
[5100]10  USE netcdf,      ONLY: nf90_open,  nf90_nowrite, NF90_INQ_VARID, &
11                         nf90_close, nf90_get_var, nf90_noerr
[4325]12  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
[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
[5091]21  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
[2600]22
[2293]23  IMPLICIT NONE
24  include "dimensions.h"
25  include "paramet.h"
26  include "comgeom2.h"
27  include "description.h"
28  include "iniprint.h"
29!===============================================================================
30! Arguments:
31  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
32  REAL, INTENT(OUT) ::  vcov(iip1,jjm, llm)        !--- V COVARIANT WIND
33  REAL, INTENT(OUT) ::  ucov(iip1,jjp1,llm)        !--- U COVARIANT WIND
34  REAL, INTENT(OUT) ::  teta(iip1,jjp1,llm)        !--- POTENTIAL TEMP.
35  REAL, INTENT(OUT) ::     q(iip1,jjp1,llm,nqtot)  !--- TRACERS
36  REAL, INTENT(OUT) :: masse(iip1,jjp1,llm)        !--- MASS PER CELL
37  REAL, INTENT(OUT) ::    ps(iip1,jjp1)            !--- GROUND PRESSURE
38  REAL, INTENT(OUT) ::  phis(iip1,jjp1)            !--- GEOPOTENTIAL
39!===============================================================================
40! Local variables:
[4120]41  CHARACTER(LEN=maxlen) :: mesg, var, modname, oldVar
[2293]42  INTEGER, PARAMETER :: length=100
[4050]43  INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase
[4325]44  REAL    :: time, tnat, alpha_ideal, tab_cntrl(length)    !--- RUN PARAMS TABLE
[4301]45  LOGICAL :: lSkip, ll
[4984]46  LOGICAL,PARAMETER :: tnat1=.TRUE.
[2293]47!-------------------------------------------------------------------------------
48  modname="dynetat0"
49
50!--- Initial state file opening
51  var=fichnom
[5100]52  CALL err(nf90_open(var,nf90_nowrite,fID),"open",var)
[2293]53  CALL get_var1("controle",tab_cntrl)
54
55!!! AS: idecal is a hack to be able to read planeto starts...
56!!!     .... while keeping everything OK for LMDZ EARTH
57  IF(planet_type=="generic") THEN
[4120]58    CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname)
[2293]59    idecal = 4
60    annee_ref  = 2000
61  ELSE
[4120]62    CALL msg('NOTE NOTE NOTE : Earth-like start files', modname)
[2293]63    idecal = 5
64    annee_ref  = tab_cntrl(5)
65  END IF
66  im         = tab_cntrl(1)
67  jm         = tab_cntrl(2)
68  lllm       = tab_cntrl(3)
69  day_ref    = tab_cntrl(4)
70  rad        = tab_cntrl(idecal+1)
71  omeg       = tab_cntrl(idecal+2)
72  g          = tab_cntrl(idecal+3)
73  cpp        = tab_cntrl(idecal+4)
74  kappa      = tab_cntrl(idecal+5)
75  daysec     = tab_cntrl(idecal+6)
76  dtvr       = tab_cntrl(idecal+7)
77  etot0      = tab_cntrl(idecal+8)
78  ptot0      = tab_cntrl(idecal+9)
79  ztot0      = tab_cntrl(idecal+10)
80  stot0      = tab_cntrl(idecal+11)
81  ang0       = tab_cntrl(idecal+12)
82  pa         = tab_cntrl(idecal+13)
83  preff      = tab_cntrl(idecal+14)
[5099]84
[2293]85  clon       = tab_cntrl(idecal+15)
86  clat       = tab_cntrl(idecal+16)
87  grossismx  = tab_cntrl(idecal+17)
88  grossismy  = tab_cntrl(idecal+18)
[5099]89
[2293]90  IF ( tab_cntrl(idecal+19)==1. )  THEN
91    fxyhypb  = .TRUE.
92!   dzoomx   = tab_cntrl(25)
93!   dzoomy   = tab_cntrl(26)
94!   taux     = tab_cntrl(28)
95!   tauy     = tab_cntrl(29)
96  ELSE
97    fxyhypb = .FALSE.
98    ysinus  = tab_cntrl(idecal+22)==1.
99  END IF
100
101  day_ini    = tab_cntrl(30)
102  itau_dyn   = tab_cntrl(31)
103  start_time = tab_cntrl(32)
104
105!-------------------------------------------------------------------------------
[4120]106  CALL msg('rad, omeg, g, cpp, kappa = '//TRIM(strStack(real2str([rad,omeg,g,cpp,kappa]))), modname)
[2293]107  CALL check_dim(im,iim,'im','im')
108  CALL check_dim(jm,jjm,'jm','jm')
109  CALL check_dim(lllm,llm,'lm','lllm')
110  CALL get_var1("rlonu",rlonu)
111  CALL get_var1("rlatu",rlatu)
112  CALL get_var1("rlonv",rlonv)
113  CALL get_var1("rlatv",rlatv)
114  CALL get_var2("cu"   ,cu)
115  CALL get_var2("cv"   ,cv)
116  CALL get_var2("aire" ,aire)
117  var="temps"
[5099]118  IF(NF90_INQ_VARID(fID,var,vID)/=nf90_noerr) THEN
[4120]119    CALL msg('missing field <temps> ; trying with <Time>', modname)
120    var="Time"
[2293]121    CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
122  END IF
[5099]123  CALL err(nf90_get_var(fID,vID,time),"get",var)
[2299]124  CALL get_var2("phisinit",phis)
[2293]125  CALL get_var3("ucov",ucov)
126  CALL get_var3("vcov",vcov)
127  CALL get_var3("teta",teta)
128  CALL get_var3("masse",masse)
129  CALL get_var2("ps",ps)
130
131!--- Tracers
[4268]132  ll=.FALSE.
[4265]133#ifdef REPROBUS
[5099]134  ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= nf90_noerr                                 !--- DETECT OLD REPRO start.nc FILE
[4265]135#endif
[2293]136  DO iq=1,nqtot
[4120]137    var = tracers(iq)%name
[4301]138    oldVar = new2oldH2O(var)
139    lSkip = ll .AND. var == 'HNO3'                                                       !--- FORCE "HNO3_g" READING FOR "HNO3"
140#ifdef REPROBUS
141    ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix)                          !--- REPROBUS HNO3 exceptions
142#endif
[5091]143    IF (CPPKEY_INCA) THEN
144      IF(var == 'O3') oldVar = 'OX'                                                        !--- DEAL WITH INCA OZONE EXCEPTION
145    END IF
[4120]146    !--------------------------------------------------------------------------------------------------------------------------
[5099]147    IF(NF90_INQ_VARID(fID, var, vID) == nf90_noerr .AND. .NOT.lSkip) THEN                !=== REGULAR CASE: AVAILABLE VARIABLE
148      CALL err(nf90_get_var(fID,vID,q(:,:,:,iq)),"get",var)
[4120]149    !--------------------------------------------------------------------------------------------------------------------------
[5099]150    ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == nf90_noerr) THEN                         !=== TRY WITH ALTERNATE NAME
[4120]151      CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname)
[5099]152      CALL err(nf90_get_var(fID,vID,q(:,:,:,iq)),"get",oldVar)
[4120]153    !--------------------------------------------------------------------------------------------------------------------------
154    ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN                          !=== WATER ISOTOPES
[4143]155      iName    = tracers(iq)%iso_iName
[4120]156      iPhase   = tracers(iq)%iso_iPhase
157      iqParent = tracers(iq)%iqParent
158      IF(tracers(iq)%iso_iZone == 0) THEN
[4984]159         if (tnat1) then
160                 tnat=1.0
161                 alpha_ideal=1.0
162                 write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
163         else
164          IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
[4325]165            CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
[4984]166         endif
[4120]167         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname)
[4325]168         q(:,:,:,iq) = q(:,:,:,iqParent)*tnat*(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal-1.)
[4120]169      ELSE
170         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)
[4492]171         ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à
172         ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme
173         ! les parents. Sinon, c'est nul.
174         ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en
175         ! remplacant 1 par izone_init dans la ligne qui suit.
176         IF(tracers(iq)%iso_iZone == 1) THEN
177           q(:,:,:,iq) = q(:,:,:,iqIsoPha(iName,iPhase))
178         ELSE
179           q(:,:,:,iq) = 0.
180         END IF
[4120]181      END IF
182    !--------------------------------------------------------------------------------------------------------------------------
183    ELSE                                                                                 !=== MISSING: SET TO 0
184      CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to zero', modname)
185      q(:,:,:,iq)=0.
186    !--------------------------------------------------------------------------------------------------------------------------
[2293]187    END IF
188  END DO
189
[5100]190  CALL err(nf90_close(fID),"close",fichnom)
[2293]191  day_ini=day_ini+INT(time)
192  time=time-INT(time)
193
194
195  CONTAINS
196
197
198SUBROUTINE check_dim(n1,n2,str1,str2)
199  INTEGER,          INTENT(IN) :: n1, n2
200  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
[4046]201  CHARACTER(LEN=maxlen) :: s1, s2
[4193]202  IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "'//TRIM(str1)//'" = '//TRIM(int2str(n1))// &
203   ' read in starting file differs from gcm value of "'//TRIM(str2)//'" = '//TRIM(int2str(n2)), 1)
[2293]204END SUBROUTINE check_dim
205
206
207SUBROUTINE get_var1(var,v)
208  CHARACTER(LEN=*), INTENT(IN)  :: var
209  REAL,             INTENT(OUT) :: v(:)
210  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
[5099]211  CALL err(nf90_get_var(fID,vID,v),"get",var)
[2293]212END SUBROUTINE get_var1
213
214
215SUBROUTINE get_var2(var,v)
216  CHARACTER(LEN=*), INTENT(IN)  :: var
217  REAL,             INTENT(OUT) :: v(:,:)
218  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
[5099]219  CALL err(nf90_get_var(fID,vID,v),"get",var)
[2293]220END SUBROUTINE get_var2
221
222
223SUBROUTINE get_var3(var,v)
224  CHARACTER(LEN=*), INTENT(IN)  :: var
225  REAL,             INTENT(OUT) :: v(:,:,:)
226  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
[5099]227  CALL err(nf90_get_var(fID,vID,v),"get",var)
[2293]228END SUBROUTINE get_var3
229
230
231SUBROUTINE err(ierr,typ,nam)
232  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
233  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
234  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
[5099]235  IF(ierr==nf90_noerr) RETURN
[2293]236  SELECT CASE(typ)
[4120]237    CASE('inq');   mesg="Field <"//TRIM(nam)//"> is missing"
238    CASE('get');   mesg="Reading failed for <"//TRIM(nam)//">"
239    CASE('open');  mesg="File opening failed for <"//TRIM(nam)//">"
240    CASE('close'); mesg="File closing failed for <"//TRIM(nam)//">"
[2293]241  END SELECT
[4120]242  CALL ABORT_gcm(TRIM(modname),TRIM(mesg),ierr)
[2293]243END SUBROUTINE err
244
245END SUBROUTINE dynetat0
Note: See TracBrowser for help on using the repository browser.