Changeset 4293 for LMDZ6/trunk/libf

Timestamp:

Oct 4, 2022, 9:42:41 PM (2 years ago)

Author:

dcugnet

Message:

Commit for Nicolas: fixes for StratAer?.

Location:

LMDZ6/trunk/libf/phylmd

Files:

• StratAer/calcaerosolstrato_rrtm.F90 (modified) (1 diff)
• StratAer/micphy_tstep.F90 (modified) (4 diffs)
• StratAer/nucleation_tstep_mod.F90 (modified) (1 diff)
• StratAer/strataer_mod.F90 (modified) (9 diffs)
• StratAer/traccoag_mod.F90 (modified) (3 diffs)
• infotrac_phy.F90 (modified) (1 diff)
• phys_output_write_mod.F90 (modified) (1 diff)
• phytrac_mod.F90 (modified) (1 diff)

LMDZ6/trunk/libf/phylmd/StratAer/calcaerosolstrato_rrtm.F90

@@ -16 +16 @@
   INCLUDE "clesphys.h"
   INCLUDE "paramet.h"
-  INCLUDE "thermcell.h"
   INCLUDE "iniprint.h"
 

LMDZ6/trunk/libf/phylmd/StratAer/micphy_tstep.F90

@@ -7 +7 @@
   USE dimphy, ONLY : klon,klev
   USE aerophys
-  USE infotrac_phy
+  USE infotrac_phy, ONLY : nbtr_bin, nbtr_sulgas, nbtr, id_H2SO4_strat
   USE phys_local_var_mod, ONLY: mdw, budg_3D_nucl, budg_3D_cond_evap, budg_h2so4_to_part, R2SO4, DENSO4, f_r_wet
   USE nucleation_tstep_mod
@@ -47 +47 @@
   REAL ASO4(nbtr_bin)
   REAL DNDR(nbtr_bin)
-  REAL H2SO4_sat(nbtr_bin)
+  REAL H2SO4_sat
 
   DO it=1,nbtr_bin
@@ -107 +107 @@
              & ACTSO4(ilon,ilev),R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
              & RRSI,Vbin,FL,ASO4,DNDR)
+      ! Compute H2SO4 saturate vapor for big particules
+      H2SO4_sat = DNDR(nbtr_bin)/(pplay(ilon,ilev)/t_seri(ilon,ilev)/RD/1.E6/mH2SO4mol)
       ! consider only condensation (positive FL)
       DO it=1,nbtr_bin
@@ -117 +119 @@
       ENDDO
       ! determine appropriate time step
-      dt=(H2SO4_init-H2SO4_sat(nbtr_bin))/float(nbtstep)/MAX(1.e-30, nucl_rate+cond_evap_rate) !cond_evap_rate pos. for cond. and neg. for evap.
+      dt=(H2SO4_init-H2SO4_sat)/float(nbtstep)/MAX(1.e-30, nucl_rate+cond_evap_rate) !cond_evap_rate pos. for cond. and neg. for evap.
       IF (dt.LT.0.0) THEN
         dt=PDT

LMDZ6/trunk/libf/phylmd/StratAer/nucleation_tstep_mod.F90

@@ -604 +604 @@
      na_n=x_n*ntot_n
      IF (na_n .LT. 1.) THEN
-        print *, 'Warning: number of acid molecules < 1 in nucleation regime, setting na_n=1'
+!        print *, 'Warning: number of acid molecules < 1 in nucleation regime, setting na_n=1'
         na_n=1.0
      ENDIF

LMDZ6/trunk/libf/phylmd/StratAer/strataer_mod.F90

@@ -79 +79 @@
     !Config Help = Used in physiq.F
     !
-    flag_sulf_emit = 0
+    flag_sulf_emit = 0 ! Background (default)
+    flag_sulf_emit_distrib = 0 ! Gaussian (default)
     nErupt = 0 ! eruption number
     injdur = 0 ! init injection duration
@@ -87 +88 @@
        CALL getin_p('nErupt',nErupt)
        CALL getin_p('injdur',injdur)
