source: LMDZ6/trunk/libf/phylmd/Dust/splaeropt_lw_rrtm.f90 @ 5301

Last change on this file since 5301 was 5282, checked in by abarral, 4 days ago

Turn iniprint.h clesphys.h into modules
Remove unused description.h

File size: 2.7 KB
RevLine 
[2753]1!
2! splaeropt_lw_rrtm.F90 2014-05-13 C. Kleinschmitt
3!                      2016-05-03 O. Boucher
4!
5! This routine feeds aerosol LW properties to RRTM
6! we only consider absorption (not scattering)
7
8SUBROUTINE SPLAEROPT_LW_RRTM(ok_alw,zdm,tr_seri)
9
[5282]10  USE clesphys_mod_h
[2753]11  USE dimphy
12  USE aero_mod
[4056]13  USE infotrac_phy, ONLY: nqtot, nbtr, tracers
[2753]14  USE phys_state_var_mod, ONLY : tau_aero_lw_rrtm
15  USE YOERAD, ONLY : NLW
16
17  IMPLICIT NONE
18
19  !
20  ! Input arguments:
21  !
22  LOGICAL, INTENT(IN) :: ok_alw
23  REAL, DIMENSION(klon,klev), INTENT(IN)      :: zdm
24  REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri
25  !
26  ! Local arguments :
27  !
28  INTEGER, PARAMETER :: naero_soluble=2    ! 1- accumulation soluble; 2- coarse soluble
29  INTEGER, PARAMETER :: naero_insoluble=2  ! 1- coarse dust; 2- supercoarse dust
30  INTEGER, PARAMETER :: naero=naero_soluble+naero_insoluble
31  !
[4056]32  INTEGER inu, itr, iq, spinsol
[2753]33  CHARACTER*20 modname
34  !
35  !--absorption coefficient for coarse and super-coarse DUST
36  REAL:: alpha_abs_CIDUST_16bands(nbands_lw_rrtm,naero_insoluble)   !--unit m2/g
37  DATA alpha_abs_CIDUST_16bands /                         &
38   ! Dust CO insoluble
39  0.001, 0.003, 0.005, 0.006, 0.011, 0.031, 0.157, 0.102, &
40  0.017, 0.056, 0.032, 0.008, 0.010, 0.011, 0.013, 0.016, &
41   ! Dust SC insoluble
42  0.002, 0.004, 0.007, 0.010, 0.018, 0.043, 0.099, 0.071, &
43  0.021, 0.056, 0.033, 0.011, 0.013, 0.014, 0.016, 0.018 /
44
45  modname='splaeropt_lw_rrtm'
46  !
47  IF (NLW.NE.nbands_lw_rrtm) THEN
48    CALL abort_physic(modname,'Erreur NLW doit etre egal a 16 pour cette routine',1)
49  ENDIF
50  !
51  IF (ok_alw) THEN
52    !
53    !--initialisation
54    tau_aero_lw_rrtm = 0.0
55    !
[4056]56   
57    itr = 0
58    DO iq = 1, nqtot
[4071]59      IF(.NOT.tracers(iq)%isInPhysics) CYCLE
[4056]60      itr = itr+1
61      SELECT CASE(tracers(iq)%name)
62        CASE('PREC','FINE','COSS'); CYCLE                  !--precursor or fine/coarde accumulation mode
[4046]63        CASE('CODU'); spinsol=1                            !--coarse mode dust
64        CASE('SCDU'); spinsol=2                            !--super coarse mode dust
[4056]65        CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(iq)%name,1)
[4046]66      END SELECT
[2753]67      !
68      DO inu=1,NLW
69        !
70        !--total aerosol
71        tau_aero_lw_rrtm(:,:,2,inu) = tau_aero_lw_rrtm(:,:,2,inu) + tr_seri(:,:,itr)*zdm(:,:)*alpha_abs_CIDUST_16bands(inu,spinsol)
72        !--no aerosol at all
73        tau_aero_lw_rrtm(:,:,1,inu) = tau_aero_lw_rrtm(:,:,1,inu) + 0.0
74        !
75      ENDDO
76    !
77    ENDDO
78    !
79    !--avoid very small values
80    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
81    !
82  ELSE
83    !--default value
84    tau_aero_lw_rrtm = 1.e-15
85  ENDIF
86  !
87END SUBROUTINE SPLAEROPT_LW_RRTM
Note: See TracBrowser for help on using the repository browser.