Ignore:
Timestamp:
Jul 22, 2024, 9:29:09 PM (2 months ago)
Author:
abarral
Message:

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/splaeropt_5wv_rrtm.f90

    r5098 r5099  
    1 !
     1
    22! $Id: splaeropt_5wv_rrtm.F90 2644 2016-10-02 16:55:08Z oboucher $
    3 !
    43
    5 SUBROUTINE SPLAEROPT_5WV_RRTM(  &
    6    zdm, zdh, tr_seri, RHcl,    &
    7    tausum, tau )
     4SUBROUTINE SPLAEROPT_5WV_RRTM(&
     5        zdm, zdh, tr_seri, RHcl, &
     6        tausum, tau)
    87
    98  USE DIMPHY
    109  USE aero_mod
    11   USE infotrac_phy, ONLY: nqtot, nbtr, tracers
    12   USE phys_local_var_mod, ONLY: od550aer,od865aer,ec550aer,od550lt1aer
    13   !
     10  USE infotrac_phy, ONLY : nqtot, nbtr, tracers
     11  USE phys_local_var_mod, ONLY : od550aer, od865aer, ec550aer, od550lt1aer
     12
    1413  ! Olivier Boucher Jan 2017
    1514  ! Based on Mie routines on ciclad CMIP6
    16   !
     15
    1716  IMPLICIT NONE
    18   !
     17
    1918  ! Input arguments:
    20   !
    21   REAL, DIMENSION(klon,klev), INTENT(IN)  :: zdh      !--m
    22   REAL, DIMENSION(klon,klev), INTENT(IN)  :: zdm      !--kg/m2
    23   REAL, DIMENSION(klon,klev), INTENT(IN)  :: RHcl     ! humidite relative ciel clair
    24   REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri
    25   !
     19
     20  REAL, DIMENSION(klon, klev), INTENT(IN) :: zdh      !--m
     21  REAL, DIMENSION(klon, klev), INTENT(IN) :: zdm      !--kg/m2
     22  REAL, DIMENSION(klon, klev), INTENT(IN) :: RHcl     ! humidite relative ciel clair
     23  REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tr_seri
     24
    2625  ! Output arguments:
    27   !
    28   REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)      :: tausum
    29   REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau
    30   !
     26
     27  REAL, DIMENSION(klon, nwave, naero_tot), INTENT(OUT) :: tausum
     28  REAL, DIMENSION(klon, klev, nwave, naero_tot), INTENT(OUT) :: tau
     29
    3130  ! Local
    32   !
     31
    3332  INTEGER, PARAMETER :: las = nwave_sw
    3433  LOGICAL :: soluble
    35  
     34
    3635  INTEGER :: i, k, m, iq, itr, irh, aerindex
    3736  INTEGER :: spsol, spinsol, la
    38   INTEGER :: RH_num(klon,klev)
     37  INTEGER :: RH_num(klon, klev)
    3938  INTEGER, PARAMETER :: la443 = 1
    4039  INTEGER, PARAMETER :: la550 = 2
    … …  
    4241  INTEGER, PARAMETER :: la765 = 4
    4342  INTEGER, PARAMETER :: la865 = 5
    44   INTEGER, PARAMETER :: nbre_RH=12
    45   INTEGER, PARAMETER :: naero_soluble=2
    46   INTEGER, PARAMETER :: naero_insoluble=2
    47   INTEGER, PARAMETER :: naero=naero_soluble+naero_insoluble
     43  INTEGER, PARAMETER :: nbre_RH = 12
     44  INTEGER, PARAMETER :: naero_soluble = 2
     45  INTEGER, PARAMETER :: naero_insoluble = 2
     46  INTEGER, PARAMETER :: naero = naero_soluble + naero_insoluble
    4847
    49   REAL, PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
    50   REAL, PARAMETER :: RH_MAX=95.
    51   REAL :: delta(klon,klev), rh(klon,klev)
     48  REAL, PARAMETER :: RH_tab(nbre_RH) = (/0., 10., 20., 30., 40., 50., 60., 70., 80., 85., 90., 95./)
     49  REAL, PARAMETER :: RH_MAX = 95.
     50  REAL :: delta(klon, klev), rh(klon, klev)
    5251  REAL :: tau_ae5wv_int   ! Intermediate computation of epaisseur optique aerosol
    5352  REAL :: zrho
    5453  CHARACTER*20 modname
    55  
     54
    5655  ! Soluble components 1-accumulation mode soluble; 2- seasalt coarse
    57   REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble)   ! Ext. coeff. ** m2/g
     56  REAL :: alpha_aers_5wv(nbre_RH, las, naero_soluble)   ! Ext. coeff. ** m2/g
    5857  ! Insoluble components 1- Dust: 2- BC; 3- POM
    59   REAL :: alpha_aeri_5wv(las,naero_insoluble)         ! Ext. coeff. ** m2/g
    60   !
     58  REAL :: alpha_aeri_5wv(las, naero_insoluble)         ! Ext. coeff. ** m2/g
     59
    6160  ! Proprietes optiques
    62   !
     61
    6362  REAL :: fact_RH(nbre_RH)
    6463
    65 ! From here on we look at the optical parameters at 5 wavelengths: 
    66 ! 443nm, 550, 670, 765 and 865 nm
    67 !                                   le 12 AVRIL 2006
    68 ! 
    69  DATA alpha_aers_5wv/ &
    70                            ! accumulation mode (sulfate+2% bc) soluble
    71        4.632, 4.632, 4.632, 4.632, 6.206, 6.827, 7.616, 8.716,10.514,12.025,14.688,21.539, &
    72        3.981, 3.981, 3.981, 3.981, 5.346, 5.923, 6.662, 7.704, 9.437,10.914,13.562,20.591, &
    73        3.265, 3.265, 3.265, 3.265, 4.400, 4.909, 5.565, 6.500, 8.081, 9.449,11.943,18.791, &
    74        2.761, 2.761, 2.761, 2.761, 3.731, 4.182, 4.767, 5.606, 7.041, 8.294,10.610,17.118, &
    75        2.307, 2.307, 2.307, 2.307, 3.129, 3.522, 4.034, 4.774, 6.052, 7.180, 9.286,15.340, &
     64  ! From here on we look at the optical parameters at 5 wavelengths:
     65  ! 443nm, 550, 670, 765 and 865 nm
     66  !                                   le 12 AVRIL 2006
    7667
    77                            ! seasalt seasalt Coarse Soluble (CS)     
    78        0.576, 0.690, 0.738, 0.789, 0.855, 0.935, 1.046, 1.212, 1.512, 1.785, 2.258, 3.449, &
    79        0.595, 0.713, 0.763, 0.814, 0.880, 0.963, 1.079, 1.248, 1.550, 1.826, 2.306, 3.507, &
    80        0.617, 0.738, 0.789, 0.842, 0.911, 0.996, 1.113, 1.286, 1.592, 1.871, 2.369, 3.562, &
    81        0.632, 0.755, 0.808, 0.862, 0.931, 1.018, 1.140, 1.316, 1.626, 1.909, 2.409, 3.622, &
    82        0.645, 0.771, 0.825, 0.880, 0.951, 1.039, 1.164, 1.344, 1.661, 1.948, 2.455, 3.682  /
     68  DATA alpha_aers_5wv/ &
     69          ! accumulation mode (sulfate+2% bc) soluble
     70          4.632, 4.632, 4.632, 4.632, 6.206, 6.827, 7.616, 8.716, 10.514, 12.025, 14.688, 21.539, &
     71          3.981, 3.981, 3.981, 3.981, 5.346, 5.923, 6.662, 7.704, 9.437, 10.914, 13.562, 20.591, &
     72          3.265, 3.265, 3.265, 3.265, 4.400, 4.909, 5.565, 6.500, 8.081, 9.449, 11.943, 18.791, &
     73          2.761, 2.761, 2.761, 2.761, 3.731, 4.182, 4.767, 5.606, 7.041, 8.294, 10.610, 17.118, &
     74          2.307, 2.307, 2.307, 2.307, 3.129, 3.522, 4.034, 4.774, 6.052, 7.180, 9.286, 15.340, &
     75
     76          ! seasalt seasalt Coarse Soluble (CS)
     77          0.576, 0.690, 0.738, 0.789, 0.855, 0.935, 1.046, 1.212, 1.512, 1.785, 2.258, 3.449, &
     78          0.595, 0.713, 0.763, 0.814, 0.880, 0.963, 1.079, 1.248, 1.550, 1.826, 2.306, 3.507, &
     79          0.617, 0.738, 0.789, 0.842, 0.911, 0.996, 1.113, 1.286, 1.592, 1.871, 2.369, 3.562, &
     80          0.632, 0.755, 0.808, 0.862, 0.931, 1.018, 1.140, 1.316, 1.626, 1.909, 2.409, 3.622, &
     81          0.645, 0.771, 0.825, 0.880, 0.951, 1.039, 1.164, 1.344, 1.661, 1.948, 2.455, 3.682  /
    8382
    8483  DATA alpha_aeri_5wv/ &
    85                                  ! coarse dust insoluble
    86        0.605, 0.611, 0.661, 0.714, 0.760, &
    87                                  ! super coarse insoluble
    88        0.153, 0.156, 0.158, 0.157, 0.161 /
    89   !
     84          ! coarse dust insoluble
     85          0.605, 0.611, 0.661, 0.714, 0.760, &
     86          ! super coarse insoluble
     87          0.153, 0.156, 0.158, 0.157, 0.161 /
     88
    9089  ! Initialisations
    91   tausum(:,:,:)=0.
    92   tau(:,:,:,:)=0.
     90  tausum(:, :, :) = 0.
     91  tau(:, :, :, :) = 0.
    9392
    94   modname='splaeropt_5wv_rrtm'
     93  modname = 'splaeropt_5wv_rrtm'
    9594
    9695  IF (naero>naero_tot) THEN
    97     CALL abort_physic(modname,'Too many aerosol types',1)
     96    CALL abort_physic(modname, 'Too many aerosol types', 1)
    9897  ENDIF
    9998
    100   DO irh=1,nbre_RH-1
    101     fact_RH(irh)=1./(RH_tab(irh+1)-RH_tab(irh))
     99  DO irh = 1, nbre_RH - 1
     100    fact_RH(irh) = 1. / (RH_tab(irh + 1) - RH_tab(irh))
    102101  ENDDO
    103    
    104   DO k=1, klev
    105     DO i=1, klon
    106       rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
    107       RH_num(i,k) = INT( rh(i,k)/10. + 1.)
    108       IF (rh(i,k)>85.) RH_num(i,k)=10
    109       IF (rh(i,k)>90.) RH_num(i,k)=11
    110       delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
     102
     103  DO k = 1, klev
     104    DO i = 1, klon
     105      rh(i, k) = MIN(RHcl(i, k) * 100., RH_MAX)
     106      RH_num(i, k) = INT(rh(i, k) / 10. + 1.)
     107      IF (rh(i, k)>85.) RH_num(i, k) = 10
     108      IF (rh(i, k)>90.) RH_num(i, k) = 11
     109      delta(i, k) = (rh(i, k) - RH_tab(RH_num(i, k))) * fact_RH(RH_num(i, k))
    111110    ENDDO
    112111  ENDDO
    … …  
    115114  DO iq = 1, nqtot
    116115    IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    117     itr = itr+1
     116    itr = itr + 1
    118117    SELECT CASE(tracers(iq)%name)
    119       CASE('PREC'); CYCLE                                  !--precursor
    120       CASE('FINE'); soluble=.TRUE.;  spsol=1; aerindex=1   !--fine mode accumulation mode
    121       CASE('COSS'); soluble=.TRUE.;  spsol=2; aerindex=2   !--coarse mode sea salt
    122       CASE('CODU'); soluble=.FALSE.; spinsol=1; aerindex=3   !--coarse mode dust
    123       CASE('SCDU'); soluble=.FALSE.; spinsol=2; aerindex=4   !--super coarse mode dust
    124       CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(iq)%name,1)
     118    CASE('PREC'); CYCLE                                  !--precursor
     119    CASE('FINE'); soluble = .TRUE.;  spsol = 1; aerindex = 1   !--fine mode accumulation mode
     120    CASE('COSS'); soluble = .TRUE.;  spsol = 2; aerindex = 2   !--coarse mode sea salt
     121    CASE('CODU'); soluble = .FALSE.; spinsol = 1; aerindex = 3   !--coarse mode dust
     122    CASE('SCDU'); soluble = .FALSE.; spinsol = 2; aerindex = 4   !--super coarse mode dust
     123    CASE DEFAULT; CALL abort_physic(modname, 'I cannot do aerosol optics for ' // tracers(iq)%name, 1)
    125124    END SELECT
    126125
    127     DO la=1,las
     126    DO la = 1, las
    128127
    129128      !--only 550 and 865 nm are used
    … …  
    132131      IF (soluble) THEN  !--soluble aerosol with RH dependence
    133132
    134         DO k=1, klev
    135           DO i=1, klon
    136             tau_ae5wv_int = alpha_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* &
    137                            (alpha_aers_5wv(RH_num(i,k)+1,la,spsol) - &
    138                             alpha_aers_5wv(RH_num(i,k),la,spsol))
    139             tau(i,k,la,aerindex) = tr_seri(i,k,itr)*zdm(i,k)*tau_ae5wv_int
    140             tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
     133        DO k = 1, klev
     134          DO i = 1, klon
     135            tau_ae5wv_int = alpha_aers_5wv(RH_num(i, k), la, spsol) + DELTA(i, k) * &
     136                    (alpha_aers_5wv(RH_num(i, k) + 1, la, spsol) - &
     137                            alpha_aers_5wv(RH_num(i, k), la, spsol))
     138            tau(i, k, la, aerindex) = tr_seri(i, k, itr) * zdm(i, k) * tau_ae5wv_int
     139            tausum(i, la, aerindex) = tausum(i, la, aerindex) + tau(i, k, la, aerindex)
    141140          ENDDO
    142141        ENDDO
    … …  
    144143      ELSE               !--cases of insoluble aerosol
    145144
    146         DO k=1, klev
    147           DO i=1, klon
    148             tau_ae5wv_int = alpha_aeri_5wv(la,spinsol)
    149             tau(i,k,la,aerindex) = tr_seri(i,k,itr)*zdm(i,k)*tau_ae5wv_int
    150             tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex)
     145        DO k = 1, klev
     146          DO i = 1, klon
     147            tau_ae5wv_int = alpha_aeri_5wv(la, spinsol)
     148            tau(i, k, la, aerindex) = tr_seri(i, k, itr) * zdm(i, k) * tau_ae5wv_int
     149            tausum(i, la, aerindex) = tausum(i, la, aerindex) + tau(i, k, la, aerindex)
    151150          ENDDO
    152151        ENDDO
    … …  
    157156  ENDDO     ! Boucle sur les masses de traceurs
    158157
    159 !--AOD calculations for diagnostics
    160   od550aer(:)=SUM(tausum(:,la550,1:naero),dim=2)
    161   od865aer(:)=SUM(tausum(:,la865,1:naero),dim=2)
     158  !--AOD calculations for diagnostics
     159  od550aer(:) = SUM(tausum(:, la550, 1:naero), dim = 2)
     160  od865aer(:) = SUM(tausum(:, la865, 1:naero), dim = 2)
    162161
    163 !--extinction coefficient for diagnostic
    164   ec550aer(:,:)=SUM(tau(:,:,la550,1:naero),dim=3)/zdh(:,:)
     162  !--extinction coefficient for diagnostic
     163  ec550aer(:, :) = SUM(tau(:, :, la550, 1:naero), dim = 3) / zdh(:, :)
    165164
    166 !--aod for particles lower than 1 micron
    167   od550lt1aer(:)=tausum(:,la550,1)+tausum(:,la550,2)*0.3+tausum(:,la550,3)*0.2
     165  !--aod for particles lower than 1 micron
     166  od550lt1aer(:) = tausum(:, la550, 1) + tausum(:, la550, 2) * 0.3 + tausum(:, la550, 3) * 0.2
    168167
    169168END SUBROUTINE SPLAEROPT_5WV_RRTM
Note: See TracChangeset for help on using the changeset viewer.