GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/macv2sp.F90 Lines: 0 51 0.0 %
Date: 2023-06-30 12:56:34 Branches: 0 90 0.0 %

Line Branch Exec Source
1
SUBROUTINE MACv2SP(pphis,pplay,paprs,xlon,xlat,tau_allaer,piz_allaer,cg_allaer)
2
  !
3
  !--routine to read the MACv2SP plume and compute optical properties
4
  !--requires flag_aerosol = 7
5
  !--feeds into aerosol optical properties and newmicro cloud droplet size if ok_cdnc activated
6
  !--for this one needs to feed natural (pre-industrial) aerosols twice for nat and 1980 files
7
  !--pre-ind aerosols (index=1) are not changed, present-day aerosols (index=2) are incremented
8
  !--uses model year so year_cur needs to be correct in the model simulation
9
  !
10
  !--aod_prof = AOD per layer
11
  !--ssa_prof = SSA
12
  !--asy_prof = asymetry parameter
13
  !--dNovrN   = enhancement factor for CDNC
14
  !
15
  USE mo_simple_plumes, ONLY: sp_aop_profile
16
  USE phys_cal_mod, ONLY : year_cur, day_cur, year_len
17
  USE dimphy
18
  USE aero_mod
19
  USE phys_local_var_mod, ONLY: t_seri, od443aer, od550aer, od865aer, ec550aer, dryod550aer, od550lt1aer, dNovrN
20
  !!USE YOMCST, ONLY : RD, RG
21
  !
22
  IMPLICIT NONE
23
  !
24
  include "YOMCST.h"
25
  !
26
  REAL,DIMENSION(klon),INTENT(IN)        :: pphis   ! Geopotentiel de surface
27
  REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
28
  REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour les interfaces de chaque couche (en Pa)
29
  REAL,DIMENSION(klon),INTENT(IN)        :: xlat    ! latitudes pour chaque point
30
  REAL,DIMENSION(klon),INTENT(IN)        :: xlon    ! longitudes pour chaque point
31
  !
32
  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: tau_allaer !  epaisseur optique aerosol
33
  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: piz_allaer !  single scattering albedo aerosol
34
  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: cg_allaer  !  asymmetry parameter aerosol
35
  !
36
  REAL,DIMENSION(klon,klev) :: aod_prof, ssa_prof, asy_prof
37
  REAL,DIMENSION(klon,klev) :: z, dz
38
  REAL,DIMENSION(klon)      :: oro, zrho, zt
39
  !
40
  INTEGER, PARAMETER :: nmon = 12
41
  !
42
  REAL, PARAMETER    :: l443 = 443.0, l550 = 550.0, l865 = 865.0 !--wavelengths in nm
43
  !
44
  INTEGER, PARAMETER :: Nwvmax=25
45
  REAL, DIMENSION(0:Nwvmax), PARAMETER :: lambda=(/ 240.0, &  !--this one is for band 1
46
                  280.0,  300.0,  330.0,  360.0,  400.0,   &  !--these are bounds of Streamer bands
47
                  440.0,  480.0,  520.0,  570.0,  640.0,   &
48
                  690.0,  750.0,  780.0,  870.0, 1000.0,   &
49
                 1100.0, 1190.0, 1280.0, 1530.0, 1640.0,   &
50
                 2130.0, 2380.0, 2910.0, 3420.0, 4000.0   /)
51
  !
52
  REAL, DIMENSION(1:Nwvmax-1), PARAMETER :: weight =(/    &   !--and the weights to be given to the bands
53
                 0.01,  4.05,  9.51, 15.99, 26.07, 33.10, &   !--corresponding to a typical solar spectrum
54
                33.07, 39.91, 52.67, 27.89, 43.60, 13.67, &
55
                42.22, 40.12, 32.70, 14.44, 19.48, 14.23, &
56
                13.43, 16.42,  8.33,  0.95,  0.65,  2.76  /)
57
  !
58
  REAL :: zlambda, zweight
59
  REAL :: year_fr
60
  !
61
  INTEGER band, i, k, Nwv
62
  !
63
  ! define the height and dheight arrays
64
  !
65
  oro(:)  = pphis(:)/RG                             ! surface height in m
66
  !
67
  DO k = 1, klev
68
    zrho(:) = pplay(:,k)/t_seri(:,k)/RD                         ! air density in kg/m3
69
    dz(:,k) = (paprs(:,k)-paprs(:,k+1))/zrho(:)/RG              ! layer thickness in m
70
    IF (k==1) THEN
71
       z(:,1) = oro(:) + (paprs(:,1)-pplay(:,1))/zrho(:)/RG     ! altitude middle of first layer in m
72
       zt(:)  = oro(:) + dz(:,1)                                ! altitude top of first layer in m
73
    ELSE
74
      z(:,k) = zt(:) + (paprs(:,k)-pplay(:,k))/zrho(:)/RG       ! altitude middle of layer k in m
75
      zt(:)  = zt(:) + dz(:,k)                                  ! altitude top of layer k in m
76
    ENDIF
77
  ENDDO
78
  !
79
  !--fractional year
80
  !
81
  year_fr = FLOAT(year_cur) + (FLOAT(day_cur)-0.5) / FLOAT(year_len)
82
  IF (year_fr.LT.1850.0.OR.year_fr.GE.2017.0) THEN
83
     CALL abort_physic ('macv2sp','year not supported by plume model',1)
