Changeset 1889 for trunk/LMDZ.TITAN/libf/dynphy_lonlat

Timestamp:

Jan 9, 2018, 12:26:53 PM (7 years ago)

Author:

jvatant

Message:

Making chemistry handling more flexible - Step 2
+ Added the calculation of the pressure grid in newstart
using Vervack profile in gr_kim_vervack routine
+ Next step : regridding !
--JVO

Location:

trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan

Files:

• gr_kim_vervack.F90 (added)
• lect_start_archive.F (modified) (8 diffs)
• newstart.F (modified) (7 diffs)

trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/lect_start_archive.F

@@ -5 +5 @@
 
 !      USE surfdat_h
+      USE comchem_h, ONLY: nlaykimold, preskimold
       USE comsoil_h, ONLY: nsoilmx, layer, mlayer, volcapa, inertiedat
       USE infotrac, ONLY: tname, nqtot
@@ -46 +47 @@
 c------------------------------------
       INTEGER   imold,jmold,lmold,nsoilold,nqold
-
 
 c Variables pour les lectures des fichiers "ini" 
@@ -147 +147 @@
       real, dimension(:,:), allocatable :: emisold
       real, dimension(:,:,:,:), allocatable :: qold
-
+      
       real tab_cntrl(100)
 
@@ -158 +158 @@
       logical :: therminertia_3D=.true. ! flag
 ! therminertia_3D=.true. if thermal inertia is 3D and read from datafile
+
 c Variable intermediaires iutilise pour l'extrapolation verticale 
 c----------------------------------------------------------------
@@ -247 +248 @@
       endif
 
-
       if (nsoilold.ne.nsoilmx) then ! interpolation will be required
         depthinterpol=.true.
       endif
+
+! 1.2.2 find out the # of upper chemistry layers
+
+      ierr= NF_INQ_DIMID(nid,"upper_chemistry_layers",dimid)
+      ierr= NF_INQ_DIMLEN(nid,dimid,nlaykimold)
+
+      ! NB : The regriding, if needed cannot be done here since the new
+      ! pressure grid is only computed at the end of newstart
 
 ! 1.3 Report dimensions
@@ -266 +274 @@
       write(*,*) '  Otherwise, set nsoilmx -in dimphys.h- to: ',nsoilold
       endif
+      write(*,*) "upper_chemistry_layers: ",nlaykimold
       write(*,*) "time lenght: ",timelen
       write(*,*) 
@@ -295 +304 @@
       allocate(mlayerold(nsoilold))
       allocate(qsurfold(imold+1,jmold+1,nqtot))
+      
+      allocate(preskimold(nlaykimold))
 
       allocate(var (imold+1,jmold+1,llm))
@@ -512 +523 @@
        endif
       endif
-
-c-----------------------------------------------------------------------
-c 3.6 Lecture geopotentiel au sol
+      
+c-----------------------------------------------------------------------
+c 3.6 Read upper chemistry mid-layer pressure
+c-----------------------------------------------------------------------  
+    
+      ierr=NF_INQ_VARID(nid,"preskim",nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <preskim> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, preskimold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, preskimold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <preskim>"
+         CALL abort
+      ENDIF
+
+c-----------------------------------------------------------------------
+c 3.7 Lecture geopotentiel au sol
 c-----------------------------------------------------------------------
 c

trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/newstart.F

@@ -17 +17 @@
      &                              is_master
       use infotrac, only: infotrac_init, nqtot, tname
+      USE comchem_h, ONLY: nlaykim_up, nlaykimold
       USE comsoil_h, ONLY: nsoilmx, layer, mlayer, inertiedat
       USE surfdat_h, ONLY: phisfi, albedodat,
@@ -130 +131 @@
       real tab_cntrl(100)
       real tab_cntrl_bis(100)
-
+      
 c variables diverses
 c-------------------
@@ -258 +259 @@
 
       endif
-
 
 c=======================================================================
@@ -536 +536 @@
         CALL lect_start_archive(ngridmx,llm,
      &   date,tsurf,tsoil,emis,q2,
-     &   t,ucov,vcov,ps,teta,phisold_newgrid,q,qsurf,
-     &   surfith,nid)
+     &   t,ucov,vcov,ps,teta,phisold_newgrid,
+     &   q,qsurf,surfith,nid)
         write(*,*) "OK, read start_archive file"
         ! copy soil thermal inertia
@@ -572 +572 @@
       write(*,*) 'q=x : give a specific uniform value to one tracer'
       write(*,*) 'q=profile    : specify a profile for a tracer'
-!      write(*,*) 'ini_q : tracers initialisation for chemistry, water an
-!     $d ice   '
-!      write(*,*) 'ini_q-H2O : tracers initialisation for chemistry and 
-!     $ice '
-!      write(*,*) 'ini_q-iceH2O : tracers initialisation for chemistry on
-!     $ly '
       write(*,*) 'isotherm  : Isothermal Temperatures, wind set to zero'
       write(*,*) 'radequi   : Earth-like radiative equilibrium temperature
@@ -1071 +1065 @@
       CALL inifilr 
       CALL pression(ip1jmp1, ap, bp, ps, p3d)
+      
+
+c=========================================================================
+c  Calcul de la dimension verticale pour la chimie  - JVO 2017
+c  start_archive seulement, la grille verticale pouvant avoir ete modifiee
+c==========================================================================
+
+      IF (choix_1.eq.0) THEN
+
+        ! Calculate the # of upper chemistry layers with the "new" pressure grid
+        ! For this we use Vervack profile for upper atmosphere with dz=10km
+
+        CALL gr_kim_vervack
+
+        WRITE(*,*)
+        WRITE(*,*) " With the compiled vertical grid we found :"
+        WRITE(*,*) " Number of upper chemistry layers =", nlaykim_up
+        
+        ! Regriding is then done, if needed
+        
+        IF (nlaykimold.ne.nlaykim_up) THEN
+
+          WRITE(*,*) " Warning, nlaykimold=", nlaykimold
+          WRITE(*,*) ' which implies that a regriding on upper chemistry
+     & will be performed.'
+          WRITE(*,*)
+          
+!          CALL  regrid_kim
+          
+        ENDIF
+ 
+      endif ! of if (choix_1.eq.0)      
+ 
 
 c-----------------------------------------------------------------------
@@ -1125 +1152 @@
          day_ini=int(date)
       endif
+
 c
       CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )