Skip to content

Commit aabdcf7

Browse files
dustinswalesdustinswales
committed
MOre cahnges
1 parent 747d50a commit aabdcf7

2 files changed

Lines changed: 305 additions & 164 deletions

File tree

‎physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cosp.F90‎

Lines changed: 154 additions & 96 deletions
Original file line numberDiff line numberDiff line change
@@ -8,38 +8,14 @@
88
!!
99
! ###########################################################################################
1010
module GFS_cosp
11-
use machine, only: kind_phys
12-
use mod_cosp, only: cosp_outputs, cosp_optical_inputs, cosp_column_inputs,&
13-
cosp_simulator
14-
use mod_cosp_config, only: R_UNDEF_COSP => R_UNDEF, nHydro => N_HYDRO
15-
use mod_cosp_modis_interface, only: cosp_modis_init
16-
use mod_cosp_misr_interface, only: cosp_misr_init
17-
use mod_cosp_isccp_interface, only: cosp_isccp_init
18-
use mod_rng, only: rng_state, init_rng
19-
use mod_scops, only: scops
20-
use mod_prec_scops, only: prec_scops
11+
use machine, only: kind_phys
12+
use mod_cosp, only: cosp_outputs, cosp_optical_inputs, cosp_column_inputs
13+
2114
implicit none
2215

2316
real(kind_phys), parameter :: R_UNDEF = 0._kind_phys
2417
real(kind_phys), parameter :: emsfc_lw = 0.99_kind_phys ! longwave emissivity of surface at 10.5 microns
2518

26-
!
27-
integer,parameter :: &
28-
I_LSCLIQ = 1, & ! Large-scale (stratiform) liquid
29-
I_LSCICE = 2, & ! Large-scale (stratiform) ice
30-
I_LSRAIN = 3, & ! Large-scale (stratiform) rain
31-
I_LSSNOW = 4, & ! Large-scale (stratiform) snow
32-
I_CVCLIQ = 5, & ! Convective liquid
33-
I_CVCICE = 6, & ! Convective ice
34-
I_CVRAIN = 7, & ! Convective rain
35-
I_CVSNOW = 8, & ! Convective snow
36-
I_LSGRPL = 9 ! Large-scale (stratiform) groupel
37-
38-
! Stratiform and convective clouds in frac_out (scops output).
39-
integer, parameter :: &
40-
I_LSC = 1, & ! Large-scale clouds
41-
I_CVC = 2 ! Convective clouds
42-
4319
contains
4420

4521
! ###########################################################################################
@@ -57,6 +33,12 @@ module GFS_cosp
5733
subroutine GFS_cosp_init(mpirank, mpiroot, do_cosp, do_isccp, do_misr, do_modis, &
5834
cosp_nsubcol, imp_physics, imp_physics_thompson, imp_physics_gfdl, isccp_topht, &
5935
isccp_topht_dir, errmsg, errflg)
36+
use mod_cosp_config, only: modis_histTau, modis_histTauEdges, modis_histTauCenters
37+
use mod_cosp_config, only: numMODISTauBins, ntau
38+
use mod_cosp_config, only: tau_binBounds, tau_binEdges, tau_binCenters
39+
use mod_cosp_modis_interface, only: cosp_modis_init
40+
use mod_cosp_misr_interface, only: cosp_misr_init
41+
use mod_cosp_isccp_interface, only: cosp_isccp_init
6042