+       CALL getin_p('flag_sulf_emit_distrib',flag_sulf_emit_distrib)
+
+       year_emit_vol=0 ; mth_emit_vol=0 ; day_emit_vol=0
+       m_aer_emiss_vol=0. ; altemiss_vol=0. ; sigma_alt_vol=0.
+       xlon_min_vol=0. ; xlon_max_vol=0.
+       xlat_min_vol=0. ; xlat_max_vol=0.
+
+       IF (nErupt.GT.0) THEN
+          ALLOCATE(year_emit_vol(nErupt),mth_emit_vol(nErupt),day_emit_vol(nErupt))
+          ALLOCATE(m_aer_emiss_vol(nErupt),altemiss_vol(nErupt),sigma_alt_vol(nErupt))
+          ALLOCATE(xlat_min_vol(nErupt),xlon_min_vol(nErupt))
+          ALLOCATE(xlat_max_vol(nErupt),xlon_max_vol(nErupt))
+       ELSE
+          WRITE(lunout,*) 'ERROR : Using flag_sulf_emit=1 (ie Volcanic eruption) but nErupt (',nErupt,') <=0 !'
+          CALL abort_physic('strataer_mod','No eruption define in physiq_def (nErupt=0). Add one or use background condition.',1)
+       ENDIF
+
+       CALL getin_p('year_emit_vol',year_emit_vol)
+       CALL getin_p('mth_emit_vol',mth_emit_vol)
+       CALL getin_p('day_emit_vol',day_emit_vol)
+       CALL getin_p('m_aer_emiss_vol',m_aer_emiss_vol)
+       CALL getin_p('altemiss_vol',altemiss_vol)
+       CALL getin_p('sigma_alt_vol',sigma_alt_vol)
+       CALL getin_p('xlon_min_vol',xlon_min_vol)
+       CALL getin_p('xlon_max_vol',xlon_max_vol)
+       CALL getin_p('xlat_min_vol',xlat_min_vol)
+       CALL getin_p('xlat_max_vol',xlat_max_vol)
     ELSEIF (flag_sulf_emit == 2) THEN ! SAI
        CALL getin_p('m_aer_emiss_sai',m_aer_emiss_sai)
@@ -93 +121 @@
        CALL getin_p('xlat_sai',xlat_sai)
        CALL getin_p('xlon_sai',xlon_sai)
-       CALL getin_p('flag_sulf_emit_distrib',flag_sulf_emit_distrib)
     ELSEIF (flag_sulf_emit == 3) THEN ! SAI between latitudes
        CALL getin_p('m_aer_emiss_sai',m_aer_emiss_sai)
@@ -101 +128 @@
        CALL getin_p('xlat_max_sai',xlat_max_sai)
        CALL getin_p('xlat_min_sai',xlat_min_sai)
-       CALL getin_p('flag_sulf_emit_distrib',flag_sulf_emit_distrib)
     ENDIF
 
-    ALLOCATE(year_emit_vol(nErupt),mth_emit_vol(nErupt),day_emit_vol(nErupt))
-    ALLOCATE(m_aer_emiss_vol(nErupt),altemiss_vol(nErupt),sigma_alt_vol(nErupt))
-    ALLOCATE(xlat_min_vol(nErupt),xlon_min_vol(nErupt))
-    ALLOCATE(xlat_max_vol(nErupt),xlon_max_vol(nErupt))
-    
-    IF (nErupt.GT.0) THEN 
-      year_emit_vol=0 ; mth_emit_vol=0 ; day_emit_vol=0
-      m_aer_emiss_vol=0. ; altemiss_vol=0. ; sigma_alt_vol=0.
-      xlon_min_vol=0. ; xlon_max_vol=0.
-      xlat_min_vol=0. ; xlat_max_vol=0.
-    ENDIF
-    
-    CALL getin_p('year_emit_vol',year_emit_vol)
-    CALL getin_p('mth_emit_vol',mth_emit_vol)
-    CALL getin_p('day_emit_vol',day_emit_vol)
-    CALL getin_p('m_aer_emiss_vol',m_aer_emiss_vol)
-    CALL getin_p('altemiss_vol',altemiss_vol)
-    CALL getin_p('sigma_alt_vol',sigma_alt_vol)
-    CALL getin_p('xlon_min_vol',xlon_min_vol)
-    CALL getin_p('xlon_max_vol',xlon_max_vol)
-    CALL getin_p('xlat_min_vol',xlat_min_vol)
-    CALL getin_p('xlat_max_vol',xlat_max_vol)
     !Config Key  = flag_nuc_rate_box
     !Config Desc = define or not a box for nucleation rate
@@ -136 +140 @@
     !
     flag_nuc_rate_box = .FALSE.
