From f74be0aa1c159c199eef2a3ae11b238a193e34f5 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Sat, 8 Jun 2024 13:40:12 -0600 Subject: [PATCH 01/24] General infrastructure changes for COSP-RTTOV. --- Externals_CAM.cfg | 4 +- bld/config_files/definition.xml | 8 ++ bld/configure | 30 +++++ bld/namelist_files/namelist_definition.xml | 131 +++++++++++++++++++++ src/physics/cosp2/Makefile.in | 50 ++++++-- src/physics/cosp2/Makefile.rttov | 80 +++++++++++++ 6 files changed, 293 insertions(+), 10 deletions(-) create mode 100644 src/physics/cosp2/Makefile.rttov diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 32231f3d10..64351ed55c 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -15,9 +15,9 @@ required = True [cosp2] local_path = src/physics/cosp2/src protocol = git -repo_url = https://github.com/CFMIP/COSPv2.0 +repo_url = https://github.com/jshaw35/COSPv2.0 sparse = ../.cosp_sparse_checkout -tag = v2.1.4cesm +tag = cesm2.2.0_rel_cosp_rttov required = True [clubb] diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index 37f43e918b..913e50aa2e 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -297,6 +297,14 @@ Switch to enable building COSP simulator package. 1 => build COSP. Directory containing COSP library. + +Switch to enable building the RTTOV radiative transfer model. With COSP. +1 => link COSP with RTTOV with building. + + +Directory containing RTTOV libraries. For example: +/glade/u/home/jonahshaw/w/RTTOV2/hdfseries_build/lib/ + Directory containing FV3CORE library. diff --git a/bld/configure b/bld/configure index ac68bed627..8ebdc7b8d8 100755 --- a/bld/configure +++ b/bld/configure @@ -75,6 +75,8 @@ OPTIONS -co2_cycle This option modifies the CAM configuration by increasing the number of advected constituents by 4. -cosp Enable the COSP simulator. + -rttov Enable RTTOV within the COSP simulator. + -rttov_libdir A string containing a path to the RTTOV install. -cppdefs A string of user specified CPP defines. Appended to Makefile defaults. E.g. -cppdefs '-DVAR1 -DVAR2' -cpl Coupling framework [mct | nuopc]. Default: mct. @@ -249,6 +251,8 @@ GetOptions( "co2_cycle" => \$opts{'co2_cycle'}, "cosp" => \$opts{'cosp'}, "cosp_libdir=s" => \$opts{'cosp_libdir'}, + "rttov" => \$opts{'rttov'}, + "rttov_libdir=s" => \$opts{'rttov_libdir'}, "cppdefs=s" => \$opts{'cppdefs'}, "cpl=s" => \$opts{'cpl'}, "spcam_clubb_sgs" => \$opts{'spcam_clubb_sgs'}, @@ -1104,6 +1108,22 @@ if (defined $opts{'cosp'}) { } my $cosp = $cfg_ref->get('cosp'); +# Option to build COSP with RTTOV +if ($cosp and defined $opts{'rttov'} and defined $opts{'rttov_libdir'}) { + $cfg_ref->set('rttov', $opts{'rttov'}); + $cfg_ref->set('rttov_libdir', $opts{'rttov_libdir'}); + print "COSP-RTTOV enabled$eol"; +} +elsif ( $cosp and defined $opts{'rttov'}) { + $cfg_ref->set('rttov', $opts{'rttov'}); +} +elsif ( defined $opts{'rttov'} ) { + die "configure ERROR: rttov defined but cosp undefined. cosp_libdir also undefined \n"; +} + +my $rttov = $cfg_ref->get('rttov'); +my $rttov_libdir = $cfg_ref->get('rttov_libdir'); + # cosp is only implemented with the cam5 and cam6 physics packages if ($cosp and ($phys_pkg ne 'cam5' and $phys_pkg ne 'cam6' and $phys_pkg ne 'cam_dev')) { die "configure ERROR: cosp not implemented for the $phys_pkg physics package \n"; @@ -1975,6 +1995,16 @@ if ($cosp) { die "** Could not create the cosp build directory: $bld_dir\n"; } + # Turn on RTTOV if passed the keyword. The cosp-rttov Makefile copies rttov libraries to the $cosp_libdir path + if ($rttov) { + # Current version when copying the RTTOV libraries for each build (both HDF5 and openmp are successfully linked now): + $ldflags .= " -L$cosp_libdir -lrttov13_wrapper -lrttov13_mw_scatt -lrttov13_brdf_atlas -lrttov13_emis_atlas -lrttov13_other -lrttov13_parallel -lrttov13_coef_io -lrttov13_hdf -lrttov13_main "; + # Let the RTTOV libraries stay where they are: + # A more functional code would read these from Makefile.rttov in the COSP2 directory in CAM instead of hardcoding, but I don't know how to do that yet. + # $ldflags .= " -L$rttov_libdir -lrttov13_wrapper -lrttov13_mw_scatt -lrttov13_brdf_atlas -lrttov13_emis_atlas -lrttov13_other -lrttov13_parallel -lrttov13_coef_io -lrttov13_hdf -lrttov13_main "; + $cfg_ref->set('ldflags', $ldflags); + print "Adding rttov libraries as dependencies in ldflags.\n"; + } # Create the COSP Makefile from a template and copy it into the cosp bld directory if ($print) { print "creating $cosp_libdir/Makefile\n"; } write_cosp_makefile("$cfgdir/../src/physics/cosp2/Makefile.in", "$cosp_libdir/Makefile"); diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 21fa4adead..323c12aa2d 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -2520,6 +2520,15 @@ will be saved. Default: FALSE + +If true, RTTOV simulator will be run and output +will be saved according to the appropriate RTTOV +instrument namelist files in "rttov_instrument_namelists". + +Default: FALSE + + + +Number of RTTOV instruments to simulate. +This default logical is set in cospsimulator_intr.F90 +Default: 0 + + + +List of RTTOV instrument namelist files read when running RTTOV in COSP. +Default: none + + + + +Number of satellite sampling swaths to mask COSP ISCCP data. +Default: none + + + +Number of satellite sampling swaths to mask COSP MISR data. +Default: none + + + +Number of satellite sampling swaths to mask COSP MODIS data. +Default: none + + + +Number of satellite sampling swaths to mask COSP CloudSat-CALIPSO data. +Default: none + + + +Number of satellite sampling swaths to mask COSP PARASOL data. +Default: none + + + +Number of satellite sampling swaths to mask COSP ATLID data. +Default: none + + + +Swath localtimes (hours) for masking COSP ISCCP data. +Default: none + + + +Swath localtimes (hours) for masking COSP MISR data. +Default: none + + + +Swath localtimes (hours) for masking COSP MODIS data. +Default: none + + + +Swath localtimes (hours) for masking COSP CloudSat-CALIPSO data. +Default: none + + + +Swath localtimes (hours) for masking COSP PARASOL data. +Default: none + + + +Swath localtimes (hours) for masking COSP ATLID data. +Default: none + + + +Swath widths (kilometers) for masking COSP ISCCP data. +Default: none + + + +Swath widths (kilometers) for masking COSP MISR data. +Default: none + + + +Swath widths (kilometers) for masking COSP MODIS data. +Default: none + + + +Swath widths (kilometers) for masking COSP CSCAL data. +Default: none + + + +Swath widths (kilometers) for masking COSP PARASOL data. +Default: none + + + +Swath widths (kilometers) for masking COSP ATLID data. +Default: none + + Date: Sat, 8 Jun 2024 13:41:52 -0600 Subject: [PATCH 02/24] Kitchen sink of cospsimulator_intr changes. Everything needed for RTTOV plus swathing, memory checks, and OPAQ outputs. Needs cleaning! --- src/physics/cam/cospsimulator_intr.F90 | 1546 ++++++++++++++++++++---- 1 file changed, 1287 insertions(+), 259 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 855a8e82d5..ae6143d09a 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -11,7 +11,7 @@ module cospsimulator_intr ! ! ###################################################################################### use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc + use spmd_utils, only: masterproc, mpi_real8, MPI_MAX ! JKS memory (last 2) use ppgrid, only: pcols, pver, pverp, begchunk, endchunk use perf_mod, only: t_startf, t_stopf use cam_abortutils, only: endrun @@ -20,11 +20,12 @@ module cospsimulator_intr #ifdef USE_COSP use quickbeam, only: radar_cfg use mod_quickbeam_optics, only: size_distribution - use mod_cosp, only: cosp_outputs,cosp_optical_inputs,cosp_column_inputs + use mod_cosp, only: cosp_outputs,cosp_optical_inputs,cosp_column_inputs, & + swath_inputs use mod_cosp_config, only: pres_binCenters, pres_binEdges, tau_binCenters, & tau_binEdges, cloudsat_binCenters, cloudsat_binEdges, calipso_binCenters, & calipso_binEdges, misr_histHgtCenters, misr_histHgtEdges, PARASOL_SZA, & - R_UNDEF, PARASOL_NREFL, LIDAR_NCAT,SR_BINS, N_HYDRO, RTTOV_MAX_CHANNELS, & + R_UNDEF, PARASOL_NREFL, LIDAR_NCAT,SR_BINS, N_HYDRO, & numMISRHgtBins, CLOUDSAT_DBZE_BINS, LIDAR_NTEMP, calipso_histBsct, & numMODISTauBins, numMODISPresBins, numMODISReffIceBins, numMODISReffLiqBins, & numISCCPTauBins, numISCCPPresBins, numMISRTauBins, reffICE_binEdges, & @@ -38,7 +39,8 @@ module cospsimulator_intr nhtmisr_cosp => numMISRHgtBins, & nhydro => N_HYDRO, & cloudsat_preclvl - use mod_cosp_stats, only: cosp_change_vertical_grid + use mod_cosp_stats, only: cosp_change_vertical_grid + use mod_cosp_rttov_interface, only: rttov_cfg ! JKS #endif implicit none private @@ -117,7 +119,7 @@ module cospsimulator_intr integer, allocatable :: htdbze_cosp(:) ! radar CFAD mixed output dimension index (nht_cosp*CLOUDSAT_DBZE_BINS) integer, allocatable :: htsr_cosp(:) ! lidar CFAD mixed output dimension index (nht_cosp*nsr_cosp) integer, allocatable :: htmlscol_cosp(:) ! html-subcolumn mixed output dimension index (nhtml_cosp*nscol_cosp) - + ! ###################################################################################### ! Default namelists ! The CAM and COSP namelists defaults are set below. Some of the COSP namelist @@ -133,20 +135,21 @@ module cospsimulator_intr logical :: cosp_active = .false. ! CAM namelist variable default, not in COSP namelist logical :: cosp_isccp = .false. ! CAM namelist variable default, not in COSP namelist logical :: cosp_lradar_sim = .false. ! CAM namelist variable default - logical :: cosp_llidar_sim = .false. ! CAM namelist variable default + logical :: cosp_llidar_sim = .false. ! CAM namelist variable default logical :: cosp_lisccp_sim = .false. ! CAM namelist variable default logical :: cosp_lmisr_sim = .false. ! CAM namelist variable default logical :: cosp_lmodis_sim = .false. ! CAM namelist variable default + logical :: cosp_lrttov_sim = .false. ! CAM namelist variable default logical :: cosp_histfile_aux = .false. ! CAM namelist variable default logical :: cosp_lfrac_out = .false. ! CAM namelist variable default logical :: cosp_runall = .false. ! flag to run all of the cosp simulator package integer :: cosp_ncolumns = 50 ! CAM namelist variable default integer :: cosp_histfile_num =1 ! CAM namelist variable default, not in COSP namelist integer :: cosp_histfile_aux_num =-1 ! CAM namelist variable default, not in COSP namelist - + ! COSP logical :: lradar_sim = .false. ! COSP namelist variable, can be changed from default by CAM namelist - logical :: llidar_sim = .false. ! + logical :: llidar_sim = .false. ! logical :: lparasol_sim = .false. ! logical :: lgrLidar532 = .false. ! logical :: latlid = .false. ! @@ -220,19 +223,21 @@ module cospsimulator_intr ! pbuf indices integer :: cld_idx, concld_idx, lsreffrain_idx, lsreffsnow_idx, cvreffliq_idx integer :: cvreffice_idx, dpcldliq_idx, dpcldice_idx - integer :: shcldliq1_idx, shcldice1_idx, dpflxprc_idx + integer :: shcldliq_idx, shcldice_idx, shcldliq1_idx, shcldice1_idx, dpflxprc_idx integer :: dpflxsnw_idx, shflxprc_idx, shflxsnw_idx, lsflxprc_idx, lsflxsnw_idx - integer :: rei_idx, rel_idx + integer :: rei_idx, rel_idx, dei_idx +! integer :: ubot_idx, vbot_idx ! ###################################################################################### ! Declarations specific to COSP2 ! ###################################################################################### type(radar_cfg) :: rcfg_cloudsat ! Radar configuration (Cloudsat) type(radar_cfg), allocatable :: rcfg_cs(:) ! chunked version of rcfg_cloudsat + type(rttov_cfg), allocatable, target :: rttov_configs(:) ! Chunked RTTOV configuration type(size_distribution) :: sd ! Size distribution used by radar simulator type(size_distribution), allocatable :: sd_cs(:) ! chunked version of sd character(len=64) :: cloudsat_micro_scheme = 'MMF_v3.5_single_moment' - + integer,parameter :: & I_LSCLIQ = 1, & ! Large-scale (stratiform) liquid I_LSCICE = 2, & ! Large-scale (stratiform) ice @@ -263,7 +268,35 @@ module cospsimulator_intr gamma_1 = (/-1._r8, -1._r8, 17.83725_r8, 8.284701_r8, -1._r8, -1._r8, 17.83725_r8, 8.284701_r8, 11.63230_r8/),& gamma_2 = (/-1._r8, -1._r8, 6.0_r8, 6.0_r8, -1._r8, -1._r8, 6.0_r8, 6.0_r8, 6.0_r8/),& gamma_3 = (/-1._r8, -1._r8, 2.0_r8, 2.0_r8, -1._r8, -1._r8, 2.0_r8, 2.0_r8, 2.0_r8/),& - gamma_4 = (/-1._r8, -1._r8, 6.0_r8, 6.0_r8, -1._r8, -1._r8, 6.0_r8, 6.0_r8, 6.0_r8/) + gamma_4 = (/-1._r8, -1._r8, 6.0_r8, 6.0_r8, -1._r8, -1._r8, 6.0_r8, 6.0_r8, 6.0_r8/) + + ! Local variables for orbit swathing + real(r8),dimension(:),allocatable :: & + cosp_localtime, & + cosp_localtime_width + + ! Swathing DDT array + type(swath_inputs),dimension(6) :: & + cospswathsIN + + type rttov_output_write + integer :: & + nchan_out + real(r8),allocatable :: & + bt_total(:,:), & + bt_clear(:,:), & + rad_total(:,:), & + rad_clear(:,:), & + rad_cloudy(:,:), & + refl_total(:,:), & + refl_clear(:,:), & + bt_total_pc(:,:), & + rad_total_pc(:,:) + end type rttov_output_write + + character(len=256), dimension(50) :: rttov_instrument_namelists = ' ' ! Input of paths to RTTOV instrument namelists + integer :: rttov_Ninstruments = 0 ! Default is zero + #endif CONTAINS @@ -276,6 +309,9 @@ subroutine setcosp2values(Nlr_in,use_vgrid_in,csat_vgrid_in,Ncolumns_in,cosp_nra use mod_cosp, only: cosp_init use mod_cosp_config, only: vgrid_zl, vgrid_zu, vgrid_z use mod_quickbeam_optics, only: hydro_class_init, quickbeam_optics_init + + use units, only: getunit, freeunit ! JKS testing + ! Inputs integer, intent(in) :: Nlr_in ! Number of vertical levels for CALIPSO and Cloudsat products integer, intent(in) :: Ncolumns_in ! Number of sub-columns @@ -286,7 +322,9 @@ subroutine setcosp2values(Nlr_in,use_vgrid_in,csat_vgrid_in,Ncolumns_in,cosp_nra ! Local logical :: ldouble=.false. logical :: lsingle=.true. ! Default is to use single moment - integer :: i,k + integer :: i,k, unitn ! JKS testing + + character(len=256), allocatable :: rttov_instrument_namelists_final(:) prsmid_cosp = pres_binCenters prslim_cosp = pres_binEdges @@ -321,11 +359,24 @@ subroutine setcosp2values(Nlr_in,use_vgrid_in,csat_vgrid_in,Ncolumns_in,cosp_nra ! to _init functions in cosp_init. ! DS2019: Add logicals, default=.false., for new Lidar simuldators (Earthcare (atlid) and ground-based ! lidar at 532nm) - call COSP_INIT(Lisccp_sim, Lmodis_sim, Lmisr_sim, Lradar_sim, Llidar_sim, LgrLidar532, & - Latlid, Lparasol_sim, Lrttov_sim, radar_freq, k2, use_gas_abs, do_ray, & - isccp_topheight, isccp_topheight_direction, surface_radar, rcfg_cloudsat, & - use_vgrid_in, csat_vgrid_in, Nlr_in, pver, cloudsat_micro_scheme) - + + ! Flexible namelist I/O + allocate(rttov_instrument_namelists_final(rttov_Ninstruments)) + rttov_instrument_namelists_final(:) = rttov_instrument_namelists(1:rttov_Ninstruments) + + unitn = getunit() ! JKS handle many files. + + call COSP_INIT(Lisccp_sim, Lmodis_sim, Lmisr_sim, Lradar_sim, Llidar_sim, LgrLidar532, & + Latlid, Lparasol_sim, Lrttov_sim, radar_freq, k2, use_gas_abs, do_ray, & + isccp_topheight, isccp_topheight_direction, surface_radar, rcfg_cloudsat, & + use_vgrid_in, csat_vgrid_in, Nlr_in, pver, cloudsat_micro_scheme, & + rttov_Ninstruments, rttov_instrument_namelists_final, rttov_configs,unitn=unitn) ! JKS add functionality for multiple files + ! Could add mpi commands here to parallelize load coefficients if slow. + ! Yes, this should really only be run on the main processor, but I might need to bcast everything since the call is wrapped around all of COSP. + ! Could be done a few different ways. + call freeunit(unitn) ! JKS handle many files + deallocate(rttov_instrument_namelists_final) + ! Set number of sub-columns, from namelist nscol_cosp = Ncolumns_in @@ -428,28 +479,55 @@ subroutine cospsimulator_intr_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit #ifdef SPMD - use mpishorthand, only: mpicom, mpilog, mpiint, mpichar + use mpishorthand, only: mpicom, mpilog, mpiint, mpichar, mpir8 #endif character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input (nlfile=atm_in) ! Local variables - integer :: unitn, ierr + integer :: unitn, ierr, i character(len=*), parameter :: subname = 'cospsimulator_intr_readnl' + ! Inputs for orbit swathing + integer :: N_SWATHS_ISCCP = 0 ! Number of ISCCP swaths + integer :: N_SWATHS_MISR = 0 ! Number of MISR swaths + integer :: N_SWATHS_MODIS = 0 ! Number of MODIS swaths + integer :: N_SWATHS_PARASOL = 0 ! Number of PARASOL swaths + integer :: N_SWATHS_CSCAL = 0 ! Number of CLOUDSAT+CALIPSO swaths + integer :: N_SWATHS_ATLID = 0 ! Number of ATLID swaths + real(r8),dimension(10),target :: & ! Arbitrary limit of 10 swaths seems reasonable. + SWATH_LOCALTIMES_ISCCP, & ! Local time of ISCCP satellite overpasses (hrs GMT) + SWATH_LOCALTIMES_MISR, & ! Local time of MISR satellite overpasses (hrs GMT) + SWATH_LOCALTIMES_MODIS, & ! Local time of MODIS satellite overpasses (hrs GMT) + SWATH_LOCALTIMES_PARASOL, & ! Local time of PARASOL satellite overpasses (hrs GMT) + SWATH_LOCALTIMES_CSCAL, & ! Local time of CLOUDSAT+CALIPSO satellite overpasses (hrs GMT) + SWATH_LOCALTIMES_ATLID, & ! Local time of ATLID satellite overpasses (hrs GMT) + SWATH_WIDTHS_ISCCP, & ! Width in km of ISCCP satellite overpasses + SWATH_WIDTHS_MISR, & ! Width in km of MISR satellite overpasses + SWATH_WIDTHS_MODIS, & ! Width in km of MODIS satellite overpasses + SWATH_WIDTHS_PARASOL, & ! Width in km of PARASOL satellite overpasses + SWATH_WIDTHS_CSCAL, & ! Width in km of CLOUDSAT+CALIPSO satellite overpasses + SWATH_WIDTHS_ATLID ! Width in km of ATLID satellite overpasses + #ifdef USE_COSP + !!! this list should include any variable that you might want to include in the namelist !!! philosophy is to not include COSP output flags but just important COSP settings and cfmip controls. - namelist /cospsimulator_nl/ docosp, cosp_active, cosp_amwg, & - cosp_histfile_num, cosp_histfile_aux, cosp_histfile_aux_num, cosp_isccp, cosp_lfrac_out, & - cosp_lite, cosp_lradar_sim, cosp_llidar_sim, cosp_lisccp_sim, cosp_lmisr_sim, cosp_lmodis_sim, cosp_ncolumns, & - cosp_nradsteps, cosp_passive, cosp_runall + namelist /cospsimulator_nl/ docosp, cosp_active, cosp_amwg, & + cosp_histfile_num, cosp_histfile_aux, cosp_histfile_aux_num, cosp_isccp, cosp_lfrac_out, & + cosp_lite, cosp_lradar_sim, cosp_llidar_sim, cosp_lisccp_sim, cosp_lmisr_sim, cosp_lmodis_sim, cosp_lrttov_sim, & + cosp_ncolumns, cosp_nradsteps, cosp_passive, cosp_runall, rttov_Ninstruments, rttov_instrument_namelists, & + N_SWATHS_ISCCP, SWATH_LOCALTIMES_ISCCP, SWATH_WIDTHS_ISCCP, N_SWATHS_MISR, & + SWATH_LOCALTIMES_MISR, SWATH_WIDTHS_MISR, N_SWATHS_MODIS, SWATH_LOCALTIMES_MODIS, & + SWATH_WIDTHS_MODIS, N_SWATHS_PARASOL, SWATH_LOCALTIMES_PARASOL, & + SWATH_WIDTHS_PARASOL, N_SWATHS_CSCAL, SWATH_LOCALTIMES_CSCAL, & + SWATH_WIDTHS_CSCAL, N_SWATHS_ATLID, SWATH_LOCALTIMES_ATLID, SWATH_WIDTHS_ATLID !! read in the namelist if (masterproc) then unitn = getunit() open( unitn, file=trim(nlfile), status='old' ) !! presumably opens the namelist file "nlfile" - !! position the file to write to the cospsimulator portion of the cam_in namelist + ! position the file to write to the cospsimulator portion of the cam_in namelist call find_group_name(unitn, 'cospsimulator_nl', status=ierr) if (ierr == 0) then read(unitn, cospsimulator_nl, iostat=ierr) @@ -460,7 +538,29 @@ subroutine cospsimulator_intr_readnl(nlfile) close(unitn) call freeunit(unitn) end if - + + ! Indexing order for "cospIN % cospswathsIN" is ISCCP, MISR, CLOUDSAT-CALIPSO, ATLID, PARASOL, MODIS + if (masterproc) then + cospswathsIN(1)%N_inst_swaths = N_SWATHS_ISCCP + cospswathsIN(1)%inst_localtimes(1:N_SWATHS_ISCCP) = SWATH_LOCALTIMES_ISCCP + cospswathsIN(1)%inst_localtime_widths(1:N_SWATHS_ISCCP) = SWATH_WIDTHS_ISCCP + cospswathsIN(2)%N_inst_swaths = N_SWATHS_MISR + cospswathsIN(2)%inst_localtimes(1:N_SWATHS_MISR) = SWATH_LOCALTIMES_MISR + cospswathsIN(2)%inst_localtime_widths(1:N_SWATHS_MISR) = SWATH_WIDTHS_MISR + cospswathsIN(3)%N_inst_swaths = N_SWATHS_CSCAL + cospswathsIN(3)%inst_localtimes(1:N_SWATHS_CSCAL) = SWATH_LOCALTIMES_CSCAL + cospswathsIN(3)%inst_localtime_widths(1:N_SWATHS_CSCAL) = SWATH_WIDTHS_CSCAL + cospswathsIN(4)%N_inst_swaths = N_SWATHS_ATLID + cospswathsIN(4)%inst_localtimes(1:N_SWATHS_ATLID) = SWATH_LOCALTIMES_ATLID + cospswathsIN(4)%inst_localtime_widths(1:N_SWATHS_ATLID) = SWATH_WIDTHS_ATLID + cospswathsIN(5)%N_inst_swaths = N_SWATHS_PARASOL + cospswathsIN(5)%inst_localtimes(1:N_SWATHS_PARASOL) = SWATH_LOCALTIMES_PARASOL + cospswathsIN(5)%inst_localtime_widths(1:N_SWATHS_PARASOL) = SWATH_WIDTHS_PARASOL + cospswathsIN(6)%N_inst_swaths = N_SWATHS_MODIS + cospswathsIN(6)%inst_localtime_widths(1:N_SWATHS_MODIS) = SWATH_WIDTHS_MODIS + cospswathsIN(6)%inst_localtimes(1:N_SWATHS_MODIS) = SWATH_LOCALTIMES_MODIS + end if + #ifdef SPMD ! Broadcast namelist variables call mpibcast(docosp, 1, mpilog, 0, mpicom) @@ -476,13 +576,23 @@ subroutine cospsimulator_intr_readnl(nlfile) call mpibcast(cosp_lisccp_sim, 1, mpilog, 0, mpicom) call mpibcast(cosp_lmisr_sim, 1, mpilog, 0, mpicom) call mpibcast(cosp_lmodis_sim, 1, mpilog, 0, mpicom) + call mpibcast(cosp_lrttov_sim, 1, mpilog, 0, mpicom) call mpibcast(cosp_ncolumns, 1, mpiint, 0, mpicom) call mpibcast(cosp_histfile_num, 1, mpiint, 0, mpicom) call mpibcast(cosp_histfile_aux_num,1, mpiint, 0, mpicom) call mpibcast(cosp_histfile_aux, 1, mpilog, 0, mpicom) call mpibcast(cosp_nradsteps, 1, mpiint, 0, mpicom) -#endif - + call mpibcast(rttov_Ninstruments, 1, mpiint, 0, mpicom) ! JKS - Additional RTTOV variable. This should work. + call mpibcast(rttov_instrument_namelists, len(rttov_instrument_namelists(1))*50, mpichar, 0, mpicom) + + do i=1,6 ! Broadcast swathing variables. + call mpibcast(cospswathsIN(i)%N_inst_swaths, 1, mpiint, 0, mpicom) + call mpibcast(cospswathsIN(i)%inst_localtimes, 20, mpir8, 0, mpicom) + call mpibcast(cospswathsIN(i)%inst_localtime_widths, 20, mpir8, 0, mpicom) + end do + +#endif + if (cosp_lfrac_out) then lfrac_out = .true. end if @@ -502,7 +612,10 @@ subroutine cospsimulator_intr_readnl(nlfile) if (cosp_lmodis_sim) then lmodis_sim = .true. end if - + if ((rttov_Ninstruments .gt. 0) .and. cosp_lrttov_sim) then + lrttov_sim = .true. + end if + if (cosp_histfile_aux .and. cosp_histfile_aux_num == -1) then cosp_histfile_aux_num = cosp_histfile_num end if @@ -551,7 +664,7 @@ subroutine cospsimulator_intr_readnl(nlfile) !! if no simulators are turned on at all and docosp is, set cosp_amwg = .true. if((docosp) .and. (.not.lradar_sim) .and. (.not.llidar_sim) .and. (.not.lisccp_sim) .and. & - (.not.lmisr_sim) .and. (.not.lmodis_sim)) then + (.not.lmisr_sim) .and. (.not.lmodis_sim) .and. (.not.lrttov_sim)) then cosp_amwg = .true. end if if (cosp_amwg) then @@ -582,15 +695,41 @@ subroutine cospsimulator_intr_readnl(nlfile) write(iulog,*)' Number of COSP subcolumns = ', cosp_ncolumns write(iulog,*)' Frequency at which cosp is called = ', cosp_nradsteps write(iulog,*)' Enable radar simulator = ', lradar_sim - write(iulog,*)' Enable calipso simulator = ', llidar_sim + write(iulog,*)' Enable calipso simulator = ', llidar_sim write(iulog,*)' Enable ISCCP simulator = ', lisccp_sim write(iulog,*)' Enable MISR simulator = ', lmisr_sim write(iulog,*)' Enable MODIS simulator = ', lmodis_sim + write(iulog,*)' Enable RTTOV simulator = ', lrttov_sim write(iulog,*)' RADAR_SIM microphysics scheme = ', trim(cloudsat_micro_scheme) write(iulog,*)' Write COSP output to history file = ', cosp_histfile_num write(iulog,*)' Write COSP input fields = ', cosp_histfile_aux write(iulog,*)' Write COSP input fields to history file = ', cosp_histfile_aux_num write(iulog,*)' Write COSP subcolumn fields = ', cosp_lfrac_out + + write(iulog,*)' N_SWATHS_ISCCP = ', N_SWATHS_ISCCP + write(iulog,*)' SWATH_LOCALTIMES_ISCCP = ', SWATH_LOCALTIMES_ISCCP + write(iulog,*)' SWATH_WIDTHS_ISCCP = ', SWATH_WIDTHS_ISCCP + + write(iulog,*)' N_SWATHS_MISR = ', N_SWATHS_MISR + write(iulog,*)' SWATH_LOCALTIMES_MISR = ', SWATH_LOCALTIMES_MISR + write(iulog,*)' SWATH_WIDTHS_MISR = ', SWATH_WIDTHS_MISR + + write(iulog,*)' N_SWATHS_CSCAL = ', N_SWATHS_CSCAL + write(iulog,*)' SWATH_LOCALTIMES_CSCAL = ', SWATH_LOCALTIMES_CSCAL + write(iulog,*)' SWATH_WIDTHS_CSCAL = ', SWATH_WIDTHS_CSCAL + + write(iulog,*)' N_SWATHS_MODIS = ', N_SWATHS_MODIS + write(iulog,*)' SWATH_LOCALTIMES_MODIS = ', SWATH_LOCALTIMES_MODIS + write(iulog,*)' SWATH_WIDTHS_MODIS = ', SWATH_WIDTHS_MODIS + + write(iulog,*)' N_SWATHS_PARASOL = ', N_SWATHS_PARASOL + write(iulog,*)' SWATH_LOCALTIMES_PARASOL = ', SWATH_LOCALTIMES_PARASOL + write(iulog,*)' SWATH_WIDTHS_PARASOL = ', SWATH_WIDTHS_PARASOL + + write(iulog,*)' N_SWATHS_ATLID = ', N_SWATHS_ATLID + write(iulog,*)' SWATH_LOCALTIMES_ATLID = ', SWATH_LOCALTIMES_ATLID + write(iulog,*)' SWATH_WIDTHS_ATLID = ', SWATH_WIDTHS_ATLID + else write(iulog,*)'COSP not enabled' end if @@ -606,6 +745,13 @@ subroutine cospsimulator_intr_register() use cam_history_support, only: add_hist_coord #ifdef USE_COSP + integer :: i + character(len=8) :: & + fmt, & ! format descriptor for flexible RTTOV output + i_str + + fmt = '(I3.3)' ! an integer of width 3 with zeros at the left + ! register non-standard variable dimensions if (lisccp_sim .or. lmodis_sim) then call add_hist_coord('cosp_prs', nprs_cosp, 'COSP Mean ISCCP pressure', & @@ -665,6 +811,18 @@ subroutine cospsimulator_intr_register() bounds_name='cosp_reffliq_bnds',bounds=reffLIQ_binEdges_cosp) end if + ! Assume the rttov_configs object is accessible and set up here + if (lrttov_sim) then + do i=1,rttov_Ninstruments + write (i_str,fmt) i ! converting integer to string i_str using a 'internal file' + call add_hist_coord('RTTOV_CHAN_I'//trim(i_str), & ! This string needs to be 16 characters or less + rttov_configs(i) % nchan_out, & ! Size + 'RTTOV Channel Indices for Instrument '//trim(i_str), & ! Long name + 'Channel Index', & ! Units + values=rttov_configs(i) % iChannel_out) ! History coordinate values. Original code + end do + end if + #endif end subroutine cospsimulator_intr_register @@ -688,6 +846,11 @@ subroutine cospsimulator_intr_init() integer :: ncid,latid,lonid,did,hrid,minid,secid, istat integer :: i, ierr + character(len=8) :: & + fmt, & ! format descriptor for flexible RTTOV output + i_str + + fmt = '(I3.3)' ! an integer of width 3 with zeros at the left ! ISCCP OUTPUTS if (lisccp_sim) then @@ -819,39 +982,39 @@ subroutine cospsimulator_intr_init() call addfld('CLDLOW_CAL_UN',horiz_only,'A','percent','Calipso Low-level Undefined-Phase Cloud Fraction', & flag_xyfill=.true., fill_value=R_UNDEF) -! ! Calipso Opaque/thin cloud diagnostics -! call addfld('CLDOPQ_CAL', horiz_only, 'A', 'percent', 'CALIPSO Opaque Cloud Cover', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL', horiz_only, 'A', 'percent', 'CALIPSO Thin Cloud Cover', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL', horiz_only, 'A', 'm', 'CALIPSO z_opaque Altitude', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO Opaque Cloud Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO Thin Cloud Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO z_opaque Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('OPACITY_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO opacity Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO Opaque Cloud Temperature', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO Thin Cloud Temperature', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO z_opaque Temperature', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_Z', horiz_only, 'A', 'm', 'CALIPSO Opaque Cloud Altitude', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_Z', horiz_only, 'A', 'm', 'CALIPSO Thin Cloud Altitude', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_EMIS', horiz_only, 'A', '1', 'CALIPSO Thin Cloud Emissivity', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO Opaque Cloud Altitude with respect to surface-elevation', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO Thin Cloud Altitude with respect to surface-elevation', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO z_opaque Altitude with respect to surface-elevation', & -! flag_xyfill=.true., fill_value=R_UNDEF) + ! Calipso Opaque/thin cloud diagnostics + call addfld('CLDOPQ_CAL', horiz_only, 'A', 'percent', 'CALIPSO Opaque Cloud Cover', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTHN_CAL', horiz_only, 'A', 'percent', 'CALIPSO Thin Cloud Cover', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDZOPQ_CAL', horiz_only, 'A', 'm', 'CALIPSO z_opaque Altitude', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDOPQ_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO Opaque Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTHN_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO Thin Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDZOPQ_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO z_opaque Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('OPACITY_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO opacity Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDOPQ_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO Opaque Cloud Temperature', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTHN_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO Thin Cloud Temperature', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDZOPQ_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO z_opaque Temperature', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDOPQ_CAL_Z', horiz_only, 'A', 'm', 'CALIPSO Opaque Cloud Altitude', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTHN_CAL_Z', horiz_only, 'A', 'm', 'CALIPSO Thin Cloud Altitude', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTHN_CAL_EMIS', horiz_only, 'A', '1', 'CALIPSO Thin Cloud Emissivity', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDOPQ_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO Opaque Cloud Altitude with respect to surface-elevation', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTHN_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO Thin Cloud Altitude with respect to surface-elevation', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDZOPQ_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO z_opaque Altitude with respect to surface-elevation', & + flag_xyfill=.true., fill_value=R_UNDEF) ! add_default calls for CFMIP experiments or else all fields are added to history file ! except those with sub-column dimension/experimental variables @@ -878,22 +1041,22 @@ subroutine cospsimulator_intr_init() call add_default ('CLDLOW_CAL_ICE',cosp_histfile_num,' ') call add_default ('CLDLOW_CAL_LIQ',cosp_histfile_num,' ') call add_default ('CLDLOW_CAL_UN',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_2D',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_2D',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL_2D',cosp_histfile_num,' ') -! call add_default ('OPACITY_CAL_2D',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_TMP',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_TMP',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL_TMP',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_Z',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_Z',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_EMIS',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_SE',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_SE',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL_SE',cosp_histfile_num,' ') + call add_default ('CLDOPQ_CAL',cosp_histfile_num,' ') + call add_default ('CLDTHN_CAL',cosp_histfile_num,' ') + call add_default ('CLDZOPQ_CAL',cosp_histfile_num,' ') + call add_default ('CLDOPQ_CAL_2D',cosp_histfile_num,' ') + call add_default ('CLDTHN_CAL_2D',cosp_histfile_num,' ') + call add_default ('CLDZOPQ_CAL_2D',cosp_histfile_num,' ') + call add_default ('OPACITY_CAL_2D',cosp_histfile_num,' ') + call add_default ('CLDOPQ_CAL_TMP',cosp_histfile_num,' ') + call add_default ('CLDTHN_CAL_TMP',cosp_histfile_num,' ') + call add_default ('CLDZOPQ_CAL_TMP',cosp_histfile_num,' ') + call add_default ('CLDOPQ_CAL_Z',cosp_histfile_num,' ') + call add_default ('CLDTHN_CAL_Z',cosp_histfile_num,' ') + call add_default ('CLDTHN_CAL_EMIS',cosp_histfile_num,' ') + call add_default ('CLDOPQ_CAL_SE',cosp_histfile_num,' ') + call add_default ('CLDTHN_CAL_SE',cosp_histfile_num,' ') + call add_default ('CLDZOPQ_CAL_SE',cosp_histfile_num,' ') if ((.not.cosp_amwg) .and. (.not.cosp_lite) .and. (.not.cosp_passive) .and. (.not.cosp_active) & .and. (.not.cosp_isccp)) then @@ -1076,8 +1239,120 @@ subroutine cospsimulator_intr_init() if (lradar_sim) then call add_default ('DBZE_CS',cosp_histfile_num,' ') end if + end if + + ! RTTOV + if (lrttov_sim) then + do i=1,rttov_Ninstruments + write (i_str,fmt) i ! converting integer to string i_str using a 'internal file' + if (.not. rttov_configs(i) % Lrttov_pc) then + if (rttov_configs(i) % Lrttov_bt) then + ! Just add one variable for now. + call addfld ('rttov_bt_total_inst'//trim(i_str), & ! Variable name + (/'RTTOV_CHAN_I'//trim(i_str)/), & ! History coordinate name + 'A', & ! A - 'average', I - 'instantaneous' + 'Degrees Kelvin', & ! Units + 'RTTOV All-sky Brightness Temperature', & ! Long name + flag_xyfill=.true., & + fill_value=R_UNDEF) + call add_default ('rttov_bt_total_inst'//trim(i_str),cosp_histfile_num,' ') + end if + + if (rttov_configs(i) % Lrttov_bt .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + call addfld ('rttov_bt_clear_inst'//trim(i_str), & + (/'RTTOV_CHAN_I'//trim(i_str)/), & + 'A', & + 'Degrees Kelvin', & + 'RTTOV Clear-sky Brightness Temperature', & + flag_xyfill=.true., & + fill_value=R_UNDEF) + call add_default ('rttov_bt_clear_inst'//trim(i_str),cosp_histfile_num,' ') + end if + + if (rttov_configs(i) % Lrttov_rad) then + call addfld ('rttov_rad_total_inst'//trim(i_str), & + (/'RTTOV_CHAN_I'//trim(i_str)/), & + 'A', & + 'mW/cm-1/sr/m2', & + 'RTTOV All-sky Radiance', & + flag_xyfill=.true., & + fill_value=R_UNDEF) + call add_default ('rttov_rad_total_inst'//trim(i_str),cosp_histfile_num,' ') + end if + + if (rttov_configs(i) % Lrttov_rad .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + call addfld ('rttov_rad_clear_inst'//trim(i_str), & + (/'RTTOV_CHAN_I'//trim(i_str)/), & + 'A', & + 'mW/cm-1/sr/m2', & + 'RTTOV Clear-sky Radiance', & + flag_xyfill=.true., & + fill_value=R_UNDEF) + call add_default ('rttov_rad_clear_inst'//trim(i_str),cosp_histfile_num,' ') + call addfld ('rttov_rad_cloudy_inst'//trim(i_str), & + (/'RTTOV_CHAN_I'//trim(i_str)/), & + 'A', & + 'mW/cm-1/sr/m2', & + 'RTTOV Cloudy-sky Radiance', & + flag_xyfill=.true., & + fill_value=R_UNDEF) + call add_default ('rttov_rad_cloudy_inst'//trim(i_str),cosp_histfile_num,' ') + end if + + if (rttov_configs(i) % Lrttov_refl) then + call addfld ('rttov_refl_total_inst'//trim(i_str), & + (/'RTTOV_CHAN_I'//trim(i_str)/), & + 'A', & + '1', & + 'RTTOV All-sky Reflectance', & + flag_xyfill=.true., & + fill_value=R_UNDEF) + call add_default ('rttov_refl_total_inst'//trim(i_str),cosp_histfile_num,' ') + end if + + if (rttov_configs(i) % Lrttov_refl .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + call addfld ('rttov_refl_clear_inst'//trim(i_str), & + (/'RTTOV_CHAN_I'//trim(i_str)/), & + 'A', & + '1', & + 'RTTOV Clear-sky Reflectance', & + flag_xyfill=.true., & + fill_value=R_UNDEF) + call add_default ('rttov_refl_clear_inst'//trim(i_str),cosp_histfile_num,' ') + end if + else + if (rttov_configs(i) % Lrttov_bt) then + call addfld ('rttov_btpc_clr_inst'//trim(i_str), & + (/'RTTOV_CHAN_I'//trim(i_str)/), & + 'A', & + 'Degrees Kelvin', & + 'PC-RTTOV Clear-sky Brightness Temperature', & + flag_xyfill=.true., & + fill_value=R_UNDEF) + call add_default ('rttov_btpc_clr_inst'//trim(i_str),cosp_histfile_num,' ') + end if + + if (rttov_configs(i) % Lrttov_rad) then + call addfld ('rttov_radpc_clr_inst'//trim(i_str), & + (/'RTTOV_CHAN_I'//trim(i_str)/), & + 'A', & + 'mW/cm-1/sr/m2', & + 'PC-RTTOV Clear-sky Radiance', & + flag_xyfill=.true., & + fill_value=R_UNDEF) + call add_default ('rttov_radpc_clr_inst'//trim(i_str),cosp_histfile_num,' ') + end if + end if + end do end if + if (masterproc) then + if (docosp) then + write(iulog,*)'Finished RTTOV section in cospsimulator_intr_init' + write(iulog,*)'lrttov_sim: ', lrttov_sim + end if + end if + !! ADDFLD, ADD_DEFAULT, OUTFLD CALLS FOR COSP OUTPUTS IF RUNNING COSP OFF-LINE !! Note: A suggestion was to add all of the CAM variables needed to add to make it possible to run COSP off-line !! These fields are available and can be called from the namelist though. Here, when the cosp_runall mode is invoked @@ -1156,6 +1431,7 @@ subroutine cospsimulator_intr_init() rei_idx = pbuf_get_index('REI') rel_idx = pbuf_get_index('REL') + dei_idx = pbuf_get_index('DEI') cld_idx = pbuf_get_index('CLD') concld_idx = pbuf_get_index('CONCLD') lsreffrain_idx = pbuf_get_index('LS_REFFRAIN') @@ -1164,14 +1440,18 @@ subroutine cospsimulator_intr_init() cvreffice_idx = pbuf_get_index('CV_REFFICE') dpcldliq_idx = pbuf_get_index('DP_CLDLIQ') dpcldice_idx = pbuf_get_index('DP_CLDICE') + shcldliq_idx = pbuf_get_index('SH_CLDLIQ') + shcldice_idx = pbuf_get_index('SH_CLDICE') shcldliq1_idx = pbuf_get_index('SH_CLDLIQ1') shcldice1_idx = pbuf_get_index('SH_CLDICE1') dpflxprc_idx = pbuf_get_index('DP_FLXPRC') dpflxsnw_idx = pbuf_get_index('DP_FLXSNW') shflxprc_idx = pbuf_get_index('SH_FLXPRC', errcode=ierr) - shflxsnw_idx = pbuf_get_index('SH_FLXSNW', errcode=ierr) + shflxsnw_idx = pbuf_get_index('SH_FLXSNW', errcode=ierr) lsflxprc_idx = pbuf_get_index('LS_FLXPRC') lsflxsnw_idx = pbuf_get_index('LS_FLXSNW') +! ubot_idx = pbuf_get_index('U10') ! alternate option is 10m winds (U10 and V10) +! vbot_idx = pbuf_get_index('V10') allocate(first_run_cosp(begchunk:endchunk)) first_run_cosp(begchunk:endchunk)=.true. @@ -1196,10 +1476,15 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn use cam_history, only: outfld,hist_fld_col_active use cam_history_support, only: max_fieldname_len use cmparray_mod, only: CmpDayNite, ExpDayNite + use shr_mem_mod, only: shr_mem_getusage ! JKS memory + use spmd_utils, only: masterprocid, mpicom ! JKS memory #ifdef USE_COSP use mod_cosp_config, only: R_UNDEF,parasol_nrefl, Nlvgrid, vgrid_zl, vgrid_zu use mod_cosp, only: cosp_simulator use mod_quickbeam_optics, only: size_distribution + use time_manager, only: get_curr_date ! Gets the date/time valid at the end of the timestep. Should be fine. + use ref_pres, only: top_lev=>trop_cloud_top_lev ! JKS cloud water diagnostics + use conv_water, only: conv_water_in_rad, conv_water_4rad #endif ! ###################################################################################### @@ -1221,7 +1506,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn integer :: lchnk ! chunk identifier integer :: ncol ! number of active atmospheric columns integer :: i,k,ip,it,ipt,ih,id,ihd,is,ihs,isc,ihsc,ihm,ihmt,ihml,itim_old,ifld - + ! Variables for day/nite and orbital subsetting ! Gathered indicies of day and night columns ! chunk_column_index = IdxDay(daylight_column_index) @@ -1312,10 +1597,12 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8) :: lat_cosp(pcols) ! lat for cosp (degrees_north) real(r8) :: lon_cosp(pcols) ! lon for cosp (degrees_east) real(r8) :: landmask(pcols) ! landmask (0 or 1) - real(r8) :: mr_lsliq(pcols,pver) ! mixing_ratio_large_scale_cloud_liquid (kg/kg) + real(r8) :: mr_lsliq(pcols,pver) ! mixing_ratio_large_scale_cloud_liquid (kg/kg) (gricell avg.) real(r8) :: mr_lsice(pcols,pver) ! mixing_ratio_large_scale_cloud_ice (kg/kg) real(r8) :: mr_ccliq(pcols,pver) ! mixing_ratio_convective_cloud_liquid (kg/kg) real(r8) :: mr_ccice(pcols,pver) ! mixing_ratio_convective_cloud_ice (kg/kg) + real(r8) :: icimr(pcols,pver) ! In cloud ice mixing ratio, JKS + real(r8) :: icwmr(pcols,pver) ! In cloud water mixing ratio, JKS real(r8) :: rain_cv(pcols,pverp) ! interface flux_convective_cloud_rain (kg m^-2 s^-1) real(r8) :: snow_cv(pcols,pverp) ! interface flux_convective_cloud_snow (kg m^-2 s^-1) real(r8) :: rain_cv_interp(pcols,pver) ! midpoint flux_convective_cloud_rain (kg m^-2 s^-1) @@ -1336,15 +1623,16 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8) :: dem_s_snow(pcols,pver) ! dem_s_snow - Grid-box mean Optical depth of stratiform snow at 10.5 um integer :: cam_sunlit(pcols) ! cam_sunlit - Sunlit flag(1-sunlit/0-dark). integer :: nSunLit,nNoSunLit ! Number of sunlit (not sunlit) scenes. - + integer :: rttov_sfcmask(pcols) ! Mask for RTTOV surface type (0=ocean, 1=land, 2=seaice) ! ###################################################################################### ! Simulator output info ! ###################################################################################### integer, parameter :: nf_radar=17 ! number of radar outputs - integer, parameter :: nf_calipso=28 ! number of calipso outputs + integer, parameter :: nf_calipso=44 ! number of calipso outputs (28 w/o OPAQ, 44 w/ OPAQ) integer, parameter :: nf_isccp=9 ! number of isccp outputs integer, parameter :: nf_misr=1 ! number of misr outputs integer, parameter :: nf_modis=20 ! number of modis outputs + integer, parameter :: nf_rttov=9 ! number of possible RTTOV outputs per instrument ! Cloudsat outputs character(len=max_fieldname_len),dimension(nf_radar),parameter :: & @@ -1364,11 +1652,11 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn 'CLD_CAL_ICE ','CLD_CAL_UN ','CLD_CAL_TMP ','CLD_CAL_TMPLIQ ','CLD_CAL_TMPICE ',& 'CLD_CAL_TMPUN ','CLDTOT_CAL_ICE ','CLDTOT_CAL_LIQ ','CLDTOT_CAL_UN ','CLDHGH_CAL_ICE ',& 'CLDHGH_CAL_LIQ ','CLDHGH_CAL_UN ','CLDMED_CAL_ICE ','CLDMED_CAL_LIQ ','CLDMED_CAL_UN ',& - 'CLDLOW_CAL_ICE ','CLDLOW_CAL_LIQ ','CLDLOW_CAL_UN '/)!, & -! 'CLDOPQ_CAL ','CLDTHN_CAL ','CLDZOPQ_CAL ','CLDOPQ_CAL_2D ','CLDTHN_CAL_2D ',& -! 'CLDZOPQ_CAL_2D ','OPACITY_CAL_2D ','CLDOPQ_CAL_TMP ','CLDTHN_CAL_TMP ','CLDZOPQ_CAL_TMP',& -! 'CLDOPQ_CAL_Z ','CLDTHN_CAL_Z ','CLDTHN_CAL_EMIS','CLDOPQ_CAL_SE ','CLDTHN_CAL_SE ',& -! 'CLDZOPQ_CAL_SE' /) + 'CLDLOW_CAL_ICE ','CLDLOW_CAL_LIQ ','CLDLOW_CAL_UN ', & + 'CLDOPQ_CAL ','CLDTHN_CAL ','CLDZOPQ_CAL ','CLDOPQ_CAL_2D ','CLDTHN_CAL_2D ',& + 'CLDZOPQ_CAL_2D ','OPACITY_CAL_2D ','CLDOPQ_CAL_TMP ','CLDTHN_CAL_TMP ','CLDZOPQ_CAL_TMP',& + 'CLDOPQ_CAL_Z ','CLDTHN_CAL_Z ','CLDTHN_CAL_EMIS','CLDOPQ_CAL_SE ','CLDTHN_CAL_SE ',& + 'CLDZOPQ_CAL_SE' /) ! ISCCP outputs character(len=max_fieldname_len),dimension(nf_isccp),parameter :: & fname_isccp=(/'FISCCP1_COSP ','CLDTOT_ISCCP ','MEANCLDALB_ISCCP',& @@ -1384,12 +1672,26 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn 'TAUWLOGMODIS','TAUILOGMODIS','REFFCLWMODIS','REFFCLIMODIS',& 'PCTMODIS ','LWPMODIS ','IWPMODIS ','CLMODIS ','CLRIMODIS ',& 'CLRLMODIS '/) + + character(len=8) :: & + fmt, & ! format descriptor for flexible RTTOV output + i_str + + ! JKS RTTOV outputs? + character(len=max_fieldname_len),dimension(rttov_Ninstruments,nf_rttov) :: & + fname_rttov + + real(r8) :: mem_hw_beg, mem_hw_end ! JKS memory + real(r8) :: mem_beg, mem_end ! JKS memory + real(r8) :: clat_p_tmp ! JKS memory + integer :: curp ! JKS memory - logical :: run_radar(nf_radar,pcols) ! logical telling you if you should run radar simulator - logical :: run_calipso(nf_calipso,pcols) ! logical telling you if you should run calipso simulator - logical :: run_isccp(nf_isccp,pcols) ! logical telling you if you should run isccp simulator - logical :: run_misr(nf_misr,pcols) ! logical telling you if you should run misr simulator - logical :: run_modis(nf_modis,pcols) ! logical telling you if you should run modis simulator + logical :: run_radar(nf_radar,pcols) ! logical telling you if you should run radar simulator + logical :: run_calipso(nf_calipso,pcols) ! logical telling you if you should run calipso simulator + logical :: run_isccp(nf_isccp,pcols) ! logical telling you if you should run isccp simulator + logical :: run_misr(nf_misr,pcols) ! logical telling you if you should run misr simulator + logical :: run_modis(nf_modis,pcols) ! logical telling you if you should run modis simulator + logical :: run_rttov(rttov_Ninstruments,nf_rttov,pcols) ! logical telling you if you should run rttov simulator ! CAM pointers to get variables from radiation interface (get from rad_cnst_get_gas) real(r8), pointer, dimension(:,:) :: q ! specific humidity (kg/kg) @@ -1397,19 +1699,22 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8), pointer, dimension(:,:) :: co2 ! Mass mixing ratio C02 real(r8), pointer, dimension(:,:) :: ch4 ! Mass mixing ratio CH4 real(r8), pointer, dimension(:,:) :: n2o ! Mass mixing ratio N20 + real(r8), pointer, dimension(:,:) :: co ! Mass mixing ratio CO +! real(r8), pointer, dimension(:,:) :: so2 ! Mass mixing ratio SO2 - JKS ! CAM pointers to get variables from the physics buffer real(r8), pointer, dimension(:,:) :: cld ! cloud fraction, tca - total_cloud_amount (0-1) real(r8), pointer, dimension(:,:) :: concld ! concld fraction, cca - convective_cloud_amount (0-1) real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) + real(r8), pointer, dimension(:,:) :: dei ! ice effective diameter (microns) real(r8), pointer, dimension(:,:) :: ls_reffrain ! rain effective drop radius (microns) real(r8), pointer, dimension(:,:) :: ls_reffsnow ! snow effective drop size (microns) real(r8), pointer, dimension(:,:) :: cv_reffliq ! convective cld liq effective drop radius (microns) real(r8), pointer, dimension(:,:) :: cv_reffice ! convective cld ice effective drop size (microns) !! precip flux pointers (use for cam4 or cam5) - real(r8), target, dimension(pcols,pverp) :: zero_ifc ! zero array for interface fields not in the pbuf + real(r8), target, dimension(pcols,pverp) :: zero_ifc ! zero array for interface fields not in the pbuf ! Added pointers; pbuff in zm_conv_intr.F90, calc in zm_conv.F90 real(r8), pointer, dimension(:,:) :: dp_flxprc ! deep interface gbm flux_convective_cloud_rain+snow (kg m^-2 s^-1) real(r8), pointer, dimension(:,:) :: dp_flxsnw ! deep interface gbm flux_convective_cloud_snow (kg m^-2 s^-1) @@ -1430,6 +1735,10 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8), pointer, dimension(:,:) :: dp_cldliq ! deep gbm cloud liquid water (kg/kg) real(r8), pointer, dimension(:,:) :: dp_cldice ! deep gmb cloud ice water (kg/kg) + ! Surface wind pointers for RTTOV +! real(r8), pointer, dimension(:) :: ubot ! Lowest model level zonal wind +! real(r8), pointer, dimension(:) :: vbot ! Lowest model level meridional wind + ! Output CAM variables ! Notes: ! 1) use pcols (maximum number of columns that code could use, maybe 16) @@ -1478,22 +1787,22 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8) :: cld_cal_tmpliq(pcols,nht_cosp) ! CAM (time,height,profile) real(r8) :: cld_cal_tmpice(pcols,nht_cosp) ! CAM (time,height,profile) real(r8) :: cld_cal_tmpun(pcols,nht_cosp) ! CAM (time,height,profile) !+cosp1.4 -! real(r8) :: cldopaq_cal(pcols) -! real(r8) :: cldthin_cal(pcols) -! real(r8) :: cldopaqz_cal(pcols) -! real(r8) :: cldopaq_cal_temp(pcols) -! real(r8) :: cldthin_cal_temp(pcols) -! real(r8) :: cldzopaq_cal_temp(pcols) -! real(r8) :: cldopaq_cal_z(pcols) -! real(r8) :: cldthin_cal_z(pcols) -! real(r8) :: cldthin_cal_emis(pcols) -! real(r8) :: cldopaq_cal_se(pcols) -! real(r8) :: cldthin_cal_se(pcols) -! real(r8) :: cldzopaq_cal_se(pcols) -! real(r8) :: cldopaq_cal_2d(pcols,nht_cosp) -! real(r8) :: cldthin_cal_2d(pcols,nht_cosp) -! real(r8) :: cldzopaq_cal_2d(pcols,nht_cosp) -! real(r8) :: opacity_cal_2d(pcols,nht_cosp) + real(r8) :: cldopaq_cal(pcols) + real(r8) :: cldthin_cal(pcols) + real(r8) :: cldopaqz_cal(pcols) + real(r8) :: cldopaq_cal_temp(pcols) + real(r8) :: cldthin_cal_temp(pcols) + real(r8) :: cldzopaq_cal_temp(pcols) + real(r8) :: cldopaq_cal_z(pcols) + real(r8) :: cldthin_cal_z(pcols) + real(r8) :: cldthin_cal_emis(pcols) + real(r8) :: cldopaq_cal_se(pcols) + real(r8) :: cldthin_cal_se(pcols) + real(r8) :: cldzopaq_cal_se(pcols) + real(r8) :: cldopaq_cal_2d(pcols,nht_cosp) + real(r8) :: cldthin_cal_2d(pcols,nht_cosp) + real(r8) :: cldzopaq_cal_2d(pcols,nht_cosp) + real(r8) :: opacity_cal_2d(pcols,nht_cosp) real(r8) :: cfad_dbze94_cs(pcols,nht_cosp*CLOUDSAT_DBZE_BINS)! CAM cfad_dbze94 (time,height,dbze,profile) real(r8) :: cfad_sr532_cal(pcols,nht_cosp*nsr_cosp) ! CAM cfad_lidarsr532 (time,height,scat_ratio,profile) real(r8) :: tau_isccp(pcols,nscol_cosp) ! CAM boxtauisccp (time,column,profile) @@ -1551,14 +1860,80 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn cal_betatot_liq,cal_tautot,cal_tautot_ice,cal_tautot_liq,cs_gvol_out,cs_krvol_out,cs_zvol_out,& asym34_out,ssa34_out + type(rttov_output_write),dimension(rttov_Ninstruments) :: rttov_outputs_cp + type(interp_type) :: interp_wgts integer, parameter :: extrap_method = 1 ! sets extrapolation method to boundary value (1) ! COSPv2 stuff character(len=256),dimension(100) :: cosp_status integer :: nerror + + ! Variables for determining the time. + integer :: yr, mon, day ! year, month, and day components of a date + integer :: ncsec ! current time of day [seconds] + + ! JKS trying to correct the cloud water fields + real(r8) :: allcld_ice (pcols,pver) ! cloud ice (Convective?) + real(r8) :: allcld_liq (pcols,pver) ! cloud liquid (Convective?) + + ! Create the fname string array for RTTOV + fmt = '(I3.3)' ! an integer of width 3 with zeros at the left + do i=1,rttov_Ninstruments + write (i_str,fmt) i ! converting integer to string i_str using a 'internal file' + do k=1,nf_rttov + fname_rttov(i,:) = (/'rttov_bt_total_inst'//trim(i_str), & + 'rttov_bt_clear_inst'//trim(i_str), & + 'rttov_rad_total_inst'//trim(i_str), & + 'rttov_rad_clear_inst'//trim(i_str), & + 'rttov_rad_cloudy_inst'//trim(i_str), & + 'rttov_refl_total_inst'//trim(i_str), & + 'rttov_refl_clear_inst'//trim(i_str), & + 'rttov_btpc_clr_inst'//trim(i_str), & + 'rttov_radpc_clr_inst'//trim(i_str) /) + end do + end do + + + ! Allocate the DDT for the RTTOV outputs (bleh?) + if (lrttov_sim) then + call t_startf('allocate rttov_outputs_cp') + do i=1,rttov_Ninstruments + rttov_outputs_cp(i) % nchan_out = rttov_configs(i) % nchan_out + ! Only allocate output if the output has been requested. + if (not(rttov_configs(i) % Lrttov_pc)) then + if (rttov_configs(i) % Lrttov_bt) then + allocate(rttov_outputs_cp(i) % bt_total(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_bt .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + allocate(rttov_outputs_cp(i) % bt_clear(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_rad) then + allocate(rttov_outputs_cp(i) % rad_total(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_rad .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + allocate(rttov_outputs_cp(i) % rad_clear(pcols,rttov_configs(i) % nchan_out)) + allocate(rttov_outputs_cp(i) % rad_cloudy(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_refl) then + allocate(rttov_outputs_cp(i) % refl_total(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_refl .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + allocate(rttov_outputs_cp(i) % refl_clear(pcols,rttov_configs(i) % nchan_out)) + end if + else + if (rttov_configs(i) % Lrttov_bt) then + allocate(rttov_outputs_cp(i) % bt_total_pc(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_rad) then + allocate(rttov_outputs_cp(i) % rad_total_pc(pcols,rttov_configs(i) % nchan_out)) + end if + end if + end do + call t_stopf('allocate rttov_outputs_cp') + end if - call t_startf("init_and_stuff") + call t_startf('init_and_stuff') ! ###################################################################################### ! Initialization ! ###################################################################################### @@ -1566,8 +1941,8 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn lchnk = state%lchnk ! state variable contains a number of columns, one chunk ncol = state%ncol ! number of columns in the chunk - zero_ifc = 0._r8 - + zero_ifc = 0._r8 + ! Initialize temporary variables as R_UNDEF - need to do this otherwise array expansion puts garbage in history ! file for columns over which COSP did make calculations. tmp(1:pcols) = R_UNDEF @@ -1613,22 +1988,22 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn cld_cal_tmpliq(1:pcols,1:nht_cosp) = R_UNDEF cld_cal_tmpice(1:pcols,1:nht_cosp) = R_UNDEF cld_cal_tmpun(1:pcols,1:nht_cosp) = R_UNDEF -! cldopaq_cal(1:pcols) = R_UNDEF -! cldthin_cal(1:pcols) = R_UNDEF -! cldopaqz_cal(1:pcols) = R_UNDEF -! cldopaq_cal_temp(1:pcols) = R_UNDEF -! cldthin_cal_temp(1:pcols) = R_UNDEF -! cldzopaq_cal_temp(1:pcols) = R_UNDEF -! cldopaq_cal_z(1:pcols) = R_UNDEF -! cldthin_cal_z(1:pcols) = R_UNDEF -! cldthin_cal_emis(1:pcols) = R_UNDEF -! cldopaq_cal_se(1:pcols) = R_UNDEF -! cldthin_cal_se(1:pcols) = R_UNDEF -! cldzopaq_cal_se(1:pcols) = R_UNDEF -! cldopaq_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF -! cldthin_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF -! cldzopaq_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF -! opacity_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF + cldopaq_cal(1:pcols) = R_UNDEF ! - JKS OPAQ diagnostics + cldthin_cal(1:pcols) = R_UNDEF + cldopaqz_cal(1:pcols) = R_UNDEF + cldopaq_cal_temp(1:pcols) = R_UNDEF + cldthin_cal_temp(1:pcols) = R_UNDEF + cldzopaq_cal_temp(1:pcols) = R_UNDEF + cldopaq_cal_z(1:pcols) = R_UNDEF + cldthin_cal_z(1:pcols) = R_UNDEF + cldthin_cal_emis(1:pcols) = R_UNDEF + cldopaq_cal_se(1:pcols) = R_UNDEF + cldthin_cal_se(1:pcols) = R_UNDEF + cldzopaq_cal_se(1:pcols) = R_UNDEF + cldopaq_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF + cldthin_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF + cldzopaq_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF + opacity_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF ! - JKS OPAQ diagnostics end cfad_dbze94_cs(1:pcols,1:nht_cosp*CLOUDSAT_DBZE_BINS) = R_UNDEF cfad_sr532_cal(1:pcols,1:nht_cosp*nsr_cosp) = R_UNDEF tau_isccp(1:pcols,1:nscol_cosp) = R_UNDEF @@ -1685,6 +2060,40 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn asym34_out(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF ! +cosp2 ssa34_out(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF ! +cosp2 fracLiq_out(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF ! +cosp2 + + ! Initialize the RTTOV outputs + if (lrttov_sim) then + do i=1,rttov_Ninstruments + if (not(rttov_configs(i) % Lrttov_pc)) then + if (rttov_configs(i) % Lrttov_bt) then + rttov_outputs_cp(i) % bt_total(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_bt .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + rttov_outputs_cp(i) % bt_clear(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_rad) then + rttov_outputs_cp(i) % rad_total(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_rad .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + rttov_outputs_cp(i) % rad_clear(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + rttov_outputs_cp(i) % rad_cloudy(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_refl) then + rttov_outputs_cp(i) % refl_total(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_refl .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + rttov_outputs_cp(i) % refl_clear(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + else + if (rttov_configs(i) % Lrttov_bt) then + rttov_outputs_cp(i) % bt_total_pc(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_rad) then + rttov_outputs_cp(i) % rad_total_pc(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + end if + end do + end if ! ###################################################################################### ! DECIDE WHICH COLUMNS YOU ARE GOING TO RUN COSP ON.... @@ -1700,6 +2109,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn run_isccp(1:nf_isccp,1:ncol)=.false. run_misr(1:nf_misr,1:ncol)=.false. run_modis(1:nf_modis,1:ncol)=.false. + run_rttov(1:rttov_Ninstruments,1:nf_rttov,1:ncol)=.false. if (lradar_sim) then do i=1,nf_radar @@ -1725,11 +2135,45 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn do i=1,nf_modis run_modis(i,1:pcols)=hist_fld_col_active(fname_modis(i),lchnk,pcols) end do - end if + end if + + ! Only look for variables that have been requested as output. + if (lrttov_sim) then + do k=1,rttov_Ninstruments + if (not(rttov_configs(k) % Lrttov_pc)) then + if (rttov_configs(k) % Lrttov_bt) then + run_rttov(k,1,1:pcols)=hist_fld_col_active(fname_rttov(k,1),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_bt .and. ((rttov_configs(k) % Lrttov_cld) .or. (rttov_configs(k) % Lrttov_aer))) then + run_rttov(k,2,1:pcols)=hist_fld_col_active(fname_rttov(k,2),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_rad) then + run_rttov(k,3,1:pcols)=hist_fld_col_active(fname_rttov(k,3),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_rad .and. ((rttov_configs(k) % Lrttov_cld) .or. (rttov_configs(k) % Lrttov_aer))) then + run_rttov(k,4,1:pcols)=hist_fld_col_active(fname_rttov(k,4),lchnk,pcols) + run_rttov(k,5,1:pcols)=hist_fld_col_active(fname_rttov(k,5),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_refl) then + run_rttov(k,6,1:pcols)=hist_fld_col_active(fname_rttov(k,6),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_refl .and. ((rttov_configs(k) % Lrttov_cld) .or. (rttov_configs(k) % Lrttov_aer))) then + run_rttov(k,7,1:pcols)=hist_fld_col_active(fname_rttov(k,7),lchnk,pcols) + end if + else + if (rttov_configs(k) % Lrttov_bt) then + run_rttov(k,8,1:pcols)=hist_fld_col_active(fname_rttov(k,8),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_rad) then + run_rttov(k,9,1:pcols)=hist_fld_col_active(fname_rttov(k,9),lchnk,pcols) + end if + end if + end do + end if do i=1,ncol if ((any(run_radar(:,i))) .or. (any(run_calipso(:,i))) .or. (any(run_isccp(:,i))) & - .or. (any(run_misr(:,i))) .or. (any(run_modis(:,i)))) then + .or. (any(run_misr(:,i))) .or. (any(run_modis(:,i))) .or. (any(run_rttov(:,:,i)))) then run_cosp(i,lchnk)=.true. end if end do @@ -1781,13 +2225,15 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn call rad_cnst_get_gas(0,'CH4', state, pbuf, ch4) call rad_cnst_get_gas(0,'CO2', state, pbuf, co2) call rad_cnst_get_gas(0,'N2O', state, pbuf, n2o) + ! JKS - No radiatively active CO or SO2 in RRTMG or at least in CESM2. ! 4) get variables from physics buffer itim_old = pbuf_old_tim_idx() call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, rel_idx, rel ) - call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, rei_idx, rei ) + call pbuf_get_field(pbuf, dei_idx, dei ) !added some more sizes to physics buffer in stratiform.F90 for COSP inputs call pbuf_get_field(pbuf, lsreffrain_idx, ls_reffrain ) @@ -1808,6 +2254,8 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn !! precipitation fluxes (use for both cam4 and cam5 for now....) call pbuf_get_field(pbuf, dpflxprc_idx, dp_flxprc ) call pbuf_get_field(pbuf, dpflxsnw_idx, dp_flxsnw ) +! call pbuf_get_field(pbuf, shflxprc_idx, sh_flxprc ) +! call pbuf_get_field(pbuf, shflxsnw_idx, sh_flxsnw ) if (shflxprc_idx > 0) then call pbuf_get_field(pbuf, shflxprc_idx, sh_flxprc ) else @@ -1820,7 +2268,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn end if call pbuf_get_field(pbuf, lsflxprc_idx, ls_flxprc ) call pbuf_get_field(pbuf, lsflxsnw_idx, ls_flxsnw ) - + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! CALCULATE COSP INPUT VARIABLES FROM CAM VARIABLES, done for all columns within chunk !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -1886,6 +2334,21 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn if (cam_in%landfrac(i).gt.0.01_r8) landmask(i)= 1 end do + ! 4) RTTOV surface mask (consider sea ice as well) + rttov_sfcmask(1:ncol) = 0 + do i=1,ncol + ! Land is 1 + if ((cam_in%landfrac(i) .gt. cam_in%ocnfrac(i)) .and. (cam_in%landfrac(i) .gt. cam_in%icefrac(i))) then + rttov_sfcmask = 1 + ! Ocean is 0 + else if (cam_in%ocnfrac(i) .gt. cam_in%icefrac(i)) then + rttov_sfcmask = 0 + ! Sea ice is 2 + else + rttov_sfcmask = 2 + end if + end do + ! 4) calculate necessary input cloud/precip variables ! CAM4 note: don't take the cloud water from the hack shallow convection scheme or the deep convection. ! cloud water values for convection are the same as the stratiform value. (Sungsu) @@ -1896,6 +2359,8 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn mr_ccice(1:ncol,1:pver) = 0._r8 mr_lsliq(1:ncol,1:pver) = 0._r8 mr_lsice(1:ncol,1:pver) = 0._r8 + icimr(1:ncol,1:pver) = 0._r8 ! JKS + icwmr(1:ncol,1:pver) = 0._r8 ! JKS grpl_ls_interp(1:ncol,1:pver) = 0._r8 rain_ls_interp(1:ncol,1:pver) = 0._r8 snow_ls_interp(1:ncol,1:pver) = 0._r8 @@ -1948,6 +2413,27 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn end if end do end do + + ! Calculate cloud liquid water and ice consistently with the radiation scheme. + if( conv_water_in_rad /= 0 ) then + allcld_ice(:ncol,:) = 0._r8 ! Grid-avg all cloud liquid + allcld_liq(:ncol,:) = 0._r8 ! Grid-avg all cloud ice + + call conv_water_4rad(state, pbuf, allcld_liq, allcld_ice) + else + allcld_liq(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldliq) ! Grid-ave all cloud liquid + allcld_ice(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldice) ! " ice + end if + + ! Calculate in-cloud liquid water and ice mixing ratios (most consistent with the radation scheme) + do k = top_lev, pver + do i = 1, ncol + ! Limits for in-cloud mixing ratios consistent with MG microphysics + ! in-cloud mixing ratio maximum limit of 0.005 kg/kg + icimr(i,k) = min( allcld_ice(i,k) / max(0.0001_r8,cld(i,k)),0.005_r8 ) + icwmr(i,k) = min( allcld_liq(i,k) / max(0.0001_r8,cld(i,k)),0.005_r8 ) + end do + end do !! Previously, I had set use_reff=.false. !! use_reff = .false. !! if you use this,all sizes use DEFAULT_LIDAR_REFF = 30.0e-6 meters @@ -2057,7 +2543,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn endif enddo endif - call t_stopf("init_and_stuff") + call t_stopf('init_and_stuff') ! ###################################################################################### ! ###################################################################################### @@ -2068,78 +2554,335 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! ###################################################################################### ! Construct COSP output derived type. ! ###################################################################################### - call t_startf("construct_cosp_outputs") - call construct_cosp_outputs(ncol,nscol_cosp,pver,Nlvgrid,0,cospOUT) - call t_stopf("construct_cosp_outputs") + + call t_startf('construct_cosp_outputs') + + ! JKS check memory + if (docosp) call shr_mem_getusage(mem_hw_beg, mem_beg) ! JKS leak troubleshoot + + if (allocated(rttov_configs)) then + call construct_cosp_outputs(ncol,nscol_cosp,pver,Nlvgrid,rttov_Ninstruments,cospOUT,rttov_configs) + else + call construct_cosp_outputs(ncol,nscol_cosp,pver,Nlvgrid,rttov_Ninstruments,cospOUT) + end if + + ! JKS check memory + if (docosp) then + call shr_mem_getusage(mem_hw_end, mem_end) + clat_p_tmp = mem_end - mem_beg + call MPI_reduce(clat_p_tmp, mem_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'construct_cosp_outputs: Increase in memory usage = ', mem_end, ' (MB)' + clat_p_tmp = mem_hw_end - mem_hw_beg + call MPI_reduce(clat_p_tmp, mem_hw_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'construct_cosp_outputs: Increase in memory highwater = ', mem_hw_end, ' (MB)' + end if + + call t_stopf('construct_cosp_outputs') ! ###################################################################################### ! Construct and populate COSP input types ! ###################################################################################### ! Model state - call t_startf("construct_cospstateIN") - call construct_cospstateIN(ncol,pver,0,cospstateIN) + call t_startf('construct_cospstateIN') + ! JKS check memory + if (docosp) call shr_mem_getusage(mem_hw_beg, mem_beg) ! JKS leak troubleshoot + + call construct_cospstateIN(ncol,pver,cospstateIN) + + ! JKS check memory + if (docosp) then + call shr_mem_getusage(mem_hw_end, mem_end) + clat_p_tmp = mem_end - mem_beg + call MPI_reduce(clat_p_tmp, mem_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'construct_cospstateIN: Increase in memory usage = ', mem_end, ' (MB)' + clat_p_tmp = mem_hw_end - mem_hw_beg + call MPI_reduce(clat_p_tmp, mem_hw_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'construct_cospstateIN: Increase in memory highwater = ', mem_hw_end, ' (MB)' + end if + cospstateIN%lat = lat_cosp(1:ncol) cospstateIN%lon = lon_cosp(1:ncol) - cospstateIN%at = state%t(1:ncol,1:pver) + cospstateIN%at = state%t(1:ncol,1:pver) ! Layer temperatures. cospstateIN%qv = q(1:ncol,1:pver) + cospstateIN%tca = cld(1:ncol,1:pver) cospstateIN%o3 = o3(1:ncol,1:pver) + cospstateIN%co2 = co2(1:ncol,1:pver) + cospstateIN%ch4 = ch4(1:ncol,1:pver) + cospstateIN%n2o = n2o(1:ncol,1:pver) + cospstateIN%co = 0._r8 ! CO not radiatively active. +! For winds take the total 10m wind from cam_in and divide it such that the quadrature sum is the same. + cospstateIN%u_sfc = cam_in%u10(1:ncol) * (2**(-1/2)) + cospstateIN%v_sfc = cam_in%u10(1:ncol) * (2**(-1/2)) cospstateIN%sunlit = cam_sunlit(1:ncol) cospstateIN%skt = cam_in%ts(1:ncol) - cospstateIN%land = landmask(1:ncol) + cospstateIN%psfc = state%ps(1:ncol) + cospstateIN%land = landmask(1:ncol) ! This is just a 0 or 1 logical. cospstateIN%pfull = state%pmid(1:ncol,1:pver) - cospstateIN%phalf(1:ncol,1) = 0._r8 + cospstateIN%phalf(1:ncol,1) = 0._r8 ! JKS why???? r_state indicates that the interface above the top layer is 2.25mb. cospstateIN%phalf(1:ncol,2:pver+1) = pbot(1:ncol,pver:1:-1) - cospstateIN%hgt_matrix = zmid(1:ncol,1:pver) - cospstateIN%hgt_matrix_half(1:ncol,pver+1) = 0._r8 + cospstateIN%hgt_matrix = zmid(1:ncol,1:pver) cospstateIN%hgt_matrix_half(1:ncol,1:pver) = zbot(1:ncol,pver:1:-1) cospstateIN%surfelev(1:ncol) = zbot(1:ncol,1) - call t_stopf("construct_cospstateIN") + + cospstateIN%rttov_sfcmask = rttov_sfcmask(1:ncol) + ! cospgridIN%t2m + + ! Set time + call get_curr_date(yr, mon, day, ncsec) + +! if (masterproc) then +! if (docosp) then +! write(iulog,*)'ncol: ',ncol +! write(iulog,*)'mon: ',mon +! write(iulog,*)'ncsec: ',ncsec +! write(iulog,*)'coszrs: ',coszrs +! write(iulog,*)'shape(coszrs): ',shape(coszrs) +! write(iulog,*)'shape(cospstateIN%sza): ',shape(cospstateIN%sza) +! end if +! end if + + cospstateIN%rttov_date(:,1) = yr + cospstateIN%rttov_date(:,2) = mon + cospstateIN%rttov_date(:,3) = day + + ! Need to convert from total daily seconds to hour, minute, and seconds + cospstateIN%rttov_time(:,1) = ncsec / 3600 ! Hours is nsec / 3600 (seconds per hour). Need integers to get the integer division! + cospstateIN%rttov_time(:,2) = (ncsec - 3600 * (ncsec / 3600)) / 60 ! Remainder divided by 60 seconds per minute + cospstateIN%rttov_time(:,3) = ncsec - (3600*cospstateIN%rttov_time(:,1)) - (60*cospstateIN%rttov_time(:,2)) ! Final remainder + + cospstateIN%sza(1:ncol) = acosd(coszrs(1:ncol)) ! Hokey because we get the SZA by taking the arcosine of cos(sza), but this seems to be the variable the radiation scheme can pass. + + ! if (masterproc) then + ! if (docosp) then + ! write(iulog,*)'cospstateIN%rttov_date(:,1): ',cospstateIN%rttov_date(:,1) + ! write(iulog,*)'cospstateIN%rttov_date(:,2): ',cospstateIN%rttov_date(:,2) + ! write(iulog,*)'cospstateIN%rttov_date(:,3): ',cospstateIN%rttov_date(:,3) + ! write(iulog,*)'cospstateIN%rttov_time(:,1): ',cospstateIN%rttov_time(:,1) + ! write(iulog,*)'cospstateIN%rttov_time(:,2): ',cospstateIN%rttov_time(:,2) + ! write(iulog,*)'cospstateIN%rttov_time(:,3): ',cospstateIN%rttov_time(:,3) + ! write(iulog,*)'coszrs: ',coszrs + ! write(iulog,*)'cospstateIN%sza: ',cospstateIN%sza + ! write(iulog,*)'cospstateIN%lat: ',cospstateIN%lat + ! write(iulog,*)'cospstateIN%lon: ',cospstateIN%lon + ! write(iulog,*)'cospstateIN%phalf(1,:): ',cospstateIN%phalf(1,:) + ! end if + ! end if + + ! JKS + ! Combine large-scale and convective cloud mixing ratios for RTTOV. Could pass in separately for cloud categories + ! If convective liquid is not included in RRTMG-LW's radiative transfer should I remove it? I should be able to test with print statements. + ! Old version with incorrect mixing ratios. + ! cospstateIN%cloudIce = mr_lsice(1:ncol,1:pver) + mr_ccice(1:ncol,1:pver) + ! cospstateIN%cloudLiq = mr_lsliq(1:ncol,1:pver) + mr_ccliq(1:ncol,1:pver) + ! Updated version that calculates the cloud water mixing ratios consistently with cloud_diagnostics.F90 which is used in the radiation scheme + cospstateIN%cloudIce = allcld_ice ! gridcell ice water mixing ratio + cospstateIN%cloudLiq = allcld_liq ! gridcell liquid water mixing ratio + ! Alternatively use the in-cloud mixing ratios to be more consistent with the radiation scheme. But then need to modify rttov_config % opts % rt_ir % grid_box_avg_cloud + + ! if (masterproc) write(iulog,*) 'cospstateIN%at(:,;): ',cospstateIN%at(:,:) + ! if (masterproc) write(iulog,*) 'cospstateIN%skt(:): ',cospstateIN%skt(:) + ! if (masterproc) write(iulog,*) 'cospstateIN%psfc(:): ',cospstateIN%psfc(:) + ! if (masterproc) write(iulog,*) 'cam_in%tref(1:ncol): ',cam_in%tref(1:ncol) + ! if (masterproc) write(iulog,*) 'cospstateIN%co2(1,:): ',cospstateIN%co2(1,:) + ! if (masterproc) write(iulog,*) 'cospstateIN%pfull(1,:): ',cospstateIN%pfull(1,:) + ! if (masterproc) write(iulog,*) 'cospstateIN%phalf(1,:): ',cospstateIN%phalf(1,:) + ! if (masterproc) write(iulog,*) 'cospstateIN%o3(1,:): ',cospstateIN%o3(1,:) + ! if (masterproc) write(iulog,*) 'cospgridIN%phalf(:,cospIN%Nlevels+1): ',cospgridIN%phalf(:,cospIN%Nlevels+1) + + if (masterproc) then + if (docosp) then + print*,'Npoints: ',Npoints + print*,'reff_cosp(1:ncol,1:pver,I_LSCLIQ): ',reff_cosp(1:ncol,1:pver,I_LSCLIQ) + print*,'reff_cosp(1:ncol,1:pver,I_CVCLIQ): ',reff_cosp(1:ncol,1:pver,I_CVCLIQ) + ! print*,'reff_cosp(1:ncol,1:pver,I_LSCICE): ',reff_cosp(1:ncol,1:pver,I_LSCICE) + ! print*,'reff_cosp(1:ncol,1:pver,I_CVCICE): ',reff_cosp(1:ncol,1:pver,I_CVCICE) + ! print*,'dei(1:ncol,1:pver): ',dei(1:ncol,1:pver) + ! print*,'cospstateIN%cloudLiq: ',cospstateIN%cloudLiq + ! print*,'mr_lsliq(1:ncol,1:pver): ',mr_lsliq(1:ncol,1:pver) + ! print*,'mr_ccliq(1:ncol,1:pver): ',mr_ccliq(1:ncol,1:pver) + ! print*,'icimr(1:ncol,1:pver): ',icimr(1:ncol,1:pver) + ! print*,'icwmr(1:ncol,1:pver): ',icwmr(1:ncol,1:pver) + ! print*,'allcld_liq(1:ncol,1:pver): ',allcld_liq(1:ncol,1:pver) + ! print*,'allcld_ice(1:ncol,1:pver): ',allcld_ice(1:ncol,1:pver) + ! print*,'cospstateIN%o3(1,:): ',cospstateIN%o3(1,:) + ! print*,'cospstateIN%tca(1,:): ',cospstateIN%tca(1,:) + end if + end if + + ! Combine large-scale and convective cloud effective radii into effective diameters for RTTOV + ! Reff(Npoints,Nlevels,N_HYDRO) + ! The weighted Reff is given by: Reff_net = (M_1 + M_2) / (M_1/Reff_1 + M_2/Reff_2) + ! Multiply by 2 to go from radius to diameter, multiply 1e6 to go from meters to microns. + cospstateIN%DeffLiq(:,:) = 0._r8 ! Initialize for zero everywhere. + where ((mr_lsliq(1:ncol,1:pver) .gt. 0._r8) .and. (mr_ccliq(1:ncol,1:pver) .gt. 0._r8)) + cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * (mr_lsliq(1:ncol,1:pver) + mr_ccliq(1:ncol,1:pver)) / (mr_lsliq(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_LSCLIQ) + mr_ccliq(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_CVCLIQ)) + else where (mr_lsliq(1:ncol,1:pver) .gt. 0._r8) + cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * reff_cosp(1:ncol,1:pver,I_LSCLIQ) + else where (mr_ccliq(:,Nlevels:1:-1) .gt. 0._r8) + cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * reff_cosp(1:ncol,1:pver,I_CVCLIQ) + end where + + ! cospstateIN%DeffIce(:,:) = 0._r8 ! Initialize for zero everywhere. + ! where ((mr_lsice(1:ncol,1:pver) .gt. 0._r8) .and. (mr_ccice(1:ncol,1:pver) .gt. 0._r8)) + ! cospstateIN%DeffIce(:,:) = 2._r8 * 1.0e6 * (mr_lsice(1:ncol,1:pver) + mr_ccice(1:ncol,1:pver)) / (mr_lsice(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_LSCICE) + mr_ccice(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_CVCICE)) + ! else where (mr_lsice(1:ncol,1:pver) .gt. 0._r8) + ! cospstateIN%DeffIce(:,:) = 2._r8 * 1.0e6 * reff_cosp(1:ncol,1:pver,I_LSCICE) + ! else where (mr_ccice(1:ncol,1:pver) .gt. 0._r8) + ! cospstateIN%DeffIce(:,:) = 2._r8 * 1.0e6 * reff_cosp(1:ncol,1:pver,I_CVCICE) + ! end where + + ! Use the actual effective ice diameter value (different from the radius fields and used in RRTMG) + cospstateIN%DeffIce(:,:) = dei(1:ncol,1:pver) + ! ^This field is filled with 50um values when no cloud is present. Should I worry about this? + ! ^I could set dei to zero and let the default RTTOV scheme handle it or just stick with the CESM filler value. + + ! RTTOV doesn't consider precip flux, but if I add RTTOV-SCATT it will. + ! Graupel goes in the snow category, arbitrarily. +! cospstateIN%fl_rain = fl_lsrain(1:ncol,1:pver) + fl_ccrain(1:ncol,1:pver) +! cospstateIN%fl_snow = fl_lssnow(1:ncol,1:pver) + fl_ccsnow(1:ncol,1:pver) + & +! fl_lsgrpl(1:ncol,1:pver) + + ! JKS - this is commented because the cam_in values are not populated + ! 2-meter (ref height) temperature and moisture are optional, so they have to be explicitly allocated if used. +! allocate(cospstateIN%t2m(ncol),cospstateIN%q2m(ncol)) +! cospstateIN%t2m = cam_in%tref(1:ncol) +! cospstateIN%q2m = cam_in%qref(1:ncol) + + call t_stopf('construct_cospstateIN') + +! if (masterproc) then +! if (docosp) then +! write(iulog,*)'cospstateIN%t2m: ',cospstateIN%t2m +! write(iulog,*)'cospstateIN%q2m: ',cospstateIN%q2m +! write(iulog,*)'cam_in%tref: ',cam_in%tref +! write(iulog,*)'cam_in%qref: ',cam_in%qref +! write(iulog,*)'cam_in%u10: ',cam_in%u10 +! end if +! end if + if (masterproc) then + if (docosp) then + write(iulog,*)'at construct_cospIN' + end if + end if + ! Optical inputs - call t_startf("construct_cospIN") - call construct_cospIN(ncol,nscol_cosp,pver,cospIN) + call t_startf('construct_cospIN') + ! JKS check memory + if (docosp) call shr_mem_getusage(mem_hw_beg, mem_beg) ! JKS leak troubleshoot + + call construct_cospIN(ncol,nscol_cosp,pver,rttov_Ninstruments,cospIN,emis_grey=1.0_r8) ! JKS apply unitary blackbody surface emissivity to be consistent with CESM physics + + ! JKS check memory + if (docosp) then + call shr_mem_getusage(mem_hw_end, mem_end) + clat_p_tmp = mem_end - mem_beg + call MPI_reduce(clat_p_tmp, mem_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'construct_cospIN: Increase in memory usage = ', mem_end, ' (MB)' + clat_p_tmp = mem_hw_end - mem_hw_beg + call MPI_reduce(clat_p_tmp, mem_hw_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'construct_cospIN: Increase in memory highwater = ', mem_hw_end, ' (MB)' + end if + cospIN%emsfc_lw = emsfc_lw if (lradar_sim) cospIN%rcfg_cloudsat = rcfg_cs(lchnk) - call t_stopf("construct_cospIN") + + if (masterproc) then + if (docosp) then + write(iulog,*)'after construct_cospIN' + end if + end if + + if (lrttov_sim) cospIN%cfg_rttov => rttov_configs - ! *NOTE* Fields passed into subsample_and_optics are ordered from TOA-2-SFC. - call t_startf("subsample_and_optics") - call subsample_and_optics(ncol,pver,nscol_cosp,nhydro,overlap, & - use_precipitation_fluxes,lidar_ice_type,sd_cs(lchnk),cld(1:ncol,1:pver),& - concld(1:ncol,1:pver),rain_ls_interp(1:ncol,1:pver), & - snow_ls_interp(1:ncol,1:pver),grpl_ls_interp(1:ncol,1:pver), & - rain_cv_interp(1:ncol,1:pver),snow_cv_interp(1:ncol,1:pver), & - mr_lsliq(1:ncol,1:pver),mr_lsice(1:ncol,1:pver), & - mr_ccliq(1:ncol,1:pver),mr_ccice(1:ncol,1:pver), & - reff_cosp(1:ncol,1:pver,:),dtau_c(1:ncol,1:pver), & - dtau_s(1:ncol,1:pver),dem_c(1:ncol,1:pver), & - dem_s(1:ncol,1:pver),dtau_s_snow(1:ncol,1:pver), & - dem_s_snow(1:ncol,1:pver),state%ps(1:ncol),cospstateIN,cospIN) - call t_stopf("subsample_and_optics") + cospIN%cospswathsIN = cospswathsIN + call t_stopf('construct_cospIN') + if (masterproc) then + if (docosp) then + write(iulog,*)'at subsample_and_optics' + end if + end if + + ! *NOTE* Fields passed into subsample_and_optics are ordered from TOA-2-SFC. + if (lradar_sim .or. (llidar_sim .or. (lisccp_sim .or. (lmisr_sim .or. lmodis_sim)))) then ! RTTOV does not use subsample_and_optics + call t_startf('subsample_and_optics') + call subsample_and_optics(ncol,pver,nscol_cosp,nhydro,overlap, & + use_precipitation_fluxes,lidar_ice_type,sd_cs(lchnk),cld(1:ncol,1:pver),& + concld(1:ncol,1:pver),rain_ls_interp(1:ncol,1:pver), & + snow_ls_interp(1:ncol,1:pver),grpl_ls_interp(1:ncol,1:pver), & + rain_cv_interp(1:ncol,1:pver),snow_cv_interp(1:ncol,1:pver), & + mr_lsliq(1:ncol,1:pver),mr_lsice(1:ncol,1:pver), & + mr_ccliq(1:ncol,1:pver),mr_ccice(1:ncol,1:pver), & + reff_cosp(1:ncol,1:pver,:),dtau_c(1:ncol,1:pver), & + dtau_s(1:ncol,1:pver),dem_c(1:ncol,1:pver), & + dem_s(1:ncol,1:pver),dtau_s_snow(1:ncol,1:pver), & + dem_s_snow(1:ncol,1:pver),state%ps(1:ncol),cospstateIN,cospIN) + call t_stopf('subsample_and_optics') + end if + + if (masterproc) then + if (docosp) then + write(iulog,*)'at COSP_SIMULATOR' + end if + end if + + if (docosp) call shr_mem_getusage(mem_hw_beg, mem_beg) ! JKS memory + ! ###################################################################################### ! Call COSP ! ###################################################################################### - call t_startf("cosp_simulator") - cosp_status = COSP_SIMULATOR(cospIN, cospstateIN, cospOUT, start_idx=1, stop_idx=ncol,debug=.false.) + call t_startf('cosp_simulator') + + ! Run loudly (with print statements) for the main processor + if (masterproc) then + cosp_status = COSP_SIMULATOR(cospIN, cospstateIN, cospOUT, start_idx=1, stop_idx=ncol,debug=.true.) + else + cosp_status = COSP_SIMULATOR(cospIN, cospstateIN, cospOUT, start_idx=1, stop_idx=ncol,debug=.false.) + end if + + if (masterproc) then + if (docosp) then + write(iulog,*)'after COSP_SIMULATOR' + end if + end if + + ! JKS memory + if (docosp) then + call shr_mem_getusage(mem_hw_end, mem_end) + clat_p_tmp = mem_end - mem_beg + call MPI_reduce(clat_p_tmp, mem_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'COSP_SIMULATOR: Increase in memory usage = ', mem_end, ' (MB)' + clat_p_tmp = mem_hw_end - mem_hw_beg + call MPI_reduce(clat_p_tmp, mem_hw_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'COSP_SIMULATOR: Increase in memory highwater = ', mem_hw_end, ' (MB)' + end if ! Check status flags nerror = 0 do i = 1, ubound(cosp_status, 1) if (len_trim(cosp_status(i)) > 0) then - write(iulog,*) "cosp_simulator: ERROR: "//trim(cosp_status(i)) + write(iulog,*) 'cosp_simulator: ERROR: '//trim(cosp_status(i)) nerror = nerror + 1 end if end do if (nerror > 0) then call endrun('cospsimulator_intr_run: error return from cosp_simulator') end if - call t_stopf("cosp_simulator") + call t_stopf('cosp_simulator') ! ###################################################################################### ! Write COSP inputs to output file for offline use. ! ###################################################################################### - call t_startf("cosp_histfile_aux") + call t_startf('cosp_histfile_aux') if (cosp_histfile_aux) then ! 1D outputs call outfld('PS_COSP', state%ps(1:ncol), ncol,lchnk) @@ -2173,12 +2916,12 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn call outfld('MODIS_ssa', ssa34_out, pcols,lchnk) call outfld('MODIS_fracliq',fracLiq_out,pcols,lchnk) end if - call t_stopf("cosp_histfile_aux") + call t_stopf('cosp_histfile_aux') ! ###################################################################################### ! Set dark-scenes to fill value. Only done for passive simulators and when cosp_runall=F ! ###################################################################################### - call t_startf("sunlit_passive") + call t_startf('sunlit_passive') if (.not. cosp_runall) then ! ISCCP simulator if (lisccp_sim) then @@ -2261,7 +3004,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn enddo end if end if - call t_stopf("sunlit_passive") + call t_stopf("sunlit_passive") ! ###################################################################################### ! Copy COSP outputs to CAM fields. @@ -2335,22 +3078,22 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! PARASOL. In COSP2, the Parasol simulator is independent of the calipso simulator. refl_parasol(1:ncol,1:nsza_cosp) = cospOUT%parasolGrid_refl ! CAM version of parasolrefl (time,sza,profile) ! CALIPSO Opaque cloud diagnostics -! cldopaq_cal(1:pcols) = cospOUT%calipso_cldtype(:,1) -! cldthin_cal(1:pcols) = cospOUT%calipso_cldtype(:,2) -! cldopaqz_cal(1:pcols) = cospOUT%calipso_cldtype(:,3) -! cldopaq_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,1) -! cldthin_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,2) -! cldzopaq_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,3) -! cldopaq_cal_z(1:pcols) = cospOUT%calipso_cldtypemeanz(:,1) -! cldthin_cal_z(1:pcols) = cospOUT%calipso_cldtypemeanz(:,2) -! cldthin_cal_emis(1:pcols) = cospOUT%calipso_cldthinemis -! cldopaq_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,1) -! cldthin_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,2) -! cldzopaq_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,3) -! cldopaq_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,1) -! cldthin_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,2) -! cldzopaq_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,3) -! opacity_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,4) + cldopaq_cal(1:pcols) = cospOUT%calipso_cldtype(:,1) + cldthin_cal(1:pcols) = cospOUT%calipso_cldtype(:,2) + cldopaqz_cal(1:pcols) = cospOUT%calipso_cldtype(:,3) + cldopaq_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,1) + cldthin_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,2) + cldzopaq_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,3) + cldopaq_cal_z(1:pcols) = cospOUT%calipso_cldtypemeanz(:,1) + cldthin_cal_z(1:pcols) = cospOUT%calipso_cldtypemeanz(:,2) + cldthin_cal_emis(1:pcols) = cospOUT%calipso_cldthinemis + cldopaq_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,1) + cldthin_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,2) + cldzopaq_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,3) + cldopaq_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,1) + cldthin_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,2) + cldzopaq_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,3) + opacity_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,4) endif ! ISCCP @@ -2394,6 +3137,40 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn clrimodis(1:ncol,1:ntau_cosp_modis,1:numMODISReffIceBins) = cospOUT%modis_Optical_Thickness_vs_ReffICE clrlmodis(1:ncol,1:ntau_cosp_modis,1:numMODISReffLiqBins) = cospOUT%modis_Optical_Thickness_vs_ReffLIQ endif + + ! RTTOV + if (lrttov_sim) then + do i=1,rttov_Ninstruments ! Not sure if this logical stuff is needed or not? + if (rttov_configs(i) % Lrttov_pc) then + if (rttov_configs(i) % Lrttov_bt) then + rttov_outputs_cp(i) % bt_total_pc(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % bt_total_pc + end if + if (rttov_configs(i) % Lrttov_rad) then + rttov_outputs_cp(i) % rad_total_pc(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % rad_total_pc + end if + else + if (rttov_configs(i) % Lrttov_bt) then + rttov_outputs_cp(i) % bt_total(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % bt_total + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + rttov_outputs_cp(i) % bt_clear(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % bt_clear + end if + end if + if (rttov_configs(i) % Lrttov_rad) then + rttov_outputs_cp(i) % rad_total(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % rad_total + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + rttov_outputs_cp(i) % rad_clear(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % rad_clear + rttov_outputs_cp(i) % rad_cloudy(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % rad_cloudy + end if + end if + if (rttov_configs(i) % Lrttov_refl) then + rttov_outputs_cp(i) % refl_total(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % refl_total + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + rttov_outputs_cp(i) % refl_clear(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % refl_clear + end if + end if + end if + end do + endif ! Use high-dimensional output to populate CAM collapsed output variables ! see above for mixed dimension definitions @@ -2480,16 +3257,68 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! ###################################################################################### ! Clean up ! ###################################################################################### + call t_startf("destroy_cospIN") - call destroy_cospIN(cospIN) - call t_stopf("destroy_cospIN") + ! JKS - memory check + if (docosp) call shr_mem_getusage(mem_hw_beg, mem_beg) ! JKS leak troubleshoot + + call destroy_cospIN(cospIN) ! JKS add swath destroy logical? Need to update function + + ! JKS - memory check + if (docosp) then + call shr_mem_getusage(mem_hw_end, mem_end) + clat_p_tmp = mem_beg - mem_end ! mem_end - mem_beg + call MPI_reduce(clat_p_tmp, mem_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'destroy_cospIN: Decrease in memory usage = ', mem_end, ' (MB)' + clat_p_tmp = mem_hw_beg - mem_hw_end ! mem_hw_end - mem_hw_beg + call MPI_reduce(clat_p_tmp, mem_hw_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'destroy_cospIN: Decrease in memory highwater = ', mem_hw_end, ' (MB)' + end if + + call t_stopf("destroy_cospIN") call t_startf("destroy_cospstateIN") + ! JKS - memory check + if (docosp) call shr_mem_getusage(mem_hw_beg, mem_beg) ! JKS leak troubleshoot + call destroy_cospstateIN(cospstateIN) + + ! JKS - memory check + if (docosp) then + call shr_mem_getusage(mem_hw_end, mem_end) + clat_p_tmp = mem_beg - mem_end ! mem_end - mem_beg + call MPI_reduce(clat_p_tmp, mem_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'destroy_cospstateIN: Decrease in memory usage = ', mem_end, ' (MB)' + clat_p_tmp = mem_hw_beg - mem_hw_end ! mem_hw_end - mem_hw_beg + call MPI_reduce(clat_p_tmp, mem_hw_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'destroy_cospstateIN: Decrease in memory highwater = ', mem_hw_end, ' (MB)' + end if + call t_stopf("destroy_cospstateIN") call t_startf("destroy_cospOUT") + ! JKS - memory check + if (docosp) call shr_mem_getusage(mem_hw_beg, mem_beg) ! JKS leak troubleshoot + call destroy_cosp_outputs(cospOUT) + + ! JKS - memory check + if (docosp) then + call shr_mem_getusage(mem_hw_end, mem_end) + clat_p_tmp = mem_beg - mem_end ! mem_end - mem_beg + call MPI_reduce(clat_p_tmp, mem_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'destroy_cosp_outputs: Decrease in memory usage = ', mem_end, ' (MB)' + clat_p_tmp = mem_hw_beg - mem_hw_end ! mem_hw_end - mem_hw_beg + call MPI_reduce(clat_p_tmp, mem_hw_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) write(iulog, *) 'destroy_cosp_outputs: Decrease in memory highwater = ', mem_hw_end, ' (MB)' + end if + call t_stopf("destroy_cospOUT") - + ! ###################################################################################### ! OUTPUT ! ###################################################################################### @@ -2602,38 +3431,39 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn call outfld('CLD_CAL_TMPUN',cld_cal_tmpun ,pcols,lchnk) !! !+cosp1.4 ! Opaque cloud diagnostics -! call outfld('CLDOPQ_CAL', cldopaq_cal, pcols, lchnk) -! call outfld('CLDTHN_CAL', cldthin_cal, pcols, lchnk) -! call outfld('CLDZOPQ_CAL', cldopaqz_cal, pcols, lchnk) -! call outfld('CLDOPQ_CAL_TMP', cldopaq_cal_temp, pcols, lchnk) -! call outfld('CLDTHN_CAL_TMP', cldthin_cal_temp, pcols, lchnk) -! call outfld('CLDZOPQ_CAL_TMP', cldzopaq_cal_temp, pcols, lchnk) -! call outfld('CLDOPQ_CAL_Z', cldopaq_cal_z, pcols, lchnk) -! call outfld('CLDTHN_CAL_Z', cldthin_cal_z, pcols, lchnk) -! call outfld('CLDTHN_CAL_EMIS', cldthin_cal_emis, pcols, lchnk) -! call outfld('CLDOPQ_CAL_SE', cldopaq_cal_se, pcols, lchnk) -! call outfld('CLDTHN_CAL_SE', cldthin_cal_se, pcols, lchnk) -! call outfld('CLDZOPQ_CAL_SE', cldzopaq_cal_se, pcols, lchnk) -! ! -! where (cldopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! cldopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('CLDOPQ_CAL_2D', cldopaq_cal_2d, pcols, lchnk) -! ! -! where (cldthin_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! cldthin_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('CLDTHN_CAL_2D', cldthin_cal_2d, pcols, lchnk) -! ! -! where (cldzopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! cldzopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('CLDZOPQ_CAL_2D', cldzopaq_cal_2d, pcols, lchnk) -! ! -! where (opacity_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! opacity_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('OPACITY_CAL_2D', opacity_cal_2d, pcols, lchnk) + call outfld('CLDOPQ_CAL', cldopaq_cal, pcols, lchnk) + call outfld('CLDTHN_CAL', cldthin_cal, pcols, lchnk) + call outfld('CLDZOPQ_CAL', cldopaqz_cal, pcols, lchnk) + call outfld('CLDOPQ_CAL_TMP', cldopaq_cal_temp, pcols, lchnk) + call outfld('CLDTHN_CAL_TMP', cldthin_cal_temp, pcols, lchnk) + call outfld('CLDZOPQ_CAL_TMP', cldzopaq_cal_temp, pcols, lchnk) + call outfld('CLDOPQ_CAL_Z', cldopaq_cal_z, pcols, lchnk) + call outfld('CLDTHN_CAL_Z', cldthin_cal_z, pcols, lchnk) + call outfld('CLDTHN_CAL_EMIS', cldthin_cal_emis, pcols, lchnk) + call outfld('CLDOPQ_CAL_SE', cldopaq_cal_se, pcols, lchnk) + call outfld('CLDTHN_CAL_SE', cldthin_cal_se, pcols, lchnk) + call outfld('CLDZOPQ_CAL_SE', cldzopaq_cal_se, pcols, lchnk) + ! + ! JKS not sure how this will work with masking. It won't. + where (cldopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) + cldopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLDOPQ_CAL_2D', cldopaq_cal_2d, pcols, lchnk) + ! + where (cldthin_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) + cldthin_cal_2d(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLDTHN_CAL_2D', cldthin_cal_2d, pcols, lchnk) + ! + where (cldzopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) + cldzopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLDZOPQ_CAL_2D', cldzopaq_cal_2d, pcols, lchnk) + ! + where (opacity_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) + opacity_cal_2d(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('OPACITY_CAL_2D', opacity_cal_2d, pcols, lchnk) end if @@ -2769,7 +3599,55 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn call outfld('CLMODIS',clmodis_cam ,pcols,lchnk) call outfld('CLRIMODIS',clrimodis_cam ,pcols,lchnk) call outfld('CLRLMODIS',clrlmodis_cam ,pcols,lchnk) - end if + end if + + ! RTTOV + if (lrttov_sim) then + do i=1,rttov_Ninstruments + write (i_str,fmt) i ! converting integer to string i_str using a 'internal file' + if (rttov_configs(i) % Lrttov_pc) then + if (rttov_configs(i) % Lrttov_bt) then + call outfld('rttov_btpc_clr_inst'//trim(i_str),rttov_outputs_cp(i) % bt_total_pc,pcols,lchnk) + end if + if (rttov_configs(i) % Lrttov_rad) then + call outfld('rttov_radpc_clr_inst'//trim(i_str),rttov_outputs_cp(i) % rad_total_pc,pcols,lchnk) + end if + else + if (rttov_configs(i) % Lrttov_bt) then + call outfld('rttov_bt_total_inst'//trim(i_str),rttov_outputs_cp(i) % bt_total,pcols,lchnk) + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + call outfld('rttov_bt_clear_inst'//trim(i_str),rttov_outputs_cp(i) % bt_clear,pcols,lchnk) + end if + end if + if (rttov_configs(i) % Lrttov_rad) then + call outfld('rttov_rad_total_inst'//trim(i_str),rttov_outputs_cp(i) % rad_total,pcols,lchnk) + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + call outfld('rttov_rad_clear_inst'//trim(i_str),rttov_outputs_cp(i) % rad_clear,pcols,lchnk) + call outfld('rttov_rad_cloudy_inst'//trim(i_str),rttov_outputs_cp(i) % rad_cloudy,pcols,lchnk) + end if + end if + if (rttov_configs(i) % Lrttov_refl) then + call outfld('rttov_refl_total_inst'//trim(i_str),rttov_outputs_cp(i) % refl_total,pcols,lchnk) + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + call outfld('rttov_refl_clear_inst'//trim(i_str),rttov_outputs_cp(i) % refl_clear,pcols,lchnk) + end if + end if + end if + end do + endif + + ! Deallocate the DDT for the RTTOV outputs + do i=1,rttov_Ninstruments + if (allocated(rttov_outputs_cp(i) % bt_total)) deallocate(rttov_outputs_cp(i) % bt_total) + if (allocated(rttov_outputs_cp(i) % bt_clear)) deallocate(rttov_outputs_cp(i) % bt_clear) + if (allocated(rttov_outputs_cp(i) % rad_total)) deallocate(rttov_outputs_cp(i) % rad_total) + if (allocated(rttov_outputs_cp(i) % rad_clear)) deallocate(rttov_outputs_cp(i) % rad_clear) + if (allocated(rttov_outputs_cp(i) % rad_cloudy)) deallocate(rttov_outputs_cp(i) % rad_cloudy) + if (allocated(rttov_outputs_cp(i) % refl_total)) deallocate(rttov_outputs_cp(i) % refl_total) + if (allocated(rttov_outputs_cp(i) % refl_clear)) deallocate(rttov_outputs_cp(i) % refl_clear) + if (allocated(rttov_outputs_cp(i) % bt_total_pc)) deallocate(rttov_outputs_cp(i) % bt_total_pc) + if (allocated(rttov_outputs_cp(i) % rad_total_pc)) deallocate(rttov_outputs_cp(i) % rad_total_pc) + end do ! SUB-COLUMN OUTPUT if (lfrac_out) then @@ -3272,25 +4150,34 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, call t_stopf("modis_optics") end subroutine subsample_and_optics - + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE construct_cospIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - subroutine construct_cospIN(npoints,ncolumns,nlevels,y) + subroutine construct_cospIN(npoints,ncolumns,nlevels,ninst_rttov,y,emis_grey) + use cosp_kinds, only: wp + ! Inputs integer,intent(in) :: & npoints, & ! Number of horizontal gridpoints ncolumns, & ! Number of subcolumns - nlevels ! Number of vertical levels + nlevels, & ! Number of vertical levels + ninst_rttov ! Number of RTTOV instruments ! Outputs type(cosp_optical_inputs),intent(out) :: y - + ! Optional input + real(wp),intent(in),target, optional :: & + emis_grey + ! Dimensions - y%Npoints = Npoints - y%Ncolumns = Ncolumns - y%Nlevels = Nlevels - y%Npart = 4 - y%Nrefl = PARASOL_NREFL + y%Npoints = Npoints + y%Ncolumns = Ncolumns + y%Nlevels = Nlevels + y%Ninst_rttov = Ninst_rttov + y%Npart = 4 + y%Nrefl = PARASOL_NREFL + + if (present(emis_grey)) y%emis_grey => emis_grey allocate(y%tau_067( npoints, ncolumns, nlevels),& y%emiss_11( npoints, ncolumns, nlevels),& @@ -3317,22 +4204,25 @@ end subroutine construct_cospIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE construct_cospstateIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - subroutine construct_cospstateIN(npoints,nlevels,nchan,y) + subroutine construct_cospstateIN(npoints,nlevels,y) ! Inputs integer,intent(in) :: & npoints, & ! Number of horizontal gridpoints - nlevels, & ! Number of vertical levels - nchan ! Number of channels + nlevels ! Number of vertical levels ! Outputs type(cosp_column_inputs),intent(out) :: y allocate(y%sunlit(npoints),y%skt(npoints),y%land(npoints),y%at(npoints,nlevels), & y%pfull(npoints,nlevels),y%phalf(npoints,nlevels+1),y%qv(npoints,nlevels), & y%o3(npoints,nlevels),y%hgt_matrix(npoints,nlevels),y%u_sfc(npoints), & - y%v_sfc(npoints),y%lat(npoints),y%lon(nPoints),y%emis_sfc(nchan), & + y%co(npoints,nlevels),y%n2o(npoints,nlevels),y%ch4(npoints,nlevels), & + y%co2(npoints,nlevels),y%psfc(npoints), & + y%v_sfc(npoints),y%lat(npoints),y%lon(nPoints),y%rttov_sfcmask(nPoints), & y%cloudIce(nPoints,nLevels),y%cloudLiq(nPoints,nLevels),y%surfelev(nPoints),& - y%fl_snow(nPoints,nLevels),y%fl_rain(nPoints,nLevels),y%seaice(npoints), & - y%tca(nPoints,nLevels),y%hgt_matrix_half(npoints,nlevels+1)) + y%DeffLiq(nPoints,nLevels),y%DeffIce(nPoints,nLevels), & + y%fl_snow(nPoints,nLevels),y%fl_rain(nPoints,nLevels), & + y%tca(nPoints,nLevels),y%hgt_matrix_half(npoints,nlevels), & + y%rttov_date(nPoints,3),y%rttov_time(nPoints,3),y%sza(nPoints)) end subroutine construct_cospstateIN ! ###################################################################################### @@ -3340,19 +4230,25 @@ end subroutine construct_cospstateIN ! ! This subroutine allocates output fields based on input logical flag switches. ! ###################################################################################### - subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,Nchan,x) + subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,N_rttov_instruments,x,rttov_configs) ! Inputs integer,intent(in) :: & - Npoints, & ! Number of sampled points - Ncolumns, & ! Number of subgrid columns - Nlevels, & ! Number of model levels - Nlvgrid, & ! Number of levels in L3 stats computation - Nchan ! Number of RTTOV channels - + Npoints, & ! Number of sampled points + Ncolumns, & ! Number of subgrid columns + Nlevels, & ! Number of model levels + Nlvgrid, & ! Number of levels in L3 stats computation + N_rttov_instruments ! Number of RTTOV instruments + + type(rttov_cfg), dimension(N_rttov_instruments),optional,intent(in) :: & + rttov_configs + ! Outputs type(cosp_outputs),intent(out) :: & x ! COSP output structure - + + integer :: & + i + ! ISCCP simulator outputs if (lisccp_sim) then allocate(x%isccp_boxtau(Npoints,Ncolumns)) @@ -3418,12 +4314,12 @@ subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,Nchan,x) allocate(x%calipso_tau_tot(Npoints,Ncolumns,Nlevels)) allocate(x%calipso_temp_tot(Npoints,Nlevels)) ! Calipso opaque cloud diagnostics -! allocate(x%calipso_cldtype(Npoints,LIDAR_NTYPE)) -! allocate(x%calipso_cldtypetemp(Npoints,LIDAR_NTYPE)) -! allocate(x%calipso_cldtypemeanz(Npoints,2)) -! allocate(x%calipso_cldtypemeanzse(Npoints,3)) -! allocate(x%calipso_cldthinemis(Npoints)) -! allocate(x%calipso_lidarcldtype(Npoints,Nlvgrid,LIDAR_NTYPE+1)) + allocate(x%calipso_cldtype(Npoints,LIDAR_NTYPE)) + allocate(x%calipso_cldtypetemp(Npoints,LIDAR_NTYPE)) + allocate(x%calipso_cldtypemeanz(Npoints,2)) + allocate(x%calipso_cldtypemeanzse(Npoints,3)) + allocate(x%calipso_cldthinemis(Npoints)) + allocate(x%calipso_lidarcldtype(Npoints,Nlvgrid,LIDAR_NTYPE+1)) endif ! PARASOL @@ -3441,6 +4337,52 @@ subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,Nchan,x) allocate(x%cloudsat_precip_cover(Npoints,nCloudsatPrecipClass)) allocate(x%cloudsat_pia(Npoints)) endif + + ! RTTOV - Allocate output for multiple instruments + if (lrttov_sim) then + x % N_rttov_instruments = N_rttov_instruments + allocate(x % rttov_outputs(N_rttov_instruments)) ! Need to allocate a pointer? + do i=1,N_rttov_instruments + x % rttov_outputs(i) % nchan_out = rttov_configs(i) % nchan_out + if (rttov_configs(i) % Lrttov_pc) then ! Treat PC-RTTOV fields as clear-sky only for now + allocate(x % rttov_outputs(i) % channel_indices(rttov_configs(i) % nchan_out)) + if (rttov_configs(i) % Lrttov_bt) then ! Brightness temp + allocate(x % rttov_outputs(i) % bt_total_pc(Npoints,rttov_configs(i) % nchan_out)) + ! if (Lrttov_cld .or. Lrttov_aer) allocate(x%rttov_bt_clear(Npoints,Nchan)) + end if + if (rttov_configs(i) % Lrttov_rad) then ! Radiance + allocate(x % rttov_outputs(i) % rad_total_pc(Npoints,rttov_configs(i) % nchan_out)) + ! if (Lrttov_cld .or. Lrttov_aer) allocate(x%rttov_rad_clear(Npoints,Nchan)) + ! if (Lrttov_cld .or. Lrttov_aer) allocate(x%rttov_rad_cloudy(Npoints,Nchan)) + end if + else + allocate(x % rttov_outputs(i) % channel_indices(rttov_configs(i) % nchan_out)) + if (rttov_configs(i) % Lrttov_bt) then ! Brightness temp + allocate(x % rttov_outputs(i) % bt_total(Npoints,rttov_configs(i) % nchan_out)) + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + allocate(x % rttov_outputs(i) % bt_clear(Npoints,rttov_configs(i) % nchan_out)) + end if + end if + if (rttov_configs(i) % Lrttov_rad) then ! Radiance + allocate(x % rttov_outputs(i) % rad_total(Npoints,rttov_configs(i) % nchan_out)) + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + allocate(x % rttov_outputs(i) % rad_clear(Npoints,rttov_configs(i) % nchan_out)) + end if + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + allocate(x % rttov_outputs(i) % rad_cloudy(Npoints,rttov_configs(i) % nchan_out)) + end if + end if + if (rttov_configs(i) % Lrttov_refl) then ! Reflectance + allocate(x % rttov_outputs(i) % refl_total(Npoints,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_refl .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + allocate(x % rttov_outputs(i) % refl_clear(Npoints,rttov_configs(i) % nchan_out)) + end if !^ Logic should be equivalent?? + end if + end do + else + x % N_rttov_instruments = 0 + end if end subroutine construct_cosp_outputs @@ -3470,6 +4412,16 @@ subroutine destroy_cospIN(y) if (allocated(y%ss_alb)) deallocate(y%ss_alb) if (allocated(y%fracLiq)) deallocate(y%fracLiq) if (allocated(y%fracPrecipIce)) deallocate(y%fracPrecipIce) + if (allocated(y%betatot_grLidar532)) deallocate(y%betatot_grLidar532) + if (allocated(y%betatot_atlid)) deallocate(y%betatot_atlid) + if (allocated(y%tautot_grLidar532)) deallocate(y%tautot_grLidar532) + if (allocated(y%tautot_atlid)) deallocate(y%tautot_atlid) + if (allocated(y%beta_mol_grLidar532)) deallocate(y%beta_mol_grLidar532) + if (allocated(y%beta_mol_atlid)) deallocate(y%beta_mol_atlid) + if (allocated(y%tau_mol_grLidar532)) deallocate(y%tau_mol_grLidar532) + if (allocated(y%tau_mol_atlid)) deallocate(y%tau_mol_atlid) + if (associated(y%cfg_rttov)) nullify(y%cfg_rttov) + end subroutine destroy_cospIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE destroy_cospstateIN @@ -3480,21 +4432,32 @@ subroutine destroy_cospstateIN(y) if (allocated(y%surfelev)) deallocate(y%surfelev) if (allocated(y%sunlit)) deallocate(y%sunlit) if (allocated(y%skt)) deallocate(y%skt) + if (allocated(y%psfc)) deallocate(y%psfc) if (allocated(y%land)) deallocate(y%land) + if (allocated(y%rttov_sfcmask)) deallocate(y%rttov_sfcmask) if (allocated(y%at)) deallocate(y%at) if (allocated(y%pfull)) deallocate(y%pfull) if (allocated(y%phalf)) deallocate(y%phalf) if (allocated(y%qv)) deallocate(y%qv) + if (allocated(y%rttov_date)) deallocate(y%rttov_date) + if (allocated(y%rttov_time)) deallocate(y%rttov_time) + if (allocated(y%sza)) deallocate(y%sza) + if (allocated(y%co2)) deallocate(y%co2) + if (allocated(y%ch4)) deallocate(y%ch4) + if (allocated(y%n2o)) deallocate(y%n2o) + if (allocated(y%co)) deallocate(y%co) ! New RTTOV vars^ if (allocated(y%o3)) deallocate(y%o3) if (allocated(y%hgt_matrix)) deallocate(y%hgt_matrix) if (allocated(y%u_sfc)) deallocate(y%u_sfc) if (allocated(y%v_sfc)) deallocate(y%v_sfc) if (allocated(y%lat)) deallocate(y%lat) if (allocated(y%lon)) deallocate(y%lon) - if (allocated(y%emis_sfc)) deallocate(y%emis_sfc) + if (allocated(y%emis_in)) deallocate(y%emis_in) + if (allocated(y%refl_in)) deallocate(y%refl_in) if (allocated(y%cloudIce)) deallocate(y%cloudIce) if (allocated(y%cloudLiq)) deallocate(y%cloudLiq) - if (allocated(y%seaice)) deallocate(y%seaice) + if (allocated(y%DeffLiq)) deallocate(y%DeffLiq) + if (allocated(y%DeffIce)) deallocate(y%DeffIce) if (allocated(y%fl_rain)) deallocate(y%fl_rain) if (allocated(y%fl_snow)) deallocate(y%fl_snow) if (allocated(y%tca)) deallocate(y%tca) @@ -3507,6 +4470,7 @@ end subroutine destroy_cospstateIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% subroutine destroy_cosp_outputs(y) type(cosp_outputs),intent(inout) :: y + integer :: i ! Local iterator for RTTOV instruments ! Deallocate and nullify if (associated(y%calipso_beta_mol)) then @@ -3641,10 +4605,6 @@ subroutine destroy_cosp_outputs(y) deallocate(y%misr_cldarea) nullify(y%misr_cldarea) endif - if (associated(y%rttov_tbs)) then - deallocate(y%rttov_tbs) - nullify(y%rttov_tbs) - endif if (associated(y%modis_Cloud_Fraction_Total_Mean)) then deallocate(y%modis_Cloud_Fraction_Total_Mean) nullify(y%modis_Cloud_Fraction_Total_Mean) @@ -3750,7 +4710,75 @@ subroutine destroy_cosp_outputs(y) nullify(y%calipso_lidarcldtype) endif + ! RTTOV multi-instrument - JKS +! if (associated(y%rttov_outputs)) then + if (allocated(y%rttov_outputs)) then + do i=1,y % N_rttov_instruments ! Iterate over each instrument + if (associated(y%rttov_outputs(i)%channel_indices)) then + deallocate(y%rttov_outputs(i)%channel_indices) + nullify(y%rttov_outputs(i)%channel_indices) + endif + if (associated(y%rttov_outputs(i)%bt_total)) then + deallocate(y%rttov_outputs(i)%bt_total) + nullify(y%rttov_outputs(i)%bt_total) + endif + if (associated(y%rttov_outputs(i)%bt_clear)) then + deallocate(y%rttov_outputs(i)%bt_clear) + nullify(y%rttov_outputs(i)%bt_clear) + endif + if (associated(y%rttov_outputs(i)%rad_total)) then + deallocate(y%rttov_outputs(i)%rad_total) + nullify(y%rttov_outputs(i)%rad_total) + endif + if (associated(y%rttov_outputs(i)%rad_clear)) then + deallocate(y%rttov_outputs(i)%rad_clear) + nullify(y%rttov_outputs(i)%rad_clear) + endif + if (associated(y%rttov_outputs(i)%rad_cloudy)) then + deallocate(y%rttov_outputs(i)%rad_cloudy) + nullify(y%rttov_outputs(i)%rad_cloudy) + endif + if (associated(y%rttov_outputs(i)%refl_total)) then + deallocate(y%rttov_outputs(i)%refl_total) + nullify(y%rttov_outputs(i)%refl_total) + endif + if (associated(y%rttov_outputs(i)%refl_clear)) then + deallocate(y%rttov_outputs(i)%refl_clear) + nullify(y%rttov_outputs(i)%refl_clear) + endif + if (associated(y%rttov_outputs(i)%bt_total_pc)) then + deallocate(y%rttov_outputs(i)%bt_total_pc) + nullify(y%rttov_outputs(i)%bt_total_pc) + endif + if (associated(y%rttov_outputs(i)%rad_total_pc)) then + deallocate(y%rttov_outputs(i)%rad_total_pc) + nullify(y%rttov_outputs(i)%rad_total_pc) + endif + end do + deallocate(y%rttov_outputs) +! nullify(y%rttov_outputs) + end if + end subroutine destroy_cosp_outputs + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE rttov_cleanup + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine rttov_cleanup(y) + use MOD_COSP_RTTOV_INTERFACE, only: DESTROY_RTTOV_CONFIG + + type(cosp_optical_inputs),intent(inout) :: y + integer :: i + + if (size(y%cfg_rttov) .gt. 0) then + do i=1,y%Ninst_rttov + call destroy_rttov_config(y%cfg_rttov(i)) + end do + end if + nullify(y%cfg_rttov) + + end subroutine rttov_cleanup + #endif !####################################################################### From 76818e67feef15ca4f321ed8eb5890253988f356 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Mon, 19 Aug 2024 11:34:02 -0600 Subject: [PATCH 03/24] Move assignment of allcld_ice and allcld_liq values --- src/physics/cam/cospsimulator_intr.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index ae6143d09a..69907efa4c 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -2657,6 +2657,8 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn cospstateIN%sza(1:ncol) = acosd(coszrs(1:ncol)) ! Hokey because we get the SZA by taking the arcosine of cos(sza), but this seems to be the variable the radiation scheme can pass. + cospstateIN%cloudIce(1:ncol,1:pver) = allcld_ice ! gridcell ice water mixing ratio + cospstateIN%cloudLiq(1:ncol,1:pver) = allcld_liq ! gridcell liquid water mixing ratio ! if (masterproc) then ! if (docosp) then ! write(iulog,*)'cospstateIN%rttov_date(:,1): ',cospstateIN%rttov_date(:,1) @@ -2680,8 +2682,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! cospstateIN%cloudIce = mr_lsice(1:ncol,1:pver) + mr_ccice(1:ncol,1:pver) ! cospstateIN%cloudLiq = mr_lsliq(1:ncol,1:pver) + mr_ccliq(1:ncol,1:pver) ! Updated version that calculates the cloud water mixing ratios consistently with cloud_diagnostics.F90 which is used in the radiation scheme - cospstateIN%cloudIce = allcld_ice ! gridcell ice water mixing ratio - cospstateIN%cloudLiq = allcld_liq ! gridcell liquid water mixing ratio + ! Alternatively use the in-cloud mixing ratios to be more consistent with the radiation scheme. But then need to modify rttov_config % opts % rt_ir % grid_box_avg_cloud ! if (masterproc) write(iulog,*) 'cospstateIN%at(:,;): ',cospstateIN%at(:,:) From 1db8f04df8da56126a3bafb3f0bcc5a443e42c42 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Mon, 30 Jun 2025 15:05:04 -0600 Subject: [PATCH 04/24] Remove initials, change inequality checks to modern fortran, remove old dependencies, clean up obsolete cloud water fields. --- src/physics/cam/cospsimulator_intr.F90 | 167 +++++++++++-------------- 1 file changed, 75 insertions(+), 92 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index aca97499b4..422f525fe1 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -11,7 +11,7 @@ module cospsimulator_intr ! ! ###################################################################################### use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc, mpi_real8, MPI_MAX ! JKS memory (last 2) + use spmd_utils, only: masterproc use ppgrid, only: pcols, pver, pverp, begchunk, endchunk use ref_pres, only: ktop => trop_cloud_top_lev use perf_mod, only: t_startf, t_stopf @@ -41,7 +41,7 @@ module cospsimulator_intr nhydro => N_HYDRO, & cloudsat_preclvl use mod_cosp_stats, only: cosp_change_vertical_grid - use mod_cosp_rttov_interface, only: rttov_cfg ! JKS + use mod_cosp_rttov_interface, only: rttov_cfg #endif implicit none private @@ -221,7 +221,6 @@ module cospsimulator_intr integer :: dpflxprc_idx integer :: dpflxsnw_idx, shflxprc_idx, shflxsnw_idx, lsflxprc_idx, lsflxsnw_idx integer :: rei_idx, rel_idx, dei_idx -! integer :: ubot_idx, vbot_idx ! ###################################################################################### ! Declarations specific to COSP2 @@ -405,7 +404,7 @@ subroutine cospsimulator_intr_readnl(nlfile) call mpibcast(cosp_histfile_aux_num,1, mpiint, 0, mpicom) call mpibcast(cosp_histfile_aux, 1, mpilog, 0, mpicom) call mpibcast(cosp_nradsteps, 1, mpiint, 0, mpicom) - call mpibcast(rttov_Ninstruments, 1, mpiint, 0, mpicom) ! JKS - Additional RTTOV variable. This should work. + call mpibcast(rttov_Ninstruments, 1, mpiint, 0, mpicom) call mpibcast(rttov_instrument_namelists, len(rttov_instrument_namelists(1))*50, mpichar, 0, mpicom) do i=1,6 ! Broadcast swathing variables. @@ -435,7 +434,7 @@ subroutine cospsimulator_intr_readnl(nlfile) if (cosp_lmodis_sim) then lmodis_sim = .true. end if - if ((rttov_Ninstruments .gt. 0) .and. cosp_lrttov_sim) then + if ((rttov_Ninstruments > 0) .and. cosp_lrttov_sim) then lrttov_sim = .true. end if @@ -1173,8 +1172,6 @@ subroutine cospsimulator_intr_init() shflxsnw_idx = pbuf_get_index('SH_FLXSNW', errcode=ierr) lsflxprc_idx = pbuf_get_index('LS_FLXPRC') lsflxsnw_idx = pbuf_get_index('LS_FLXSNW') -! ubot_idx = pbuf_get_index('U10') ! alternate option is 10m winds (U10 and V10) -! vbot_idx = pbuf_get_index('V10') allocate(first_run_cosp(begchunk:endchunk), run_cosp(1:pcols,begchunk:endchunk), & stat=istat) @@ -1357,7 +1354,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & use mod_cosp, only: cosp_simulator use mod_quickbeam_optics, only: size_distribution use time_manager, only: get_curr_date ! Gets the date/time valid at the end of the timestep. Should be fine. - use ref_pres, only: top_lev=>trop_cloud_top_lev ! JKS cloud water diagnostics + use ref_pres, only: top_lev=>trop_cloud_top_lev use conv_water, only: conv_water_in_rad, conv_water_4rad #endif @@ -1484,7 +1481,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & fmt, & ! format descriptor for flexible RTTOV output i_str - ! JKS RTTOV outputs? + ! RTTOV outputs character(len=max_fieldname_len),dimension(rttov_Ninstruments,nf_rttov) :: & fname_rttov @@ -1654,10 +1651,6 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & integer :: yr, mon, day ! year, month, and day components of a date integer :: ncsec ! current time of day [seconds] - ! JKS trying to correct the cloud water fields - real(r8) :: allcld_ice (pcols,pver) ! cloud ice (Convective?) - real(r8) :: allcld_liq (pcols,pver) ! cloud liquid (Convective?) - call t_startf('init_and_stuff') ! Create the fname string array for RTTOV fmt = '(I3.3)' ! an integer of width 3 with zeros at the left @@ -2068,31 +2061,21 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & if (cam_in%landfrac(i) > 0.01_r8) landmask(i)= 1 end do - ! Lat-lon for COSP-RTTOV convert from radians to cosp input type - ! Initalize - lat_cosp(1:ncol)=0._r8 - lon_cosp(1:ncol)=0._r8 - ! convert from radians to degrees_north and degrees_east - lat_cosp=state%lat*180._r8/(pi) ! needs to go from -90 to +90 degrees north - lon_cosp=state%lon*180._r8/(pi) ! needs to go from 0 to 360 degrees east - ! initalize landmask landmask(1:ncol)=0._r8 ! calculate landmask do i=1,ncol - if (cam_in%landfrac(i).gt.0.01_r8) landmask(i)= 1 + if (cam_in%landfrac(i)>0.01_r8) landmask(i)= 1 end do ! RTTOV surface mask (consider sea ice as well) + ! 1: land, 0: ocean, 2: sea ice rttov_sfcmask(1:ncol) = 0 do i=1,ncol - ! Land is 1 - if ((cam_in%landfrac(i) .gt. cam_in%ocnfrac(i)) .and. (cam_in%landfrac(i) .gt. cam_in%icefrac(i))) then + if ((cam_in%landfrac(i) > cam_in%ocnfrac(i)) .and. (cam_in%landfrac(i) > cam_in%icefrac(i))) then rttov_sfcmask(i) = 1 - ! Ocean is 0 - else if (cam_in%ocnfrac(i) .gt. cam_in%icefrac(i)) then + else if (cam_in%ocnfrac(i) > cam_in%icefrac(i)) then rttov_sfcmask(i) = 0 - ! Sea ice is 2 else rttov_sfcmask(i) = 2 end if @@ -2257,19 +2240,19 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & cospstateIN%sza(1:ncol) = acosd(coszrs(1:ncol)) ! Hokey because we get the SZA by taking the arcosine of cos(sza), but this seems to be the variable the radiation scheme can pass. - cospstateIN%cloudIce(1:ncol,1:pver) = allcld_ice ! gridcell ice water mixing ratio - cospstateIN%cloudLiq(1:ncol,1:pver) = allcld_liq ! gridcell liquid water mixing ratio + cospstateIN%cloudIce(1:ncol,1:pver) = totg_ice ! gridcell ice water mixing ratio + cospstateIN%cloudLiq(1:ncol,1:pver) = totg_liq ! gridcell liquid water mixing ratio - ! Combine large-scale and convective cloud effective radii into effective diameters for RTTOV + ! Combine large-scale and convective cloud liquid effective radii into effective diameters for RTTOV ! Reff(Npoints,Nlevels,N_HYDRO) ! The weighted Reff is given by: Reff_net = (M_1 + M_2) / (M_1/Reff_1 + M_2/Reff_2) ! Multiply by 2 to go from radius to diameter, multiply 1e6 to go from meters to microns. cospstateIN%DeffLiq(:,:) = 0._r8 ! Initialize for zero everywhere. - where ((mr_lsliq(1:ncol,1:pver) .gt. 0._r8) .and. (mr_ccliq(1:ncol,1:pver) .gt. 0._r8)) + where ((mr_lsliq(1:ncol,1:pver) > 0._r8) .and. (mr_ccliq(1:ncol,1:pver) > 0._r8)) cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * (mr_lsliq(1:ncol,1:pver) + mr_ccliq(1:ncol,1:pver)) / (mr_lsliq(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_LSCLIQ) + mr_ccliq(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_CVCLIQ)) - else where (mr_lsliq(1:ncol,1:pver) .gt. 0._r8) + else where (mr_lsliq(1:ncol,1:pver) > 0._r8) cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * reff_cosp(1:ncol,1:pver,I_LSCLIQ) - else where (mr_ccliq(:,Nlevels:1:-1) .gt. 0._r8) + else where (mr_ccliq(:,Nlevels:1:-1) > 0._r8) cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * reff_cosp(1:ncol,1:pver,I_CVCLIQ) end where cospstateIN%DeffIce(:,:) = dei(1:ncol,1:pver) @@ -2387,7 +2370,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! ISCCP simulator if (lisccp_sim) then ! 1D - where(cam_sunlit(1:ncol) .eq. 0) + where(cam_sunlit(1:ncol) == 0) cospOUT%isccp_totalcldarea(1:ncol) = R_UNDEF cospOUT%isccp_meanptop(1:ncol) = R_UNDEF cospOUT%isccp_meantaucld(1:ncol) = R_UNDEF @@ -2397,7 +2380,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where ! 2D do i=1,nscol_cosp - where (cam_sunlit(1:ncol) .eq. 0) + where (cam_sunlit(1:ncol) == 0) cospOUT%isccp_boxtau(1:ncol,i) = R_UNDEF cospOUT%isccp_boxptop(1:ncol,i) = R_UNDEF end where @@ -2405,7 +2388,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! 3D do i=1,nprs_cosp do k=1,ntau_cosp - where(cam_sunlit(1:ncol) .eq. 0) + where(cam_sunlit(1:ncol) == 0) cospOUT%isccp_fq(1:ncol,k,i) = R_UNDEF end where end do @@ -2416,7 +2399,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & if (lmisr_sim) then do i=1,nhtmisr_cosp do k=1,ntau_cosp - where(cam_sunlit(1:ncol) .eq. 0) + where(cam_sunlit(1:ncol) == 0) cospOUT%misr_fq(1:ncol,k,i) = R_UNDEF end where end do @@ -2426,7 +2409,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! MODIS simulator if (lmodis_sim) then ! 1D - where(cam_sunlit(1:ncol) .eq. 0) + where(cam_sunlit(1:ncol) == 0) cospOUT%modis_Cloud_Fraction_Total_Mean(1:ncol) = R_UNDEF cospOUT%modis_Cloud_Fraction_Water_Mean(1:ncol) = R_UNDEF cospOUT%modis_Cloud_Fraction_Ice_Mean(1:ncol) = R_UNDEF @@ -2448,17 +2431,17 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! 3D do i=1,ntau_cosp_modis do k=1,nprs_cosp - where(cam_sunlit(1:ncol) .eq. 0) + where(cam_sunlit(1:ncol) == 0) cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure(1:ncol,i,k) = R_UNDEF end where enddo do k=1,numMODISReffIceBins - where(cam_sunlit(1:ncol) .eq. 0) + where(cam_sunlit(1:ncol) == 0) cospOUT%modis_Optical_Thickness_vs_ReffICE(1:ncol,i,k) = R_UNDEF end where end do do k=1,numMODISReffLiqBins - where(cam_sunlit(1:ncol) .eq. 0) + where(cam_sunlit(1:ncol) == 0) cospOUT%modis_Optical_Thickness_vs_ReffLIQ(1:ncol,i,k) = R_UNDEF end where enddo @@ -2703,7 +2686,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & call t_startf("destroy_cospIN") - call destroy_cospIN(cospIN) ! JKS add swath destroy logical? Need to update function + call destroy_cospIN(cospIN) call t_stopf("destroy_cospIN") call t_startf("destroy_cospstateIN") @@ -2731,7 +2714,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & !! where there is no isccp cloud fraction, set meanptop_isccp = R_UNDEF !! weight meantau_isccp by the cloud fraction !! where there is no isccp cloud fraction, set meantau_isccp = R_UNDEF - where (cldtot_isccp(:ncol) .eq. R_UNDEF) + where (cldtot_isccp(:ncol) == R_UNDEF) meancldalb_isccp(:ncol) = R_UNDEF meanptop_isccp(:ncol) = R_UNDEF meantau_isccp(:ncol) = R_UNDEF @@ -2765,7 +2748,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & call outfld('CLDLOW_CAL_ICE',cldlow_cal_ice, pcols,lchnk) call outfld('CLDLOW_CAL_LIQ',cldlow_cal_liq, pcols,lchnk) call outfld('CLDLOW_CAL_UN', cldlow_cal_un, pcols,lchnk) !+1.4 - where (cld_cal(:ncol,:nht_cosp) .eq. R_UNDEF) + where (cld_cal(:ncol,:nht_cosp) == R_UNDEF) !! setting missing values to 0 (clear air). !! I'm not sure why COSP produces a mix of R_UNDEF and realvalue in the nht_cosp dimension. cld_cal(:ncol,:nht_cosp) = 0.0_r8 @@ -2773,56 +2756,56 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & call outfld('CLD_CAL', cld_cal, pcols,lchnk) !! fails check_accum if 'A' call outfld('MOL532_CAL', mol532_cal, pcols,lchnk) - where (cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) .eq. R_UNDEF) + where (cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) == R_UNDEF) !! fails check_accum if this is set... with ht_cosp set relative to sea level, mix of R_UNDEF and realvalue !! cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) = R_UNDEF cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) = 0.0_r8 end where call outfld('CFAD_SR532_CAL',cfad_sr532_cal ,pcols,lchnk) - where (refl_parasol(:ncol,:nsza_cosp) .eq. R_UNDEF) + where (refl_parasol(:ncol,:nsza_cosp) == R_UNDEF) !! setting missing values to 0 (clear air). refl_parasol(:ncol,:nsza_cosp) = 0 end where call outfld('RFL_PARASOL',refl_parasol ,pcols,lchnk) !! - where (cld_cal_liq(:ncol,:nht_cosp) .eq. R_UNDEF) !+cosp1.4 + where (cld_cal_liq(:ncol,:nht_cosp) == R_UNDEF) !+cosp1.4 !! setting missing values to 0 (clear air), likely below sea level cld_cal_liq(:ncol,:nht_cosp) = 0.0_r8 end where call outfld('CLD_CAL_LIQ',cld_cal_liq ,pcols,lchnk) !! - where (cld_cal_ice(:ncol,:nht_cosp) .eq. R_UNDEF) + where (cld_cal_ice(:ncol,:nht_cosp) == R_UNDEF) !! setting missing values to 0 (clear air), likely below sea level cld_cal_ice(:ncol,:nht_cosp) = 0.0_r8 end where call outfld('CLD_CAL_ICE',cld_cal_ice ,pcols,lchnk) !! - where (cld_cal_un(:ncol,:nht_cosp) .eq. R_UNDEF) + where (cld_cal_un(:ncol,:nht_cosp) == R_UNDEF) !! setting missing values to 0 (clear air), likely below sea level cld_cal_un(:ncol,:nht_cosp) = 0.0_r8 end where call outfld('CLD_CAL_UN',cld_cal_un ,pcols,lchnk) !! - where (cld_cal_tmp(:ncol,:nht_cosp) .eq. R_UNDEF) + where (cld_cal_tmp(:ncol,:nht_cosp) == R_UNDEF) !! setting missing values to 0 (clear air), likely below sea level cld_cal_tmp(:ncol,:nht_cosp) = 0.0_r8 end where call outfld('CLD_CAL_TMP',cld_cal_tmp ,pcols,lchnk) !! - where (cld_cal_tmpliq(:ncol,:nht_cosp) .eq. R_UNDEF) + where (cld_cal_tmpliq(:ncol,:nht_cosp) == R_UNDEF) !! setting missing values to 0 (clear air), likely below sea level cld_cal_tmpliq(:ncol,:nht_cosp) = 0.0_r8 end where call outfld('CLD_CAL_TMPLIQ',cld_cal_tmpliq ,pcols,lchnk) !! - where (cld_cal_tmpice(:ncol,:nht_cosp) .eq. R_UNDEF) + where (cld_cal_tmpice(:ncol,:nht_cosp) == R_UNDEF) !! setting missing values to 0 (clear air), likely below sea level cld_cal_tmpice(:ncol,:nht_cosp) = 0.0_r8 end where call outfld('CLD_CAL_TMPICE',cld_cal_tmpice ,pcols,lchnk) !! - where (cld_cal_tmpun(:ncol,:nht_cosp) .eq. R_UNDEF) + where (cld_cal_tmpun(:ncol,:nht_cosp) == R_UNDEF) !! setting missing values to 0 (clear air), likely below sea level cld_cal_tmpun(:ncol,:nht_cosp) = 0.0_r8 end where @@ -2844,22 +2827,22 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! NOTE: This output handling does not work with the COSP satellite swathing ! because nans meant to be swathed are assigned to R_UNDEF. - where (cldopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) + where (cldopaq_cal_2d(:ncol,:nht_cosp) == R_UNDEF) cldopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8 end where call outfld('CLDOPQ_CAL_2D', cldopaq_cal_2d, pcols, lchnk) ! - where (cldthin_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) + where (cldthin_cal_2d(:ncol,:nht_cosp) == R_UNDEF) cldthin_cal_2d(:ncol,:nht_cosp) = 0.0_r8 end where call outfld('CLDTHN_CAL_2D', cldthin_cal_2d, pcols, lchnk) ! - where (cldzopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) + where (cldzopaq_cal_2d(:ncol,:nht_cosp) == R_UNDEF) cldzopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8 end where call outfld('CLDZOPQ_CAL_2D', cldzopaq_cal_2d, pcols, lchnk) ! - where (opacity_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) + where (opacity_cal_2d(:ncol,:nht_cosp) == R_UNDEF) opacity_cal_2d(:ncol,:nht_cosp) = 0.0_r8 end where call outfld('OPACITY_CAL_2D', opacity_cal_2d, pcols, lchnk) @@ -2868,7 +2851,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! RADAR SIMULATOR OUTPUTS if (lradar_sim) then - where (cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) .eq. R_UNDEF) + where (cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) == R_UNDEF) !! fails check_accum if this is set... with ht_cosp set relative to sea level, mix of R_UNDEF and realvalue ! cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) = R_UNDEF cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) = 0.0_r8 @@ -2907,7 +2890,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & !! where there is no cloud fraction or no retrieval, set to R_UNDEF, !! otherwise weight retrieval by cloud fraction - where ((cltmodis(:ncol) .eq. R_UNDEF) .or. (tautmodis(:ncol) .eq. R_UNDEF)) + where ((cltmodis(:ncol) == R_UNDEF) .or. (tautmodis(:ncol) == R_UNDEF)) tautmodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction cltmodis @@ -2915,7 +2898,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where call outfld('TAUTMODIS',tautmodis ,pcols,lchnk) - where ((tauwmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF)) + where ((tauwmodis(:ncol) == R_UNDEF) .or. (clwmodis(:ncol) == R_UNDEF)) tauwmodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction clwmodis @@ -2923,7 +2906,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where call outfld('TAUWMODIS',tauwmodis ,pcols,lchnk) - where ((tauimodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF)) + where ((tauimodis(:ncol) == R_UNDEF) .or. (climodis(:ncol) == R_UNDEF)) tauimodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction climodis @@ -2931,7 +2914,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where call outfld('TAUIMODIS',tauimodis ,pcols,lchnk) - where ((tautlogmodis(:ncol) .eq. R_UNDEF) .or. (cltmodis(:ncol) .eq. R_UNDEF)) + where ((tautlogmodis(:ncol) == R_UNDEF) .or. (cltmodis(:ncol) == R_UNDEF)) tautlogmodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction cltmodis @@ -2939,7 +2922,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where call outfld('TAUTLOGMODIS',tautlogmodis ,pcols,lchnk) - where ((tauwlogmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF)) + where ((tauwlogmodis(:ncol) == R_UNDEF) .or. (clwmodis(:ncol) == R_UNDEF)) tauwlogmodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction clwmodis @@ -2947,7 +2930,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where call outfld('TAUWLOGMODIS',tauwlogmodis ,pcols,lchnk) - where ((tauilogmodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF)) + where ((tauilogmodis(:ncol) == R_UNDEF) .or. (climodis(:ncol) == R_UNDEF)) tauilogmodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction climodis @@ -2955,7 +2938,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where call outfld('TAUILOGMODIS',tauilogmodis ,pcols,lchnk) - where ((reffclwmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF)) + where ((reffclwmodis(:ncol) == R_UNDEF) .or. (clwmodis(:ncol) == R_UNDEF)) reffclwmodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction clwmodis @@ -2963,7 +2946,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where call outfld('REFFCLWMODIS',reffclwmodis ,pcols,lchnk) - where ((reffclimodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF)) + where ((reffclimodis(:ncol) == R_UNDEF) .or. (climodis(:ncol) == R_UNDEF)) reffclimodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction climodis @@ -2971,7 +2954,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where call outfld('REFFCLIMODIS',reffclimodis ,pcols,lchnk) - where ((pctmodis(:ncol) .eq. R_UNDEF) .or. ( cltmodis(:ncol) .eq. R_UNDEF)) + where ((pctmodis(:ncol) == R_UNDEF) .or. ( cltmodis(:ncol) == R_UNDEF)) pctmodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction cltmodis @@ -2979,7 +2962,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where call outfld('PCTMODIS',pctmodis ,pcols,lchnk) - where ((lwpmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF)) + where ((lwpmodis(:ncol) == R_UNDEF) .or. (clwmodis(:ncol) == R_UNDEF)) lwpmodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction clwmodis @@ -2987,7 +2970,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end where call outfld('LWPMODIS',lwpmodis ,pcols,lchnk) - where ((iwpmodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF)) + where ((iwpmodis(:ncol) == R_UNDEF) .or. (climodis(:ncol) == R_UNDEF)) iwpmodis(:ncol) = R_UNDEF elsewhere !! weight by the cloud fraction climodis @@ -3150,7 +3133,7 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, !-------------------------------------------------------------------------------------- call t_startf("scops") - if (Ncolumns .gt. 1) then + if (Ncolumns > 1) then !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Generate subcolumns for clouds (SCOPS) and precipitation type (PREC_SCOPS) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3158,7 +3141,7 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, allocate(rngs(nPoints), seed(nPoints), stat=istat) call handle_allocate_error(istat, sub, 'rngs, seed') seed = int(sfcP) - if (Npoints .gt. 1) seed=(sfcP-int(sfcP))*1000000 + if (Npoints > 1) seed=(sfcP-int(sfcP))*1000000 call init_rng(rngs, seed) ! Call scops @@ -3192,12 +3175,12 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, do j=1,nPoints do k=1,nLevels do i=1,nColumns - if (cospIN%frac_out(j,i,k) .eq. 1) frac_ls(j,k) = frac_ls(j,k)+1._wp - if (cospIN%frac_out(j,i,k) .eq. 2) frac_cv(j,k) = frac_cv(j,k)+1._wp - if (frac_prec(j,i,k) .eq. 1) prec_ls(j,k) = prec_ls(j,k)+1._wp - if (frac_prec(j,i,k) .eq. 2) prec_cv(j,k) = prec_cv(j,k)+1._wp - if (frac_prec(j,i,k) .eq. 3) prec_cv(j,k) = prec_cv(j,k)+1._wp - if (frac_prec(j,i,k) .eq. 3) prec_ls(j,k) = prec_ls(j,k)+1._wp + if (cospIN%frac_out(j,i,k) == 1) frac_ls(j,k) = frac_ls(j,k)+1._wp + if (cospIN%frac_out(j,i,k) == 2) frac_cv(j,k) = frac_cv(j,k)+1._wp + if (frac_prec(j,i,k) == 1) prec_ls(j,k) = prec_ls(j,k)+1._wp + if (frac_prec(j,i,k) == 2) prec_cv(j,k) = prec_cv(j,k)+1._wp + if (frac_prec(j,i,k) == 3) prec_cv(j,k) = prec_cv(j,k)+1._wp + if (frac_prec(j,i,k) == 3) prec_ls(j,k) = prec_ls(j,k)+1._wp enddo frac_ls(j,k)=frac_ls(j,k)/nColumns frac_cv(j,k)=frac_cv(j,k)/nColumns @@ -3206,10 +3189,10 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, ! Adjust grid-box mean snow properties to local properties ! Convert longwave optical depth to longwave emissivity - if (prec_ls(j,k) .ne. 0._r8 .and. dtau_s_snow(j,k) .gt. 0._r8) then + if (prec_ls(j,k) /= 0._r8 .and. dtau_s_snow(j,k) > 0._r8) then dtau_s_snow(j,k) = dtau_s_snow(j,k)/prec_ls(j,k) end if - if (prec_ls(j,k) .ne. 0._r8 .and. dem_s_snow(j,k) .gt. 0._r8) then + if (prec_ls(j,k) /= 0._r8 .and. dem_s_snow(j,k) > 0._r8) then dem_s_snow(j,k) = dem_s_snow(j,k)/prec_ls(j,k) dem_s_snow(j,k) = 1._r8 - exp ( -1._r8*dem_s_snow(j,k)) end if !!+JEK @@ -3270,22 +3253,22 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, do k=1,nLevels do j=1,nPoints ! Clouds - if (frac_ls(j,k) .ne. 0._r8) then + if (frac_ls(j,k) /= 0._r8) then mr_hydro(j,:,k,I_LSCLIQ) = mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k) mr_hydro(j,:,k,I_LSCICE) = mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k) endif - if (frac_cv(j,k) .ne. 0._r8) then + if (frac_cv(j,k) /= 0._r8) then mr_hydro(j,:,k,I_CVCLIQ) = mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k) mr_hydro(j,:,k,I_CVCICE) = mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k) endif ! Precipitation - if (prec_ls(j,k) .ne. 0._r8) then + if (prec_ls(j,k) /= 0._r8) then fl_lsrain(j,k) = fl_lsrainIN(j,k)/prec_ls(j,k) fl_lssnow(j,k) = fl_lssnowIN(j,k)/prec_ls(j,k) fl_lsgrpl(j,k) = fl_lsgrplIN(j,k)/prec_ls(j,k) endif - if (prec_cv(j,k) .ne. 0._r8) then + if (prec_cv(j,k) /= 0._r8) then fl_ccrain(j,k) = fl_ccrainIN(j,k)/prec_cv(j,k) fl_ccsnow(j,k) = fl_ccsnowIN(j,k)/prec_cv(j,k) endif @@ -3377,9 +3360,9 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, cospIN%kr_vol_cloudsat(1:nPoints,k,:)) ! At each model level, what fraction of the precipitation is frozen? - where(mr_hydro(:,k,:,I_LSRAIN) .gt. 0 .or. mr_hydro(:,k,:,I_LSSNOW) .gt. 0 .or. & - mr_hydro(:,k,:,I_CVRAIN) .gt. 0 .or. mr_hydro(:,k,:,I_CVSNOW) .gt. 0 .or. & - mr_hydro(:,k,:,I_LSGRPL) .gt. 0) + where(mr_hydro(:,k,:,I_LSRAIN) > 0 .or. mr_hydro(:,k,:,I_LSSNOW) > 0 .or. & + mr_hydro(:,k,:,I_CVRAIN) > 0 .or. mr_hydro(:,k,:,I_CVSNOW) > 0 .or. & + mr_hydro(:,k,:,I_LSGRPL) > 0) fracPrecipIce(:,k,:) = (mr_hydro(:,k,:,I_LSSNOW) + mr_hydro(:,k,:,I_CVSNOW) + & mr_hydro(:,k,:,I_LSGRPL)) / & (mr_hydro(:,k,:,I_LSSNOW) + mr_hydro(:,k,:,I_CVSNOW) + mr_hydro(:,k,:,I_LSGRPL) + & @@ -3450,7 +3433,7 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, cospIN%emiss_11) ! Add in contributions from radiative snow do j=1,nColumns - where(frac_prec(:,j,:) .eq. 1 .or. frac_prec(:,j,:) .eq. 3) + where(frac_prec(:,j,:) == 1 .or. frac_prec(:,j,:) == 3) cospIN%emiss_11(:,j,:) = 1._wp - (1- cospIN%emiss_11(:,j,:))*(1-dem_s_snow) endwhere enddo @@ -3467,8 +3450,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, ! Add in contributions from snow do j=1,nColumns - where((frac_prec(:,j,:) .eq. 1 .or. frac_prec(:,j,:) .eq. 3) .and. & - Reff(:,j,:,I_LSSNOW) .gt. 0._r8 .and. dtau_s_snow .gt. 0._r8) + where((frac_prec(:,j,:) == 1 .or. frac_prec(:,j,:) == 3) .and. & + Reff(:,j,:,I_LSSNOW) > 0._r8 .and. dtau_s_snow > 0._r8) cospIN%tau_067(:,j,:) = cospIN%tau_067(:,j,:)+dtau_s_snow endwhere enddo @@ -3507,8 +3490,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, ! Cloud snow and size MODIS_snowSize(:,:,:) = Reff(:,:,:,I_LSSNOW) do j=1,nColumns - where((frac_prec(:,j,:) .eq. 1 .or. frac_prec(:,j,:) .eq. 3) .and. & - Reff(:,j,:,I_LSSNOW) .gt. 0._r8 .and. dtau_s_snow .gt. 0._r8) + where((frac_prec(:,j,:) == 1 .or. frac_prec(:,j,:) == 3) .and. & + Reff(:,j,:,I_LSSNOW) > 0._r8 .and. dtau_s_snow > 0._r8) MODIS_cloudSnow(:,j,:) = mr_hydro(:,j,:,I_LSSNOW) MODIS_snowSize(:,j,:) = Reff(:,j,:,I_LSSNOW) elsewhere @@ -4197,7 +4180,7 @@ subroutine rttov_cleanup(y) type(cosp_optical_inputs),intent(inout) :: y integer :: i - if (size(y%cfg_rttov) .gt. 0) then + if (size(y%cfg_rttov) > 0) then do i=1,y%Ninst_rttov call destroy_rttov_config(y%cfg_rttov(i)) end do From 920045df0a60fcb079d46357f5843fae6aa43aec Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Mon, 30 Jun 2025 15:07:26 -0600 Subject: [PATCH 05/24] Prepend COSP-related namelist fields with "cosp_" and add more complete descriptions. Remove commented line from bld/configure --- bld/configure | 1 - bld/namelist_files/namelist_definition.xml | 119 ++++++++++++++------- 2 files changed, 80 insertions(+), 40 deletions(-) diff --git a/bld/configure b/bld/configure index ffe47c714e..51261f2634 100755 --- a/bld/configure +++ b/bld/configure @@ -1912,7 +1912,6 @@ if ($cosp) { $ldflags .= " -L$cosp_libdir -lrttov13_wrapper -lrttov13_mw_scatt -lrttov13_brdf_atlas -lrttov13_emis_atlas -lrttov13_other -lrttov13_parallel -lrttov13_coef_io -lrttov13_hdf -lrttov13_main "; # Let the RTTOV libraries stay where they are: # A more functional code would read these from Makefile.rttov in the COSP2 directory in CAM instead of hardcoding, but I don't know how to do that yet. - # $ldflags .= " -L$rttov_libdir -lrttov13_wrapper -lrttov13_mw_scatt -lrttov13_brdf_atlas -lrttov13_emis_atlas -lrttov13_other -lrttov13_parallel -lrttov13_coef_io -lrttov13_hdf -lrttov13_main "; $cfg_ref->set('ldflags', $ldflags); print "Adding rttov libraries as dependencies in ldflags.\n"; } diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 9d6cc64b5d..ce4699fc9f 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -2479,125 +2479,166 @@ This default logical is set in cospsimulator_intr.F90 Default: 50 - Number of RTTOV instruments to simulate. This default logical is set in cospsimulator_intr.F90 Default: 0 - -List of RTTOV instrument namelist files read when running RTTOV in COSP. +List of RTTOV instrument namelist files to read when running RTTOV in COSP. +File paths are read relative to the case run directory +(e.g. /glade/derecho/scratch/$USER/$CASENAME/run/). Each namelist file +contains information specifying the simulated instrument, channels, and +outputs. Templates and instructions can be found in the COSP-RTTOV +code repository. Default: none - -Number of satellite sampling swaths to mask COSP ISCCP data. +Number of satellite sampling swaths used to mask COSP ISCCP data. Default: none - -Number of satellite sampling swaths to mask COSP MISR data. +Number of satellite sampling swaths used to mask COSP MISR data. Default: none - -Number of satellite sampling swaths to mask COSP MODIS data. +Number of satellite sampling swaths used to mask COSP MODIS data. Default: none - -Number of satellite sampling swaths to mask COSP CloudSat-CALIPSO data. +Number of satellite sampling swaths used to mask COSP CloudSat-CALIPSO data. Default: none - -Number of satellite sampling swaths to mask COSP PARASOL data. +Number of satellite sampling swaths used to mask COSP PARASOL data. Default: none - -Number of satellite sampling swaths to mask COSP ATLID data. +Number of satellite sampling swaths used to mask COSP ATLID data. Default: none - -Swath localtimes (hours) for masking COSP ISCCP data. +Swath localtimes (hours) for masking COSP ISCCP data. The sampling +"local time" refers to a linear shift from UTC as a function of a +gridcell’s longitude (t_local = t_UTC − longitude * 24/360). Default: none - -Swath localtimes (hours) for masking COSP MISR data. +Swath localtimes (hours) for masking COSP MISR data. The sampling +"local time" refers to a linear shift from UTC as a function of a +gridcell’s longitude (t_local = t_UTC − longitude * 24/360). Default: none - -Swath localtimes (hours) for masking COSP MODIS data. +Swath localtimes (hours) for masking COSP MODIS data. The sampling +"local time" refers to a linear shift from UTC as a function of a +gridcell’s longitude (t_local = t_UTC − longitude * 24/360). Default: none - -Swath localtimes (hours) for masking COSP CloudSat-CALIPSO data. +Swath localtimes (hours) for masking COSP CloudSat-CALIPSO data. The +sampling "local time" refers to a linear shift from UTC as a function of a +gridcell’s longitude (t_local = t_UTC − longitude * 24/360). Default: none - -Swath localtimes (hours) for masking COSP PARASOL data. +Swath localtimes (hours) for masking COSP PARASOL data. The sampling +"local time" refers to a linear shift from UTC as a function of a +gridcell’s longitude (t_local = t_UTC − longitude * 24/360). Default: none - -Swath localtimes (hours) for masking COSP ATLID data. +Swath localtimes (hours) for masking COSP ATLID data. The sampling +"local time" refers to a linear shift from UTC as a function of a +gridcell’s longitude (t_local = t_UTC − longitude * 24/360). Default: none - -Swath widths (kilometers) for masking COSP ISCCP data. +Swath widths (kilometers) for masking COSP ISCCP data. The "swath width" +determines the spatial region around each local time that is simulated. +Supplying a swath width in units of distance rather than radians produces +a larger sampling density at higher latitudes that is consistent with +observations. Default: none - -Swath widths (kilometers) for masking COSP MISR data. +Swath widths (kilometers) for masking COSP MISR data. The "swath width" +determines the spatial region around each local time that is simulated. +Supplying a swath width in units of distance rather than radians produces +a larger sampling density at higher latitudes that is consistent with +observations. Default: none - -Swath widths (kilometers) for masking COSP MODIS data. +Swath widths (kilometers) for masking COSP MODIS data. The "swath width" +determines the spatial region around each local time that is simulated. +Supplying a swath width in units of distance rather than radians produces +a larger sampling density at higher latitudes that is consistent with +observations. Default: none - -Swath widths (kilometers) for masking COSP CSCAL data. +Swath widths (kilometers) for masking COSP CSCAL data. The "swath width" +determines the spatial region around each local time that is simulated. +Supplying a swath width in units of distance rather than radians produces +a larger sampling density at higher latitudes that is consistent with +observations. Default: none - -Swath widths (kilometers) for masking COSP PARASOL data. +Swath widths (kilometers) for masking COSP PARASOL data. The "swath width" +determines the spatial region around each local time that is simulated. +Supplying a swath width in units of distance rather than radians produces +a larger sampling density at higher latitudes that is consistent with +observations. Default: none - -Swath widths (kilometers) for masking COSP ATLID data. +Swath widths (kilometers) for masking COSP ATLID data. The "swath width" +determines the spatial region around each local time that is simulated. +Supplying a swath width in units of distance rather than radians produces +a larger sampling density at higher latitudes that is consistent with +observations. Default: none From fa1e764dcd200cf3d99289b257c947c7c09d4df3 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Tue, 8 Jul 2025 14:41:31 -0600 Subject: [PATCH 06/24] update imports and Makefile following COSPv2.0 reorg --- src/physics/cam/cospsimulator_intr.F90 | 8 ++--- src/physics/cosp2/Makefile.in | 46 +++++++++++++++++--------- 2 files changed, 34 insertions(+), 20 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 422f525fe1..620bcf123f 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -19,9 +19,8 @@ module cospsimulator_intr use phys_control, only: cam_physpkg_is use cam_logfile, only: iulog #ifdef USE_COSP - use quickbeam, only: radar_cfg use mod_quickbeam_optics, only: size_distribution - use mod_cosp, only: cosp_outputs, cosp_optical_inputs, cosp_column_inputs, & + use mod_cosp, only: cosp_outputs, & swath_inputs use mod_cosp_config, only: pres_binCenters, pres_binEdges, tau_binCenters, & tau_binEdges, cloudsat_binCenters, cloudsat_binEdges, calipso_binCenters, & @@ -40,8 +39,9 @@ module cospsimulator_intr nhtmisr_cosp => numMISRHgtBins, & nhydro => N_HYDRO, & cloudsat_preclvl - use mod_cosp_stats, only: cosp_change_vertical_grid - use mod_cosp_rttov_interface, only: rttov_cfg + use mod_cosp_stats, only: cosp_change_vertical_grid, cosp_optical_inputs, & + cosp_column_inputs, radar_cfg + use mod_cosp_rttov_util, only: rttov_cfg #endif implicit none private diff --git a/src/physics/cosp2/Makefile.in b/src/physics/cosp2/Makefile.in index 83ca1ad330..4f30138e68 100644 --- a/src/physics/cosp2/Makefile.in +++ b/src/physics/cosp2/Makefile.in @@ -48,9 +48,9 @@ OBJS = cosp_kinds.o cosp_constants.o cosp_cloudsat_interface.o cosp_config.o \ # Conditionally add dependencies on the STUB or actual RTTOV simulator. ifdef RTTOV -OBJS += cosp_rttov_interface_v13.o cosp_rttov_v13.o +OBJS += cosp_rttov_interface_v13.o cosp_rttov_v13.o cosp_rttov_util.o else -OBJS += cosp_rttov_interfaceSTUB.o cosp_rttovSTUB.o +OBJS += cosp_rttov_interfaceSTUB.o cosp_rttovSTUB.o cosp_rttov_utilSTUB.o endif # Copy the RTTOV libraries to the current location (which is the EXEROOT/the case bld directory) @@ -79,23 +79,28 @@ cosp.o : cosp_kinds.o cosp_modis_interface.o cosp_constants. # Conditionally add dependencies on the STUB or actual RTTOV simulator. ifdef RTTOV -cosp.o: cosp_rttov_interface_v13.o cosp_rttov_v13.o +cosp.o : cosp_rttov_interface_v13.o cosp_rttov_v13.o cosp_rttov_util.o +cosp_stats.o : cosp_kinds.o cosp_config.o cosp_constants.o cosp_rttov_util.o else -cosp.o: cosp_rttov_interfaceSTUB.o cosp_rttovSTUB.o +cosp.o : cosp_rttov_interfaceSTUB.o cosp_rttovSTUB.o cosp_rttov_utilSTUB.o +cosp_stats.o : cosp_kinds.o cosp_config.o cosp_constants.o cosp_rttov_utilSTUB.o endif cosp_config.o : cosp_kinds.o cosp_stats.o : cosp_kinds.o cosp_config.o -cosp_calipso_interface.o : cosp_kinds.o lidar_simulator.o -cosp_grLidar532_interface.o: cosp_kinds.o -cosp_atlid_interface.o : cosp_kinds.o -cosp_cloudsat_interface.o : cosp_kinds.o cosp_config.o quickbeam.o -cosp_isccp_interface.o : cosp_kinds.o icarus.o -cosp_misr_interface.o : cosp_kinds.o -cosp_modis_interface.o : cosp_kinds.o cosp_config.o modis_simulator.o -cosp_rttov_interfaceSTUB.o : cosp_kinds.o cosp_config.o cosp_rttovSTUB.o -cosp_rttov_interface_v13.o : cosp_kinds.o cosp_config.o cosp_rttov_v13.o -cosp_parasol_interface.o : cosp_kinds.o +cosp_calipso_interface.o : cosp_kinds.o cosp_stats.o lidar_simulator.o +cosp_grLidar532_interface.o: cosp_kinds.o cosp_stats.o +cosp_atlid_interface.o : cosp_kinds.o cosp_stats.o +cosp_cloudsat_interface.o : cosp_kinds.o cosp_config.o quickbeam.o cosp_stats.o +cosp_isccp_interface.o : cosp_kinds.o cosp_stats.o icarus.o +cosp_misr_interface.o : cosp_kinds.o cosp_stats.o +cosp_modis_interface.o : cosp_kinds.o cosp_config.o modis_simulator.o \ + cosp_stats.o +cosp_rttov_interfaceSTUB.o : cosp_kinds.o cosp_config.o cosp_rttovSTUB.o \ + cosp_rttov_utilSTUB.o +cosp_rttov_interface_v13.o : cosp_kinds.o cosp_config.o cosp_rttov_v13.o \ + cosp_rttov_util.o +cosp_parasol_interface.o : cosp_kinds.o cosp_stats.o cosp_rttovSTUB.o : cosp_kinds.o cosp_config.o cosp_constants.o cosp_rttov_v13.o : cosp_kinds.o cosp_config.o cosp_constants.o MISR_simulator.o : cosp_kinds.o cosp_config.o cosp_stats.o @@ -109,8 +114,9 @@ mo_rng.o : cosp_kinds.o scops.o : cosp_kinds.o mo_rng.o cosp_errorHandling.o prec_scops.o : cosp_kinds.o cosp_config.o cosp_optics.o : cosp_kinds.o cosp_constants.o modis_simulator.o -quickbeam_optics.o : cosp_kinds.o cosp_config.o cosp_constants.o quickbeam.o \ - cosp_errorHandling.o array_lib.o math_lib.o optics_lib.o +quickbeam_optics.o : cosp_kinds.o cosp_config.o cosp_stats.o cosp_constants.o \ + quickbeam.o cosp_errorHandling.o array_lib.o math_lib.o \ + optics_lib.o optics_lib.o : cosp_kinds.o cosp_errorHandling.o array_lib.o : cosp_kinds.o cosp_errorHandling.o math_lib.o : cosp_kinds.o array_lib.o mrgrnk.o @@ -118,6 +124,8 @@ mrgrnk.o : cosp_kinds.o cosp_errorHandling.o : cosp_kinds.o cosp_utils.o : cosp_kinds.o cosp_config.o cosp_constants.o : cosp_kinds.o +cosp_rttov_util.o : cosp_kinds.o +cosp_rttov_utilSTUB.o : cosp_kinds.o # clean_objs: @@ -144,6 +152,12 @@ cosp_rttov_interfaceSTUB.o : $(COSP_PATH)/src/src/simulator/cosp_rttov_interface cosp_rttov_interface_v13.o : $(COSP_PATH)/src/src/simulator/cosp_rttov_interface_v13.F90 $(F90) $(F90FLAGS) $(FFLAGS) -c $< +cosp_rttov_utilSTUB.o : $(COSP_PATH)/src/src/simulator/cosp_rttov_utilSTUB.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_rttov_util.o : $(COSP_PATH)/src/src/simulator/cosp_rttov_util.F90 + $(F90) $(F90FLAGS) $(FFLAGS) -c $< + cosp_misr_interface.o : $(COSP_PATH)/src/src/simulator/cosp_misr_interface.F90 $(F90) $(F90FLAGS) -c $< From 5334bfe00171bb7b355626cba292cdc77e9c2e64 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 9 Jul 2025 09:30:07 -0600 Subject: [PATCH 07/24] Correct COSP utils path in Makefile --- src/physics/cosp2/Makefile.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/physics/cosp2/Makefile.in b/src/physics/cosp2/Makefile.in index 4f30138e68..712e53760d 100644 --- a/src/physics/cosp2/Makefile.in +++ b/src/physics/cosp2/Makefile.in @@ -152,10 +152,10 @@ cosp_rttov_interfaceSTUB.o : $(COSP_PATH)/src/src/simulator/cosp_rttov_interface cosp_rttov_interface_v13.o : $(COSP_PATH)/src/src/simulator/cosp_rttov_interface_v13.F90 $(F90) $(F90FLAGS) $(FFLAGS) -c $< -cosp_rttov_utilSTUB.o : $(COSP_PATH)/src/src/simulator/cosp_rttov_utilSTUB.F90 +cosp_rttov_utilSTUB.o : $(COSP_PATH)/src/src/cosp_rttov_utilSTUB.F90 $(F90) $(F90FLAGS) -c $< -cosp_rttov_util.o : $(COSP_PATH)/src/src/simulator/cosp_rttov_util.F90 +cosp_rttov_util.o : $(COSP_PATH)/src/src/cosp_rttov_util.F90 $(F90) $(F90FLAGS) $(FFLAGS) -c $< cosp_misr_interface.o : $(COSP_PATH)/src/src/simulator/cosp_misr_interface.F90 From da5fa8b934ddcecadaac996c35ebfa9a3d51849e Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 9 Jul 2025 09:30:34 -0600 Subject: [PATCH 08/24] Update cosp2 repo information for git fleximod --- .gitmodules | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/.gitmodules b/.gitmodules index 169d3259e4..b5835377b1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -97,13 +97,21 @@ fxtag = v8.2.1 fxDONOTUSEurl = https://github.com/MPAS-Dev/MPAS-Model.git +# [submodule "cosp2"] +# path = src/physics/cosp2/src +# url = https://github.com/CFMIP/COSPv2.0 +# fxrequired = AlwaysRequired +# fxsparse = ../.cosp_sparse_checkout +# fxtag = v2.1.4cesm +# fxDONOTUSEurl = https://github.com/CFMIP/COSPv2.0 + [submodule "cosp2"] - path = src/physics/cosp2/src - url = https://github.com/CFMIP/COSPv2.0 + path = src/physics/cosp2/src + url = https://github.com/dustinswales/COSPv2.0 fxrequired = AlwaysRequired fxsparse = ../.cosp_sparse_checkout - fxtag = v2.1.4cesm - fxDONOTUSEurl = https://github.com/CFMIP/COSPv2.0 + fxtag = feature/cosp_rttov_swathing + fxDONOTUSEurl = https://github.com/dustinswales/COSPv2.0 [submodule "clubb"] path = src/physics/clubb From 8e47f709e7528776d759fccd32fe21fc3229d781 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 9 Jul 2025 17:08:25 -0600 Subject: [PATCH 09/24] Address error in CESM build with COSP but not RTTOV. --- src/physics/cam/cospsimulator_intr.F90 | 75 +++++++++++++++----------- 1 file changed, 43 insertions(+), 32 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 620bcf123f..105fa2abe3 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -1190,13 +1190,15 @@ subroutine setcosp2values() use mod_cosp, only: cosp_init use mod_cosp_config, only: vgrid_zl, vgrid_zu, vgrid_z use mod_quickbeam_optics, only: hydro_class_init, quickbeam_optics_init - + use units, only: getunit, freeunit ! Local logical :: ldouble=.false. logical :: lsingle=.true. ! Default is to use single moment integer :: k integer :: istat + integer :: unitn character(len=*), parameter :: sub = 'setcosp2values' + character(len=256), allocatable :: rttov_instrument_namelists_final(:) !-------------------------------------------------------------------------------------- prsmid_cosp = pres_binCenters @@ -1232,10 +1234,20 @@ subroutine setcosp2values() ! to _init functions in cosp_init. ! DS2019: Add logicals, default=.false., for new Lidar simuldators (Earthcare (atlid) and ground-based ! lidar at 532nm) - call COSP_INIT(Lisccp_sim, Lmodis_sim, Lmisr_sim, Lradar_sim, Llidar_sim, LgrLidar532, & - Latlid, Lparasol_sim, Lrttov_sim, radar_freq, k2, use_gas_abs, do_ray, & - isccp_topheight, isccp_topheight_direction, surface_radar, rcfg_cloudsat, & - use_vgrid, csat_vgrid, Nlr, nlay, cloudsat_micro_scheme) + + ! Flexible RTTOV namelist I/O + allocate(rttov_instrument_namelists_final(rttov_Ninstruments)) + rttov_instrument_namelists_final(:) = rttov_instrument_namelists(1:rttov_Ninstruments) + + unitn = getunit() + + call COSP_INIT(Lisccp_sim, Lmodis_sim, Lmisr_sim, Lradar_sim, Llidar_sim, LgrLidar532, & + Latlid, Lparasol_sim, Lrttov_sim, radar_freq, k2, use_gas_abs, do_ray, & + isccp_topheight, isccp_topheight_direction, surface_radar, rcfg_cloudsat, & + use_vgrid, csat_vgrid, Nlr, nlay, cloudsat_micro_scheme, & + rttov_Ninstruments, rttov_instrument_namelists_final, rttov_configs,unitn=unitn) + call freeunit(unitn) + deallocate(rttov_instrument_namelists_final) if (use_vgrid) then !! using fixed vertical grid if (csat_vgrid) then @@ -1629,7 +1641,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & real(r8) :: clrimodis(pcols,ntau_cosp,numMODISReffIceBins) real(r8) :: clrlmodis_cam(pcols,ntau_cosp*numMODISReffLiqBins) real(r8) :: clrlmodis(pcols,ntau_cosp,numMODISReffLiqBins) - real(r8),dimension(pcols,nhtml_cosp*nscol_cosp) :: & + real(r8),dimension(pcols,nlay*nscol_cosp) :: & tau067_out,emis11_out,fracliq_out,cal_betatot,cal_betatot_ice, & cal_betatot_liq,cal_tautot,cal_tautot_ice,cal_tautot_liq,cs_gvol_out,cs_krvol_out,cs_zvol_out,& asym34_out,ssa34_out @@ -2190,7 +2202,11 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! Construct COSP output derived type. ! ###################################################################################### call t_startf("construct_cosp_outputs") - call construct_cosp_outputs(ncol, nscol_cosp, nlay, Nlvgrid, cospOUT) + if (allocated(rttov_configs)) then + call construct_cosp_outputs(ncol,nscol_cosp,nlay,Nlvgrid,rttov_Ninstruments,cospOUT,rttov_configs) + else + call construct_cosp_outputs(ncol,nscol_cosp,nlay,Nlvgrid,rttov_Ninstruments,cospOUT) + end if call t_stopf("construct_cosp_outputs") ! ###################################################################################### @@ -2252,7 +2268,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * (mr_lsliq(1:ncol,1:pver) + mr_ccliq(1:ncol,1:pver)) / (mr_lsliq(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_LSCLIQ) + mr_ccliq(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_CVCLIQ)) else where (mr_lsliq(1:ncol,1:pver) > 0._r8) cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * reff_cosp(1:ncol,1:pver,I_LSCLIQ) - else where (mr_ccliq(:,Nlevels:1:-1) > 0._r8) + else where (mr_ccliq(1:ncol,1:pver) > 0._r8) cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * reff_cosp(1:ncol,1:pver,I_CVCLIQ) end where cospstateIN%DeffIce(:,:) = dei(1:ncol,1:pver) @@ -2275,27 +2291,21 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & cospIN%cospswathsIN = cospswathsIN call t_stopf('construct_cospIN') - - if (masterproc) then - if (docosp) then - write(iulog,*)'at subsample_and_optics' - end if - end if - ! *NOTE* Fields passed into subsample_and_optics are ordered from TOA-2-SFC. if (lradar_sim .or. (llidar_sim .or. (lisccp_sim .or. (lmisr_sim .or. lmodis_sim)))) then call t_startf("subsample_and_optics") - call subsample_and_optics(ncol,pver,nscol_cosp,nhydro,overlap, & - use_precipitation_fluxes,lidar_ice_type,sd_cs(lchnk),cld(1:ncol,1:pver),& - concld(1:ncol,1:pver),rain_ls_interp(1:ncol,1:pver), & - snow_ls_interp(1:ncol,1:pver),grpl_ls_interp(1:ncol,1:pver), & - rain_cv_interp(1:ncol,1:pver),snow_cv_interp(1:ncol,1:pver), & - mr_lsliq(1:ncol,1:pver),mr_lsice(1:ncol,1:pver), & - mr_ccliq(1:ncol,1:pver),mr_ccice(1:ncol,1:pver), & - reff_cosp(1:ncol,1:pver,:),dtau_c(1:ncol,1:pver), & - dtau_s(1:ncol,1:pver),dem_c(1:ncol,1:pver), & - dem_s(1:ncol,1:pver),dtau_s_snow(1:ncol,1:pver), & - dem_s_snow(1:ncol,1:pver),state%ps(1:ncol),cospstateIN,cospIN) + ! The arrays passed here contain only active columns and the limited vertical + ! domain operated on by COSP. Unsubscripted array arguments have already been + ! allocated to the correct size. Arrays the size of a CAM chunk (pcol,pver) + ! need to pass the correct section (:ncol,ktop:pver). + call subsample_and_optics( & + ncol, nlay, nscol_cosp, nhydro, overlap, & + lidar_ice_type, sd_cs(lchnk), & + cld(:ncol,ktop:pver), concld(:ncol,ktop:pver), & + rain_ls_interp, snow_ls_interp, grpl_ls_interp, rain_cv_interp, & + snow_cv_interp, mr_lsliq, mr_lsice, mr_ccliq, mr_ccice, & + reff_cosp, dtau_c, dtau_s ,dem_c, dem_s, dtau_s_snow, & + dem_s_snow, state%ps(:ncol), cospstateIN, cospIN) call t_stopf("subsample_and_optics") end if @@ -3577,11 +3587,12 @@ end subroutine construct_cospIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE construct_cospstateIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - subroutine construct_cospstateIN(npoints,nlevels,y) + subroutine construct_cospstateIN(npoints,nlevels,nchan,y) ! Inputs integer,intent(in) :: & npoints, & ! Number of horizontal gridpoints - nlevels ! Number of vertical levels + nlevels, & ! Number of vertical levels + nchan ! Number of channels ! Outputs type(cosp_column_inputs),intent(out) :: y @@ -3601,10 +3612,9 @@ subroutine construct_cospstateIN(npoints,nlevels,y) y%land(npoints), & y%skt(npoints), & y%surfelev(nPoints), & - y%emis_sfc(nchan), & + ! y%emis_sfc(nchan), & ! revisit this in COSPv2.0 code. y%u_sfc(npoints), & y%v_sfc(npoints), & - y%seaice(npoints), & y%lat(npoints), & y%lon(nPoints), & y%o3(npoints,nlevels), & @@ -3626,6 +3636,7 @@ subroutine construct_cospstateIN(npoints,nlevels,y) call handle_allocate_error(istat, sub, 'sunlit,..,fl_snow') end subroutine construct_cospstateIN + ! ###################################################################################### ! SUBROUTINE construct_cosp_outputs ! @@ -3790,10 +3801,10 @@ subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,N_rttov_instr if (rttov_configs(i) % Lrttov_refl .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then allocate(x % rttov_outputs(i) % refl_clear(Npoints,rttov_configs(i) % nchan_out)) end if - end if + end if end do else - x % N_rttov_instruments = 0 + x % Ninst_rttov = 0 end if end subroutine construct_cosp_outputs From 2c433f0c159c68627be67d6939e8b55a69aa4b84 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 9 Jul 2025 17:11:57 -0600 Subject: [PATCH 10/24] Change cosp2 git fleximod reference to a stable hash following recommendation from cacraig --- .gitmodules | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/.gitmodules b/.gitmodules index b5835377b1..f29781244c 100644 --- a/.gitmodules +++ b/.gitmodules @@ -97,20 +97,12 @@ fxtag = v8.2.1 fxDONOTUSEurl = https://github.com/MPAS-Dev/MPAS-Model.git -# [submodule "cosp2"] -# path = src/physics/cosp2/src -# url = https://github.com/CFMIP/COSPv2.0 -# fxrequired = AlwaysRequired -# fxsparse = ../.cosp_sparse_checkout -# fxtag = v2.1.4cesm -# fxDONOTUSEurl = https://github.com/CFMIP/COSPv2.0 - [submodule "cosp2"] path = src/physics/cosp2/src url = https://github.com/dustinswales/COSPv2.0 fxrequired = AlwaysRequired fxsparse = ../.cosp_sparse_checkout - fxtag = feature/cosp_rttov_swathing + fxtag = d10be9f # Tag for feature/cosp_rrtov_swathing on 2025/07/09 fxDONOTUSEurl = https://github.com/dustinswales/COSPv2.0 [submodule "clubb"] From 7f3a24c8011fb8bd0fcd6cb64fc71866aaf7685b Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 9 Jul 2025 17:15:51 -0600 Subject: [PATCH 11/24] Missed correction --- src/physics/cam/cospsimulator_intr.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 105fa2abe3..b25d96645d 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -3766,7 +3766,7 @@ subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,N_rttov_instr ! RTTOV - Allocate output for multiple instruments if (lrttov_sim) then - x % N_rttov_instruments = N_rttov_instruments + x % Ninst_rttov = N_rttov_instruments allocate(x % rttov_outputs(N_rttov_instruments)) do i=1,N_rttov_instruments x % rttov_outputs(i) % nchan_out = rttov_configs(i) % nchan_out From 04adadb2919b87b36045f7faac80b9b4024c5865 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 16 Jul 2025 10:18:04 -0600 Subject: [PATCH 12/24] Update cospsimulator_intr.F90 logic to work with new namelist variables. --- src/physics/cam/cospsimulator_intr.F90 | 151 +++++++++++++------------ 1 file changed, 78 insertions(+), 73 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index b25d96645d..7c7920c345 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -263,11 +263,6 @@ module cospsimulator_intr gamma_2 = (/-1._r8, -1._r8, 6.0_r8, 6.0_r8, -1._r8, -1._r8, 6.0_r8, 6.0_r8, 6.0_r8/),& gamma_3 = (/-1._r8, -1._r8, 2.0_r8, 2.0_r8, -1._r8, -1._r8, 2.0_r8, 2.0_r8, 2.0_r8/),& gamma_4 = (/-1._r8, -1._r8, 6.0_r8, 6.0_r8, -1._r8, -1._r8, 6.0_r8, 6.0_r8, 6.0_r8/) - - ! Local variables for orbit swathing - real(r8),dimension(:),allocatable :: & - cosp_localtime, & - cosp_localtime_width ! Swathing DDT array type(swath_inputs),dimension(6) :: & @@ -287,9 +282,13 @@ module cospsimulator_intr bt_total_pc(:,:), & rad_total_pc(:,:) end type rttov_output_write - - character(len=256), dimension(50) :: rttov_instrument_namelists = ' ' ! Input of paths to RTTOV instrument namelists - integer :: rttov_Ninstruments = 0 ! Default is zero + + ! Number of RTTOV instruments to be simulated + integer :: rttov_Ninstruments = 0 ! Default + integer :: cosp_rttov_Ninstruments = 0 ! Namelist default + ! Namelist paths for each RTTOV instrument + character(len=256), dimension(50) :: rttov_instrument_namelists = ' ' ! Default + character(len=256), dimension(50) :: cosp_rttov_instrument_namelists = ' ' ! Namelist default #endif @@ -312,25 +311,25 @@ subroutine cospsimulator_intr_readnl(nlfile) character(len=*), parameter :: subname = 'cospsimulator_intr_readnl' ! Inputs for orbit swathing - integer :: N_SWATHS_ISCCP = 0 ! Number of ISCCP swaths - integer :: N_SWATHS_MISR = 0 ! Number of MISR swaths - integer :: N_SWATHS_MODIS = 0 ! Number of MODIS swaths - integer :: N_SWATHS_PARASOL = 0 ! Number of PARASOL swaths - integer :: N_SWATHS_CSCAL = 0 ! Number of CLOUDSAT+CALIPSO swaths - integer :: N_SWATHS_ATLID = 0 ! Number of ATLID swaths + integer :: COSP_N_SWATHS_ISCCP = 0 ! Number of ISCCP swaths + integer :: COSP_N_SWATHS_MISR = 0 ! Number of MISR swaths + integer :: COSP_N_SWATHS_MODIS = 0 ! Number of MODIS swaths + integer :: COSP_N_SWATHS_PARASOL = 0 ! Number of PARASOL swaths + integer :: COSP_N_SWATHS_CSCAL = 0 ! Number of CLOUDSAT+CALIPSO swaths + integer :: COSP_N_SWATHS_ATLID = 0 ! Number of ATLID swaths real(r8),dimension(10),target :: & ! Arbitrary limit of 10 swaths seems reasonable. - SWATH_LOCALTIMES_ISCCP, & ! Local time of ISCCP satellite overpasses (hrs GMT) - SWATH_LOCALTIMES_MISR, & ! Local time of MISR satellite overpasses (hrs GMT) - SWATH_LOCALTIMES_MODIS, & ! Local time of MODIS satellite overpasses (hrs GMT) - SWATH_LOCALTIMES_PARASOL, & ! Local time of PARASOL satellite overpasses (hrs GMT) - SWATH_LOCALTIMES_CSCAL, & ! Local time of CLOUDSAT+CALIPSO satellite overpasses (hrs GMT) - SWATH_LOCALTIMES_ATLID, & ! Local time of ATLID satellite overpasses (hrs GMT) - SWATH_WIDTHS_ISCCP, & ! Width in km of ISCCP satellite overpasses - SWATH_WIDTHS_MISR, & ! Width in km of MISR satellite overpasses - SWATH_WIDTHS_MODIS, & ! Width in km of MODIS satellite overpasses - SWATH_WIDTHS_PARASOL, & ! Width in km of PARASOL satellite overpasses - SWATH_WIDTHS_CSCAL, & ! Width in km of CLOUDSAT+CALIPSO satellite overpasses - SWATH_WIDTHS_ATLID ! Width in km of ATLID satellite overpasses + COSP_SWATH_LOCALTIMES_ISCCP, & ! Local time of ISCCP satellite overpasses (hrs GMT) + COSP_SWATH_LOCALTIMES_MISR, & ! Local time of MISR satellite overpasses (hrs GMT) + COSP_SWATH_LOCALTIMES_MODIS, & ! Local time of MODIS satellite overpasses (hrs GMT) + COSP_SWATH_LOCALTIMES_PARASOL, & ! Local time of PARASOL satellite overpasses (hrs GMT) + COSP_SWATH_LOCALTIMES_CSCAL, & ! Local time of CLOUDSAT+CALIPSO satellite overpasses (hrs GMT) + COSP_SWATH_LOCALTIMES_ATLID, & ! Local time of ATLID satellite overpasses (hrs GMT) + COSP_SWATH_WIDTHS_ISCCP, & ! Width in km of ISCCP satellite overpasses + COSP_SWATH_WIDTHS_MISR, & ! Width in km of MISR satellite overpasses + COSP_SWATH_WIDTHS_MODIS, & ! Width in km of MODIS satellite overpasses + COSP_SWATH_WIDTHS_PARASOL, & ! Width in km of PARASOL satellite overpasses + COSP_SWATH_WIDTHS_CSCAL, & ! Width in km of CLOUDSAT+CALIPSO satellite overpasses + COSP_SWATH_WIDTHS_ATLID ! Width in km of ATLID satellite overpasses #ifdef USE_COSP !!! this list should include any variable that you might want to include in the namelist @@ -339,12 +338,12 @@ subroutine cospsimulator_intr_readnl(nlfile) cosp_histfile_num, cosp_histfile_aux, cosp_histfile_aux_num, cosp_isccp, cosp_lfrac_out, & cosp_lite, cosp_lradar_sim, cosp_llidar_sim, cosp_lisccp_sim, cosp_lmisr_sim, cosp_lmodis_sim, cosp_lrttov_sim, & cosp_ncolumns, cosp_nradsteps, cosp_passive, cosp_runall, & - rttov_Ninstruments, rttov_instrument_namelists, & - N_SWATHS_ISCCP, SWATH_LOCALTIMES_ISCCP, SWATH_WIDTHS_ISCCP, N_SWATHS_MISR, & - SWATH_LOCALTIMES_MISR, SWATH_WIDTHS_MISR, N_SWATHS_MODIS, SWATH_LOCALTIMES_MODIS, & - SWATH_WIDTHS_MODIS, N_SWATHS_PARASOL, SWATH_LOCALTIMES_PARASOL, & - SWATH_WIDTHS_PARASOL, N_SWATHS_CSCAL, SWATH_LOCALTIMES_CSCAL, & - SWATH_WIDTHS_CSCAL, N_SWATHS_ATLID, SWATH_LOCALTIMES_ATLID, SWATH_WIDTHS_ATLID + cosp_rttov_Ninstruments, cosp_rttov_instrument_namelists, & + COSP_N_SWATHS_ISCCP, COSP_SWATH_LOCALTIMES_ISCCP, COSP_SWATH_WIDTHS_ISCCP, COSP_N_SWATHS_MISR, & + COSP_SWATH_LOCALTIMES_MISR, COSP_SWATH_WIDTHS_MISR, COSP_N_SWATHS_MODIS, COSP_SWATH_LOCALTIMES_MODIS, & + COSP_SWATH_WIDTHS_MODIS, COSP_N_SWATHS_PARASOL, COSP_SWATH_LOCALTIMES_PARASOL, & + COSP_SWATH_WIDTHS_PARASOL, COSP_N_SWATHS_CSCAL, COSP_SWATH_LOCALTIMES_CSCAL, & + COSP_SWATH_WIDTHS_CSCAL, COSP_N_SWATHS_ATLID, COSP_SWATH_LOCALTIMES_ATLID, COSP_SWATH_WIDTHS_ATLID !! read in the namelist if (masterproc) then @@ -363,24 +362,24 @@ subroutine cospsimulator_intr_readnl(nlfile) ! Indexing order for "cospIN % cospswathsIN" is ISCCP, MISR, CLOUDSAT-CALIPSO, ATLID, PARASOL, MODIS if (masterproc) then - cospswathsIN(1)%N_inst_swaths = N_SWATHS_ISCCP - cospswathsIN(1)%inst_localtimes(1:N_SWATHS_ISCCP) = SWATH_LOCALTIMES_ISCCP - cospswathsIN(1)%inst_localtime_widths(1:N_SWATHS_ISCCP) = SWATH_WIDTHS_ISCCP - cospswathsIN(2)%N_inst_swaths = N_SWATHS_MISR - cospswathsIN(2)%inst_localtimes(1:N_SWATHS_MISR) = SWATH_LOCALTIMES_MISR - cospswathsIN(2)%inst_localtime_widths(1:N_SWATHS_MISR) = SWATH_WIDTHS_MISR - cospswathsIN(3)%N_inst_swaths = N_SWATHS_CSCAL - cospswathsIN(3)%inst_localtimes(1:N_SWATHS_CSCAL) = SWATH_LOCALTIMES_CSCAL - cospswathsIN(3)%inst_localtime_widths(1:N_SWATHS_CSCAL) = SWATH_WIDTHS_CSCAL - cospswathsIN(4)%N_inst_swaths = N_SWATHS_ATLID - cospswathsIN(4)%inst_localtimes(1:N_SWATHS_ATLID) = SWATH_LOCALTIMES_ATLID - cospswathsIN(4)%inst_localtime_widths(1:N_SWATHS_ATLID) = SWATH_WIDTHS_ATLID - cospswathsIN(5)%N_inst_swaths = N_SWATHS_PARASOL - cospswathsIN(5)%inst_localtimes(1:N_SWATHS_PARASOL) = SWATH_LOCALTIMES_PARASOL - cospswathsIN(5)%inst_localtime_widths(1:N_SWATHS_PARASOL) = SWATH_WIDTHS_PARASOL - cospswathsIN(6)%N_inst_swaths = N_SWATHS_MODIS - cospswathsIN(6)%inst_localtime_widths(1:N_SWATHS_MODIS) = SWATH_WIDTHS_MODIS - cospswathsIN(6)%inst_localtimes(1:N_SWATHS_MODIS) = SWATH_LOCALTIMES_MODIS + cospswathsIN(1)%N_inst_swaths = COSP_N_SWATHS_ISCCP + cospswathsIN(1)%inst_localtimes(1:COSP_N_SWATHS_ISCCP) = COSP_SWATH_LOCALTIMES_ISCCP + cospswathsIN(1)%inst_localtime_widths(1:COSP_N_SWATHS_ISCCP) = COSP_SWATH_WIDTHS_ISCCP + cospswathsIN(2)%N_inst_swaths = COSP_N_SWATHS_MISR + cospswathsIN(2)%inst_localtimes(1:COSP_N_SWATHS_MISR) = COSP_SWATH_LOCALTIMES_MISR + cospswathsIN(2)%inst_localtime_widths(1:COSP_N_SWATHS_MISR) = COSP_SWATH_WIDTHS_MISR + cospswathsIN(3)%N_inst_swaths = COSP_N_SWATHS_CSCAL + cospswathsIN(3)%inst_localtimes(1:COSP_N_SWATHS_CSCAL) = COSP_SWATH_LOCALTIMES_CSCAL + cospswathsIN(3)%inst_localtime_widths(1:COSP_N_SWATHS_CSCAL) = COSP_SWATH_WIDTHS_CSCAL + cospswathsIN(4)%N_inst_swaths = COSP_N_SWATHS_ATLID + cospswathsIN(4)%inst_localtimes(1:COSP_N_SWATHS_ATLID) = COSP_SWATH_LOCALTIMES_ATLID + cospswathsIN(4)%inst_localtime_widths(1:COSP_N_SWATHS_ATLID) = COSP_SWATH_WIDTHS_ATLID + cospswathsIN(5)%N_inst_swaths = COSP_N_SWATHS_PARASOL + cospswathsIN(5)%inst_localtimes(1:COSP_N_SWATHS_PARASOL) = COSP_SWATH_LOCALTIMES_PARASOL + cospswathsIN(5)%inst_localtime_widths(1:COSP_N_SWATHS_PARASOL) = COSP_SWATH_WIDTHS_PARASOL + cospswathsIN(6)%N_inst_swaths = COSP_N_SWATHS_MODIS + cospswathsIN(6)%inst_localtime_widths(1:COSP_N_SWATHS_MODIS) = COSP_SWATH_WIDTHS_MODIS + cospswathsIN(6)%inst_localtimes(1:COSP_N_SWATHS_MODIS) = COSP_SWATH_LOCALTIMES_MODIS end if #ifdef SPMD @@ -404,8 +403,8 @@ subroutine cospsimulator_intr_readnl(nlfile) call mpibcast(cosp_histfile_aux_num,1, mpiint, 0, mpicom) call mpibcast(cosp_histfile_aux, 1, mpilog, 0, mpicom) call mpibcast(cosp_nradsteps, 1, mpiint, 0, mpicom) - call mpibcast(rttov_Ninstruments, 1, mpiint, 0, mpicom) - call mpibcast(rttov_instrument_namelists, len(rttov_instrument_namelists(1))*50, mpichar, 0, mpicom) + call mpibcast(cosp_rttov_Ninstruments, 1, mpiint, 0, mpicom) + call mpibcast(cosp_rttov_instrument_namelists, len(cosp_rttov_instrument_namelists(1))*50, mpichar, 0, mpicom) do i=1,6 ! Broadcast swathing variables. call mpibcast(cospswathsIN(i)%N_inst_swaths, 1, mpiint, 0, mpicom) @@ -434,7 +433,7 @@ subroutine cospsimulator_intr_readnl(nlfile) if (cosp_lmodis_sim) then lmodis_sim = .true. end if - if ((rttov_Ninstruments > 0) .and. cosp_lrttov_sim) then + if ((cosp_rttov_Ninstruments > 0) .and. cosp_lrttov_sim) then lrttov_sim = .true. end if @@ -503,6 +502,10 @@ subroutine cospsimulator_intr_readnl(nlfile) ! Set number of sub-columns, from namelist ncolumns = cosp_ncolumns nscol_cosp = cosp_ncolumns + + ! Set RTTOV instruments and namelists paths, from cosp namelist + rttov_Ninstruments = cosp_rttov_Ninstruments + rttov_instrument_namelists = cosp_rttov_instrument_namelists if (masterproc) then if (docosp) then @@ -521,30 +524,32 @@ subroutine cospsimulator_intr_readnl(nlfile) write(iulog,*)' Write COSP input fields to history file = ', cosp_histfile_aux_num write(iulog,*)' Write COSP subcolumn fields = ', lfrac_out - write(iulog,*)' N_SWATHS_ISCCP = ', N_SWATHS_ISCCP - write(iulog,*)' SWATH_LOCALTIMES_ISCCP = ', SWATH_LOCALTIMES_ISCCP - write(iulog,*)' SWATH_WIDTHS_ISCCP = ', SWATH_WIDTHS_ISCCP + write(iulog,*)' COSP_N_SWATHS_ISCCP = ', COSP_N_SWATHS_ISCCP + write(iulog,*)' COSP_SWATH_LOCALTIMES_ISCCP = ', COSP_SWATH_LOCALTIMES_ISCCP + write(iulog,*)' COSP_SWATH_WIDTHS_ISCCP = ', COSP_SWATH_WIDTHS_ISCCP - write(iulog,*)' N_SWATHS_MISR = ', N_SWATHS_MISR - write(iulog,*)' SWATH_LOCALTIMES_MISR = ', SWATH_LOCALTIMES_MISR - write(iulog,*)' SWATH_WIDTHS_MISR = ', SWATH_WIDTHS_MISR + write(iulog,*)' COSP_N_SWATHS_MISR = ', COSP_N_SWATHS_MISR + write(iulog,*)' COSP_SWATH_LOCALTIMES_MISR = ', COSP_SWATH_LOCALTIMES_MISR + write(iulog,*)' COSP_SWATH_WIDTHS_MISR = ', COSP_SWATH_WIDTHS_MISR - write(iulog,*)' N_SWATHS_CSCAL = ', N_SWATHS_CSCAL - write(iulog,*)' SWATH_LOCALTIMES_CSCAL = ', SWATH_LOCALTIMES_CSCAL - write(iulog,*)' SWATH_WIDTHS_CSCAL = ', SWATH_WIDTHS_CSCAL + write(iulog,*)' COSP_N_SWATHS_CSCAL = ', COSP_N_SWATHS_CSCAL + write(iulog,*)' COSP_SWATH_LOCALTIMES_CSCAL = ', COSP_SWATH_LOCALTIMES_CSCAL + write(iulog,*)' COSP_SWATH_WIDTHS_CSCAL = ', COSP_SWATH_WIDTHS_CSCAL - write(iulog,*)' N_SWATHS_MODIS = ', N_SWATHS_MODIS - write(iulog,*)' SWATH_LOCALTIMES_MODIS = ', SWATH_LOCALTIMES_MODIS - write(iulog,*)' SWATH_WIDTHS_MODIS = ', SWATH_WIDTHS_MODIS + write(iulog,*)' COSP_N_SWATHS_MODIS = ', COSP_N_SWATHS_MODIS + write(iulog,*)' COSP_SWATH_LOCALTIMES_MODIS = ', COSP_SWATH_LOCALTIMES_MODIS + write(iulog,*)' COSP_SWATH_WIDTHS_MODIS = ', COSP_SWATH_WIDTHS_MODIS - write(iulog,*)' N_SWATHS_PARASOL = ', N_SWATHS_PARASOL - write(iulog,*)' SWATH_LOCALTIMES_PARASOL = ', SWATH_LOCALTIMES_PARASOL - write(iulog,*)' SWATH_WIDTHS_PARASOL = ', SWATH_WIDTHS_PARASOL + write(iulog,*)' COSP_N_SWATHS_PARASOL = ', COSP_N_SWATHS_PARASOL + write(iulog,*)' COSP_SWATH_LOCALTIMES_PARASOL = ', COSP_SWATH_LOCALTIMES_PARASOL + write(iulog,*)' COSP_SWATH_WIDTHS_PARASOL = ', COSP_SWATH_WIDTHS_PARASOL - write(iulog,*)' N_SWATHS_ATLID = ', N_SWATHS_ATLID - write(iulog,*)' SWATH_LOCALTIMES_ATLID = ', SWATH_LOCALTIMES_ATLID - write(iulog,*)' SWATH_WIDTHS_ATLID = ', SWATH_WIDTHS_ATLID + write(iulog,*)' COSP_N_SWATHS_ATLID = ', COSP_N_SWATHS_ATLID + write(iulog,*)' COSP_SWATH_LOCALTIMES_ATLID = ', COSP_SWATH_LOCALTIMES_ATLID + write(iulog,*)' COSP_SWATH_WIDTHS_ATLID = ', COSP_SWATH_WIDTHS_ATLID + write(iulog,*)' Number of RTTOV instruments = ', rttov_Ninstruments + write(iulog,*)' RTTOV instrument namelists = ', rttov_instrument_namelists else write(iulog,*)'COSP not enabled' end if @@ -2215,7 +2220,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! Model state call t_startf("construct_cospstateIN") - call construct_cospstateIN(ncol, nlay, 0, cospstateIN) + call construct_cospstateIN(ncol, nlay, 0, cospstateIN) ! convert to degrees. Lat in range [-90,..,90], Lon in range [0,..,360] cospstateIN%lat = state%lat(:ncol)*rad2deg @@ -4135,7 +4140,7 @@ subroutine destroy_cosp_outputs(y) ! RTTOV multi-instrument if (allocated(y%rttov_outputs)) then - do i=1,y % N_rttov_instruments ! Iterate over each instrument + do i=1,y % Ninst_rttov ! Iterate over each instrument if (associated(y%rttov_outputs(i)%channel_indices)) then deallocate(y%rttov_outputs(i)%channel_indices) nullify(y%rttov_outputs(i)%channel_indices) From aeb8df33bfd51e60ff6db62c3ee405189828a66c Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 16 Jul 2025 10:21:46 -0600 Subject: [PATCH 13/24] Correct allocation and assignment of cospstateIN%hgt_matrix_half. Per cosp.F90 this array should be: "Height of bottom interface of atm layer(km). First level contains the bottom of the top layer. Last level contains the bottom of the surface layer." Current CAM interface includes the top of the top layer and needs to be corrected. --- src/physics/cam/cospsimulator_intr.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 7c7920c345..8c86a89349 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -2243,7 +2243,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & cospstateIN%pfull = state%pmid(:ncol,ktop:pver) cospstateIN%phalf = state%pint(:ncol,ktop:pverp) cospstateIN%hgt_matrix = zmid - cospstateIN%hgt_matrix_half = zint + cospstateIN%hgt_matrix_half = zint(1:ncol,2:nlayp) ! COSP wants half levels without model top cospstateIN%surfelev = surf_hgt cospstateIN%rttov_sfcmask = rttov_sfcmask(1:ncol) @@ -3613,7 +3613,7 @@ subroutine construct_cospstateIN(npoints,nlevels,nchan,y) y%phalf(npoints,nlevels+1), & y%qv(npoints,nlevels), & y%hgt_matrix(npoints,nlevels), & - y%hgt_matrix_half(npoints,nlevels+1), & + y%hgt_matrix_half(npoints,nlevels), & y%land(npoints), & y%skt(npoints), & y%surfelev(nPoints), & From 496a7ec4b6431cfade3e5254e799c3e3c8aac022 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 16 Jul 2025 10:32:55 -0600 Subject: [PATCH 14/24] Clean up print statement --- src/physics/cam/cospsimulator_intr.F90 | 16 +--------------- 1 file changed, 1 insertion(+), 15 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 8c86a89349..ac5d4c8e1c 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -1098,14 +1098,7 @@ subroutine cospsimulator_intr_init() end if end do end if - - if (masterproc) then - if (docosp) then - write(iulog,*)'Finished RTTOV section in cospsimulator_intr_init' - write(iulog,*)'lrttov_sim: ', lrttov_sim - end if - end if - + !! ADDFLD, ADD_DEFAULT, OUTFLD CALLS FOR COSP OUTPUTS IF RUNNING COSP OFF-LINE if (cosp_histfile_aux) then call addfld ('PS_COSP', horiz_only, 'I','Pa', & @@ -2285,13 +2278,6 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & call construct_cospIN(ncol, nscol_cosp, nlay, rttov_Ninstruments, cospIN, emis_grey=1.0_r8) ! Apply unitary blackbody surface emissivity to be consistent with CESM physics cospIN%emsfc_lw = emsfc_lw if (lradar_sim) cospIN%rcfg_cloudsat = rcfg_cs(lchnk) - - if (masterproc) then - if (docosp) then - write(iulog,*)'after construct_cospIN' - end if - end if - if (lrttov_sim) cospIN%cfg_rttov => rttov_configs cospIN%cospswathsIN = cospswathsIN From d2adfccb845caf03c9966ddae18d70233af7d212 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 16 Jul 2025 15:17:14 -0600 Subject: [PATCH 15/24] At logic to masking that allows for swaths to work correctly. --- src/physics/cam/cospsimulator_intr.F90 | 81 +++++++++++++++----------- 1 file changed, 47 insertions(+), 34 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index ac5d4c8e1c..f9b40f8f30 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -2749,45 +2749,56 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & call outfld('CLDLOW_CAL_ICE',cldlow_cal_ice, pcols,lchnk) call outfld('CLDLOW_CAL_LIQ',cldlow_cal_liq, pcols,lchnk) call outfld('CLDLOW_CAL_UN', cldlow_cal_un, pcols,lchnk) !+1.4 - where (cld_cal(:ncol,:nht_cosp) == R_UNDEF) - !! setting missing values to 0 (clear air). - !! I'm not sure why COSP produces a mix of R_UNDEF and realvalue in the nht_cosp dimension. - cld_cal(:ncol,:nht_cosp) = 0.0_r8 - end where + if (cospIN%cospswathsIN(3)%N_inst_swaths < 1) then + where (cld_cal(:ncol,:nht_cosp) == R_UNDEF) + !! setting missing values to 0 (clear air). + !! I'm not sure why COSP produces a mix of R_UNDEF and realvalue in the nht_cosp dimension. + cld_cal(:ncol,:nht_cosp) = 0.0_r8 + end where + end if call outfld('CLD_CAL', cld_cal, pcols,lchnk) !! fails check_accum if 'A' call outfld('MOL532_CAL', mol532_cal, pcols,lchnk) - where (cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) == R_UNDEF) - !! fails check_accum if this is set... with ht_cosp set relative to sea level, mix of R_UNDEF and realvalue - !! cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) = R_UNDEF - cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) = 0.0_r8 - end where + if (cospIN%cospswathsIN(3)%N_inst_swaths < 1) then + where (cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) == R_UNDEF) + !! fails check_accum if this is set... with ht_cosp set relative to sea level, mix of R_UNDEF and realvalue + !! cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) = R_UNDEF + cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) = 0.0_r8 + end where + end if call outfld('CFAD_SR532_CAL',cfad_sr532_cal ,pcols,lchnk) - - where (refl_parasol(:ncol,:nsza_cosp) == R_UNDEF) - !! setting missing values to 0 (clear air). - refl_parasol(:ncol,:nsza_cosp) = 0 - end where + if (cospIN%cospswathsIN(5)%N_inst_swaths < 1) then + where (refl_parasol(:ncol,:nsza_cosp) == R_UNDEF) + !! setting missing values to 0 (clear air). + refl_parasol(:ncol,:nsza_cosp) = 0 + end where + end if call outfld('RFL_PARASOL',refl_parasol ,pcols,lchnk) !! - where (cld_cal_liq(:ncol,:nht_cosp) == R_UNDEF) !+cosp1.4 - !! setting missing values to 0 (clear air), likely below sea level - cld_cal_liq(:ncol,:nht_cosp) = 0.0_r8 - end where + if (cospIN%cospswathsIN(3)%N_inst_swaths < 1) then + where (cld_cal_liq(:ncol,:nht_cosp) == R_UNDEF) !+cosp1.4 + !! setting missing values to 0 (clear air), likely below sea level + cld_cal_liq(:ncol,:nht_cosp) = 0.0_r8 + end where + end if call outfld('CLD_CAL_LIQ',cld_cal_liq ,pcols,lchnk) !! - where (cld_cal_ice(:ncol,:nht_cosp) == R_UNDEF) - !! setting missing values to 0 (clear air), likely below sea level - cld_cal_ice(:ncol,:nht_cosp) = 0.0_r8 - end where + if (cospIN%cospswathsIN(3)%N_inst_swaths < 1) then + where (cld_cal_ice(:ncol,:nht_cosp) == R_UNDEF) + !! setting missing values to 0 (clear air), likely below sea level + cld_cal_ice(:ncol,:nht_cosp) = 0.0_r8 + end where + end if call outfld('CLD_CAL_ICE',cld_cal_ice ,pcols,lchnk) !! - where (cld_cal_un(:ncol,:nht_cosp) == R_UNDEF) - !! setting missing values to 0 (clear air), likely below sea level - cld_cal_un(:ncol,:nht_cosp) = 0.0_r8 - end where - call outfld('CLD_CAL_UN',cld_cal_un ,pcols,lchnk) !! - + if (cospIN%cospswathsIN(3)%N_inst_swaths < 1) then + where (cld_cal_un(:ncol,:nht_cosp) == R_UNDEF) + !! setting missing values to 0 (clear air), likely below sea level + cld_cal_un(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLD_CAL_UN',cld_cal_un ,pcols,lchnk) !! + end if + where (cld_cal_tmp(:ncol,:nht_cosp) == R_UNDEF) !! setting missing values to 0 (clear air), likely below sea level cld_cal_tmp(:ncol,:nht_cosp) = 0.0_r8 @@ -2852,11 +2863,13 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! RADAR SIMULATOR OUTPUTS if (lradar_sim) then - where (cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) == R_UNDEF) - !! fails check_accum if this is set... with ht_cosp set relative to sea level, mix of R_UNDEF and realvalue - ! cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) = R_UNDEF - cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) = 0.0_r8 - end where + if (cospIN%cospswathsIN(3)%N_inst_swaths < 1) then + where (cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) == R_UNDEF) + !! fails check_accum if this is set... with ht_cosp set relative to sea level, mix of R_UNDEF and realvalue + ! cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) = R_UNDEF + cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) = 0.0_r8 + end where + end if call outfld('CFAD_DBZE94_CS',cfad_dbze94_cs, pcols, lchnk) call outfld('CLDTOT_CALCS', cldtot_calcs, pcols, lchnk) call outfld('CLDTOT_CS', cldtot_cs, pcols, lchnk) From a318f504cf59f08dbdfb5096c45b349be1bcd644 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 16 Jul 2025 15:17:18 -0600 Subject: [PATCH 16/24] Revert "Clean up print statement" This reverts commit 496a7ec4b6431cfade3e5254e799c3e3c8aac022. This was a mistake too, I meant to revert the commit that merged recent CAM updates. --- src/physics/cam/cospsimulator_intr.F90 | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index f9b40f8f30..13933a8382 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -1098,7 +1098,14 @@ subroutine cospsimulator_intr_init() end if end do end if - + + if (masterproc) then + if (docosp) then + write(iulog,*)'Finished RTTOV section in cospsimulator_intr_init' + write(iulog,*)'lrttov_sim: ', lrttov_sim + end if + end if + !! ADDFLD, ADD_DEFAULT, OUTFLD CALLS FOR COSP OUTPUTS IF RUNNING COSP OFF-LINE if (cosp_histfile_aux) then call addfld ('PS_COSP', horiz_only, 'I','Pa', & @@ -2278,6 +2285,13 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & call construct_cospIN(ncol, nscol_cosp, nlay, rttov_Ninstruments, cospIN, emis_grey=1.0_r8) ! Apply unitary blackbody surface emissivity to be consistent with CESM physics cospIN%emsfc_lw = emsfc_lw if (lradar_sim) cospIN%rcfg_cloudsat = rcfg_cs(lchnk) + + if (masterproc) then + if (docosp) then + write(iulog,*)'after construct_cospIN' + end if + end if + if (lrttov_sim) cospIN%cfg_rttov => rttov_configs cospIN%cospswathsIN = cospswathsIN From 4287774228b5c47a6bcfdc8b6fba0b524cff6ece Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 16 Jul 2025 15:20:03 -0600 Subject: [PATCH 17/24] Revert "Merge pull request #1343 from jimmielin/hplin/vdiff_answer_change" This reverts commit 9b98aacbfb22edac5cf46e610336e65905fb270d, reversing changes made to 9ccd34221dd6e65e0dfae594c27bf3c9ecc9a8de. --- cime | 2 +- components/cice | 2 +- doc/ChangeLog | 111 --------------------------- libraries/FMS | 2 +- src/atmos_phys | 2 +- src/physics/cam/diffusion_solver.F90 | 8 +- tools/CUPiD | 2 +- 7 files changed, 9 insertions(+), 120 deletions(-) diff --git a/cime b/cime index 1006c39f59..38bf614c60 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit 1006c39f59577d47994fb3fb897566b2b8fa12ed +Subproject commit 38bf614c60645ae5c87a948750036faf4bba26d0 diff --git a/components/cice b/components/cice index 48737cc126..e51ab1d3f1 160000 --- a/components/cice +++ b/components/cice @@ -1 +1 @@ -Subproject commit 48737cc126b3a9ea9839746a4fc1e4a17aeddb93 +Subproject commit e51ab1d3f12ae2959b7df978f77dc5a1ee0181d3 diff --git a/doc/ChangeLog b/doc/ChangeLog index 2acb2b065b..bd25a52b28 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,116 +1,5 @@ =============================================================== -Tag name: cam6_4_104 -Originator(s): jimmielin -Date: Jul 14, 2025 -One-line Summary: Reorder tautms/taublj add terms for future vertical diffusion refactoring -Github PR URL: https://github.com/ESCOMP/CAM/pull/1343 - -Purpose of changes (include the issue number and title text for each relevant GitHub issue): - - reorders terms for summation of taublj and tautms to be at the end of taures instead of in the middle to facilitate future decoupling of the TMS and Beljaars code from the diffusion solver (part of #1314; part of #1205) - - update git submodule hashes to be consistent with .gitmodules fxTag to pass GitHub action test - -Describe any changes made to build system: N/A - -Describe any changes made to the namelist: N/A - -List any changes to the defaults for the boundary datasets: N/A - -Describe any substantial timing or memory changes: N/A - -Code reviewed by: cacraig - -List all files eliminated: N/A - -List all files added and what they do: N/A - -List all existing files that have been modified, and describe the changes: -M src/physics/cam/diffusion_solver.F90 - - reorder terms for vertical diffusion surface stresses. - -M cime -M components/cice -M libraries/FMS -M src/atmos_phys -M tools/CUPiD - - checkout git submodules corresponding to .gitmodules file for consistency - (no externals are updated -- only makes submodule hashes in repository consistent with .gitmodules file) - -If there were any failures reported from running test_driver.sh on any test -platform, and checkin with these failures has been OK'd by the gatekeeper, -then copy the lines from the td.*.status files for the failed tests to the -appropriate machine below. All failed tests must be justified. - -derecho/intel/aux_cam: - ERC_D_Ln9.f09_f09_mt232.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - ERC_D_Ln9.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: - ERC_D_Ln9.mpasa120_mpasa120.FHISTC_LTso.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: - ERC_D_Ln9.ne30pg3_ne30pg3_mt232.FHISTC_LTso.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - ERP_Ld3.ne16pg3_ne16pg3_mg17.FHISTC_WAt1ma.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: - ERP_Ld3.ne30pg3_ne30pg3_mt232.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (Overall: DIFF) details: - ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: - ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - ERP_Ln9.ne30pg3_ne30pg3_mg17.FHISTC_WAma.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - ERS_Ln9.ne30pg3_ne30pg3_mg17.FHISTC_WXma.derecho_intel.cam-outfrq9s_ctem (Overall: DIFF) details: - SMS_C2_D_Ln9.ne16pg3_ne16pg3_mg17.FHISTC_WXma.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: - SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: - SMS_D_Ln9.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - SMS_D_Ln9.ne30pg3_ne30pg3_mt232.FHISTC_MTso.derecho_intel.cam-outfrq9s (Overall: DIFF) details: - SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mt232.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) details: - SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: - SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: - SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: - SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: - SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: - SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: - SMS_Ln9.f19_f19_mg17.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: - SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: - - new answers due to changes in order where Beljaars/TMS added to residual surface stress. - - SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: - - pre-existing failure due to build-namelist error requiring CLM/CTSM external update. - -derecho/nvhpc/aux_cam: - ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: DIFF) details: - - new answers due to changes in order where Beljaars/TMS added to residual surface stress. - -izumi/nag/aux_cam: - ERC_D_Ln9.f10_f10_mt232.FHIST.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: - ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHISTC_LTso.izumi_nag.cam-cosp_rad_diags (Overall: DIFF) details: - ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHISTC_LTso.izumi_nag.cam-outfrq9s_nochem (Overall: DIFF) details: - SMS_D_Ln9.f10_f10_mt232.F1850.izumi_nag.cam-outfrq9s (Overall: DIFF) details: - - new answers due to changes in order where Beljaars/TMS added to residual surface stress. - -izumi/gnu/aux_cam: - ERC_D_Ln9.f19_f19_mt232.FHIST.izumi_gnu.cam-lonlat_fv_diags (Overall: DIFF) details: - ERC_D_Ln9.mpasa480_mpasa480_mt232.FHISTC_LTso.izumi_gnu.cam-outfrq9s_mpasa480 (Overall: DIFF) details: - ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHIST.izumi_gnu.cam-nochem_clubbmf (Overall: DIFF) details: - ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 (Overall: DIFF) details: - - new answers due to changes in order where Beljaars/TMS added to residual surface stress. - - -CAM tag used for the baseline comparison tests if different than previous -tag: - -Summarize any changes to answers: -Answer changes for all configurations using diffusion solver and Beljaars -or- TMS, -due to change in order of operations in computing residual surface stress. -Not all compsets change. CAM4 compsets are unaffected because they do not have orographic drag, -so the change in adding zeros will not affect answers. "Q"/aquaplanet compsets did not see -answer changes. - - -=============================================================== - - Tag name: cam6_4_103 Originator(s): fvitt Date: 11 Jul 2025 diff --git a/libraries/FMS b/libraries/FMS index 99a1d4f46a..1aa662acd0 160000 --- a/libraries/FMS +++ b/libraries/FMS @@ -1 +1 @@ -Subproject commit 99a1d4f46a0e4586c51e8a2f68eb905201b128ff +Subproject commit 1aa662acd094b53d157973782dd442f46e30ee48 diff --git a/src/atmos_phys b/src/atmos_phys index fb56446930..4589f434a3 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit fb564469305ae9718f5ceebf85ccf478ff821331 +Subproject commit 4589f434a31e031e665d0d73b379ffb72cd81659 diff --git a/src/physics/cam/diffusion_solver.F90 b/src/physics/cam/diffusion_solver.F90 index 06d4f20236..2a715596ea 100644 --- a/src/physics/cam/diffusion_solver.F90 +++ b/src/physics/cam/diffusion_solver.F90 @@ -631,14 +631,14 @@ end function vd_lu_qdecomp ! the sum of 'taux(i) - ksrftms(i)*u(i,pver) + tauresx(i)'. if( itaures .eq. 1 ) then - tauresx(i) = taux(i) + tauresx(i) - tauimpx(i) + tautmsx(i) + taubljx(i) - tauresy(i) = tauy(i) + tauresy(i) - tauimpy(i) + tautmsy(i) + taubljy(i) + tauresx(i) = taux(i) + tautmsx(i) + taubljx(i) + tauresx(i)- tauimpx(i) + tauresy(i) = tauy(i) + tautmsy(i) + taubljy(i) + tauresy(i)- tauimpy(i) endif else - tautotx(i) = taux(i) + tautmsx(i) - tautoty(i) = tauy(i) + tautmsy(i) + tautotx(i) = tautmsx(i) + taux(i) + tautoty(i) = tautmsy(i) + tauy(i) tauresx(i) = 0._r8 tauresy(i) = 0._r8 diff --git a/tools/CUPiD b/tools/CUPiD index e3d16bf491..18c0e37022 160000 --- a/tools/CUPiD +++ b/tools/CUPiD @@ -1 +1 @@ -Subproject commit e3d16bf49184cd6dbb18c17072031b974605c8e5 +Subproject commit 18c0e370222070ae6b9bc061d3d404b115fdc1d3 From 8b021fb2f5e65dd279bfada0f564c07fe3d4d89a Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 16 Jul 2025 15:22:51 -0600 Subject: [PATCH 18/24] Revert changes for comparison of swathed fields. --- cime | 2 +- components/cice | 2 +- libraries/FMS | 2 +- src/atmos_phys | 2 +- src/physics/cosp2/src | 2 +- tools/CUPiD | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/cime b/cime index 38bf614c60..1006c39f59 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit 38bf614c60645ae5c87a948750036faf4bba26d0 +Subproject commit 1006c39f59577d47994fb3fb897566b2b8fa12ed diff --git a/components/cice b/components/cice index e51ab1d3f1..48737cc126 160000 --- a/components/cice +++ b/components/cice @@ -1 +1 @@ -Subproject commit e51ab1d3f12ae2959b7df978f77dc5a1ee0181d3 +Subproject commit 48737cc126b3a9ea9839746a4fc1e4a17aeddb93 diff --git a/libraries/FMS b/libraries/FMS index 1aa662acd0..99a1d4f46a 160000 --- a/libraries/FMS +++ b/libraries/FMS @@ -1 +1 @@ -Subproject commit 1aa662acd094b53d157973782dd442f46e30ee48 +Subproject commit 99a1d4f46a0e4586c51e8a2f68eb905201b128ff diff --git a/src/atmos_phys b/src/atmos_phys index 4589f434a3..fb56446930 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit 4589f434a31e031e665d0d73b379ffb72cd81659 +Subproject commit fb564469305ae9718f5ceebf85ccf478ff821331 diff --git a/src/physics/cosp2/src b/src/physics/cosp2/src index 34d8eef3d2..e2afae92fa 160000 --- a/src/physics/cosp2/src +++ b/src/physics/cosp2/src @@ -1 +1 @@ -Subproject commit 34d8eef3d231a87c0f73e565f6b5d548876b294a +Subproject commit e2afae92fa130594ab3532e8b4bc7dcac22ca2a2 diff --git a/tools/CUPiD b/tools/CUPiD index 18c0e37022..e3d16bf491 160000 --- a/tools/CUPiD +++ b/tools/CUPiD @@ -1 +1 @@ -Subproject commit 18c0e370222070ae6b9bc061d3d404b115fdc1d3 +Subproject commit e3d16bf49184cd6dbb18c17072031b974605c8e5 From 7124d2335dcc727e5f55f1fc209a701ac8029fa1 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Wed, 16 Jul 2025 15:23:25 -0600 Subject: [PATCH 19/24] Clean up print statements --- src/physics/cam/cospsimulator_intr.F90 | 16 +--------------- 1 file changed, 1 insertion(+), 15 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 13933a8382..f9b40f8f30 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -1098,14 +1098,7 @@ subroutine cospsimulator_intr_init() end if end do end if - - if (masterproc) then - if (docosp) then - write(iulog,*)'Finished RTTOV section in cospsimulator_intr_init' - write(iulog,*)'lrttov_sim: ', lrttov_sim - end if - end if - + !! ADDFLD, ADD_DEFAULT, OUTFLD CALLS FOR COSP OUTPUTS IF RUNNING COSP OFF-LINE if (cosp_histfile_aux) then call addfld ('PS_COSP', horiz_only, 'I','Pa', & @@ -2285,13 +2278,6 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & call construct_cospIN(ncol, nscol_cosp, nlay, rttov_Ninstruments, cospIN, emis_grey=1.0_r8) ! Apply unitary blackbody surface emissivity to be consistent with CESM physics cospIN%emsfc_lw = emsfc_lw if (lradar_sim) cospIN%rcfg_cloudsat = rcfg_cs(lchnk) - - if (masterproc) then - if (docosp) then - write(iulog,*)'after construct_cospIN' - end if - end if - if (lrttov_sim) cospIN%cfg_rttov => rttov_configs cospIN%cospswathsIN = cospswathsIN From 57e6fb4b173145bda3b3a6dd7f7744d4a3b7359a Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Thu, 17 Jul 2025 11:42:24 -0600 Subject: [PATCH 20/24] Correct cld_cal_un outfld call to outside of if statement --- src/physics/cam/cospsimulator_intr.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index f9b40f8f30..f186769c7b 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -2796,8 +2796,8 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & !! setting missing values to 0 (clear air), likely below sea level cld_cal_un(:ncol,:nht_cosp) = 0.0_r8 end where - call outfld('CLD_CAL_UN',cld_cal_un ,pcols,lchnk) !! end if + call outfld('CLD_CAL_UN',cld_cal_un ,pcols,lchnk) !! where (cld_cal_tmp(:ncol,:nht_cosp) == R_UNDEF) !! setting missing values to 0 (clear air), likely below sea level From fef0719831f2afcaf523e7a672e70526b129bbd0 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Thu, 17 Jul 2025 13:45:59 -0600 Subject: [PATCH 21/24] Update COSPv.20 tag --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index a95b41ce20..4fa5f72d31 100644 --- a/.gitmodules +++ b/.gitmodules @@ -102,7 +102,7 @@ url = https://github.com/dustinswales/COSPv2.0 fxrequired = AlwaysRequired fxsparse = ../.cosp_sparse_checkout - fxtag = d10be9f # Tag for feature/cosp_rrtov_swathing on 2025/07/09 + fxtag = e2afae9 fxDONOTUSEurl = https://github.com/dustinswales/COSPv2.0 [submodule "clubb"] From 1579bbdad17c6631821c77b9150b1b5c96346b42 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Tue, 5 Aug 2025 13:20:39 -0600 Subject: [PATCH 22/24] Revert diffusion_solver and ChangeLog --- doc/ChangeLog | 1 - src/physics/cam/diffusion_solver.F90 | 8 ++++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 00b69d1851..90114c3769 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,6 +1,5 @@ =============================================================== -======= Tag name: cam6_4_106 Originator(s): kuanchihwang Date: July 23, 2025 diff --git a/src/physics/cam/diffusion_solver.F90 b/src/physics/cam/diffusion_solver.F90 index 2a715596ea..06d4f20236 100644 --- a/src/physics/cam/diffusion_solver.F90 +++ b/src/physics/cam/diffusion_solver.F90 @@ -631,14 +631,14 @@ end function vd_lu_qdecomp ! the sum of 'taux(i) - ksrftms(i)*u(i,pver) + tauresx(i)'. if( itaures .eq. 1 ) then - tauresx(i) = taux(i) + tautmsx(i) + taubljx(i) + tauresx(i)- tauimpx(i) - tauresy(i) = tauy(i) + tautmsy(i) + taubljy(i) + tauresy(i)- tauimpy(i) + tauresx(i) = taux(i) + tauresx(i) - tauimpx(i) + tautmsx(i) + taubljx(i) + tauresy(i) = tauy(i) + tauresy(i) - tauimpy(i) + tautmsy(i) + taubljy(i) endif else - tautotx(i) = tautmsx(i) + taux(i) - tautoty(i) = tautmsy(i) + tauy(i) + tautotx(i) = taux(i) + tautmsx(i) + tautoty(i) = tauy(i) + tautmsy(i) tauresx(i) = 0._r8 tauresy(i) = 0._r8 From e799da1b878076397d87ed78c92749839198a87c Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Tue, 5 Aug 2025 17:18:43 -0600 Subject: [PATCH 23/24] Change request for CAM PR --- src/physics/cam/cospsimulator_intr.F90 | 366 +++++++++++++------------ 1 file changed, 190 insertions(+), 176 deletions(-) diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index f186769c7b..baef37762a 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -125,7 +125,6 @@ module cospsimulator_intr ! ###################################################################################### ! Default CAM namelist settings ! ###################################################################################### - ! CAM logical :: cosp_amwg = .false. logical :: cosp_lite = .false. logical :: cosp_passive = .false. @@ -1011,7 +1010,7 @@ subroutine cospsimulator_intr_init() call add_default ('rttov_bt_total_inst'//trim(i_str),cosp_histfile_num,' ') end if - if (rttov_configs(i) % Lrttov_bt .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + if (rttov_configs(i) % Lrttov_bt .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then call addfld ('rttov_bt_clear_inst'//trim(i_str), & (/'RTTOV_CHAN_I'//trim(i_str)/), & 'A', & @@ -1363,7 +1362,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & use mod_cosp_config, only: R_UNDEF,parasol_nrefl, Nlvgrid use mod_cosp, only: cosp_simulator use mod_quickbeam_optics, only: size_distribution - use time_manager, only: get_curr_date ! Gets the date/time valid at the end of the timestep. Should be fine. + use time_manager, only: get_curr_date ! Gets the date/time valid at the end of the timestep. use ref_pres, only: top_lev=>trop_cloud_top_lev use conv_water, only: conv_water_in_rad, conv_water_4rad #endif @@ -1664,58 +1663,63 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & call t_startf('init_and_stuff') ! Create the fname string array for RTTOV fmt = '(I3.3)' ! an integer of width 3 with zeros at the left - do i=1,rttov_Ninstruments - write (i_str,fmt) i ! converting integer to string i_str using a 'internal file' - do k=1,nf_rttov - fname_rttov(i,:) = (/'rttov_bt_total_inst'//trim(i_str), & - 'rttov_bt_clear_inst'//trim(i_str), & - 'rttov_rad_total_inst'//trim(i_str), & - 'rttov_rad_clear_inst'//trim(i_str), & - 'rttov_rad_cloudy_inst'//trim(i_str), & - 'rttov_refl_total_inst'//trim(i_str), & - 'rttov_refl_clear_inst'//trim(i_str), & - 'rttov_btpc_clr_inst'//trim(i_str), & - 'rttov_radpc_clr_inst'//trim(i_str) /) - end do - end do + if (lrttov_sim) then + do i=1,rttov_Ninstruments + write (i_str,fmt) i ! converting integer to string i_str using a 'internal file' + do k=1,nf_rttov + fname_rttov(i,:) = (/'rttov_bt_total_inst'//trim(i_str), & + 'rttov_bt_clear_inst'//trim(i_str), & + 'rttov_rad_total_inst'//trim(i_str), & + 'rttov_rad_clear_inst'//trim(i_str), & + 'rttov_rad_cloudy_inst'//trim(i_str), & + 'rttov_refl_total_inst'//trim(i_str), & + 'rttov_refl_clear_inst'//trim(i_str), & + 'rttov_btpc_clr_inst'//trim(i_str), & + 'rttov_radpc_clr_inst'//trim(i_str) /) + end do + end do + end if ! Allocate the DDT for the RTTOV outputs (bleh?) if (lrttov_sim) then - call t_startf('allocate rttov_outputs_cp') - do i=1,rttov_Ninstruments - rttov_outputs_cp(i) % nchan_out = rttov_configs(i) % nchan_out - ! Only allocate output if the output has been requested. - if (not(rttov_configs(i) % Lrttov_pc)) then - if (rttov_configs(i) % Lrttov_bt) then - allocate(rttov_outputs_cp(i) % bt_total(pcols,rttov_configs(i) % nchan_out)) - end if - if (rttov_configs(i) % Lrttov_bt .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then - allocate(rttov_outputs_cp(i) % bt_clear(pcols,rttov_configs(i) % nchan_out)) - end if - if (rttov_configs(i) % Lrttov_rad) then - allocate(rttov_outputs_cp(i) % rad_total(pcols,rttov_configs(i) % nchan_out)) - end if - if (rttov_configs(i) % Lrttov_rad .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then - allocate(rttov_outputs_cp(i) % rad_clear(pcols,rttov_configs(i) % nchan_out)) - allocate(rttov_outputs_cp(i) % rad_cloudy(pcols,rttov_configs(i) % nchan_out)) - end if - if (rttov_configs(i) % Lrttov_refl) then - allocate(rttov_outputs_cp(i) % refl_total(pcols,rttov_configs(i) % nchan_out)) - end if - if (rttov_configs(i) % Lrttov_refl .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then - allocate(rttov_outputs_cp(i) % refl_clear(pcols,rttov_configs(i) % nchan_out)) - end if - else - if (rttov_configs(i) % Lrttov_bt) then - allocate(rttov_outputs_cp(i) % bt_total_pc(pcols,rttov_configs(i) % nchan_out)) - end if - if (rttov_configs(i) % Lrttov_rad) then - allocate(rttov_outputs_cp(i) % rad_total_pc(pcols,rttov_configs(i) % nchan_out)) - end if - end if - end do - call t_stopf('allocate rttov_outputs_cp') + call t_startf('allocate rttov_outputs_cp') + do i=1,rttov_Ninstruments + rttov_outputs_cp(i) % nchan_out = rttov_configs(i) % nchan_out + ! Only allocate output if the output has been requested. + if (not(rttov_configs(i) % Lrttov_pc)) then + if (rttov_configs(i) % Lrttov_bt) then + allocate(rttov_outputs_cp(i) % bt_total(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_bt .and. & + ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + allocate(rttov_outputs_cp(i) % bt_clear(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_rad) then + allocate(rttov_outputs_cp(i) % rad_total(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_rad .and. & + ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + allocate(rttov_outputs_cp(i) % rad_clear(pcols,rttov_configs(i) % nchan_out)) + allocate(rttov_outputs_cp(i) % rad_cloudy(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_refl) then + allocate(rttov_outputs_cp(i) % refl_total(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_refl .and. & + ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + allocate(rttov_outputs_cp(i) % refl_clear(pcols,rttov_configs(i) % nchan_out)) + end if + else + if (rttov_configs(i) % Lrttov_bt) then + allocate(rttov_outputs_cp(i) % bt_total_pc(pcols,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_rad) then + allocate(rttov_outputs_cp(i) % rad_total_pc(pcols,rttov_configs(i) % nchan_out)) + end if + end if + end do + call t_stopf('allocate rttov_outputs_cp') end if ! ###################################################################################### @@ -1843,36 +1847,39 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! Initialize the RTTOV outputs if (lrttov_sim) then - do i=1,rttov_Ninstruments - if (not(rttov_configs(i) % Lrttov_pc)) then - if (rttov_configs(i) % Lrttov_bt) then - rttov_outputs_cp(i) % bt_total(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF - end if - if (rttov_configs(i) % Lrttov_bt .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then - rttov_outputs_cp(i) % bt_clear(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF - end if - if (rttov_configs(i) % Lrttov_rad) then - rttov_outputs_cp(i) % rad_total(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF - end if - if (rttov_configs(i) % Lrttov_rad .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then - rttov_outputs_cp(i) % rad_clear(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF - rttov_outputs_cp(i) % rad_cloudy(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF - end if - if (rttov_configs(i) % Lrttov_refl) then - rttov_outputs_cp(i) % refl_total(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF - end if - if (rttov_configs(i) % Lrttov_refl .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then - rttov_outputs_cp(i) % refl_clear(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF - end if - else - if (rttov_configs(i) % Lrttov_bt) then - rttov_outputs_cp(i) % bt_total_pc(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF - end if - if (rttov_configs(i) % Lrttov_rad) then - rttov_outputs_cp(i) % rad_total_pc(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF - end if - end if - end do + do i=1,rttov_Ninstruments + if (not(rttov_configs(i) % Lrttov_pc)) then + if (rttov_configs(i) % Lrttov_bt) then + rttov_outputs_cp(i) % bt_total(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_bt .and. & + ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + rttov_outputs_cp(i) % bt_clear(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_rad) then + rttov_outputs_cp(i) % rad_total(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_rad .and. & + ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + rttov_outputs_cp(i) % rad_clear(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + rttov_outputs_cp(i) % rad_cloudy(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_refl) then + rttov_outputs_cp(i) % refl_total(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_refl .and. & + ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + rttov_outputs_cp(i) % refl_clear(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + else + if (rttov_configs(i) % Lrttov_bt) then + rttov_outputs_cp(i) % bt_total_pc(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + if (rttov_configs(i) % Lrttov_rad) then + rttov_outputs_cp(i) % rad_total_pc(1:pcols,1:rttov_outputs_cp(i) % nchan_out) = R_UNDEF + end if + end if + end do end if ! ###################################################################################### @@ -1921,32 +1928,35 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & if (lrttov_sim) then do k=1,rttov_Ninstruments if (not(rttov_configs(k) % Lrttov_pc)) then - if (rttov_configs(k) % Lrttov_bt) then - run_rttov(k,1,1:pcols)=hist_fld_col_active(fname_rttov(k,1),lchnk,pcols) - end if - if (rttov_configs(k) % Lrttov_bt .and. ((rttov_configs(k) % Lrttov_cld) .or. (rttov_configs(k) % Lrttov_aer))) then - run_rttov(k,2,1:pcols)=hist_fld_col_active(fname_rttov(k,2),lchnk,pcols) - end if - if (rttov_configs(k) % Lrttov_rad) then - run_rttov(k,3,1:pcols)=hist_fld_col_active(fname_rttov(k,3),lchnk,pcols) - end if - if (rttov_configs(k) % Lrttov_rad .and. ((rttov_configs(k) % Lrttov_cld) .or. (rttov_configs(k) % Lrttov_aer))) then - run_rttov(k,4,1:pcols)=hist_fld_col_active(fname_rttov(k,4),lchnk,pcols) - run_rttov(k,5,1:pcols)=hist_fld_col_active(fname_rttov(k,5),lchnk,pcols) - end if - if (rttov_configs(k) % Lrttov_refl) then - run_rttov(k,6,1:pcols)=hist_fld_col_active(fname_rttov(k,6),lchnk,pcols) - end if - if (rttov_configs(k) % Lrttov_refl .and. ((rttov_configs(k) % Lrttov_cld) .or. (rttov_configs(k) % Lrttov_aer))) then - run_rttov(k,7,1:pcols)=hist_fld_col_active(fname_rttov(k,7),lchnk,pcols) - end if + if (rttov_configs(k) % Lrttov_bt) then + run_rttov(k,1,1:pcols)=hist_fld_col_active(fname_rttov(k,1),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_bt .and. & + ((rttov_configs(k) % Lrttov_cld) .or. (rttov_configs(k) % Lrttov_aer))) then + run_rttov(k,2,1:pcols)=hist_fld_col_active(fname_rttov(k,2),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_rad) then + run_rttov(k,3,1:pcols)=hist_fld_col_active(fname_rttov(k,3),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_rad .and. & + ((rttov_configs(k) % Lrttov_cld) .or. (rttov_configs(k) % Lrttov_aer))) then + run_rttov(k,4,1:pcols)=hist_fld_col_active(fname_rttov(k,4),lchnk,pcols) + run_rttov(k,5,1:pcols)=hist_fld_col_active(fname_rttov(k,5),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_refl) then + run_rttov(k,6,1:pcols)=hist_fld_col_active(fname_rttov(k,6),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_refl .and. & + ((rttov_configs(k) % Lrttov_cld) .or. (rttov_configs(k) % Lrttov_aer))) then + run_rttov(k,7,1:pcols)=hist_fld_col_active(fname_rttov(k,7),lchnk,pcols) + end if else - if (rttov_configs(k) % Lrttov_bt) then - run_rttov(k,8,1:pcols)=hist_fld_col_active(fname_rttov(k,8),lchnk,pcols) - end if - if (rttov_configs(k) % Lrttov_rad) then - run_rttov(k,9,1:pcols)=hist_fld_col_active(fname_rttov(k,9),lchnk,pcols) - end if + if (rttov_configs(k) % Lrttov_bt) then + run_rttov(k,8,1:pcols)=hist_fld_col_active(fname_rttov(k,8),lchnk,pcols) + end if + if (rttov_configs(k) % Lrttov_rad) then + run_rttov(k,9,1:pcols)=hist_fld_col_active(fname_rttov(k,9),lchnk,pcols) + end if end if end do end if @@ -2011,8 +2021,6 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & !! precipitation fluxes call pbuf_get_field(pbuf, dpflxprc_idx, dp_flxprc ) call pbuf_get_field(pbuf, dpflxsnw_idx, dp_flxsnw ) -! call pbuf_get_field(pbuf, shflxprc_idx, sh_flxprc ) -! call pbuf_get_field(pbuf, shflxsnw_idx, sh_flxsnw ) if (shflxprc_idx > 0) then call pbuf_get_field(pbuf, shflxprc_idx, sh_flxprc ) else @@ -2066,30 +2074,25 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & end do zint(:,nlayp) = surf_hgt - landmask = 0._r8 + landmask(1:ncol) = 0._r8 do i = 1, ncol if (cam_in%landfrac(i) > 0.01_r8) landmask(i)= 1 end do - ! initalize landmask - landmask(1:ncol)=0._r8 - ! calculate landmask - do i=1,ncol - if (cam_in%landfrac(i)>0.01_r8) landmask(i)= 1 - end do - ! RTTOV surface mask (consider sea ice as well) ! 1: land, 0: ocean, 2: sea ice - rttov_sfcmask(1:ncol) = 0 - do i=1,ncol - if ((cam_in%landfrac(i) > cam_in%ocnfrac(i)) .and. (cam_in%landfrac(i) > cam_in%icefrac(i))) then - rttov_sfcmask(i) = 1 - else if (cam_in%ocnfrac(i) > cam_in%icefrac(i)) then - rttov_sfcmask(i) = 0 - else - rttov_sfcmask(i) = 2 - end if - end do + if (lrttov_sim) then + rttov_sfcmask(1:ncol) = 0 + do i=1,ncol + if ((cam_in%landfrac(i) > cam_in%ocnfrac(i)) .and. (cam_in%landfrac(i) > cam_in%icefrac(i))) then + rttov_sfcmask(i) = 1 + else if (cam_in%ocnfrac(i) > cam_in%icefrac(i)) then + rttov_sfcmask(i) = 0 + else + rttov_sfcmask(i) = 2 + end if + end do + end if ! Add together deep and shallow convection precipitation fluxes. ! Note: sh_flxprc and dp_flxprc variables are rain+snow @@ -2144,7 +2147,6 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & mr_lsice = 0._r8 do k = 1, nlay kk = ktop + k -1 - do i = 1, ncol if (cld(i,k) > 0._r8) then mr_lsliq(i,k) = totg_liq(i,kk) @@ -2240,7 +2242,7 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & cospstateIN%surfelev = surf_hgt cospstateIN%rttov_sfcmask = rttov_sfcmask(1:ncol) - ! Set time + ! Set time (used by RTTOV and all simulators for swathing) call get_curr_date(yr, mon, day, ncsec) cospstateIN%rttov_date(:,1) = yr @@ -2248,11 +2250,12 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & cospstateIN%rttov_date(:,3) = day ! Need to convert from total daily seconds to hour, minute, and seconds - cospstateIN%rttov_time(:,1) = ncsec / 3600 ! Hours is nsec / 3600 (seconds per hour). Need integers to get the integer division! + cospstateIN%rttov_time(:,1) = ncsec / 3600 ! Hours is nsec / 3600 (seconds per hour). cospstateIN%rttov_time(:,2) = (ncsec - 3600 * (ncsec / 3600)) / 60 ! Remainder divided by 60 seconds per minute cospstateIN%rttov_time(:,3) = ncsec - (3600*cospstateIN%rttov_time(:,1)) - (60*cospstateIN%rttov_time(:,2)) ! Final remainder - cospstateIN%sza(1:ncol) = acosd(coszrs(1:ncol)) ! Hokey because we get the SZA by taking the arcosine of cos(sza), but this seems to be the variable the radiation scheme can pass. + ! We get the SZA by taking the arcosine of cos(sza), but this seems to be the variable the radiation scheme can pass. + cospstateIN%sza(1:ncol) = acosd(coszrs(1:ncol)) cospstateIN%cloudIce(1:ncol,1:pver) = totg_ice ! gridcell ice water mixing ratio cospstateIN%cloudLiq(1:ncol,1:pver) = totg_liq ! gridcell liquid water mixing ratio @@ -2263,7 +2266,8 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! Multiply by 2 to go from radius to diameter, multiply 1e6 to go from meters to microns. cospstateIN%DeffLiq(:,:) = 0._r8 ! Initialize for zero everywhere. where ((mr_lsliq(1:ncol,1:pver) > 0._r8) .and. (mr_ccliq(1:ncol,1:pver) > 0._r8)) - cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * (mr_lsliq(1:ncol,1:pver) + mr_ccliq(1:ncol,1:pver)) / (mr_lsliq(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_LSCLIQ) + mr_ccliq(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_CVCLIQ)) + cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * (mr_lsliq(1:ncol,1:pver) + mr_ccliq(1:ncol,1:pver)) / & + (mr_lsliq(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_LSCLIQ) + mr_ccliq(1:ncol,1:pver) / reff_cosp(1:ncol,1:pver,I_CVCLIQ)) else where (mr_lsliq(1:ncol,1:pver) > 0._r8) cospstateIN%DeffLiq(:,:) = 2._r8 * 1.0e6 * reff_cosp(1:ncol,1:pver,I_LSCLIQ) else where (mr_ccliq(1:ncol,1:pver) > 0._r8) @@ -2275,7 +2279,8 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! Optical inputs call t_startf("construct_cospIN") - call construct_cospIN(ncol, nscol_cosp, nlay, rttov_Ninstruments, cospIN, emis_grey=1.0_r8) ! Apply unitary blackbody surface emissivity to be consistent with CESM physics + ! Apply unitary blackbody surface emissivity to be consistent with CESM physics + call construct_cospIN(ncol, nscol_cosp, nlay, rttov_Ninstruments, cospIN, emis_grey=1.0_r8) cospIN%emsfc_lw = emsfc_lw if (lradar_sim) cospIN%rcfg_cloudsat = rcfg_cs(lchnk) if (lrttov_sim) cospIN%cfg_rttov => rttov_configs @@ -2577,32 +2582,41 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & ! RTTOV if (lrttov_sim) then - do i=1,rttov_Ninstruments ! Not sure if this logical stuff is needed or not? + do i=1,rttov_Ninstruments if (rttov_configs(i) % Lrttov_pc) then if (rttov_configs(i) % Lrttov_bt) then - rttov_outputs_cp(i) % bt_total_pc(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % bt_total_pc + rttov_outputs_cp(i) % bt_total_pc(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = & + cospOUT % rttov_outputs(i) % bt_total_pc end if if (rttov_configs(i) % Lrttov_rad) then - rttov_outputs_cp(i) % rad_total_pc(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % rad_total_pc + rttov_outputs_cp(i) % rad_total_pc(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = & + cospOUT % rttov_outputs(i) % rad_total_pc end if else if (rttov_configs(i) % Lrttov_bt) then - rttov_outputs_cp(i) % bt_total(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % bt_total + rttov_outputs_cp(i) % bt_total(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = & + cospOUT % rttov_outputs(i) % bt_total if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then - rttov_outputs_cp(i) % bt_clear(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % bt_clear + rttov_outputs_cp(i) % bt_clear(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = & + cospOUT % rttov_outputs(i) % bt_clear end if end if if (rttov_configs(i) % Lrttov_rad) then - rttov_outputs_cp(i) % rad_total(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % rad_total + rttov_outputs_cp(i) % rad_total(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = & + cospOUT % rttov_outputs(i) % rad_total if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then - rttov_outputs_cp(i) % rad_clear(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % rad_clear - rttov_outputs_cp(i) % rad_cloudy(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % rad_cloudy + rttov_outputs_cp(i) % rad_clear(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = & + cospOUT % rttov_outputs(i) % rad_clear + rttov_outputs_cp(i) % rad_cloudy(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = & + cospOUT % rttov_outputs(i) % rad_cloudy end if end if if (rttov_configs(i) % Lrttov_refl) then - rttov_outputs_cp(i) % refl_total(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % refl_total + rttov_outputs_cp(i) % refl_total(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = & + cospOUT % rttov_outputs(i) % refl_total if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then - rttov_outputs_cp(i) % refl_clear(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = cospOUT % rttov_outputs(i) % refl_clear + rttov_outputs_cp(i) % refl_clear(1:ncol,1:rttov_outputs_cp(i) % nchan_out) = & + cospOUT % rttov_outputs(i) % refl_clear end if end if end if @@ -3770,43 +3784,43 @@ subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,N_rttov_instr ! RTTOV - Allocate output for multiple instruments if (lrttov_sim) then - x % Ninst_rttov = N_rttov_instruments - allocate(x % rttov_outputs(N_rttov_instruments)) - do i=1,N_rttov_instruments - x % rttov_outputs(i) % nchan_out = rttov_configs(i) % nchan_out - if (rttov_configs(i) % Lrttov_pc) then ! Treat PC-RTTOV fields as clear-sky only for now - allocate(x % rttov_outputs(i) % channel_indices(rttov_configs(i) % nchan_out)) - if (rttov_configs(i) % Lrttov_bt) then ! Brightness temp - allocate(x % rttov_outputs(i) % bt_total_pc(Npoints,rttov_configs(i) % nchan_out)) - end if - if (rttov_configs(i) % Lrttov_rad) then ! Radiance - allocate(x % rttov_outputs(i) % rad_total_pc(Npoints,rttov_configs(i) % nchan_out)) - end if - else - allocate(x % rttov_outputs(i) % channel_indices(rttov_configs(i) % nchan_out)) - if (rttov_configs(i) % Lrttov_bt) then ! Brightness temp - allocate(x % rttov_outputs(i) % bt_total(Npoints,rttov_configs(i) % nchan_out)) - if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then - allocate(x % rttov_outputs(i) % bt_clear(Npoints,rttov_configs(i) % nchan_out)) - end if - end if - if (rttov_configs(i) % Lrttov_rad) then ! Radiance - allocate(x % rttov_outputs(i) % rad_total(Npoints,rttov_configs(i) % nchan_out)) - if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then - allocate(x % rttov_outputs(i) % rad_clear(Npoints,rttov_configs(i) % nchan_out)) - end if - if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then - allocate(x % rttov_outputs(i) % rad_cloudy(Npoints,rttov_configs(i) % nchan_out)) - end if + x % Ninst_rttov = N_rttov_instruments + allocate(x % rttov_outputs(N_rttov_instruments)) + do i=1,N_rttov_instruments + x % rttov_outputs(i) % nchan_out = rttov_configs(i) % nchan_out + if (rttov_configs(i) % Lrttov_pc) then ! Treat PC-RTTOV fields as clear-sky only for now + allocate(x % rttov_outputs(i) % channel_indices(rttov_configs(i) % nchan_out)) + if (rttov_configs(i) % Lrttov_bt) then ! Brightness temp + allocate(x % rttov_outputs(i) % bt_total_pc(Npoints,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_rad) then ! Radiance + allocate(x % rttov_outputs(i) % rad_total_pc(Npoints,rttov_configs(i) % nchan_out)) + end if + else + allocate(x % rttov_outputs(i) % channel_indices(rttov_configs(i) % nchan_out)) + if (rttov_configs(i) % Lrttov_bt) then ! Brightness temp + allocate(x % rttov_outputs(i) % bt_total(Npoints,rttov_configs(i) % nchan_out)) + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + allocate(x % rttov_outputs(i) % bt_clear(Npoints,rttov_configs(i) % nchan_out)) end if - if (rttov_configs(i) % Lrttov_refl) then ! Reflectance - allocate(x % rttov_outputs(i) % refl_total(Npoints,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_rad) then ! Radiance + allocate(x % rttov_outputs(i) % rad_total(Npoints,rttov_configs(i) % nchan_out)) + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + allocate(x % rttov_outputs(i) % rad_clear(Npoints,rttov_configs(i) % nchan_out)) end if - if (rttov_configs(i) % Lrttov_refl .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then - allocate(x % rttov_outputs(i) % refl_clear(Npoints,rttov_configs(i) % nchan_out)) + if ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer)) then + allocate(x % rttov_outputs(i) % rad_cloudy(Npoints,rttov_configs(i) % nchan_out)) end if - end if - end do + end if + if (rttov_configs(i) % Lrttov_refl) then ! Reflectance + allocate(x % rttov_outputs(i) % refl_total(Npoints,rttov_configs(i) % nchan_out)) + end if + if (rttov_configs(i) % Lrttov_refl .and. ((rttov_configs(i) % Lrttov_cld) .or. (rttov_configs(i) % Lrttov_aer))) then + allocate(x % rttov_outputs(i) % refl_clear(Npoints,rttov_configs(i) % nchan_out)) + end if + end if + end do else x % Ninst_rttov = 0 end if From cbbc65a34308b95d3fa2951e4746142718ea1cb3 Mon Sep 17 00:00:00 2001 From: jshaw35 Date: Mon, 29 Dec 2025 10:41:39 -0700 Subject: [PATCH 24/24] Re-add COSP2 information to .gitmodules --- .gitmodules | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/.gitmodules b/.gitmodules index 9d78805753..d7f31bc2aa 100644 --- a/.gitmodules +++ b/.gitmodules @@ -91,6 +91,14 @@ fxtag = v8.2.1 fxDONOTUSEurl = https://github.com/MPAS-Dev/MPAS-Model.git +[submodule "cosp2"] + path = src/physics/cosp2/src + url = https://github.com/CFMIP/COSPv2.0 + fxrequired = AlwaysRequired + fxsparse = ../.cosp_sparse_checkout + fxtag = v2.2.0 + fxDONOTUSEurl = https://github.com/CFMIP/COSPv2.0 + [submodule "clubb"] path = src/physics/clubb url = https://github.com/larson-group/clubb_release