source: LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/StratAer/strataer_mod.F90 @ 5407

Last change on this file since 5407 was 3931, checked in by oboucher, 4 years ago

Correction of include statement for RPI
  • Property svn:keywords set to Id
File size: 10.6 KB
Line 
1! $Id: strataer_mod.F90 3931 2021-06-11 20:28:38Z abarral $
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    year_emit_vol=0 ; mth_emit_vol=0 ; day_emit_vol=0
112    m_aer_emiss_vol=0. ; altemiss_vol=0. ; sigma_alt_vol=0.
113    xlon_min_vol=0. ; xlon_max_vol=0.
114    xlat_min_vol=0. ; xlat_max_vol=0.
115   
116    CALL getin_p('year_emit_vol',year_emit_vol)
117    CALL getin_p('mth_emit_vol',mth_emit_vol)
118    CALL getin_p('day_emit_vol',day_emit_vol)
119    CALL getin_p('m_aer_emiss_vol',m_aer_emiss_vol)
120    CALL getin_p('altemiss_vol',altemiss_vol)
121    CALL getin_p('sigma_alt_vol',sigma_alt_vol)
122    CALL getin_p('xlon_min_vol',xlon_min_vol)
123    CALL getin_p('xlon_max_vol',xlon_max_vol)
124    CALL getin_p('xlat_min_vol',xlat_min_vol)
125    CALL getin_p('xlat_max_vol',xlat_max_vol)
126    !Config Key  = flag_nuc_rate_box
127    !Config Desc = define or not a box for nucleation rate
128    ! - F = global nucleation
129    ! - T = 2D-box for nucleation need nuclat_min, nuclat_max, nucpres_min and
130    ! nucpres_max
131    !       to define its bounds.
132    !Config Def  = F
133    !Config Help = Used in physiq.F
134    !
135    flag_nuc_rate_box = .FALSE.
136    CALL getin_p('flag_nuc_rate_box',flag_nuc_rate_box)
137    CALL getin_p('nuclat_min',nuclat_min)
138    CALL getin_p('nuclat_max',nuclat_max)
139    CALL getin_p('nucpres_min',nucpres_min)
140    CALL getin_p('nucpres_max',nucpres_max)
141
142    WRITE(lunout,*) 'IN STRATAER INIT2 year_emit_vol = ',year_emit_vol
143    WRITE(lunout,*) 'IN STRATAER INIT2 mth_emit_vol = ',mth_emit_vol
144    WRITE(lunout,*) 'IN STRATAER INIT2 day_emit_vol = ',day_emit_vol
145   
146    !IF (is_master) THEN
147       WRITE(lunout,*) 'IN STRATAER INIT2 year_emit_vol = ',year_emit_vol
148       WRITE(lunout,*) 'IN STRATAER INIT2 mth_emit_vol=',mth_emit_vol
149       WRITE(lunout,*) 'IN STRATAER INIT2 day_emit_vol=',day_emit_vol
150       WRITE(lunout,*) 'IN STRATAER INIT2 =m_aer_emiss_vol',m_aer_emiss_vol
151       WRITE(lunout,*) 'IN STRATAER INIT2 =altemiss_vol',altemiss_vol
152       WRITE(lunout,*) 'IN STRATAER INIT2 =sigma_alt_vol',sigma_alt_vol
153       WRITE(lunout,*) 'IN STRATAER INIT2 xlon_min_vol=',xlon_min_vol
154       WRITE(lunout,*) 'IN STRATAER INIT2 xlon_max_vol=',xlon_max_vol
155       WRITE(lunout,*) 'IN STRATAER INIT2 xlat_min_vol=',xlat_min_vol
156       WRITE(lunout,*) 'IN STRATAER INIT2 xlat_max_vol=',xlat_max_vol
157       WRITE(lunout,*) 'flag_nuc_rate_box = ',flag_nuc_rate_box
158       WRITE(lunout,*) 'nuclat_min = ',nuclat_min
159       WRITE(lunout,*) 'nuclat_max = ',nuclat_max
160       WRITE(lunout,*) 'nucpres_min = ',nucpres_min
161       WRITE(lunout,*) 'nucpres_max = ',nucpres_max
162       WRITE(lunout,*) 'flag_sulf_emit = ',flag_sulf_emit
163       WRITE(lunout,*) 'injdur = ',injdur
164       WRITE(lunout,*) 'flag_sulf_emit_distrib = ',flag_sulf_emit_distrib
165       WRITE(lunout,*) 'nErupt = ',nErupt
166       WRITE(lunout,*) 'year_emit_vol = ',year_emit_vol
167       WRITE(lunout,*) 'mth_emit_vol = ',mth_emit_vol
168       WRITE(lunout,*) 'day_emit_vol = ',day_emit_vol
169       WRITE(lunout,*) 'm_aer_emiss_vol = ',m_aer_emiss_vol
170       WRITE(lunout,*) 'altemiss_vol = ',altemiss_vol
171       WRITE(lunout,*) 'sigma_alt_vol = ',sigma_alt_vol
172       WRITE(lunout,*) 'xlat_min_vol = ',xlat_min_vol
173       WRITE(lunout,*) 'xlat_max_vol = ',xlat_max_vol
174       WRITE(lunout,*) 'xlon_min_vol = ',xlon_min_vol
175       WRITE(lunout,*) 'xlon_max_vol = ',xlon_max_vol
176       WRITE(lunout,*) 'm_aer_emiss_sai = ',m_aer_emiss_sai
177       WRITE(lunout,*) 'altemiss_sai = ',altemiss_sai
178       WRITE(lunout,*) 'sigma_alt_sai = ',sigma_alt_sai
179       WRITE(lunout,*) 'xlat_sai = ',xlat_sai
180       WRITE(lunout,*) 'xlon_sai = ',xlon_sai
181       WRITE(lunout,*) 'xlat_min_sai = ',xlat_min_sai
182       WRITE(lunout,*) 'xlat_max_sai = ',xlat_max_sai
183    !ENDIF
184
185    CALL strataer_ponde_init
186    WRITE(lunout,*) 'IN STRATAER INT2 END'
187
188  END SUBROUTINE strataer_init
189 
190  ! Compute the ponderation to applicate in each grid point for all eruptions and init
191  ! dlat & dlon variables
192  SUBROUTINE strataer_ponde_init()
193   
194    USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
195    USE dimphy, ONLY: klon
196    USE mod_grid_phy_lmdz, ONLY: nbp_lat, nbp_lon
197    USE print_control_mod, ONLY : lunout
198
199    INCLUDE "YOMCST.h"  !--RPI
200
201    ! local var
202    REAL                :: pi,lat_reg_deg,lon_reg_deg! latitude and d longitude of grid in degree
203    INTEGER             :: ieru, i, j
204   
205    ALLOCATE(ponde_lonlat_vol(nErupt))
206   
207    !Compute lon/lat ponderation for injection
208    dlat=180./2./FLOAT(nbp_lat)   ! d latitude in degree
209    dlon=360./2./FLOAT(nbp_lon)   ! d longitude in degree
210    WRITE(lunout,*) 'IN STRATAER_INIT dlat=',dlat,'dlon=',dlon
211    WRITE(lunout,*) 'IN STRATAER_INIT nErupt=',nErupt
212    WRITE(lunout,*) 'IN STRATAER_INIT xlat_min=',xlat_min_vol,'xlat_max=',xlat_max_vol
213    WRITE(lunout,*) 'IN STRATAER_INIT xlon_min=',xlon_min_vol,'xlon_max=',xlon_max_vol
214    DO ieru=1, nErupt
215       ponde_lonlat_vol(ieru) = 0
216       DO i=1,nbp_lon
217          lon_reg_deg = lon_reg(i)*180./RPI
218          DO j=1,nbp_lat
219             lat_reg_deg = lat_reg(j)*180./RPI
220             IF  ( lat_reg_deg.GE.xlat_min_vol(ieru)-dlat .AND. lat_reg_deg.LT.xlat_max_vol(ieru)+dlat .AND. &
221                  lon_reg_deg.GE.xlon_min_vol(ieru)-dlon .AND. lon_reg_deg.LT.xlon_max_vol(ieru)+dlon ) THEN
222                ponde_lonlat_vol(ieru) = ponde_lonlat_vol(ieru) + 1
223             ENDIF
224          ENDDO
225       ENDDO
226       IF(ponde_lonlat_vol(ieru) == 0) THEN
227          WRITE(lunout,*) 'STRATAER_INIT ERROR: no grid point found for eruption ieru=',ieru
228       ENDIF
229    ENDDO !ieru
230    WRITE(lunout,*) 'IN STRATAER_INIT ponde_lonlat: ',ponde_lonlat_vol
231   
232  END SUBROUTINE strataer_ponde_init
233 
234END MODULE strataer_mod
Note: See TracBrowser for help on using the repository browser.