source: LMDZ6/branches/SETHET_DECOUPLE/libf/phylmd/StratAer/strataer_mod.F90 @ 4799

Last change on this file since 4799 was 3527, checked in by oboucher, 5 years ago

Cleaning up StratAer? for trunk version
  • Property svn:keywords set to Id
File size: 10.5 KB
Line 
1! $Id: strataer_mod.F90 3527 2019-05-30 13:43:48Z nfevrier $
2MODULE strataer_mod
3! This module contains information about strato microphysic model parameters
4 
5  IMPLICIT NONE
6
7  ! flag to constraint nucleation rate in a lat/pres box
8  LOGICAL,SAVE :: flag_nuc_rate_box      ! Nucleation rate limit or not to a lat/pres
9  !$OMP THREADPRIVATE(flag_nuc_rate_box)
10  REAL,SAVE    :: nuclat_min             ! min lat to activate nuc rate
11  REAL,SAVE    :: nuclat_max             ! max lat to activate nuc rate
12  REAL,SAVE    :: nucpres_min            ! min pres to activate nuc rate
13  REAL,SAVE    :: nucpres_max            ! max pres to activate nuc rate
14  !$OMP THREADPRIVATE(nuclat_min, nuclat_max, nucpres_min, nucpres_max)
15 
16  ! flag for sulfur emission scenario: (0) background aer ; (1) volcanic eruption ; (2) strato aer injections (SAI)
17  INTEGER,SAVE :: flag_sulf_emit
18  !$OMP THREADPRIVATE(flag_sulf_emit)
19
20  ! flag for sulfur emission altitude distribution: (0) gaussian; (1) uniform
21  INTEGER,SAVE :: flag_sulf_emit_distrib
22  !$OMP THREADPRIVATE(flag_sulf_emit_distrib)
23 
24  !--flag_sulf_emit=1 -- Volcanic eruption(s)
25  INTEGER,SAVE             :: nErupt                    ! number of eruptions specs
26  REAL,SAVE                :: injdur                    ! volcanic injection duration
27  !$OMP THREADPRIVATE(nErupt, injdur)
28  INTEGER,ALLOCATABLE,SAVE :: year_emit_vol(:)          ! year of emission date
29  INTEGER,ALLOCATABLE,SAVE :: mth_emit_vol(:)           ! month of emission date
30  INTEGER,ALLOCATABLE,SAVE :: day_emit_vol(:)           ! day of emission date
31  !$OMP THREADPRIVATE(year_emit_vol, mth_emit_vol, day_emit_vol)
32  REAL,ALLOCATABLE,SAVE    :: m_aer_emiss_vol(:)        ! emitted sulfur mass in kgS, e.g. 7Tg(S)=14Tg(SO2)
33  REAL,ALLOCATABLE,SAVE    :: altemiss_vol(:)           ! emission altitude in m
34  REAL,ALLOCATABLE,SAVE    :: sigma_alt_vol(:)          ! standard deviation of emission altitude in m
35  !$OMP THREADPRIVATE(m_aer_emiss_vol, altemiss_vol, sigma_alt_vol)
36  INTEGER,ALLOCATABLE,SAVE :: ponde_lonlat_vol(:)       ! lon/lat ponderation factor
37  REAL,ALLOCATABLE,SAVE    :: xlat_min_vol(:)           ! min latitude of volcano in degree
38  REAL,ALLOCATABLE,SAVE    :: xlat_max_vol(:)           ! max latitude of volcano in degree
39  REAL,ALLOCATABLE,SAVE    :: xlon_min_vol(:)           ! min longitude of volcano in degree
40  REAL,ALLOCATABLE,SAVE    :: xlon_max_vol(:)           ! max longitude of volcano in degree
41  !$OMP THREADPRIVATE(ponde_lonlat_vol, xlat_min_vol, xlat_max_vol, xlon_min_vol, xlon_max_vol)
42 
43  !--flag_sulf_emit=2 --SAI
44  REAL,SAVE    :: m_aer_emiss_sai        ! emitted sulfur mass in kgS, eg 1e9=1TgS, 1e10=10TgS
45  REAL,SAVE    :: altemiss_sai           ! emission altitude in m
46  REAL,SAVE    :: sigma_alt_sai          ! standard deviation of emission altitude in m
47  !$OMP THREADPRIVATE(m_aer_emiss_sai, altemiss_sai, sigma_alt_sai)
48  REAL,SAVE    :: xlat_sai               ! latitude of SAI in degree
49  REAL,SAVE    :: xlon_sai               ! longitude of SAI in degree
50  REAL,SAVE    :: dlat, dlon             ! delta latitude and d longitude of grid in degree
51  !$OMP THREADPRIVATE(xlat_sai, xlon_sai, dlat, dlon)
52 
53  !--flag_sulf_emit=3 -- SAI
54  REAL,SAVE    :: xlat_max_sai           ! maximum latitude of SAI in degrees
55  REAL,SAVE    :: xlat_min_sai           ! minimum latitude of SAI in degrees
56  !$OMP THREADPRIVATE(xlat_min_sai,xlat_max_sai)
57 
58CONTAINS
59   
60  SUBROUTINE strataer_init()
61    USE ioipsl_getin_p_mod, ONLY : getin_p
62    USE print_control_mod, ONLY : lunout
63    USE mod_phys_lmdz_para, ONLY : is_master
64
65    ! Local var
66    INTEGER       :: ieru
67 
68    INTEGER :: i
69   
70    WRITE(lunout,*) 'IN STRATAER INIT WELCOME!'
71   
72    !Config Key  = flag_sulf_emit
73    !Config Desc = aerosol emission mode
74    ! - 0 = background aerosol
75    ! - 1 = volcanic eruption
76    ! - 2 = geo-ingeneering design
77    ! - 3 = geo-engineering between two latitudes
78    !Config Def  = 0
79    !Config Help = Used in physiq.F
80    !
81    flag_sulf_emit = 0
82    nErupt = 0 ! eruption number
83    injdur = 0 ! init injection duration
84    CALL getin_p('flag_sulf_emit',flag_sulf_emit)
85
86    IF (flag_sulf_emit==1) THEN ! Volcano
87       CALL getin_p('nErupt',nErupt)
88       CALL getin_p('injdur',injdur)
89    ELSEIF (flag_sulf_emit == 2) THEN ! SAI
90       CALL getin_p('m_aer_emiss_sai',m_aer_emiss_sai)
91       CALL getin_p('altemiss_sai',altemiss_sai)
92       CALL getin_p('sigma_alt_sai',sigma_alt_sai)
93       CALL getin_p('xlat_sai',xlat_sai)
94       CALL getin_p('xlon_sai',xlon_sai)
95       CALL getin_p('flag_sulf_emit_distrib',flag_sulf_emit_distrib)
96    ELSEIF (flag_sulf_emit == 3) THEN ! SAI between latitudes
97       CALL getin_p('m_aer_emiss_sai',m_aer_emiss_sai)
98       CALL getin_p('altemiss_sai',altemiss_sai)
99       CALL getin_p('sigma_alt_sai',sigma_alt_sai)
100       CALL getin_p('xlon_sai',xlon_sai)
101       CALL getin_p('xlat_max_sai',xlat_max_sai)
102       CALL getin_p('xlat_min_sai',xlat_min_sai)
103       CALL getin_p('flag_sulf_emit_distrib',flag_sulf_emit_distrib)
104    ENDIF
105
106    ALLOCATE(year_emit_vol(nErupt),mth_emit_vol(nErupt),day_emit_vol(nErupt))
107    ALLOCATE(m_aer_emiss_vol(nErupt),altemiss_vol(nErupt),sigma_alt_vol(nErupt))
108    ALLOCATE(xlat_min_vol(nErupt),xlon_min_vol(nErupt))
109    ALLOCATE(xlat_max_vol(nErupt),xlon_max_vol(nErupt))
110   
111    IF (nErupt.GT.0) THEN
112      year_emit_vol=0 ; mth_emit_vol=0 ; day_emit_vol=0
113      m_aer_emiss_vol=0. ; altemiss_vol=0. ; sigma_alt_vol=0.
114      xlon_min_vol=0. ; xlon_max_vol=0.
115      xlat_min_vol=0. ; xlat_max_vol=0.
116    ENDIF
117   
118    CALL getin_p('year_emit_vol',year_emit_vol)
119    CALL getin_p('mth_emit_vol',mth_emit_vol)
120    CALL getin_p('day_emit_vol',day_emit_vol)
121    CALL getin_p('m_aer_emiss_vol',m_aer_emiss_vol)
122    CALL getin_p('altemiss_vol',altemiss_vol)
123    CALL getin_p('sigma_alt_vol',sigma_alt_vol)
124    CALL getin_p('xlon_min_vol',xlon_min_vol)
125    CALL getin_p('xlon_max_vol',xlon_max_vol)
126    CALL getin_p('xlat_min_vol',xlat_min_vol)
127    CALL getin_p('xlat_max_vol',xlat_max_vol)
128    !Config Key  = flag_nuc_rate_box
129    !Config Desc = define or not a box for nucleation rate
130    ! - F = global nucleation
131    ! - T = 2D-box for nucleation need nuclat_min, nuclat_max, nucpres_min and
132    ! nucpres_max
133    !       to define its bounds.
134    !Config Def  = F
135    !Config Help = Used in physiq.F
136    !
137    flag_nuc_rate_box = .FALSE.
138    CALL getin_p('flag_nuc_rate_box',flag_nuc_rate_box)
139    CALL getin_p('nuclat_min',nuclat_min)
140    CALL getin_p('nuclat_max',nuclat_max)
141    CALL getin_p('nucpres_min',nucpres_min)
142    CALL getin_p('nucpres_max',nucpres_max)
143
144    !IF (is_master) THEN
145    WRITE(lunout,*) 'flag_sulf_emit = ',flag_sulf_emit
146    IF (flag_sulf_emit == 1) THEN
147       WRITE(lunout,*) 'IN STRATAER nErupt: ',nErupt
148       WRITE(lunout,*) 'IN STRATAER injdur: ',injdur
149       WRITE(lunout,*) 'IN STRATAER : year_emit_vol',year_emit_vol
150       WRITE(lunout,*) 'IN STRATAER : mth_emit_vol',mth_emit_vol
151       WRITE(lunout,*) 'IN STRATAER : day_emit_vol',day_emit_vol
152       WRITE(lunout,*) 'IN STRATAER : m_aer_emiss_vol',m_aer_emiss_vol
153       WRITE(lunout,*) 'IN STRATAER : altemiss_vol',altemiss_vol
154       WRITE(lunout,*) 'IN STRATAER : sigma_alt_vol',sigma_alt_vol
155       WRITE(lunout,*) 'IN STRATAER : ponde_lonlat_vol',ponde_lonlat_vol
156       WRITE(lunout,*) 'IN STRATAER : xlat_min_vol',xlat_min_vol
157       WRITE(lunout,*) 'IN STRATAER : xlat_max_vol',xlat_max_vol
158       WRITE(lunout,*) 'IN STRATAER : xlon_min_vol',xlon_min_vol
159       WRITE(lunout,*) 'IN STRATAER : xlon_max_vol',xlon_max_vol
160    ELSEIF (flag_sulf_emit == 2) THEN
161       WRITE(lunout,*) 'IN STRATAER : m_aer_emiss_sai',m_aer_emiss_sai
162       WRITE(lunout,*) 'IN STRATAER : altemiss_sai',altemiss_sai
163       WRITE(lunout,*) 'IN STRATAER : sigma_alt_sai',sigma_alt_sai
164       WRITE(lunout,*) 'IN STRATAER : xlat_sai',xlat_sai
165       WRITE(lunout,*) 'IN STRATAER : xlon_sai',xlon_sai
166       WRITE(lunout,*) 'flag_sulf_emit_distrib = ',flag_sulf_emit_distrib
167    ELSEIF (flag_sulf_emit == 3) THEN
168       WRITE(lunout,*) 'IN STRATAER : m_aer_emiss_sai',m_aer_emiss_sai
169       WRITE(lunout,*) 'IN STRATAER : altemiss_sai',altemiss_sai
170       WRITE(lunout,*) 'IN STRATAER : sigma_alt_sai',sigma_alt_sai
171       WRITE(lunout,*) 'IN STRATAER : xlat_min_sai',xlat_min_sai
172       WRITE(lunout,*) 'IN STRATAER : xlat_max_sai',xlat_max_sai
173       WRITE(lunout,*) 'IN STRATAER : xlon_sai',xlon_sai
174       WRITE(lunout,*) 'flag_sulf_emit_distrib = ',flag_sulf_emit_distrib
175    ENDIF
176    WRITE(lunout,*) 'IN STRATAER : flag_nuc_rate_box = ',flag_nuc_rate_box
177    IF (flag_nuc_rate_box) THEN
178       WRITE(lunout,*) 'IN STRATAER : nuclat_min = ',nuclat_min,', nuclat_max = ',nuclat_max
179       WRITE(lunout,*) 'IN STRATAER : nucpres_min = ',nucpres_min,', nucpres_max = ',nucpres_max
180    ENDIF
181    !ENDIF
182
183    CALL strataer_ponde_init
184    WRITE(lunout,*) 'IN STRATAER INT2 END'
185
186  END SUBROUTINE strataer_init
187 
188  ! Compute the ponderation to applicate in each grid point for all eruptions and init
189  ! dlat & dlon variables
190  SUBROUTINE strataer_ponde_init()
191   
192    USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
193    USE dimphy, ONLY: klon
194    USE mod_grid_phy_lmdz, ONLY: nbp_lat, nbp_lon
195    USE print_control_mod, ONLY : lunout
196    USE YOMCST, ONLY : RPI
197
198    ! local var
199    REAL                :: pi,lat_reg_deg,lon_reg_deg! latitude and d longitude of grid in degree
200    INTEGER             :: ieru, i, j
201   
202    ALLOCATE(ponde_lonlat_vol(nErupt))
203   
204    !Compute lon/lat ponderation for injection
205    dlat=180./2./FLOAT(nbp_lat)   ! d latitude in degree
206    dlon=360./2./FLOAT(nbp_lon)   ! d longitude in degree
207    WRITE(lunout,*) 'IN STRATAER_INIT dlat=',dlat,'dlon=',dlon
208    WRITE(lunout,*) 'IN STRATAER_INIT nErupt=',nErupt
209    WRITE(lunout,*) 'IN STRATAER_INIT xlat_min=',xlat_min_vol,'xlat_max=',xlat_max_vol
210    WRITE(lunout,*) 'IN STRATAER_INIT xlon_min=',xlon_min_vol,'xlon_max=',xlon_max_vol
211    DO ieru=1, nErupt
212       ponde_lonlat_vol(ieru) = 0
213       DO i=1,nbp_lon
214          lon_reg_deg = lon_reg(i)*180./RPI
215          DO j=1,nbp_lat
216             lat_reg_deg = lat_reg(j)*180./RPI
217             IF  ( lat_reg_deg.GE.xlat_min_vol(ieru)-dlat .AND. lat_reg_deg.LT.xlat_max_vol(ieru)+dlat .AND. &
218                  lon_reg_deg.GE.xlon_min_vol(ieru)-dlon .AND. lon_reg_deg.LT.xlon_max_vol(ieru)+dlon ) THEN
219                ponde_lonlat_vol(ieru) = ponde_lonlat_vol(ieru) + 1
220             ENDIF
221          ENDDO
222       ENDDO
223       IF(ponde_lonlat_vol(ieru) == 0) THEN
224          WRITE(lunout,*) 'STRATAER_INIT ERROR: no grid point found for eruption ieru=',ieru
225       ENDIF
226    ENDDO !ieru
227    WRITE(lunout,*) 'IN STRATAER_INIT ponde_lonlat: ',ponde_lonlat_vol
228   
229  END SUBROUTINE strataer_ponde_init
230 
231END MODULE strataer_mod
Note: See TracBrowser for help on using the repository browser.