6143
! Inputs
6244
logical, intent(in) :: &
@@ -92,6 +74,14 @@ subroutine GFS_cosp_init(mpirank, mpiroot, do_cosp, do_isccp, do_misr, do_modis,
9274
call cosp_isccp_init(isccp_topht, isccp_topht_dir)
9375
endif
9476
if (do_modis) then
77+
! Initialize MODIS optical-depth bin boundaries for joint-histogram. (defined in cosp_config.F90)
78+
if (.not. allocated(modis_histTau)) then
79+
allocate(modis_histTau(ntau+1),modis_histTauEdges(2,ntau),modis_histTauCenters(ntau))
80+
numMODISTauBins = ntau
81+
modis_histTau = tau_binBounds
82+
modis_histTauEdges = tau_binEdges
83+
modis_histTauCenters = tau_binCenters
84+
endif
9585
call cosp_modis_init()
9686
endif
9787
if (do_misr) then
@@ -135,7 +125,12 @@ subroutine GFS_cosp_run(nCol, nLay, cosp_nlvgrid, cosp_nsubcol, tsfc, coszen, sl
135125
n_misr_hgt_bins, misr_hgt_bins, n_misr_tau_bins, misr_tau_bins, doSWrad, doLWrad, &
136126
do_cosp, do_isccp, do_misr, do_modis, overlap, &
137127
f1isccp_cosp, cldtot_isccp, meancldalb_isccp, meanptop_isccp, meantau_isccp, &
138-
meantb_isccp, meantbclr_isccp, tau_isccp, cldptop_isccp, errmsg, errflg)
128+
meantb_isccp, meantbclr_isccp, tau_isccp, cldptop_isccp, &
129+
clt_modis, clw_modis, cli_modis, clh_modis, clm_modis, cll_modis, taut_modis, &
130+
tauw_modis, taui_modis, tautlog_modis, tauwlog_modis, tauilog_modis, reffclw_modis, &
131+
reffcli_modis, pct_modis, lwp_modis, iwp_modis, cl_modis, clri_modis, clrl_modis, &
132+
errmsg, errflg)
133+
use mod_cosp, only: cosp_simulator
139134

