Changeset 2501 for LMDZ5/trunk/libf/phylmd/rrtm
- Timestamp:
- May 3, 2016, 5:09:56 PM (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/rrtm/aeropt_lw_rrtm.F90
r2231 r2501 1 1 ! 2 2 ! aeropt_lw_rrtm.F90 2014-05-13 C. Kleinschmitt 3 ! 2016-05-03 O. Boucher 3 4 ! 5 ! This routine feeds aerosol LW properties to RRTM 6 ! we only consider absorption (not scattering) 4 7 5 SUBROUTINE AEROPT_LW_RRTM 8 SUBROUTINE AEROPT_LW_RRTM(aerosol_couple,paprs,tr_seri) 6 9 10 USE dimphy 11 USE aero_mod 7 12 USE phys_state_var_mod, ONLY : tau_aero_lw_rrtm 8 13 9 14 IMPLICIT NONE 10 15 11 tau_aero_lw_rrtm(:,:,:,:) = 1.e-15 16 INCLUDE "YOMCST.h" 17 INCLUDE "clesphys.h" 18 ! 19 ! Input arguments: 20 ! 21 LOGICAL, INTENT(IN) :: aerosol_couple 22 REAL, DIMENSION(klon,klev+1), INTENT(in) :: paprs 23 ! 24 REAL, DIMENSION(klon,klev) :: zdp, mass_temp 25 ! 26 INTEGER inu, k 27 INTEGER :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM 28 INTEGER :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M 12 29 30 ! 31 !--absorption coefficient for CIDUST 32 REAL:: alpha_abs_CIDUST_16bands(nbands_lw_rrtm) !--unit m2/g 33 DATA alpha_abs_CIDUST_16bands / & 34 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & 35 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / 36 ! 37 IF (NLW.NE.nbands_lw_rrtm) THEN 38 print *,'Erreur NLW doit etre egal a 16 pour cette routine' 39 stop 40 ENDIF 41 ! 42 IF (aerosol_couple) THEN 43 ! 44 do i=1,nbtr 45 select case(trim(solsym(i))) 46 case ("ASBCM") 47 id_ASBCM = i 48 case ("ASPOMM") 49 id_ASPOMM = i 50 case ("ASSO4M") 51 id_ASSO4M = i 52 case ("ASMSAM") 53 id_ASMSAM = i 54 case ("CSSO4M") 55 id_CSSO4M = i 56 case ("CSMSAM") 57 id_CSMSAM = i 58 case ("SSSSM") 59 id_SSSSM = i 60 case ("CSSSM") 61 id_CSSSM = i 62 case ("ASSSM") 63 id_ASSSM = i 64 case ("CIDUSTM") 65 id_CIDUSTM = i 66 case ("AIBCM") 67 id_AIBCM = i 68 case ("AIPOMM") 69 id_AIPOMM = i 70 case ("ASNO3M") 71 id_ASNO3M = i 72 case ("CSNO3M") 73 id_CSNO3M = i 74 case ("CINO3M") 75 id_CINO3M = i 76 end select 77 enddo 78 ! 79 DO k=1, klev 80 zdp(:,k) = (paprs(i,k)-paprs(i,k+1))/RG !--kg/m2 81 ENDDO 82 ! 83 !--for now only consider dust 84 mass_temp(:,:)=tr_seri(:,:,id_CIDUSTM) !--kg/kg 85 ! 86 DO inu=1,NLW 87 ! 88 !--total aerosol 89 tau_aero_lw_rrtm(:,:,2,inu) = mass_temp(:,:)*zdp(:,:)*1000.*alpha_abs_CIDUST_16bands(inu) 90 !--no aerosol at all 91 tau_aero_lw_rrtm(:,:,1,inu) = 0.0 92 ! 93 ENDDO 94 ! 95 !--avoid very small values 96 tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15) 97 ! 98 ELSE !--not aerosol_couple 99 ! 100 !--no LW effects if not coupled to INCA 101 tau_aero_lw_rrtm = 1.e-15 102 ENDIF 103 ! 13 104 END SUBROUTINE AEROPT_LW_RRTM
Note: See TracChangeset
for help on using the changeset viewer.