[2004] | 1 | ! $Id: readaerosol_optic_rrtm.F90 2005 2014-04-04 12:59:37Z lguez $ |
---|
| 2 | ! |
---|
| 3 | SUBROUTINE readaerosol_optic_rrtm(debut, new_aod, flag_aerosol, itap, rjourvrai, & |
---|
| 4 | pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & |
---|
| 5 | mass_solu_aero, mass_solu_aero_pi, & |
---|
| 6 | tau_aero, piz_aero, cg_aero, & |
---|
| 7 | tausum_aero, tau3d_aero ) |
---|
| 8 | |
---|
| 9 | ! This routine will : |
---|
| 10 | ! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol |
---|
| 11 | ! 2) calculate the optical properties for the aerosols |
---|
| 12 | ! |
---|
| 13 | |
---|
| 14 | USE dimphy |
---|
| 15 | USE aero_mod |
---|
| 16 | USE phys_local_var_mod, only: sconcso4,sconcoa,sconcbc,sconcss,sconcdust, & |
---|
| 17 | concso4,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, & |
---|
| 18 | load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7 |
---|
| 19 | IMPLICIT NONE |
---|
| 20 | include "clesphys.h" |
---|
| 21 | |
---|
| 22 | ! Input arguments |
---|
| 23 | !**************************************************************************************** |
---|
| 24 | LOGICAL, INTENT(IN) :: debut |
---|
| 25 | LOGICAL, INTENT(IN) :: new_aod |
---|
| 26 | INTEGER, INTENT(IN) :: flag_aerosol |
---|
| 27 | INTEGER, INTENT(IN) :: itap |
---|
| 28 | REAL, INTENT(IN) :: rjourvrai |
---|
| 29 | REAL, INTENT(IN) :: pdtphys |
---|
| 30 | REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay |
---|
| 31 | REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs |
---|
| 32 | REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri |
---|
| 33 | REAL, DIMENSION(klon,klev), INTENT(IN) :: rhcl ! humidite relative ciel clair |
---|
| 34 | REAL, DIMENSION(klev), INTENT(IN) :: presnivs |
---|
| 35 | |
---|
| 36 | ! Output arguments |
---|
| 37 | !**************************************************************************************** |
---|
| 38 | REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero ! Total mass for all soluble aerosols |
---|
| 39 | REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero_pi ! -"- preindustrial values |
---|
| 40 | REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero ! Aerosol optical thickness |
---|
| 41 | REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero ! Single scattering albedo aerosol |
---|
| 42 | REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero ! asymmetry parameter aerosol |
---|
| 43 | ! REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT) :: tausum_aero |
---|
| 44 | ! REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT) :: tau3d_aero |
---|
| 45 | !--correction minibug OB |
---|
| 46 | REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT) :: tausum_aero |
---|
| 47 | REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau3d_aero |
---|
| 48 | |
---|
| 49 | ! Local variables |
---|
| 50 | !**************************************************************************************** |
---|
| 51 | REAL, DIMENSION(klon) :: aerindex ! POLDER aerosol index |
---|
| 52 | REAL, DIMENSION(klon,klev) :: sulfate ! SO4 aerosol concentration [ug/m3] |
---|
| 53 | REAL, DIMENSION(klon,klev) :: bcsol ! BC soluble concentration [ug/m3] |
---|
| 54 | REAL, DIMENSION(klon,klev) :: bcins ! BC insoluble concentration [ug/m3] |
---|
| 55 | REAL, DIMENSION(klon,klev) :: pomsol ! POM soluble concentration [ug/m3] |
---|
| 56 | REAL, DIMENSION(klon,klev) :: pomins ! POM insoluble concentration [ug/m3] |
---|
| 57 | REAL, DIMENSION(klon,klev) :: cidust ! DUST aerosol concentration [ug/m3] |
---|
| 58 | REAL, DIMENSION(klon,klev) :: sscoarse ! SS Coarse concentration [ug/m3] |
---|
| 59 | REAL, DIMENSION(klon,klev) :: sssupco ! SS Super Coarse concentration [ug/m3] |
---|
| 60 | REAL, DIMENSION(klon,klev) :: ssacu ! SS Acumulation concentration [ug/m3] |
---|
| 61 | REAL, DIMENSION(klon,klev) :: sulfate_pi |
---|
| 62 | REAL, DIMENSION(klon,klev) :: bcsol_pi |
---|
| 63 | REAL, DIMENSION(klon,klev) :: bcins_pi |
---|
| 64 | REAL, DIMENSION(klon,klev) :: pomsol_pi |
---|
| 65 | REAL, DIMENSION(klon,klev) :: pomins_pi |
---|
| 66 | REAL, DIMENSION(klon,klev) :: cidust_pi |
---|
| 67 | REAL, DIMENSION(klon,klev) :: sscoarse_pi |
---|
| 68 | REAL, DIMENSION(klon,klev) :: sssupco_pi |
---|
| 69 | REAL, DIMENSION(klon,klev) :: ssacu_pi |
---|
| 70 | REAL, DIMENSION(klon,klev) :: pdel |
---|
| 71 | REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer |
---|
| 72 | REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer_pi !RAF |
---|
| 73 | ! REAL, DIMENSION(klon,naero_tot) :: fractnat_allaer !RAF delete?? |
---|
| 74 | |
---|
| 75 | INTEGER :: k, i |
---|
| 76 | |
---|
| 77 | !**************************************************************************************** |
---|
| 78 | ! 1) Get aerosol mass |
---|
| 79 | ! |
---|
| 80 | !**************************************************************************************** |
---|
| 81 | ! Read and interpolate sulfate |
---|
| 82 | IF ( flag_aerosol .EQ. 1 .OR. & |
---|
| 83 | flag_aerosol .EQ. 6 ) THEN |
---|
| 84 | |
---|
| 85 | CALL readaerosol_interp(id_ASSO4M, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi,loadso4) |
---|
| 86 | ELSE |
---|
| 87 | sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0. |
---|
| 88 | loadso4=0. |
---|
| 89 | END IF |
---|
| 90 | |
---|
| 91 | ! Read and interpolate bcsol and bcins |
---|
| 92 | IF ( flag_aerosol .EQ. 2 .OR. & |
---|
| 93 | flag_aerosol .EQ. 6 ) THEN |
---|
| 94 | |
---|
| 95 | ! Get bc aerosol distribution |
---|
| 96 | CALL readaerosol_interp(id_ASBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 ) |
---|
| 97 | CALL readaerosol_interp(id_AIBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 ) |
---|
| 98 | loadbc(:)=load_tmp1(:)+load_tmp2(:) |
---|
| 99 | ELSE |
---|
| 100 | bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0. |
---|
| 101 | bcins(:,:) = 0. ; bcins_pi(:,:) = 0. |
---|
| 102 | loadbc=0. |
---|
| 103 | END IF |
---|
| 104 | |
---|
| 105 | |
---|
| 106 | ! Read and interpolate pomsol and pomins |
---|
| 107 | IF ( flag_aerosol .EQ. 3 .OR. & |
---|
| 108 | flag_aerosol .EQ. 6 ) THEN |
---|
| 109 | |
---|
| 110 | CALL readaerosol_interp(id_ASPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3) |
---|
| 111 | CALL readaerosol_interp(id_AIPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4) |
---|
| 112 | loadoa(:)=load_tmp3(:)+load_tmp4(:) |
---|
| 113 | ELSE |
---|
| 114 | pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0. |
---|
| 115 | pomins(:,:) = 0. ; pomins_pi(:,:) = 0. |
---|
| 116 | loadoa=0. |
---|
| 117 | END IF |
---|
| 118 | |
---|
| 119 | |
---|
| 120 | ! Read and interpolate csssm, ssssm, assssm |
---|
| 121 | IF (flag_aerosol .EQ. 4 .OR. & |
---|
| 122 | flag_aerosol .EQ. 6 ) THEN |
---|
| 123 | |
---|
| 124 | CALL readaerosol_interp(id_SSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5) |
---|
| 125 | CALL readaerosol_interp(id_CSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6) |
---|
| 126 | CALL readaerosol_interp(id_ASSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7) |
---|
| 127 | loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:) |
---|
| 128 | ELSE |
---|
| 129 | sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0. |
---|
| 130 | ssacu(:,:) = 0. ; ssacu_pi(:,:) = 0. |
---|
| 131 | sssupco(:,:) = 0. ; sssupco_pi = 0. |
---|
| 132 | loadss=0. |
---|
| 133 | ENDIF |
---|
| 134 | |
---|
| 135 | ! Read and interpolate cidustm |
---|
| 136 | IF (flag_aerosol .EQ. 5 .OR. & |
---|
| 137 | flag_aerosol .EQ. 6 ) THEN |
---|
| 138 | |
---|
| 139 | CALL readaerosol_interp(id_CIDUSTM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust) |
---|
| 140 | |
---|
| 141 | ELSE |
---|
| 142 | cidust(:,:) = 0. ; cidust_pi(:,:) = 0. |
---|
| 143 | loaddust=0. |
---|
| 144 | ENDIF |
---|
| 145 | |
---|
| 146 | ! |
---|
| 147 | ! Store all aerosols in one variable |
---|
| 148 | ! |
---|
| 149 | m_allaer(:,:,id_ASBCM) = bcsol(:,:) ! ASBCM |
---|
| 150 | m_allaer(:,:,id_ASPOMM) = pomsol(:,:) ! ASPOMM |
---|
| 151 | m_allaer(:,:,id_ASSO4M) = sulfate(:,:) ! ASSO4M (= SO4) |
---|
| 152 | m_allaer(:,:,id_CSSO4M) = 0. ! CSSO4M |
---|
| 153 | m_allaer(:,:,id_SSSSM) = sssupco(:,:) ! SSSSM |
---|
| 154 | m_allaer(:,:,id_CSSSM) = sscoarse(:,:) ! CSSSM |
---|
| 155 | m_allaer(:,:,id_ASSSM) = ssacu(:,:) ! ASSSM |
---|
| 156 | m_allaer(:,:,id_CIDUSTM)= cidust(:,:) ! CIDUSTM |
---|
| 157 | m_allaer(:,:,id_AIBCM) = bcins(:,:) ! AIBCM |
---|
| 158 | m_allaer(:,:,id_AIPOMM) = pomins(:,:) ! AIPOMM |
---|
| 159 | |
---|
| 160 | !RAF |
---|
| 161 | m_allaer_pi(:,:,1) = bcsol_pi(:,:) ! ASBCM pre-ind |
---|
| 162 | m_allaer_pi(:,:,2) = pomsol_pi(:,:) ! ASPOMM pre-ind |
---|
| 163 | m_allaer_pi(:,:,3) = sulfate_pi(:,:) ! ASSO4M (= SO4) pre-ind |
---|
| 164 | m_allaer_pi(:,:,4) = 0. ! CSSO4M pre-ind |
---|
| 165 | m_allaer_pi(:,:,5) = sssupco_pi(:,:) ! SSSSM pre-ind |
---|
| 166 | m_allaer_pi(:,:,6) = sscoarse_pi(:,:) ! CSSSM pre-ind |
---|
| 167 | m_allaer_pi(:,:,7) = ssacu_pi(:,:) ! ASSSM pre-ind |
---|
| 168 | m_allaer_pi(:,:,8) = cidust_pi(:,:) ! CIDUSTM pre-ind |
---|
| 169 | m_allaer_pi(:,:,9) = bcins_pi(:,:) ! AIBCM pre-ind |
---|
| 170 | m_allaer_pi(:,:,10) = pomins_pi(:,:) ! AIPOMM pre-ind |
---|
| 171 | |
---|
| 172 | ! |
---|
| 173 | ! Calculate the total mass of all soluble aersosols |
---|
| 174 | ! |
---|
| 175 | mass_solu_aero(:,:) = sulfate(:,:) + bcsol(:,:) + pomsol(:,:) ! + & |
---|
| 176 | ! sscoarse(:,:) + ssacu(:,:) + sssupco(:,:) |
---|
| 177 | mass_solu_aero_pi(:,:) = sulfate_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) ! + & |
---|
| 178 | ! sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:) |
---|
| 179 | |
---|
| 180 | !**************************************************************************************** |
---|
| 181 | ! 2) Calculate optical properties for the aerosols |
---|
| 182 | ! |
---|
| 183 | !**************************************************************************************** |
---|
| 184 | DO k = 1, klev |
---|
| 185 | DO i = 1, klon |
---|
| 186 | pdel(i,k) = paprs(i,k) - paprs (i,k+1) |
---|
| 187 | END DO |
---|
| 188 | END DO |
---|
| 189 | |
---|
| 190 | CALL aeropt_6bands_rrtm( & |
---|
| 191 | pdel, m_allaer, pdtphys, rhcl, & |
---|
| 192 | tau_aero, piz_aero, cg_aero, & |
---|
| 193 | m_allaer_pi, flag_aerosol, & |
---|
| 194 | pplay, t_seri, presnivs) |
---|
| 195 | |
---|
| 196 | ! aeropt_5wv only for validation and diagnostics. |
---|
| 197 | CALL aeropt_5wv_rrtm( & |
---|
| 198 | pdel, m_allaer, & |
---|
| 199 | pdtphys, rhcl, aerindex, & |
---|
| 200 | flag_aerosol, pplay, t_seri, & |
---|
| 201 | tausum_aero, tau3d_aero ) |
---|
| 202 | |
---|
| 203 | ! Diagnostics calculation for CMIP5 protocol |
---|
| 204 | sconcso4(:)=m_allaer(:,1,id_ASSO4M)*1.e-9 |
---|
| 205 | sconcoa(:)=(m_allaer(:,1,id_ASPOMM)+m_allaer(:,1,id_AIPOMM))*1.e-9 |
---|
| 206 | sconcbc(:)=(m_allaer(:,1,id_ASBCM)+m_allaer(:,1,id_AIBCM))*1.e-9 |
---|
| 207 | sconcss(:)=(m_allaer(:,1,id_ASSSM)+m_allaer(:,1,id_CSSSM)+m_allaer(:,1,id_SSSSM))*1.e-9 |
---|
| 208 | sconcdust(:)=m_allaer(:,1,id_CIDUSTM)*1.e-9 |
---|
| 209 | concso4(:,:)=m_allaer(:,:,id_ASSO4M)*1.e-9 |
---|
| 210 | concoa(:,:)=(m_allaer(:,:,id_ASPOMM)+m_allaer(:,:,id_AIPOMM))*1.e-9 |
---|
| 211 | concbc(:,:)=(m_allaer(:,:,id_ASBCM)+m_allaer(:,:,id_AIBCM))*1.e-9 |
---|
| 212 | concss(:,:)=(m_allaer(:,:,id_ASSSM)+m_allaer(:,:,id_CSSSM)+m_allaer(:,:,id_SSSSM))*1.e-9 |
---|
| 213 | concdust(:,:)=m_allaer(:,:,id_CIDUSTM)*1.e-9 |
---|
| 214 | |
---|
| 215 | END SUBROUTINE readaerosol_optic_rrtm |
---|