LCOV - code coverage report
Current view: | top level - physics/cam - cloud_diagnostics.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 160 | 236 | 67.8 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 3 | 3 | 100.0 %

              Line data    Source code
           1             : module cloud_diagnostics
           2             :
           3             : !---------------------------------------------------------------------------------
           4             : ! Purpose:
           5             : !
           6             : ! Put cloud physical specifications on the history tape
           7             : !  Modified from code that computed cloud optics
           8             : !
           9             : ! Author: Byron Boville  Sept 06, 2002
          10             : !  Modified Oct 15, 2008
          11             : !
          12             : !
          13             : !---------------------------------------------------------------------------------
          14             :
          15             :    use shr_kind_mod,  only: r8=>shr_kind_r8
          16             :    use ppgrid,        only: pcols, pver,pverp
          17             :    use physconst,     only: gravit
          18             :    use cam_history,   only: outfld
          19             :    use cam_history,   only: addfld, add_default, horiz_only
          20             :
          21             :    implicit none
          22             :    private
          23             :    save
          24             :
          25             :    public :: cloud_diagnostics_init
          26             :    public :: cloud_diagnostics_calc
          27             :    public :: cloud_diagnostics_register
          28             :
          29             : ! Local variables
          30             :    integer :: dei_idx, mu_idx, lambda_idx, iciwp_idx, iclwp_idx, cld_idx  ! index into pbuf for cloud fields
          31             :    integer :: ixcldice, ixcldliq, rei_idx, rel_idx
          32             :
          33             :    logical :: do_cld_diag, mg_clouds, rk_clouds, camrt_rad, spcam_m2005_clouds, spcam_sam1mom_clouds
          34             :    logical :: one_mom_clouds, two_mom_clouds
          35             :
          36             :    integer :: cicewp_idx = -1
          37             :    integer :: cliqwp_idx = -1
          38             :    integer :: cldemis_idx = -1
          39             :    integer :: cldtau_idx = -1
          40             :    integer :: nmxrgn_idx = -1
          41             :    integer :: pmxrgn_idx = -1
          42             :    integer :: gb_totcldliqmr_idx = -1
          43             :    integer :: gb_totcldicemr_idx = -1
          44             :
          45             :    ! Index fields for precipitation efficiency.
          46             :    integer :: acpr_idx, acgcme_idx, acnum_idx
          47             :
          48             :    logical           :: use_spcam
          49             :
          50             : contains
          51             :
          52             : !===============================================================================
          53     1496904 :   subroutine cloud_diagnostics_register
          54             :
          55             :     use phys_control,  only: phys_getopts
          56             :     use physics_buffer,only: pbuf_add_field, dtype_r8, dtype_i4
          57             :
          58             :     character(len=16) :: rad_pkg, microp_pgk
          59             :
          60        1536 :     call phys_getopts(radiation_scheme_out=rad_pkg,microp_scheme_out=microp_pgk)
          61        1536 :     camrt_rad            = rad_pkg .eq. 'camrt'
          62        1536 :     rk_clouds            = microp_pgk == 'RK'
          63        1536 :     mg_clouds            = microp_pgk == 'MG'
          64        1536 :     spcam_m2005_clouds   = microp_pgk == 'SPCAM_m2005'
          65        1536 :     spcam_sam1mom_clouds = microp_pgk == 'SPCAM_sam1mom'
          66        1536 :     one_mom_clouds       = (rk_clouds .or. spcam_sam1mom_clouds)
          67        1536 :     two_mom_clouds       = (mg_clouds .or. spcam_m2005_clouds)
          68             :
          69        1536 :     if (one_mom_clouds) then
          70        1536 :        call pbuf_add_field('CLDEMIS','physpkg', dtype_r8,(/pcols,pver/), cldemis_idx)
          71        1536 :        call pbuf_add_field('CLDTAU', 'physpkg', dtype_r8,(/pcols,pver/), cldtau_idx)
          72             :
          73        1536 :        call pbuf_add_field('CICEWP', 'physpkg', dtype_r8,(/pcols,pver/), cicewp_idx)
          74        1536 :        call pbuf_add_field('CLIQWP', 'physpkg', dtype_r8,(/pcols,pver/), cliqwp_idx)
          75             :
          76        1536 :        call pbuf_add_field('PMXRGN', 'physpkg', dtype_r8,(/pcols,pverp/), pmxrgn_idx)
          77        1536 :        call pbuf_add_field('NMXRGN', 'physpkg', dtype_i4,(/pcols /),      nmxrgn_idx)
          78           0 :     else if (two_mom_clouds) then
          79             :        ! In cloud ice water path for radiation
          80           0 :        call pbuf_add_field('ICIWP',      'global', dtype_r8,(/pcols,pver/), iciwp_idx)
          81             :        ! In cloud liquid water path for radiation
          82           0 :        call pbuf_add_field('ICLWP',      'global', dtype_r8,(/pcols,pver/), iclwp_idx)
          83             :     endif
          84        1536 :   end subroutine cloud_diagnostics_register
          85             :
          86             : !===============================================================================
          87        1536 :   subroutine cloud_diagnostics_init(pbuf2d)
          88             : !-----------------------------------------------------------------------
          89        1536 :     use physics_buffer,only: pbuf_get_index, pbuf_set_field, physics_buffer_desc
          90             :     use phys_control,  only: phys_getopts
          91             :     use constituents,  only: cnst_get_ind
          92             :     use cloud_cover_diags, only: cloud_cover_diags_init
          93             :     use time_manager, only: is_first_step
          94             :
          95             :     implicit none
          96             :
          97             :     type(physics_buffer_desc), pointer :: pbuf2d(:,:)
          98             :
          99             : !-----------------------------------------------------------------------
         100             :
         101             :     character(len=16) :: wpunits, sampling_seq
         102             :     logical           :: history_amwg                  ! output the variables used by the AMWG diag package
         103             :
         104             :
         105             :     !-----------------------------------------------------------------------
         106             :
         107        1536 :     cld_idx    = pbuf_get_index('CLD')
         108             :     ! grid box total cloud liquid water mixing ratio (kg/kg)
         109        1536 :     gb_totcldliqmr_idx = pbuf_get_index('GB_TOTCLDLIQMR')
         110             :     ! grid box total cloud ice water mixing ratio (kg/kg)
         111        1536 :     gb_totcldicemr_idx = pbuf_get_index('GB_TOTCLDICEMR')
         112             :
         113        1536 :     call phys_getopts(use_spcam_out=use_spcam)
         114             :
         115        1536 :     if (two_mom_clouds) then
         116             :
         117             :        ! initialize to zero
         118           0 :        if (is_first_step()) then
         119           0 :           call pbuf_set_field(pbuf2d, iciwp_idx, 0._r8)
         120           0 :           call pbuf_set_field(pbuf2d, iclwp_idx, 0._r8)
         121             :        end if
         122             :
         123           0 :        call addfld ('ICWMR', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-cloud water mixing ratio')
         124           0 :        call addfld ('ICIMR', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-cloud ice mixing ratio'  )
         125           0 :        call addfld ('IWC',   (/ 'lev' /), 'A', 'kg/m3', 'Grid box average ice water content'    )
         126           0 :        call addfld ('LWC',   (/ 'lev' /), 'A', 'kg/m3', 'Grid box average liquid water content' )
         127             :
         128             :        ! determine the add_default fields
         129           0 :        call phys_getopts(history_amwg_out           = history_amwg)
         130             :
         131           0 :        if (history_amwg) then
         132           0 :           call add_default ('ICWMR', 1, ' ')
         133           0 :           call add_default ('ICIMR', 1, ' ')
         134           0 :           call add_default ('IWC      ', 1, ' ')
         135             :        end if
         136             :
         137           0 :        dei_idx    = pbuf_get_index('DEI')
         138           0 :        mu_idx     = pbuf_get_index('MU')
         139           0 :        lambda_idx = pbuf_get_index('LAMBDAC')
         140             :
         141        1536 :     elseif (one_mom_clouds) then
         142             :
         143        1536 :        rei_idx    = pbuf_get_index('REI')
         144        1536 :        rel_idx    = pbuf_get_index('REL')
         145             :
         146             :     endif
         147             :
         148        1536 :     call cnst_get_ind('CLDICE', ixcldice)
         149        1536 :     call cnst_get_ind('CLDLIQ', ixcldliq)
         150             :
         151        1536 :     do_cld_diag = one_mom_clouds .or. two_mom_clouds
         152             :
         153        1536 :     if (.not.do_cld_diag) return
         154             :
         155        1536 :     if (rk_clouds) then
         156        1536 :        wpunits = 'gram/m2'
         157        1536 :        sampling_seq='rad_lwsw'
         158           0 :     else if (two_mom_clouds .or. spcam_sam1mom_clouds) then
         159           0 :        wpunits = 'kg/m2'
         160           0 :        sampling_seq=''
         161             :     end if
         162             :
         163        3072 :     call addfld ('ICLDIWP', (/ 'lev' /), 'A', wpunits,'In-cloud ice water path'               , sampling_seq=sampling_seq)
         164             :     call addfld ('ICLDTWP', (/ 'lev' /), 'A',wpunits,'In-cloud cloud total water path (liquid and ice)', &
         165        3072 :          sampling_seq=sampling_seq)
         166             :
         167             :     call addfld ('GCLDLWP', (/ 'lev' /), 'A',wpunits,'Grid-box cloud water path'             , &
         168        3072 :          sampling_seq=sampling_seq)
         169             :     call addfld ('TGCLDCWP',horiz_only,  'A',wpunits,'Total grid-box cloud water path (liquid and ice)', &
         170        1536 :          sampling_seq=sampling_seq)
         171             :     call addfld ('TGCLDLWP',horiz_only,  'A',wpunits,'Total grid-box cloud liquid water path', &
         172        1536 :          sampling_seq=sampling_seq)
         173             :     call addfld ('TGCLDIWP',horiz_only,  'A',wpunits,'Total grid-box cloud ice water path'   , &
         174        1536 :          sampling_seq=sampling_seq)
         175             :
         176        1536 :     if(two_mom_clouds) then
         177           0 :        call addfld ('lambda_cloud',(/ 'lev' /),'I','1/meter','lambda in cloud')
         178           0 :        call addfld ('mu_cloud',    (/ 'lev' /),'I','1','mu in cloud')
         179           0 :        call addfld ('dei_cloud',   (/ 'lev' /),'I','micrometers','ice radiative effective diameter in cloud')
         180             :     endif
         181             :
         182        1536 :     if(one_mom_clouds) then
         183        3072 :        call addfld ('rel_cloud',(/ 'lev' /),'I','1/meter','effective radius of liq in cloud', sampling_seq=sampling_seq)
         184        3072 :        call addfld ('rei_cloud',(/ 'lev' /),'I','1','effective radius of ice in cloud', sampling_seq=sampling_seq)
         185             :     endif
         186             :
         187        3072 :     call addfld ('SETLWP',(/ 'lev' /), 'A','gram/m2','Prescribed liquid water path'          , sampling_seq=sampling_seq)
         188        1536 :     call addfld ('LWSH',horiz_only,    'A','m','Liquid water scale height'             , sampling_seq=sampling_seq)
         189             :
         190        3072 :     call addfld ('EFFCLD',(/ 'lev' /), 'A','fraction','Effective cloud fraction'              , sampling_seq=sampling_seq)
         191             :
         192        1536 :     if (camrt_rad) then
         193        3072 :        call addfld ('EMIS', (/ 'lev' /), 'A', '1','cloud emissivity'                      , sampling_seq=sampling_seq)
         194             :     else
         195           0 :        call addfld ('EMISCLD', (/ 'lev' /), 'A', '1','cloud emissivity'                      , sampling_seq=sampling_seq)
         196             :     endif
         197             :
         198        1536 :     call cloud_cover_diags_init(sampling_seq)
         199             :
         200             :     ! ----------------------------
         201             :     ! determine default variables
         202             :     ! ----------------------------
         203        1536 :     call phys_getopts( history_amwg_out = history_amwg)
         204             :
         205        1536 :     if (history_amwg) then
         206        1536 :        call add_default ('TGCLDLWP', 1, ' ')
         207        1536 :        call add_default ('TGCLDIWP', 1, ' ')
         208        1536 :        call add_default ('TGCLDCWP', 1, ' ')
         209        1536 :        if(rk_clouds) then
         210        1536 :           if (camrt_rad) then
         211        1536 :              call add_default ('EMIS', 1, ' ')
         212             :           else
         213           0 :              call add_default ('EMISCLD', 1, ' ')
         214             :           endif
         215             :        endif
         216             :     endif
         217             :
         218             :     return
         219        1536 :   end subroutine cloud_diagnostics_init
         220             :
         221     1495368 : subroutine cloud_diagnostics_calc(state,  pbuf)
         222             : !===============================================================================
         223             : !
         224             : ! Compute (liquid+ice) water path and cloud water/ice diagnostics
         225             : ! *** soon this code will compute liquid and ice paths from input liquid and ice mixing ratios
         226             : !
         227             : ! **** mixes interface and physics code temporarily
         228             : !-----------------------------------------------------------------------
         229        1536 :     use physics_types, only: physics_state
         230             :     use physics_buffer,only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx
         231             :     use pkg_cldoptics, only: cldovrlap, cldclw,  cldems
         232             :     use conv_water,    only: conv_water_in_rad, conv_water_4rad
         233             :     use radiation,     only: radiation_do
         234             :     use cloud_cover_diags, only: cloud_cover_diags_out
         235             :
         236             :     use ref_pres,       only: top_lev=>trop_cloud_top_lev
         237             :
         238             :     implicit none
         239             :
         240             : ! Arguments
         241             :     type(physics_state), intent(in)    :: state        ! state variables
         242             :     type(physics_buffer_desc), pointer :: pbuf(:)
         243             :
         244             : ! Local variables
         245             :
         246     1495368 :     real(r8), pointer :: cld(:,:)       ! cloud fraction
         247     1495368 :     real(r8), pointer :: iciwp(:,:)   ! in-cloud cloud ice water path
         248     1495368 :     real(r8), pointer :: iclwp(:,:)   ! in-cloud cloud liquid water path
         249     1495368 :     real(r8), pointer :: dei(:,:)       ! effective radiative diameter of ice
         250     1495368 :     real(r8), pointer :: mu(:,:)        ! gamma distribution for liq clouds
         251     1495368 :     real(r8), pointer :: lambda(:,:)    ! gamma distribution for liq clouds
         252     1495368 :     real(r8), pointer :: rei(:,:)       ! effective radiative radius of ice
         253     1495368 :     real(r8), pointer :: rel(:,:)       ! effective radiative radius of liq
         254             :
         255     1495368 :     real(r8), pointer :: cldemis(:,:)   ! cloud emissivity
         256     1495368 :     real(r8), pointer :: cldtau(:,:)    ! cloud optical depth
         257     1495368 :     real(r8), pointer :: cicewp(:,:)    ! in-cloud cloud ice water path
         258     1495368 :     real(r8), pointer :: cliqwp(:,:)    ! in-cloud cloud liquid water path
         259             :
         260     1495368 :     integer,  pointer :: nmxrgn(:)      ! Number of maximally overlapped regions
         261     1495368 :     real(r8), pointer :: pmxrgn(:,:)    ! Maximum values of pressure for each
         262             :
         263     1495368 :     real(r8), pointer :: totg_ice(:,:)  ! grid box total cloud ice mixing ratio
         264     1495368 :     real(r8), pointer :: totg_liq(:,:)  ! grid box total cloud liquid mixing ratio
         265             :
         266             :     integer :: itim_old
         267             :
         268             :     real(r8) :: cwp   (pcols,pver)      ! in-cloud cloud (total) water path
         269             :     real(r8) :: gicewp(pcols,pver)      ! grid-box cloud ice water path
         270             :     real(r8) :: gliqwp(pcols,pver)      ! grid-box cloud liquid water path
         271             :     real(r8) :: gwp   (pcols,pver)      ! grid-box cloud (total) water path
         272             :     real(r8) :: tgicewp(pcols)          ! Vertically integrated ice water path
         273             :     real(r8) :: tgliqwp(pcols)          ! Vertically integrated liquid water path
         274             :     real(r8) :: tgwp   (pcols)          ! Vertically integrated (total) cloud water path
         275             :
         276             :     real(r8) :: ficemr (pcols,pver)     ! Ice fraction from ice and liquid mixing ratios
         277             :
         278             :     real(r8) :: icimr(pcols,pver)       ! In cloud ice mixing ratio
         279             :     real(r8) :: icwmr(pcols,pver)       ! In cloud water mixing ratio
         280             :     real(r8) :: iwc(pcols,pver)         ! Grid box average ice water content
         281             :     real(r8) :: lwc(pcols,pver)         ! Grid box average liquid water content
         282             :
         283             : ! old data
         284             :     real(r8) :: tpw    (pcols)          ! total precipitable water
         285             :     real(r8) :: clwpold(pcols,pver)     ! Presribed cloud liq. h2o path
         286             :     real(r8) :: hl     (pcols)          ! Liquid water scale height
         287             :
         288             :     integer :: i,k                      ! loop indexes
         289             :     integer :: ncol, lchnk
         290             :     real(r8) :: rgrav
         291             :
         292             :     real(r8) :: allcld_ice (pcols,pver) ! Convective cloud ice
         293             :     real(r8) :: allcld_liq (pcols,pver) ! Convective cloud liquid
         294             :
         295             :     real(r8) :: effcld(pcols,pver)      ! effective cloud=cld*emis
         296             :
         297             :     logical :: dosw,dolw
         298             :
         299             : !-----------------------------------------------------------------------
         300     1495368 :     if (.not.do_cld_diag) return
         301             :
         302     1495368 :     if(one_mom_clouds) then
         303     1495368 :        dosw     = radiation_do('sw')      ! do shortwave heating calc this timestep?
         304     1495368 :        dolw     = radiation_do('lw')      ! do longwave heating calc this timestep?
         305             :     else
         306             :        dosw     = .true.
         307             :        dolw     = .true.
         308             :     endif
         309             :
         310     1495368 :     if (.not.(dosw .or. dolw)) return
         311             :
         312      749232 :     ncol  = state%ncol
         313      749232 :     lchnk = state%lchnk
         314             :
         315      749232 :     itim_old = pbuf_old_tim_idx()
         316     2996928 :     call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         317             :
         318      749232 :     call pbuf_get_field(pbuf, gb_totcldicemr_idx, totg_ice)
         319      749232 :     call pbuf_get_field(pbuf, gb_totcldliqmr_idx, totg_liq)
         320             :
         321      749232 :     if(two_mom_clouds)then
         322             :
         323           0 :        call pbuf_get_field(pbuf, iclwp_idx, iclwp )
         324           0 :        call pbuf_get_field(pbuf, iciwp_idx, iciwp )
         325           0 :        call pbuf_get_field(pbuf, dei_idx, dei )
         326           0 :        call pbuf_get_field(pbuf, mu_idx, mu )
         327           0 :        call pbuf_get_field(pbuf, lambda_idx, lambda )
         328             :
         329           0 :        call outfld('dei_cloud',dei(:,:),pcols,lchnk)
         330           0 :        call outfld('mu_cloud',mu(:,:),pcols,lchnk)
         331           0 :        call outfld('lambda_cloud',lambda(:,:),pcols,lchnk)
         332             :
         333      749232 :     elseif(one_mom_clouds) then
         334             :
         335      749232 :        call pbuf_get_field(pbuf, rei_idx, rei )
         336      749232 :        call pbuf_get_field(pbuf, rel_idx, rel )
         337             :
         338      749232 :        call outfld('rel_cloud', rel, pcols, lchnk)
         339      749232 :        call outfld('rei_cloud', rei, pcols, lchnk)
         340             :
         341      749232 :        if (cldemis_idx>0) then
         342      749232 :           call pbuf_get_field(pbuf, cldemis_idx, cldemis )
         343             :        else
         344           0 :           allocate(cldemis(pcols,pver))
         345             :        endif
         346      749232 :        if (cldtau_idx>0) then
         347      749232 :           call pbuf_get_field(pbuf, cldtau_idx, cldtau )
         348             :        else
         349           0 :           allocate(cldtau(pcols,pver))
         350             :        endif
         351             :
         352             :     endif
         353             :
         354      749232 :     if (cicewp_idx>0) then
         355      749232 :        call pbuf_get_field(pbuf, cicewp_idx, cicewp )
         356             :     else
         357           0 :        allocate(cicewp(pcols,pver))
         358             :     endif
         359      749232 :     if (cliqwp_idx>0) then
         360      749232 :        call pbuf_get_field(pbuf, cliqwp_idx, cliqwp )
         361             :     else
         362           0 :        allocate(cliqwp(pcols,pver))
         363             :     endif
         364             :
         365      749232 :     if (nmxrgn_idx>0) then
         366      749232 :        call pbuf_get_field(pbuf, nmxrgn_idx, nmxrgn )
         367             :     else
         368           0 :        allocate(nmxrgn(pcols))
         369             :     endif
         370             :
         371      749232 :     if (pmxrgn_idx>0) then
         372      749232 :        call pbuf_get_field(pbuf, pmxrgn_idx, pmxrgn )
         373             :     else
         374           0 :        allocate(pmxrgn(pcols,pverp))
         375             :     endif
         376             :
         377             : ! Compute liquid and ice water paths
         378      749232 :     if(two_mom_clouds) then
         379             :
         380             :        ! ----------------------------------------------------------- !
         381             :        ! Adjust in-cloud water values to take account of convective  !
         382             :        ! in-cloud water. It is used to calculate the values of       !
         383             :        ! iclwp and iciwp to pass to the radiation.                   !
         384             :        ! ----------------------------------------------------------- !
         385           0 :        if( conv_water_in_rad /= 0 ) then
         386           0 :           call conv_water_4rad(state, pbuf)
         387           0 :           allcld_ice(:ncol,:) = totg_ice(:ncol,:) ! Grid-avg all cloud liquid
         388           0 :           allcld_liq(:ncol,:) = totg_liq(:ncol,:) ! Grid-avg all cloud ice
         389             :        else
         390           0 :           allcld_liq(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldliq)  ! Grid-ave all cloud liquid
         391           0 :           allcld_ice(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldice)  !           "        ice
         392             :        end if
         393             :
         394             :        ! ------------------------------------------------------------ !
         395             :        ! Compute in cloud ice and liquid mixing ratios                !
         396             :        ! Note that 'iclwp, iciwp' are used for radiation computation. !
         397             :        ! ------------------------------------------------------------ !
         398             :
         399             :
         400           0 :        iciwp = 0._r8
         401           0 :        iclwp = 0._r8
         402           0 :        icimr = 0._r8
         403           0 :        icwmr = 0._r8
         404           0 :        iwc = 0._r8
         405           0 :        lwc = 0._r8
         406             :
         407           0 :        do k = top_lev, pver
         408           0 :           do i = 1, ncol
         409             :              ! Limits for in-cloud mixing ratios consistent with MG microphysics
         410             :              ! in-cloud mixing ratio maximum limit of 0.005 kg/kg
         411           0 :              icimr(i,k)     = min( allcld_ice(i,k) / max(0.0001_r8,cld(i,k)),0.005_r8 )
         412           0 :              icwmr(i,k)     = min( allcld_liq(i,k) / max(0.0001_r8,cld(i,k)),0.005_r8 )
         413           0 :              iwc(i,k)       = allcld_ice(i,k) * state%pmid(i,k) / (287.15_r8*state%t(i,k))
         414           0 :              lwc(i,k)       = allcld_liq(i,k) * state%pmid(i,k) / (287.15_r8*state%t(i,k))
         415             :              ! Calculate total cloud water paths in each layer
         416           0 :              iciwp(i,k)     = icimr(i,k) * state%pdel(i,k) / gravit
         417           0 :              iclwp(i,k)     = icwmr(i,k) * state%pdel(i,k) / gravit
         418             :           end do
         419             :        end do
         420             :
         421           0 :        do k=1,pver
         422           0 :           do i = 1,ncol
         423           0 :              gicewp(i,k) = iciwp(i,k)*cld(i,k)
         424           0 :              gliqwp(i,k) = iclwp(i,k)*cld(i,k)
         425           0 :              cicewp(i,k) = iciwp(i,k)
         426           0 :              cliqwp(i,k) = iclwp(i,k)
         427             :           end do
         428             :        end do
         429             :
         430      749232 :     elseif(one_mom_clouds) then
         431             :
         432      749232 :        if (conv_water_in_rad /= 0) then
         433           0 :           call conv_water_4rad(state, pbuf)
         434           0 :           allcld_ice(:ncol,:) = totg_ice(:ncol,:) ! Grid-avg all cloud liquid
         435           0 :           allcld_liq(:ncol,:) = totg_liq(:ncol,:) ! Grid-avg all cloud ice
         436             :        else
         437   331909776 :           allcld_liq = state%q(:,:,ixcldliq)
         438   331909776 :           allcld_ice = state%q(:,:,ixcldice)
         439             :        end if
         440             :
         441    20229264 :        do k=1,pver
         442   326020464 :           do i = 1,ncol
         443   305791200 :              gicewp(i,k) = allcld_ice(i,k)*state%pdel(i,k)/gravit*1000.0_r8  ! Grid box ice water path.
         444   305791200 :              gliqwp(i,k) = allcld_liq(i,k)*state%pdel(i,k)/gravit*1000.0_r8  ! Grid box liquid water path.
         445   305791200 :              cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cld(i,k))               ! In-cloud ice water path.
         446   305791200 :              cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cld(i,k))               ! In-cloud liquid water path.
         447   325271232 :              ficemr(i,k) = allcld_ice(i,k) / max(1.e-10_r8,(allcld_ice(i,k) + allcld_liq(i,k)))
         448             :           end do
         449             :        end do
         450             :     endif
         451             :
         452             : ! Determine parameters for maximum/random overlap
         453      749232 :     call cldovrlap(lchnk, ncol, state%pint, cld, nmxrgn, pmxrgn)
         454             :
         455      749232 :     if(.not. use_spcam) then ! in spcam, these diagnostics are calcluated in crm_physics.F90
         456             : ! Cloud cover diagnostics (done in radiation_tend for camrt)
         457      749232 :     if (.not.camrt_rad) then
         458           0 :        call cloud_cover_diags_out(lchnk, ncol, cld, state%pmid, nmxrgn, pmxrgn )
         459             :     endif
         460             :     end if
         461             :
         462    12510432 :     tgicewp(:ncol) = 0._r8
         463    12510432 :     tgliqwp(:ncol) = 0._r8
         464             :
         465    20229264 :     do k=1,pver
         466   325271232 :        tgicewp(:ncol)  = tgicewp(:ncol) + gicewp(:ncol,k)
         467   326020464 :        tgliqwp(:ncol)  = tgliqwp(:ncol) + gliqwp(:ncol,k)
         468             :     end do
         469             :
         470    12510432 :     tgwp(:ncol) = tgicewp(:ncol) + tgliqwp(:ncol)
         471   326020464 :     gwp(:ncol,:pver) = gicewp(:ncol,:pver) + gliqwp(:ncol,:pver)
         472   326020464 :     cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver)
         473             :
         474      749232 :     if(one_mom_clouds) then
         475             :
         476             :        ! Cloud emissivity.
         477      749232 :        call cldems(lchnk, ncol, cwp, ficemr, rei, cldemis, cldtau)
         478             :
         479             :        ! Effective cloud cover
         480    20229264 :        do k=1,pver
         481   326020464 :           do i=1,ncol
         482   325271232 :              effcld(i,k) = cld(i,k)*cldemis(i,k)
         483             :           end do
         484             :        end do
         485             :
         486      749232 :        call outfld('EFFCLD'  ,effcld , pcols,lchnk)
         487      749232 :        if (camrt_rad) then
         488      749232 :           call outfld('EMIS' ,cldemis, pcols,lchnk)
         489             :        else
         490           0 :           call outfld('EMISCLD' ,cldemis, pcols,lchnk)
         491             :        endif
         492             :
         493           0 :     else if (two_mom_clouds) then
         494             :
         495             :        ! --------------------------------------------- !
         496             :        ! General outfield calls for microphysics       !
         497             :        ! --------------------------------------------- !
         498             :
         499           0 :        call outfld( 'IWC'      , iwc,         pcols, lchnk )
         500           0 :        call outfld( 'LWC'      , lwc,         pcols, lchnk )
         501           0 :        call outfld( 'ICIMR'    , icimr,       pcols, lchnk )
         502           0 :        call outfld( 'ICWMR'    , icwmr,       pcols, lchnk )
         503             :
         504             :     endif
         505             :
         506      749232 :     if (.not. use_spcam) then
         507             :        ! for spcam, these are diagnostics in crm_physics.F90
         508      749232 :        call outfld('GCLDLWP' ,gwp    , pcols,lchnk)
         509      749232 :        call outfld('TGCLDCWP',tgwp   , pcols,lchnk)
         510      749232 :        call outfld('TGCLDLWP',tgliqwp, pcols,lchnk)
         511      749232 :        call outfld('TGCLDIWP',tgicewp, pcols,lchnk)
         512      749232 :        call outfld('ICLDTWP' ,cwp    , pcols,lchnk)
         513      749232 :        call outfld('ICLDIWP' ,cicewp , pcols,lchnk)
         514             :     endif
         515             :
         516             : ! Compute total preciptable water in column (in mm)
         517    12510432 :     tpw(:ncol) = 0.0_r8
         518      749232 :     rgrav = 1.0_r8/gravit
         519    20229264 :     do k=1,pver
         520   326020464 :        do i=1,ncol
         521   325271232 :           tpw(i) = tpw(i) + state%pdel(i,k)*state%q(i,k,1)*rgrav
         522             :        end do
         523             :     end do
         524             :
         525             : ! Diagnostic liquid water path (old specified form)
         526             :
         527      749232 :     call cldclw(lchnk, ncol, state%zi, clwpold, tpw, hl)
         528      749232 :     call outfld('SETLWP'  ,clwpold, pcols,lchnk)
         529      749232 :     call outfld('LWSH'    ,hl     , pcols,lchnk)
         530             :
         531      749232 :     if(one_mom_clouds) then
         532      749232 :        if (cldemis_idx<0) deallocate(cldemis)
         533      749232 :        if (cldtau_idx<0) deallocate(cldtau)
         534             :     endif
         535      749232 :     if (cicewp_idx<0) deallocate(cicewp)
         536      749232 :     if (cliqwp_idx<0) deallocate(cliqwp)
         537      749232 :     if (pmxrgn_idx<0) deallocate(pmxrgn)
         538      749232 :     if (nmxrgn_idx<0) deallocate(nmxrgn)
         539             :
         540             :     return
         541     2990736 : end subroutine cloud_diagnostics_calc
         542             :
         543             : end module cloud_diagnostics

Generated by: LCOV version 1.14