84
  ENDIF
85
  !
86
  !--call to sp routine -- 443 nm
87
  !
88
  CALL sp_aop_profile                                    ( &
89
       klev     ,klon ,l443 ,oro    ,xlon     ,xlat      , &
90
       year_fr  ,z    ,dz   ,dNovrN ,aod_prof ,ssa_prof  , &
91
       asy_prof )
92
  !
93
  !--AOD calculations for diagnostics
94
  od443aer(:)= od443aer(:)+SUM(aod_prof(:,:),dim=2)
95
  !
96
  !--call to sp routine -- 550 nm
97
  !
98
  CALL sp_aop_profile                                    ( &
99
       klev     ,klon ,l550 ,oro    ,xlon     ,xlat      , &
100
       year_fr  ,z    ,dz   ,dNovrN ,aod_prof ,ssa_prof  , &
101
       asy_prof )
102
  !
103
  !--AOD calculations for diagnostics
104
  od550aer(:)=od550aer(:)+SUM(aod_prof(:,:),dim=2)
105
  !
106
  !--dry AOD calculation for diagnostics
107
  dryod550aer(:)=dryod550aer(:)+od550aer(:)
108
  !
109
  !--fine-mode AOD calculation for diagnostics
110
  od550lt1aer(:)=od550lt1aer(:)+od550aer(:)
111
  !
112
  !--extinction coefficient for diagnostic
113
  ec550aer(:,:)=ec550aer(:,:)+aod_prof(:,:)/dz(:,:)
114
  !
115
  !--call to sp routine -- 865 nm
116
  !
117
  CALL sp_aop_profile                                    ( &
118
       klev     ,klon ,l865 ,oro    ,xlon     ,xlat      , &
119
       year_fr  ,z    ,dz   ,dNovrN ,aod_prof ,ssa_prof  , &
120
       asy_prof )
121
  !
122
  !--AOD calculations for diagnostics
123
  od865aer(:)=od865aer(:)+SUM(aod_prof(:,:),dim=2)
124
  !
125
  !--re-weighting of piz and cg arrays before adding the anthropogenic aerosols
126
  !--index 2 = all natural + anthropogenic aerosols
127
  piz_allaer(:,:,2,:)=piz_allaer(:,:,2,:)*tau_allaer(:,:,2,:)
128
  cg_allaer(:,:,2,:) =cg_allaer(:,:,2,:)*piz_allaer(:,:,2,:)
129
  !
130
  !--now computing the same at many wavelengths to fill the model bands
131
  !
132
  DO Nwv=0,Nwvmax-1
133
134
    IF (Nwv.EQ.0) THEN          !--RRTM spectral band 1
135
      zlambda=lambda(Nwv)
136
      zweight=1.0
137
      band=1
138
    ELSEIF (Nwv.LE.5) THEN      !--RRTM spectral band 2
139
      zlambda=0.5*(lambda(Nwv)+lambda(Nwv+1))
140
      zweight=weight(Nwv)/SUM(weight(1:5))
141
      band=2
142
    ELSEIF (Nwv.LE.10) THEN     !--RRTM spectral band 3
143
      zlambda=0.5*(lambda(Nwv)+lambda(Nwv+1))
144
      zweight=weight(Nwv)/SUM(weight(6:10))
145
      band=3
146
    ELSEIF (Nwv.LE.16) THEN     !--RRTM spectral band 4
147
      zlambda=0.5*(lambda(Nwv)+lambda(Nwv+1))
148
      zweight=weight(Nwv)/SUM(weight(11:16))
149
      band=4
150
    ELSEIF (Nwv.LE.21) THEN     !--RRTM spectral band 5
151
      zlambda=0.5*(lambda(Nwv)+lambda(Nwv+1))
152
      zweight=weight(Nwv)/SUM(weight(17:21))
153
      band=5
154
    ELSE                        !--RRTM spectral band 6
155
      zlambda=0.5*(lambda(Nwv)+lambda(Nwv+1))
156
      zweight=weight(Nwv)/SUM(weight(22:Nwvmax-1))
157
      band=6
158
    ENDIF
159
    !
160
    CALL sp_aop_profile                                       ( &
161
         klev     ,klon ,zlambda ,oro    ,xlon     ,xlat      , &
162
         year_fr  ,z    ,dz      ,dNovrN ,aod_prof ,ssa_prof  , &
163
         asy_prof )
164
    !
165
    !--adding up the quantities tau, piz*tau and cg*piz*tau
166
    tau_allaer(:,:,2,band)=tau_allaer(:,:,2,band)+zweight*MAX(aod_prof(:,:),1.e-15)
167
    piz_allaer(:,:,2,band)=piz_allaer(:,:,2,band)+zweight*MAX(aod_prof(:,:),1.e-15)*ssa_prof(:,:)
168
    cg_allaer(:,:,2,band) =cg_allaer(:,:,2,band) +zweight*MAX(aod_prof(:,:),1.e-15)*ssa_prof(:,:)*asy_prof(:,:)
169
    !
170
  ENDDO
171
  !
172
  !--renpomalizing cg and piz now that MACv2SP increments have been added
173
  cg_allaer(:,:,2,:) =cg_allaer(:,:,2,:) /piz_allaer(:,:,2,:)
174
  piz_allaer(:,:,2,:)=piz_allaer(:,:,2,:)/tau_allaer(:,:,2,:)
175
  !
176
END SUBROUTINE MACv2SP