source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aeropacity.F90

Last change on this file was 313, checked in by ymipsl, 10 years ago
  • implement splitting of XIOS file for lmdz physics
  • Termination is done properly in parallel by calling MPI_ABORT instead of abort or stop

YM

File size: 16.3 KB
Line 
1      Subroutine aeropacity(ngrid,nlayer,nq,pplay,pplev,pq, &
2         aerosol,reffrad,QREFvis3d,QREFir3d,tau_col,cloudfrac,totcloudfrac,clearsky)
3
4       use radinc_h, only : L_TAUMAX,naerkind
5       use aerosol_mod
6       USE comgeomfi_h
7       USE tracer_h, only: noms,rho_co2,rho_ice
8       use mod_phys_lmdz_para, only : is_master
9                 
10       implicit none
11
12!==================================================================
13!     
14!     Purpose
15!     -------
16!     Compute aerosol optical depth in each gridbox.
17!     
18!     Authors
19!     -------
20!     F. Forget
21!     F. Montmessin (water ice scheme)
22!     update J.-B. Madeleine (2008)
23!     dust removal, simplification by Robin Wordsworth (2009)
24!
25!     Input
26!     -----
27!     ngrid             Number of horizontal gridpoints
28!     nlayer            Number of layers
29!     nq                Number of tracers
30!     pplev             Pressure (Pa) at each layer boundary
31!     pq                Aerosol mixing ratio
32!     reffrad(ngrid,nlayer,naerkind)         Aerosol effective radius
33!     QREFvis3d(ngrid,nlayer,naerkind) \ 3d extinction coefficients
34!     QREFir3d(ngrid,nlayer,naerkind)  / at reference wavelengths
35!
36!     Output
37!     ------
38!     aerosol            Aerosol optical depth in layer l, grid point ig
39!     tau_col            Total column optical depth at grid point ig
40!
41!=======================================================================
42
43!#include "dimensions.h"
44!#include "dimphys.h"
45#include "callkeys.h"
46#include "comcstfi.h"
47!#include "comvert.h"
48
49      INTEGER,INTENT(IN) :: ngrid  ! number of atmospheric columns
50      INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers
51      INTEGER,INTENT(IN) :: nq     ! number of tracers
52      REAL,INTENT(IN) :: pplay(ngrid,nlayer) ! mid-layer pressure (Pa)
53      REAL,INTENT(IN) :: pplev(ngrid,nlayer+1) ! inter-layer pressure (Pa)
54      REAL,INTENT(IN) :: pq(ngrid,nlayer,nq) ! tracers (.../kg_of_air)
55      REAL,INTENT(OUT) :: aerosol(ngrid,nlayer,naerkind) ! aerosol optical depth
56      REAL,INTENT(IN) :: reffrad(ngrid,nlayer,naerkind) ! aerosol effective radius
57      REAL,INTENT(IN) :: QREFvis3d(ngrid,nlayer,naerkind) ! extinction coefficient in the visible
58      REAL,INTENT(IN) :: QREFir3d(ngrid,nlayer,naerkind)
59      REAL,INTENT(OUT):: tau_col(ngrid) !column integrated visible optical depth
60      ! BENJAMIN MODIFS
61      real,intent(in) :: cloudfrac(ngrid,nlayer) ! cloud fraction
62      real,intent(out) :: totcloudfrac(ngrid) ! total cloud fraction
63      logical,intent(in) :: clearsky
64
65      real aerosol0
66
67      INTEGER l,ig,iq,iaer
68
69      LOGICAL,SAVE :: firstcall=.true.
70!$OMP THREADPRIVATE(firstcall)
71      REAL CBRT
72      EXTERNAL CBRT
73
74      INTEGER,SAVE :: i_co2ice=0      ! co2 ice
75      INTEGER,SAVE :: i_h2oice=0      ! water ice
76!$OMP THREADPRIVATE(i_co2ice,i_h2oice)
77      CHARACTER(LEN=20) :: tracername ! to temporarily store text
78
79      ! for fixed dust profiles
80      real topdust, expfactor, zp
81      REAL taudusttmp(ngrid) ! Temporary dust opacity used before scaling
82      REAL tauh2so4tmp(ngrid) ! Temporary h2so4 opacity used before scaling
83
84      real CLFtot
85
86      ! identify tracers
87      IF (firstcall) THEN
88
89        if (is_master) write(*,*) "Tracers found in aeropacity:"
90        do iq=1,nq
91          tracername=noms(iq)
92          if (tracername.eq."co2_ice") then
93            i_co2ice=iq
94          if (is_master) write(*,*) "i_co2ice=",i_co2ice
95
96          endif
97          if (tracername.eq."h2o_ice") then
98            i_h2oice=iq
99            if (is_master) write(*,*) "i_h2oice=",i_h2oice
100          endif
101        enddo
102
103        if (noaero) then
104          if (is_master) print*, "No active aerosols found in aeropacity"
105        else
106          if (is_master) print*, "If you would like to use aerosols, make sure any old"
107          if (is_master) print*, "start files are updated in newstart using the option"
108          if (is_master) print*, "q=0"
109          if (is_master) write(*,*) "Active aerosols found in aeropacity:"
110        endif
111
112        if ((iaero_co2.ne.0).and.(.not.noaero)) then
113          if (is_master) print*, 'iaero_co2=  ',iaero_co2
114        endif
115        if (iaero_h2o.ne.0) then
116          if (is_master) print*,'iaero_h2o=  ',iaero_h2o   
117        endif
118        if (iaero_dust.ne.0) then
119          if (is_master) print*,'iaero_dust= ',iaero_dust
120        endif
121        if (iaero_h2so4.ne.0) then
122          if (is_master) print*,'iaero_h2so4= ',iaero_h2so4
123        endif
124        if (iaero_back2lay.ne.0) then
125          if (is_master) print*,'iaero_back2lay= ',iaero_back2lay
126        endif
127
128        firstcall=.false.
129      ENDIF ! of IF (firstcall)
130
131
132!     ---------------------------------------------------------
133!==================================================================
134!    CO2 ice aerosols
135!==================================================================
136
137      if (iaero_co2.ne.0) then
138           iaer=iaero_co2
139!       1. Initialization
140            aerosol(1:ngrid,1:nlayer,iaer)=0.0
141!       2. Opacity calculation
142            if (noaero) then ! aerosol set to zero
143             aerosol(1:ngrid,1:nlayer,iaer)=0.0
144            elseif (aerofixco2.or.(i_co2ice.eq.0)) then !  CO2 ice cloud prescribed
145               aerosol(1:ngrid,1:nlayer,iaer)=1.e-9
146               !aerosol(1:ngrid,12,iaer)=4.0 ! single cloud layer option
147            else
148               DO ig=1, ngrid
149                  DO l=1,nlayer-1 ! to stop the rad tran bug
150
151                     aerosol0 =                         &
152                          (  0.75 * QREFvis3d(ig,l,iaer) /        &
153                          ( rho_co2 * reffrad(ig,l,iaer) )  ) *   &
154                          ( pq(ig,l,i_co2ice) + 1.E-9 ) *         &
155                          ( pplev(ig,l) - pplev(ig,l+1) ) / g
156                     aerosol0           = max(aerosol0,1.e-9)
157                     aerosol0           = min(aerosol0,L_TAUMAX)
158                     aerosol(ig,l,iaer) = aerosol0
159!                     aerosol(ig,l,iaer) = 0.0
160!                     print*, aerosol(ig,l,iaer)
161!        using cloud fraction
162!                     aerosol(ig,l,iaer) = -log(1 - CLF + CLF*exp(-aerosol0/CLF))
163!                     aerosol(ig,l,iaer) = min(aerosol(ig,l,iaer),L_TAUMAX)
164
165
166                  ENDDO
167               ENDDO
168            end if ! if fixed or varying
169      end if ! if CO2 aerosols   
170!==================================================================
171!     Water ice / liquid
172!==================================================================
173
174      if (iaero_h2o.ne.0) then
175           iaer=iaero_h2o
176!       1. Initialization
177            aerosol(1:ngrid,1:nlayer,iaer)=0.0
178!       2. Opacity calculation
179            if (aerofixh2o.or.(i_h2oice.eq.0).or.clearsky) then
180               aerosol(1:ngrid,1:nlayer,iaer) =1.e-9
181
182               ! put cloud at cloudlvl
183               if(kastprof.and.(cloudlvl.ne.0.0))then
184                  ig=1
185                  do l=1,nlayer
186                     if(int(cloudlvl).eq.l)then
187                     !if(cloudlvl.gt.(pplay(ig,l)/pplev(ig,1)))then
188                        print*,'Inserting cloud at level ',l
189                        !aerosol(ig,l,iaer)=10.0
190
191                        rho_ice=920.0
192
193                        ! the Kasting approximation
194                        aerosol(ig,l,iaer) =                      &
195                          (  0.75 * QREFvis3d(ig,l,iaer) /        &
196                          ( rho_ice * reffrad(ig,l,iaer) )  ) *   &
197                          !( pq(ig,l,i_h2oice) + 1.E-9 ) *         &
198                          ( 4.0e-4 + 1.E-9 ) *         &
199                          ( pplev(ig,l) - pplev(ig,l+1) ) / g
200
201
202                        open(115,file='clouds.out',form='formatted')
203                        write(115,*) l,aerosol(ig,l,iaer)
204                        close(115)
205
206                        return
207                     endif
208                  end do
209
210                  call abort_physiq
211               endif
212
213            else
214
215               do ig=1, ngrid
216                  do l=1,nlayer-1 ! to stop the rad tran bug
217
218                     aerosol(ig,l,iaer) =                                    & !modification by BC
219                          (  0.75 * QREFvis3d(ig,l,iaer) /        &
220                          ( rho_ice * reffrad(ig,l,iaer) )  ) *   &
221                          !  pq(ig,l,i_h2oice) *                   & !JL I dropped the +1e-9 here to have the same
222                          !( pplev(ig,l) - pplev(ig,l+1) ) / g       !   opacity in the clearsky=true and the
223                                                                     !   clear=false/pq=0 case
224                          ( pq(ig,l,i_h2oice) + 1.E-9 ) *         & ! Doing this makes the code unstable, so I have restored it (RW)
225                          ( pplev(ig,l) - pplev(ig,l+1) ) / g 
226
227                  enddo
228               enddo
229
230               if(CLFvarying)then
231                  call totalcloudfrac(ngrid,nlayer,nq,cloudfrac,totcloudfrac,pplev,pq,aerosol(1,1,iaer))
232                  do ig=1, ngrid
233                     do l=1,nlayer-1 ! to stop the rad tran bug
234                        CLFtot  = max(totcloudfrac(ig),0.01)
235                        aerosol(ig,l,iaer)=aerosol(ig,l,iaer)/CLFtot
236                        aerosol(ig,l,iaer) = max(aerosol(ig,l,iaer),1.e-9)
237                     enddo
238                  enddo
239               else
240                  do ig=1, ngrid
241                     do l=1,nlayer-1 ! to stop the rad tran bug
242                        CLFtot  = CLFfixval
243                        aerosol(ig,l,iaer)=aerosol(ig,l,iaer)/CLFtot
244                        aerosol(ig,l,iaer) = max(aerosol(ig,l,iaer),1.e-9)
245                     enddo
246                  enddo
247              end if!(CLFvarying)
248            endif !(aerofixed.or.(i_h2oice.eq.0).or.clearsky)
249             
250      end if ! End if h2o aerosol
251
252!==================================================================
253!             Dust
254!==================================================================
255      if (iaero_dust.ne.0) then
256          iaer=iaero_dust
257!         1. Initialization
258          aerosol(1:ngrid,1:nlayer,iaer)=0.0
259         
260          topdust=30.0 ! km  (used to be 10.0 km) LK
261
262!       2. Opacity calculation
263
264!           expfactor=0.
265           DO l=1,nlayer-1
266             DO ig=1,ngrid
267!             Typical mixing ratio profile
268
269                 zp=(pplev(ig,1)/pplay(ig,l))**(70./topdust)
270                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
271
272!             Vertical scaling function
273              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) &
274               *expfactor
275
276
277             ENDDO
278           ENDDO
279
280!          Rescaling each layer to reproduce the choosen (or assimilated)
281!          dust extinction opacity at visible reference wavelength, which
282!          is scaled to the surface pressure pplev(ig,1)
283
284            taudusttmp(1:ngrid)=0.
285              DO l=1,nlayer
286                DO ig=1,ngrid
287                   taudusttmp(ig) = taudusttmp(ig) &
288                          +  aerosol(ig,l,iaer)
289                ENDDO
290              ENDDO
291            DO l=1,nlayer-1
292               DO ig=1,ngrid
293                  aerosol(ig,l,iaer) = max(1E-20, &
294                          dusttau &
295                       *  pplev(ig,1) / pplev(ig,1) &
296                       *  aerosol(ig,l,iaer) &
297                       /  taudusttmp(ig))
298
299              ENDDO
300            ENDDO
301      end if ! If dust aerosol   
302
303!==================================================================
304!           H2SO4
305!==================================================================
306! added by LK
307      if (iaero_h2so4.ne.0) then
308         iaer=iaero_h2so4
309
310!       1. Initialization
311         aerosol(1:ngrid,1:nlayer,iaer)=0.0
312
313
314!       2. Opacity calculation
315
316!           expfactor=0.
317         DO l=1,nlayer-1
318            DO ig=1,ngrid
319!              Typical mixing ratio profile
320
321               zp=(pplev(ig,1)/pplay(ig,l))**(70./30) !emulating topdust
322               expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
323
324!             Vertical scaling function
325               aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1))*expfactor
326
327            ENDDO
328         ENDDO
329         tauh2so4tmp(1:ngrid)=0.
330         DO l=1,nlayer
331            DO ig=1,ngrid
332               tauh2so4tmp(ig) = tauh2so4tmp(ig) + aerosol(ig,l,iaer)
333            ENDDO
334         ENDDO
335         DO l=1,nlayer-1
336            DO ig=1,ngrid
337               aerosol(ig,l,iaer) = max(1E-20, &
338                          1 &
339                       *  pplev(ig,1) / pplev(ig,1) &
340                       *  aerosol(ig,l,iaer) &
341                       /  tauh2so4tmp(ig))
342
343            ENDDO
344         ENDDO
345
346! 1/700. is assuming a "sulfurtau" of 1
347! Sulfur aerosol routine to be improved.
348!                     aerosol0 =                         &
349!                          (  0.75 * QREFvis3d(ig,l,iaer) /        &
350!                          ( rho_h2so4 * reffrad(ig,l,iaer) )  ) *   &
351!                          ( pq(ig,l,i_h2so4) + 1.E-9 ) *         &
352!                          ( pplev(ig,l) - pplev(ig,l+1) ) / g
353!                     aerosol0           = max(aerosol0,1.e-9)
354!                     aerosol0           = min(aerosol0,L_TAUMAX)
355!                     aerosol(ig,l,iaer) = aerosol0
356
357!                  ENDDO
358!               ENDDO
359      end if
360 
361           
362!     ---------------------------------------------------------
363!==================================================================
364!    Two-layer aerosols (unknown composition)
365!    S. Guerlet (2013)
366!==================================================================
367
368      if (iaero_back2lay .ne.0) then
369           iaer=iaero_back2lay
370!       1. Initialization
371            aerosol(1:ngrid,1:nlayer,iaer)=0.0
372!       2. Opacity calculation
373          DO ig=1,ngrid
374           DO l=1,nlayer-1
375             aerosol(ig,l,iaer) = ( pplev(ig,l) - pplev(ig,l+1) )
376             !! 1. below tropospheric layer: no aerosols
377             IF (pplev(ig,l) .gt. pres_bottom_tropo) THEN
378               aerosol(ig,l,iaer) = 0.*aerosol(ig,l,iaer)
379             !! 2. tropo layer
380             ELSEIF (pplev(ig,l) .le. pres_bottom_tropo .and. pplev(ig,l) .ge. pres_top_tropo) THEN
381               aerosol(ig,l,iaer) = obs_tau_col_tropo*aerosol(ig,l,iaer)
382             !! 3. linear transition
383             ELSEIF (pplev(ig,l) .lt. pres_top_tropo .and. pplev(ig,l) .gt. pres_bottom_strato) THEN
384               expfactor=log(obs_tau_col_strato/obs_tau_col_tropo)/log(pres_bottom_strato/pres_top_tropo)
385               aerosol(ig,l,iaer)= obs_tau_col_tropo*((pplev(ig,l)/pres_top_tropo)**expfactor)*aerosol(ig,l,iaer)/1.5
386             !! 4. strato layer
387             ELSEIF (pplev(ig,l) .le. pres_bottom_strato .and. pplev(ig,l) .gt. pres_top_strato) THEN
388               aerosol(ig,l,iaer)= obs_tau_col_strato*aerosol(ig,l,iaer)
389             !! 5. above strato layer: no aerosols
390             ELSEIF (pplev(ig,l) .lt. pres_top_strato) THEN
391               aerosol(ig,l,iaer) = 0.*aerosol(ig,l,iaer)
392             ENDIF
393           ENDDO
394          ENDDO
395
396 !       3. Re-normalize to observed total column
397         tau_col(:)=0.0
398         DO l=1,nlayer
399          DO ig=1,ngrid
400               tau_col(ig) = tau_col(ig) &
401                     + aerosol(ig,l,iaer)/(obs_tau_col_tropo+obs_tau_col_strato)
402            ENDDO
403         ENDDO
404
405         DO ig=1,ngrid
406           DO l=1,nlayer-1
407                aerosol(ig,l,iaer)=aerosol(ig,l,iaer)/tau_col(ig)
408           ENDDO
409         ENDDO
410
411
412      end if ! if Two-layer aerosols 
413
414
415! --------------------------------------------------------------------------
416! Column integrated visible optical depth in each point (used for diagnostic)
417
418      tau_col(:)=0.0
419      do iaer = 1, naerkind
420         do l=1,nlayer
421            do ig=1,ngrid
422               tau_col(ig) = tau_col(ig) + aerosol(ig,l,iaer)
423            end do
424         end do
425      end do
426
427      do ig=1,ngrid
428         do l=1,nlayer
429            do iaer = 1, naerkind
430               if(aerosol(ig,l,iaer).gt.1.e3)then
431                  print*,'WARNING: aerosol=',aerosol(ig,l,iaer)
432                  print*,'at ig=',ig,',  l=',l,', iaer=',iaer
433                  print*,'QREFvis3d=',QREFvis3d(ig,l,iaer)
434                  print*,'reffrad=',reffrad(ig,l,iaer)
435               endif
436            end do
437         end do
438      end do
439
440      do ig=1,ngrid
441         if(tau_col(ig).gt.1.e3)then
442            print*,'WARNING: tau_col=',tau_col(ig)
443            print*,'at ig=',ig
444            print*,'aerosol=',aerosol(ig,:,:)
445            print*,'QREFvis3d=',QREFvis3d(ig,:,:)
446            print*,'reffrad=',reffrad(ig,:,:)
447         endif
448      end do
449      return
450    end subroutine aeropacity
451     
Note: See TracBrowser for help on using the repository browser.