source: LMDZ6/branches/contrails/libf/phylmd/lmdz_call_cloud_optics_prop.f90 @ 5602

Last change on this file since 5602 was 5601, checked in by aborella, 2 months ago

Multiple changes:

  • tracers which were ratios are now absolute quantities. This is needed because when the ratio

is not defined, some aberrations may occur

  • added a new tracer for total specific humidity in contrails
  • rework of the mixing process for cirrus clouds (and contrails)
  • changed the numerical integration of ice crystals' sublimation
  • subroutines do not take real inputs anymore (at least klon tables)
  • added more radiative diagnostics for contrails
File size: 8.5 KB
Line 
1! $Id$
2MODULE lmdz_call_cloud_optics_prop
3
4CONTAINS
5
6  SUBROUTINE call_cloud_optics_prop(klon, klev, ok_newmicro,&
7       paprs, pplay, temp, radocond, picefra, pclc, &
8    pcltau, pclemi, pch, pcl, pcm, pct, radocondwp, xflwp, xfiwp, xflwc, xfiwc, ok_aie, &
9    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, distcltop, temp_cltop, re, fl, reliq, reice, &
10    reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
11    reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  &
12    icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon, &
13    !--AB contrails
14    contfra, qice_cont, pclc_nocont, pcltau_nocont, pclemi_nocont, &
15    pcltau_cont, pclemi_cont, pch_nocont, pct_cont, &
16    xfiwp_nocont, xfiwc_nocont, reice_nocont)
17
18  ! Interface between the LMDZ physics monitor and the cloud properties calculation routines
19  ! 2023/10/02: L. Raillard, M. Coulon--Decorzens, A. Idelkadi, L. Fairhead
20  ! (E. Vignon and J.-B. Madeleine in spirit)
21  ! List of arguments
22  !------------------
23
24  USE lmdz_cloud_optics_prop_ini , ONLY : ok_cdnc
25  USE lmdz_cloud_optics_prop_ini , ONLY : bl95_b0, bl95_b1
26  USE lmdz_cloud_optics_prop_ini , ONLY : iflag_ice_thermo, ok_new_lscp, iflag_t_glace
27  USE lmdz_cloud_optics_prop, ONLY : cloud_optics_prop
28 
29  USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14) 
30  USE lmdz_lscp_tools, only: icefrac_lscp
31
32  IMPLICIT NONE
33 
34  ! input:
35  INTEGER, INTENT(IN) :: klon, klev      ! number of horizontal and vertical grid points
36  REAL, INTENT(IN) :: paprs(klon, klev+1)! pressure at bottom interfaces [Pa]
37  REAL, INTENT(IN) :: pplay(klon, klev)  ! pressure at the middle of layers [Pa]
38  REAL, INTENT(IN) :: temp(klon, klev)   ! temperature [K]
39  REAL, INTENT(IN) :: radocond(klon, klev) ! cloud condensed water seen by radiation [kg/kg]
40  REAL, INTENT(IN) :: picefra(klon,klev) ! ice fraction in clouds from large scale condensation scheme [-]
41  REAL, INTENT(IN) :: rnebcon(klon,klev) ! convection cloud fraction [-]
42  REAL, INTENT(IN) :: ccwcon(klon,klev)  ! condensed water from deep convection [kg/kg]
43  ! jq for the aerosol indirect effect
44  ! jq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003
45  REAL, INTENT(IN) :: mass_solu_aero(klon, klev)    ! total mass concentration for all soluble aerosols [ug m-3]
46  REAL, INTENT(IN) :: mass_solu_aero_pi(klon, klev) ! - (pre-industrial value)
47  REAL, INTENT(IN)  :: dNovrN(klon)         ! enhancement factor for cdnc
48  REAL, INTENT(OUT) :: distcltop(klon,klev) ! distance from large scale cloud top [m]
49  REAL, INTENT(OUT) :: temp_cltop(klon,klev)!temperature at large scale cloud top [K]
50
51  LOGICAL, INTENT(IN) :: ptconv(klon, klev) ! flag for grid points affected by deep convection
52  LOGICAL, INTENT(IN) :: ok_newmicro, ok_aie
53
54  ! inout:
55  REAL, INTENT(INOUT) :: pclc(klon, klev) ! cloud fraction for radiation [-]
56
57  ! out:
58  REAL, INTENT(OUT) :: pct(klon)      ! 2D total cloud cover [-]
59  REAL, INTENT(OUT) :: pcl(klon)      ! 2D low cloud cover [-]
60  REAL, INTENT(OUT) :: pcm(klon)      ! 2D mid cloud cover [-]
61  REAL, INTENT(OUT) :: pch(klon)      ! 2D high cloud cover [-]
62  REAL, INTENT(OUT) :: radocondwp(klon) ! total condensed water path (seen by radiation) [kg/m2]
63  REAL, INTENT(OUT) :: xflwp(klon)    ! liquid water path (seen by radiation) [kg/m2]
64  REAL, INTENT(OUT) :: xfiwp(klon)    ! ice water path (seen by radiation) [kg/m2]
65  REAL, INTENT(OUT) :: xflwc(klon, klev) ! liquid water content seen by radiation [kg/kg]
66  REAL, INTENT(OUT) :: xfiwc(klon, klev) ! ice water content seen by radiation [kg/kg]
67  REAL, INTENT(OUT) :: re(klon, klev) ! cloud droplet effective radius multiplied by fl
68  REAL, INTENT(OUT) :: fl(klon, klev) ! xliq * rneb, denominator to re; fraction of liquid water clouds
69                                      ! introduced to avoid problems in the averaging of the output
70                                      ! water clouds within a grid cell
71
72  REAL, INTENT(OUT) :: pcltau(klon, klev) ! cloud optical depth [m]
73  REAL, INTENT(OUT) :: pclemi(klon, klev) ! cloud emissivity [-]
74  REAL, INTENT(OUT) :: pcldtaupi(klon, klev) ! pre-industrial value of cloud optical thickness, ie.
75                                             ! values of optical thickness that does not account
76                                             ! for aerosol effects on cloud droplet radius [m]
77
78  REAL, INTENT(OUT) :: reliq(klon, klev)   ! liquid droplet effective radius [m]
79  REAL, INTENT(OUT) :: reice(klon, klev)   ! ice effective radius [m]
80  REAL, INTENT(OUT) :: reliq_pi(klon, klev)! liquid droplet effective radius [m], pre-industrial
81  REAL, INTENT(OUT) :: reice_pi(klon, klev)! ice effective radius [m], pre-industrial
82  REAL, INTENT(OUT) :: scdnc(klon, klev)   ! cloud droplet number concentration, mean over the whole mesh [m-3]
83  REAL, INTENT(OUT) :: cldncl(klon)        ! cloud droplet number concentration at top of cloud [m-3]
84  REAL, INTENT(OUT) :: reffclwtop(klon)    ! effective radius of cloud droplet at top of cloud [m]
85  REAL, INTENT(OUT) :: lcc(klon)           ! liquid Cloud Content at top of cloud [kg/kg]
86  REAL, INTENT(OUT) :: reffclws(klon, klev)! stratiform cloud droplet effective radius
87  REAL, INTENT(OUT) :: reffclwc(klon, klev)! convective cloud droplet effective radius
88  REAL, INTENT(OUT) :: cldnvi(klon)        ! column Integrated cloud droplet Number [/m2]
89  REAL, INTENT(OUT) :: lcc3d(klon, klev)   ! cloud fraction for liquid part only [-]
90  REAL, INTENT(OUT) :: lcc3dcon(klon, klev)! cloud fraction for liquid part only, convective clouds [-]
91  REAL, INTENT(OUT) :: lcc3dstra(klon, klev)!cloud fraction for liquid part only, stratiform clouds [-]
92  REAL, INTENT(OUT) :: icc3dcon(klon, klev)! cloud fraction for liquid part only, convective clouds [-]
93  REAL, INTENT(OUT) :: icc3dstra(klon, klev)! cloud fraction for ice part only, stratiform clouds [-]
94  REAL, INTENT(INOUT) :: icefrac_optics(klon, klev)! ice fraction in clouds seen by radiation [-]
95
96  !--AB for contrails. All these are used / outputed only if ok_plane_contrail=y
97  REAL, INTENT(IN)  :: contfra(klon, klev)       ! contrails fraction [-]
98  REAL, INTENT(IN)  :: qice_cont(klon, klev)     ! contrails condensed water [kg/kg]
99  REAL, INTENT(OUT) :: pch_nocont(klon)          ! 2D high cloud cover without contrails[-]
100  REAL, INTENT(OUT) :: pct_cont(klon)            ! 2D total contrails cover[-]
101  REAL, INTENT(OUT) :: xfiwp_nocont(klon)        ! ice water path (seen by radiation) without contrails [kg/m2]
102  REAL, INTENT(OUT) :: xfiwc_nocont(klon, klev)  ! ice water content seen by radiation without contrails [kg/kg]
103  REAL, INTENT(OUT) :: pclc_nocont(klon, klev)   ! cloud fraction for radiation without contrails [-]
104  REAL, INTENT(OUT) :: pcltau_nocont(klon, klev) ! cloud optical depth without contrails [-]
105  REAL, INTENT(OUT) :: pclemi_nocont(klon, klev) ! cloud emissivity without contrails [-]
106  REAL, INTENT(OUT) :: pcltau_cont(klon, klev)   ! contrails optical depth [-]
107  REAL, INTENT(OUT) :: pclemi_cont(klon, klev)   ! contrails emissivity [-]
108  REAL, INTENT(OUT) :: reice_nocont(klon, klev)  ! ice effective radius without contrails [micronts]
109  !--AB
110
111  ! Local variables
112  !----------------
113  INTEGER :: k
114  REAL :: dzfice(klon, klev)
115
116  IF (iflag_t_glace .EQ. 0) THEN
117     icefrac_optics(:, :) = 0.
118  ELSE
119     DO k = 1, klev
120        IF (ok_new_lscp) THEN
121          CALL icefrac_lscp(klon,temp(:,k),iflag_ice_thermo,distcltop(:,k),temp_cltop(:,k), &
122   &         icefrac_optics(:,k),dzfice(:,k))
123        ELSE
124          CALL icefrac_lsc(klon,temp(:,k),pplay(1:klon,k)/paprs(1:klon,1),icefrac_optics(:,k))
125        ENDIF
126     ENDDO
127  ENDIF
128 
129
130
131  IF (ok_newmicro) THEN       
132    CALL cloud_optics_prop(klon, klev, paprs, pplay, temp, radocond, picefra, pclc, &
133    pcltau, pclemi, pch, pcl, pcm, pct, radocondwp, xflwp, xfiwp, xflwc, xfiwc, &
134    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, distcltop, temp_cltop, re, fl, reliq, reice, &
135    reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
136    reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  &
137    icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon, &
138    !--AB for contrails
139    contfra, qice_cont, pclc_nocont, pcltau_nocont, pclemi_nocont, &
140    pcltau_cont, pclemi_cont, pch_nocont, pct_cont, &
141    xfiwp_nocont, xfiwc_nocont, reice_nocont)
142  ELSE
143    CALL nuage (paprs, pplay, &
144               temp, radocond, picefra, pclc, pcltau, pclemi, &
145               pch, pcl,pcm, pct, radocondwp, &
146               ok_aie, &
147               mass_solu_aero, mass_solu_aero_pi, &
148               bl95_b0, bl95_b1, distcltop, temp_cltop, &
149               pcldtaupi, re, fl)
150  ENDIF
151  RETURN
152
153END SUBROUTINE call_cloud_optics_prop
154
155END MODULE lmdz_call_cloud_optics_prop
Note: See TracBrowser for help on using the repository browser.