+    nuclat_min=0  ; nuclat_max=0
+    nucpres_min=0 ; nucpres_max=0
+
     CALL getin_p('flag_nuc_rate_box',flag_nuc_rate_box)
     CALL getin_p('nuclat_min',nuclat_min)
@@ -153 +160 @@
        WRITE(lunout,*) 'IN STRATAER : altemiss_vol',altemiss_vol
        WRITE(lunout,*) 'IN STRATAER : sigma_alt_vol',sigma_alt_vol
-       WRITE(lunout,*) 'IN STRATAER : ponde_lonlat_vol',ponde_lonlat_vol
        WRITE(lunout,*) 'IN STRATAER : xlat_min_vol',xlat_min_vol
        WRITE(lunout,*) 'IN STRATAER : xlat_max_vol',xlat_max_vol
@@ -164 +170 @@
        WRITE(lunout,*) 'IN STRATAER : xlat_sai',xlat_sai
        WRITE(lunout,*) 'IN STRATAER : xlon_sai',xlon_sai
-       WRITE(lunout,*) 'flag_sulf_emit_distrib = ',flag_sulf_emit_distrib
     ELSEIF (flag_sulf_emit == 3) THEN
        WRITE(lunout,*) 'IN STRATAER : m_aer_emiss_sai',m_aer_emiss_sai
@@ -172 +177 @@
        WRITE(lunout,*) 'IN STRATAER : xlat_max_sai',xlat_max_sai
        WRITE(lunout,*) 'IN STRATAER : xlon_sai',xlon_sai
-       WRITE(lunout,*) 'flag_sulf_emit_distrib = ',flag_sulf_emit_distrib
     ENDIF
+    WRITE(lunout,*) 'flag_sulf_emit_distrib = ',flag_sulf_emit_distrib
     WRITE(lunout,*) 'IN STRATAER : flag_nuc_rate_box = ',flag_nuc_rate_box
     IF (flag_nuc_rate_box) THEN
@@ -181 +186 @@
     !ENDIF
 
-    CALL strataer_ponde_init
-    WRITE(lunout,*) 'IN STRATAER INT2 END'
+    IF (flag_sulf_emit == 1) THEN
+       CALL strataer_ponde_init
+       WRITE(lunout,*) 'IN STRATAER INT2 END'
+    END IF
+    WRITE(lunout,*) 'IN STRATAER END'
 
   END SUBROUTINE strataer_init

LMDZ6/trunk/libf/phylmd/StratAer/traccoag_mod.F90

@@ -17 +17 @@
 
     USE dimphy
-    USE infotrac_phy
+    USE infotrac_phy, ONLY : nbtr_bin, nbtr_sulgas, nbtr, id_SO2_strat
     USE aerophys
     USE geometry_mod, ONLY : cell_area, boundslat
@@ -23 +23 @@
     USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     USE mod_phys_lmdz_para, only: gather, scatter
-    USE phys_cal_mod
+    USE phys_cal_mod, ONLY : year_len, year_cur,mth_cur, day_cur, hour
     USE sulfate_aer_mod
     USE phys_local_var_mod, ONLY: stratomask
@@ -29 +29 @@
     USE print_control_mod, ONLY: lunout
     USE strataer_mod
-    USE phys_cal_mod, ONLY : year_len
 
     IMPLICIT NONE

LMDZ6/trunk/libf/phylmd/infotrac_phy.F90

@@ -16 +16 @@
    PUBLIC :: nqtot,   nbtr,   nqo,   nqCO2,   nqtottr      !--- Main dimensions
    PUBLIC :: conv_flg, pbl_flg                             !--- Convection & boundary layer activation keys
+#ifdef CPP_StratAer
+   PUBLIC :: nbtr_bin, nbtr_sulgas                         !--- Number of aerosols bins and sulfur gases for StratAer model
+   PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
+#endif
 
    !=== FOR ISOTOPES: General

LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90

@@ -481 +481 @@
 #ifdef CPP_StratAer 
     LOGICAL, PARAMETER :: debug_strataer=.FALSE.
+    CHARACTER(LEN=maxlen) :: unt
 #endif
     REAL,DIMENSION(klon,klev) :: z, dz

LMDZ6/trunk/libf/phylmd/phytrac_mod.F90

@@ -707 +707 @@
                 !--with the full array tr_seri even if only item it is processed
 
-                print*,'CV SCAV ',it,ccntrAA(it),ccntrENV(it)
-
                 CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep,         &
                      sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,              &