source: LMDZ6/trunk/libf/phylmd/Dust/splaeropt_lw_rrtm.F90 @ 4056

Last change on this file since 4056 was 4056, checked in by dcugnet, 2 years ago

Most of the changes are intended to help to eventually remove the constraints about the tracers assumptions, in particular water tracers.

  • Remove index tables itr_indice and niadv, replaced by tracers(:)%isAdvected and tracers(:)%isH2OFamily. Most of the loops are now from 1 to nqtot:
    • DO iq=nqo+1,nqtot loops are replaced with: DO iq=1,nqtot

IF(tracers(iq)%isH2Ofamily) CYCLE

  • DO it=1,nbtr; iq=niadv(it+nqo)

and DO it=1,nqtottr; iq=itr_indice(it) loops are replaced with:

it = 0
DO iq = 1, nqtot

IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
it = it+1

  • Move some StratAer? related code from infotrac to infotrac_phy
  • Remove "nqperes" variable:

DO iq=1,nqpere loops are replaced with:
DO iq=1,nqtot

IF(tracers(iq)%parent/='air') CYCLE

  • Cosmetic changes (justification, SELECT CASE instead of multiple IF...) mostly in advtrac* routines.
File size: 2.7 KB
Line 
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
10  USE dimphy
11  USE aero_mod
12  USE infotrac_phy, ONLY: nqtot, nbtr, tracers
13  USE phys_state_var_mod, ONLY : tau_aero_lw_rrtm
14  USE YOERAD, ONLY : NLW
15
16  IMPLICIT NONE
17
18  INCLUDE "clesphys.h"
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  !
32  INTEGER inu, itr, iq, spinsol
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    !
56   
57    itr = 0
58    DO iq = 1, nqtot
59      IF(tracers(iq)%isH2Ofamily) CYCLE
60      itr = itr+1
61      SELECT CASE(tracers(iq)%name)
62        CASE('PREC','FINE','COSS'); CYCLE                  !--precursor or fine/coarde accumulation mode
63        CASE('CODU'); spinsol=1                            !--coarse mode dust
64        CASE('SCDU'); spinsol=2                            !--super coarse mode dust
65        CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(iq)%name,1)
66      END SELECT
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.