140135
! Inputs
141136
logical, intent(in) :: &
@@ -206,7 +201,10 @@ subroutine GFS_cosp_run(nCol, nLay, cosp_nlvgrid, cosp_nsubcol, tsfc, coszen, sl
206201
integer, intent(out) :: &
207202
errflg ! CCPP error flag
208203
real(kind_phys), dimension(:,:,:), intent(out) :: &
209-
f1isccp_cosp ! ISCCP CFAD
204+
f1isccp_cosp, & ! ISCCP CFAD
205+
cl_modis, & ! MODIS CFAD
206+
clri_modis, & ! MODIS CFAD
207+
clrl_modis ! MODIS CFAD
210208
real(kind_phys), dimension(:,:), intent(out) :: &
211209
tau_isccp, & ! ISCCP subcolumn optical-depth
212210
cldptop_isccp ! ISCCP subcolumn cloud-top pressure
@@ -216,7 +214,24 @@ subroutine GFS_cosp_run(nCol, nLay, cosp_nlvgrid, cosp_nsubcol, tsfc, coszen, sl
216214
meanptop_isccp, & ! ISCCP mean cloud-top pressure
217215
meantau_isccp, & ! ISCCP mean optical-depth
218216
meantb_isccp, & ! ISCCP mean brightness temperature
219-
meantbclr_isccp ! ISCCP mean brightness temperature (clear-sky)
217+
meantbclr_isccp, & ! ISCCP mean brightness temperature (clear-sky)
218+
clt_modis, & ! MODIS
219+
clw_modis, & ! MODIS
220+
cli_modis, & ! MODIS
221+
clh_modis, & ! MODIS
222+
clm_modis, & ! MODIS
223+
cll_modis, & ! MODIS
224+
taut_modis, & ! MODIS
225+
tauw_modis, & ! MODIS
226+
taui_modis, & ! MODIS
227+
tautlog_modis, & ! MODIS
228+
tauwlog_modis, & ! MODIS
229+
tauilog_modis, & ! MODIS
230+
reffclw_modis, & ! MODIS
231+
reffcli_modis, & ! MODIS
232+
pct_modis, & ! MODIS
233+
lwp_modis, & ! MODIS
234+
iwp_modis ! MODIS
220235

221236
! Local
222237
type(cosp_outputs) :: cospOUT
@@ -347,17 +362,81 @@ subroutine GFS_cosp_run(nCol, nLay, cosp_nlvgrid, cosp_nsubcol, tsfc, coszen, sl
347362
end do
348363
end do
349364
end if
365+
if (do_modis) then
366+
! 1D
367+
where(sunlit(1:nCol) .eq. 0)
368+
cospOUT%modis_Cloud_Fraction_Total_Mean(1:ncol) = 0._kind_phys
369+
cospOUT%modis_Cloud_Fraction_Water_Mean(1:ncol) = 0._kind_phys
370+
cospOUT%modis_Cloud_Fraction_Ice_Mean(1:ncol) = 0._kind_phys
371+
cospOUT%modis_Cloud_Fraction_High_Mean(1:ncol) = 0._kind_phys
372+
cospOUT%modis_Cloud_Fraction_Mid_Mean(1:ncol) = 0._kind_phys
373+
cospOUT%modis_Cloud_Fraction_Low_Mean(1:ncol) = 0._kind_phys
374+
cospOUT%modis_Optical_Thickness_Total_Mean(1:ncol) = 0._kind_phys
375+
cospOUT%modis_Optical_Thickness_Water_Mean(1:ncol) = 0._kind_phys
376+
cospOUT%modis_Optical_Thickness_Ice_Mean(1:ncol) = 0._kind_phys
377+
cospOUT%modis_Optical_Thickness_Total_LogMean(1:ncol) = 0._kind_phys
378+
cospOUT%modis_Optical_Thickness_Water_LogMean(1:ncol) = 0._kind_phys
379+
cospOUT%modis_Optical_Thickness_Ice_LogMean(1:ncol) = 0._kind_phys
380+
cospOUT%modis_Cloud_Particle_Size_Water_Mean(1:ncol) = 0._kind_phys
381+
cospOUT%modis_Cloud_Particle_Size_Ice_Mean(1:ncol) = 0._kind_phys
382+
cospOUT%modis_Cloud_Top_Pressure_Total_Mean(1:ncol) = 0._kind_phys
383+
cospOUT%modis_Liquid_Water_Path_Mean(1:ncol) = 0._kind_phys
384+
cospOUT%modis_Ice_Water_Path_Mean(1:ncol) = 0._kind_phys
385+
end where
386+
! 3D
387+
do iprs=1,n_modis_pres_bins
388+
do itau=1,n_modis_tau_bins
389+
where(sunlit(1:ncol) .eq. 0)
390+
cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure(1:ncol,itau,iprs) = 0._kind_phys
391+
end where
392+
enddo
393+
do itau=1,n_modis_reffi_bins
394+
where(sunlit(1:ncol) .eq. 0)
395+
cospOUT%modis_Optical_Thickness_vs_ReffICE(1:ncol,itau,iprs) = 0._kind_phys
396+
end where
397+
end do
398+
do itau=1,n_modis_reffl_bins
399+
where(sunlit(1:ncol) .eq. 0)
400+
cospOUT%modis_Optical_Thickness_vs_ReffLIQ(1:ncol,itau,iprs) = 0._kind_phys
401+
end where
402+
enddo
403+
enddo
404+
end if
350405

351406
! Copy COSP outputs to host interstitials.
352-
f1isccp_cosp = cospOUT%isccp_fq
353-
tau_isccp = cospOUT%isccp_boxtau
354-
cldptop_isccp = cospOUT%isccp_boxptop
355-
cldtot_isccp = cospOUT%isccp_totalcldarea
356-
meanptop_isccp = cospOUT%isccp_meanptop
357-
meantau_isccp = cospOUT%isccp_meantaucld
358-
meancldalb_isccp = cospOUT%isccp_meanalbedocld
359-
meantb_isccp = cospOUT%isccp_meantb
360-
meantbclr_isccp = cospOUT%isccp_meantbclr
407+
if (do_isccp) then
408+
f1isccp_cosp = cospOUT%isccp_fq
409+
tau_isccp = cospOUT%isccp_boxtau
410+
cldptop_isccp = cospOUT%isccp_boxptop
411+
cldtot_isccp = cospOUT%isccp_totalcldarea
412+
meanptop_isccp = cospOUT%isccp_meanptop
413+
meantau_isccp = cospOUT%isccp_meantaucld
414+
meancldalb_isccp = cospOUT%isccp_meanalbedocld
415+
meantb_isccp = cospOUT%isccp_meantb
416+
meantbclr_isccp = cospOUT%isccp_meantbclr
417+
endif
418+
if (do_modis) then
419+
clt_modis = cospOUT%modis_Cloud_Fraction_Total_Mean
420+
clw_modis = cospOUT%modis_Cloud_Fraction_Water_Mean
421+
cli_modis = cospOUT%modis_Cloud_Fraction_Ice_Mean
422+
clh_modis = cospOUT%modis_Cloud_Fraction_High_Mean
423+
clm_modis = cospOUT%modis_Cloud_Fraction_Mid_Mean
424+
cll_modis = cospOUT%modis_Cloud_Fraction_Low_Mean
425+
taut_modis = cospOUT%modis_Optical_Thickness_Total_Mean
426+
tauw_modis = cospOUT%modis_Optical_Thickness_Water_Mean
427+
taui_modis = cospOUT%modis_Optical_Thickness_Ice_Mean
428+
tautlog_modis = cospOUT%modis_Optical_Thickness_Total_LogMean
429+
tauwlog_modis = cospOUT%modis_Optical_Thickness_Water_LogMean
430+
tauilog_modis = cospOUT%modis_Optical_Thickness_Ice_LogMean
431+
reffclw_modis = cospOUT%modis_Cloud_Particle_Size_Water_Mean
432+
reffcli_modis = cospOUT%modis_Cloud_Particle_Size_Ice_Mean
433+
pct_modis = cospOUT%modis_Cloud_Top_Pressure_Total_Mean
434+
lwp_modis = cospOUT%modis_Liquid_Water_Path_Mean
435+
iwp_modis = cospOUT%modis_Ice_Water_Path_Mean
436+
cl_modis = cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure
437+
clri_modis = cospOUT%modis_Optical_Thickness_vs_ReffICE
438+
clrl_modis = cospOUT%modis_Optical_Thickness_vs_ReffLIQ
439+
endif
361440

362441
! Clean up
363442
call destroy_cospIN(cospIN)
@@ -367,62 +446,6 @@ subroutine GFS_cosp_run(nCol, nLay, cosp_nlvgrid, cosp_nsubcol, tsfc, coszen, sl
367446
end subroutine GFS_cosp_run
368447
!> @}
369448

370-
! ###########################################################################################
371-
!! \section arg_table_GFS_cosp_timestep_finalize
372-
!! \htmlinclude GFS_cosp_timestep_finalize.html
373-
!!
374-
! ###########################################################################################
375-
subroutine GFS_cosp_timestep_finalize(do_cosp, doLWrad, doSWrad, do_isccp, f1isccp_cosp, &
376-
f1isccp_cosp_avg, n_isccp_pres_bins, n_isccp_tau_bins, errmsg, errflg)
377-
! Inputs
378-
logical, intent(in) :: &
379-
do_cosp, & ! Flag for COSP
380-
do_isccp, & ! Flag for COSP ISCCP diagnostics
381-
doLWrad, & ! Flag for LW radiation
382-
doSWrad ! Flag for SW radiaiton
383-
integer, intent(in) :: &
384-
n_isccp_pres_bins, & ! Number of pressure bins in ISCCP CFAD.
385-
n_isccp_tau_bins ! Number of optical-depth bins in ISCCP CFAD.
386-
real(kind_phys), dimension(:,:,:), intent(in) :: &
387-
f1isccp_cosp ! ISCCP CFAD
388-
389-
! Outputs
390-
real(kind_phys), dimension(:,:), intent(out) :: &
391-
f1isccp_cosp_avg ! ISCCP CFAD (globally averaged)
392-
character(len=*), intent(out) :: &
393-
errmsg ! CCPP error message
394-
integer, intent(out) :: &
395-
errflg ! CCPP error flag
396-
397-
! Locals
398-
integer :: iprs, itau, iCol, count
399-
400-
if (.not. do_cosp) return
401-
402-
! Only call COSP on radiation time-step.
403-
if (.not. (doLWrad .or. doSWrad)) return
404-
405-
! Initialize CCPP error handling variables
406-
errmsg = ''
407-
errflg = 0
408-
409-
! Compute spatially averaged diagnsotics for timestep.
410-
if (do_isccp) then
411-
do iprs=1,n_isccp_pres_bins
412-
do itau=1,n_isccp_tau_bins
413-
count = 0
414-
do iCol=1,size(f1isccp_cosp,dim=3)
415-
if (f1isccp_cosp(iCol,iprs,itau) .ne. R_UNDEF) then
416-
f1isccp_cosp_avg(iprs,itau) = f1isccp_cosp(iCol,iprs,itau)
417-
count = count + 1
418-
endif
419-
end do
420-
f1isccp_cosp_avg(iprs,itau) = f1isccp_cosp_avg(iprs,itau)/count
421-
end do
422-
end do
423-
endif
424-
425-
end subroutine GFS_cosp_timestep_finalize
426449
! #########################################################################################
427450
! SUBROUTINE subsample_and_optics
428451
!
@@ -433,7 +456,11 @@ end subroutine GFS_cosp_timestep_finalize
433456
subroutine subsample_and_optics(nCol, nSubCol, nLay, do_isccp, do_misr, do_modis, &
434457
sfcP, cld_frac, ccld_frac, overlap, cldtau_lw, cldtau_sw, cld_liq, ccld_liq, cld_ice,&
435458
cld_rain, cld_snow, cld_graupel, cld_reliq, cld_reice, cld_rerain, cld_resnow, cospIN)
436-
459+
use cosp_optics, only: modis_optics, modis_optics_partition
460+
use mod_scops, only: scops
461+
use mod_prec_scops, only: prec_scops
462+
use mod_rng, only: rng_state, init_rng
463+
use mod_cosp_config, only: nHydro => N_HYDRO
437464
! Inputs
438465
logical, intent(in) :: &
439466
do_isccp, & ! Flag for COSP ISCCP diagnostics
@@ -483,6 +510,23 @@ subroutine subsample_and_optics(nCol, nSubCol, nLay, do_isccp, do_misr, do_modis
483510
real(kind_phys),dimension(:,:,:,:), allocatable :: &
484511
mr_hydro, Reff
485512

513+
!
514+
integer,parameter :: &
515+
I_LSCLIQ = 1, & ! Large-scale (stratiform) liquid
516+
I_LSCICE = 2, & ! Large-scale (stratiform) ice
517+
I_LSRAIN = 3, & ! Large-scale (stratiform) rain
518+
I_LSSNOW = 4, & ! Large-scale (stratiform) snow
519+
I_CVCLIQ = 5, & ! Convective liquid
520+
I_CVCICE = 6, & ! Convective ice
521+
I_CVRAIN = 7, & ! Convective rain
522+
I_CVSNOW = 8, & ! Convective snow
523+
I_LSGRPL = 9 ! Large-scale (stratiform) groupel
524+
525+
! Stratiform and convective clouds in frac_out (scops output).
526+
integer, parameter :: &
527+
I_LSC = 1, & ! Large-scale clouds
528+
I_CVC = 2 ! Convective clouds
529+
486530
! #####################################################################################
487531
!
488532
! Set default values for optional MP arguments
@@ -647,6 +691,8 @@ subroutine subsample_and_optics(nCol, nSubCol, nLay, do_isccp, do_misr, do_modis
647691
! 11-micron emissivity (in-cloud), needed by ISCCP simulator.
648692
! ##################################################################################
649693
if (do_isccp) then
694+
! Assume same radiative properties for stratiform and convective clouds
695+
! True in current RRTMG and RRTMGP implementations
650696
cldemis_lw_strat = 1._kind_phys - exp(-cldtau_lw)
651697
cldemis_lw_conv = cldemis_lw_strat
652698
!
@@ -665,6 +711,8 @@ subroutine subsample_and_optics(nCol, nSubCol, nLay, do_isccp, do_misr, do_modis
665711
! 0.67 micron optical-depth (in-cloud), needed by ISCCP, MISR and MODIS simulators.
666712
! ##################################################################################
667713
if (do_isccp .or. do_modis .or. do_misr) then
714+
! Assume same radiative properties for stratiform and convective clouds
715+
! True in current RRTMG and RRTMGP implementations
668716
cldtau_sw_strat = cldtau_sw
669717
cldtau_sw_conv = cldtau_sw
670718
!
@@ -734,6 +782,16 @@ subroutine subsample_and_optics(nCol, nSubCol, nLay, do_isccp, do_misr, do_modis
734782
MODIS_iceSize(:,iSub,:) = Reff(:,iSub,:,I_LSCICE)
735783
endwhere
736784
enddo
785+
786+
! Partition optical thickness into liquid and ice parts
787+
call modis_optics_partition(nCol, nLay, nSubCol, MODIS_cloudWater, &
788+
MODIS_cloudIce, MODIS_waterSize, MODIS_iceSize, cospIN%tau_067, &
789+
MODIS_opticalThicknessLiq, MODIS_opticalThicknessIce)
790+
791+
! Compute assymetry parameter and single scattering albedo
792+
call modis_optics(nCol, nLay, nSubCol, MODIS_opticalThicknessLiq, &
793+
MODIS_waterSize*1.0e6_kind_phys, MODIS_opticalThicknessIce, &
794+
MODIS_iceSize*1.0e6_kind_phys, cospIN%fracLiq, cospIN%asym, cospIN%ss_alb)
737795

738796
deallocate (MODIS_cloudWater, MODIS_cloudIce, MODIS_waterSize)
739797
deallocate (MODIS_iceSize, MODIS_opticalThicknessLiq)

0 commit comments

Comments
 (0)