diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index f72166ec39..a116ccbe1f 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -78,6 +78,7 @@ jobs: cd driver/run ./cosp2_test cosp2_input_nl.txt ./cosp2_test cosp2_input_nl.um_global.txt + ./cosp2_test cosp2_swath_input_nl.um_global.txt ############################################################################### # Compare results against known good outputs. As above, # we split it in as many steps as tests. @@ -99,6 +100,15 @@ jobs: TST=data/outputs/UKMO/cosp2_output.um_global.nc STATS=data/outputs/UKMO/cosp2_output.um_global.${{ matrix.compiler }}.out python compare_to_kgo.py ${KGO} ${TST} --atol=${ATOL} --rtol=${RTOL} --stats_file=${STATS} + # 3. UM global snapshot with swathing. + - name: UM global with swathing against known good output (KGO) + if: always() + run: | + cd driver + KGO=data/outputs/UKMO/cosp2_output.um_global.${{ matrix.compiler }}.kgo.$KGO_VERSION.nc + TST=data/outputs/UKMO/cosp2_swath_output.um_global.nc + STATS=data/outputs/UKMO/cosp2_output.um_global.${{ matrix.compiler }}.out + python compare_to_kgo.py ${KGO} ${TST} --atol=${ATOL} --rtol=${RTOL} --stats_file=${STATS} ############################################################################### # Produce plots when it fails during global snapshot tests, # and create a tarball with outputs. @@ -112,7 +122,7 @@ jobs: fi cd data/outputs/UKMO tar --ignore-failed-read -czf outputs.${{ matrix.compiler }}.UKMO.tgz cosp2_output.um_global.nc \ - cosp2_output_um.nc *.png cosp2_output*.${{ matrix.compiler }}.out + cosp2_output_um.nc cosp2_swath_output.um_global.nc *.png cosp2_output*.${{ matrix.compiler }}.out ls -lh ############################################################################### # Make output files available if any test fails diff --git a/.github/workflows/continuous_integration.yml b/.github/workflows/continuous_integration.yml index 9e7ce87611..7ed6289e9c 100644 --- a/.github/workflows/continuous_integration.yml +++ b/.github/workflows/continuous_integration.yml @@ -102,6 +102,7 @@ jobs: cd driver/run ./cosp2_test cosp2_input_nl.txt ./cosp2_test cosp2_input_nl.um_global.txt + ./cosp2_test cosp2_swath_input_nl.um_global.txt # 2. UM global snapshot. Diagnostics on model levels. - name: UM global snapshot. Diagnostics on model levels. run: | @@ -134,6 +135,14 @@ jobs: KGO=data/outputs/UKMO/cosp2_output.um_global_model_levels.${F90_SHORT_NAME}.kgo.$KGO_VERSION.nc TST=data/outputs/UKMO/cosp2_output.um_global_model_levels.nc python compare_to_kgo.py ${KGO} ${TST} --atol=${ATOL} --rtol=${RTOL} + # 4. UM global snapshot. + - name: UM global with swathing against known good output (KGO) + if: always() + run: | + cd driver + KGO=data/outputs/UKMO/cosp2_output.um_global.${F90_SHORT_NAME}.kgo.$KGO_VERSION.nc + TST=data/outputs/UKMO/cosp2_swath_output.um_global.nc + python compare_to_kgo.py ${KGO} ${TST} --atol=${ATOL} --rtol=${RTOL} ############################################################################### # Produce plots when it fails during global snapshot tests, # and create a tarball with outputs. @@ -151,7 +160,7 @@ jobs: fi cd data/outputs/UKMO tar --ignore-failed-read -czf outputs.${{ matrix.compiler }}.UKMO.tgz cosp2_output.um_global.nc \ - cosp2_output_um.nc cosp2_output.um_global_model_levels.nc *.png \ + cosp2_output_um.nc cosp2_swath_output.um_global.nc cosp2_output.um_global_model_levels.nc *.png \ cosp2_output.um_global.out ls -lh ############################################################################### diff --git a/build/Makefile b/build/Makefile index 54ff8ab508..813752bf22 100644 --- a/build/Makefile +++ b/build/Makefile @@ -9,6 +9,13 @@ ISCCP_PATH = $(SIM_PATH)/icarus MISR_PATH = $(SIM_PATH)/MISR_simulator MODIS_PATH = $(SIM_PATH)/MODIS_simulator PARASOL_PATH = $(SIM_PATH)/parasol + +# Makefile.rttov needed to define the following: +# RTTOVDIR, FFLAGS, LIBDIR, LIBS, LLIBS, LDFLAGS_NETCDF, LDFLAGS_HDF5, LDFLAGS_ARCH +ifdef RTTOV +include Makefile.rttov +endif + VPATH = $(SRC_PATH):$(HOOKS):$(SIM_PATH):$(RT_PATH):$(RS_PATH):$(CS_PATH):$(ISCCP_PATH):$(MISR_PATH):$(MODIS_PATH):$(PARASOL_PATH) # Example subcolumn generaton and mapping to optical properties, following COSP 1.4 @@ -26,6 +33,11 @@ LDFLAGS += $(NC_LIB) -lnetcdff LDFLAGS += -L. -lcosp -lsubcol +# Need additional load flags from Makefile.rttov when linking to RTTOV. May remove with improved linking. +ifdef RTTOV +LDFLAGS += $(LLIBS) $(LDFLAGS_NETCDF) $(LDFLAGS_HDF5) $(LDFLAGS_ARCH) $(LDFLAGS_LAPACK) +endif + # Rules %.o: %.F90 $(F90) $(F90FLAGS) -c $< @@ -34,8 +46,17 @@ LDFLAGS += -L. -lcosp -lsubcol $(F90) $(F90FLAGS) -c $< %: %.o - $(F90) $(F90FLAGS) -o $@ $^ $(LDFLAGS) $(LIBS) + $(F90) $(F90FLAGS) -o $@ $^ $(LDFLAGS) +# Special rules for the RTTOV files. +cosp_rttov_interface_v13.o : cosp_rttov_interface_v13.F90 + $(F90) $(F90FLAGS) $(FFLAGS) -c $< + +cosp_rttov_v13.o : cosp_rttov_v13.F90 + $(F90) $(F90FLAGS) $(FFLAGS) -c $< + +cosp_rttov_util.o : cosp_rttov_util.F90 + $(F90) $(F90FLAGS) $(FFLAGS) -c $< # # The COSP library # @@ -43,10 +64,19 @@ COSP_OBJS = cosp.o cosp_config.o cosp_stats.o cosp_constants.o cosp_errorHandlin cosp_isccp_interface.o icarus.o cosp_misr_interface.o MISR_simulator.o \ cosp_modis_interface.o modis_simulator.o cosp_parasol_interface.o parasol.o \ cosp_calipso_interface.o lidar_simulator.o cosp_cloudsat_interface.o quickbeam.o \ - cosp_rttov_interfaceSTUB.o cosp_rttovSTUB.o cosp_grLidar532_interface.o cosp_atlid_interface.o + cosp_grLidar532_interface.o cosp_atlid_interface.o + +# Add RTTOV files appropriately. +ifdef RTTOV +COSP_OBJS += cosp_rttov_interface_v13.o cosp_rttov_v13.o cosp_rttov_util.o +else +COSP_OBJS += cosp_rttov_interfaceSTUB.o cosp_rttovSTUB.o cosp_rttov_utilSTUB.o +endif + LIBRARY = libcosp.a +# Jonah tried to link in RTTOV to libcosp.a rather than cosp2_test. It didn't work. $(LIBRARY): $(COSP_OBJS) ar -rvs $(LIBRARY) $(COSP_OBJS) @@ -62,44 +92,62 @@ driver: make cosp2_test mv cosp2_test ../driver/run -# Dependencies for libary -cosp.o : cosp_kinds.o cosp_modis_interface.o cosp_constants.o cosp_rttov_interfaceSTUB.o \ - cosp_misr_interface.o cosp_isccp_interface.o cosp_calipso_interface.o \ - cosp_cloudsat_interface.o cosp_stats.o \ - cosp_parasol_interface.o cosp_rttovSTUB.o \ - cosp_rttov_interfaceSTUB.o quickbeam.o MISR_simulator.o lidar_simulator.o \ - parasol.o icarus.o cosp_grLidar532_interface.o cosp_atlid_interface.o +# Dependencies for normal COSP libary +cosp.o : cosp_kinds.o cosp_modis_interface.o cosp_constants.o \ + cosp_misr_interface.o cosp_isccp_interface.o cosp_calipso_interface.o \ + cosp_cloudsat_interface.o cosp_stats.o \ + cosp_parasol_interface.o \ + quickbeam.o MISR_simulator.o lidar_simulator.o \ + parasol.o icarus.o cosp_grLidar532_interface.o cosp_atlid_interface.o + +# Conditionally add dependencies on the STUB or actual RTTOV simulator. +ifdef RTTOV +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_rttov_utilSTUB.o +cosp_stats.o : cosp_kinds.o cosp_config.o cosp_constants.o cosp_rttov_utilSTUB.o +endif + cosp_constants.o : cosp_kinds.o cosp_config.o : cosp_kinds.o cosp_errorHandling.o : cosp_kinds.o -cosp_stats.o : cosp_kinds.o cosp_config.o cosp_constants.o -cosp_isccp_interface.o : cosp_kinds.o icarus.o -icarus.o : cosp_kinds.o cosp_constants.o cosp_stats.o -cosp_misr_interface.o : cosp_kinds.o +cosp_isccp_interface.o : cosp_kinds.o icarus.o cosp_stats.o +icarus.o : cosp_kinds.o cosp_constants.o cosp_stats.o +cosp_misr_interface.o : cosp_kinds.o cosp_stats.o MISR_simulator.o : cosp_kinds.o cosp_config.o cosp_stats.o -cosp_modis_interface.o : cosp_kinds.o cosp_config.o modis_simulator.o +cosp_modis_interface.o : cosp_kinds.o cosp_config.o modis_simulator.o cosp_stats.o modis_simulator.o : cosp_kinds.o cosp_config.o cosp_stats.o -cosp_parasol_interface.o : cosp_kinds.o +cosp_parasol_interface.o : cosp_kinds.o cosp_stats.o parasol.o : cosp_kinds.o cosp_config.o cosp_constants.o -cosp_calipso_interface.o : cosp_kinds.o lidar_simulator.o +cosp_calipso_interface.o : cosp_kinds.o lidar_simulator.o cosp_stats.o lidar_simulator.o : cosp_kinds.o cosp_config.o cosp_stats.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_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 quickbeam.o : cosp_kinds.o cosp_stats.o -cosp_rttov_interfaceSTUB.o : cosp_kinds.o cosp_config.o cosp_rttovSTUB.o + +# RTTOV Simulator code dependencies (only one interface and one RTTOV simulator are used at a time) +cosp_rttov_interface_v13.o : cosp_kinds.o cosp_config.o cosp_rttov_v13.o cosp_rttov_util.o +cosp_rttov_v13.o : cosp_kinds.o cosp_config.o cosp_constants.o +cosp_rttov_interfaceSTUB.o : cosp_kinds.o cosp_config.o cosp_rttovSTUB.o cosp_rttov_utilSTUB.o cosp_rttovSTUB.o : cosp_kinds.o cosp_config.o cosp_constants.o +# RTTOV utility code dependencies +cosp_rttov_util.o : cosp_kinds.o +cosp_rttov_utilSTUB.o : cosp_kinds.o + # Example subcolumn generaton and mapping to optical properties, following COSP 1.4 SUBCOL_OBJS = mo_rng.o scops.o prec_scops.o cosp_utils.o cosp_optics.o quickbeam_optics.o array_lib.o math_lib.o mrgrnk.o optics_lib.o cosp_errorHandling.o libsubcol.a: $(SUBCOL_OBJS) libcosp.a ar -rvs libsubcol.a $(SUBCOL_OBJS) + array_lib.o : cosp_kinds.o mrgrnk.o : cosp_kinds.o math_lib.o : cosp_kinds.o cosp_errorHandling.o optics_lib.o : cosp_kinds.o cosp_errorHandling.o -quickbeam_optics.o: cosp_kinds.o cosp_errorHandling.o cosp_constants.o cosp_config.o mrgrnk.o array_lib.o optics_lib.o math_lib.o quickbeam.o +quickbeam_optics.o: cosp_kinds.o cosp_errorHandling.o cosp_constants.o cosp_config.o mrgrnk.o array_lib.o optics_lib.o math_lib.o quickbeam.o cosp_stats.o scops.o : cosp_kinds.o cosp_errorHandling.o mo_rng.o prec_scops.o : cosp_kinds.o cosp_config.o cosp_utils.o : cosp_kinds.o cosp_config.o diff --git a/build/Makefile.rttov b/build/Makefile.rttov new file mode 100644 index 0000000000..7a5a22da2b --- /dev/null +++ b/build/Makefile.rttov @@ -0,0 +1,103 @@ +# Makefile specifics for linking with RTTOV. +# From src/test/Makefile_examples +# ----------------------------------------------------------------------------- + +# You must update the following variables below according to the local RTTOV installation and compiler + +# RTTOV_VERSION RTTOV version number +# RTTOVDIR root directory for RTTOV binaries, libraries, modules, includes + +# FC compiler command name +# FFLAGS compiler specific flags: -I$(RTTOVDIR)/mod -I$(RTTOVDIR)/include are mandatory +# LDFLAGS_ARCH flags for linker + +# BINDIR directory to store the binary file + +# If RTTOV was compiled against the HDF5 or external LAPACK libraries this is +# handled automatically using the contents of Makefile.local. + +# ----------------------------------------------------------------------------- + + +# RTTOVDIR=../../ +# Cheyenne version (with HDF5) +# RTTOVDIR=/glade/u/home/jonahshaw/w/RTTOV + +# Derecho version (without HDF5). Note: You need a copy of Makefile.local in the RTTOVDIR directory in a build/ subdirectory +#RTTOVDIR=/glade/u/home/jonahshaw/w/RTTOV/alt_build + +#FC=gfortran +#FFLAGS= -I$(RTTOVDIR)/mod -I$(RTTOVDIR)/include -fPIC -O3 -fopenmp -ffree-line-length-none +#FFLAGS= -I$(RTTOVDIR)/mod -I$(RTTOVDIR)/include -fPIC -O3 -fopenmp +#LDFLAGS_ARCH=-fopenmp + +# Original Derecho settings +#RTTOVDIR=/glade/u/home/jonahshaw/w/RTTOV/alt_build +#FC=gfortran +#FFLAGS= -I$(RTTOVDIR)/mod -I$(RTTOVDIR)/include -fPIC -O3 -fopenmp +#LDFLAGS_ARCH=-fopenmp + +# Derecho with debug changes (01/23/2024) +# RTTOVDIR=/glade/u/home/jonahshaw/w/RTTOV2 +# Derecho with HDF +RTTOVDIR=/glade/u/home/jonahshaw/w/RTTOV2/hdf_build +FC=ifort +FFLAGS= -I$(RTTOVDIR)/mod -I$(RTTOVDIR)/include -fPIC -O3 -fopenmp +LDFLAGS_ARCH=-fopenmp + +RTTOV_VERSION=13 +EXT_BIN=.exe +EXT_OBJ=.o +EXT_LIB=.a +OBJDIR=$(RTTOVDIR)/obj +BINDIR=$(RTTOVDIR)/bin + + +#### Do not edit beyond this line #### + +# JKS - Include settings used to build RTTOV +include $(RTTOVDIR)/build/Makefile.local + +LIBDIR=$(RTTOVDIR)/lib + +# JKS this if statement depends on the contents of Makefile.local +# but it doesn't seem to do anything. +ifdef LDFLAGS_HDF5 + LIBS=\ + $(LIBDIR)/librttov$(RTTOV_VERSION)_brdf_atlas$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_emis_atlas$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_mw_scatt$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_other$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_coef_io$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_hdf$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_parallel$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_main$(EXT_LIB) + + LLIBS=-L$(LIBDIR) \ + -lrttov$(RTTOV_VERSION)_brdf_atlas \ + -lrttov$(RTTOV_VERSION)_emis_atlas \ + -lrttov$(RTTOV_VERSION)_mw_scatt \ + -lrttov$(RTTOV_VERSION)_other \ + -lrttov$(RTTOV_VERSION)_coef_io \ + -lrttov$(RTTOV_VERSION)_hdf \ + -lrttov$(RTTOV_VERSION)_parallel \ + -lrttov$(RTTOV_VERSION)_main +else + LIBS=\ + $(LIBDIR)/librttov$(RTTOV_VERSION)_brdf_atlas$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_emis_atlas$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_mw_scatt$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_other$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_coef_io$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_parallel$(EXT_LIB) \ + $(LIBDIR)/librttov$(RTTOV_VERSION)_main$(EXT_LIB) + + LLIBS=-L$(LIBDIR) \ + -lrttov$(RTTOV_VERSION)_brdf_atlas \ + -lrttov$(RTTOV_VERSION)_emis_atlas \ + -lrttov$(RTTOV_VERSION)_mw_scatt \ + -lrttov$(RTTOV_VERSION)_other \ + -lrttov$(RTTOV_VERSION)_coef_io \ + -lrttov$(RTTOV_VERSION)_parallel \ + -lrttov$(RTTOV_VERSION)_main +endif diff --git a/driver/run/cosp2_input_nl.txt b/driver/run/cosp2_input_nl.txt index 65a16fc44d..3520ac6a55 100644 --- a/driver/run/cosp2_input_nl.txt +++ b/driver/run/cosp2_input_nl.txt @@ -82,15 +82,7 @@ !---------------------------------------------------------------------------------- !-------------- RTTOV inputs !---------------------------------------------------------------------------------- - rttov_Platform=1, ! satellite platform - rttov_Satellite=15, ! satellite - rttov_Instrument=5, ! instrument - rttov_Nchannels=3, ! Number of channels to be computed - rttov_Channels=1,2,3, ! Channel numbers (please be sure that you supply Nchannels) - rttov_Surfem=0.0,0.0,0.0, ! Surface emissivity (please be sure that you supply Nchannels) - rttov_ZenAng=50.0, ! Satellite Zenith Angle - CO2=5.241e-04, ! Mixing ratios of trace gases - CH4=9.139e-07, - N2O=4.665e-07, - CO=2.098e-07 +! rttov_Ninstruments=1, +! rttov_instrument_namelists='instrument_nls/cosp2_rttov_inst1.txt', + rttov_verbose=.false. / diff --git a/driver/run/cosp2_input_nl.um_global.txt b/driver/run/cosp2_input_nl.um_global.txt index 44c57f9226..1e5f011289 100644 --- a/driver/run/cosp2_input_nl.um_global.txt +++ b/driver/run/cosp2_input_nl.um_global.txt @@ -82,15 +82,7 @@ !---------------------------------------------------------------------------------- !-------------- RTTOV inputs !---------------------------------------------------------------------------------- - rttov_Platform=1, ! satellite platform - rttov_Satellite=15, ! satellite - rttov_Instrument=5, ! instrument - rttov_Nchannels=3, ! Number of channels to be computed - rttov_Channels=1,2,3, ! Channel numbers (please be sure that you supply Nchannels) - rttov_Surfem=0.0,0.0,0.0, ! Surface emissivity (please be sure that you supply Nchannels) - rttov_ZenAng=50.0, ! Satellite Zenith Angle - CO2=5.241e-04, ! Mixing ratios of trace gases - CH4=9.139e-07, - N2O=4.665e-07, - CO=2.098e-07 +! rttov_Ninstruments=1, +! rttov_instrument_namelists='instrument_nls/cosp2_rttov_inst1.txt', + rttov_verbose=.false. / diff --git a/driver/run/cosp2_input_nl.um_global_model_levels.txt b/driver/run/cosp2_input_nl.um_global_model_levels.txt index 72e968372e..4e917c55a9 100644 --- a/driver/run/cosp2_input_nl.um_global_model_levels.txt +++ b/driver/run/cosp2_input_nl.um_global_model_levels.txt @@ -82,15 +82,7 @@ !---------------------------------------------------------------------------------- !-------------- RTTOV inputs !---------------------------------------------------------------------------------- - rttov_Platform=1, ! satellite platform - rttov_Satellite=15, ! satellite - rttov_Instrument=5, ! instrument - rttov_Nchannels=3, ! Number of channels to be computed - rttov_Channels=1,2,3, ! Channel numbers (please be sure that you supply Nchannels) - rttov_Surfem=0.0,0.0,0.0, ! Surface emissivity (please be sure that you supply Nchannels) - rttov_ZenAng=50.0, ! Satellite Zenith Angle - CO2=5.241e-04, ! Mixing ratios of trace gases - CH4=9.139e-07, - N2O=4.665e-07, - CO=2.098e-07 +! rttov_Ninstruments=1, +! rttov_instrument_namelists='instrument_nls/cosp2_rttov_inst1.txt', + rttov_verbose=.false. / diff --git a/driver/run/cosp2_output_nl.txt b/driver/run/cosp2_output_nl.txt index 7f39228c71..4c61520a2f 100755 --- a/driver/run/cosp2_output_nl.txt +++ b/driver/run/cosp2_output_nl.txt @@ -132,8 +132,6 @@ Llwpmodis=.true., Liwpmodis=.true., Lclmodis=.true., - !- RTTOV - Ltbrttov=.false., ! -CLOUDSAT precipitation frequency/occurence diagnostics Lptradarflag0=.true., Lptradarflag1=.true., diff --git a/driver/run/cosp2_output_nl.um_global_model_levels.txt b/driver/run/cosp2_output_nl.um_global_model_levels.txt index ce8ab5a60e..a4ad7743dc 100755 --- a/driver/run/cosp2_output_nl.um_global_model_levels.txt +++ b/driver/run/cosp2_output_nl.um_global_model_levels.txt @@ -132,8 +132,6 @@ Llwpmodis=.true., Liwpmodis=.true., Lclmodis=.true., - !- RTTOV - Ltbrttov=.false., ! -CLOUDSAT precipitation frequency/occurence diagnostics Lptradarflag0=.false., Lptradarflag1=.false., diff --git a/driver/run/cosp2_swath_input_nl.um_global.txt b/driver/run/cosp2_swath_input_nl.um_global.txt new file mode 100644 index 0000000000..a833fa6312 --- /dev/null +++ b/driver/run/cosp2_swath_input_nl.um_global.txt @@ -0,0 +1,109 @@ +! (c) British Crown Copyright 2008, the Met Office. +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are permitted +! provided that the following conditions are met: +! +! * Redistributions of source code must retain the above copyright notice, this list +! of conditions and the following disclaimer. +! * Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other materials +! provided with the distribution. +! * Neither the name of the Met Office nor the names of its contributors may be used +! to endorse or promote products derived from this software without specific prior written +! permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR +! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR +! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER +! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + +! Namelist that sets up the main COSP options +&COSP_INPUT + NPOINTS=1728, ! 1728,6912 + NPOINTS_IT=1000,! Max number of gridpoints to be processed in one iteration + NCOLUMNS=20, ! Number of subcolumns + NLEVELS=54, ! Number of model levels + USE_VGRID=.true., ! Use fixed vertical grid for outputs? (if .true. then you need to define number of levels with Nlr) + NLVGRID=40, ! Number of levels in statistical outputs (only used if USE_VGRID=.true.) + CSAT_VGRID=.true., ! CloudSat vertical grid? (if .true. then the CloudSat standard grid is used for the outputs. + ! USE_VGRID needs also be .true.) + DINPUT='./', ! Directory where the input files are located. Useful when processing multiple files. + ! Leave blank ('') if you are using the full path in FINPUT. + FINPUT='../data/inputs/UKMO/cosp_input.um_global.nc', ! List input NetCDF files + FOUTPUT='../data/outputs/UKMO/cosp2_swath_output.um_global.nc', + !---------------------------------------------------------------------------------- + !--------------- Inputs related to radar simulations + !---------------------------------------------------------------------------------- + cloudsat_RADAR_FREQ=94.0, ! CloudSat radar frequency (GHz) + SURFACE_RADAR=0, ! surface=1, spaceborne=0 + cloudsat_use_gas_abs=1, ! include gaseous absorption? yes=1,no=0 + cloudsat_do_ray=0, ! calculate/output Rayleigh refl=1, not=0 + cloudsat_k2=-1, ! |K|^2, -1=use frequency dependent default + use_precipitation_fluxes=.true., ! True if precipitation fluxes are input to the algorithm + cloudsat_micro_scheme='MMF_v3_single_moment', !'MMF_v3.5_two_moment' + !---------------------------------------------------------------------------------- + !---------------- Inputs related to lidar simulations + !---------------------------------------------------------------------------------- + lidar_ice_type=0, ! Ice particle shape in lidar calculations (0=ice-spheres ; 1=ice-non-spherical) + OVERLAP=3, ! overlap assumption used by scops: 1=max, 2=rand, 3=max/rand + !---------------------------------------------------------------------------------- + !---------------- Inputs related to ISCCP simulator + !---------------------------------------------------------------------------------- + ISCCP_TOPHEIGHT=1, ! 1 = adjust top height using both a computed + ! infrared brightness temperature and the visible + ! optical depth to adjust cloud top pressure. Note + ! that this calculation is most appropriate to compare + ! to ISCCP data during sunlit hours. + ! 2 = do not adjust top height, that is cloud top + ! pressure is the actual cloud top pressure + ! in the model + ! 3 = adjust top height using only the computed + ! infrared brightness temperature. Note that this + ! calculation is most appropriate to compare to ISCCP + ! IR only algortihm (i.e. you can compare to nighttime + ! ISCCP data with this option) + ISCCP_TOPHEIGHT_DIRECTION=2, ! direction for finding atmosphere pressure level + ! with interpolated temperature equal to the radiance + ! determined cloud-top temperature + ! 1 = find the *lowest* altitude (highest pressure) level + ! with interpolated temperature equal to the radiance + ! determined cloud-top temperature + ! 2 = find the *highest* altitude (lowest pressure) level + ! with interpolated temperature equal to the radiance + ! determined cloud-top temperature. This is the + ! default value since V4.0 of the ISCCP simulator. + ! ONLY APPLICABLE IF top_height EQUALS 1 or 3 + !---------------------------------------------------------------------------------- + !-------------- Swathing inputs + !---------------------------------------------------------------------------------- + N_SWATHS_ISCCP=2, + SWATH_LOCALTIMES_ISCCP=5.25,18.0, + SWATH_WIDTHS_ISCCP=2000,2000, + N_SWATHS_MISR=2, + SWATH_LOCALTIMES_MISR=6.5,18.25, + SWATH_WIDTHS_MISR=2000,2000, + N_SWATHS_MODIS=2, + SWATH_LOCALTIMES_MODIS=5.75,13.5, + SWATH_WIDTHS_MODIS=2000,2000, + N_SWATHS_CSCAL=2, + SWATH_LOCALTIMES_CSCAL=6.75,19.25, + SWATH_WIDTHS_CSCAL=2000,2000, + N_SWATHS_PARASOL=2, + SWATH_LOCALTIMES_PARASOL=6.75,19, + SWATH_WIDTHS_PARASOL=2000,2000, + N_SWATHS_ATLID=2, + SWATH_LOCALTIMES_ATLID=7.25,19.5, + SWATH_WIDTHS_ATLID=2000,2000, + !---------------------------------------------------------------------------------- + !-------------- RTTOV inputs + !---------------------------------------------------------------------------------- +! rttov_Ninstruments=1, +! rttov_instrument_namelists='instrument_nls/cosp2_rttov_inst1.txt', + rttov_verbose=.false. +/ diff --git a/driver/src/cosp2_io.f90 b/driver/src/cosp2_io.f90 index 4931d7c395..9ca8f1cc47 100644 --- a/driver/src/cosp2_io.f90 +++ b/driver/src/cosp2_io.f90 @@ -17,22 +17,27 @@ module mod_cosp_io !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE write_cosp2_output !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - subroutine write_cosp2_output(Npoints, Ncolumns, Nlevels, lev, lon, lat, cospOUT, outFileName) - integer,intent(in) :: Npoints, Ncolumns, Nlevels + subroutine write_cosp2_output(Npoints, Ncolumns, Nlevels, Ninst_rttov, lev, lon, lat, cospOUT, outFileName) + integer,intent(in) :: Npoints, Ncolumns, Nlevels, Ninst_rttov real(wp),dimension(Npoints),intent(in) :: lon,lat real(wp),dimension(Nlevels),intent(in) :: lev type(cosp_outputs),intent(in) :: cospOUT character(len=256),intent(in) :: outFileName - integer :: fileID,status,ij - integer,dimension(20) :: dimID - integer,dimension(150) :: varID + integer :: fileID,status,ij,i,ii + integer,dimension(50) :: dimID + integer,dimension(250) :: varID integer,dimension(Npoints) :: loc integer,dimension(Ncolumns) :: cosp_scol integer,dimension(2) :: bnds + character(len=8) :: & + fmt, & ! format descriptor for flexible RTTOV output + i_str + loc=(/(ij,ij=1,Npoints)/) cosp_scol=(/(ij,ij=1,Ncolumns)/) bnds=(/(ij,ij=1,2)/) + fmt = '(I3.3)' ! an integer of width 3 with zeros at the left ! --------------------------------------------------------------------------------------- ! Create output file. @@ -79,9 +84,18 @@ subroutine write_cosp2_output(Npoints, Ncolumns, Nlevels, lev, lon, lat, cospOUT if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) status = nf90_def_dim(fileID,"CFODD_NICOD",CFODD_NICOD,dimID(18)) if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) - + + ! Define instrument channel indices for multiple RTTOV instruments + if (allocated(cospOUT%rttov_outputs)) then + do i=1,Ninst_rttov + write (i_str,fmt) i ! converting integer to string i_str using a 'internal file' + status = nf90_def_dim(fileID,"RTTOV_CHAN_INST"//trim(i_str),cospOUT % rttov_outputs(i) % nchan_out,dimID(20+i)) ! Start at 100 for RTTOV output channel dimensions + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + end do + end if + ! --------------------------------------------------------------------------------------- - ! Define varaibles + ! Define variables ! --------------------------------------------------------------------------------------- ! Longitude status = nf90_def_var(fileID,"longitude", nf90_float, (/dimID(1)/),varID(1)) @@ -1417,6 +1431,129 @@ subroutine write_cosp2_output(Npoints, Ncolumns, Nlevels, lev, lon, lat, cospOUT if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) endif + + ! --------------------------------------------------------------------------------------- + ! RTTOV - JKS + ! --------------------------------------------------------------------------------------- + + ! Define instrument channel indices for multiple RTTOV instruments + ii = 165 ! RTTOV variable indices start at 165 + if (allocated(cospOUT%rttov_outputs)) then + do i=1,Ninst_rttov + write (i_str,fmt) i ! converting integer to string i_str using a 'internal file' + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) then + ii = ii + 1 + status = nf90_def_var(fileID,"RTTOV_CHAN_INST"//trim(i_str),nf90_float, (/dimID(20+i)/),varID(ii)) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"long_name","RTTOV Channel Indices") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"units", "1") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"standard_name", "rttov_ichan") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%bt_total)) then + ii = ii + 1 + status = nf90_def_var(fileID,"rttov_bt_total_inst"//trim(i_str),nf90_float, (/dimID(1),dimID(20+i)/),varID(ii)) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"long_name","RTTOV All-sky Brightness Temperature") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"units", "Degrees Kelvin") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"standard_name", "rttov_allsky_bt") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) then + ii = ii + 1 + status = nf90_def_var(fileID,"rttov_bt_clear_inst"//trim(i_str),nf90_float, (/dimID(1),dimID(20+i)/),varID(ii)) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"long_name","RTTOV Clear-sky Brightness Temperature") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"units", "Degrees Kelvin") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"standard_name", "rttov_clearsky_bt") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%rad_total)) then + ii = ii + 1 + status = nf90_def_var(fileID,"rttov_rad_total_inst"//trim(i_str),nf90_float, (/dimID(1),dimID(20+i)/),varID(ii)) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"long_name","RTTOV All-sky Radiance") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"units", "mW/cm-1/sr/m2") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"standard_name", "rttov_allsky_rad") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) then + ii = ii + 1 + status = nf90_def_var(fileID,"rttov_rad_clear_inst"//trim(i_str),nf90_float, (/dimID(1),dimID(20+i)/),varID(ii)) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"long_name","RTTOV Clear-sky Radiance") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"units", "mW/cm-1/sr/m2") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"standard_name", "rttov_clearsky_rad") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) then + ii = ii + 1 + status = nf90_def_var(fileID,"rttov_rad_cloudy_inst"//trim(i_str),nf90_float, (/dimID(1),dimID(20+i)/),varID(ii)) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"long_name","RTTOV Cloudy-sky Radiance") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"units", "mW/cm-1/sr/m2") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"standard_name", "rttov_cloudysky_rad") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%refl_total)) then + ii = ii + 1 + status = nf90_def_var(fileID,"rttov_refl_total_inst"//trim(i_str),nf90_float, (/dimID(1),dimID(20+i)/),varID(ii)) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"long_name","RTTOV All-sky Reflectance") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"units", "unitless") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"standard_name", "bleh") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) then + ii = ii + 1 + status = nf90_def_var(fileID,"rttov_refl_clear_inst"//trim(i_str),nf90_float, (/dimID(1),dimID(20+i)/),varID(ii)) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"long_name","RTTOV Clear-sky Reflectance") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"units", "unitless") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"standard_name", "rttov_allsky_refl") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) then + ii = ii + 1 + status = nf90_def_var(fileID,"rttov_bt_clear_pc_inst"//trim(i_str),nf90_float, (/dimID(1),dimID(20+i)/),varID(ii)) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"long_name","PC-RTTOV Clear-sky Brightness Temperature") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"units", "Degrees Kelvin") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"standard_name", "pcrttov_clearsky_bt") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) then + ii = ii + 1 + status = nf90_def_var(fileID,"rttov_rad_clear_pc_inst"//trim(i_str),nf90_float, (/dimID(1),dimID(20+i)/),varID(ii)) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"long_name","PC-RTTOV Clear-sky Radiance") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"units", "mW/cm-1/sr/m2") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + status = nf90_put_att(fileID,varID(ii),"standard_name", "pcrttov_clearsky_rad") + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + end do + end if + ! --------------------------------------------------------------------------------------- ! Exit define mode ! --------------------------------------------------------------------------------------- @@ -1893,7 +2030,64 @@ subroutine write_cosp2_output(Npoints, Ncolumns, Nlevels, lev, lon, lat, cospOUT status = nf90_put_var(fileID,varID(147),CFODD_HISTICODcenters) if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) endif - + + ! Define instrument channel indices for multiple RTTOV instruments + ii = 165 ! RTTOV variable indices start at 166 + if (allocated(cospOUT%rttov_outputs)) then + do i=1,Ninst_rttov + write (i_str,fmt) i ! converting integer to string i_str using a 'internal file' + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) then + ii = ii + 1 + status = nf90_put_var(fileID,varID(ii),cospOUT%rttov_outputs(i)%channel_indices) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%bt_total)) then + ii = ii + 1 + status = nf90_put_var(fileID,varID(ii),cospOUT%rttov_outputs(i)%bt_total) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) then + ii = ii + 1 + status = nf90_put_var(fileID,varID(ii),cospOUT%rttov_outputs(i)%bt_clear) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%rad_total)) then + ii = ii + 1 + status = nf90_put_var(fileID,varID(ii),cospOUT%rttov_outputs(i)%rad_total) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) then + ii = ii + 1 + status = nf90_put_var(fileID,varID(ii),cospOUT%rttov_outputs(i)%rad_clear) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) then + ii = ii + 1 + status = nf90_put_var(fileID,varID(ii),cospOUT%rttov_outputs(i)%rad_cloudy) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%refl_total)) then + ii = ii + 1 + status = nf90_put_var(fileID,varID(ii),cospOUT%rttov_outputs(i)%refl_total) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) then + ii = ii + 1 + status = nf90_put_var(fileID,varID(ii),cospOUT%rttov_outputs(i)%refl_clear) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) then + ii = ii + 1 + status = nf90_put_var(fileID,varID(ii),cospOUT%rttov_outputs(i)%bt_total_pc) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) then + ii = ii + 1 + status = nf90_put_var(fileID,varID(ii),cospOUT%rttov_outputs(i)%rad_total_pc) + if (status .ne. nf90_NoERR) print*,trim(nf90_strerror(status)) + endif + end do + end if ! Close file status = nf90_close(fileID) @@ -1942,8 +2136,9 @@ end subroutine write_cosp2_output SUBROUTINE NC_READ_INPUT_FILE(fname,Npnts,Nl,Nhydro,lon,lat,p,ph,z,zh,T,qv,rh,tca,cca, & mr_lsliq,mr_lsice,mr_ccliq,mr_ccice,fl_lsrain,fl_lssnow, & fl_lsgrpl,fl_ccrain,fl_ccsnow,Reff,dtau_s,dtau_c,dem_s, & - dem_c,skt,landmask,mr_ozone,u_wind,v_wind,sunlit, & - emsfc_lw,mode,Nlon,Nlat,surfelev) + dem_c,skt,psfc,landmask,mr_ozone,u_wind,v_wind,sunlit, & + emsfc_lw,mode,Nlon,Nlat,surfelev,year,month,day, & + hour,minute,seconds) ! Arguments character(len=512),intent(in) :: fname ! File name @@ -1953,7 +2148,8 @@ SUBROUTINE NC_READ_INPUT_FILE(fname,Npnts,Nl,Nhydro,lon,lat,p,ph,z,zh,T,qv,rh,tc mr_lsliq,mr_lsice,mr_ccliq,mr_ccice,fl_lsrain,fl_lssnow,fl_lsgrpl, & fl_ccrain,fl_ccsnow,dtau_s,dtau_c,dem_s,dem_c,mr_ozone real(wp),dimension(Npnts,Nl,Nhydro),intent(out) :: Reff - real(wp),dimension(Npnts),intent(out) :: skt,landmask,u_wind,v_wind,sunlit,surfelev + real(wp),dimension(Npnts),intent(out) :: skt,psfc,landmask,u_wind,v_wind,sunlit,surfelev, & + year,month,day,hour,minute,seconds real(wp),intent(out) :: emsfc_lw integer,intent(out) :: mode,Nlon,Nlat @@ -2264,6 +2460,12 @@ SUBROUTINE NC_READ_INPUT_FILE(fname,Npnts,Nl,Nhydro,lon,lat,p,ph,z,zh,T,qv,rh,tc else call map_ll_to_point(Na,Nb,Npoints,x2=x2,y1=skt) endif + case ('psfc') + if (Lpoint) then + psfc(1:Npoints) = x1(1:Npoints) + else + call map_ll_to_point(Na,Nb,Npoints,x2=x2,y1=psfc) + endif case ('orography') if (Lpoint) then surfelev(1:Npoints) = x1(1:Npoints) @@ -2300,6 +2502,42 @@ SUBROUTINE NC_READ_INPUT_FILE(fname,Npnts,Nl,Nhydro,lon,lat,p,ph,z,zh,T,qv,rh,tc else call map_ll_to_point(Na,Nb,Npoints,x2=x2,y1=sunlit) endif + case ('year') + if (Lpoint) then + year(1:Npoints) = x1(1:Npoints) + else + call map_ll_to_point(Na,Nb,Npoints,x2=x2,y1=year) + endif + case ('month') + if (Lpoint) then + month(1:Npoints) = x1(1:Npoints) + else + call map_ll_to_point(Na,Nb,Npoints,x2=x2,y1=month) + endif + case ('day') + if (Lpoint) then + day(1:Npoints) = x1(1:Npoints) + else + call map_ll_to_point(Na,Nb,Npoints,x2=x2,y1=day) + endif + case ('hour') + if (Lpoint) then + hour(1:Npoints) = x1(1:Npoints) + else + call map_ll_to_point(Na,Nb,Npoints,x2=x2,y1=hour) + endif + case ('minute') + if (Lpoint) then + minute(1:Npoints) = x1(1:Npoints) + else + call map_ll_to_point(Na,Nb,Npoints,x2=x2,y1=minute) + endif + case ('second') + if (Lpoint) then + seconds(1:Npoints) = x1(1:Npoints) + else + call map_ll_to_point(Na,Nb,Npoints,x2=x2,y1=seconds) + endif end select ! Free memory if (vrank == 1) deallocate(x1) diff --git a/driver/src/cosp2_test.f90 b/driver/src/cosp2_test.F90 similarity index 79% rename from driver/src/cosp2_test.f90 rename to driver/src/cosp2_test.F90 index cb29cc1b9f..3f04be1722 100755 --- a/driver/src/cosp2_test.f90 +++ b/driver/src/cosp2_test.F90 @@ -31,11 +31,12 @@ ! April 2018 - R. Guzman - Added OPAQ diagnostics and Ground LIDar (GLID) simulator ! April 2018 - R. Guzman - Added ATLID simulator ! Nov 2018 - T. Michibata - Added CloudSat+MODIS Warmrain Diagnostics +! June 2025 - J.K. Shaw - Added COSP-RTTOV integration and swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% program cosp2_test use cosp_kinds, only: wp USE MOD_COSP_CONFIG, ONLY: R_UNDEF,PARASOL_NREFL,LIDAR_NCAT,LIDAR_NTYPE,SR_BINS, & - N_HYDRO,RTTOV_MAX_CHANNELS,numMISRHgtBins, & + N_HYDRO,numMISRHgtBins, & cloudsat_DBZE_BINS,LIDAR_NTEMP,calipso_histBsct, & CFODD_NDBZE, CFODD_NICOD, & CFODD_BNDRE, CFODD_NCLASS, & @@ -57,40 +58,49 @@ program cosp2_test use mod_cosp_io, only: nc_read_input_file,write_cosp2_output USE mod_quickbeam_optics,only: size_distribution,hydro_class_init,quickbeam_optics, & quickbeam_optics_init,gases - use quickbeam, only: radar_cfg - use mod_cosp, only: cosp_init,cosp_optical_inputs,cosp_column_inputs, & - cosp_outputs,cosp_cleanUp,cosp_simulator + use mod_cosp, only: cosp_init, & + cosp_outputs,swath_inputs,cosp_simulator USE mod_rng, ONLY: rng_state, init_rng USE mod_scops, ONLY: scops USE mod_prec_scops, ONLY: prec_scops USE MOD_COSP_UTILS, ONLY: cosp_precip_mxratio use cosp_optics, ONLY: cosp_simulator_optics,lidar_optics,modis_optics, & modis_optics_partition - use mod_cosp_stats, ONLY: COSP_CHANGE_VERTICAL_GRID + use mod_cosp_stats, ONLY: COSP_CHANGE_VERTICAL_GRID,cosp_optical_inputs, & + cosp_column_inputs,radar_cfg,cosp_cleanUp + use MOD_COSP_RTTOV_UTIL, only: rttov_cfg implicit none ! Input/Output driver file control - character(len=64) :: cosp_input_namelist - character(len=64) :: cosp_output_namelist = 'cosp2_output_nl.txt' + character(len=256) :: cosp_input_namelist + character(len=64) :: cosp_output_namelist = 'cosp2_output_nl.txt' ! Test data integer :: & Nlon,Nlat,geomode real(wp) :: & emsfc_lw - real(wp),dimension(:),allocatable,target:: & + real(wp),dimension(:),allocatable,target :: & lon, & ! Longitude (deg) lat, & ! Latitude (deg) skt, & ! Skin temperature (K) + psfc, & ! Surface Pressure (Pa) surfelev, & ! Surface Elevation (m) landmask, & ! Land/sea mask (0/1) u_wind, & ! U-component of wind (m/s) v_wind, & ! V-component of wind (m/s) - sunlit ! Sunlit flag + sunlit ! Sunlit flag + real(wp),dimension(:),allocatable :: & + year, & ! Year (CE) + month, & ! Month [1,12] + day, & ! Day [1,31] + hour, & ! Hour [0,24] + minute, & ! Minute [0,60] + seconds ! Second [0,60] real(wp),dimension(:,:),allocatable,target :: & p, & ! Model pressure levels (pa) - ph, & ! Moddel pressure @ half levels (pa) + ph, & ! Model pressure @ half levels (pa) zlev, & ! Model level height (m) zlev_half, & ! Model level height @ half-levels (m) T, & ! Temperature (K) @@ -132,29 +142,15 @@ program cosp2_test ! (0=ice-spheres/1=ice-non-spherical) overlap, & ! Overlap type: 1=max, 2=rand, 3=max/rand isccp_topheight, & ! ISCCP cloud top height - isccp_topheight_direction, & ! ISCCP cloud top height direction - rttov_platform, & ! RTTOV: Satellite platform - rttov_satellite, & ! RTTOV: Satellite - rttov_instrument, & ! RTTOV: Instrument - rttov_Nchannels ! RTTOV: Number of channels to be computed + isccp_topheight_direction ! ISCCP cloud top height direction real(wp) :: & ! cloudsat_radar_freq, & ! CloudSat radar frequency (GHz) - cloudsat_k2, & ! |K|^2, -1=use frequency dependent default - rttov_ZenAng, & ! RTTOV: Satellite Zenith Angle - co2, & ! CO2 mixing ratio - ch4, & ! CH4 mixing ratio - n2o, & ! n2o mixing ratio - co ! co mixing ratio + cloudsat_k2 ! |K|^2, -1=use frequency dependent default logical :: & ! use_vgrid, & ! Use fixed vertical grid for outputs? csat_vgrid, & ! CloudSat vertical grid? use_precipitation_fluxes ! True if precipitation fluxes are input to the ! algorithm - - integer,dimension(RTTOV_MAX_CHANNELS) :: & - rttov_Channels ! RTTOV: Channel numbers - real(wp),dimension(RTTOV_MAX_CHANNELS) :: & - rttov_Surfem ! RTTOV: Surface emissivity character(len=64) :: & cloudsat_micro_scheme ! Microphysical scheme used in cloudsat radar simulator character(len=64) :: & @@ -165,12 +161,46 @@ program cosp2_test dinput ! Directory where the input files are located character(len=600) :: & fileIN ! dinput+finput + + ! RTTOV + integer :: rttov_Ninstruments = 0 + character(len=256), dimension(50) :: & ! Arbitrary limit of 50 should be fine. + rttov_instrument_namelists ! Input of paths to RTTOV instrument namelists + character(len=256), allocatable :: & + rttov_instrument_namelists_final(:) ! Array of paths to RTTOV instrument namelists + logical :: rttov_verbose = .false. + + ! 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(wp),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 + namelist/COSP_INPUT/overlap, isccp_topheight, isccp_topheight_direction, npoints, & npoints_it, ncolumns, nlevels, use_vgrid, Nlvgrid, csat_vgrid, dinput, finput, & foutput, cloudsat_radar_freq, surface_radar, cloudsat_use_gas_abs,cloudsat_do_ray,& cloudsat_k2, cloudsat_micro_scheme, lidar_ice_type, use_precipitation_fluxes, & - rttov_platform, rttov_satellite, rttov_Instrument, rttov_Nchannels, & - rttov_Channels, rttov_Surfem, rttov_ZenAng, co2, ch4, n2o, co + rttov_Ninstruments, rttov_instrument_namelists, rttov_verbose, & + 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 ! Output namelist logical :: Lcfaddbze94,Ldbze94,Latb532,LcfadLidarsr532,Lclcalipso,Lclhcalipso, & @@ -191,10 +221,10 @@ program cosp2_test LlidarBetaMol532,Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis,Lclmmodis, & Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis,Ltautlogmodis,Ltauwlogmodis, & Ltauilogmodis,Lreffclwmodis,Lreffclimodis,Lpctmodis,Llwpmodis,Liwpmodis, & - Lclmodis,Ltbrttov,Lptradarflag0,Lptradarflag1,Lptradarflag2,Lptradarflag3, & + Lclmodis,Lptradarflag0,Lptradarflag1,Lptradarflag2,Lptradarflag3, & Lptradarflag4,Lptradarflag5,Lptradarflag6,Lptradarflag7,Lptradarflag8, & Lptradarflag9,Lradarpia, & - Lwr_occfreq, Lcfodd + Lwr_occfreq,Lcfodd namelist/COSP_OUTPUT/Lcfaddbze94,Ldbze94,Latb532,LcfadLidarsr532,Lclcalipso, & Lclhcalipso,Lcllcalipso,Lclmcalipso,Lcltcalipso,LparasolRefl, & Lclcalipsoliq,Lclcalipsoice,Lclcalipsoun,Lclcalipsotmp, & @@ -216,12 +246,11 @@ program cosp2_test LlidarBetaMol532,Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis, & Lclmmodis,Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis, & Ltautlogmodis,Ltauwlogmodis,Ltauilogmodis,Lreffclwmodis, & - Lreffclimodis,Lpctmodis,Llwpmodis,Liwpmodis,Lclmodis,Ltbrttov, & + Lreffclimodis,Lpctmodis,Llwpmodis,Liwpmodis,Lclmodis, & Lptradarflag0,Lptradarflag1,Lptradarflag2,Lptradarflag3, & Lptradarflag4,Lptradarflag5,Lptradarflag6,Lptradarflag7, & Lptradarflag8,Lptradarflag9,Lradarpia, & Lwr_occfreq, Lcfodd - ! Local variables logical :: & lsingle = .true., & ! True if using MMF_v3_single_moment CLOUDSAT microphysical scheme (default) @@ -239,6 +268,8 @@ program cosp2_test sd ! Hydrometeor description type(radar_cfg) :: & rcfg_cloudsat ! Radar configuration + type(rttov_cfg), dimension(:), allocatable, target :: & + rttov_configs type(cosp_outputs) :: & cospOUT ! COSP simulator outputs type(cosp_optical_inputs) :: & @@ -281,6 +312,11 @@ program cosp2_test gamma_2 = (/-1., -1., 6.0, 6.0, -1., -1., 6.0, 6.0, 6.0/),& gamma_3 = (/-1., -1., 2.0, 2.0, -1., -1., 2.0, 2.0, 2.0/),& gamma_4 = (/-1., -1., 6.0, 6.0, -1., -1., 6.0, 6.0, 6.0/) + + ! Swathing DDT array + type(swath_inputs),dimension(6) :: & + cospswathsIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% call cpu_time(driver_time(1)) @@ -294,11 +330,40 @@ program cosp2_test close(10) ! Output namelist (logical flags to turn on/off outputs) - if (command_argument_count() == 2) call get_command_argument(2, cosp_output_namelist) + if (command_argument_count() .ge. 2) call get_command_argument(2, cosp_output_namelist) open(10,file=cosp_output_namelist,status='unknown') read(10,nml=cosp_output) close(10) + + ! Jonah namelist checking area + print*,'rttov_verbose: ',rttov_verbose + print*,'rttov_Ninstruments: ',rttov_Ninstruments + + ! Shift the namelists read in into a shorter array for cosp_init: + allocate(rttov_instrument_namelists_final(rttov_Ninstruments)) + rttov_instrument_namelists_final(:) = rttov_instrument_namelists(1:rttov_Ninstruments) + ! Read orbital swathing inputs into structure: + ! Indexing order is ISCCP, MISR, CLOUDSAT-CALIPSO, ATLID, PARASOL, MODIS + cospswathsIN(1) % N_inst_swaths = N_SWATHS_ISCCP + cospswathsIN(1) % inst_localtimes(1:N_SWATHS_ISCCP) = SWATH_LOCALTIMES_ISCCP(1:N_SWATHS_ISCCP) + cospswathsIN(1) % inst_localtime_widths(1:N_SWATHS_ISCCP) = SWATH_WIDTHS_ISCCP(1:N_SWATHS_ISCCP) + cospswathsIN(2) % N_inst_swaths = N_SWATHS_MISR + cospswathsIN(2) % inst_localtimes(1:N_SWATHS_MISR) = SWATH_LOCALTIMES_MISR(1:N_SWATHS_MISR) + cospswathsIN(2) % inst_localtime_widths(1:N_SWATHS_MISR) = SWATH_WIDTHS_MISR(1:N_SWATHS_MISR) + cospswathsIN(3) % N_inst_swaths = N_SWATHS_CSCAL + cospswathsIN(3) % inst_localtimes(1:N_SWATHS_CSCAL) = SWATH_LOCALTIMES_CSCAL(1:N_SWATHS_CSCAL) + cospswathsIN(3) % inst_localtime_widths(1:N_SWATHS_CSCAL) = SWATH_WIDTHS_CSCAL(1:N_SWATHS_CSCAL) + cospswathsIN(4) % N_inst_swaths = N_SWATHS_ATLID + cospswathsIN(4) % inst_localtimes(1:N_SWATHS_ATLID) = SWATH_LOCALTIMES_ATLID(1:N_SWATHS_ATLID) + cospswathsIN(4) % inst_localtime_widths(1:N_SWATHS_ATLID) = SWATH_WIDTHS_ATLID(1:N_SWATHS_ATLID) + cospswathsIN(5) % N_inst_swaths = N_SWATHS_PARASOL + cospswathsIN(5) % inst_localtimes(1:N_SWATHS_PARASOL) = SWATH_LOCALTIMES_PARASOL(1:N_SWATHS_PARASOL) + cospswathsIN(5) % inst_localtime_widths(1:N_SWATHS_PARASOL) = SWATH_WIDTHS_PARASOL(1:N_SWATHS_PARASOL) + cospswathsIN(6) % N_inst_swaths = N_SWATHS_MODIS + cospswathsIN(6) % inst_localtimes(1:N_SWATHS_MODIS) = SWATH_LOCALTIMES_MODIS(1:N_SWATHS_MODIS) + cospswathsIN(6) % inst_localtime_widths(1:N_SWATHS_MODIS) = SWATH_WIDTHS_MODIS(1:N_SWATHS_MODIS) + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Read in sample input data. !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -311,16 +376,26 @@ program cosp2_test fl_lsgrpl(Npoints,Nlevels),fl_ccrain(Npoints,Nlevels), & fl_ccsnow(Npoints,Nlevels),Reff(Npoints,Nlevels,N_HYDRO), & dtau_s(Npoints,Nlevels),dtau_c(Npoints,Nlevels),dem_s(Npoints,Nlevels), & - dem_c(Npoints,Nlevels),skt(Npoints),landmask(Npoints), & + dem_c(Npoints,Nlevels),skt(Npoints),psfc(Npoints),landmask(Npoints), & mr_ozone(Npoints,Nlevels),u_wind(Npoints),v_wind(Npoints),sunlit(Npoints), & - frac_out(Npoints,Ncolumns,Nlevels),surfelev(Npoints)) + frac_out(Npoints,Ncolumns,Nlevels),surfelev(Npoints),year(Npoints), & + month(Npoints),day(Npoints),hour(Npoints),minute(Npoints),seconds(Npoints)) + + ! Set some fields to masked values if the COSP offline driver outputs are inconsistent + year(:) = R_UNDEF + month(:) = R_UNDEF + day(:) = R_UNDEF + hour(:) = R_UNDEF + minute(:) = R_UNDEF + seconds(:) = R_UNDEF fileIN = trim(dinput)//trim(finput) call nc_read_input_file(fileIN,Npoints,Nlevels,N_HYDRO,lon,lat,p,ph,zlev,zlev_half, & T,sh,rh,tca,cca,mr_lsliq,mr_lsice,mr_ccliq,mr_ccice,fl_lsrain, & fl_lssnow,fl_lsgrpl,fl_ccrain,fl_ccsnow,Reff,dtau_s,dtau_c, & - dem_s,dem_c,skt,landmask,mr_ozone,u_wind,v_wind,sunlit, & - emsfc_lw,geomode,Nlon,Nlat,surfelev) + dem_s,dem_c,skt,psfc,landmask,mr_ozone,u_wind,v_wind,sunlit, & + emsfc_lw,geomode,Nlon,Nlat,surfelev,year,month,day,hour, & + minute,seconds) call cpu_time(driver_time(2)) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -347,7 +422,7 @@ program cosp2_test Lclthinmeanzse .or. Lclzopaquecalipsose) Lcalipso = .true. if (LlidarBetaMol532gr .or. LcfadLidarsr532gr .or. Latb532gr .or. LclgrLidar532 .or. & - LclhgrLidar532 .or. LcllgrLidar532 .or. LclmgrLidar532 .or. LcltgrLidar532) & + LclhgrLidar532 .or. LcllgrLidar532 .or. LclmgrLidar532 .or. LcltgrLidar532) & LgrLidar532 = .true. if (LlidarBetaMol355 .or. LcfadLidarsr355 .or. Latb355 .or. Lclatlid .or. & @@ -361,8 +436,9 @@ program cosp2_test Lptradarflag6 .or. Lptradarflag7 .or. Lptradarflag8 .or. Lptradarflag9 .or. & Lradarpia) Lcloudsat = .true. if (Lparasolrefl) Lparasol = .true. - if (Ltbrttov) Lrttov = .true. + if (rttov_Ninstruments .gt. 0) Lrttov = .true. + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -393,9 +469,11 @@ program cosp2_test Lparasol, Lrttov, & cloudsat_radar_freq, cloudsat_k2, cloudsat_use_gas_abs, & cloudsat_do_ray, isccp_topheight, isccp_topheight_direction, surface_radar, & - rcfg_cloudsat, use_vgrid, csat_vgrid, Nlvgrid, Nlevels, cloudsat_micro_scheme) + rcfg_cloudsat, use_vgrid, csat_vgrid, Nlvgrid, Nlevels, cloudsat_micro_scheme, & + rttov_Ninstruments, rttov_instrument_namelists_final, rttov_configs, & + debug=rttov_verbose) call cpu_time(driver_time(3)) - + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Construct output derived type. ! *NOTE* The "construct/destroy" subroutines are local to this module and should be @@ -420,21 +498,27 @@ program cosp2_test Lclcalipsoopacity, Lclopaquetemp, Lclthintemp, Lclzopaquetemp, Lclopaquemeanz, & Lclthinmeanz, Lclthinemis, Lclopaquemeanzse, Lclthinmeanzse, Lclzopaquecalipsose, & LcfadDbze94, Ldbze94, Lparasolrefl, & - Ltbrttov, Lptradarflag0,Lptradarflag1,Lptradarflag2,Lptradarflag3,Lptradarflag4, & + Lptradarflag0,Lptradarflag1,Lptradarflag2,Lptradarflag3,Lptradarflag4, & Lptradarflag5,Lptradarflag6,Lptradarflag7,Lptradarflag8,Lptradarflag9,Lradarpia, & Lwr_occfreq, Lcfodd, & - Npoints, Ncolumns, Nlevels, Nlvgrid_local, rttov_Nchannels, use_vgrid, cospOUT) + rttov_Ninstruments,rttov_configs, & + Npoints, Ncolumns, Nlevels, Nlvgrid_local, use_vgrid, cospOUT) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Break COSP up into pieces and loop over each COSP 'chunk'. ! nChunks = # Points to Process (nPoints) / # Points per COSP iteration (nPoints_it) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - nChunks = nPoints/nPoints_it+1 + if (MOD(nPoints,nPoints_it) .eq. 0) then + nChunks = Npoints/Npoints_it + else + nChunks = nPoints/nPoints_it+1 + endif if (nPoints .eq. nPoints_it) nChunks = 1 do iChunk=1,nChunks !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Determine indices for "chunking" (again, if necessary) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if (nChunks .eq. 1) then start_idx = 1 end_idx = nPoints @@ -450,14 +534,16 @@ program cosp2_test ! Construct COSP input types !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if (iChunk .eq. 1) then - call construct_cospIN(Nptsperit,nColumns,nLevels,cospIN) - call construct_cospstateIN(Nptsperit,nLevels,rttov_nChannels,cospstateIN) + call construct_cospIN(Nptsperit,nColumns,nLevels,rttov_Ninstruments,cospIN,emis_grey=1.0_wp) + ! call construct_cospIN(Nptsperit,nColumns,nLevels,rttov_Ninstruments,cospIN) + call construct_cospstateIN(Nptsperit,nLevels,cospstateIN) endif if (iChunk .eq. nChunks) then call destroy_cospIN(cospIN) call destroy_cospstateIN(cospstateIN) - call construct_cospIN(Nptsperit,nColumns,nLevels,cospIN) - call construct_cospstateIN(Nptsperit,nLevels,rttov_nChannels,cospstateIN) + call construct_cospIN(Nptsperit,nColumns,nLevels,rttov_Ninstruments,cospIN,emis_grey=1.0_wp) + ! call construct_cospIN(Nptsperit,nColumns,nLevels,rttov_Ninstruments,cospIN) + call construct_cospstateIN(Nptsperit,nLevels,cospstateIN) endif call cpu_time(driver_time(4)) @@ -467,8 +553,12 @@ program cosp2_test ! surface-2-TOA, whereas COSP expects all fields to be ordered from TOA-2-SFC. So the ! vertical fields are flipped prior to storing to COSP input type. !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + cospIN%emsfc_lw = emsfc_lw cospIN%rcfg_cloudsat = rcfg_cloudsat + cospIN%cfg_rttov => rttov_configs + cospIN%cospswathsIN = cospswathsIN ! Swathing information for each non-RTTOV simulator. + cospstateIN%hgt_matrix = zlev(start_idx:end_idx,Nlevels:1:-1) ! km cospstateIN%sunlit = sunlit(start_idx:end_idx) ! 0-1 cospstateIN%skt = skt(start_idx:end_idx) ! K @@ -480,11 +570,122 @@ program cosp2_test ! Pressure at interface (nlevels+1). Set uppermost interface to 0. cospstateIN%phalf(:,2:Nlevels+1) = ph(start_idx:end_idx,Nlevels:1:-1) ! Pa cospstateIN%phalf(:,1) = 0._wp + ! Surface pressure + if (any(psfc(start_idx:end_idx) .lt. 0._wp)) then + print*,'Some of values of the surface pressure field are negative. Replacing all psfc values with the lowest boundary pressure.' + psfc(start_idx:end_idx) = cospstateIN%phalf(start_idx:end_idx,Nlevels+1) + end if + cospstateIN%psfc = psfc(start_idx:end_idx) ! Pa ! Height of bottom interfaces of model layers (nlevels). ! cospstateIN%hgt_matrix_half(:,1) contains the bottom of the top layer. ! cospstateIN%hgt_matrix_half(:,Nlevels) contains the bottom of the surface layer. cospstateIN%hgt_matrix_half(:,1:Nlevels) = zlev_half(start_idx:end_idx,Nlevels:1:-1) ! km + ! Assign RTTOV values + ! Keeping these structures since refl and emis could come from model input + ! cospstateIN%emis_in(:,:) = 1._wp + ! cospstateIN%refl_in(:,:) = 1._wp + + ! Well-mixed gases are not provided in COSP offline input, so hardcoding them in. + ! Units are kg/kg over moist air. + ! Note: user_tracegas_input should be true in instrument namelists for the COSP offline driver + cospstateIN%co2(:,:) = 5.241e-04 + cospstateIN%ch4(:,:) = 9.139e-07 + cospstateIN%n2o(:,:) = 4.665e-07 + cospstateIN%co(:,:) = 2.098e-07 + cospstateIN%so2(:,:) = 2.0e-11 + + if (any(year(start_idx:end_idx) .lt. 0._wp)) then + print*,'Some of values of the input year field are masked. Replacing with 1 so RTTOV will run.' + where (year(start_idx:end_idx) .lt. 0._wp) + year(start_idx:end_idx) = 1 + end where + end if + if (any(month(start_idx:end_idx) .lt. 0._wp)) then + print*,'Some of values of the input month field are masked. Replacing with 1 so RTTOV will run.' + where (month(start_idx:end_idx) .lt. 0._wp) + month(start_idx:end_idx) = 1 + end where + end if + if (any(day(start_idx:end_idx) .lt. 0._wp)) then + print*,'Some of values of the input day field are masked. Replacing with 1 so RTTOV will run.' + where (day(start_idx:end_idx) .lt. 0._wp) + day(start_idx:end_idx) = 1 + end where + end if + if (any(hour(start_idx:end_idx) .lt. 0._wp)) then + print*,'Some of values of the input hour field are masked. Replacing with 1 so RTTOV will run.' + where (hour(start_idx:end_idx) .lt. 0._wp) + hour(start_idx:end_idx) = 1._wp + end where + end if + if (any(minute(start_idx:end_idx) .lt. 0._wp)) then + print*,'Some of values of the input minute field are masked. Replacing with 1 so RTTOV will run.' + where (minute(start_idx:end_idx) .lt. 0._wp) + minute(start_idx:end_idx) = 1._wp + end where + end if + if (any(seconds(start_idx:end_idx) .lt. 0._wp)) then + print*,'Some of values of the input minute field are masked. Replacing with 1 so RTTOV will run.' + where (seconds(start_idx:end_idx) .lt. 0._wp) + seconds(start_idx:end_idx) = 1._wp + end where + end if + + ! Read in date and time objects for RTTOV + cospstateIN%rttov_date(:,1) = year(start_idx:end_idx) + cospstateIN%rttov_date(:,2) = month(start_idx:end_idx) + cospstateIN%rttov_date(:,3) = day(start_idx:end_idx) + + cospstateIN%rttov_time(:,1) = hour(start_idx:end_idx) + cospstateIN%rttov_time(:,2) = minute(start_idx:end_idx) + cospstateIN%rttov_time(:,3) = seconds(start_idx:end_idx) + + cospstateIN%sza = 0._wp ! Hard code to zero for the offline driver. + + ! From the data input file + cospstateIN%u_sfc = u_wind(start_idx:end_idx) + cospstateIN%v_sfc = v_wind(start_idx:end_idx) + cospstateIN%lat = lat(start_idx:end_idx) + cospstateIN%lon = lon(start_idx:end_idx) + + cospstateIN%o3 = mr_ozone(start_idx:end_idx,Nlevels:1:-1) + cospstateIN%tca = tca(start_idx:end_idx,Nlevels:1:-1) + + ! Combine large-scale and convective cloud mixing ratios for RTTOV [kg/kg] + cospstateIN%cloudIce = mr_lsice(start_idx:end_idx,Nlevels:1:-1) + mr_ccice(start_idx:end_idx,Nlevels:1:-1) + cospstateIN%cloudLiq = mr_lsliq(start_idx:end_idx,Nlevels:1:-1) + mr_ccliq(start_idx:end_idx,Nlevels:1:-1) + + ! 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) + cospstateIN%DeffLiq(:,:) = 0._wp ! Initialize for zero everywhere. + where ((mr_lsliq(start_idx:end_idx,Nlevels:1:-1) .gt. 0._wp) .and. (mr_ccliq(start_idx:end_idx,Nlevels:1:-1) .gt. 0._wp)) + cospstateIN%DeffLiq(:,:) = 2._wp * 1.0e6 * (mr_lsliq(start_idx:end_idx,Nlevels:1:-1) + mr_ccliq(start_idx:end_idx,Nlevels:1:-1)) / (mr_lsliq(start_idx:end_idx,Nlevels:1:-1) / Reff(start_idx:end_idx,Nlevels:1:-1,I_LSCLIQ) + mr_ccliq(start_idx:end_idx,Nlevels:1:-1) / Reff(start_idx:end_idx,Nlevels:1:-1,I_CVCLIQ)) + elsewhere (mr_lsliq(start_idx:end_idx,Nlevels:1:-1) .gt. 0._wp) + cospstateIN%DeffLiq(:,:) = 2._wp * 1.0e6 * Reff(start_idx:end_idx,Nlevels:1:-1,I_LSCLIQ) + elsewhere (mr_ccliq(start_idx:end_idx,Nlevels:1:-1) .gt. 0._wp) + cospstateIN%DeffLiq(:,:) = 2._wp * 1.0e6 * Reff(start_idx:end_idx,Nlevels:1:-1,I_CVCLIQ) + end where + + cospstateIN%DeffIce(:,:) = 0._wp ! Initialize for zero everywhere. + where ((mr_lsice(start_idx:end_idx,Nlevels:1:-1) .gt. 0._wp) .and. (mr_ccice(start_idx:end_idx,Nlevels:1:-1) .gt. 0._wp)) + cospstateIN%DeffIce(:,:) = 2._wp * 1.0e6 * (mr_lsice(start_idx:end_idx,Nlevels:1:-1) + mr_ccice(start_idx:end_idx,Nlevels:1:-1)) / (mr_lsice(start_idx:end_idx,Nlevels:1:-1) / Reff(start_idx:end_idx,Nlevels:1:-1,I_LSCICE) + mr_ccice(start_idx:end_idx,Nlevels:1:-1) / Reff(start_idx:end_idx,Nlevels:1:-1,I_CVCICE)) + elsewhere (mr_lsice(start_idx:end_idx,Nlevels:1:-1) .gt. 0._wp) + cospstateIN%DeffIce(:,:) = 2._wp * 1.0e6 * Reff(start_idx:end_idx,Nlevels:1:-1,I_LSCICE) + elsewhere (mr_ccice(start_idx:end_idx,Nlevels:1:-1) .gt. 0._wp) + cospstateIN%DeffIce(:,:) = 2._wp * 1.0e6 * Reff(start_idx:end_idx,Nlevels:1:-1,I_CVCICE) + end where + + ! RTTOV doesn't consider precip flux for longwave, but it could be used when simulating MW instruments. + ! Graupel goes in the snow category, arbitrarily + cospstateIN%fl_rain = fl_lsrain(start_idx:end_idx,Nlevels:1:-1) + fl_ccrain(start_idx:end_idx,Nlevels:1:-1) + cospstateIN%fl_snow = fl_lssnow(start_idx:end_idx,Nlevels:1:-1) + fl_ccsnow(start_idx:end_idx,Nlevels:1:-1) + & + fl_lsgrpl(start_idx:end_idx,Nlevels:1:-1) + + ! Inputs not supplied in the UKMO test data + cospstateIN%rttov_sfcmask = landmask(start_idx:end_idx) ! (0=ocn,1=land,2=seaice). No sea ice in UKMO input here. + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Generate subcolumns and compute optical inputs. !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -501,17 +702,18 @@ program cosp2_test cospstateIN,cospIN) call cpu_time(driver_time(6)) - + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Call COSP !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - cosp_status = COSP_SIMULATOR(cospIN, cospstateIN, cospOUT,start_idx,end_idx,.false.) + cosp_status = COSP_SIMULATOR(cospIN, cospstateIN, cospOUT,start_idx,end_idx,rttov_verbose) do ij=1,size(cosp_status,1) if (cosp_status(ij) .ne. '') print*,trim(cosp_status(ij)) end do call cpu_time(driver_time(7)) - enddo + end do + print*,'Time to read in data: ',driver_time(2)-driver_time(1) print*,'Time to initialize: ',driver_time(3)-driver_time(2) print*,'Time to construct types: ',driver_time(4)-driver_time(3) @@ -522,7 +724,7 @@ program cosp2_test !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Output !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - call write_cosp2_output(Npoints, Ncolumns, Nlevels, zlev(1,Nlevels:1:-1), lon, lat, cospOUT, foutput) + call write_cosp2_output(Npoints, Ncolumns, Nlevels, rttov_Ninstruments, zlev(1,Nlevels:1:-1), lon, lat, cospOUT, foutput) call cpu_time(driver_time(8)) print*,'Time to write to output: ',driver_time(8)-driver_time(7) @@ -530,10 +732,20 @@ program cosp2_test !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Free up memory !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if (rttov_verbose) print*,'Calling "destroy_cosp_outputs".' call destroy_cosp_outputs(cospOUT) + if (associated(cospIN%cfg_rttov)) then + if (rttov_verbose) print*,'Calling "rttov_cleanup".' + call rttov_cleanup(cospIN) + endif + if (rttov_verbose) print*,'Calling "destroy_cospIN".' call destroy_cospIN(cospIN) - call destroy_cospstateIN(cospstateIN) + if (rttov_verbose) print*,'Calling "destroy_cospstateIN".' + call destroy_cospstateIN(cospstateIN) + if (rttov_verbose) print*,'Calling "cosp_cleanUp".' call cosp_cleanUp() + if (rttov_verbose) print*,'all done.' + contains !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE subsample_and_optics @@ -932,27 +1144,34 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro, overlap, use Np,Reff) endif 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) ! 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(kind=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 allocate(y%frac_out(npoints, ncolumns,nlevels)) - + + if (present(emis_grey)) y%emis_grey => emis_grey + if (Lmodis .or. Lmisr .or. Lisccp) then allocate(y%tau_067(npoints, ncolumns,nlevels),& y%emiss_11(npoints, ncolumns,nlevels)) @@ -995,30 +1214,34 @@ subroutine construct_cospIN(npoints,ncolumns,nlevels,y) y%asym(npoints, ncolumns,nlevels),& y%ss_alb(npoints, ncolumns,nlevels)) endif - - allocate (y%rcfg_cloudsat) 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%psfc(npoints), & 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%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)) + y%v_sfc(npoints),y%lat(npoints),y%lon(nPoints),y%rttov_sfcmask(nPoints), & + y%co(npoints,nlevels),y%n2o(npoints,nlevels),y%ch4(npoints,nlevels), & + y%co2(npoints,nlevels), y%so2(npoints,nlevels), & + y%cloudIce(nPoints,nLevels),y%cloudLiq(nPoints,nLevels),y%surfelev(nPoints),& + 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 @@ -1055,11 +1278,12 @@ subroutine construct_cosp_outputs(Lpctisccp,Lclisccp,& Lclzopaquetemp,Lclopaquemeanz,Lclthinmeanz, & Lclthinemis,Lclopaquemeanzse,Lclthinmeanzse, & Lclzopaquecalipsose,LcfadDbze94,Ldbze94,Lparasolrefl,& - Ltbrttov, Lptradarflag0,Lptradarflag1,Lptradarflag2, & + Lptradarflag0,Lptradarflag1,Lptradarflag2, & Lptradarflag3,Lptradarflag4,Lptradarflag5, & Lptradarflag6,Lptradarflag7,Lptradarflag8, & Lptradarflag9,Lradarpia,Lwr_occfreq,Lcfodd, & - Npoints,Ncolumns,Nlevels,Nlvgrid,Nchan,use_vgrid,x) + Ninst_rttov,rttov_configs, & + Npoints,Ncolumns,Nlevels,Nlvgrid,use_vgrid,x) ! Inputs logical,intent(in) :: & Lpctisccp, & ! ISCCP mean cloud top pressure @@ -1156,7 +1380,6 @@ subroutine construct_cosp_outputs(Lpctisccp,Lclisccp,& LcfadDbze94, & ! CLOUDSAT radar reflectivity CFAD Ldbze94, & ! CLOUDSAT radar reflectivity LparasolRefl, & ! PARASOL reflectance - Ltbrttov, & ! RTTOV mean clear-sky brightness temperature Lptradarflag0, & ! CLOUDSAT Lptradarflag1, & ! CLOUDSAT Lptradarflag2, & ! CLOUDSAT @@ -1177,11 +1400,17 @@ subroutine construct_cosp_outputs(Lpctisccp,Lclisccp,& Ncolumns, & ! Number of subgrid columns Nlevels, & ! Number of model levels Nlvgrid, & ! Number of levels in L3 stats computation - Nchan ! Number of RTTOV channels + Ninst_rttov + type(rttov_cfg), dimension(:),intent(in) :: & + rttov_configs + ! Outputs type(cosp_outputs),intent(out) :: & x ! COSP output structure + + integer :: & + i ! ISCCP simulator outputs if (Lboxtauisccp) allocate(x%isccp_boxtau(Npoints,Ncolumns)) @@ -1340,23 +1569,68 @@ subroutine construct_cosp_outputs(Lpctisccp,Lclisccp,& ! Combined CALIPSO/CLOUDSAT fields if (Lclcalipso2) allocate(x%lidar_only_freq_cloud(Npoints,Nlvgrid)) if (Lcltlidarradar) allocate(x%radar_lidar_tcc(Npoints)) - if (Lcloudsat_tcc) allocate(x%cloudsat_tcc(Npoints)) + if (Lcloudsat_tcc) allocate(x%cloudsat_tcc(Npoints)) if (Lcloudsat_tcc2) allocate(x%cloudsat_tcc2(Npoints)) - ! RTTOV - if (Ltbrttov) allocate(x%rttov_tbs(Npoints,Nchan)) - ! Joint MODIS/CloudSat Statistics if (Lwr_occfreq) allocate(x%wr_occfreq_ntotal(Npoints,WR_NREGIME)) if (Lcfodd) allocate(x%cfodd_ntotal(Npoints,CFODD_NDBZE,CFODD_NICOD,CFODD_NCLASS)) + + ! RTTOV - Allocate output for multiple instruments + ! Do I not need to allocate the number of instruments? Because each rttov output DDT will be a pointer? + if (Lrttov) then + x % Ninst_rttov = Ninst_rttov + allocate(x % rttov_outputs(Ninst_rttov)) ! Need to allocate a pointer? + do i=1,Ninst_rttov + 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)) + if ((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 % Ninst_rttov = 0 + end if end subroutine construct_cosp_outputs !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE destroy_cospIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - subroutine destroy_cospIN(y) + subroutine destroy_cospIN(y) type(cosp_optical_inputs),intent(inout) :: y + if (allocated(y%tau_067)) deallocate(y%tau_067) if (allocated(y%emiss_11)) deallocate(y%emiss_11) if (allocated(y%frac_out)) deallocate(y%frac_out) @@ -1384,54 +1658,57 @@ subroutine destroy_cospIN(y) if (allocated(y%betatot_atlid)) deallocate(y%betatot_atlid) if (allocated(y%tau_mol_atlid)) deallocate(y%tau_mol_atlid) if (allocated(y%tautot_atlid)) deallocate(y%tautot_atlid) - if (allocated(y%fracPrecipIce)) deallocate(y%fracPrecipIce) - if (allocated(y%rcfg_cloudsat%N_scale_flag)) deallocate(y%rcfg_cloudsat%N_scale_flag) - if (allocated(y%rcfg_cloudsat%Z_scale_flag)) deallocate(y%rcfg_cloudsat%Z_scale_flag) - if (allocated(y%rcfg_cloudsat%Z_scale_added_flag)) deallocate(y%rcfg_cloudsat%Z_scale_added_flag) - if (allocated(y%rcfg_cloudsat%Ze_scaled)) deallocate(y%rcfg_cloudsat%Ze_scaled) - if (allocated(y%rcfg_cloudsat%Zr_scaled)) deallocate(y%rcfg_cloudsat%Zr_scaled) - if (allocated(y%rcfg_cloudsat%kr_scaled)) deallocate(y%rcfg_cloudsat%kr_scaled) - if (allocated(y%rcfg_cloudsat%fc)) deallocate(y%rcfg_cloudsat%fc) - if (allocated(y%rcfg_cloudsat%rho_eff)) deallocate(y%rcfg_cloudsat%rho_eff) - if (allocated(y%rcfg_cloudsat%base_list)) deallocate(y%rcfg_cloudsat%base_list) - if (allocated(y%rcfg_cloudsat%step_list)) deallocate(y%rcfg_cloudsat%step_list) + if (allocated(y%fracPrecipIce)) deallocate(y%fracPrecipIce) + if (associated(y%cfg_rttov)) nullify(y%cfg_rttov) end subroutine destroy_cospIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE destroy_cospstateIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - subroutine destroy_cospstateIN(y) + subroutine destroy_cospstateIN(y) type(cosp_column_inputs),intent(inout) :: y 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%o3)) deallocate(y%o3) if (allocated(y%hgt_matrix)) deallocate(y%hgt_matrix) + if (allocated(y%hgt_matrix_half)) deallocate(y%hgt_matrix_half) + if (allocated(y%surfelev)) deallocate(y%surfelev) + 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) + if (allocated(y%o3)) deallocate(y%o3) 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) - if (allocated(y%hgt_matrix_half)) deallocate(y%hgt_matrix_half) - if (allocated(y%surfelev)) deallocate(y%surfelev) end subroutine destroy_cospstateIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE destroy_cosp_outputs !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - subroutine destroy_cosp_outputs(y) + 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 @@ -1654,10 +1931,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) @@ -1746,8 +2019,73 @@ subroutine destroy_cosp_outputs(y) deallocate(y%wr_occfreq_ntotal) nullify(y%wr_occfreq_ntotal) endif - + + ! RTTOV multi-instrument + if (allocated(y%rttov_outputs)) then + 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) + 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) + 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 + end program cosp2_test diff --git a/src/cosp.F90 b/src/cosp.F90 index 40ee93b814..b61e97730d 100755 --- a/src/cosp.F90 +++ b/src/cosp.F90 @@ -39,7 +39,7 @@ MODULE MOD_COSP USE COSP_KINDS, ONLY: wp USE MOD_COSP_CONFIG, ONLY: R_UNDEF,PARASOL_NREFL,LIDAR_NCAT,LIDAR_NTYPE, SR_BINS,& - N_HYDRO,RTTOV_MAX_CHANNELS,numMISRHgtBins, & + N_HYDRO,numMISRHgtBins, & cloudsat_DBZE_BINS,LIDAR_NTEMP,calipso_histBsct,& use_vgrid,Nlvgrid,vgrid_zu,vgrid_zl,vgrid_z,dz, & WR_NREGIME, CFODD_NCLASS, & @@ -52,125 +52,41 @@ MODULE MOD_COSP modis_histTauEdges,tau_binEdges,nCloudsatPrecipClass,& modis_histTauCenters,tau_binCenters, & cloudsat_preclvl,grLidar532_histBsct,atlid_histBsct - USE MOD_COSP_MODIS_INTERFACE, ONLY: cosp_modis_init, modis_IN - USE MOD_COSP_RTTOV_INTERFACE, ONLY: cosp_rttov_init, rttov_IN - USE MOD_COSP_MISR_INTERFACE, ONLY: cosp_misr_init, misr_IN - USE MOD_COSP_ISCCP_INTERFACE, ONLY: cosp_isccp_init, isccp_IN - USE MOD_COSP_CALIPSO_INTERFACE, ONLY: cosp_calipso_init, calipso_IN - USE MOD_COSP_ATLID_INTERFACE, ONLY: cosp_atlid_init, atlid_IN - USE MOD_COSP_GRLIDAR532_INTERFACE, ONLY: cosp_grLidar532_init, grLidar532_IN - USE MOD_COSP_PARASOL_INTERFACE, ONLY: cosp_parasol_init, parasol_in - USE MOD_COSP_CLOUDSAT_INTERFACE, ONLY: cosp_cloudsat_init, cloudsat_IN - USE quickbeam, ONLY: quickbeam_subcolumn, quickbeam_column, radar_cfg + USE MOD_COSP_MODIS_INTERFACE, ONLY: cosp_modis_init, modis_IN, & + COSP_ASSIGN_modisIN + USE MOD_COSP_RTTOV_INTERFACE, ONLY: cosp_rttov_init, cosp_rttov_simulate + USE MOD_COSP_RTTOV_UTIL, ONLY: rttov_cfg, rttov_output + USE MOD_COSP_MISR_INTERFACE, ONLY: cosp_misr_init, misr_IN, & + COSP_ASSIGN_misrIN, COSP_ASSIGN_misrIN_clean + USE MOD_COSP_ISCCP_INTERFACE, ONLY: cosp_isccp_init, isccp_IN, & + COSP_ASSIGN_isccpIN, COSP_ASSIGN_isccpIN_clean + USE MOD_COSP_CALIPSO_INTERFACE, ONLY: cosp_calipso_init, calipso_IN, & + COSP_ASSIGN_calipsoIN, COSP_ASSIGN_calipsoIN_clean + USE MOD_COSP_ATLID_INTERFACE, ONLY: cosp_atlid_init, atlid_IN, & + COSP_ASSIGN_atlidIN, COSP_ASSIGN_atlidIN_clean + USE MOD_COSP_GRLIDAR532_INTERFACE, ONLY: cosp_grLidar532_init, grLidar532_IN + USE MOD_COSP_PARASOL_INTERFACE, ONLY: cosp_parasol_init, parasol_in, & + COSP_ASSIGN_parasolIN, COSP_ASSIGN_parasolIN_clean + USE MOD_COSP_CLOUDSAT_INTERFACE, ONLY: cosp_cloudsat_init, cloudsat_IN, & + COSP_ASSIGN_cloudsatIN,COSP_ASSIGN_cloudsatIN_clean + USE quickbeam, ONLY: quickbeam_subcolumn, quickbeam_column USE MOD_ICARUS, ONLY: icarus_subcolumn, icarus_column USE MOD_MISR_SIMULATOR, ONLY: misr_subcolumn, misr_column USE MOD_LIDAR_SIMULATOR, ONLY: lidar_subcolumn, lidar_column USE MOD_MODIS_SIM, ONLY: modis_subcolumn, modis_column USE MOD_PARASOL, ONLY: parasol_subcolumn, parasol_column - use mod_cosp_rttov, ONLY: rttov_column + USE MOD_COSP_RTTOV, ONLY: rttov_IN USE MOD_COSP_STATS, ONLY: COSP_LIDAR_ONLY_CLOUD,COSP_CHANGE_VERTICAL_GRID, & - COSP_DIAG_WARMRAIN + COSP_DIAG_WARMRAIN, COMPUTE_ORBITMASKS, & + cosp_optical_inputs, cosp_column_inputs, & + swath_inputs, radar_cfg + USE COSP_PHYS_CONSTANTS, ONLY: radius_earth + USE COSP_MATH_CONSTANTS, ONLY: pi IMPLICIT NONE logical :: linitialization ! Initialization flag - ! ###################################################################################### - ! TYPE cosp_column_inputs - ! ###################################################################################### - type cosp_column_inputs - integer :: & - Npoints, & ! Number of gridpoints. - Ncolumns, & ! Number of columns. - Nlevels ! Number of levels. - - integer,allocatable,dimension(:) :: & - sunlit ! Sunlit flag (0-1) - - real(wp),allocatable,dimension(:,:) :: & - at, & ! Temperature (K) - pfull, & ! Pressure (Pa) - phalf, & ! Pressure at half-levels (Pa) - qv, & ! Specific humidity (kg/kg) - hgt_matrix, & ! Height of atmosphere layer (km) - hgt_matrix_half ! 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. - - real(wp),allocatable,dimension(:) :: & - land, & ! Land/Sea mask (0-1) - skt, & ! Surface temperature (K) - surfelev ! Surface Elevation (m) - ! Fields used ONLY by RTTOV - integer :: & - month ! Month for surface emissivty atlas (1-12) - real(wp) :: & - zenang, & ! Satellite zenith angle for RTTOV (deg) - co2, & ! CO2 (kg/kg) - ch4, & ! Methane (kg/kg) - n2o, & ! N2O (kg/kg) - co ! CO (kg/kg) - real(wp),allocatable,dimension(:) :: & - emis_sfc, & ! Surface emissivity (1) - u_sfc, & ! Surface u-wind (m/s) - v_sfc, & ! Surface v-wind (m/s) - seaice, & ! Sea-ice fraction (0-1) - lat, & ! Latitude (deg) - lon ! Longitude (deg) - real(wp),allocatable,dimension(:,:) :: & - o3, & ! Ozone (kg/kg) - tca, & ! Total column cloud fraction (0-1) - cloudIce, & ! Cloud ice water mixing ratio (kg/kg) - cloudLiq, & ! Cloud liquid water mixing ratio (kg/kg) - fl_rain, & ! Precipitation (rain) flux (kg/m2/s) - fl_snow ! Precipitation (snow) flux (kg/m2/s) - end type cosp_column_inputs - - ! ###################################################################################### - ! TYPE cosp_optical_inputs - ! ###################################################################################### - type cosp_optical_inputs - integer :: & - Npoints, & ! Number of gridpoints. - Ncolumns, & ! Number of columns. - Nlevels, & ! Number of levels. - Npart, & ! Number of cloud meteors for LIDAR simulators. - Nrefl ! Number of reflectances for PARASOL simulator - real(wp) :: & - emsfc_lw ! Surface emissivity @ 11micron - real(wp),allocatable,dimension(:,:,:) :: & - frac_out, & ! Cloud fraction - tau_067, & ! Optical depth @ 0.67micron - emiss_11, & ! Emissivity @ 11 micron - fracLiq, & ! Fraction of optical-depth due to liquid (MODIS) - asym, & ! Assymetry parameter @ 3.7micron (MODIS) - ss_alb, & ! Single-scattering albedo @ 3.7micron (MODIS) - betatot_calipso, & ! Lidar backscatter coefficient (calipso @ 532nm) - betatot_grLidar532, & ! Lidar backscatter coefficient (ground-lidar @ 532nm) - betatot_atlid, & ! Lidar backscatter coefficient (atlid @ 355nm) - betatot_ice_calipso, & ! Lidar backscatter coefficient ICE (calipso @ 532nm) - betatot_liq_calipso, & ! Lidar backscatter coefficient LIQUID (calipso @ 532nm) - tautot_calipso, & ! Lidar Optical thickness (calipso @ 532nm) - tautot_grLidar532, & ! Lidar Optical thickness (ground-lidar @ 532nm) - tautot_atlid, & ! Lidar Optical thickness (atlid @ 355nm) - tautot_ice_calipso, & ! Lidar Ice Optical thickness (calipso @ 532nm) - tautot_liq_calipso, & ! Lidar Liquid Optical thickness (calipso @ 532nm) - z_vol_cloudsat, & ! Effective reflectivity factor (mm^6/m^3) - kr_vol_cloudsat, & ! Attenuation coefficient hydro (dB/km) - g_vol_cloudsat ! Attenuation coefficient gases (dB/km) - real(wp),allocatable,dimension(:,:) :: & - beta_mol_calipso, & ! Lidar molecular backscatter coefficient (calipso @ 532nm) - beta_mol_grLidar532, & ! Lidar molecular backscatter coefficient (ground-lidar @ 532nm) - beta_mol_atlid, & ! Lidar molecular backscatter coefficient (atlid @ 355nm) - tau_mol_calipso, & ! Lidar molecular optical depth (calipso @ 532nm) - tau_mol_grLidar532, & ! Lidar molecular optical depth (ground-lidar @ 532nm) - tau_mol_atlid, & ! Lidar molecular optical depth (atlid @ 355nm) - tautot_S_liq, & ! Parasol Liquid water optical thickness, from TOA to SFC - tautot_S_ice, & ! Parasol Ice water optical thickness, from TOA to SFC - fracPrecipIce ! Fraction of precipitation which is frozen (1). - type(radar_cfg), allocatable :: & - rcfg_cloudsat ! Radar configuration information (CLOUDSAT) - end type cosp_optical_inputs ! ###################################################################################### ! TYPE cosp_outputs @@ -222,7 +138,6 @@ MODULE MOD_COSP real(wp), dimension(:),pointer :: & atlid_srbval => null() ! SR bins in cfad_sr - ! PARASOL outputs real(wp),dimension(:,:,:),pointer :: & parasolPix_refl => null() ! PARASOL reflectances (subcolumn) @@ -298,15 +213,15 @@ MODULE MOD_COSP modis_LWP_vs_ReffLIQ => null(), & ! LWP/ReffLIQ joint histogram modis_IWP_vs_ReffICE => null() ! IWP/ReffICE joint histogram - ! RTTOV outputs - real(wp),pointer :: & - rttov_tbs(:,:) => null() ! Brightness Temperature - ! Joint CloudSat+MODIS simulators outputs real(wp),dimension(:,:,:,:),pointer :: & cfodd_ntotal => null() ! # of CFODD (Npoints,CFODD_NDBZE,CFODD_NICOD,CFODD_NCLASS) real(wp),dimension(:,:), pointer :: & wr_occfreq_ntotal => null() ! # of nonprecip/drizzle/precip (Npoints,WR_NREGIME) + integer :: & + Ninst_rttov + type(rttov_output),dimension(:),allocatable :: & + rttov_outputs end type cosp_outputs @@ -328,11 +243,13 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) type(cloudsat_IN) :: cloudsatIN ! Input to the CLOUDSAT radar simulator type(modis_IN) :: modisIN ! Input to the MODIS simulator type(rttov_IN) :: rttovIN ! Input to the RTTOV simulator - integer,optional :: start_idx,stop_idx - logical,optional :: debug ! Outputs from the simulators (nested simulator output structure) type(cosp_outputs), intent(inout) :: cospOUT + + integer,optional :: start_idx,stop_idx + logical,optional :: debug + character(len=256),dimension(100) :: cosp_simulator ! Local variables @@ -350,7 +267,6 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) Lparasol_subcolumn, & ! On/Off switch for subcolumn PARASOL simulator Lcloudsat_subcolumn, & ! On/Off switch for subcolumn CLOUDSAT simulator Lmodis_subcolumn, & ! On/Off switch for subcolumn MODIS simulator - Lrttov_subcolumn, & ! On/Off switch for subcolumn RTTOV simulator Lisccp_column, & ! On/Off switch for column ISCCP simulator Lmisr_column, & ! On/Off switch for column MISR simulator Lcalipso_column, & ! On/Off switch for column CALIPSO simulator @@ -359,18 +275,17 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) Lparasol_column, & ! On/Off switch for column PARASOL simulator Lcloudsat_column, & ! On/Off switch for column CLOUDSAT simulator Lmodis_column, & ! On/Off switch for column MODIS simulator - Lrttov_column, & ! On/Off switch for column RTTOV simulator (not used) + Lrttov_column, & ! On/Off switch for column RTTOV simulator Lradar_lidar_tcc, & ! On/Off switch from joint Calipso/Cloudsat product Lcloudsat_tcc, & ! Lcloudsat_tcc2, & ! Llidar_only_freq_cloud, & ! On/Off switch from joint Calipso/Cloudsat product Lcloudsat_modis_wr ! On/Off switch from joint CloudSat/MODIS warm rain product logical :: & - ok_lidar_cfad = .false., & + ok_lidar_cfad = .false., & ok_lidar_cfad_grLidar532 = .false., & - ok_lidar_cfad_atlid = .false., & - lrttov_cleanUp = .false. - + ok_lidar_cfad_atlid = .false., & + verbose = .false. integer, dimension(:,:),allocatable :: & modisRetrievedPhase,isccpLEVMATCH real(wp), dimension(:), allocatable :: & @@ -384,7 +299,10 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) modisRetrievedCloudTopPressure,modisRetrievedTau,modisRetrievedSize, & misr_boxtau,misr_boxztop,misr_dist_model_layertops,isccp_boxtau, & isccp_boxttop,isccp_boxptop,calipso_beta_mol,lidar_only_freq_cloud, & - grLidar532_beta_mol,atlid_beta_mol + grLidar532_beta_mol,atlid_beta_mol, & + rttov_bt_total,rttov_bt_clear, & ! RTTOV brightness temps + rttov_rad_total,rttov_rad_clear,rttov_rad_cloudy, & ! RTTOV radiances + rttov_refl_total,rttov_refl_clear ! RTTOV reflectances REAL(WP), dimension(:,:,:),allocatable :: & modisJointHistogram,modisJointHistogramIce,modisJointHistogramLiq, & modisJointHistogram_CtpCodLiq,modisJointHistogram_CtpCodIce, & @@ -403,9 +321,79 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) cfodd_ntotal (:,:,:,:), & ! # of total samples for CFODD (Npoints,CFODD_NDBZE,CFODD_NICOD,CFODD_NCLASS) wr_occfreq_ntotal(:,:) ! # of warm-rain (nonprecip/drizzle/precip) (Npoints,WR_NREGIME) + ! Fields used in orbit swathing of gridcells. + logical,dimension(:),allocatable :: & ! Mask of reals over all local times + CSCAL_SWATH_MASK, & ! Needed for MODIS CSCAL + MODIS_SWATH_MASK ! Needed for MODIS CSCAL + normal MODIS + integer,dimension(:),allocatable :: & ! Arrays containing the indices of the swath masks + ISCCP_MASK_INDICES, & + MISR_MASK_INDICES, & + CSCAL_MASK_INDICES, & + PARASOL_MASK_INDICES, & + ATLID_MASK_INDICES, & + MODIS_CSCAL_MASK_INDICES + integer :: j + ! ISCCP swathing variables + real(wp),dimension(:),target,allocatable :: & + temp_isccp_meanalbedocld, & + temp_isccp_meanptop, & + temp_isccp_meantaucld, & + temp_isccp_totalcldarea, & + temp_isccp_meantb + real(wp),dimension(:,:,:),target,allocatable :: & + temp_isccp_fq + ! MISR swathing variables + real(wp),dimension(:),target,allocatable :: & + temp_misr_cldarea, & + temp_misr_meanztop + real(wp),dimension(:,:,:),target,allocatable :: & + temp_misr_fq + ! CALIPSO swathing variables + real(wp),dimension(:),target,allocatable :: & + temp_calipso_cldthinemis + real(wp),dimension(:,:),target,allocatable :: & + temp_calipso_lidarcld, & + temp_calipso_cldlayer, & + temp_calipso_cldtype, & + temp_calipso_cldtypetemp, & + temp_calipso_cldtypemeanz,& + temp_calipso_cldtypemeanzse + real(wp),dimension(:,:,:),target,allocatable :: & + temp_calipso_cfad_sr, & + temp_calipso_lidarcldphase, & + temp_calipso_lidarcldtype, & + temp_calipso_cldlayerphase, & + temp_calipso_lidarcldtmp + ! ATLID swathing variables + real(wp),dimension(:,:),target,allocatable :: & + temp_atlid_lidarcld, & + temp_atlid_cldlayer + real(wp),dimension(:,:,:),target,allocatable :: & + temp_atlid_cfad_sr + ! PARASOL swathing variables + real(wp),dimension(:,:),target,allocatable :: & + temp_parasolGrid_refl + ! CLOUDSAT swathing variables + real(wp),dimension(:),target,allocatable :: & + temp_cloudsat_pia + real(wp),dimension(:,:),target,allocatable :: & + temp_cloudsat_precip_cover + real(wp),dimension(:,:,:),target,allocatable :: & + temp_cloudsat_cfad_ze + ! MODIS swathing variables. + real(wp),dimension(:,:),allocatable :: & + modis_boxptop, & + modis_boxttop, & + modis_boxtau + integer,dimension(:,:),allocatable :: & + modisLEVMATCH + real(wp),dimension(:),target,allocatable :: & + modis_meantbclr + ! Initialize error reporting for output cosp_simulator(:)='' - + if (present(debug)) verbose = debug + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! 1) Determine if using full inputs or subset !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -433,7 +421,6 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) Lparasol_subcolumn = .false. Lcloudsat_subcolumn = .false. Lmodis_subcolumn = .false. - Lrttov_subcolumn = .false. Lisccp_column = .false. Lmisr_column = .false. Lcalipso_column = .false. @@ -503,13 +490,11 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) ! PARASOL subcolumn if (associated(cospOUT%parasolPix_refl)) & Lparasol_subcolumn = .true. - - ! RTTOV column - if (associated(cospOUT%rttov_tbs)) & + + ! RTTOV Column + if (allocated(cospOUT%rttov_outputs)) then Lrttov_column = .true. - - ! Set flag to deallocate rttov types (only done on final call to simulator) - if (associated(cospOUT%isccp_meantb) .and. size(cospOUT%isccp_meantb) .eq. stop_idx) lrttov_cleanUp = .true. + endif ! ISCCP column if (associated(cospOUT%isccp_fq) .or. & @@ -629,51 +614,25 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) Lmisr_subcolumn, Lmisr_column, Lmodis_subcolumn, Lmodis_column, & Lcloudsat_subcolumn, Lcloudsat_column, Lcalipso_subcolumn, Lcalipso_column, & Latlid_subcolumn, Latlid_column, LgrLidar532_subcolumn, LgrLidar532_column, & - Lrttov_subcolumn, Lrttov_column, Lparasol_subcolumn, Lparasol_column, & + Lrttov_column, Lparasol_subcolumn, Lparasol_column, & Lradar_lidar_tcc, Llidar_only_freq_cloud, Lcloudsat_tcc,Lcloudsat_tcc2, & Lcloudsat_modis_wr, cospOUT, cosp_simulator, nError) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! 3) Populate instrument simulator inputs !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + ! Indexing order for "cospIN % cospswathsIN" is ISCCP, MISR, CLOUDSAT-CALIPSO, ATLID, PARASOL, MODIS if (Lisccp_subcolumn .or. Lmodis_subcolumn) then - isccpIN%Npoints => Npoints - isccpIN%Ncolumns => cospIN%Ncolumns - isccpIN%Nlevels => cospIN%Nlevels - isccpIN%emsfc_lw => cospIN%emsfc_lw - isccpIN%skt => cospgridIN%skt - isccpIN%qv => cospgridIN%qv - isccpIN%at => cospgridIN%at - isccpIN%frac_out => cospIN%frac_out - isccpIN%dtau => cospIN%tau_067 - isccpIN%dem => cospIN%emiss_11 - isccpIN%phalf => cospgridIN%phalf - isccpIN%sunlit => cospgridIN%sunlit - isccpIN%pfull => cospgridIN%pfull + call COSP_ASSIGN_isccpIN(cospIN,cospgridIN,Npoints,isccpIN,ISCCP_MASK_INDICES) !COSP_ASSIGN_isccpIN endif if (Lmisr_subcolumn) then - misrIN%Npoints => Npoints - misrIN%Ncolumns => cospIN%Ncolumns - misrIN%Nlevels => cospIN%Nlevels - misrIN%dtau => cospIN%tau_067 - misrIN%sunlit => cospgridIN%sunlit - misrIN%zfull => cospgridIN%hgt_matrix - misrIN%at => cospgridIN%at + call COSP_ASSIGN_misrIN(cospIN,cospgridIN,Npoints,misrIN,MISR_MASK_INDICES) endif if (Lcalipso_subcolumn) then - calipsoIN%Npoints => Npoints - calipsoIN%Ncolumns => cospIN%Ncolumns - calipsoIN%Nlevels => cospIN%Nlevels - calipsoIN%beta_mol => cospIN%beta_mol_calipso - calipsoIN%betatot => cospIN%betatot_calipso - calipsoIN%betatot_liq => cospIN%betatot_liq_calipso - calipsoIN%betatot_ice => cospIN%betatot_ice_calipso - calipsoIN%tau_mol => cospIN%tau_mol_calipso - calipsoIN%tautot => cospIN%tautot_calipso - calipsoIN%tautot_liq => cospIN%tautot_liq_calipso - calipsoIN%tautot_ice => cospIN%tautot_ice_calipso + call COSP_ASSIGN_calipsoIN(cospIN,cospgridIN,Npoints,calipsoIN,CSCAL_MASK_INDICES,CSCAL_SWATH_MASK) endif if (LgrLidar532_subcolumn) then @@ -687,88 +646,66 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) endif if (Latlid_subcolumn) then - atlidIN%Npoints => Npoints - atlidIN%Ncolumns => cospIN%Ncolumns - atlidIN%Nlevels => cospIN%Nlevels - atlidIN%beta_mol_atlid => cospIN%beta_mol_atlid - atlidIN%betatot_atlid => cospIN%betatot_atlid - atlidIN%tau_mol_atlid => cospIN%tau_mol_atlid - atlidIN%tautot_atlid => cospIN%tautot_atlid + call COSP_ASSIGN_atlidIN(cospIN,cospgridIN,Npoints,atlidIN,ATLID_MASK_INDICES) endif if (Lparasol_subcolumn) then - parasolIN%Npoints => Npoints - parasolIN%Nlevels => cospIN%Nlevels - parasolIN%Ncolumns => cospIN%Ncolumns - parasolIN%Nrefl => cospIN%Nrefl - parasolIN%tautot_S_liq => cospIN%tautot_S_liq - parasolIN%tautot_S_ice => cospIN%tautot_S_ice + call COSP_ASSIGN_parasolIN(cospIN,cospgridIN,Npoints,parasolIN,PARASOL_MASK_INDICES) endif if (Lcloudsat_subcolumn) then - cloudsatIN%Npoints => Npoints - cloudsatIN%Nlevels => cospIN%Nlevels - cloudsatIN%Ncolumns => cospIN%Ncolumns - cloudsatIN%z_vol => cospIN%z_vol_cloudsat - cloudsatIN%kr_vol => cospIN%kr_vol_cloudsat - cloudsatIN%g_vol => cospIN%g_vol_cloudsat - cloudsatIN%rcfg => cospIN%rcfg_cloudsat - cloudsatIN%hgt_matrix => cospgridIN%hgt_matrix + call COSP_ASSIGN_cloudsatIN(cospIN,cospgridIN,Npoints,cloudsatIN,CSCAL_MASK_INDICES,CSCAL_SWATH_MASK) endif if (Lmodis_subcolumn) then - modisIN%Ncolumns => cospIN%Ncolumns - modisIN%Nlevels => cospIN%Nlevels - modisIN%Npoints => Npoints - modisIN%liqFrac => cospIN%fracLiq - modisIN%tau => cospIN%tau_067 - modisIN%g => cospIN%asym - modisIN%w0 => cospIN%ss_alb - modisIN%Nsunlit = count(cospgridIN%sunlit > 0) - if (modisIN%Nsunlit .gt. 0) then - allocate(modisIN%sunlit(modisIN%Nsunlit),modisIN%pres(modisIN%Nsunlit,cospIN%Nlevels+1)) - modisIN%sunlit = pack((/ (i, i = 1, Npoints ) /),mask = cospgridIN%sunlit > 0) - modisIN%pres = cospgridIN%phalf(int(modisIN%sunlit(:)),:) - endif - if (count(cospgridIN%sunlit <= 0) .gt. 0) then - allocate(modisIN%notSunlit(count(cospgridIN%sunlit <= 0))) - modisIN%notSunlit = pack((/ (i, i = 1, Npoints ) /),mask = .not. cospgridIN%sunlit > 0) - endif + call COSP_ASSIGN_modisIN(cospIN,cospgridIN,Npoints,modisIN,CSCAL_SWATH_MASK,MODIS_CSCAL_MASK_INDICES) endif if (Lrttov_column) then rttovIN%nPoints => Npoints - rttovIN%nLevels => cospIN%nLevels + rttovIN%nLevels => cospIN%nLevels ! This is actually "nlayers" in the RTTOV sense rttovIN%nSubCols => cospIN%nColumns - rttovIN%zenang => cospgridIN%zenang rttovIN%co2 => cospgridIN%co2 rttovIN%ch4 => cospgridIN%ch4 rttovIN%n2o => cospgridIN%n2o rttovIN%co => cospgridIN%co - rttovIN%surfem => cospgridIN%emis_sfc - rttovIN%h_surf => cospgridIN%hgt_matrix_half(:,cospIN%Nlevels) + rttovIN%h_surf => cospgridIN%surfelev rttovIN%u_surf => cospgridIN%u_sfc rttovIN%v_surf => cospgridIN%v_sfc rttovIN%t_skin => cospgridIN%skt - rttovIN%p_surf => cospgridIN%phalf(:,cospIN%Nlevels+1) - rttovIN%q2m => cospgridIN%qv(:,cospIN%Nlevels) - rttovIN%t2m => cospgridIN%at(:,cospIN%Nlevels) - rttovIN%lsmask => cospgridIN%land + rttovIN%p_surf => cospgridIN%psfc ! Lower boundary of lowest layer may not be the surface. + if (associated(cospIN%emis_grey)) rttovIN%emis_grey => cospIN%emis_grey +! rttovIN%surfem => cospgridIN%emis_in +! rttovIN%refl_in => cospgridIN%refl_in + if (allocated(cospgridIN%q2m)) then + rttovIN%q2m => cospgridIN%q2m(:) + else + rttovIN%q2m => cospgridIN%qv(:,cospIN%Nlevels) + end if + if (allocated(cospgridIN%t2m)) then + rttovIN%t2m => cospgridIN%t2m(:) + else + rttovIN%t2m => cospgridIN%at(:,cospIN%Nlevels) + end if + rttovIN%sfcmask => cospgridIN%rttov_sfcmask rttovIN%latitude => cospgridIN%lat rttovIN%longitude => cospgridIN%lon - rttovIN%seaice => cospgridIN%seaice rttovIN%p => cospgridIN%pfull rttovIN%ph => cospgridIN%phalf rttovIN%t => cospgridIN%at rttovIN%q => cospgridIN%qv rttovIN%o3 => cospgridIN%o3 ! Below only needed for all-sky RTTOV calculation - rttovIN%month => cospgridIN%month + rttovIN%rttov_date => cospgridIN%rttov_date + rttovIN%rttov_time => cospgridIN%rttov_time + rttovIN%sza => cospgridIN%sza ! JKS make optional? Defeats the purpose of the "associated" check in cosp_rttov_v13. rttovIN%tca => cospgridIN%tca - rttovIN%cldIce => cospgridIN%cloudIce rttovIN%cldLiq => cospgridIN%cloudLiq - rttovIN%fl_rain => cospgridIN%fl_rain - rttovIN%fl_snow => cospgridIN%fl_snow + rttovIN%cldIce => cospgridIN%cloudIce + rttovIN%DeffLiq => cospgridIN%DeffLiq + rttovIN%DeffIce => cospgridIN%DeffIce + rttovIN%fl_rain => cospgridIN%fl_rain ! Keep in case of RTTOV-SCATT implementation. + rttovIN%fl_snow => cospgridIN%fl_snow ! Keep in case of RTTOV-SCATT implementation. endif !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -777,65 +714,94 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) ! ISCCP (icarus) subcolumn simulator if (Lisccp_subcolumn .or. Lmodis_subcolumn) then - ! Allocate space for local variables - allocate(isccpLEVMATCH(Npoints,isccpIN%Ncolumns), & - isccp_boxttop(Npoints,isccpIN%Ncolumns), & - isccp_boxptop(Npoints,isccpIN%Ncolumns), & - isccp_boxtau(Npoints,isccpIN%Ncolumns), isccp_meantbclr(Npoints)) - ! Call simulator - call icarus_subcolumn(isccpIN%npoints,isccpIN%ncolumns,isccpIN%nlevels, & - isccpIN%sunlit,isccpIN%dtau,isccpIN%dem,isccpIN%skt, & - isccpIN%emsfc_lw,isccpIN%qv,isccpIN%at,isccpIN%pfull, & - isccpIN%phalf,isccpIN%frac_out,isccpLEVMATCH, & - isccp_boxtau(:,:),isccp_boxptop(:,:), & - isccp_boxttop(:,:),isccp_meantbclr(:)) - ! Store output (if requested) - if (associated(cospOUT%isccp_boxtau)) then - cospOUT%isccp_boxtau(ij:ik,:) = isccp_boxtau - endif - if (associated(cospOUT%isccp_boxptop)) then - cospOUT%isccp_boxptop(ij:ik,:) = isccp_boxptop - endif - if (associated(cospOUT%isccp_meantbclr)) then - cospOUT%isccp_meantbclr(ij:ik) = isccp_meantbclr - endif - endif - - ! MISR subcolumn simulator + if (isccpIN%Npoints .gt. 0) then + allocate(isccpLEVMATCH(isccpIN%Npoints,isccpIN%Ncolumns), & + isccp_boxttop(isccpIN%Npoints,isccpIN%Ncolumns), & + isccp_boxptop(isccpIN%Npoints,isccpIN%Ncolumns), & + isccp_boxtau(isccpIN%Npoints,isccpIN%Ncolumns), & + isccp_meantbclr(isccpIN%Npoints)) + ! Call simulator + call icarus_subcolumn(isccpIN%npoints,isccpIN%ncolumns,isccpIN%nlevels, & + isccpIN%sunlit,isccpIN%dtau,isccpIN%dem,isccpIN%skt, & + isccpIN%emsfc_lw,isccpIN%qv,isccpIN%at,isccpIN%pfull, & + isccpIN%phalf,isccpIN%frac_out,isccpLEVMATCH, & + isccp_boxtau(:,:),isccp_boxptop(:,:), & + isccp_boxttop(:,:),isccp_meantbclr(:)) + if (cospIN % cospswathsIN(1) % N_inst_swaths .gt. 0) then + ! Decode outputs from swaths when reading into cospOUT fields + cospOUT%isccp_boxtau(ij:ik,:) = R_UNDEF + cospOUT%isccp_boxptop(ij:ik,:) = R_UNDEF + cospOUT%isccp_meantbclr(ij:ik) = R_UNDEF + if (associated(cospOUT%isccp_boxtau)) cospOUT%isccp_boxtau(ij+int(ISCCP_MASK_INDICES)-1,:) = isccp_boxtau(:,:) + if (associated(cospOUT%isccp_boxptop)) cospOUT%isccp_boxptop(ij+int(ISCCP_MASK_INDICES)-1,:) = isccp_boxptop(:,:) + if (associated(cospOUT%isccp_meantbclr)) cospOUT%isccp_meantbclr(ij+int(ISCCP_MASK_INDICES)-1) = isccp_meantbclr(:) + else + if (associated(cospOUT%isccp_boxtau)) cospOUT%isccp_boxtau(ij:ik,:) = isccp_boxtau + if (associated(cospOUT%isccp_boxptop)) cospOUT%isccp_boxptop(ij:ik,:) = isccp_boxptop + if (associated(cospOUT%isccp_meantbclr)) cospOUT%isccp_meantbclr(ij:ik) = isccp_meantbclr + end if + else + cospOUT%isccp_boxtau(ij:ik,:) = R_UNDEF + cospOUT%isccp_boxptop(ij:ik,:) = R_UNDEF + cospOUT%isccp_meantbclr(ij:ik) = R_UNDEF + end if + end if + + ! MISR subcolumn simulator if (Lmisr_subcolumn) then - ! Allocate space for local variables - allocate(misr_boxztop(Npoints,misrIN%Ncolumns), & - misr_boxtau(Npoints,misrIN%Ncolumns), & - misr_dist_model_layertops(Npoints,numMISRHgtBins)) - ! Call simulator - call misr_subcolumn(misrIN%Npoints,misrIN%Ncolumns,misrIN%Nlevels,misrIN%dtau, & - misrIN%zfull,misrIN%at,misrIN%sunlit,misr_boxtau, & - misr_dist_model_layertops,misr_boxztop) - ! Store output (if requested) - if (associated(cospOUT%misr_dist_model_layertops)) then - cospOUT%misr_dist_model_layertops(ij:ik,:) = misr_dist_model_layertops - endif - endif + if (misrIN%Npoints .gt. 0) then + ! Allocate space for local variables. + allocate(misr_boxztop(misrIN%Npoints,misrIN%Ncolumns), & + misr_boxtau(misrIN%Npoints,misrIN%Ncolumns), & + misr_dist_model_layertops(misrIN%Npoints,numMISRHgtBins)) + ! Call simulator + call misr_subcolumn(misrIN%Npoints,misrIN%Ncolumns,misrIN%Nlevels,misrIN%dtau, & + misrIN%zfull,misrIN%at,misrIN%sunlit,misr_boxtau, & + misr_dist_model_layertops,misr_boxztop) + if (cospIN % cospswathsIN(2) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + ! Decode outputs from swaths when reading into cospOUT fields + cospOUT%misr_dist_model_layertops(ij:ik,:) = R_UNDEF + if (associated(cospOUT%misr_dist_model_layertops)) cospOUT%misr_dist_model_layertops(ij+int(MISR_MASK_INDICES)-1,:) = misr_dist_model_layertops(:,:) + else + if (associated(cospOUT%misr_dist_model_layertops)) cospOUT%misr_dist_model_layertops(ij:ik,:) = misr_dist_model_layertops + end if + else + cospOUT%misr_dist_model_layertops(ij:ik,:) = R_UNDEF + end if + end if ! Calipso subcolumn simulator if (Lcalipso_subcolumn) then - ! Allocate space for local variables - allocate(calipso_beta_mol(calipsoIN%Npoints,calipsoIN%Nlevels), & - calipso_beta_tot(calipsoIN%Npoints,calipsoIN%Ncolumns,calipsoIN%Nlevels),& - calipso_betaperp_tot(calipsoIN%Npoints,calipsoIN%Ncolumns,calipsoIN%Nlevels)) - ! Call simulator - call lidar_subcolumn(calipsoIN%npoints, calipsoIN%ncolumns, calipsoIN%nlevels, .false., & - calipsoIN%beta_mol, calipsoIN%tau_mol, calipsoIN%betatot, calipsoIN%tautot, & - calipso_beta_mol(:,:), calipso_beta_tot(:,:,:), calipsoIN%betatot_ice, & - calipsoIN%tautot_ice, calipsoIN%betatot_liq, calipsoIN%tautot_liq, & - calipso_betaperp_tot(:,:,:)) - ! Store output (if requested) - if (associated(cospOUT%calipso_beta_mol)) & - cospOUT%calipso_beta_mol(ij:ik,calipsoIN%Nlevels:1:-1) = calipso_beta_mol - if (associated(cospOUT%calipso_beta_tot)) & - cospOUT%calipso_beta_tot(ij:ik,:,calipsoIN%Nlevels:1:-1) = calipso_beta_tot - if (associated(cospOUT%calipso_betaperp_tot)) & - cospOUT%calipso_betaperp_tot(ij:ik,:,:) = calipso_betaperp_tot + if (calipsoIN%Npoints .gt. 0) then + ! Allocate space for local variables + allocate(calipso_beta_mol(calipsoIN%Npoints,calipsoIN%Nlevels), & + calipso_beta_tot(calipsoIN%Npoints,calipsoIN%Ncolumns,calipsoIN%Nlevels),& + calipso_betaperp_tot(calipsoIN%Npoints,calipsoIN%Ncolumns,calipsoIN%Nlevels)) + ! Call simulator + call lidar_subcolumn(calipsoIN%npoints, calipsoIN%ncolumns, calipsoIN%nlevels, .false., & + calipsoIN%beta_mol, calipsoIN%tau_mol, calipsoIN%betatot, calipsoIN%tautot, & + calipso_beta_mol(:,:), calipso_beta_tot(:,:,:), calipsoIN%betatot_ice, & + calipsoIN%tautot_ice, calipsoIN%betatot_liq, calipsoIN%tautot_liq, & + calipso_betaperp_tot(:,:,:)) + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + ! Decode outputs from swaths when reading into cospOUT fields + cospOUT%calipso_beta_mol(ij:ik,:) = R_UNDEF + cospOUT%calipso_beta_tot(ij:ik,:,:) = R_UNDEF + cospOUT%calipso_betaperp_tot(ij:ik,:,:) = R_UNDEF + if (associated(cospOUT%calipso_beta_mol)) cospOUT%calipso_beta_mol(ij+int(CSCAL_MASK_INDICES)-1,calipsoIN%Nlevels:1:-1) = calipso_beta_mol(:,:) + if (associated(cospOUT%calipso_beta_tot)) cospOUT%calipso_beta_tot(ij+int(CSCAL_MASK_INDICES)-1,:,calipsoIN%Nlevels:1:-1) = calipso_beta_tot(:,:,:) + if (associated(cospOUT%calipso_betaperp_tot)) cospOUT%calipso_betaperp_tot(ij+int(CSCAL_MASK_INDICES)-1,:,:) = calipso_betaperp_tot(:,:,:) + else ! Proceed normally + ! Store output (if requested) + if (associated(cospOUT%calipso_beta_mol)) cospOUT%calipso_beta_mol(ij:ik,calipsoIN%Nlevels:1:-1) = calipso_beta_mol + if (associated(cospOUT%calipso_beta_tot)) cospOUT%calipso_beta_tot(ij:ik,:,calipsoIN%Nlevels:1:-1) = calipso_beta_tot + if (associated(cospOUT%calipso_betaperp_tot)) cospOUT%calipso_betaperp_tot(ij:ik,:,:) = calipso_betaperp_tot + endif + else + cospOUT%calipso_beta_mol(ij:ik,:) = R_UNDEF + cospOUT%calipso_beta_tot(ij:ik,:,:) = R_UNDEF + cospOUT%calipso_betaperp_tot(ij:ik,:,:) = R_UNDEF + endif endif ! GROUND LIDAR subcolumn simulator @@ -856,75 +822,126 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) ! ATLID subcolumn simulator if (Latlid_subcolumn) then - ! Allocate space for local variables - allocate(atlid_beta_mol(atlidIN%Npoints,atlidIN%Nlevels), & - atlid_beta_tot(atlidIN%Npoints,atlidIN%Ncolumns,atlidIN%Nlevels)) - ! Call simulator - call lidar_subcolumn(atlidIN%npoints, atlidIN%ncolumns, atlidIN%nlevels,& - .false., atlidIN%beta_mol_atlid, atlidIN%tau_mol_atlid, atlidIN%betatot_atlid,& - atlidIN%tautot_atlid, atlid_beta_mol(:,:), atlid_beta_tot(:,:,:)) - ! Store output (if requested) - if (associated(cospOUT%atlid_beta_mol)) & - cospOUT%atlid_beta_mol(ij:ik,atlidIN%Nlevels:1:-1) = atlid_beta_mol - if (associated(cospOUT%atlid_beta_tot)) & - cospOUT%atlid_beta_tot(ij:ik,:,atlidIN%Nlevels:1:-1) = atlid_beta_tot + if (atlidIN%Npoints .gt. 0) then + ! Allocate space for local variables + allocate(atlid_beta_mol(atlidIN%Npoints,atlidIN%Nlevels), & + atlid_beta_tot(atlidIN%Npoints,atlidIN%Ncolumns,atlidIN%Nlevels)) + ! Call simulator + call lidar_subcolumn(atlidIN%npoints, atlidIN%ncolumns, atlidIN%nlevels, & + .false., atlidIN%beta_mol_atlid, atlidIN%tau_mol_atlid, atlidIN%betatot_atlid, & + atlidIN%tautot_atlid, atlid_beta_mol(:,:), atlid_beta_tot(:,:,:)) + ! Decode outputs from swaths when reading into cospOUT fields + if (cospIN % cospswathsIN(4) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + cospOUT%atlid_beta_mol(ij:ik,:) = R_UNDEF + cospOUT%atlid_beta_tot(ij:ik,:,:) = R_UNDEF + if (associated(cospOUT%atlid_beta_mol)) cospOUT%atlid_beta_mol(ij+int(ATLID_MASK_INDICES)-1,atlidIN%Nlevels:1:-1) = atlid_beta_mol(:,:) + if (associated(cospOUT%atlid_beta_tot)) cospOUT%atlid_beta_tot(ij+int(ATLID_MASK_INDICES)-1,:,atlidIN%Nlevels:1:-1) = atlid_beta_tot(:,:,:) + else + ! Store output (if requested) + if (associated(cospOUT%atlid_beta_mol)) & + cospOUT%atlid_beta_mol(ij:ik,atlidIN%Nlevels:1:-1) = atlid_beta_mol + if (associated(cospOUT%atlid_beta_tot)) & + cospOUT%atlid_beta_tot(ij:ik,:,atlidIN%Nlevels:1:-1) = atlid_beta_tot + end if + else + cospOUT%atlid_beta_mol(ij:ik,:) = R_UNDEF + cospOUT%atlid_beta_tot(ij:ik,:,:) = R_UNDEF + endif endif ! PARASOL subcolumn simulator if (Lparasol_subcolumn) then - ! Allocate space for local variables - allocate(parasolPix_refl(parasolIN%Npoints,parasolIN%Ncolumns,PARASOL_NREFL)) - ! Call simulator - do icol=1,parasolIN%Ncolumns - call parasol_subcolumn(parasolIN%npoints, PARASOL_NREFL, & - parasolIN%tautot_S_liq(1:parasolIN%Npoints,icol), & - parasolIN%tautot_S_ice(1:parasolIN%Npoints,icol), & - parasolPix_refl(:,icol,1:PARASOL_NREFL)) - ! Store output (if requested) - if (associated(cospOUT%parasolPix_refl)) then - cospOUT%parasolPix_refl(ij:ik,icol,1:PARASOL_NREFL) = & - parasolPix_refl(:,icol,1:PARASOL_NREFL) - endif - enddo + if (parasolIN%Npoints .gt. 0) then + ! Allocate space for local variables + allocate(parasolPix_refl(parasolIN%Npoints,parasolIN%Ncolumns,PARASOL_NREFL)) + ! Call simulator + do icol=1,parasolIN%Ncolumns + call parasol_subcolumn(parasolIN%npoints, PARASOL_NREFL, & + parasolIN%tautot_S_liq(1:parasolIN%Npoints,icol), & + parasolIN%tautot_S_ice(1:parasolIN%Npoints,icol), & + parasolPix_refl(:,icol,1:PARASOL_NREFL)) + ! Store output (if requested) + if (cospIN % cospswathsIN(5) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + cospOUT%parasolPix_refl(ij:ik,icol,1:PARASOL_NREFL) = R_UNDEF + if (associated(cospOUT%parasolPix_refl)) cospOUT%parasolPix_refl(ij+int(PARASOL_MASK_INDICES)-1,icol,1:PARASOL_NREFL) = parasolPix_refl(:,icol,1:PARASOL_NREFL) + else + if (associated(cospOUT%parasolPix_refl)) cospOUT%parasolPix_refl(ij:ik,icol,1:PARASOL_NREFL) = parasolPix_refl(:,icol,1:PARASOL_NREFL) + endif + enddo + else + cospOUT%parasolPix_refl(ij:ik,:,1:PARASOL_NREFL) = R_UNDEF + endif endif ! Cloudsat (quickbeam) subcolumn simulator if (Lcloudsat_subcolumn) then ! Allocate space for local variables - allocate(cloudsatDBZe(cloudsatIN%Npoints,cloudsatIN%Ncolumns,cloudsatIN%Nlevels), & - cloudsatZe_non(cloudsatIN%Npoints,cloudsatIN%Ncolumns,cloudsatIN%Nlevels)) - do icol=1,cloudsatIN%ncolumns - call quickbeam_subcolumn(cloudsatIN%rcfg,cloudsatIN%Npoints,cloudsatIN%Nlevels,& - cloudsatIN%hgt_matrix/1000._wp, & - cloudsatIN%z_vol(:,icol,:), & - cloudsatIN%kr_vol(:,icol,:), & - cloudsatIN%g_vol(:,1,:),cloudsatDBze(:,icol,:),cloudsatZe_non(:,icol,:)) - enddo - ! Store output (if requested) - if (associated(cospOUT%cloudsat_Ze_tot)) then - cospOUT%cloudsat_Ze_tot(ij:ik,:,:) = cloudsatDBZe(:,:,1:cloudsatIN%Nlevels) - endif + if (cloudsatIN%Npoints .gt. 0) then + allocate(cloudsatDBZe(cloudsatIN%Npoints,cloudsatIN%Ncolumns,cloudsatIN%Nlevels), & + cloudsatZe_non(cloudsatIN%Npoints,cloudsatIN%Ncolumns,cloudsatIN%Nlevels)) + do icol=1,cloudsatIN%ncolumns + call quickbeam_subcolumn(cloudsatIN%rcfg,cloudsatIN%Npoints,cloudsatIN%Nlevels,& + cloudsatIN%hgt_matrix/1000._wp, & + cloudsatIN%z_vol(:,icol,:), & + cloudsatIN%kr_vol(:,icol,:), & + cloudsatIN%g_vol(:,1,:),cloudsatDBze(:,icol,:),cloudsatZe_non(:,icol,:)) + enddo + ! Store output (if requested) + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + cospOUT%cloudsat_Ze_tot(ij:ik,:,:) = R_UNDEF + if (associated(cospOUT%cloudsat_Ze_tot)) cospOUT%cloudsat_Ze_tot(ij+int(CSCAL_MASK_INDICES)-1,:,1:cloudsatIN%Nlevels) = cloudsatDBZe(:,:,1:cloudsatIN%Nlevels) + else + if (associated(cospOUT%cloudsat_Ze_tot)) cospOUT%cloudsat_Ze_tot(ij:ik,:,:) = cloudsatDBZe(:,:,1:cloudsatIN%Nlevels) + endif + else + cospOUT%cloudsat_Ze_tot(ij:ik,:,:) = R_UNDEF + endif endif + ! MODIS subcolumn simulator if (Lmodis_subcolumn) then - if(modisiN%nSunlit > 0) then + if (modisiN%nSunlit > 0) then ! Allocate space for local variables allocate(modisRetrievedTau(modisIN%nSunlit,modisIN%nColumns), & modisRetrievedSize(modisIN%nSunlit,modisIN%nColumns), & modisRetrievedPhase(modisIN%nSunlit,modisIN%nColumns), & modisRetrievedCloudTopPressure(modisIN%nSunlit,modisIN%nColumns)) - ! Call simulator - do i = 1, modisIN%nSunlit - call modis_subcolumn(modisIN%Ncolumns,modisIN%Nlevels,modisIN%pres(i,:), & + if ((Lisccp_subcolumn .or. Lmodis_subcolumn) .and. (cospIN % cospswathsIN(1) % N_inst_swaths .gt. 0)) then ! If ISCCP is swathed must run ICARUS separately for MODIS + allocate(modisLEVMATCH(modisIN%Npoints,modisIN%Ncolumns), & + modis_boxptop(modisIN%Npoints,modisIN%Ncolumns), & + modis_boxttop(modisIN%Npoints,modisIN%Ncolumns), & + modis_boxtau(modisIN%Npoints,modisIN%Ncolumns), & + modis_meantbclr(modisIN%Npoints)) + if (.not. allocated(MODIS_SWATH_MASK)) then ! Allows to run when there is no swathing + allocate(MODIS_SWATH_MASK(Npoints)) + MODIS_SWATH_MASK(:) = .true. + end if + call icarus_subcolumn(modisIN%npoints,modisIN%ncolumns,modisIN%nlevels, & + int(MERGE(1,0,MASK=(cospgridIN%sunlit > 0) .and. MODIS_SWATH_MASK)), & + modisIN%tau,cospIN%emiss_11,cospgridIN%skt, & + cospIN%emsfc_lw,cospgridIN%qv,cospgridIN%at,cospgridIN%pfull, & + modisIN%pres,cospIN%frac_out,modisLEVMATCH, & + modis_boxtau(:,:),modis_boxptop(:,:), & + modis_boxttop(:,:),modis_meantbclr(:)) + deallocate(modis_boxtau,modis_boxttop,modis_meantbclr,modisLEVMATCH) + else ! If ISCCP runs fully, just use the cospOUT field indexed appropriately + allocate(modis_boxptop(modisIN%Npoints,modisIN%Ncolumns)) + modis_boxptop = cospOUT%isccp_boxptop(ij:ik,:) + end if + ! Call simulator one column at a time on sunlit columns + do i = 1, modisIN%nSunlit ! Just run on the sunlit columns, even though the modisIN DDT includes everything orbit swathed + call modis_subcolumn(modisIN%Ncolumns,modisIN%Nlevels, & + modisIN%pres(int(modisIN%sunlit(i)),:), & modisIN%tau(int(modisIN%sunlit(i)),:,:), & modisIN%liqFrac(int(modisIN%sunlit(i)),:,:), & modisIN%g(int(modisIN%sunlit(i)),:,:), & modisIN%w0(int(modisIN%sunlit(i)),:,:), & - isccp_boxptop(int(modisIN%sunlit(i)),:), & + modis_boxptop(int(modisIN%sunlit(i)),:), & modisRetrievedPhase(i,:), & modisRetrievedCloudTopPressure(i,:), & modisRetrievedTau(i,:),modisRetrievedSize(i,:)) end do + deallocate(modis_boxptop) endif endif @@ -961,12 +978,50 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) endif ! Call simulator - call icarus_column(isccpIN%npoints, isccpIN%ncolumns,isccp_boxtau(:,:), & - isccp_boxptop(:,:)/100._wp, isccpIN%sunlit,isccp_boxttop, & - cospOUT%isccp_fq(ij:ik,:,:), & - cospOUT%isccp_meanalbedocld(ij:ik), & - cospOUT%isccp_meanptop(ij:ik),cospOUT%isccp_meantaucld(ij:ik), & - cospOUT%isccp_totalcldarea(ij:ik),cospOUT%isccp_meantb(ij:ik)) + if (isccpIN%Npoints .gt. 0) then + allocate(temp_isccp_fq(isccpIN%Npoints,numISCCPTauBins,numISCCPPresBins), & + temp_isccp_meanalbedocld(isccpIN%Npoints), & + temp_isccp_meanptop(isccpIN%Npoints), & + temp_isccp_meantaucld(isccpIN%Npoints), & + temp_isccp_totalcldarea(isccpIN%Npoints), & + temp_isccp_meantb(isccpIN%Npoints)) + call icarus_column(isccpIN%npoints, isccpIN%ncolumns,isccp_boxtau(:,:), & + isccp_boxptop(:,:)/100._wp,isccpIN%sunlit,isccp_boxttop(:,:), & + temp_isccp_fq, & + temp_isccp_meanalbedocld, & + temp_isccp_meanptop,temp_isccp_meantaucld, & + temp_isccp_totalcldarea,temp_isccp_meantb) + if (cospIN % cospswathsIN(1) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + ! Decode back to the cospOUT shapes + cospOUT%isccp_fq(ij:ik,:,:) = R_UNDEF + cospOUT%isccp_meanalbedocld(ij:ik) = R_UNDEF + cospOUT%isccp_meanptop(ij:ik) = R_UNDEF + cospOUT%isccp_meantaucld(ij:ik) = R_UNDEF + cospOUT%isccp_totalcldarea(ij:ik) = R_UNDEF + cospOUT%isccp_meantb(ij:ik) = R_UNDEF + if (associated(cospOUT%isccp_fq)) cospOUT%isccp_fq(ij+int(ISCCP_MASK_INDICES)-1,:,:) = temp_isccp_fq(:,:,:) + if (associated(cospOUT%isccp_meanalbedocld)) cospOUT%isccp_meanalbedocld(ij+int(ISCCP_MASK_INDICES)-1) = temp_isccp_meanalbedocld(:) + if (associated(cospOUT%isccp_meanptop)) cospOUT%isccp_meanptop(ij+int(ISCCP_MASK_INDICES)-1) = temp_isccp_meanptop(:) + if (associated(cospOUT%isccp_meantaucld)) cospOUT%isccp_meantaucld(ij+int(ISCCP_MASK_INDICES)-1) = temp_isccp_meantaucld(:) + if (associated(cospOUT%isccp_totalcldarea)) cospOUT%isccp_totalcldarea(ij+int(ISCCP_MASK_INDICES)-1) = temp_isccp_totalcldarea(:) + if (associated(cospOUT%isccp_meantb)) cospOUT%isccp_meantb(ij+int(ISCCP_MASK_INDICES)-1) = temp_isccp_meantb(:) + else + if (associated(cospOUT%isccp_fq)) cospOUT%isccp_fq(ij:ik,:,:) = temp_isccp_fq(:,:,:) + if (associated(cospOUT%isccp_meanalbedocld)) cospOUT%isccp_meanalbedocld(ij:ik) = temp_isccp_meanalbedocld(:) + if (associated(cospOUT%isccp_meanptop)) cospOUT%isccp_meanptop(ij:ik) = temp_isccp_meanptop(:) + if (associated(cospOUT%isccp_meantaucld)) cospOUT%isccp_meantaucld(ij:ik) = temp_isccp_meantaucld(:) + if (associated(cospOUT%isccp_totalcldarea)) cospOUT%isccp_totalcldarea(ij:ik) = temp_isccp_totalcldarea(:) + if (associated(cospOUT%isccp_meantb)) cospOUT%isccp_meantb(ij:ik) = temp_isccp_meantb(:) + end if + deallocate(temp_isccp_fq,temp_isccp_meanalbedocld,temp_isccp_meanptop,temp_isccp_meantaucld,temp_isccp_totalcldarea,temp_isccp_meantb) + else + cospOUT%isccp_fq(ij:ik,:,:) = R_UNDEF + cospOUT%isccp_meanalbedocld(ij:ik) = R_UNDEF + cospOUT%isccp_meanptop(ij:ik) = R_UNDEF + cospOUT%isccp_meantaucld(ij:ik) = R_UNDEF + cospOUT%isccp_totalcldarea(ij:ik) = R_UNDEF + cospOUT%isccp_meantb(ij:ik) = R_UNDEF + end if cospOUT%isccp_fq(ij:ik,:,:) = cospOUT%isccp_fq(ij:ik,:,7:1:-1) ! Check if there is any value slightly greater than 1 @@ -981,6 +1036,7 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) if (allocated(isccp_boxtau)) deallocate(isccp_boxtau) if (allocated(isccp_meantbclr)) deallocate(isccp_meantbclr) if (allocated(isccpLEVMATCH)) deallocate(isccpLEVMATCH) + if (allocated(ISCCP_MASK_INDICES)) deallocate(ISCCP_MASK_INDICES) if (allocated(out1D_1)) then deallocate(out1D_1) nullify(cospOUT%isccp_meanalbedocld) @@ -1021,17 +1077,41 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) if (.not. associated(cospOUT%misr_fq)) then allocate(out1D_3(Npoints*numMISRTauBins*numMISRHgtBins)) cospOUT%misr_fq(ij:ik,1:numMISRTauBins,1:numMISRHgtBins) => out1D_3 - endif + endif ! Call simulator - call misr_column(misrIN%Npoints,misrIN%Ncolumns,misr_boxztop,misrIN%sunlit,& - misr_boxtau,cospOUT%misr_cldarea(ij:ik), & - cospOUT%misr_meanztop(ij:ik),cospOUT%misr_fq(ij:ik,:,:)) - + if (cospIN % cospswathsIN(2) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + if (misrIN%Npoints .gt. 0) then + ! Operate at the masked format. + allocate(temp_misr_cldarea(misrIN%Npoints), & + temp_misr_meanztop(misrIN%Npoints), & + temp_misr_fq(misrIN%Npoints,numMISRTauBins,numMISRHgtBins)) + call misr_column(misrIN%Npoints,misrIN%Ncolumns,misr_boxztop,misrIN%sunlit, & + misr_boxtau,temp_misr_cldarea(:), & + temp_misr_meanztop(:),temp_misr_fq(:,:,:)) + ! Decode back to the cospOUT shapes + cospOUT%misr_cldarea(ij:ik) = R_UNDEF + cospOUT%misr_meanztop(ij:ik) = R_UNDEF + cospOUT%misr_fq(ij:ik,:,:) = R_UNDEF + if (associated(cospOUT%misr_cldarea)) cospOUT%misr_cldarea(ij+int(MISR_MASK_INDICES)-1) = temp_misr_cldarea(:) + if (associated(cospOUT%misr_meanztop)) cospOUT%misr_meanztop(ij+int(MISR_MASK_INDICES)-1) = temp_misr_meanztop(:) + if (associated(cospOUT%misr_fq)) cospOUT%misr_fq(ij+int(MISR_MASK_INDICES)-1,:,:) = temp_misr_fq(:,:,:) + deallocate(temp_misr_cldarea,temp_misr_meanztop,temp_misr_fq) + else + cospOUT%misr_cldarea(ij:ik) = R_UNDEF + cospOUT%misr_meanztop(ij:ik) = R_UNDEF + cospOUT%misr_fq(ij:ik,:,:) = R_UNDEF + endif + else + call misr_column(misrIN%Npoints,misrIN%Ncolumns,misr_boxztop,misrIN%sunlit,& + misr_boxtau,cospOUT%misr_cldarea(ij:ik), & + cospOUT%misr_meanztop(ij:ik),cospOUT%misr_fq(ij:ik,:,:)) + endif ! Clear up memory if (allocated(misr_boxtau)) deallocate(misr_boxtau) if (allocated(misr_boxztop)) deallocate(misr_boxztop) if (allocated(misr_dist_model_layertops)) deallocate(misr_dist_model_layertops) + if (allocated(MISR_MASK_INDICES)) deallocate(MISR_MASK_INDICES) if (allocated(out1D_1)) then deallocate(out1D_1) nullify(cospOUT%misr_cldarea) @@ -1099,21 +1179,104 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) endif ! Call simulator - ok_lidar_cfad=.true. - call lidar_column(calipsoIN%Npoints, calipsoIN%Ncolumns, calipsoIN%Nlevels, & - Nlvgrid, SR_BINS, LIDAR_NTYPE, 'calipso',calipso_beta_tot(:,:,:), calipso_beta_mol(:,:),& - cospgridIN%phalf(:,2:calipsoIN%Nlevels+1),cospgridIN%hgt_matrix, & - cospgridIN%hgt_matrix_half, vgrid_z(:), ok_lidar_cfad, LIDAR_NCAT, & - cospOUT%calipso_cfad_sr(ij:ik,:,:), cospOUT%calipso_lidarcld(ij:ik,:), & - cospOUT%calipso_cldlayer(ij:ik,:), & - cospgridIN%at(:,:), calipso_betaperp_tot(:,:,:), cospgridIN%surfelev, & - cospOUT%calipso_lidarcldphase(ij:ik,:,:), & - cospOUT%calipso_lidarcldtype(ij:ik,:,:), cospOUT%calipso_cldtype(ij:ik,:), & - cospOUT%calipso_cldtypetemp(ij:ik,:), cospOUT%calipso_cldtypemeanz(ij:ik,:), & - cospOUT%calipso_cldtypemeanzse(ij:ik,:), cospOUT%calipso_cldthinemis(ij:ik), & - cospOUT%calipso_cldlayerphase(ij:ik,:,:), cospOUT%calipso_lidarcldtmp(ij:ik,:,:)) - - if (associated(cospOUT%calipso_srbval)) cospOUT%calipso_srbval = calipso_histBsct + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + ! Operate at the masked format. + if (calipsoIN%Npoints .gt. 0) then + allocate(temp_calipso_cfad_sr(calipsoIN%Npoints,SR_BINS,Nlvgrid), & + temp_calipso_lidarcld(calipsoIN%Npoints,Nlvgrid), & + temp_calipso_cldlayer(calipsoIN%Npoints,LIDAR_NCAT), & + temp_calipso_lidarcldphase(calipsoIN%Npoints,Nlvgrid,6), & + temp_calipso_lidarcldtype(calipsoIN%Npoints,Nlvgrid,LIDAR_NTYPE+1), & + temp_calipso_cldtype(calipsoIN%Npoints,LIDAR_NTYPE), & + temp_calipso_cldtypetemp(calipsoIN%Npoints,LIDAR_NTYPE), & + temp_calipso_cldtypemeanz(calipsoIN%Npoints,2), & + temp_calipso_cldtypemeanzse(calipsoIN%Npoints,3), & + temp_calipso_cldthinemis(calipsoIN%Npoints), & + temp_calipso_cldlayerphase(calipsoIN%Npoints,LIDAR_NCAT,6), & + temp_calipso_lidarcldtmp(calipsoIN%Npoints,LIDAR_NTEMP,5)) + ok_lidar_cfad=.true. + call lidar_column(calipsoIN%Npoints, calipsoIN%Ncolumns, calipsoIN%Nlevels, & + Nlvgrid, SR_BINS, LIDAR_NTYPE, 'calipso',calipso_beta_tot(:,:,:), calipso_beta_mol(:,:), & + cospgridIN%phalf(int(CSCAL_MASK_INDICES),2:calipsoIN%Nlevels+1), & + cospgridIN%hgt_matrix(int(CSCAL_MASK_INDICES),:), & + cospgridIN%hgt_matrix_half(int(CSCAL_MASK_INDICES),:), vgrid_z(:), ok_lidar_cfad, LIDAR_NCAT, & + temp_calipso_cfad_sr(:,:,:), temp_calipso_lidarcld(:,:), temp_calipso_cldlayer(:,:), & + cospgridIN%at(int(CSCAL_MASK_INDICES),:), calipso_betaperp_tot(:,:,:), & + cospgridIN%surfelev(int(CSCAL_MASK_INDICES)), & + temp_calipso_lidarcldphase(:,:,:), & + temp_calipso_lidarcldtype(:,:,:), temp_calipso_cldtype(:,:), & + temp_calipso_cldtypetemp(:,:), temp_calipso_cldtypemeanz(:,:), & + temp_calipso_cldtypemeanzse(:,:), temp_calipso_cldthinemis(:), & + temp_calipso_cldlayerphase(:,:,:), temp_calipso_lidarcldtmp(:,:,:)) + ! Decode back to the cospOUT shapes + cospOUT%calipso_cfad_sr(ij:ik,:,:) = R_UNDEF + cospOUT%calipso_lidarcld(ij:ik,:) = R_UNDEF + cospOUT%calipso_cldlayer(ij:ik,:) = R_UNDEF + cospOUT%calipso_lidarcldphase(ij:ik,:,:) = R_UNDEF + cospOUT%calipso_lidarcldtype(ij:ik,:,:) = R_UNDEF + cospOUT%calipso_cldtype(ij:ik,:) = R_UNDEF + cospOUT%calipso_cldtypetemp(ij:ik,:) = R_UNDEF + cospOUT%calipso_cldtypemeanz(ij:ik,:) = R_UNDEF + cospOUT%calipso_cldtypemeanzse(ij:ik,:) = R_UNDEF + cospOUT%calipso_cldthinemis(ij:ik) = R_UNDEF + cospOUT%calipso_cldlayerphase(ij:ik,:,:) = R_UNDEF + cospOUT%calipso_lidarcldtmp(ij:ik,:,:) = R_UNDEF + ! Note: The active simulators use R_UNDEF to indicate unretrieved and clear-sky values. + ! Decisions on how to treat these values are delegeate to the host user, and fields + ! are often set to zero. + ! Using R_UNDEF in this way is incompatible with the swath approach, where R_UNDEF means + ! that a field should not be used in statistically averaging, etc. + ! To avoid this error, when swathing we set R_UNDEF value to zero here. + where (temp_calipso_cfad_sr(:,:,:) == R_UNDEF) temp_calipso_cfad_sr(:,:,:) = 0._wp + where (temp_calipso_lidarcldphase(:,:,:) == R_UNDEF) temp_calipso_lidarcldphase(:,:,:) = 0._wp + where (temp_calipso_lidarcld(:,:) == R_UNDEF) temp_calipso_lidarcld(:,:) = 0._wp + ! Unpack into the full lat-lon structure + if (associated(cospOUT%calipso_cfad_sr)) cospOUT%calipso_cfad_sr(ij+int(CSCAL_MASK_INDICES)-1,:,:) = temp_calipso_cfad_sr(:,:,:) + if (associated(cospOUT%calipso_lidarcld)) cospOUT%calipso_lidarcld(ij+int(CSCAL_MASK_INDICES)-1,:) = temp_calipso_lidarcld(:,:) + if (associated(cospOUT%calipso_cldlayer)) cospOUT%calipso_cldlayer(ij+int(CSCAL_MASK_INDICES)-1,:) = temp_calipso_cldlayer(:,:) + if (associated(cospOUT%calipso_lidarcldphase)) cospOUT%calipso_lidarcldphase(ij+int(CSCAL_MASK_INDICES)-1,:,:) = temp_calipso_lidarcldphase(:,:,:) + if (associated(cospOUT%calipso_lidarcldtype)) cospOUT%calipso_lidarcldtype(ij+int(CSCAL_MASK_INDICES)-1,:,:) = temp_calipso_lidarcldtype(:,:,:) + if (associated(cospOUT%calipso_cldtype)) cospOUT%calipso_cldtype(ij+int(CSCAL_MASK_INDICES)-1,:) = temp_calipso_cldtype(:,:) + if (associated(cospOUT%calipso_cldtypetemp)) cospOUT%calipso_cldtypetemp(ij+int(CSCAL_MASK_INDICES)-1,:) = temp_calipso_cldtypetemp(:,:) + if (associated(cospOUT%calipso_cldtypemeanz)) cospOUT%calipso_cldtypemeanz(ij+int(CSCAL_MASK_INDICES)-1,:) = temp_calipso_cldtypemeanz(:,:) + if (associated(cospOUT%calipso_cldtypemeanzse)) cospOUT%calipso_cldtypemeanzse(ij+int(CSCAL_MASK_INDICES)-1,:) = temp_calipso_cldtypemeanzse(:,:) + if (associated(cospOUT%calipso_cldthinemis)) cospOUT%calipso_cldthinemis(ij+int(CSCAL_MASK_INDICES)-1) = temp_calipso_cldthinemis(:) + if (associated(cospOUT%calipso_cldlayerphase)) cospOUT%calipso_cldlayerphase(ij+int(CSCAL_MASK_INDICES)-1,:,:) = temp_calipso_cldlayerphase(:,:,:) + if (associated(cospOUT%calipso_lidarcldtmp)) cospOUT%calipso_lidarcldtmp(ij+int(CSCAL_MASK_INDICES)-1,:,:) = temp_calipso_lidarcldtmp(:,:,:) + deallocate(temp_calipso_cfad_sr,temp_calipso_lidarcld,temp_calipso_cldlayer,temp_calipso_lidarcldphase, & + temp_calipso_lidarcldtype,temp_calipso_cldtype,temp_calipso_cldtypetemp,temp_calipso_cldtypemeanz, & + temp_calipso_cldtypemeanzse,temp_calipso_cldthinemis,temp_calipso_cldlayerphase,temp_calipso_lidarcldtmp) + else + cospOUT%calipso_cfad_sr(ij:ik,:,:) = R_UNDEF + cospOUT%calipso_lidarcld(ij:ik,:) = R_UNDEF + cospOUT%calipso_cldlayer(ij:ik,:) = R_UNDEF + cospOUT%calipso_lidarcldphase(ij:ik,:,:) = R_UNDEF + cospOUT%calipso_lidarcldtype(ij:ik,:,:) = R_UNDEF + cospOUT%calipso_cldtype(ij:ik,:) = R_UNDEF + cospOUT%calipso_cldtypetemp(ij:ik,:) = R_UNDEF + cospOUT%calipso_cldtypemeanz(ij:ik,:) = R_UNDEF + cospOUT%calipso_cldtypemeanzse(ij:ik,:) = R_UNDEF + cospOUT%calipso_cldthinemis(ij:ik) = R_UNDEF + cospOUT%calipso_cldlayerphase(ij:ik,:,:) = R_UNDEF + cospOUT%calipso_lidarcldtmp(ij:ik,:,:) = R_UNDEF + endif + else + ok_lidar_cfad=.true. + call lidar_column(calipsoIN%Npoints, calipsoIN%Ncolumns, calipsoIN%Nlevels, & + Nlvgrid, SR_BINS, LIDAR_NTYPE, 'calipso',calipso_beta_tot(:,:,:), calipso_beta_mol(:,:),& + cospgridIN%phalf(:,2:calipsoIN%Nlevels+1),cospgridIN%hgt_matrix, & + cospgridIN%hgt_matrix_half, vgrid_z(:), ok_lidar_cfad, LIDAR_NCAT, & + cospOUT%calipso_cfad_sr(ij:ik,:,:), cospOUT%calipso_lidarcld(ij:ik,:), & + cospOUT%calipso_cldlayer(ij:ik,:), & + cospgridIN%at(:,:), calipso_betaperp_tot(:,:,:), cospgridIN%surfelev, & + cospOUT%calipso_lidarcldphase(ij:ik,:,:), & + cospOUT%calipso_lidarcldtype(ij:ik,:,:), cospOUT%calipso_cldtype(ij:ik,:), & + cospOUT%calipso_cldtypetemp(ij:ik,:), cospOUT%calipso_cldtypemeanz(ij:ik,:), & + cospOUT%calipso_cldtypemeanzse(ij:ik,:), cospOUT%calipso_cldthinemis(ij:ik), & + cospOUT%calipso_cldlayerphase(ij:ik,:,:), cospOUT%calipso_lidarcldtmp(ij:ik,:,:)) + endif + + if (associated(cospOUT%calipso_srbval)) cospOUT%calipso_srbval = calipso_histBsct ! Free up memory (if necessary) if (allocated(out1D_1)) then @@ -1225,20 +1388,46 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) allocate(out1D_3(Npoints*LIDAR_NCAT)) cospOUT%atlid_cldlayer(ij:ik,1:LIDAR_NCAT) => out1D_3 endif - ! Call simulator ok_lidar_cfad_atlid=.true. - call lidar_column(atlidIN%Npoints, atlidIN%Ncolumns, atlidIN%Nlevels, & - Nlvgrid, SR_BINS, LIDAR_NTYPE, 'atlid',atlid_beta_tot(:,:,:), & - atlid_beta_mol(:,:), cospgridIN%phalf(:,2:atlidIN%Nlevels+1), & - cospgridIN%hgt_matrix, cospgridIN%hgt_matrix_half, vgrid_z(:), & - ok_lidar_cfad_atlid, LIDAR_NCAT, cospOUT%atlid_cfad_sr(ij:ik,:,:), & - cospOUT%atlid_lidarcld(ij:ik,:), cospOUT%atlid_cldlayer(ij:ik,:)) - + if (cospIN % cospswathsIN(4) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + if (atlidIN%Npoints .gt. 0) then + allocate(temp_atlid_cfad_sr(atlidIN%Npoints,SR_BINS,Nlvgrid), & + temp_atlid_lidarcld(atlidIN%Npoints,Nlvgrid), & + temp_atlid_cldlayer(atlidIN%Npoints,LIDAR_NCAT)) + call lidar_column(atlidIN%Npoints, atlidIN%Ncolumns, atlidIN%Nlevels, & + Nlvgrid, SR_BINS, LIDAR_NTYPE, 'atlid',atlid_beta_tot(:,:,:), & + atlid_beta_mol(:,:), cospgridIN%phalf(int(ATLID_MASK_INDICES),2:atlidIN%Nlevels+1), & + cospgridIN%hgt_matrix(int(ATLID_MASK_INDICES),:), & + cospgridIN%hgt_matrix_half(int(ATLID_MASK_INDICES),:), vgrid_z(:), & + ok_lidar_cfad_atlid, LIDAR_NCAT, temp_atlid_cfad_sr(:,:,:), & + temp_atlid_lidarcld(:,:), temp_atlid_cldlayer(:,:)) + ! Decode back to the cospOUT shapes + cospOUT%atlid_cfad_sr(ij:ik,:,:) = R_UNDEF + cospOUT%atlid_lidarcld(ij:ik,:) = R_UNDEF + cospOUT%atlid_cldlayer(ij:ik,:) = R_UNDEF + if (associated(cospOUT%atlid_cfad_sr)) cospOUT%atlid_cfad_sr(ij+int(ATLID_MASK_INDICES)-1,:,:) = temp_atlid_cfad_sr(:,:,:) + if (associated(cospOUT%atlid_lidarcld)) cospOUT%atlid_lidarcld(ij+int(ATLID_MASK_INDICES)-1,:) = temp_atlid_lidarcld(:,:) + if (associated(cospOUT%atlid_cldlayer)) cospOUT%atlid_cldlayer(ij+int(ATLID_MASK_INDICES)-1,:) = temp_atlid_cldlayer(:,:) + deallocate(temp_atlid_cfad_sr,temp_atlid_lidarcld,temp_atlid_cldlayer) + else + cospOUT%atlid_cfad_sr(ij:ik,:,:) = R_UNDEF + cospOUT%atlid_lidarcld(ij:ik,:) = R_UNDEF + cospOUT%atlid_cldlayer(ij:ik,:) = R_UNDEF + endif + else + call lidar_column(atlidIN%Npoints, atlidIN%Ncolumns, atlidIN%Nlevels, & + Nlvgrid, SR_BINS, LIDAR_NTYPE, 'atlid',atlid_beta_tot(:,:,:), & + atlid_beta_mol(:,:), cospgridIN%phalf(:,2:atlidIN%Nlevels+1), & + cospgridIN%hgt_matrix, cospgridIN%hgt_matrix_half, vgrid_z(:), & + ok_lidar_cfad_atlid, LIDAR_NCAT, cospOUT%atlid_cfad_sr(ij:ik,:,:), & + cospOUT%atlid_lidarcld(ij:ik,:), cospOUT%atlid_cldlayer(ij:ik,:)) + endif if (associated(cospOUT%atlid_srbval)) cospOUT%atlid_srbval = atlid_histBsct - ! Free up memory (if necessary) - if (allocated(out1D_1)) then + ! Free up memory (if necessary) + if (allocated(ATLID_MASK_INDICES)) deallocate(ATLID_MASK_INDICES) + if (allocated(out1D_1)) then deallocate(out1D_1) nullify(cospOUT%atlid_cfad_sr) endif @@ -1255,10 +1444,34 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) ! PARASOL if (Lparasol_column) then - call parasol_column(parasolIN%Npoints,PARASOL_NREFL,parasolIN%Ncolumns, & - cospgridIN%land(:),parasolPix_refl(:,:,:), & - cospOUT%parasolGrid_refl(ij:ik,:)) - if (allocated(parasolPix_refl)) deallocate(parasolPix_refl) + if (cospIN % cospswathsIN(5) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + if (parasolIN%Npoints .gt. 0) then + allocate(temp_parasolGrid_refl(parasolIN%Npoints,PARASOL_NREFL)) + call parasol_column(parasolIN%Npoints,PARASOL_NREFL,parasolIN%Ncolumns, & + cospgridIN%land(int(PARASOL_MASK_INDICES)),parasolPix_refl(:,:,:), & + temp_parasolGrid_refl(:,:)) + ! Decode back to the cospOUT shapes + cospOUT%parasolGrid_refl(ij:ik,:) = R_UNDEF + ! Note: The active simulators use R_UNDEF to indicate unretrieved and clear-sky values. + ! Decisions on how to treat these values are delegeate to the host user, and fields + ! are often set to zero. + ! Using R_UNDEF in this way is incompatible with the swath approach, where R_UNDEF means + ! that a field should not be used in statistically averaging, etc. + ! To avoid this error, when swathing we set R_UNDEF value to zero here. + where (temp_parasolGrid_refl(:,:) == R_UNDEF) temp_parasolGrid_refl(:,:) = 0._wp + if (associated(cospOUT%parasolGrid_refl)) cospOUT%parasolGrid_refl(ij+int(PARASOL_MASK_INDICES)-1,:) = temp_parasolGrid_refl(:,:) + deallocate(temp_parasolGrid_refl) + else + cospOUT%parasolGrid_refl(ij:ik,:) = R_UNDEF + endif + else + call parasol_column(parasolIN%Npoints,PARASOL_NREFL,parasolIN%Ncolumns, & + cospgridIN%land(:),parasolPix_refl(:,:,:), & + cospOUT%parasolGrid_refl(ij:ik,:)) + ! print*,'cospOUT%parasolGrid_refl: ',cospOUT%parasolGrid_refl ! Values not zeroed here. + endif + if (allocated(parasolPix_refl)) deallocate(parasolPix_refl) + if (allocated(PARASOL_MASK_INDICES)) deallocate(PARASOL_MASK_INDICES) endif ! CLOUDSAT @@ -1279,12 +1492,46 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) endif ! Call simulator - call quickbeam_column(cloudsatIN%Npoints, cloudsatIN%Ncolumns, cloudsatIN%Nlevels,& - Nlvgrid, cloudsat_DBZE_BINS, 'cloudsat', cloudsatDBZe, cloudsatZe_non, & - cospgridIN%land(:), cospgridIN%surfelev(:), cospgridIN%at(:,cospIN%Nlevels), & - cospIN%fracPrecipIce, cospgridIN%hgt_matrix, cospgridIN%hgt_matrix_half, & - cospOUT%cloudsat_cfad_ze(ij:ik,:,:), cospOUT%cloudsat_precip_cover(ij:ik,:), & - cospOUT%cloudsat_pia(ij:ik)) + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + if (cloudsatIN%Npoints .gt. 0) then + allocate(temp_cloudsat_cfad_ze(cloudsatIN%Npoints,cloudsat_DBZE_BINS,Nlvgrid), & + temp_cloudsat_precip_cover(cloudsatIN%Npoints,cloudsat_DBZE_BINS), & + temp_cloudsat_pia(cloudsatIN%Npoints)) + call quickbeam_column(cloudsatIN%Npoints, cloudsatIN%Ncolumns, cloudsatIN%Nlevels, & + Nlvgrid, cloudsat_DBZE_BINS, 'cloudsat', cloudsatDBZe, cloudsatZe_non, & + cospgridIN%land(int(CSCAL_MASK_INDICES)), cospgridIN%surfelev(int(CSCAL_MASK_INDICES)), & + cospgridIN%at(int(CSCAL_MASK_INDICES),cospIN%Nlevels), cospIN%fracPrecipIce(int(CSCAL_MASK_INDICES),:), & + cospgridIN%hgt_matrix(int(CSCAL_MASK_INDICES),:), cospgridIN%hgt_matrix_half(int(CSCAL_MASK_INDICES),:), & + temp_cloudsat_cfad_ze(:,:,:), temp_cloudsat_precip_cover(:,:), temp_cloudsat_pia(:)) + ! Decode back to the cospOUT shapes + cospOUT%cloudsat_cfad_ze(ij:ik,:,:) = R_UNDEF + cospOUT%cloudsat_precip_cover(ij:ik,:) = R_UNDEF + cospOUT%cloudsat_pia(ij:ik) = R_UNDEF + ! Note: The active simulators use R_UNDEF to indicate unretrieved and clear-sky values. + ! Decisions on how to treat these values are delegeate to the host user, and fields + ! are often set to zero. + ! Using R_UNDEF in this way is incompatible with the swath approach, where R_UNDEF means + ! that a field should not be used in statistically averaging, etc. + ! To avoid this error, when swathing we set R_UNDEF value to zero here. + where (temp_cloudsat_cfad_ze(:,:,:) == R_UNDEF) temp_cloudsat_cfad_ze(:,:,:) = 0._wp + if (associated(cospOUT%cloudsat_cfad_ze)) cospOUT%cloudsat_cfad_ze(ij+int(CSCAL_MASK_INDICES)-1,:,:) = temp_cloudsat_cfad_ze(:,:,:) + if (associated(cospOUT%cloudsat_precip_cover)) cospOUT%cloudsat_precip_cover(ij+int(CSCAL_MASK_INDICES)-1,:) = temp_cloudsat_precip_cover(:,:) + if (associated(cospOUT%cloudsat_pia)) cospOUT%cloudsat_pia(ij+int(CSCAL_MASK_INDICES)-1) = temp_cloudsat_pia(:) + deallocate(temp_cloudsat_cfad_ze,temp_cloudsat_precip_cover,temp_cloudsat_pia) + if (allocated(CSCAL_SWATH_MASK)) deallocate(CSCAL_SWATH_MASK) + else + cospOUT%cloudsat_cfad_ze(ij:ik,:,:) = R_UNDEF + cospOUT%cloudsat_precip_cover(ij:ik,:) = R_UNDEF + cospOUT%cloudsat_pia(ij:ik) = R_UNDEF + endif + else + call quickbeam_column(cloudsatIN%Npoints, cloudsatIN%Ncolumns, cloudsatIN%Nlevels,& + Nlvgrid, cloudsat_DBZE_BINS, 'cloudsat', cloudsatDBZe, cloudsatZe_non, & + cospgridIN%land(:), cospgridIN%surfelev(:), cospgridIN%at(:,cospIN%Nlevels), & + cospIN%fracPrecipIce, cospgridIN%hgt_matrix, cospgridIN%hgt_matrix_half, & + cospOUT%cloudsat_cfad_ze(ij:ik,:,:), cospOUT%cloudsat_precip_cover(ij:ik,:), & + cospOUT%cloudsat_pia(ij:ik)) + endif ! Free up memory (if necessary) if (allocated(out1D_1)) then deallocate(out1D_1) @@ -1302,7 +1549,7 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) ! MODIS if (Lmodis_column) then - if(modisiN%nSunlit > 0) then + if (modisIN%nSunlit > 0) then ! Allocate space for local variables allocate(modisCftotal(modisIN%nSunlit), modisCfLiquid(modisIN%nSunlit), & modisCfIce(modisIN%nSunlit),modisCfHigh(modisIN%nSunlit), & @@ -1442,10 +1689,12 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) endif if (associated(cospOUT%modis_Optical_Thickness_vs_ReffIce)) then + ! cospOUT%modis_Optical_Thickness_vs_ReffIce(ij:ik,1:numMODISTauBins,:) = R_UNDEF cospOUT%modis_Optical_Thickness_vs_ReffIce(ij+int(modisIN%sunlit(:))-1, 1:numMODISTauBins,:) = & modisJointHistogramIce(:,:,:) endif if (associated(cospOUT%modis_Optical_Thickness_vs_ReffLiq)) then + ! cospOUT%modis_Optical_Thickness_vs_ReffLiq(ij:ik,:,:) = R_UNDEF cospOUT%modis_Optical_Thickness_vs_ReffLiq(ij+int(modisIN%sunlit(:))-1, 1:numMODISTauBins,:) = & modisJointHistogramLiq(:,:,:) endif @@ -1488,6 +1737,10 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) cospOUT%modis_Ice_Water_Path_Mean(ij+int(modisIN%notSunlit(:))-1) = R_UNDEF if (associated(cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure)) & cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure(ij+int(modisIN%notSunlit(:))-1, :, :) = R_UNDEF + ! if (associated(cospOUT%modis_Optical_Thickness_vs_ReffIce)) & + ! cospOUT%modis_Optical_Thickness_vs_ReffIce(ij+int(modisIN%notSunlit(:))-1, :, :) = R_UNDEF + ! if (associated(cospOUT%modis_Optical_Thickness_vs_ReffLiq)) & + ! cospOUT%modis_Optical_Thickness_vs_ReffLiq(ij+int(modisIN%notSunlit(:))-1, :, :) = R_UNDEF end if else ! It's nightime everywhere - everything is undefined @@ -1527,6 +1780,10 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) cospOUT%modis_Ice_Water_Path_Mean(ij:ik) = R_UNDEF if (associated(cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure)) & cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure(ij:ik, :, :) = R_UNDEF + ! if (associated(cospOUT%modis_Optical_Thickness_vs_ReffIce)) & + ! cospOUT%modis_Optical_Thickness_vs_ReffIce(ij:ik, :, :) = R_UNDEF + ! if (associated(cospOUT%modis_Optical_Thickness_vs_ReffLiq)) & + ! cospOUT%modis_Optical_Thickness_vs_ReffLiq(ij:ik, :, :) = R_UNDEF endif ! Free up memory (if necessary) if (allocated(modisRetrievedTau)) deallocate(modisRetrievedTau) @@ -1562,23 +1819,91 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) if (allocated(isccp_boxtau)) deallocate(isccp_boxtau) if (allocated(isccp_meantbclr)) deallocate(isccp_meantbclr) if (allocated(isccpLEVMATCH)) deallocate(isccpLEVMATCH) + if (allocated(MODIS_SWATH_MASK)) deallocate(MODIS_SWATH_MASK) endif - ! RTTOV - if (lrttov_column) then - call rttov_column(rttovIN%nPoints,rttovIN%nLevels,rttovIN%nSubCols,rttovIN%q, & - rttovIN%p,rttovIN%t,rttovIN%o3,rttovIN%ph,rttovIN%h_surf, & - rttovIN%u_surf,rttovIN%v_surf,rttovIN%p_surf,rttovIN%t_skin, & - rttovIN%t2m,rttovIN%q2m,rttovIN%lsmask,rttovIN%longitude, & - rttovIN%latitude,rttovIN%seaice,rttovIN%co2,rttovIN%ch4, & - rttovIN%n2o,rttovIN%co,rttovIN%zenang,lrttov_cleanUp, & - cospOUT%rttov_tbs(ij:ik,:),cosp_simulator(nError+1), & - ! Optional arguments for surface emissivity calculation - month=rttovIN%month) - ! Optional arguments to rttov for all-sky calculation - ! rttovIN%month, rttovIN%tca,rttovIN%cldIce,rttovIN%cldLiq, & - ! rttovIN%fl_rain,rttovIN%fl_snow) - endif + ! RTTOV multi-instrument + if (Lrttov_column) then + do i=1,cospIN%Ninst_rttov + ! Allocate memory for the outputs - I won't need all of these in every situation. + ! Only allocate clear-sky memory when PC-RTTOV is run. + if (cospIN % cfg_rttov(i) % Lrttov_pc) then + allocate(rttov_bt_clear(rttovIN%Npoints,cospIN % cfg_rttov(i) % nchan_out)) ! all-sky brightness temp + allocate(rttov_rad_clear(rttovIN%Npoints,cospIN % cfg_rttov(i) % nchan_out)) ! all-sky radiance + ! Init to R_UNDEF - JKS check + rttov_bt_clear(:,:) = R_UNDEF + rttov_rad_clear(:,:) = R_UNDEF + ! Run simulator + call cosp_rttov_simulate(rttovIN,cospIN%cfg_rttov(i), & ! Inputs + cosp_simulator(nError+1), & ! Error message holder + bt_clear=rttov_bt_clear, & ! Clear-sky BT + rad_clear=rttov_rad_clear) ! Clear-sky radiance + else + allocate(rttov_bt_total(rttovIN%Npoints,cospIN % cfg_rttov(i) % nchan_out)) ! all-sky brightness temp + allocate(rttov_bt_clear(rttovIN%Npoints,cospIN % cfg_rttov(i) % nchan_out)) ! clear-sky brightness temp + allocate(rttov_rad_total(rttovIN%Npoints,cospIN % cfg_rttov(i) % nchan_out)) ! all-sky brightness temp + allocate(rttov_rad_clear(rttovIN%Npoints,cospIN % cfg_rttov(i) % nchan_out)) ! clear-sky brightness temp + allocate(rttov_rad_cloudy(rttovIN%Npoints,cospIN % cfg_rttov(i) % nchan_out)) ! cloudy-sky brightness temp + allocate(rttov_refl_total(rttovIN%Npoints,cospIN % cfg_rttov(i) % nchan_out)) ! all-sky Bi-directional reflectance factor + allocate(rttov_refl_clear(rttovIN%Npoints,cospIN % cfg_rttov(i) % nchan_out)) ! clear-sky Bi-directional reflectance factor + ! Init to R_UNDEF + rttov_bt_total(:,:) = R_UNDEF + rttov_bt_clear(:,:) = R_UNDEF + rttov_rad_total(:,:) = R_UNDEF + rttov_rad_clear(:,:) = R_UNDEF + rttov_rad_cloudy(:,:) = R_UNDEF + rttov_refl_total(:,:) = R_UNDEF + rttov_refl_clear(:,:) = R_UNDEF + ! Run simulator + call cosp_rttov_simulate(rttovIN,cospIN%cfg_rttov(i), & ! Inputs + cosp_simulator(nError+1), & ! Error message holder + bt_total=rttov_bt_total, & ! Brightness Temp Outputs + bt_clear=rttov_bt_clear, & + rad_total=rttov_rad_total, & ! Radiance Outputs + rad_clear=rttov_rad_clear, & + rad_cloudy=rttov_rad_cloudy, & + refl_total=rttov_refl_total, & ! Reflectance Outputs + refl_clear=rttov_refl_clear, & + debug=verbose) + endif + + ! Write to cospOUT + if (associated(cospOUT % rttov_outputs(i) % channel_indices)) & + cospOUT % rttov_outputs(i) % channel_indices(:) = cospIN % cfg_rttov(i) % iChannel + if (cospIN % cfg_rttov(i) % Lrttov_pc) then + if (associated(cospOUT % rttov_outputs(i) % bt_total_pc)) & + cospOUT % rttov_outputs(i) % bt_total_pc(ij:ik,:) = rttov_bt_clear + if (associated(cospOUT % rttov_outputs(i) % rad_total_pc)) & + cospOUT % rttov_outputs(i) % rad_total_pc(ij:ik,:) = rttov_rad_clear + else + if (associated(cospOUT % rttov_outputs(i) % bt_total)) & + cospOUT % rttov_outputs(i) % bt_total(ij:ik,:) = rttov_bt_total + if (associated(cospOUT % rttov_outputs(i) % bt_clear)) & + cospOUT % rttov_outputs(i) % bt_clear(ij:ik,:) = rttov_bt_clear + if (associated(cospOUT % rttov_outputs(i) % rad_total)) & + cospOUT % rttov_outputs(i) % rad_total(ij:ik,:) = rttov_rad_total + if (associated(cospOUT % rttov_outputs(i) % rad_clear)) & + cospOUT % rttov_outputs(i) % rad_clear(ij:ik,:) = rttov_rad_clear + if (associated(cospOUT % rttov_outputs(i) % rad_cloudy)) & + cospOUT % rttov_outputs(i) % rad_cloudy(ij:ik,:) = rttov_rad_cloudy + if (associated(cospOUT % rttov_outputs(i) % refl_total)) & + cospOUT % rttov_outputs(i) % refl_total(ij:ik,:) = rttov_refl_total + if (associated(cospOUT % rttov_outputs(i) % refl_clear)) & + cospOUT % rttov_outputs(i) % refl_clear(ij:ik,:) = rttov_refl_clear + endif + + ! Free up memory from output (if necessary) + if (allocated(rttov_bt_total)) deallocate(rttov_bt_total) + if (allocated(rttov_bt_clear)) deallocate(rttov_bt_clear) + if (allocated(rttov_rad_total)) deallocate(rttov_rad_total) + if (allocated(rttov_rad_clear)) deallocate(rttov_rad_clear) + if (allocated(rttov_rad_cloudy)) deallocate(rttov_rad_cloudy) + if (allocated(rttov_refl_total)) deallocate(rttov_refl_total) + if (allocated(rttov_refl_clear)) deallocate(rttov_refl_clear) + + end do + + endif !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! 6) Compute multi-instrument products @@ -1586,165 +1911,300 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) ! CLOUDSAT/CALIPSO products if (Lradar_lidar_tcc .or. Llidar_only_freq_cloud .or. Lcloudsat_tcc .or. Lcloudsat_tcc2) then - - if (use_vgrid) then - allocate(lidar_only_freq_cloud(cloudsatIN%Npoints,Nlvgrid), & - radar_lidar_tcc(cloudsatIN%Npoints), cloudsat_tcc(cloudsatIN%Npoints), & - cloudsat_tcc2(cloudsatIN%Npoints)) - allocate(betamol_in(cloudsatIN%Npoints,1,cloudsatIN%Nlevels), & - betamoli(cloudsatIN%Npoints,1,Nlvgrid), & - pnormI(cloudsatIN%Npoints,cloudsatIN%Ncolumns,Nlvgrid), & - Ze_totI(cloudsatIN%Npoints,cloudsatIN%Ncolumns,Nlvgrid)) - - ! Regrid in the vertical (*NOTE* This routine requires SFC-2-TOA ordering, so flip - ! inputs and outputs to maintain TOA-2-SFC ordering convention in COSP2.) - betamol_in(:,1,:) = calipso_beta_mol(:,cloudsatIN%Nlevels:1:-1) - call cosp_change_vertical_grid(cloudsatIN%Npoints,1,cloudsatIN%Nlevels, & - cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & - cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1),betamol_in, & - Nlvgrid,vgrid_zl(Nlvgrid:1:-1),vgrid_zu(Nlvgrid:1:-1), & - betamolI(:,1,Nlvgrid:1:-1)) - - call cosp_change_vertical_grid(cloudsatIN%Npoints,cloudsatIN%Ncolumns, & - cloudsatIN%Nlevels,cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & - cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1), & - calipso_beta_tot(:,:,cloudsatIN%Nlevels:1:-1),Nlvgrid, & - vgrid_zl(Nlvgrid:1:-1),vgrid_zu(Nlvgrid:1:-1),pnormI(:,:,Nlvgrid:1:-1)) - - call cosp_change_vertical_grid(cloudsatIN%Npoints,cloudsatIN%Ncolumns, & - cloudsatIN%Nlevels,cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & - cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1), & - cloudsatDBZe(:,:,cloudsatIN%Nlevels:1:-1),Nlvgrid,vgrid_zl(Nlvgrid:1:-1), & - vgrid_zu(Nlvgrid:1:-1),Ze_totI(:,:,Nlvgrid:1:-1),log_units=.true.) - - call cosp_lidar_only_cloud(cloudsatIN%Npoints, cloudsatIN%Ncolumns, Nlvgrid, & - pnormI, betamolI, Ze_totI, lidar_only_freq_cloud, radar_lidar_tcc, & - cloudsat_tcc, cloudsat_tcc2) - - deallocate(betamol_in,betamolI,pnormI,ze_totI) - else - allocate(lidar_only_freq_cloud(cloudsatIN%Npoints,cloudsatIN%Nlevels), & - radar_lidar_tcc(cloudsatIN%Npoints), cloudsat_tcc(cloudsatIN%Npoints), & - cloudsat_tcc2(cloudsatIN%Npoints)) - call cosp_lidar_only_cloud(cloudsatIN%Npoints,cloudsatIN%Ncolumns, & - cospIN%Nlevels,calipso_beta_tot(:,:,cloudsatIN%Nlevels:1:-1), & - calipso_beta_mol(:,cloudsatIN%Nlevels:1:-1), & - cloudsatDBZe(:,:,cloudsatIN%Nlevels:1:-1),lidar_only_freq_cloud, & - radar_lidar_tcc, cloudsat_tcc, cloudsat_tcc2) + if (calipsoIN%Npoints .gt. 0) then + if (use_vgrid) then + allocate(lidar_only_freq_cloud(cloudsatIN%Npoints,Nlvgrid), & + radar_lidar_tcc(cloudsatIN%Npoints), cloudsat_tcc(cloudsatIN%Npoints), & + cloudsat_tcc2(cloudsatIN%Npoints)) + allocate(betamol_in(cloudsatIN%Npoints,1,cloudsatIN%Nlevels), & + betamolI(cloudsatIN%Npoints,1,Nlvgrid), & + pnormI(cloudsatIN%Npoints,cloudsatIN%Ncolumns,Nlvgrid), & + Ze_totI(cloudsatIN%Npoints,cloudsatIN%Ncolumns,Nlvgrid)) + + ! Regrid in the vertical (*NOTE* This routine requires SFC-2-TOA ordering, so flip + ! inputs and outputs to maintain TOA-2-SFC ordering convention in COSP2.) + ! Use CLOUDSAT masking array here (it is the same as calipso) + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + betamol_in(:,1,:) = calipso_beta_mol(:,cloudsatIN%Nlevels:1:-1) + call cosp_change_vertical_grid(cloudsatIN%Npoints,1,cloudsatIN%Nlevels, & + cospgridIN%hgt_matrix(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1),betamol_in, & + Nlvgrid,vgrid_zl(Nlvgrid:1:-1),vgrid_zu(Nlvgrid:1:-1), & + betamolI(:,1,Nlvgrid:1:-1)) + call cosp_change_vertical_grid(cloudsatIN%Npoints,cloudsatIN%Ncolumns, & + cloudsatIN%Nlevels,cospgridIN%hgt_matrix(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + calipso_beta_tot(:,:,cloudsatIN%Nlevels:1:-1),Nlvgrid, & + vgrid_zl(Nlvgrid:1:-1),vgrid_zu(Nlvgrid:1:-1),pnormI(:,:,Nlvgrid:1:-1)) + call cosp_change_vertical_grid(cloudsatIN%Npoints,cloudsatIN%Ncolumns, & + cloudsatIN%Nlevels,cospgridIN%hgt_matrix(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + cloudsatDBZe(:,:,cloudsatIN%Nlevels:1:-1),Nlvgrid,vgrid_zl(Nlvgrid:1:-1), & + vgrid_zu(Nlvgrid:1:-1),Ze_totI(:,:,Nlvgrid:1:-1),log_units=.true.) + else + betamol_in(:,1,:) = calipso_beta_mol(:,cloudsatIN%Nlevels:1:-1) + call cosp_change_vertical_grid(cloudsatIN%Npoints,1,cloudsatIN%Nlevels, & + cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1),betamol_in, & + Nlvgrid,vgrid_zl(Nlvgrid:1:-1),vgrid_zu(Nlvgrid:1:-1), & + betamolI(:,1,Nlvgrid:1:-1)) + + call cosp_change_vertical_grid(cloudsatIN%Npoints,cloudsatIN%Ncolumns, & + cloudsatIN%Nlevels,cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1), & + calipso_beta_tot(:,:,cloudsatIN%Nlevels:1:-1),Nlvgrid, & + vgrid_zl(Nlvgrid:1:-1),vgrid_zu(Nlvgrid:1:-1),pnormI(:,:,Nlvgrid:1:-1)) + + call cosp_change_vertical_grid(cloudsatIN%Npoints,cloudsatIN%Ncolumns, & + cloudsatIN%Nlevels,cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1), & + cloudsatDBZe(:,:,cloudsatIN%Nlevels:1:-1),Nlvgrid,vgrid_zl(Nlvgrid:1:-1), & + vgrid_zu(Nlvgrid:1:-1),Ze_totI(:,:,Nlvgrid:1:-1),log_units=.true.) + end if + call cosp_lidar_only_cloud(cloudsatIN%Npoints, cloudsatIN%Ncolumns, Nlvgrid, & + pnormI, betamolI, Ze_totI, lidar_only_freq_cloud, radar_lidar_tcc, & + cloudsat_tcc, cloudsat_tcc2) + deallocate(betamol_in,betamolI,pnormI,ze_totI) + else + allocate(lidar_only_freq_cloud(cloudsatIN%Npoints,cloudsatIN%Nlevels), & + radar_lidar_tcc(cloudsatIN%Npoints), cloudsat_tcc(cloudsatIN%Npoints), & + cloudsat_tcc2(cloudsatIN%Npoints)) + call cosp_lidar_only_cloud(cloudsatIN%Npoints,cloudsatIN%Ncolumns, & + cospIN%Nlevels,calipso_beta_tot(:,:,cloudsatIN%Nlevels:1:-1), & + calipso_beta_mol(:,cloudsatIN%Nlevels:1:-1), & + cloudsatDBZe(:,:,cloudsatIN%Nlevels:1:-1),lidar_only_freq_cloud, & + radar_lidar_tcc, cloudsat_tcc, cloudsat_tcc2) + endif endif ! Store, when necessary - if (associated(cospOUT%lidar_only_freq_cloud)) then - cospOUT%lidar_only_freq_cloud(ij:ik,:) = lidar_only_freq_cloud - endif - if (associated(cospOUT%radar_lidar_tcc)) then - cospOUT%radar_lidar_tcc(ij:ik) = radar_lidar_tcc - endif - if (associated(cospOUT%cloudsat_tcc)) then - cospOUT%cloudsat_tcc(ij:ik) = cloudsat_tcc - endif - if (associated(cospOUT%cloudsat_tcc2)) then - cospOUT%cloudsat_tcc2(ij:ik) = cloudsat_tcc2 + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + if (associated(cospOUT%lidar_only_freq_cloud)) then + cospOUT%lidar_only_freq_cloud(ij:ik,:) = R_UNDEF + cospOUT%lidar_only_freq_cloud(ij+int(CSCAL_MASK_INDICES(:))-1,:) = lidar_only_freq_cloud(:,:) + endif + if (associated(cospOUT%radar_lidar_tcc)) then + cospOUT%radar_lidar_tcc(ij:ik) = R_UNDEF + cospOUT%radar_lidar_tcc(ij+int(CSCAL_MASK_INDICES(:))-1) = radar_lidar_tcc(:) + endif + if (associated(cospOUT%cloudsat_tcc)) then + cospOUT%cloudsat_tcc(ij:ik) = R_UNDEF + cospOUT%cloudsat_tcc(ij+int(CSCAL_MASK_INDICES(:))-1) = cloudsat_tcc(:) + endif + if (associated(cospOUT%cloudsat_tcc2)) then + cospOUT%cloudsat_tcc2(ij:ik) = R_UNDEF + cospOUT%cloudsat_tcc2(ij+int(CSCAL_MASK_INDICES(:))-1) = cloudsat_tcc2(:) + endif + else + if (associated(cospOUT%lidar_only_freq_cloud)) then + cospOUT%lidar_only_freq_cloud(ij:ik,:) = lidar_only_freq_cloud + endif + if (associated(cospOUT%radar_lidar_tcc)) then + cospOUT%radar_lidar_tcc(ij:ik) = radar_lidar_tcc + endif + if (associated(cospOUT%cloudsat_tcc)) then + cospOUT%cloudsat_tcc(ij:ik) = cloudsat_tcc + endif + if (associated(cospOUT%cloudsat_tcc2)) then + cospOUT%cloudsat_tcc2(ij:ik) = cloudsat_tcc2 + endif endif endif ! CloudSat/MODIS joint products (CFODDs and Occurrence Frequency of Warm Clouds) if (Lcloudsat_modis_wr) then - allocate( cfodd_ntotal(cloudsatIN%Npoints, CFODD_NDBZE, CFODD_NICOD, CFODD_NCLASS) ) - allocate( wr_occfreq_ntotal(cloudsatIN%Npoints, WR_NREGIME) ) - - if ( use_vgrid ) then - !! interporation for fixed vertical grid: - allocate( zlev(cloudsatIN%Npoints,Nlvgrid), & - t_in(cloudsatIN%Npoints,1,cloudsatIN%Nlevels), & - tempI(cloudsatIN%Npoints,1,Nlvgrid), & - Ze_totI(cloudsatIN%Npoints,cloudsatIN%Ncolumns,Nlvgrid), & - frac_outI(cloudsatIN%Npoints,cloudsatIN%Ncolumns,Nlvgrid) ) - do k = 1, Nlvgrid - zlev(:,k) = vgrid_zu(k) - enddo - t_in(:,1,:) = cospgridIN%at(:,:) - call cosp_change_vertical_grid ( & - cloudsatIN%Npoints, 1, cloudsatIN%Nlevels, & - cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & - cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1), & - t_in(:,:,cloudsatIN%Nlevels:1:-1), Nlvgrid, & - vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), & - tempI(:,:,Nlvgrid:1:-1) ) - call cosp_change_vertical_grid ( & - cloudsatIN%Npoints, cloudsatIN%Ncolumns, cloudsatIN%Nlevels, & - cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & - cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1), & - cloudsatDBZe(:,:,cloudsatIN%Nlevels:1:-1), Nlvgrid, & - vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), & - Ze_totI(:,:,Nlvgrid:1:-1), log_units=.true. ) - call cosp_change_vertical_grid ( & - cloudsatIN%Npoints, cloudsatIN%Ncolumns, cloudsatIN%Nlevels, & - cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & - cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1), & - cospIN%frac_out(:,:,cloudsatIN%Nlevels:1:-1), Nlvgrid, & - vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), & - frac_outI(:,:,Nlvgrid:1:-1) ) - call cosp_diag_warmrain( & - cloudsatIN%Npoints, cloudsatIN%Ncolumns, Nlvgrid, & !! in - tempI, zlev, & !! in - cospOUT%modis_Liquid_Water_Path_Mean(ij:ik), & !! in - cospOUT%modis_Optical_Thickness_Water_Mean(ij:ik), & !! in - cospOUT%modis_Cloud_Particle_Size_Water_Mean(ij:ik), & !! in - cospOUT%modis_Cloud_Fraction_Water_Mean(ij:ik), & !! in - cospOUT%modis_Ice_Water_Path_Mean(ij:ik), & !! in - cospOUT%modis_Optical_Thickness_Ice_Mean(ij:ik), & !! in - cospOUT%modis_Cloud_Particle_Size_Ice_Mean(ij:ik), & !! in - cospOUT%modis_Cloud_Fraction_Ice_Mean(ij:ik), & !! in - frac_outI, & !! in - Ze_totI, & !! in - cfodd_ntotal, wr_occfreq_ntotal ) !! inout - deallocate( zlev, t_in, tempI, frac_outI, Ze_totI ) - else ! do not use vgrid interporation ---------------------------------------! - !! original model grid - call cosp_diag_warmrain( & - cloudsatIN%Npoints, cloudsatIN%Ncolumns, cospIN%Nlevels, & !! in - cospgridIN%at, cospgridIN%hgt_matrix, & !! in - cospOUT%modis_Liquid_Water_Path_Mean(ij:ik), & !! in - cospOUT%modis_Optical_Thickness_Water_Mean(ij:ik), & !! in - cospOUT%modis_Cloud_Particle_Size_Water_Mean(ij:ik), & !! in - cospOUT%modis_Cloud_Fraction_Water_Mean(ij:ik), & !! in - cospOUT%modis_Ice_Water_Path_Mean(ij:ik), & !! in - cospOUT%modis_Optical_Thickness_Ice_Mean(ij:ik), & !! in - cospOUT%modis_Cloud_Particle_Size_Ice_Mean(ij:ik), & !! in - cospOUT%modis_Cloud_Fraction_Ice_Mean(ij:ik), & !! in - cospIN%frac_out, & !! in - cloudsatDBZe, & !! in - cfodd_ntotal, wr_occfreq_ntotal ) !! inout - endif !! use_vgrid or not - - ! Store, when necessary - if ( associated(cospOUT%cfodd_ntotal) ) then - cospOUT%cfodd_ntotal(ij:ik,:,:,:) = cfodd_ntotal - endif - if ( associated(cospOUT%wr_occfreq_ntotal) ) then - cospOUT%wr_occfreq_ntotal(ij:ik,:) = wr_occfreq_ntotal + if (cloudsatIN%Npoints .gt. 0) then + allocate( cfodd_ntotal(cloudsatIN%Npoints, CFODD_NDBZE, CFODD_NICOD, CFODD_NCLASS) ) + allocate( wr_occfreq_ntotal(cloudsatIN%Npoints, WR_NREGIME) ) + + if ( use_vgrid ) then + !! interporation for fixed vertical grid: + allocate( zlev(cloudsatIN%Npoints,Nlvgrid), & + t_in(cloudsatIN%Npoints,1,cloudsatIN%Nlevels), & + tempI(cloudsatIN%Npoints,1,Nlvgrid), & + Ze_totI(cloudsatIN%Npoints,cloudsatIN%Ncolumns,Nlvgrid), & + frac_outI(cloudsatIN%Npoints,cloudsatIN%Ncolumns,Nlvgrid) ) + do k = 1, Nlvgrid + zlev(:,k) = vgrid_zu(k) + enddo + ! Use CLOUDSAT masking array here (it is the same as calipso) + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + t_in(:,1,:) = cospgridIN%at(int(CSCAL_MASK_INDICES(:)),:) + call cosp_change_vertical_grid ( & + cloudsatIN%Npoints, 1, cloudsatIN%Nlevels, & + cospgridIN%hgt_matrix(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + t_in(:,:,cloudsatIN%Nlevels:1:-1), Nlvgrid, & + vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), & + tempI(:,:,Nlvgrid:1:-1) ) + call cosp_change_vertical_grid ( & + cloudsatIN%Npoints, cloudsatIN%Ncolumns, cloudsatIN%Nlevels, & + cospgridIN%hgt_matrix(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + cloudsatDBZe(:,:,cloudsatIN%Nlevels:1:-1), Nlvgrid, & + vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), & + Ze_totI(:,:,Nlvgrid:1:-1), log_units=.true. ) + call cosp_change_vertical_grid ( & + cloudsatIN%Npoints, cloudsatIN%Ncolumns, cloudsatIN%Nlevels, & + cospgridIN%hgt_matrix(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(int(CSCAL_MASK_INDICES(:)),cloudsatIN%Nlevels:1:-1), & + cospIN%frac_out(int(CSCAL_MASK_INDICES(:)),:,cloudsatIN%Nlevels:1:-1), Nlvgrid, & + vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), & + frac_outI(:,:,Nlvgrid:1:-1) ) + call cosp_diag_warmrain( & + cloudsatIN%Npoints, cloudsatIN%Ncolumns, Nlvgrid, & !! in + tempI, zlev, & !! in + cospOUT%modis_Liquid_Water_Path_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Optical_Thickness_Water_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Cloud_Particle_Size_Water_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Cloud_Fraction_Water_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Ice_Water_Path_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Optical_Thickness_Ice_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Cloud_Particle_Size_Ice_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Cloud_Fraction_Ice_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + frac_outI, & !! in + Ze_totI, & !! in + cfodd_ntotal, wr_occfreq_ntotal ) !! inout + else + t_in(:,1,:) = cospgridIN%at(:,:) + call cosp_change_vertical_grid ( & + cloudsatIN%Npoints, 1, cloudsatIN%Nlevels, & + cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1), & + t_in(:,:,cloudsatIN%Nlevels:1:-1), Nlvgrid, & + vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), & + tempI(:,:,Nlvgrid:1:-1) ) + call cosp_change_vertical_grid ( & + cloudsatIN%Npoints, cloudsatIN%Ncolumns, cloudsatIN%Nlevels, & + cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1), & + cloudsatDBZe(:,:,cloudsatIN%Nlevels:1:-1), Nlvgrid, & + vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), & + Ze_totI(:,:,Nlvgrid:1:-1), log_units=.true. ) + call cosp_change_vertical_grid ( & + cloudsatIN%Npoints, cloudsatIN%Ncolumns, cloudsatIN%Nlevels, & + cospgridIN%hgt_matrix(:,cloudsatIN%Nlevels:1:-1), & + cospgridIN%hgt_matrix_half(:,cloudsatIN%Nlevels:1:-1), & + cospIN%frac_out(:,:,cloudsatIN%Nlevels:1:-1), Nlvgrid, & + vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), & + frac_outI(:,:,Nlvgrid:1:-1) ) + call cosp_diag_warmrain( & + cloudsatIN%Npoints, cloudsatIN%Ncolumns, Nlvgrid, & !! in + tempI, zlev, & !! in + cospOUT%modis_Liquid_Water_Path_Mean(ij:ik), & !! in + cospOUT%modis_Optical_Thickness_Water_Mean(ij:ik), & !! in + cospOUT%modis_Cloud_Particle_Size_Water_Mean(ij:ik), & !! in + cospOUT%modis_Cloud_Fraction_Water_Mean(ij:ik), & !! in + cospOUT%modis_Ice_Water_Path_Mean(ij:ik), & !! in + cospOUT%modis_Optical_Thickness_Ice_Mean(ij:ik), & !! in + cospOUT%modis_Cloud_Particle_Size_Ice_Mean(ij:ik), & !! in + cospOUT%modis_Cloud_Fraction_Ice_Mean(ij:ik), & !! in + frac_outI, & !! in + Ze_totI, & !! in + cfodd_ntotal, wr_occfreq_ntotal ) !! inout + endif + deallocate( zlev, t_in, tempI, frac_outI, Ze_totI ) + else ! do not use vgrid interporation ---------------------------------------! + !! original model grid + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + call cosp_diag_warmrain( & + cloudsatIN%Npoints, cloudsatIN%Ncolumns, cospIN%Nlevels, & !! in + cospgridIN%at(int(CSCAL_MASK_INDICES(:)),:), & !! in + cospgridIN%hgt_matrix(int(CSCAL_MASK_INDICES(:)),:), & !! in + cospOUT%modis_Liquid_Water_Path_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Optical_Thickness_Water_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Cloud_Particle_Size_Water_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Cloud_Fraction_Water_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Ice_Water_Path_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Optical_Thickness_Ice_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Cloud_Particle_Size_Ice_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospOUT%modis_Cloud_Fraction_Ice_Mean(ij+int(CSCAL_MASK_INDICES(:))-1), & !! in + cospIN%frac_out(int(CSCAL_MASK_INDICES(:)),:,:), & !! in + cloudsatDBZe, & !! in + cfodd_ntotal, wr_occfreq_ntotal ) !! inout + else + call cosp_diag_warmrain( & + cloudsatIN%Npoints, cloudsatIN%Ncolumns, cospIN%Nlevels, & !! in + cospgridIN%at, cospgridIN%hgt_matrix, & !! in + cospOUT%modis_Liquid_Water_Path_Mean(ij:ik), & !! in + cospOUT%modis_Optical_Thickness_Water_Mean(ij:ik), & !! in + cospOUT%modis_Cloud_Particle_Size_Water_Mean(ij:ik), & !! in + cospOUT%modis_Cloud_Fraction_Water_Mean(ij:ik), & !! in + cospOUT%modis_Ice_Water_Path_Mean(ij:ik), & !! in + cospOUT%modis_Optical_Thickness_Ice_Mean(ij:ik), & !! in + cospOUT%modis_Cloud_Particle_Size_Ice_Mean(ij:ik), & !! in + cospOUT%modis_Cloud_Fraction_Ice_Mean(ij:ik), & !! in + cospIN%frac_out, & !! in + cloudsatDBZe, & !! in + cfodd_ntotal, wr_occfreq_ntotal ) !! inout + endif + endif !! use_vgrid or not + + ! Store, when necessary + if (associated(cospOUT%lidar_only_freq_cloud)) then + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays + cospOUT%lidar_only_freq_cloud(ij+int(CSCAL_MASK_INDICES(:))-1,:) = lidar_only_freq_cloud(:,:) + else + cospOUT%lidar_only_freq_cloud(ij:ik,:) = lidar_only_freq_cloud + endif + endif + + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then ! Trigger use of swathed arrays for CSCAL + if (cospIN % cospswathsIN(6) % N_inst_swaths .gt. 0) then ! If MODIS is also swathed then use the joint mask MODIS_CSCAL_MASK_INDICES for setting R_UNDEF + if ( associated(cospOUT%cfodd_ntotal) ) then + cospOUT%cfodd_ntotal(ij+int(CSCAL_MASK_INDICES(:))-1,:,:,:) = cfodd_ntotal + cospOUT%cfodd_ntotal(ij+int(MODIS_CSCAL_MASK_INDICES(:))-1,:,:,:) = R_UNDEF + endif + if ( associated(cospOUT%wr_occfreq_ntotal) ) then + cospOUT%wr_occfreq_ntotal(ij+int(CSCAL_MASK_INDICES(:))-1,:) = wr_occfreq_ntotal + cospOUT%wr_occfreq_ntotal(ij+int(MODIS_CSCAL_MASK_INDICES(:))-1,:) = R_UNDEF + endif + else + if ( associated(cospOUT%cfodd_ntotal) ) then + cospOUT%cfodd_ntotal(ij:ik,:,:,:) = R_UNDEF + cospOUT%cfodd_ntotal(ij+int(CSCAL_MASK_INDICES(:))-1,:,:,:) = cfodd_ntotal + endif + if ( associated(cospOUT%wr_occfreq_ntotal) ) then + cospOUT%wr_occfreq_ntotal(ij:ik,:) = R_UNDEF + cospOUT%wr_occfreq_ntotal(ij+int(CSCAL_MASK_INDICES(:))-1,:) = wr_occfreq_ntotal + endif + endif + else + if ( associated(cospOUT%cfodd_ntotal) ) then + cospOUT%cfodd_ntotal(ij:ik,:,:,:) = cfodd_ntotal + endif + if ( associated(cospOUT%wr_occfreq_ntotal) ) then + cospOUT%wr_occfreq_ntotal(ij:ik,:) = wr_occfreq_ntotal + endif + endif + else + if ( associated(cospOUT%cfodd_ntotal) ) cospOUT%cfodd_ntotal(ij:ik,:,:,:) = R_UNDEF + if ( associated(cospOUT%wr_occfreq_ntotal) ) cospOUT%wr_occfreq_ntotal(ij:ik,:) = R_UNDEF endif endif - !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! 7) Cleanup !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if (Lisccp_subcolumn .or. Lmodis_subcolumn) then - nullify(isccpIN%Npoints,isccpIN%Ncolumns,isccpIN%Nlevels,isccpIN%emsfc_lw, & + nullify(isccpIN%Ncolumns,isccpIN%Nlevels,isccpIN%emsfc_lw, & isccpIN%skt,isccpIN%qv,isccpIN%at,isccpIN%frac_out,isccpIN%dtau, & isccpIN%dem,isccpIN%phalf,isccpIN%sunlit,isccpIN%pfull) + call COSP_ASSIGN_isccpIN_CLEAN() endif if (Lmisr_subcolumn) then - nullify(misrIN%Npoints,misrIN%Ncolumns,misrIN%Nlevels,misrIN%dtau,misrIN%sunlit, & + nullify(misrIN%Ncolumns,misrIN%Nlevels,misrIN%dtau,misrIN%sunlit, & misrIN%zfull,misrIN%at) + call COSP_ASSIGN_misrIN_CLEAN() endif if (Lcalipso_subcolumn) then - nullify(calipsoIN%Npoints,calipsoIN%Ncolumns,calipsoIN%Nlevels,calipsoIN%beta_mol,& + nullify(calipsoIN%Ncolumns,calipsoIN%Nlevels,calipsoIN%beta_mol,& calipsoIN%betatot,calipsoIN%betatot_liq,calipsoIN%betatot_ice, & calipsoIN%tau_mol,calipsoIN%tautot,calipsoIN%tautot_liq,calipsoIN%tautot_ice) + if (allocated(CSCAL_MASK_INDICES)) deallocate(CSCAL_MASK_INDICES) + if (allocated(CSCAL_SWATH_MASK)) deallocate(CSCAL_SWATH_MASK) + call COSP_ASSIGN_calipsoIN_CLEAN() endif if (LgrLidar532_subcolumn) then @@ -1753,19 +2213,23 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) endif if (Latlid_subcolumn) then - nullify(atlidIN%Npoints,atlidIN%Ncolumns,atlidIN%Nlevels,atlidIN%beta_mol_atlid, & + nullify(atlidIN%Ncolumns,atlidIN%Nlevels,atlidIN%beta_mol_atlid, & atlidIN%betatot_atlid,atlidIN%tau_mol_atlid,atlidIN%tautot_atlid) + call COSP_ASSIGN_atlidIN_CLEAN() endif if (Lparasol_subcolumn) then - nullify(parasolIN%Npoints,parasolIN%Nlevels,parasolIN%Ncolumns,parasolIN%Nrefl, & - parasolIN%tautot_S_liq,parasolIN%tautot_S_ice) + nullify(parasolIN%Nlevels,parasolIN%Ncolumns,parasolIN%Nrefl, & + parasolIN%tautot_S_liq,parasolIN%tautot_S_ice) + call COSP_ASSIGN_parasolIN_CLEAN() endif - if (Lcloudsat_subcolumn) then - nullify(cloudsatIN%Npoints,cloudsatIN%Nlevels,cloudsatIN%Ncolumns,cloudsatIN%rcfg,& + nullify(cloudsatIN%Nlevels,cloudsatIN%Ncolumns,cloudsatIN%rcfg,& cloudsatIN%kr_vol,cloudsatIN%g_vol,cloudsatIN%z_vol,cloudsatIN%hgt_matrix) + call COSP_ASSIGN_cloudsatIN_CLEAN() + if (allocated(CSCAL_MASK_INDICES)) deallocate(CSCAL_MASK_INDICES) + if (allocated(CSCAL_SWATH_MASK)) deallocate(CSCAL_SWATH_MASK) endif if (Lmodis_subcolumn) then @@ -1774,7 +2238,18 @@ function COSP_SIMULATOR(cospIN,cospgridIN,cospOUT,start_idx,stop_idx,debug) if (allocated(modisIN%sunlit)) deallocate(modisIN%sunlit) if (allocated(modisIN%notSunlit)) deallocate(modisIN%notSunlit) if (allocated(modisIN%pres)) deallocate(modisIN%pres) + if (allocated(MODIS_CSCAL_MASK_INDICES)) deallocate(MODIS_CSCAL_MASK_INDICES) endif + + if (Lrttov_column) then + nullify(rttovIN%nPoints,rttovIN%nLevels,rttovIN%nSubCols,rttovIN%co2,rttovIN%ch4, & + rttovIN%n2o,rttovIN%co,rttovIN%h_surf,rttovIN%u_surf,rttovIN%v_surf, & + rttovIN%t_skin,rttovIN%p_surf,rttovIN%sfcmask,rttovIN%latitude, & + rttovIN%longitude,rttovIN%p,rttovIN%ph,rttovIN%q2m,rttovIN%t2m,rttovIN%t, & + rttovIN%q,rttovIN%o3,rttovIN%rttov_date,rttovIN%rttov_time,rttovIN%tca, & + rttovIN%cldLiq,rttovIN%cldIce,rttovIN%DeffLiq,rttovIN%DeffIce, & + rttovIN%fl_rain,rttovIN%fl_snow) + endif if (allocated(calipso_beta_tot)) deallocate(calipso_beta_tot) if (allocated(grLidar532_beta_tot)) deallocate(grLidar532_beta_tot) @@ -1798,10 +2273,12 @@ end function COSP_SIMULATOR SUBROUTINE COSP_INIT(Lisccp, Lmodis, Lmisr, Lcloudsat, Lcalipso, LgrLidar532, Latlid, Lparasol, Lrttov, & cloudsat_radar_freq, cloudsat_k2, cloudsat_use_gas_abs, cloudsat_do_ray, & isccp_top_height, isccp_top_height_direction, surface_radar, rcfg, lusevgrid, & - luseCSATvgrid, Nvgrid, Nlevels, cloudsat_micro_scheme) + luseCSATvgrid, Nvgrid, Nlevels, cloudsat_micro_scheme, & + rttov_Ninstruments, rttov_instrument_namelists,rttov_configs,unitn,debug) ! INPUTS - logical,intent(in) :: Lisccp,Lmodis,Lmisr,Lcloudsat,Lcalipso,LgrLidar532,Latlid,Lparasol,Lrttov + logical,intent(in) :: Lisccp,Lmodis,Lmisr,Lcloudsat,Lcalipso,LgrLidar532,Latlid,Lparasol + logical,intent(inout) :: Lrttov integer,intent(in) :: & cloudsat_use_gas_abs, & ! cloudsat_do_ray, & ! @@ -1809,7 +2286,8 @@ SUBROUTINE COSP_INIT(Lisccp, Lmodis, Lmisr, Lcloudsat, Lcalipso, LgrLidar532, La isccp_top_height_direction, & ! Nlevels, & ! Nvgrid, & ! Number of levels for new L3 grid - surface_radar ! + surface_radar, & ! + rttov_Ninstruments real(wp),intent(in) :: & cloudsat_radar_freq, & ! cloudsat_k2 ! @@ -1819,13 +2297,25 @@ SUBROUTINE COSP_INIT(Lisccp, Lmodis, Lmisr, Lcloudsat, Lcalipso, LgrLidar532, La ! vertical grid character(len=64),intent(in) :: & cloudsat_micro_scheme ! Microphysical scheme used by CLOUDSAT - + + type(character(len=256)), dimension(rttov_Ninstruments) :: & + rttov_instrument_namelists ! Array of paths to RTTOV instrument namelists + ! OUTPUTS type(radar_cfg) :: rcfg + type(rttov_cfg), dimension(:), allocatable,intent(inout) :: rttov_configs + + ! Optional args + integer,intent(in),Optional :: unitn ! Used for io limits + logical,intent(in),Optional :: debug + logical :: verbose = .false. ! Local variables integer :: i real(wp) :: zstep + + ! Init debug print statements: + if (present(debug)) verbose = debug ! Initialize MODIS optical-depth bin boundaries for joint-histogram. (defined in cosp_config.F90) if (.not. allocated(modis_histTau)) then @@ -1865,7 +2355,20 @@ SUBROUTINE COSP_INIT(Lisccp, Lmodis, Lmisr, Lcloudsat, Lcalipso, LgrLidar532, La if (Lisccp) call cosp_isccp_init(isccp_top_height,isccp_top_height_direction) if (Lmodis) call cosp_modis_init() if (Lmisr) call cosp_misr_init() - if (Lrttov) call cosp_rttov_init() + + if (Lrttov) then + if (present(unitn)) then + call cosp_rttov_init(Lrttov,Nlevels,rttov_Ninstruments, & + rttov_instrument_namelists, & + rttov_configs,unitn=unitn, & + debug=verbose) + else + call cosp_rttov_init(Lrttov,Nlevels,rttov_Ninstruments, & + rttov_instrument_namelists, & + rttov_configs,debug=verbose) + end if + endif + if (Lcloudsat) call cosp_cloudsat_init(cloudsat_radar_freq,cloudsat_k2, & cloudsat_use_gas_abs,cloudsat_do_ray,R_UNDEF,N_HYDRO, surface_radar, & rcfg,cloudsat_micro_scheme) @@ -1877,12 +2380,6 @@ SUBROUTINE COSP_INIT(Lisccp, Lmodis, Lmisr, Lcloudsat, Lcalipso, LgrLidar532, La linitialization = .FALSE. END SUBROUTINE COSP_INIT - !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! SUBROUTINE cosp_cleanUp - !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - subroutine cosp_cleanUp() - deallocate(vgrid_zl,vgrid_zu,vgrid_z,dz) - end subroutine cosp_cleanUp !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE cosp_errorCheck @@ -1890,7 +2387,7 @@ end subroutine cosp_cleanUp subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, & Lmisr_subcolumn, Lmisr_column, Lmodis_subcolumn, Lmodis_column, Lcloudsat_subcolumn, & Lcloudsat_column, Lcalipso_subcolumn, Lcalipso_column, Latlid_subcolumn, & - Latlid_column, LgrLidar532_subcolumn, LgrLidar532_column, Lrttov_subcolumn, & + Latlid_column, LgrLidar532_subcolumn, LgrLidar532_column, & Lrttov_column, Lparasol_subcolumn, Lparasol_column, Lradar_lidar_tcc, & Llidar_only_freq_cloud, Lcloudsat_tcc, Lcloudsat_tcc2, Lcloudsat_modis_wr, & cospOUT, errorMessage, nError) @@ -1916,10 +2413,9 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, Latlid_subcolumn, & ! EarthCare subcolumn simulator on/off switch Latlid_column, & ! EarthCare column simulator on/off switch LgrLidar532_subcolumn, & ! Ground Lidar subcolumn simulator on/off switch - LgrLidar532_column, & ! Ground Lidar column simulator on/off switch + LgrLidar532_column, & ! Ground Lidar column simulator on/off switch Lparasol_subcolumn, & ! PARASOL subcolumn simulator on/off switch Lparasol_column, & ! PARASOL column simulator on/off switch - Lrttov_subcolumn, & ! RTTOV subcolumn simulator on/off switch Lrttov_column, & ! RTTOV column simulator on/off switch Lcloudsat_tcc, & ! Lcloudsat_tcc2, & ! @@ -1933,6 +2429,7 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, ! Local variables logical :: alloc_status + integer :: i nError = 0 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1943,47 +2440,47 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, alloc_status = .true. if (.not. allocated(cospgridIN%skt)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (ISSCP simulator): cospgridIN%skt has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (ISCCP simulator): cospgridIN%skt has not been allocated' alloc_status = .false. endif if (.not. allocated(cospgridIN%qv)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (ISSCP simulator): cospgridIN%qv has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (ISCCP simulator): cospgridIN%qv has not been allocated' alloc_status = .false. endif if (.not. allocated(cospgridIN%at)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (ISSCP simulator): cospgridIN%at has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (ISCCP simulator): cospgridIN%at has not been allocated' alloc_status = .false. endif if (.not. allocated(cospIN%frac_out)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (ISSCP simulator): cospIN%frac_out has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (ISCCP simulator): cospIN%frac_out has not been allocated' alloc_status = .false. endif if (.not. allocated(cospIN%tau_067)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (ISSCP simulator): cospIN%tau_067 has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (ISCCP simulator): cospIN%tau_067 has not been allocated' alloc_status = .false. endif if (.not. allocated(cospIN%emiss_11)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (ISSCP simulator): cospIN%emiss_11 has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (ISCCP simulator): cospIN%emiss_11 has not been allocated' alloc_status = .false. endif if (.not. allocated(cospgridIN%phalf)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (ISSCP simulator): cospgridIN%phalf has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (ISCCP simulator): cospgridIN%phalf has not been allocated' alloc_status = .false. endif if (.not. allocated(cospgridIN%sunlit)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (ISSCP simulator): cospgridIN%sunlit has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (ISCCP simulator): cospgridIN%sunlit has not been allocated' alloc_status = .false. endif if (.not. allocated(cospgridIN%pfull)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (ISSCP simulator): cospgridIN%pfull has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (ISCCP simulator): cospgridIN%pfull has not been allocated' alloc_status = .false. endif if (.not. alloc_status) then @@ -2503,14 +3000,19 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, ! RTTOV if (Lrttov_column) then alloc_status = .true. - if (.not. allocated(cospgridIN%emis_sfc)) then - nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%emis_sfc has not been allocated' - alloc_status = .false. - endif +! if (.not. allocated(cospgridIN%emis_in)) then +! nError=nError+1 +! errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%emis_in has not been allocated' +! alloc_status = .false. +! endif +! if (.not. allocated(cospgridIN%refl_in)) then +! nError=nError+1 +! errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%refl_in has not been allocated' +! alloc_status = .false. +! endif if (.not. allocated(cospgridIN%hgt_matrix_half)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%emis_sfc has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%hgt_matrix_half has not been allocated' alloc_status = .false. endif if (.not. allocated(cospgridIN%u_sfc)) then @@ -2543,9 +3045,9 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%at has not been allocated' alloc_status = .false. endif - if (.not. allocated(cospgridIN%land)) then + if (.not. allocated(cospgridIN%rttov_sfcmask)) then nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%land has not been allocated' + errorMessage(nError) = 'ERROR: COSP input variable (RTTOV simulator): cospgridIN%rttov_sfcmask has not been allocated' alloc_status = .false. endif if (.not. allocated(cospgridIN%lat)) then @@ -2558,11 +3060,6 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%lon has not been allocated' alloc_status = .false. endif - if (.not. allocated(cospgridIN%seaice)) then - nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%seaice has not been allocated' - alloc_status = .false. - endif if (.not. allocated(cospgridIN%pfull)) then nError=nError+1 errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%pfull has not been allocated' @@ -2593,6 +3090,11 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%tca has not been allocated' alloc_status = .false. endif + if (.not. allocated(cospgridIN%sza)) then + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%sza has not been allocated' + alloc_status = .false. + endif if (.not. allocated(cospgridIN%cloudIce)) then nError=nError+1 errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%cloudIce has not been allocated' @@ -2613,12 +3115,35 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%fl_snow has not been allocated' alloc_status = .false. endif + if (.not. allocated(cospgridIN%rttov_date)) then + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%rttov_date has not been allocated' + alloc_status = .false. + endif + if (.not. allocated(cospgridIN%rttov_time)) then + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable (RTTOV): cospgridIN%rttov_time has not been allocated' + alloc_status = .false. + endif if (.not. alloc_status) then Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if endif endif - + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! PART 1: Check input array values for out-of-bounds values. When an out-of-bound value ! is encountered, COSP outputs that are dependent on that input are filled with @@ -2721,7 +3246,20 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, Lcloudsat_tcc = .false. Lcloudsat_tcc2 = .false. Lcloudsat_modis_wr = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if if (associated(cospOUT%isccp_totalcldarea)) cospOUT%isccp_totalcldarea(:) = R_UNDEF if (associated(cospOUT%isccp_meantb)) cospOUT%isccp_meantb(:) = R_UNDEF if (associated(cospOUT%isccp_meantbclr)) cospOUT%isccp_meantbclr(:) = R_UNDEF @@ -2763,7 +3301,20 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, Lisccp_subcolumn = .false. Lisccp_column = .false. Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if if (associated(cospOUT%isccp_totalcldarea)) cospOUT%isccp_totalcldarea(:) = R_UNDEF if (associated(cospOUT%isccp_meantb)) cospOUT%isccp_meantb(:) = R_UNDEF if (associated(cospOUT%isccp_meantbclr)) cospOUT%isccp_meantbclr(:) = R_UNDEF @@ -2788,7 +3339,20 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, Lrttov_column = .false. Latlid_column = .false. LgrLidar532_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if if (associated(cospOUT%isccp_totalcldarea)) cospOUT%isccp_totalcldarea(:) = R_UNDEF if (associated(cospOUT%isccp_meantb)) cospOUT%isccp_meantb(:) = R_UNDEF if (associated(cospOUT%isccp_meantbclr)) cospOUT%isccp_meantbclr(:) = R_UNDEF @@ -2873,7 +3437,20 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, Lisccp_subcolumn = .false. Lisccp_column = .false. Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if if (associated(cospOUT%isccp_totalcldarea)) cospOUT%isccp_totalcldarea(:) = R_UNDEF if (associated(cospOUT%isccp_meantb)) cospOUT%isccp_meantb(:) = R_UNDEF if (associated(cospOUT%isccp_meantbclr)) cospOUT%isccp_meantbclr(:) = R_UNDEF @@ -2950,7 +3527,20 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, Latlid_column = .false. LgrLidar532_column = .false. Lcloudsat_modis_wr = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if if (associated(cospOUT%calipso_cfad_sr)) cospOUT%calipso_cfad_sr(:,:,:) = R_UNDEF if (associated(cospOUT%calipso_lidarcld)) cospOUT%calipso_lidarcld(:,:) = R_UNDEF if (associated(cospOUT%calipso_lidarcldphase)) cospOUT%calipso_lidarcldphase(:,:,:) = R_UNDEF @@ -2985,7 +3575,20 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, Lrttov_column = .false. Lcalipso_column = .false. Lparasol_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if if (associated(cospOUT%calipso_cfad_sr)) cospOUT%calipso_cfad_sr(:,:,:) = R_UNDEF if (associated(cospOUT%calipso_lidarcld)) cospOUT%calipso_lidarcld(:,:) = R_UNDEF if (associated(cospOUT%calipso_lidarcldphase)) cospOUT%calipso_lidarcldphase(:,:,:) = R_UNDEF @@ -3008,7 +3611,20 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, Lisccp_subcolumn = .false. Lisccp_column = .false. Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if if (associated(cospOUT%isccp_totalcldarea)) cospOUT%isccp_totalcldarea(:) = R_UNDEF if (associated(cospOUT%isccp_meantb)) cospOUT%isccp_meantb(:) = R_UNDEF if (associated(cospOUT%isccp_meantbclr)) cospOUT%isccp_meantbclr(:) = R_UNDEF @@ -3023,68 +3639,369 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, ! RTTOV Inputs if (Lrttov_column) then - if (cospgridIN%zenang .lt. -90. .OR. cospgridIN%zenang .gt. 90) then - nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%zenang contains values out of range' - Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF - endif - if (cospgridIN%co2 .lt. 0) then + if (any(cospgridIN%co2 .lt. 0)) then nError=nError+1 errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%co2 contains values out of range' Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if endif - if (cospgridIN%ch4 .lt. 0) then + if (any(cospgridIN%ch4 .lt. 0)) then nError=nError+1 errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%ch4 contains values out of range' Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if endif - if (cospgridIN%n2o .lt. 0) then + if (any(cospgridIN%n2o .lt. 0)) then nError=nError+1 errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%n2o contains values out of range' Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if endif - if (cospgridIN%co.lt. 0) then + if (any(cospgridIN%co.lt. 0)) then nError=nError+1 errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%co contains values out of range' Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if endif if (any(cospgridIN%o3 .lt. 0)) then nError=nError+1 errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%o3 contains values out of range' Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if endif - if (any(cospgridIN%emis_sfc .lt. 0. .OR. cospgridIN%emis_sfc .gt. 1)) then - nError=nError+1 - errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%emis_sfc contains values out of range' +! if (any(cospgridIN%emis_in .lt. 0. .OR. cospgridIN%emis_in .gt. 1)) then +! nError=nError+1 +! errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%emis_in contains values out of range' +! Lrttov_column = .false. +! if (allocated(cospOUT%rttov_outputs)) then +! do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument +! if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 +! if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF +! end do +! end if +! endif +! if (any(cospgridIN%refl_in .lt. 0. .OR. cospgridIN%refl_in .gt. 1)) then +! nError=nError+1 +! errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%refl_in contains values out of range' +! Lrttov_column = .false. +! if (allocated(cospOUT%rttov_outputs)) then +! do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument +! if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 +! if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF +! if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF +! end do +! end if +! endif + if (any(cospgridIN%rttov_sfcmask .lt. 0 .or. cospgridIN%rttov_sfcmask .gt. 2)) then + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%rttov_sfcmask contains values out of range' Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if endif if (any(cospgridIN%u_sfc .lt. -100. .OR. cospgridIN%u_sfc .gt. 100.)) then nError=nError+1 errorMessage(nError) = 'ERROR: COSP input variable: cospIN%u_sfc contains values out of range' - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF Lrttov_column = .false. + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if endif if (any(cospgridIN%v_sfc .lt. -100. .OR. cospgridIN%v_sfc .gt. 100.)) then nError=nError+1 errorMessage(nError) = 'ERROR: COSP input variable: cospIN%v_sfc contains values out of range' Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if endif if (any(cospgridIN%lat .lt. -90 .OR. cospgridIN%lat .gt. 90)) then nError=nError+1 errorMessage(nError) = 'ERROR: COSP input variable: cospIN%lat contains values out of range' Lrttov_column = .false. - if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if endif + if (any(cospgridIN%lon .lt. -180 .OR. cospgridIN%lon .gt. 360)) then + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable: cospIN%lon contains values out of range' + Lrttov_column = .false. + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if + endif + if (any(cospgridIN%tca .lt. 0 .OR. cospgridIN%tca .gt. 1)) then ! tca on [0,1] + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tca contains values out of range' + Lrttov_column = .false. + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if + endif + if (any(cospgridIN%rttov_time(:,1) .lt. 0 .OR. cospgridIN%rttov_time(:,1) .gt. 24)) then ! rttov_time(1), hour on [0,24] + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable: cospIN%rttov_time(1) contains values out of range' + Lrttov_column = .false. + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if + endif + if (any(cospgridIN%rttov_time(:,2) .lt. 0 .OR. cospgridIN%rttov_time(:,2) .gt. 60)) then ! rttov_time(2), minute on [0,60] + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable: cospIN%rttov_time(2) contains values out of range' + Lrttov_column = .false. + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if + endif + if (any(cospgridIN%rttov_time(:,3) .lt. 0 .OR. cospgridIN%rttov_time(:,3) .gt. 60)) then ! rttov_time(3), second on [0,60] + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable: cospIN%rttov_time(3) contains values out of range' + Lrttov_column = .false. + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if + endif + if (any(cospgridIN%rttov_date(:,1) .lt. 0)) then ! rttov_date(1), year on [0,inf] + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable: cospIN%rttov_date(1) contains values out of range' + Lrttov_column = .false. + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if + endif + if (any(cospgridIN%rttov_date(:,2) .lt. 0 .OR. cospgridIN%rttov_date(:,2) .gt. 12)) then ! rttov_date(2), month on [0,12] + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable: cospIN%rttov_date(2) contains values out of range' + Lrttov_column = .false. + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if + endif + if (any(cospgridIN%rttov_date(:,3) .lt. 1 .OR. cospgridIN%rttov_date(:,3) .gt. 31)) then ! rttov_date(3), day on [1,31] + nError=nError+1 + errorMessage(nError) = 'ERROR: COSP input variable: cospIN%rttov_date(3) contains values out of range' + Lrttov_column = .false. + if (allocated(cospOUT%rttov_outputs)) then + do i=1,cospOUT % Ninst_rttov ! Iterate over each instrument + if (associated(cospOUT%rttov_outputs(i)%channel_indices)) cospOUT%rttov_outputs(i)%channel_indices(:) = 0 + if (associated(cospOUT%rttov_outputs(i)%bt_total)) cospOUT%rttov_outputs(i)%bt_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_clear)) cospOUT%rttov_outputs(i)%bt_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total)) cospOUT%rttov_outputs(i)%rad_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_clear)) cospOUT%rttov_outputs(i)%rad_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_cloudy)) cospOUT%rttov_outputs(i)%rad_cloudy(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_total)) cospOUT%rttov_outputs(i)%refl_total(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%refl_clear)) cospOUT%rttov_outputs(i)%refl_clear(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%bt_total_pc)) cospOUT%rttov_outputs(i)%bt_total_pc(:,:) = R_UNDEF + if (associated(cospOUT%rttov_outputs(i)%rad_total_pc)) cospOUT%rttov_outputs(i)%rad_total_pc(:,:) = R_UNDEF + end do + end if + endif endif - + ! COSP_INPUTS if (any([Lisccp_subcolumn,Lisccp_column])) then if (cospIN%emsfc_lw .lt. 0. .OR. cospIN%emsfc_lw .gt. 1.) then @@ -3899,8 +4816,10 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, size(cospgridIN%v_sfc) .ne. cospIN%Npoints .OR. & size(cospgridIN%skt) .ne. cospIN%Npoints .OR. & size(cospgridIN%phalf,1) .ne. cospIN%Npoints .OR. & - size(cospgridIN%qv,1) .ne. cospIN%Npoints .OR. & - size(cospgridIN%land) .ne. cospIN%Npoints .OR. & + size(cospgridIN%cloudIce,1) .ne. cospIN%Npoints .OR. & + size(cospgridIN%cloudLiq,1) .ne. cospIN%Npoints .OR. & + size(cospgridIN%rttov_sfcmask) .ne. cospIN%Npoints .OR. & + size(cospgridIN%lon) .ne. cospIN%Npoints .OR. & size(cospgridIN%lat) .ne. cospIN%Npoints) then Lrttov_column = .false. nError=nError+1 @@ -3910,8 +4829,7 @@ subroutine cosp_errorCheck(cospgridIN, cospIN, Lisccp_subcolumn, Lisccp_column, size(cospgridIN%at,2) .ne. cospIN%Nlevels .OR. & size(cospgridIN%qv,2) .ne. cospIN%Nlevels .OR. & size(cospgridIN%hgt_matrix_half,2) .ne. cospIN%Nlevels .OR. & - size(cospgridIN%phalf,2) .ne. cospIN%Nlevels+1 .OR. & - size(cospgridIN%qv,2) .ne. cospIN%Nlevels) then + size(cospgridIN%phalf,2) .ne. cospIN%Nlevels+1) then Lrttov_column = .false. nError=nError+1 errorMessage(nError) = 'ERROR(rttov_simulator): The number of levels in the input fields are inconsistent' diff --git a/src/cosp_config.F90 b/src/cosp_config.F90 index 18f131c11f..d100e1f7da 100755 --- a/src/cosp_config.F90 +++ b/src/cosp_config.F90 @@ -176,10 +176,7 @@ MODULE MOD_COSP_CONFIG ! #################################################################################### ! Constants used by RTTOV. ! #################################################################################### - integer,parameter :: & - RTTOV_MAX_CHANNELS = 20 - character(len=256),parameter :: & - rttovDir = '/homedata/rguzman/CALIPSO/RTTOV/rttov_11.3/' + ! None ! #################################################################################### ! Constants used by the PARASOL simulator. ! #################################################################################### diff --git a/src/cosp_constants.F90 b/src/cosp_constants.F90 index 8fbdba50f5..b1d73923dd 100755 --- a/src/cosp_constants.F90 +++ b/src/cosp_constants.F90 @@ -27,8 +27,8 @@ ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ! History: -! May 2015- D. Swales - Original version -! +! May 2015 - D. Swales - Original version +! June 2025 - J.K. Shaw - Added earth radius for COSP-RTTOV integration and swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE cosp_math_constants USE cosp_kinds, only: wp @@ -54,7 +54,8 @@ MODULE cosp_phys_constants amCO2 = 44.0096_wp, & ! CO2 [g/mol] amCH4 = 16.0426_wp, & ! Methane [g/mol] amN2O = 44.0129_wp, & ! N2O [g/mol] - amCO = 28.0102_wp ! CO [g/mol] + amCO = 28.0102_wp, & ! CO [g/mol] + amSO2 = 64.0640_wp ! SO2 [g/mol] ! WMO/SI value REAL(wp), PARAMETER :: & @@ -69,4 +70,8 @@ MODULE cosp_phys_constants cpv = 1869.46_wp, & ! Specific heat at constant pressure for water vapor [J/K/Kg] km = 1.38e-23_wp ! Boltzmann constant [J/K] + ! RTTOV constants + REAL(wp), PARAMETER :: & + radius_earth = 6371.0 ! Earth's radius in km (mean volumetric) + END MODULE cosp_phys_constants diff --git a/src/cosp_rttov_util.F90 b/src/cosp_rttov_util.F90 new file mode 100644 index 0000000000..9d3c0972b6 --- /dev/null +++ b/src/cosp_rttov_util.F90 @@ -0,0 +1,130 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! Jun 2025 - J.K. Shaw - Initial version +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +MODULE MOD_COSP_RTTOV_UTIL + USE COSP_KINDS, ONLY: wp + + ! jpim, jprb and jplm are the RTTOV integer, real and logical KINDs + USE parkind1, ONLY : jpim, jprb, jplm + + ! rttov_types contains definitions of all RTTOV data types + USE rttov_types, ONLY : & + rttov_options, & + rttov_options_scatt, & + rttov_coefs, & + rttov_pccomp + + IMPLICIT NONE + + ! RTTOV variables/structures. + !==================== + + ! DDT for each instrument being simulated. Values to be assigned during the cosp_rttov_init subroutine + type rttov_cfg + logical(KIND=jplm) :: & + Lrttov_bt, & + Lrttov_rad, & + Lrttov_refl, & + Lrttov_cld, & + Lrttov_aer, & + Lrttov_pc, & + Lrttov_solar, & + Lrttov_mwscatt, & + user_tracegas_input + character(len=256) :: & + rttov_srcDir, & + rttov_coefDir, & + OD_coef_filepath, & + aer_coef_filepath, & + cld_coef_filepath, & + PC_coef_filepath + integer(KIND=jpim) :: & + nchanprof, & + rttov_direct_nthreads, & + nchan_out, & + nchannels_rec, & + rttov_Nlocaltime, & + gas_units, & + clw_scheme, & + ice_scheme, & + icede_param, & + rttov_extendatmos, & + nprof + real(wp) :: & + CO2_mr, & + CH4_mr, & + CO_mr, & + N2O_mr, & + SO2_mr, & + ZenAng + integer(kind=jpim), allocatable :: & + iChannel(:), & ! Requested channel indices + iChannel_out(:) ! Passing out the channel indices (actual output channels) + real(kind=jprb), allocatable :: & + emisChannel(:), & ! RTTOV channel emissivity + reflChannel(:), & ! RTTOV channel reflectivity + wavenumChannel(:), & ! RTTOV channel wavenumber + rttov_localtime(:), & + rttov_localtime_width(:) + type(rttov_options) :: & + opts ! RTTOV options structure + type(rttov_options_scatt) :: & + opts_scatt + type(rttov_coefs) :: & + coefs ! RTTOV coefficients structure + type(rttov_pccomp) :: & + pccomp + logical(KIND=jplm), allocatable :: & + swath_mask(:) + end type rttov_cfg + + type rttov_output + integer :: & + nchan_out + integer,pointer :: & + channel_indices(:) => null() + real(wp),pointer :: & + bt_total(:,:) => null(), & + bt_clear(:,:) => null(), & + rad_total(:,:) => null(), & + rad_clear(:,:) => null(), & + rad_cloudy(:,:) => null(), & + refl_total(:,:) => null(), & + refl_clear(:,:) => null(), & + bt_total_pc(:,:) => null(), & + rad_total_pc(:,:) => null() + end type rttov_output + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! END MODULE + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +END MODULE MOD_COSP_RTTOV_UTIL \ No newline at end of file diff --git a/src/cosp_rttov_utilSTUB.F90 b/src/cosp_rttov_utilSTUB.F90 new file mode 100644 index 0000000000..8fee7b6ddd --- /dev/null +++ b/src/cosp_rttov_utilSTUB.F90 @@ -0,0 +1,99 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! Jun 2025 - J.K. Shaw - Initial version +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +MODULE MOD_COSP_RTTOV_UTIL + USE COSP_KINDS, ONLY: wp + IMPLICIT NONE + + + ! DDT for each instrument being simulated. Values to be assigned during the cosp_rttov_init subroutine + type rttov_cfg + logical :: & + Lrttov_bt, & + Lrttov_rad, & + Lrttov_refl, & + Lrttov_cld, & + Lrttov_aer, & + Lrttov_pc + character(len=256) :: & + rttov_srcDir, & + rttov_coefDir, & + OD_coef_filepath, & + aer_coef_filepath, & + cld_coef_filepath, & + PC_coef_filepath + integer :: & + nchanprof, & + rttov_direct_nthreads, & + nchan_out, & + nchannels_rec, & + rttov_Nlocaltime + real(wp) :: & + CO2_mr, & + CH4_mr, & + CO_mr, & + N2O_mr, & + SO2_mr, & + ZenAng + integer,allocatable :: & + iChannel(:), & ! Requested channel indices + iChannel_out(:) ! Passing out the channel indices (actual output channels) + real(kind=wp),allocatable :: & + emisChannel(:), & ! RTTOV channel emissivity + reflChannel(:), & ! RTTOV channel reflectivity + rttov_localtime(:), & ! RTTOV localtime + rttov_localtime_width(:) + logical, allocatable :: & + swath_mask(:) + end type rttov_cfg + + type rttov_output + integer :: & + nchan_out + integer,pointer :: & + channel_indices(:) + real(wp),pointer :: & + bt_total(:,:), & + bt_clear(:,:), & + rad_total(:,:), & + rad_clear(:,:), & + rad_cloudy(:,:), & + refl_total(:,:), & + refl_clear(:,:), & + bt_total_pc(:,:), & + rad_total_pc(:,:) + end type rttov_output + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! END MODULE + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +END MODULE MOD_COSP_RTTOV_UTIL \ No newline at end of file diff --git a/src/cosp_stats.F90 b/src/cosp_stats.F90 index 19980853a7..556c476478 100755 --- a/src/cosp_stats.F90 +++ b/src/cosp_stats.F90 @@ -37,6 +37,7 @@ ! - Added phase 3D/3Dtemperature/Map output variables in diag_lidar ! May 2015 - D. Swales - Modified for cosp2.0 ! Nov 2018 - T. Michibata - Added CloudSat+MODIS Warmrain Diagnostics +! Jun 2025 - J.K. Shaw. - Added COSP-RTTOV integration and swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE MOD_COSP_STATS USE COSP_KINDS, ONLY: wp @@ -52,12 +53,176 @@ MODULE MOD_COSP_STATS CFODD_ICOD_MIN, CFODD_ICOD_MAX, & CFODD_DBZE_WIDTH, CFODD_ICOD_WIDTH, & CFODD_HISTDBZE, CFODD_HISTICOD, & - WR_NREGIME - USE COSP_PHYS_CONSTANTS, ONLY: tmelt - + WR_NREGIME, VGRID_ZU, & + VGRID_ZL, VGRID_Z, & + DZ + USE COSP_PHYS_CONSTANTS, ONLY: tmelt, radius_earth + USE COSP_MATH_CONSTANTS, ONLY: pi + USE MOD_COSP_RTTOV_UTIL, ONLY: rttov_cfg IMPLICIT NONE -CONTAINS + ! ###################################################################################### + ! Quickbeam parameters + integer,parameter :: & + maxhclass = 20, & ! Qucikbeam maximum number of hydrometeor classes. + nRe_types = 550, & ! Quickbeam maximum number or Re size bins allowed in N and Z_scaled look up table. + nd = 85, & ! Qucikbeam number of discrete particles used in construction DSDs. + mt_ntt = 39, & ! Quickbeam number of temperatures in mie LUT. + Re_BIN_LENGTH = 10, & ! Quickbeam minimum Re interval in scale LUTs + Re_MAX_BIN = 250 ! Quickbeam maximum Re interval in scale LUTs + real(wp),parameter :: & + dmin = 0.1, & ! Quickbeam minimum size of discrete particle + dmax = 10000. ! Quickbeam maximum size of discrete particle + + ! ###################################################################################### + ! TYPE cosp_column_inputs + ! ###################################################################################### + type cosp_column_inputs + integer :: & + Npoints, & ! Number of gridpoints. + Ncolumns, & ! Number of columns. + Nlevels ! Number of levels. + + integer,allocatable,dimension(:) :: & + sunlit ! Sunlit flag (0-1) + + real(wp),allocatable,dimension(:,:) :: & + at, & ! Temperature (K) + pfull, & ! Pressure (Pa) + phalf, & ! Pressure at half-levels (Pa) + qv, & ! Specific humidity (kg/kg) + co2, & ! CO2 (kg/kg) + ch4, & ! Methane (kg/kg) + n2o, & ! N2O (kg/kg) + co, & ! CO (kg/kg) + so2, & ! SO2 (kg/kg) + hgt_matrix, & ! Height of atmosphere layer (km) + hgt_matrix_half ! 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. + + real(wp),allocatable,dimension(:) :: & + land, & ! Land/Sea mask (0 for ocean, 1 for land) + skt, & ! Surface temperature (K) + surfelev ! Surface Elevation (m) + ! Fields used ONLY by RTTOV + real(wp),allocatable,dimension(:) :: & + u_sfc, & ! Surface u-wind (m/s) + v_sfc, & ! Surface v-wind (m/s) + t2m, & ! 2-meter temperature (K) + q2m, & ! 2-meter specific humidity (kg/kg) + lat, & ! Latitude (deg) + lon, & ! Longitude (deg) + sza, & ! Solar Zenith Angle in degrees + psfc, & ! Surface pressure (Pa) + rttov_sfcmask ! Mask for RTTOV surface types (0 for ocean, 1 for land, 2 for sea ice) + + real(wp),allocatable,dimension(:,:) :: & + o3, & ! Ozone (kg/kg) + tca, & ! Total layer cloud fraction (0-1) + cloudIce, & ! Cloud ice water mixing ratio (kg/kg) + cloudLiq, & ! Cloud liquid water mixing ratio (kg/kg) + DeffLiq, & ! Cloud liquid effective diameter (um) + DeffIce, & ! Cloud ice effective diameter (um) + rttov_date, & ! Date of the profile as year (e.g. 2013), month (1-12), and day (1-31) + rttov_time, & ! Time of profile as hour, minute, second. + emis_in, & ! Surface emissivity (point,channel) (1) + refl_in, & ! Surface reflectance (point,channel) (1) + fl_rain, & ! Precipitation (rain) flux (kg/m2/s) + fl_snow ! Precipitation (snow) flux (kg/m2/s) + end type cosp_column_inputs + + + ! ###################################################################################### + ! TYPE swath_inputs + ! ###################################################################################### + type swath_inputs + + integer :: & + N_inst_swaths = 0 + real(wp),dimension(20) :: & + inst_localtimes, & + inst_localtime_widths + + end type swath_inputs + + type radar_cfg + ! Radar properties + real(wp) :: freq,k2 + integer :: nhclass ! Number of hydrometeor classes in use + integer :: use_gas_abs, do_ray + logical :: radar_at_layer_one ! If true radar is assume to be at the edge + ! of the first layer, if the first layer is the + ! surface than a ground-based radar. If the + ! first layer is the top-of-atmosphere, then + ! a space borne radar. + + ! Variables used to store Z scale factors + character(len=240) :: scale_LUT_file_name + logical :: load_scale_LUTs, update_scale_LUTs + logical, dimension(maxhclass,nRe_types) :: N_scale_flag + logical, dimension(maxhclass,mt_ntt,nRe_types) :: Z_scale_flag,Z_scale_added_flag + real(wp),dimension(maxhclass,mt_ntt,nRe_types) :: Ze_scaled,Zr_scaled,kr_scaled + real(wp),dimension(maxhclass,nd,nRe_types) :: fc, rho_eff + real(wp),dimension(Re_MAX_BIN) :: base_list,step_list + + end type radar_cfg + + ! ###################################################################################### + ! TYPE cosp_optical_inputs + ! ###################################################################################### + type cosp_optical_inputs + integer :: & + Npoints, & ! Number of gridpoints. + Ncolumns, & ! Number of columns. + Nlevels, & ! Number of levels. + Npart, & ! Number of cloud meteors for LIDAR simulators. + Nrefl, & ! Number of reflectances for PARASOL simulator + Ninst_rttov ! Number of RTTOV instruments + real(wp),pointer :: & + emis_grey => null() ! Greybody (spectrally flat) emissivity value for RTTOV + real(wp) :: & + emsfc_lw ! Surface emissivity @ 11micron + real(wp),allocatable,dimension(:,:,:) :: & + frac_out, & ! Cloud fraction + tau_067, & ! Optical depth @ 0.67micron + emiss_11, & ! Emissivity @ 11 micron + fracLiq, & ! Fraction of optical-depth due to liquid (MODIS) + asym, & ! Assymetry parameter @ 3.7micron (MODIS) + ss_alb, & ! Single-scattering albedo @ 3.7micron (MODIS) + betatot_calipso, & ! Lidar backscatter coefficient (calipso @ 532nm) + betatot_grLidar532, & ! Lidar backscatter coefficient (ground-lidar @ 532nm) + betatot_atlid, & ! Lidar backscatter coefficient (atlid @ 355nm) + betatot_ice_calipso, & ! Lidar backscatter coefficient ICE (calipso @ 532nm) + betatot_liq_calipso, & ! Lidar backscatter coefficient LIQUID (calipso @ 532nm) + tautot_calipso, & ! Lidar Optical thickness (calipso @ 532nm) + tautot_grLidar532, & ! Lidar Optical thickness (ground-lidar @ 532nm) + tautot_atlid, & ! Lidar Optical thickness (atlid @ 355nm) + tautot_ice_calipso, & ! Lidar Ice Optical thickness (calipso @ 532nm) + tautot_liq_calipso, & ! Lidar Liquid Optical thickness (calipso @ 532nm) + z_vol_cloudsat, & ! Effective reflectivity factor (mm^6/m^3) + kr_vol_cloudsat, & ! Attenuation coefficient hydro (dB/km) + g_vol_cloudsat ! Attenuation coefficient gases (dB/km) + real(wp),allocatable,dimension(:,:) :: & + beta_mol_calipso, & ! Lidar molecular backscatter coefficient (calipso @ 532nm) + beta_mol_grLidar532, & ! Lidar molecular backscatter coefficient (ground-lidar @ 532nm) + beta_mol_atlid, & ! Lidar molecular backscatter coefficient (atlid @ 355nm) + tau_mol_calipso, & ! Lidar molecular optical depth (calipso @ 532nm) + tau_mol_grLidar532, & ! Lidar molecular optical depth (ground-lidar @ 532nm) + tau_mol_atlid, & ! Lidar molecular optical depth (atlid @ 355nm) + tautot_S_liq, & ! Parasol Liquid water optical thickness, from TOA to SFC + tautot_S_ice, & ! Parasol Ice water optical thickness, from TOA to SFC + fracPrecipIce ! Fraction of precipitation which is frozen (1). + type(radar_cfg) :: & + rcfg_cloudsat ! Radar configuration information (CLOUDSAT) + type(rttov_cfg),dimension(:),pointer :: & + cfg_rttov ! RTTOV configuration information (multiple instruments) + type(swath_inputs),dimension(6) :: & ! Could be a pointer but fine + cospswathsIN + end type cosp_optical_inputs + + +CONTAINS !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !---------- SUBROUTINE COSP_CHANGE_VERTICAL_GRID ---------------- !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -505,4 +670,111 @@ subroutine hist2D(var1,var2,npts,bin1,nbin1,bin2,nbin2,jointHist) enddo enddo end subroutine hist2D + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE cosp_cleanUp + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine cosp_cleanUp() + deallocate(vgrid_zl,vgrid_zu,vgrid_z,dz) + end subroutine cosp_cleanUp + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE compute_orbitmasks + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine compute_orbitmasks(Npoints,Nlocaltimes,localtimes,localtime_widths, & + lat,lon,month,day,hour,minute,swath_mask_out,Nswathed_out) + + ! Inputs + integer,intent(in) :: & + Npoints, & + Nlocaltimes + + real(wp),dimension(Nlocaltimes),intent(in) :: & + localtimes, & + localtime_widths + + real(wp),dimension(Npoints),intent(in) :: & + lat, & + lon, & + month, & + day, & + hour, & + minute + + ! Output + logical,dimension(Npoints),intent(out) :: & + swath_mask_out ! Mask of reals over all gridcells + integer,intent(out) :: & + Nswathed_out + + ! Local variables + integer :: i ! iterator + + real(wp),dimension(Npoints,Nlocaltimes) :: & + sat_lon, & ! Central longitude of the instrument. + dlon, & ! distance to satellite longitude in degrees + dx ! distance to satellite longitude in km? + + logical,dimension(Npoints,Nlocaltimes) :: & + swath_mask_all ! Mask of logicals over all local times, gridcells + + integer, dimension(Npoints) :: & + rttov_DOY ! Array of day of year values + real(wp), dimension(Npoints) :: & + localtime_offsets ! Offset values to avoid striping with hourly RT calls. [hours] + ! Compute the day of the year and determine the localtime offset + do i=1,Npoints + call get_DOY(int(month(i)), int(day(i)), rttov_DOY(i)) + end do + localtime_offsets = (mod(rttov_DOY(:), 5) - 2) / 5.0 ! Need to cast to real + + ! Iterate over local times + swath_mask_all(:,:) = .false. + do i=1,Nlocaltimes + ! Calculate the central longitude for each gridcell and orbit + sat_lon(:,i) = 15.0 * (localtimes(i) + localtime_offsets - (hour + minute / 60)) + ! Calculate distance (in degrees) from each grid cell to the satellite central long + dlon(:,i) = mod((lon - sat_lon(:,i) + 180.0), 360.0) - 180.0 + ! calculate distance to satellite in km. Remember to convert to radians for cos/sine calls + dx(:,i) = dlon(:,i) * (pi/180.0) * COS(lat * pi / 180) * radius_earth + ! Determine if a gridcell falls in the swath width + where (abs(dx(:,i))<(localtime_widths(i)*0.5)) + swath_mask_all(:,i) = .true. + end where + end do + + ! Mask is true where values should be calculated + swath_mask_out = ANY( swath_mask_all(:,:),2) ! Compute mask by collapsing the localtimes dimension + Nswathed_out = count(swath_mask_out) ! Number of gridcells that should be calculated. + + end subroutine compute_orbitmasks + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE get_DOY + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine get_DOY(month, day, DOY) + + integer,intent(in) :: & + month, & + day + integer,intent(out) :: & + DOY + + ! This subroutine does not handle leap years because it is not relevant to the purpose. + ! Simple look-up table for DOY. + if (month .eq. 1) DOY = day + if (month .eq. 2) DOY = 31 + day + if (month .eq. 3) DOY = 59 + day + if (month .eq. 4) DOY = 90 + day + if (month .eq. 5) DOY = 120 + day + if (month .eq. 6) DOY = 151 + day + if (month .eq. 7) DOY = 181 + day + if (month .eq. 8) DOY = 212 + day + if (month .eq. 9) DOY = 243 + day + if (month .eq. 10) DOY = 273 + day + if (month .eq. 11) DOY = 304 + day + if (month .eq. 12) DOY = 334 + day + + end subroutine get_DOY + END MODULE MOD_COSP_STATS diff --git a/src/simulator/cosp_atlid_interface.F90 b/src/simulator/cosp_atlid_interface.F90 index c18bd54492..d622921e34 100644 --- a/src/simulator/cosp_atlid_interface.F90 +++ b/src/simulator/cosp_atlid_interface.F90 @@ -28,17 +28,28 @@ ! ! History ! Apr 2018 - R. Guzman - Original version +! Jun 2025 - J.K. Shaw - Added COSP-RTTOV integration and swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE MOD_COSP_ATLID_INTERFACE USE COSP_KINDS, ONLY: wp + use mod_cosp_stats, ONLY: compute_orbitmasks,cosp_optical_inputs,cosp_column_inputs IMPLICIT NONE + ! Module variables + real(wp),dimension(:,:),target,allocatable :: & + temp_beta_mol_atlid, & + temp_tau_mol_atlid + real(wp),dimension(:,:,:),target,allocatable :: & + temp_betatot_atlid, & + temp_tautot_atlid + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! TYPE atlid_in !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% type atlid_IN + integer :: & + Npoints ! Number of gridpoints. integer,pointer :: & - Npoints, & ! Number of gridpoints. Ncolumns, & ! Number of columns. Nlevels ! Number of levels. @@ -60,6 +71,84 @@ subroutine cosp_atlid_init() end subroutine cosp_atlid_init + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_atlidIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_atlidIN(cospIN,cospgridIN,Npoints,atlidIN,ATLID_MASK_INDICES) + type(cosp_optical_inputs),intent(in),target :: cospIN ! Optical inputs to COSP simulator + type(cosp_column_inputs), intent(in),target :: cospgridIN ! Host model inputs to COSP + integer,intent(in),target :: & + Npoints + type(atlid_IN),intent(inout) :: & + atlidIN + integer,dimension(:),allocatable,intent(out) :: & ! Array containing the indices of the swath masks, already allocated? + ATLID_MASK_INDICES + + ! Local variables + logical,dimension(:),allocatable :: & ! Mask of reals over all local times + ATLID_SWATH_MASK + integer, target :: & + N_ATLID_SWATHED, & + i + + if (cospIN % cospswathsIN(4) % N_inst_swaths .gt. 0) then + allocate(ATLID_SWATH_MASK(Npoints)) + ! Do swathing to figure out which cells to simulate on + call compute_orbitmasks(Npoints, & + cospIN % cospswathsIN(4) % N_inst_swaths, & + cospIN % cospswathsIN(4) % inst_localtimes, & + cospIN % cospswathsIN(4) % inst_localtime_widths, & + cospgridIN%lat, cospgridIN%lon, & + cospgridIN%rttov_date(:,2), cospgridIN%rttov_date(:,3), & ! Time fields: month, dayofmonth + cospgridIN%rttov_time(:,1), cospgridIN%rttov_time(:,2), & ! Time fields: hour, minute + ATLID_SWATH_MASK,N_ATLID_SWATHED) ! Output: logical mask array + atlidIN%Npoints = N_ATLID_SWATHED + atlidIN%Ncolumns => cospIN%Ncolumns + allocate(ATLID_MASK_INDICES(N_ATLID_SWATHED)) + ATLID_MASK_INDICES = pack((/ (i, i = 1, Npoints ) /),mask = ATLID_SWATH_MASK) + deallocate(ATLID_SWATH_MASK) + if (atlidIN%Npoints .gt. 0) then + ! Allocate swathed arrays. + allocate(temp_beta_mol_atlid(atlidIN%Npoints,cospIN%Nlevels), & + temp_betatot_atlid(atlidIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_tau_mol_atlid(atlidIN%Npoints,cospIN%Nlevels), & + temp_tautot_atlid(atlidIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels)) + ! Encode step: Read only appropriate values into the new temp arrays. + temp_beta_mol_atlid(:,:) = cospIN%beta_mol_atlid(int(ATLID_MASK_INDICES),:) + temp_tau_mol_atlid(:,:) = cospIN%tau_mol_atlid(int(ATLID_MASK_INDICES),:) + temp_betatot_atlid(:,:,:) = cospIN%betatot_atlid(int(ATLID_MASK_INDICES),:,:) + temp_tautot_atlid(:,:,:) = cospIN%tautot_atlid(int(ATLID_MASK_INDICES),:,:) + + atlidIN%Nlevels => cospIN%Nlevels + atlidIN%beta_mol_atlid => temp_beta_mol_atlid + atlidIN%betatot_atlid => temp_betatot_atlid + atlidIN%tau_mol_atlid => temp_tau_mol_atlid + atlidIN%tautot_atlid => temp_tautot_atlid + end if + else + atlidIN%Npoints = Npoints + atlidIN%Ncolumns => cospIN%Ncolumns + atlidIN%Nlevels => cospIN%Nlevels + atlidIN%beta_mol_atlid => cospIN%beta_mol_atlid + atlidIN%betatot_atlid => cospIN%betatot_atlid + atlidIN%tau_mol_atlid => cospIN%tau_mol_atlid + atlidIN%tautot_atlid => cospIN%tautot_atlid + end if + + END SUBROUTINE COSP_ASSIGN_atlidIN + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_atlidIN_CLEAN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_atlidIN_CLEAN() + ! Deallocate temporary arrays + if (allocated(temp_beta_mol_atlid)) deallocate(temp_beta_mol_atlid) + if (allocated(temp_tau_mol_atlid)) deallocate(temp_tau_mol_atlid) + if (allocated(temp_betatot_atlid)) deallocate(temp_betatot_atlid) + if (allocated(temp_tautot_atlid)) deallocate(temp_tautot_atlid) + + END SUBROUTINE COSP_ASSIGN_atlidIN_CLEAN + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! END MODULE ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/src/simulator/cosp_calipso_interface.F90 b/src/simulator/cosp_calipso_interface.F90 index 7e50fb1743..4179deaeb0 100644 --- a/src/simulator/cosp_calipso_interface.F90 +++ b/src/simulator/cosp_calipso_interface.F90 @@ -29,21 +29,35 @@ ! History ! May 2015 - D. Swales - Original version ! Jul 2017 - R. Guzman - Added Ground LIDar variables (GLID) +! Jun 2025 - J.K. Shaw - Added COSP-RTTOV integration and swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE MOD_COSP_CALIPSO_INTERFACE USE COSP_KINDS, ONLY: wp USE MOD_LIDAR_SIMULATOR, ONLY: alpha,beta,gamma + use mod_cosp_stats, ONLY: compute_orbitmasks,cosp_optical_inputs,cosp_column_inputs IMPLICIT NONE - + + ! Module variables + real(wp),dimension(:,:),target,allocatable :: & + temp_beta_mol_calipso, & + temp_tau_mol_calipso + real(wp),dimension(:,:,:),target,allocatable :: & + temp_betatot_calipso, & + temp_tautot_calipso, & + temp_betatot_liq_calipso, & + temp_tautot_liq_calipso, & + temp_betatot_ice_calipso, & + temp_tautot_ice_calipso + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! TYPE calipso_in !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% type calipso_IN + integer :: & + Npoints ! Number of gridpoints. integer,pointer :: & - Npoints, & ! Number of gridpoints. Ncolumns, & ! Number of columns. Nlevels ! Number of levels. - real(wp),dimension(:,:),pointer :: & beta_mol, & ! Molecular backscatter coefficient tau_mol ! Molecular optical depth @@ -79,6 +93,103 @@ subroutine cosp_calipso_init() end subroutine cosp_calipso_init + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_calipsoIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_calipsoIN(cospIN,cospgridIN,Npoints,calipsoIN,CSCAL_MASK_INDICES,CSCAL_SWATH_MASK) + type(cosp_optical_inputs),intent(in),target :: cospIN ! Optical inputs to COSP simulator + type(cosp_column_inputs), intent(in),target :: cospgridIN ! Host model inputs to COSP + integer,intent(in),target :: & + Npoints + type(calipso_IN),intent(inout) :: & + calipsoIN + integer,dimension(:),allocatable,intent(out) :: & ! Array containing the indices of the swath masks, already allocated? + CSCAL_MASK_INDICES + logical,dimension(:),allocatable,intent(inout) :: & ! Mask of reals over all local times + CSCAL_SWATH_MASK + + ! Local variables + integer, target :: & + N_CALIPSO_SWATHED, & + i + + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then + if (.not.allocated(CSCAL_SWATH_MASK)) allocate(CSCAL_SWATH_MASK(Npoints)) + ! Do swathing to figure out which cells to simulate on + call compute_orbitmasks(Npoints, & + cospIN % cospswathsIN(3) % N_inst_swaths, & + cospIN % cospswathsIN(3) % inst_localtimes, & + cospIN % cospswathsIN(3) % inst_localtime_widths, & + cospgridIN%lat, cospgridIN%lon, & + cospgridIN%rttov_date(:,2), cospgridIN%rttov_date(:,3), & ! Time fields: month, dayofmonth + cospgridIN%rttov_time(:,1), cospgridIN%rttov_time(:,2), & ! Time fields: hour, minute + CSCAL_SWATH_MASK,N_CALIPSO_SWATHED) ! Output: logical mask array + calipsoIN%Npoints = N_CALIPSO_SWATHED + calipsoIN%Ncolumns => cospIN%Ncolumns + allocate(CSCAL_MASK_INDICES(N_CALIPSO_SWATHED)) + CSCAL_MASK_INDICES = pack((/ (i, i = 1, Npoints ) /),mask = CSCAL_SWATH_MASK) + if (calipsoIN%Npoints .gt. 0) then + ! Allocate swathed arrays. + allocate(temp_beta_mol_calipso(calipsoIN%Npoints,cospIN%Nlevels), & + temp_tau_mol_calipso(calipsoIN%Npoints,cospIN%Nlevels), & + temp_betatot_calipso(calipsoIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_tautot_calipso(calipsoIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_betatot_liq_calipso(calipsoIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_tautot_liq_calipso(calipsoIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_betatot_ice_calipso(calipsoIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_tautot_ice_calipso(calipsoIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels)) + ! Encode step: Read only appropriate values into the new temp arrays. + temp_beta_mol_calipso(:,:) = cospIN%beta_mol_calipso(int(CSCAL_MASK_INDICES),:) + temp_tau_mol_calipso(:,:) = cospIN%tau_mol_calipso(int(CSCAL_MASK_INDICES),:) + temp_betatot_calipso(:,:,:) = cospIN%betatot_calipso(int(CSCAL_MASK_INDICES),:,:) + temp_tautot_calipso(:,:,:) = cospIN%tautot_calipso(int(CSCAL_MASK_INDICES),:,:) + temp_betatot_liq_calipso(:,:,:) = cospIN%betatot_liq_calipso(int(CSCAL_MASK_INDICES),:,:) + temp_tautot_liq_calipso(:,:,:) = cospIN%tautot_liq_calipso(int(CSCAL_MASK_INDICES),:,:) + temp_betatot_ice_calipso(:,:,:) = cospIN%betatot_ice_calipso(int(CSCAL_MASK_INDICES),:,:) + temp_tautot_ice_calipso(:,:,:) = cospIN%tautot_ice_calipso(int(CSCAL_MASK_INDICES),:,:) + + calipsoIN%Nlevels => cospIN%Nlevels + calipsoIN%beta_mol => temp_beta_mol_calipso + calipsoIN%betatot => temp_betatot_calipso + calipsoIN%betatot_liq => temp_betatot_liq_calipso + calipsoIN%betatot_ice => temp_betatot_ice_calipso + calipsoIN%tau_mol => temp_tau_mol_calipso + calipsoIN%tautot => temp_tautot_calipso + calipsoIN%tautot_liq => temp_tautot_liq_calipso + calipsoIN%tautot_ice => temp_tautot_ice_calipso + end if + else + calipsoIN%Npoints = Npoints + calipsoIN%Ncolumns => cospIN%Ncolumns + calipsoIN%Nlevels => cospIN%Nlevels + calipsoIN%beta_mol => cospIN%beta_mol_calipso + calipsoIN%betatot => cospIN%betatot_calipso + calipsoIN%betatot_liq => cospIN%betatot_liq_calipso + calipsoIN%betatot_ice => cospIN%betatot_ice_calipso + calipsoIN%tau_mol => cospIN%tau_mol_calipso + calipsoIN%tautot => cospIN%tautot_calipso + calipsoIN%tautot_liq => cospIN%tautot_liq_calipso + calipsoIN%tautot_ice => cospIN%tautot_ice_calipso + end if + + END SUBROUTINE COSP_ASSIGN_calipsoIN + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_calipsoIN_CLEAN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_calipsoIN_CLEAN() + ! Deallocate temporary arrays + if (allocated(temp_beta_mol_calipso)) deallocate(temp_beta_mol_calipso) + if (allocated(temp_tau_mol_calipso)) deallocate(temp_tau_mol_calipso) + if (allocated(temp_betatot_calipso)) deallocate(temp_betatot_calipso) + if (allocated(temp_tautot_calipso)) deallocate(temp_tautot_calipso) + if (allocated(temp_betatot_liq_calipso)) deallocate(temp_betatot_liq_calipso) + if (allocated(temp_tautot_liq_calipso)) deallocate(temp_tautot_liq_calipso) + if (allocated(temp_betatot_ice_calipso)) deallocate(temp_betatot_ice_calipso) + if (allocated(temp_tautot_ice_calipso)) deallocate(temp_tautot_ice_calipso) + + END SUBROUTINE COSP_ASSIGN_calipsoIN_CLEAN + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! END MODULE ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/src/simulator/cosp_cloudsat_interface.F90 b/src/simulator/cosp_cloudsat_interface.F90 index 3a0de62bb0..ff61417104 100644 --- a/src/simulator/cosp_cloudsat_interface.F90 +++ b/src/simulator/cosp_cloudsat_interface.F90 @@ -28,11 +28,13 @@ ! ! History ! May 2015 - D. Swales - Original version +! Jun 2025 - J.K. Shaw - Added COSP-RTTOV integration and swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE MOD_COSP_CLOUDSAT_INTERFACE USE COSP_KINDS, ONLY: wp - USE quickbeam, ONLY: quickbeam_init,radar_cfg,Re_MAX_BIN,Re_BIN_LENGTH, & + USE quickbeam, ONLY: quickbeam_init,Re_MAX_BIN,Re_BIN_LENGTH, & maxhclass, nRe_types, nd, mt_ntt + use mod_cosp_stats, ONLY: radar_cfg,compute_orbitmasks,cosp_optical_inputs,cosp_column_inputs IMPLICIT NONE ! Directory where LUTs will be stored @@ -40,12 +42,21 @@ MODULE MOD_COSP_CLOUDSAT_INTERFACE logical :: RADAR_SIM_LOAD_scale_LUTs_flag = .false. logical :: RADAR_SIM_UPDATE_scale_LUTs_flag = .false. + ! Module variables + real(wp),dimension(:,:),target,allocatable :: & + temp_hgt_matrix + real(wp),dimension(:,:,:),target,allocatable :: & + temp_z_vol_cloudsat, & + temp_kr_vol_cloudsat, & + temp_g_vol_cloudsat + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! TYPE cloudsat_IN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% type cloudsat_IN + integer :: & + Npoints ! Number of horizontal grid-points integer,pointer :: & - Npoints, & ! Number of horizontal grid-points Nlevels, & ! Number of vertical levels Ncolumns ! Number of subcolumns real(wp),pointer :: & @@ -60,7 +71,7 @@ MODULE MOD_COSP_CLOUDSAT_INTERFACE CONTAINS !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! SUBROUTINE cosp_cloudsat_in + ! SUBROUTINE cosp_cloudsat_in !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SUBROUTINE COSP_CLOUDSAT_INIT(radar_freq,k2,use_gas_abs,do_ray,undef,nhydro, & surface_radar,rcfg,cloudsat_micro_scheme,load_LUT) @@ -78,7 +89,7 @@ SUBROUTINE COSP_CLOUDSAT_INIT(radar_freq,k2,use_gas_abs,do_ray,undef,nhydro, & logical,intent(in),optional :: & load_LUT character(len=64),intent(in) :: & - cloudsat_micro_scheme + cloudsat_micro_scheme ! OUTPUTS type(radar_cfg) :: & @@ -100,17 +111,6 @@ SUBROUTINE COSP_CLOUDSAT_INIT(radar_freq,k2,use_gas_abs,do_ray,undef,nhydro, & trim(cloudsat_micro_scheme) ! Initialize for NEW radar-configurarion derived type (radar_cfg) - allocate(rcfg%N_scale_flag(maxhclass,nRe_types)) - allocate(rcfg%Z_scale_flag(maxhclass,mt_ntt,nRe_types)) - allocate(rcfg%Z_scale_added_flag(maxhclass,mt_ntt,nRe_types)) - allocate(rcfg%Ze_scaled(maxhclass,mt_ntt,nRe_types)) - allocate(rcfg%Zr_scaled(maxhclass,mt_ntt,nRe_types)) - allocate(rcfg%kr_scaled(maxhclass,mt_ntt,nRe_types)) - allocate(rcfg%fc(maxhclass,nd,nRe_types)) - allocate(rcfg%rho_eff(maxhclass,nd,nRe_types)) - allocate(rcfg%base_list(Re_MAX_BIN)) - allocate(rcfg%step_list(Re_MAX_BIN)) - rcfg%freq = radar_freq rcfg%k2 = k2 rcfg%use_gas_abs = use_gas_abs @@ -149,6 +149,86 @@ SUBROUTINE COSP_CLOUDSAT_INIT(radar_freq,k2,use_gas_abs,do_ray,undef,nhydro, & END SUBROUTINE COSP_CLOUDSAT_INIT !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! END MODULE + ! SUBROUTINE COSP_ASSIGN_cloudsatIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_cloudsatIN(cospIN, cospgridIN, Npoints, cloudsatIN, & + CSCAL_MASK_INDICES, CSCAL_SWATH_MASK) + type(cosp_optical_inputs),intent(in),target :: cospIN ! Optical inputs to COSP simulator + type(cosp_column_inputs), intent(in),target :: cospgridIN ! Host model inputs to COSP + integer,intent(in),target :: & + Npoints + type(cloudsat_IN),intent(inout) :: & + cloudsatIN + integer,dimension(:),allocatable,intent(out) :: & ! Array containing the indices of the swath masks, already allocated? + CSCAL_MASK_INDICES + logical,dimension(:),allocatable,intent(inout) :: & ! Mask of reals over all local times + CSCAL_SWATH_MASK + + ! Local variables + integer, target :: & + N_CLOUDSAT_SWATHED, & + i + + if (cospIN % cospswathsIN(3) % N_inst_swaths .gt. 0) then + if (.not.allocated(CSCAL_SWATH_MASK)) allocate(CSCAL_SWATH_MASK(Npoints)) + ! Do swathing to figure out which cells to simulate on + call compute_orbitmasks(Npoints, & + cospIN % cospswathsIN(3) % N_inst_swaths, & + cospIN % cospswathsIN(3) % inst_localtimes, & + cospIN % cospswathsIN(3) % inst_localtime_widths, & + cospgridIN%lat, cospgridIN%lon, & + cospgridIN%rttov_date(:,2), cospgridIN%rttov_date(:,3), & ! Time fields: month, dayofmonth + cospgridIN%rttov_time(:,1), cospgridIN%rttov_time(:,2), & ! Time fields: hour, minute + CSCAL_SWATH_MASK,N_CLOUDSAT_SWATHED) ! Output: logical mask array + cloudsatIN%Npoints = N_CLOUDSAT_SWATHED + cloudsatIN%Ncolumns => cospIN%Ncolumns + if (.not. allocated(CSCAL_MASK_INDICES)) allocate(CSCAL_MASK_INDICES(cloudsatIN%Npoints)) + CSCAL_MASK_INDICES = pack((/ (i, i = 1, Npoints ) /),mask = CSCAL_SWATH_MASK) + if (cloudsatIN%Npoints .gt. 0) then + ! Allocate swathed arrays. + allocate(temp_z_vol_cloudsat(cloudsatIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_kr_vol_cloudsat(cloudsatIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_g_vol_cloudsat(cloudsatIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_hgt_matrix(cloudsatIN%Npoints,cospIN%Nlevels)) + ! Encode step: Read only appropriate values into the new temp arrays. + temp_z_vol_cloudsat = cospIN%z_vol_cloudsat(int(CSCAL_MASK_INDICES),:,:) + temp_kr_vol_cloudsat = cospIN%kr_vol_cloudsat(int(CSCAL_MASK_INDICES),:,:) + temp_g_vol_cloudsat = cospIN%g_vol_cloudsat(int(CSCAL_MASK_INDICES),:,:) + temp_hgt_matrix = cospgridIN%hgt_matrix(int(CSCAL_MASK_INDICES),:) + ! Reassign swathed values. + cloudsatIN%Nlevels => cospIN%Nlevels + cloudsatIN%z_vol => temp_z_vol_cloudsat + cloudsatIN%kr_vol => temp_kr_vol_cloudsat + cloudsatIN%g_vol => temp_g_vol_cloudsat + cloudsatIN%rcfg => cospIN%rcfg_cloudsat + cloudsatIN%hgt_matrix => temp_hgt_matrix + end if + else + cloudsatIN%Npoints = Npoints + cloudsatIN%Ncolumns => cospIN%Ncolumns + cloudsatIN%Nlevels => cospIN%Nlevels + cloudsatIN%z_vol => cospIN%z_vol_cloudsat + cloudsatIN%kr_vol => cospIN%kr_vol_cloudsat + cloudsatIN%g_vol => cospIN%g_vol_cloudsat + cloudsatIN%rcfg => cospIN%rcfg_cloudsat + cloudsatIN%hgt_matrix => cospgridIN%hgt_matrix + end if + + END SUBROUTINE COSP_ASSIGN_cloudsatIN + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_cloudsatIN_CLEAN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_cloudsatIN_CLEAN() + ! Deallocate temporary arrays + if (allocated(temp_z_vol_cloudsat)) deallocate(temp_z_vol_cloudsat) + if (allocated(temp_kr_vol_cloudsat)) deallocate(temp_kr_vol_cloudsat) + if (allocated(temp_g_vol_cloudsat)) deallocate(temp_g_vol_cloudsat) + if (allocated(temp_hgt_matrix)) deallocate(temp_hgt_matrix) + + END SUBROUTINE COSP_ASSIGN_cloudsatIN_CLEAN + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! END MODULE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% END MODULE MOD_COSP_CLOUDSAT_INTERFACE diff --git a/src/simulator/cosp_isccp_interface.F90 b/src/simulator/cosp_isccp_interface.F90 index 70299aac43..d18e09b7c7 100644 --- a/src/simulator/cosp_isccp_interface.F90 +++ b/src/simulator/cosp_isccp_interface.F90 @@ -28,19 +28,37 @@ ! ! History ! May 2015 - D. Swales - Original version +! Jun 2025 - J.K. Shaw - Added COSP-RTTOV integration and swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE MOD_COSP_ISCCP_INTERFACE USE COSP_KINDS, ONLY: wp USE mod_icarus, ONLY: isccp_top_height,isccp_top_height_direction + use mod_cosp_stats, ONLY: compute_orbitmasks,cosp_optical_inputs,cosp_column_inputs + IMPLICIT NONE - + ! Module variables + integer,dimension(:),target,allocatable :: & + temp_isccp_sunlit + real(wp),dimension(:),target,allocatable :: & + temp_isccp_skt + real(wp),dimension(:,:),target,allocatable :: & + temp_isccp_qv, & + temp_isccp_at, & + temp_isccp_phalf, & + temp_isccp_pfull + real(wp),dimension(:,:,:),target,allocatable :: & + temp_isccp_frac_out, & + temp_isccp_tau_067, & + temp_isccp_emiss_11 + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! TYPE isccp_in !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Derived input type for ISCCP simulator type isccp_IN + integer :: & + Npoints ! Number of gridpoints. integer,pointer :: & - Npoints, & ! Number of gridpoints. Ncolumns, & ! Number of columns. Nlevels, & ! Number of levels. top_height, & ! @@ -79,6 +97,106 @@ SUBROUTINE COSP_ISCCP_INIT(top_height,top_height_direction) END SUBROUTINE COSP_ISCCP_INIT + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_isccpIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_isccpIN(cospIN,cospgridIN,Npoints,isccpIN,ISCCP_MASK_INDICES) + type(cosp_optical_inputs),intent(in),target :: cospIN ! Optical inputs to COSP simulator + type(cosp_column_inputs), intent(in),target :: cospgridIN ! Host model inputs to COSP + integer,intent(in),target :: & + Npoints + type(isccp_IN),intent(inout) :: & + isccpIN + integer,dimension(:),allocatable,intent(out) :: & ! Array containing the indices of the swath masks, already allocated? + ISCCP_MASK_INDICES + + ! Local variables + logical,dimension(:),allocatable :: & ! Mask of reals over all local times + ISCCP_SWATH_MASK + integer, target :: & + N_ISCCP_SWATHED, & + i + + if (cospIN % cospswathsIN(1) % N_inst_swaths .gt. 0) then + allocate(ISCCP_SWATH_MASK(Npoints)) + ! Do swathing to figure out which cells to simulate on + call compute_orbitmasks(Npoints, & + cospIN % cospswathsIN(1) % N_inst_swaths, & + cospIN % cospswathsIN(1) % inst_localtimes, & + cospIN % cospswathsIN(1) % inst_localtime_widths, & + cospgridIN%lat, cospgridIN%lon, & + cospgridIN%rttov_date(:,2), cospgridIN%rttov_date(:,3), & ! Time fields: month, dayofmonth + cospgridIN%rttov_time(:,1), cospgridIN%rttov_time(:,2), & ! Time fields: hour, minute + ISCCP_SWATH_MASK,N_ISCCP_SWATHED) ! Output: logical mask array + isccpIN%Npoints = N_ISCCP_SWATHED + isccpIN%Ncolumns => cospIN%Ncolumns + allocate(ISCCP_MASK_INDICES(N_ISCCP_SWATHED)) + ISCCP_MASK_INDICES = pack((/ (i, i = 1, Npoints ) /),mask = ISCCP_SWATH_MASK) + deallocate(ISCCP_SWATH_MASK) + if (isccpIN%Npoints .gt. 0) then + ! Allocate swathed arrays. + allocate(temp_isccp_skt(isccpIN%Npoints),temp_isccp_qv(isccpIN%Npoints,cospIN%Nlevels),temp_isccp_at(isccpIN%Npoints,cospIN%Nlevels), & + temp_isccp_frac_out(isccpIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels),temp_isccp_tau_067(isccpIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_isccp_emiss_11(isccpIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels),temp_isccp_phalf(isccpIN%Npoints,cospIN%Nlevels+1), & + temp_isccp_pfull(isccpIN%Npoints,cospIN%Nlevels),temp_isccp_sunlit(isccpIN%Npoints)) + ! Encode step: Read only appropriate values into the new temp arrays. + temp_isccp_skt(:) = cospgridIN%skt(int(ISCCP_MASK_INDICES)) + temp_isccp_qv(:,:) = cospgridIN%qv(int(ISCCP_MASK_INDICES),:) + temp_isccp_at(:,:) = cospgridIN%at(int(ISCCP_MASK_INDICES),:) + temp_isccp_frac_out(:,:,:) = cospIN%frac_out(int(ISCCP_MASK_INDICES),:,:) + temp_isccp_tau_067(:,:,:) = cospIN%tau_067(int(ISCCP_MASK_INDICES),:,:) + temp_isccp_emiss_11(:,:,:) = cospIN%emiss_11(int(ISCCP_MASK_INDICES),:,:) + temp_isccp_phalf(:,:) = cospgridIN%phalf(int(ISCCP_MASK_INDICES),:) + temp_isccp_pfull(:,:) = cospgridIN%pfull(int(ISCCP_MASK_INDICES),:) + temp_isccp_sunlit(:) = cospgridIN%sunlit(int(ISCCP_MASK_INDICES)) + + isccpIN%Nlevels => cospIN%Nlevels + isccpIN%emsfc_lw => cospIN%emsfc_lw + isccpIN%skt => temp_isccp_skt + isccpIN%qv => temp_isccp_qv + isccpIN%at => temp_isccp_at + isccpIN%frac_out => temp_isccp_frac_out + isccpIN%dtau => temp_isccp_tau_067 + isccpIN%dem => temp_isccp_emiss_11 + isccpIN%phalf => temp_isccp_phalf + isccpIN%pfull => temp_isccp_pfull + isccpIN%sunlit => temp_isccp_sunlit + end if + else + isccpIN%Npoints = Npoints + isccpIN%Ncolumns => cospIN%Ncolumns + isccpIN%Nlevels => cospIN%Nlevels + isccpIN%emsfc_lw => cospIN%emsfc_lw + isccpIN%skt => cospgridIN%skt + isccpIN%qv => cospgridIN%qv + isccpIN%at => cospgridIN%at + isccpIN%frac_out => cospIN%frac_out + isccpIN%dtau => cospIN%tau_067 + isccpIN%dem => cospIN%emiss_11 + isccpIN%phalf => cospgridIN%phalf + isccpIN%pfull => cospgridIN%pfull + isccpIN%sunlit => cospgridIN%sunlit + end if + + END SUBROUTINE COSP_ASSIGN_isccpIN + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_isccpIN_CLEAN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_isccpIN_CLEAN() + ! Deallocate temporary arrays + if (allocated(temp_isccp_sunlit)) deallocate(temp_isccp_sunlit) + if (allocated(temp_isccp_skt)) deallocate(temp_isccp_skt) + if (allocated(temp_isccp_qv)) deallocate(temp_isccp_qv) + if (allocated(temp_isccp_at)) deallocate(temp_isccp_at) + if (allocated(temp_isccp_phalf)) deallocate(temp_isccp_phalf) + if (allocated(temp_isccp_pfull)) deallocate(temp_isccp_pfull) + if (allocated(temp_isccp_frac_out)) deallocate(temp_isccp_frac_out) + if (allocated(temp_isccp_tau_067)) deallocate(temp_isccp_tau_067) + if (allocated(temp_isccp_emiss_11)) deallocate(temp_isccp_emiss_11) + + END SUBROUTINE COSP_ASSIGN_isccpIN_CLEAN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! END MODULE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/src/simulator/cosp_misr_interface.F90 b/src/simulator/cosp_misr_interface.F90 index a2daa6ef7d..3d2e0e6cac 100644 --- a/src/simulator/cosp_misr_interface.F90 +++ b/src/simulator/cosp_misr_interface.F90 @@ -28,18 +28,30 @@ ! ! History ! May 2015 - D. Swales - Original version +! Jun 2025 - J.K. Shaw - Added COSP-RTTOV integration and swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE MOD_COSP_MISR_INTERFACE USE COSP_KINDS, ONLY: wp - + use mod_cosp_stats, ONLY: compute_orbitmasks,cosp_optical_inputs,cosp_column_inputs + IMPLICIT NONE + ! Module variables + integer,dimension(:),target,allocatable :: & + temp_misr_sunlit + real(wp),dimension(:,:),target,allocatable :: & + temp_misr_zfull, & + temp_misr_at + real(wp),dimension(:,:,:),target,allocatable :: & + temp_misr_dtau + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! TYPE misr_in ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% type misr_IN + integer :: & + Npoints ! Number of gridpoints. integer,pointer :: & - Npoints, & ! Number of gridpoints. Ncolumns, & ! Number of columns. Nlevels ! Number of levels. integer,pointer :: & @@ -61,6 +73,84 @@ SUBROUTINE COSP_MISR_INIT() END SUBROUTINE COSP_MISR_INIT + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_misrIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_misrIN(cospIN,cospgridIN,Npoints,misrIN,MISR_MASK_INDICES) + type(cosp_optical_inputs),intent(in),target :: cospIN ! Optical inputs to COSP simulator + type(cosp_column_inputs), intent(in),target :: cospgridIN ! Host model inputs to COSP + integer,intent(in),target :: & + Npoints + type(misr_IN),intent(inout) :: & + misrIN + integer,dimension(:),allocatable,intent(out) :: & ! Array containing the indices of the swath masks, already allocated? + MISR_MASK_INDICES + + ! Local variables + logical,dimension(:),allocatable :: & ! Mask of reals over all local times + MISR_SWATH_MASK + integer, target :: & + N_MISR_SWATHED, & + i + + if (cospIN % cospswathsIN(2) % N_inst_swaths .gt. 0) then + allocate(MISR_SWATH_MASK(Npoints)) + ! Do swathing to figure out which cells to simulate on + call compute_orbitmasks(Npoints, & + cospIN % cospswathsIN(2) % N_inst_swaths, & + cospIN % cospswathsIN(2) % inst_localtimes, & + cospIN % cospswathsIN(2) % inst_localtime_widths, & + cospgridIN%lat, cospgridIN%lon, & + cospgridIN%rttov_date(:,2), cospgridIN%rttov_date(:,3), & ! Time fields: month, dayofmonth + cospgridIN%rttov_time(:,1), cospgridIN%rttov_time(:,2), & ! Time fields: hour, minute + MISR_SWATH_MASK,N_MISR_SWATHED) ! Output: logical mask array + misrIN%Npoints = N_MISR_SWATHED + misrIN%Ncolumns => cospIN%Ncolumns + allocate(MISR_MASK_INDICES(N_MISR_SWATHED)) + MISR_MASK_INDICES = pack((/ (i, i = 1, Npoints ) /),mask = MISR_SWATH_MASK) + deallocate(MISR_SWATH_MASK) + if (misrIN%Npoints .gt. 0) then + ! Allocate swathed arrays. + allocate(temp_misr_dtau(misrIN%Npoints,cospIN%Ncolumns,cospIN%Nlevels), & + temp_misr_sunlit(misrIN%Npoints), & + temp_misr_zfull(misrIN%Npoints,cospIN%Nlevels), & + temp_misr_at(misrIN%Npoints,cospIN%Nlevels)) + ! Encode step: Read only appropriate values into the new temp arrays. + temp_misr_dtau(:,:,:) = cospIN%tau_067(int(MISR_MASK_INDICES),:,:) + temp_misr_at(:,:) = cospgridIN%at(int(MISR_MASK_INDICES),:) + temp_misr_zfull(:,:) = cospgridIN%hgt_matrix(int(MISR_MASK_INDICES),:) + temp_misr_sunlit(:) = cospgridIN%sunlit(int(MISR_MASK_INDICES)) + + misrIN%Nlevels => cospIN%Nlevels + misrIN%dtau => temp_misr_dtau + misrIN%sunlit => temp_misr_sunlit + misrIN%zfull => temp_misr_zfull + misrIN%at => temp_misr_at + end if + else + misrIN%Npoints = Npoints + misrIN%Ncolumns => cospIN%Ncolumns + misrIN%Nlevels => cospIN%Nlevels + misrIN%dtau => cospIN%tau_067 + misrIN%sunlit => cospgridIN%sunlit + misrIN%zfull => cospgridIN%hgt_matrix + misrIN%at => cospgridIN%at + end if + + END SUBROUTINE COSP_ASSIGN_misrIN + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_misrIN_CLEAN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_misrIN_CLEAN() + ! Deallocate temporary arrays + if (allocated(temp_misr_sunlit)) deallocate(temp_misr_sunlit) + if (allocated(temp_misr_zfull)) deallocate(temp_misr_zfull) + if (allocated(temp_misr_at)) deallocate(temp_misr_at) + if (allocated(temp_misr_dtau)) deallocate(temp_misr_dtau) + + END SUBROUTINE COSP_ASSIGN_misrIN_CLEAN + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! END MODULE ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/src/simulator/cosp_modis_interface.F90 b/src/simulator/cosp_modis_interface.F90 index 10944654fc..02e4dfc3ce 100644 --- a/src/simulator/cosp_modis_interface.F90 +++ b/src/simulator/cosp_modis_interface.F90 @@ -28,6 +28,7 @@ ! ! History ! May 2015 - D. Swales - Original version +! Jun 2025 - J.K. Shaw - Added COSP-RTTOV integration and swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE MOD_COSP_Modis_INTERFACE USE COSP_KINDS, ONLY: wp @@ -39,6 +40,7 @@ MODULE MOD_COSP_Modis_INTERFACE highCloudPressureLimit,lowCloudPressureLimit,phaseIsNone, & phaseIsLiquid,phaseIsIce,phaseIsUndetermined,trial_re_w, & trial_re_i,g_w,g_i,w0_w,w0_i, get_g_nir,get_ssa_nir + use mod_cosp_stats, ONLY: compute_orbitmasks,cosp_optical_inputs,cosp_column_inputs implicit none ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -106,7 +108,89 @@ SUBROUTINE COSP_MODIS_INIT() w0_i(1:num_trial_res) = get_ssa_nir(phaseIsIce,trial_re_i(1:num_trial_res)) END SUBROUTINE COSP_MODIS_INIT - + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_modisIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_modisIN(cospIN,cospgridIN,Npoints,modisIN,CSCAL_SWATH_MASK,MODIS_CSCAL_MASK_INDICES) + type(cosp_optical_inputs),intent(in),target :: cospIN ! Optical inputs to COSP simulator + type(cosp_column_inputs), intent(in),target :: cospgridIN ! Host model inputs to COSP + integer,intent(in),target :: & + Npoints + type(modis_IN),intent(inout) :: & + modisIN + logical,dimension(:),allocatable,intent(in) :: & ! Mask of reals over all local times + CSCAL_SWATH_MASK + integer,dimension(:),allocatable,intent(out) :: & ! Array containing the indices of the swath masks, already allocated? + MODIS_CSCAL_MASK_INDICES + ! Local variables + logical,dimension(:),allocatable :: & ! Mask of reals over all local times + MODIS_SWATH_MASK, & + MODIS_CSCAL_SWATH_MASK + integer, target :: & + N_MODIS_SWATHED, & + i + + if (cospIN % cospswathsIN(6) % N_inst_swaths .gt. 0) then + allocate(MODIS_SWATH_MASK(Npoints)) + ! Do swathing to figure out which cells to simulate on + call compute_orbitmasks(Npoints, & + cospIN % cospswathsIN(6) % N_inst_swaths, & + cospIN % cospswathsIN(6) % inst_localtimes, & + cospIN % cospswathsIN(6) % inst_localtime_widths, & + cospgridIN%lat, cospgridIN%lon, & + cospgridIN%rttov_date(:,2), cospgridIN%rttov_date(:,3), & ! Time fields: month, dayofmonth + cospgridIN%rttov_time(:,1), cospgridIN%rttov_time(:,2), & ! Time fields: hour, minute + MODIS_SWATH_MASK,N_MODIS_SWATHED) ! Output: logical mask array + + ! Operate a little differently with MODIS because there is already some swathing at play. + ! modisIN is over all variables rather than just swathed variables + modisIN%Ncolumns => cospIN%Ncolumns + modisIN%Nlevels => cospIN%Nlevels + modisIN%Npoints => Npoints + modisIN%liqFrac => cospIN%fracLiq + modisIN%tau => cospIN%tau_067 + modisIN%g => cospIN%asym + modisIN%w0 => cospIN%ss_alb + + modisIN%Nsunlit = count((cospgridIN%sunlit > 0) .and. MODIS_SWATH_MASK) ! Sunlit mask and indices now include swathing as well + if (modisIN%Nsunlit .gt. 0) then + allocate(modisIN%sunlit(modisIN%Nsunlit), modisIN%pres(modisIN%Npoints,cospIN%Nlevels+1)) + modisIN%pres = cospgridIN%phalf + modisIN%sunlit = pack((/ (i, i = 1, modisIN%Npoints ) /),mask = ((cospgridIN%sunlit > 0) .and. MODIS_SWATH_MASK)) ! Indices of columns to operate on in modisIN + endif + if (modisIN%Npoints - modisIN%Nsunlit .gt. 0) then ! If more than zero tiles are not sunlit and swathed, create array to mask out these gridcells in cospOUT + allocate(modisIN%notSunlit(modisIN%Npoints - modisIN%Nsunlit)) + modisIN%notSunlit = pack((/ (i, i = 1, Npoints ) /),mask = (.not. ((cospgridIN%sunlit > 0) .and. MODIS_SWATH_MASK))) ! Create an array with the indices of the non-sunlit tiles + endif + ! Create a CSCAL-MODIS joint mask for the combined product. + if (allocated(CSCAL_SWATH_MASK)) then + allocate(MODIS_CSCAL_SWATH_MASK(Npoints)) + MODIS_CSCAL_SWATH_MASK = (.not. (MODIS_SWATH_MASK .and. CSCAL_SWATH_MASK)) ! Gridcells not seen by both MODIS and CSCAL should be set to zero + MODIS_CSCAL_MASK_INDICES = pack((/ (i, i = 1, Npoints ) /),mask = MODIS_CSCAL_SWATH_MASK) + end if + else + modisIN%Ncolumns => cospIN%Ncolumns + modisIN%Nlevels => cospIN%Nlevels + modisIN%Npoints => Npoints + modisIN%liqFrac => cospIN%fracLiq + modisIN%tau => cospIN%tau_067 + modisIN%g => cospIN%asym + modisIN%w0 => cospIN%ss_alb + modisIN%Nsunlit = count(cospgridIN%sunlit > 0) + if (modisIN%Nsunlit .gt. 0) then + allocate(modisIN%sunlit(modisIN%Nsunlit),modisIN%pres(modisIN%Npoints,cospIN%Nlevels+1)) + modisIN%pres = cospgridIN%phalf + modisIN%sunlit = pack((/ (i, i = 1, Npoints ) /),mask = cospgridIN%sunlit > 0) + endif + if (count(cospgridIN%sunlit <= 0) .gt. 0) then ! If more than zero tiles are not sunlit a.k.a. if there are dark tiles + allocate(modisIN%notSunlit(count(cospgridIN%sunlit <= 0))) + modisIN%notSunlit = pack((/ (i, i = 1, Npoints ) /),mask = .not. cospgridIN%sunlit > 0) ! Create an array with the indices of the non-sunlit tiles + endif + end if + + END SUBROUTINE COSP_ASSIGN_modisIN + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! END MODULE MOD_COSP_Modis_INTERFACE ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/src/simulator/cosp_parasol_interface.F90 b/src/simulator/cosp_parasol_interface.F90 index 21a2d8650e..795b381a2f 100644 --- a/src/simulator/cosp_parasol_interface.F90 +++ b/src/simulator/cosp_parasol_interface.F90 @@ -28,11 +28,18 @@ ! ! History ! May 2015 - D. Swales - Original version +! Jun 2025 - J.K. Shaw - Added COSP-RTTOV integration and swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE MOD_COSP_PARASOL_INTERFACE USE COSP_KINDS, ONLY: WP + use mod_cosp_stats, ONLY: compute_orbitmasks,cosp_optical_inputs,cosp_column_inputs implicit none + ! Module variables + real(wp),dimension(:,:),target,allocatable :: & + temp_tautot_S_liq, & + temp_tautot_S_ice + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! TYPE cosp_parasol !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -65,8 +72,9 @@ MODULE MOD_COSP_PARASOL_INTERFACE ! TYPE parasol_in !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TYPE parasol_IN + integer :: & + Npoints ! Number of horizontal gridpoints integer,pointer :: & - Npoints, & ! Number of horizontal gridpoints Nlevels, & ! Number of vertical levels Ncolumns, & ! Number of columns Nrefl ! Number of angles for which the reflectance is computed @@ -84,6 +92,76 @@ SUBROUTINE COSP_PARASOL_INIT() end subroutine COSP_PARASOL_INIT + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_parasolIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_parasolIN(cospIN,cospgridIN,Npoints,parasolIN,PARASOL_MASK_INDICES) + type(cosp_optical_inputs),intent(in),target :: cospIN ! Optical inputs to COSP simulator + type(cosp_column_inputs), intent(in),target :: cospgridIN ! Host model inputs to COSP + integer,intent(in),target :: & + Npoints + type(parasol_IN),intent(inout) :: & + parasolIN + integer,dimension(:),allocatable,intent(out) :: & ! Array containing the indices of the swath masks, already allocated? + PARASOL_MASK_INDICES + + ! Local variables + logical,dimension(:),allocatable :: & ! Mask of reals over all local times + PARASOL_SWATH_MASK + integer, target :: & + N_PARASOL_SWATHED, & + i + + if (cospIN % cospswathsIN(5) % N_inst_swaths .gt. 0) then + allocate(PARASOL_SWATH_MASK(Npoints)) + ! Do swathing to figure out which cells to simulate on + call compute_orbitmasks(Npoints, & + cospIN % cospswathsIN(5) % N_inst_swaths, & + cospIN % cospswathsIN(5) % inst_localtimes, & + cospIN % cospswathsIN(5) % inst_localtime_widths, & + cospgridIN%lat, cospgridIN%lon, & + cospgridIN%rttov_date(:,2), cospgridIN%rttov_date(:,3), & ! Time fields: month, dayofmonth + cospgridIN%rttov_time(:,1), cospgridIN%rttov_time(:,2), & ! Time fields: hour, minute + PARASOL_SWATH_MASK,N_PARASOL_SWATHED) ! Output: logical mask array + parasolIN%Npoints = N_PARASOL_SWATHED + parasolIN%Ncolumns => cospIN%Ncolumns + allocate(PARASOL_MASK_INDICES(N_PARASOL_SWATHED)) + PARASOL_MASK_INDICES = pack((/ (i, i = 1, Npoints ) /),mask = PARASOL_SWATH_MASK) + deallocate(PARASOL_SWATH_MASK) + if (parasolIN%Npoints .gt. 0) then + ! Allocate swathed arrays. + allocate(temp_tautot_S_liq(parasolIN%Npoints,cospIN%Ncolumns), & + temp_tautot_S_ice(parasolIN%Npoints,cospIN%Ncolumns)) + ! Encode step: Read only appropriate values into the new temp arrays. + temp_tautot_S_liq(:,:) = cospIN%tautot_S_liq(int(PARASOL_MASK_INDICES),:) + temp_tautot_S_ice(:,:) = cospIN%tautot_S_ice(int(PARASOL_MASK_INDICES),:) + + parasolIN%Nlevels => cospIN%Nlevels + parasolIN%Nrefl => cospIN%Nrefl + parasolIN%tautot_S_liq => temp_tautot_S_liq + parasolIN%tautot_S_ice => temp_tautot_S_ice + endif + else + parasolIN%Npoints = Npoints + parasolIN%Ncolumns => cospIN%Ncolumns + parasolIN%Nlevels => cospIN%Nlevels + parasolIN%Nrefl => cospIN%Nrefl + parasolIN%tautot_S_liq => cospIN%tautot_S_liq + parasolIN%tautot_S_ice => cospIN%tautot_S_ice + end if + + END SUBROUTINE COSP_ASSIGN_parasolIN + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE COSP_ASSIGN_parasolIN_CLEAN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_ASSIGN_parasolIN_CLEAN() + ! Deallocate temporary arrays + if (allocated(temp_tautot_S_liq)) deallocate(temp_tautot_S_liq) + if (allocated(temp_tautot_S_ice)) deallocate(temp_tautot_S_ice) + + END SUBROUTINE COSP_ASSIGN_parasolIN_CLEAN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! END MODULE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/src/simulator/cosp_rttov_interfaceSTUB.F90 b/src/simulator/cosp_rttov_interfaceSTUB.F90 index 654a8df619..a6223b0ba6 100644 --- a/src/simulator/cosp_rttov_interfaceSTUB.F90 +++ b/src/simulator/cosp_rttov_interfaceSTUB.F90 @@ -29,62 +29,92 @@ ! History ! May 2015 - D. Swales - Original version ! Apr 2015 - D. Swales - Modified for RTTOVv11.3 +! Jun 2025 - J.K. Shaw - Added RTTOVv13.2 integration and swathing. rttov_cfg moved to cosp_rttov_util.F90 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE MOD_COSP_RTTOV_INTERFACE - USE COSP_KINDS, ONLY: wp + USE COSP_KINDS, ONLY: wp + USE MOD_COSP_RTTOV, ONLY: rttov_IN + USE MOD_COSP_RTTOV_UTIL, ONLY: rttov_cfg, rttov_output IMPLICIT NONE - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! TYPE rttov_in - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - type rttov_in - integer,pointer :: & - nPoints, & ! Number of profiles to simulate - nLevels, & ! Number of levels - nSubCols, & ! Number of subcolumns - month ! Month (needed for surface emissivity calculation) - real(wp),pointer :: & - zenang, & ! Satellite zenith angle - co2, & ! Carbon dioxide - ch4, & ! Methane - n2o, & ! n2o - co ! Carbon monoxide - real(wp),dimension(:),pointer :: & - surfem ! Surface emissivities for the channels - real(wp),dimension(:),pointer :: & - h_surf, & ! Surface height - u_surf, & ! U component of surface wind - v_surf, & ! V component of surface wind - t_skin, & ! Surface skin temperature - p_surf, & ! Surface pressure - t2m, & ! 2 m Temperature - q2m, & ! 2 m Specific humidity - lsmask, & ! land-sea mask - latitude, & ! Latitude - longitude, & ! Longitude - seaice ! Sea-ice? - real(wp),dimension(:,:),pointer :: & - p, & ! Pressure @ model levels - ph, & ! Pressure @ model half levels - t, & ! Temperature - q, & ! Specific humidity - o3 ! Ozone - - ! These fields below are needed ONLY for the RTTOV all-sky brightness temperature - real(wp),dimension(:,:),pointer :: & - tca, & ! Cloud fraction - cldIce, & ! Cloud ice - cldLiq, & ! Cloud liquid - fl_rain, & ! Precipitation flux (startiform+convective rain) (kg/m2/s) - fl_snow ! Precipitation flux (stratiform+convective snow) - end type rttov_in + + CONTAINS !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE cosp_rttov_init !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - SUBROUTINE COSP_RTTOV_INIT() + SUBROUTINE COSP_RTTOV_INIT(Lrttov,Nlevels,Ninstruments,instrument_namelists, & + rttov_configs,unitn,debug) + logical,intent(inout) :: & + Lrttov + integer,intent(in) :: & + Nlevels, & + Ninstruments + type(character(len=128)), dimension(Ninstruments) :: & + instrument_namelists ! Array of paths to RTTOV instrument namelists + type(rttov_cfg), dimension(:), intent(out), allocatable :: & ! intent(out)? + rttov_configs + integer,intent(in),Optional :: unitn ! Used for io limits + logical,intent(in),Optional :: debug + + Lrttov = .false. + allocate(rttov_configs(Ninstruments)) + + print*,'Running COSP_RTTOV_INIT from STUB files.', & + 'To run RTTOV, compile COSP after setting environmental variable "RTTOV"' + END SUBROUTINE COSP_RTTOV_INIT + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE DESTROY_RTTOV_CONFIG + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE DESTROY_RTTOV_CONFIG(rttovConfig) + + type(rttov_cfg),intent(inout) :: & + rttovConfig + + if (allocated(rttovConfig % iChannel)) deallocate(rttovConfig % iChannel) + if (allocated(rttovConfig % iChannel_out)) deallocate(rttovConfig % iChannel_out) + if (allocated(rttovConfig % emisChannel)) deallocate(rttovConfig % emisChannel) + if (allocated(rttovConfig % reflChannel)) deallocate(rttovConfig % reflChannel) + if (allocated(rttovConfig % rttov_localtime)) deallocate(rttovConfig % rttov_localtime) + if (allocated(rttovConfig % rttov_localtime_width)) deallocate(rttovConfig % rttov_localtime_width) + if (allocated(rttovConfig % swath_mask)) deallocate(rttovConfig % swath_mask) + + END SUBROUTINE DESTROY_RTTOV_CONFIG + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE cosp_rttov_simulate + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_RTTOV_SIMULATE(rttovIN,rttovConfig,error, & ! Inputs + bt_total,bt_clear, & ! Brightness Temp Outputs + rad_total,rad_clear,rad_cloudy, & ! Radiance Outputs + refl_total,refl_clear, & ! Reflectance Outputs + debug) + + type(rttov_in),intent(in) :: & + rttovIN + type(rttov_cfg),intent(inout) :: & + rttovConfig + character(len=128) :: & + error ! Error messages (only populated if error encountered) + real(wp),intent(inout),dimension(rttovIN%nPoints,rttovConfig%nchan_out),optional :: & + bt_total, & ! All-sky + bt_clear, & ! Clear-sky + rad_total, & ! All-sky + rad_clear, & ! Clear-sky + rad_cloudy, & ! Cloudy-sky + refl_total, & ! All-sky + refl_clear ! Clear-sky + logical,intent(in),optional :: & + debug + + print*,'Running COSP_RTTOV_SIMULATE from STUB files.', & + 'To run RTTOV, compile COSP after setting environmental variable "RTTOV"' + + END SUBROUTINE COSP_RTTOV_SIMULATE + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! END MODULE ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/src/simulator/cosp_rttov_interface_v13.F90 b/src/simulator/cosp_rttov_interface_v13.F90 new file mode 100644 index 0000000000..8e5e3b5556 --- /dev/null +++ b/src/simulator/cosp_rttov_interface_v13.F90 @@ -0,0 +1,971 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History +! May 2015 - D. Swales - Original version +! Apr 2015 - D. Swales - Modified for RTTOVv11.3 +! Jun 2025 - J.K. Shaw - Modified for RTTOV v13 +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +MODULE MOD_COSP_RTTOV_INTERFACE + USE COSP_KINDS, ONLY: wp + use MOD_COSP_RTTOV, ONLY: rttov_in + USE MOD_COSP_RTTOV_UTIL, ONLY: rttov_cfg, rttov_output + + ! rttov_const contains useful RTTOV constants + USE rttov_const, ONLY : & + errorstatus_success, & + errorstatus_fatal + + ! rttov_types contains definitions of all RTTOV data types + USE rttov_types, ONLY : & + rttov_options, & + rttov_options_scatt, & + rttov_coefs, & + rttov_scatt_coef, & + rttov_pccomp, & + rttov_radiance, & + rttov_transmission, & + rttov_profile, & + rttov_emissivity, & + rttov_reflectance, & + rttov_chanprof + + ! jpim, jprb and jplm are the RTTOV integer, real and logical KINDs + USE parkind1, ONLY : jpim, jprb, jplm + + USE rttov_unix_env, ONLY : rttov_exit + + IMPLICIT NONE + +#include "rttov_read_coefs.interface" +#include "rttov_user_options_checkinput.interface" +#include "rttov_print_opts.interface" + + +CONTAINS + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE cosp_rttov_init + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_RTTOV_INIT(Lrttov, Nlevels,Ninstruments,instrument_namelists, & + rttov_configs, unitn, debug) + + logical,intent(in) :: & + Lrttov + integer,intent(in) :: & + Nlevels, & + Ninstruments + type(character(len=256)), dimension(Ninstruments) :: & + instrument_namelists ! Array of paths to RTTOV instrument namelists + type(rttov_cfg), dimension(:), intent(out), allocatable :: & + rttov_configs + integer,intent(in),Optional :: unitn + logical,intent(in),Optional :: debug + + ! Local variables + integer :: & + inst_idx ! iterator + logical :: verbose + if (present(debug)) verbose = debug + + allocate(rttov_configs(Ninstruments)) + + ! Create config objects for each instrument to be simulated by RTTOV. Return to the main subroutine. + do inst_idx=1,Ninstruments + if (present(unitn)) then + call cosp_rttov_init_s(Nlevels,instrument_namelists(inst_idx),rttov_configs(inst_idx),unitn=unitn,debug=verbose) + else + call cosp_rttov_init_s(Nlevels,instrument_namelists(inst_idx),rttov_configs(inst_idx),debug=verbose) + endif + end do + + + END SUBROUTINE COSP_RTTOV_INIT + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE cosp_rttov_init + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_RTTOV_INIT_S(Nlevels,namelist_filepath, & + rttov_config, unitn, debug) + + integer,intent(in) :: & + Nlevels + character(len=256),intent(in) :: & + namelist_filepath ! Array of paths to RTTOV instrument namelists + type(rttov_cfg),intent(out) :: & + rttov_config + + integer,intent(in),Optional :: unitn ! Used for io limits + logical,intent(in),Optional :: debug + + ! Local variables + character(len=256),target :: & + channel_filepath, & + wavenum_filepath, & + rttov_srcDir, & + rttov_coefDir, & + OD_coef_filepath, & + aer_coef_filepath, & + cld_coef_filepath, & + PC_coef_filepath + + real(wp), target :: & + CO2_mr, & + CH4_mr, & + CO_mr, & + N2O_mr, & + SO2_mr, & + rttov_ZenAng + + ! Declare RTTOV namelist fields + logical :: Lrttov_bt + logical :: Lrttov_rad + logical :: Lrttov_refl + logical :: Lrttov_cld + logical :: Lrttov_aer + logical :: Lrttov_cldparam + logical :: Lrttov_aerparam + logical :: Lrttov_gridbox_cldmmr + logical :: Ldo_nlte_correction + logical :: Lrttov_pc + logical :: Lrttov_solar + logical :: Lchannel_filepath + logical :: Lwavenum_filepath + logical :: user_tracegas_input + logical :: SO2_data + logical :: N2O_data + logical :: CO_data + logical :: CO2_data + logical :: CH4_data + logical :: ozone_data + logical :: clw_data + + character(len=256) :: cosp_status + integer :: & + i, & + nchannels_rec + + integer, target :: & + rttov_nthreads + + integer(kind=jpim) :: & + ipcbnd, & + ipcreg, & + npcscores + + ! JKS for orbital swathing + integer(kind=jpim) :: & + rttov_Nlocaltime, & ! Number of orbits + rttov_gas_units, & ! RTTOV units for trace gases: 0 ppmv over dry air, 1 kg/kg over moist air, 2 ppmv over moist air, 3 kg/kg over dry air + rttov_clw_scheme, & ! Scheme for determining cloud water optical properties. + rttov_ice_scheme, & ! Scheme for determining cloud ice optical properties. + rttov_icede_param, & ! Scheme for how cloud ice deff is parameterized + rttov_extendatmos + real(wp),dimension(20) :: & ! Reasonable but arbitrary limit at 10 local time orbits + rttov_localtime, & ! RTTOV subsetting by local time in hours [0,24] + rttov_localtime_width ! Width of satellite swath (km). + + ! JKS for checking errors in filenames. + character(len=256) :: imsg !<-- some suitable length, say XX=256 + integer :: erro + integer(kind=jplm) :: errorstatus ! Return error status of RTTOV subroutine calls + integer(kind=jpim) :: alloc_status(60) + + logical :: verbose = .false. + if (present(debug)) verbose = debug + + ! Init. variables to false. + rttov_Nlocaltime = 0 + Lrttov_bt = .false. + Lrttov_rad = .false. + Lrttov_refl = .false. + Lrttov_cld = .false. + Lrttov_aer = .false. + Lrttov_cldparam = .false. + Lrttov_aerparam = .false. + Lrttov_gridbox_cldmmr = .true. ! Assume gridbox average MMRs. Most common for GCMs. + Ldo_nlte_correction = .false. ! Correct for non-local thermal equilibrium effects? Default false. + Lrttov_pc = .false. + Lrttov_solar = .false. + Lchannel_filepath = .false. + Lwavenum_filepath = .false. + SO2_data = .false. + N2O_data = .false. + CO_data = .false. + CO2_data = .false. + CH4_data = .false. + ozone_data = .false. + clw_data = .false. + user_tracegas_input = .false. + rttov_Nlocaltime = 0 ! Default: zero swath masking + rttov_gas_units = 1 ! Default: kg/kg over moist air (should be updated by user!) + rttov_clw_scheme = 2 ! 1: OPAC, 2: Deff + rttov_ice_scheme = 1 ! 1: Baum, 2: Baran (2014), 3: Baran (2018) + rttov_icede_param = 0 ! 0: Indicates that Deff is supplied but is rejected by RTTOV. 1: Ou and Liou, 2: Wyser(recommended), 3: Boudala, 4: McFarquhar. + rttov_extendatmos = 0 ! 0: do not extend above supplied pressure levels. 1: Simply top layer. 2: Not yet implemented. + + ! Read RTTOV namelist fields + namelist/RTTOV_INPUT/Lrttov_bt,Lrttov_rad,Lrttov_refl,Lrttov_cld, & ! Logicals for RTTOV configuration + Lrttov_aer,Lrttov_cldparam,Lrttov_aerparam, & ! + Lrttov_gridbox_cldmmr,Ldo_nlte_correction, & ! Assume cloud water mixing ratios are gridbox average instead of in-cloud + Lrttov_pc,Lrttov_solar,nchannels_rec,Lchannel_filepath, & + channel_filepath,Lwavenum_filepath,wavenum_filepath, & + rttov_srcDir,rttov_coefDir, & + OD_coef_filepath,aer_coef_filepath,cld_coef_filepath, & + PC_coef_filepath, & + CO2_data,CH4_data,CO_data,N2O_data,SO2_data,ozone_data, & ! Use trace gases for radiative transfer? + clw_data, & ! MW option + user_tracegas_input, & ! User-supplied trace gas concentrations + CO2_mr,CH4_mr,CO_mr,N2O_mr,SO2_mr, & ! Mixing ratios + ipcbnd,ipcreg,npcscores, & ! PC-RTTOV config values + rttov_nthreads,rttov_ZenAng,rttov_Nlocaltime, & + rttov_localtime,rttov_localtime_width, & + rttov_gas_units,rttov_clw_scheme,rttov_ice_scheme, & + rttov_icede_param,rttov_extendatmos + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Read in namelists + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Handle indices of files already opened (for CESM integration) + if (present(unitn)) then + open(unitn,file=namelist_filepath,status='unknown',iostat=erro,iomsg=imsg) + if (erro > 0) then + print*,'Error reading in "namelist_filepath" in COSP_RTTOV_INIT_S' + print*,'erro: ', erro + print*,'imsg: ', imsg + print*,'namelist_filepath: ',namelist_filepath + errorstatus = 1 + call rttov_exit(errorstatus) + end if + read(unitn,nml=RTTOV_INPUT) + close(unitn) + else + open(10,file=namelist_filepath,status='unknown',iostat=erro,iomsg=imsg) + if (erro > 0) then + print*,'Error reading in "namelist_filepath" in COSP_RTTOV_INIT_S' + print*,'erro: ', erro + print*,'imsg: ', imsg + print*,'namelist_filepath: ',namelist_filepath + errorstatus = 1 + call rttov_exit(errorstatus) + end if + read(10,nml=RTTOV_INPUT) + close(10) + endif + + ! Set swath arrays correctly. + allocate(rttov_config%rttov_localtime(rttov_Nlocaltime),rttov_config%rttov_localtime_width(rttov_Nlocaltime)) + rttov_config%rttov_Nlocaltime = rttov_Nlocaltime + rttov_config%rttov_localtime(:) = rttov_localtime(1:rttov_Nlocaltime) + rttov_config%rttov_localtime_width(:) = rttov_localtime_width(1:rttov_Nlocaltime) + + ! Extend atmosphere setting. If user-supplied values end too low, channels sounding the upper atmosphere will be bad. + rttov_config%rttov_extendatmos = rttov_extendatmos + + ! Set logicals for RTTOV config + rttov_config%Lrttov_bt = Lrttov_bt + rttov_config%Lrttov_rad = Lrttov_rad + rttov_config%Lrttov_refl = Lrttov_refl + rttov_config%Lrttov_pc = Lrttov_pc + + ! Set paths for RTTOV config + rttov_config%rttov_srcDir = rttov_srcDir + rttov_config%rttov_coefDir = rttov_coefDir + + ! Construct optical depth and cloud coefficient files + rttov_config%OD_coef_filepath = trim(rttov_config%rttov_srcDir)//trim(rttov_config%rttov_coefDir)//trim(OD_coef_filepath) + rttov_config%aer_coef_filepath = trim(rttov_config%rttov_srcDir)//trim(rttov_config%rttov_coefDir)//trim(aer_coef_filepath) + rttov_config%cld_coef_filepath = trim(rttov_config%rttov_srcDir)//trim(rttov_config%rttov_coefDir)//trim(cld_coef_filepath) + rttov_config%PC_coef_filepath = trim(rttov_config%rttov_srcDir)//trim(rttov_config%rttov_coefDir)//trim(PC_coef_filepath) + + ! Set other RTTOV config variables + rttov_config%rttov_direct_nthreads = rttov_nthreads + + ! Set to false in namelist if model supplies trace profiles + rttov_config%user_tracegas_input = user_tracegas_input + rttov_config%gas_units = rttov_gas_units + + ! Parametrization of cloud optical properties. + rttov_config%clw_scheme = rttov_clw_scheme + rttov_config%ice_scheme = rttov_ice_scheme + rttov_config%icede_param = rttov_icede_param + + rttov_config%SO2_mr = SO2_mr + rttov_config%N2O_mr = N2O_mr + rttov_config%CO_mr = CO_mr + rttov_config%CO2_mr = CO2_mr + rttov_config%CH4_mr = CH4_mr + rttov_config%ZenAng = rttov_ZenAng + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 1. Initialise RTTOV options structure + ! ------------------------------------------------------ + ! See page 157 of RTTOV v13 user guide for documentation + ! Initializing all options to defaults for consistency + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + ! General configuration options + rttov_config % opts % config % do_checkinput = .true. + rttov_config % opts % config % apply_reg_limits = .false. ! True in v11 + rttov_config % opts % config % verbose = .false. ! JKS suppress for now + rttov_config % opts % config % opdep13_gas_clip = .true. + + ! Declare RTTOV namelist fields + rttov_config % opts % rt_all % SO2_data = SO2_data + rttov_config % opts % rt_all % N2O_data = N2O_data + rttov_config % opts % rt_all % CO_data = CO_data + rttov_config % opts % rt_all % CO2_data = CO2_data + rttov_config % opts % rt_all % CH4_data = CH4_data + rttov_config % opts % rt_all % ozone_data = ozone_data + rttov_config % opts % rt_mw % clw_data = clw_data + + ! Other general RT options (initializing to defaults for completeness) + rttov_config % opts % rt_all % do_lambertian = .false. + rttov_config % opts % rt_all % switchrad = .false. + rttov_config % opts % rt_all % rad_down_lin_tau = .true. + rttov_config % opts % rt_all % use_t2m_opdep = .true. + rttov_config % opts % rt_all % use_q2m = .true. + rttov_config % opts % rt_all % use_tskin_eff = .false. + rttov_config % opts % rt_all % addrefrac = .true. + rttov_config % opts % rt_all % plane_parallel = .false. + rttov_config % opts % rt_all % transmittances_only = .false. + + ! MW-only radiative transfer options: + ! JKS make this optional? + rttov_config % opts % rt_mw % clw_data = .false. + rttov_config % opts % rt_mw % clw_scheme = 2 ! Default = 2/Rosenkranz + rttov_config % opts % rt_mw % clw_cloud_top = 322 ! Default is 322 hPa + rttov_config % opts % rt_mw % fastem_version = 6 ! Default FASTEM-6 + rttov_config % opts % rt_mw % supply_foam_fraction = .false. + + ! UV/visible/IR-only radiative transfer options + rttov_config % opts % rt_ir % addsolar = Lrttov_solar + rttov_config % Lrttov_solar = Lrttov_solar + rttov_config % opts % rt_ir % rayleigh_max_wavelength = 2._wp ! 2um + rttov_config % opts % rt_ir % rayleigh_min_pressure = 0._wp ! 0 hPa + rttov_config % opts % rt_ir % rayleigh_single_scatt = .true. + rttov_config % opts % rt_ir % rayleigh_depol = .true. ! Default false, recommended true + rttov_config % opts % rt_ir % do_nlte_correction = Ldo_nlte_correction + rttov_config % opts % rt_ir % solar_sea_brdf_model = 2 + rttov_config % opts % rt_ir % ir_sea_emis_model = 2 + + ! User options - JKS + ! Duplicate for STUB functionality + rttov_config % Lrttov_aer = Lrttov_aer + rttov_config % Lrttov_cld = Lrttov_cld + rttov_config % opts % rt_ir % addaerosl = Lrttov_aer + rttov_config % opts % rt_ir % addclouds = Lrttov_cld + rttov_config % opts % rt_ir % user_aer_opt_param = Lrttov_aerparam ! User specifies the aerosol scattering optical parameters + rttov_config % opts % rt_ir % user_cld_opt_param = Lrttov_cldparam ! User specifies the cloud scattering optical parameters + + rttov_config % opts % rt_ir % grid_box_avg_cloud = Lrttov_gridbox_cldmmr + rttov_config % opts % rt_ir % cldcol_threshold = -1._wp + rttov_config % opts % rt_ir % cloud_overlap = 1 ! Maximum-random overlap + rttov_config % opts % rt_ir % cc_low_cloud_top = 750_wp ! 750 hPa. Only applies when cloud_overlap=2. + rttov_config % opts % rt_ir % ir_scatt_model = 2 + rttov_config % opts % rt_ir % vis_scatt_model = 1 ! Scattering model to use for solar source term: 1 => DOM; 2 => single-scattering; 3 => MFASIS-LUT; 4 => MFASIS-NN (default = 1); only applies when addclouds or addaerosl is true and addsolar is true. JKS note, DOM is the most expensive, MFASIS-NN might be a better option + rttov_config % opts % rt_ir % dom_nstreams = 8 + rttov_config % opts % rt_ir % dom_accuracy = 0._wp ! only applies when addclouds or addaerosl is true and DOM is selected as a scattering solver. + rttov_config % opts % rt_ir % dom_opdep_threshold = 0._wp + rttov_config % opts % rt_ir % dom_rayleigh = .false. + + ! Principal Components-only radiative transfer options: + ! Default off + rttov_config % opts % rt_ir % pc % addpc = .false. + rttov_config % opts % rt_ir % pc % npcscores = -1 + rttov_config % opts % rt_ir % pc % addradrec = .false. + rttov_config % opts % rt_ir % pc % ipcbnd = 1 + rttov_config % opts % rt_ir % pc % ipcreg = 1 ! The index of the required set of PC predictors + + ! Options related to interpolation and the vertical grid: + rttov_config % opts % interpolation % addinterp = .true. + rttov_config % opts % interpolation % interp_mode = 1 +! rttov_config % opts % interpolation % reg_limit_extrap = .true. ! Depreciated + rttov_config % opts % interpolation % lgradp = .false. +! rttov_config % opts % interpolation % spacetop = .true. ! Depreciated + + ! Options related to HTFRTC: + rttov_config % opts % htfrtc_opts % htfrtc = .false. + rttov_config % opts % htfrtc_opts % n_pc_in = -1 + rttov_config % opts % htfrtc_opts % reconstruct = .false. + rttov_config % opts % htfrtc_opts % simple_cloud = .false. + rttov_config % opts % htfrtc_opts % overcast = .false. + + ! Developer options that may be useful: + rttov_config % opts % dev % do_opdep_calc = .true. + + ! If using PC-RTTOV, some settings must be a certain way. This isn't always true though... + if (Lrttov_pc) then + rttov_config % opts % rt_ir % pc % addpc = .true. + rttov_config % opts % rt_ir % pc % ipcbnd = ipcbnd + rttov_config % opts % rt_ir % pc % ipcreg = ipcreg + rttov_config % opts % rt_ir % pc % npcscores = npcscores + + rttov_config % opts % rt_ir % pc % addradrec = .true. ! Alway reconstruct radiances + + rttov_config % opts % interpolation % addinterp = .true. ! Allow interpolation of input profile + rttov_config % opts % interpolation % interp_mode = 1 ! Set interpolation method + rttov_config % opts % rt_all % addrefrac = .true. ! Include refraction in path calc (always for PC) + rttov_config % opts % rt_ir % addclouds = .false. ! Don't include cloud effects (always for PC?) + rttov_config % opts % rt_ir % addaerosl = .false. ! Don't include aerosol effects (not always for PC) + rttov_config % opts % rt_ir % addsolar = .false. ! Do not include solar radiation (always for PC?) + + endif + + if (rttov_config % Lrttov_mwscatt) then + rttov_config % opts_scatt % config % do_checkinput = .true. + rttov_config % opts_scatt % config % apply_reg_limits = .false. + rttov_config % opts_scatt % config % verbose = .true. + rttov_config % opts_scatt % ozone_data = .false. ! Default + rttov_config % opts_scatt % use_t2m_opdep = .true. + rttov_config % opts_scatt % use_q2m = .true. + rttov_config % opts_scatt % use_tskin_eff = .false. + rttov_config % opts_scatt % addrefrac = .true. + rttov_config % opts_scatt % rad_down_lin_tau = .false. ! Recommended + rttov_config % opts_scatt % interp_mode = 1 ! Default + rttov_config % opts_scatt % lgradp = .false. + rttov_config % opts_scatt % fastem_version = 6 ! Default + rttov_config % opts_scatt % supply_foam_fraction = .false. + rttov_config % opts_scatt % lusercfrac = .false. ! User supplied cloud fraction in rttov_profile_cloud. Maybe set to true? pg 164 + rttov_config % opts_scatt % cc_threshold = 0.001_wp ! Default +! rttov_config % opts_scatt % pol_mode = +! rttov_config % opts_scatt % ice_polarisation = + rttov_config % opts_scatt % hydro_cfrac_tlad = .true. ! Default + rttov_config % opts_scatt % zero_hydro_tlad = .false. ! Default + end if + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 2. Read coefficients (from RTTOV example files) + ! ------------------------------------------------------ + ! Using the GUI to figure out files that work together could be helpful here. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + ! Do I need logicals here to direct how to read the coefficients? + if (rttov_config % Lrttov_pc) then ! PC-RTTOV cannot handle cloud, some aerosols + call rttov_read_coefs(errorstatus, rttov_config % coefs, & + rttov_config % opts, & + file_coef=rttov_config % OD_coef_filepath, & +! file_scaer=rttov_config % aer_coef_filepath, & ! Needs to be PC-RTTOV compatible + file_pccoef=rttov_config % PC_coef_filepath) + else ! Read optical depth and cloud coefficient files together + call rttov_read_coefs(errorstatus, rttov_config % coefs, & + rttov_config % opts, & + file_coef=rttov_config % OD_coef_filepath, & + file_scaer=rttov_config % aer_coef_filepath, & + file_sccld=rttov_config % cld_coef_filepath) + + ! Ensure input number of channels is not higher than number stored in coefficient file + if (nchannels_rec > rttov_config % coefs % coef % fmv_chn) then + nchannels_rec = rttov_config % coefs % coef % fmv_chn + if (verbose) print*,'nchannels_rec cap hit' + end if + end if + + ! We aren't checking an allocation steps so this seems more appropriate. + call rttov_error('fatal error reading coefficients' , lalloc = .false.) + + ! Ensure the options and coefficients are consistent + call rttov_user_options_checkinput(errorstatus, rttov_config % opts, rttov_config % coefs) + + ! We aren't checking an allocation steps so this seems more appropriate. + call rttov_error('error in rttov options' , lalloc = .false.) + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Figure out how many channels we actually want to reconstruct + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + ! Handle different radiance reconstruction options + if (nchannels_rec < 0) then + print*,'The namelist variable "nchannels_rec" is negative, rttov_direct call will fail. Exiting.' + errorstatus = errorstatus_fatal + call rttov_exit(errorstatus) + ! If the number of channels is negative, don't reconstruct radiances at all + rttov_config % nchan_out = 0 + rttov_config % nchannels_rec = 0 ! Avoid nchanprof set to a negative value + else if (nchannels_rec == 0) then + ! If the number of channels is set to 0 then reconstruct all instrument channels + rttov_config % nchan_out = rttov_config % coefs % coef % fmv_chn + rttov_config % nchannels_rec = rttov_config % coefs % coef % fmv_chn ! Avoid nchanprof set to 0 + else + ! Otherwise read the channel list from the file + rttov_config % nchan_out = nchannels_rec + rttov_config % nchannels_rec = nchannels_rec + endif + + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Read in channel indices, emissivities, and reflectivities from .csv if file is passed + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + allocate(rttov_config % iChannel(rttov_config % nchan_out)) ! There is a need for these variables to be separate somewhere... + allocate(rttov_config % iChannel_out(rttov_config % nchan_out)) + if (Lwavenum_filepath) then + allocate(rttov_config % wavenumChannel(rttov_config % nchan_out)) + open(18,file=wavenum_filepath,access='sequential',form="formatted") + do i = 1, rttov_config % nchan_out + read(18,*) rttov_config % wavenumChannel(i) + end do + close(18) + end if + if (Lchannel_filepath) then + allocate(rttov_config % emisChannel(rttov_config % nchan_out)) + allocate(rttov_config % reflChannel(rttov_config % nchan_out)) + + open(18,file=channel_filepath,access='sequential',form="formatted") + do i = 1, rttov_config % nchan_out + read(18,*) rttov_config % iChannel(i), rttov_config % emisChannel(i), rttov_config % reflChannel(i) + end do + close(18) + rttov_config % iChannel_out = rttov_config % iChannel + else ! If nothing is passed, compute the first "nchan_out" channels. Ignore emissivity and reflectivity for now. + rttov_config % iChannel(:) = (/ (i, i = 1, rttov_config % nchan_out) /) + rttov_config % iChannel_out = rttov_config % iChannel + endif + + if (verbose) then + print*,'rttov_config % nchan_out: ',rttov_config % nchan_out + print*,'rttov_config % Lrttov_bt: ',rttov_config % Lrttov_bt + print*,'rttov_config % Lrttov_rad: ',rttov_config % Lrttov_rad + print*,'rttov_config % Lrttov_refl: ',rttov_config % Lrttov_refl + print*,'rttov_config % Lrttov_cld: ',rttov_config % Lrttov_cld + print*,'rttov_config % Lrttov_aer: ',rttov_config % Lrttov_aer + print*,'rttov_config % Lrttov_pc: ',rttov_config % Lrttov_pc + print*,'rttov_config % Lrttov_solar: ',rttov_config % Lrttov_solar + print*,'rttov_config % opts % rt_ir % grid_box_avg_cloud: ',rttov_config % opts % rt_ir % grid_box_avg_cloud + print*,'rttov_config % opts % rt_ir % do_nlte_correction: ',rttov_config % opts % rt_ir % do_nlte_correction + print*,'rttov_config % rttov_Nlocaltime: ',rttov_config % rttov_Nlocaltime + print*,'rttov_config % rttov_localtime: ',rttov_config % rttov_localtime + print*,'rttov_config % rttov_localtime_width: ',rttov_config % rttov_localtime_width + print*,'rttov_config % rttov_extendatmos: ',rttov_config % rttov_extendatmos + print*,'rttov_config % gas_units: ',rttov_config % gas_units + print*,'rttov_config % clw_scheme: ',rttov_config % clw_scheme + print*,'rttov_config % ice_scheme: ',rttov_config % ice_scheme + print*,'rttov_config % icede_param: ',rttov_config % icede_param + call rttov_print_opts(rttov_config % opts) ! JKS testing + end if + + ! subsub routines + contains + ! Wrapper function for exiting RTTOV and reporting the error + subroutine rttov_error(msg, lalloc) + character(*) :: msg + logical :: lalloc + + if(lalloc) then + if (any(alloc_status /= 0)) then + write(*,*) msg + errorstatus = 1 + call rttov_exit(errorstatus) + endif + else + if (errorstatus /= errorstatus_success) then + write(*,*) msg + call rttov_exit(errorstatus) + endif + endif + end subroutine rttov_error + + END SUBROUTINE COSP_RTTOV_INIT_S + + + SUBROUTINE DESTROY_RTTOV_CONFIG(rttovConfig) + use mod_cosp_rttov, only: cosp_rttov_deallocate_coefs + + type(rttov_cfg),intent(inout) :: & + rttovConfig + + if (allocated(rttovConfig % iChannel)) deallocate(rttovConfig % iChannel) + if (allocated(rttovConfig % iChannel_out)) deallocate(rttovConfig % iChannel_out) + if (allocated(rttovConfig % emisChannel)) deallocate(rttovConfig % emisChannel) + if (allocated(rttovConfig % reflChannel)) deallocate(rttovConfig % reflChannel) + if (allocated(rttovConfig % rttov_localtime)) deallocate(rttovConfig % rttov_localtime) + if (allocated(rttovConfig % rttov_localtime_width)) deallocate(rttovConfig % rttov_localtime_width) + if (allocated(rttovConfig % swath_mask)) deallocate(rttovConfig % swath_mask) + + call cosp_rttov_deallocate_coefs(rttovConfig % coefs) + + END SUBROUTINE DESTROY_RTTOV_CONFIG + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE cosp_rttov_simulate - Call subroutines in mod_cosp_rttov to run RTTOV + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_RTTOV_SIMULATE(rttovIN,rttovConfig,error, & ! Inputs + bt_total,bt_clear, & ! Brightness Temp Outputs + rad_total,rad_clear,rad_cloudy, & ! Radiance Outputs + refl_total,refl_clear, & ! Reflectance Outputs + debug) + + use mod_cosp_rttov, only: cosp_rttov_swath + + type(rttov_in),intent(in) :: & + rttovIN + type(rttov_cfg),intent(inout) :: & + rttovConfig + character(len=128),intent(inout) :: & + error ! Error messages (only populated if error encountered) + real(wp),intent(inout),dimension(rttovIN%nPoints,rttovConfig%nchan_out),optional :: & ! Can I do this? I guess so! + bt_total, & ! All-sky + bt_clear, & ! Clear-sky + rad_total, & ! All-sky + rad_clear, & ! Clear-sky + rad_cloudy, & ! Cloudy-sky + refl_total, & ! All-sky + refl_clear ! Clear-sky + logical,intent(in),optional :: & + debug + + logical :: verbose = .false. + if (present(debug)) verbose = debug + + if (allocated(rttovConfig % swath_mask)) deallocate(rttovConfig % swath_mask) + allocate(rttovConfig % swath_mask(rttovIN % nPoints)) + + call cosp_rttov_swath(rttovIN, & + rttovConfig % rttov_Nlocaltime, & + rttovConfig % rttov_localtime, & + rttovConfig % rttov_localtime_width, & + rttovConfig % swath_mask, & + debug) + rttovConfig % nprof = count(rttovConfig % swath_mask) + + if (rttovConfig % nprof .gt. 0) then ! Skip calculations if all values are swathed out + ! Check options to determine if the principal component approach should be run + if (rttovConfig % opts % rt_ir % pc % addpc) then + call COSP_PC_RTTOV_SIMULATE(rttovIN,rttovConfig, & + bt_clear,rad_clear, & + error,verbose) + else + call COSP_REG_RTTOV_SIMULATE(rttovIN,rttovConfig, & + bt_total,bt_clear, & + rad_total,rad_clear,rad_cloudy, & + refl_total,refl_clear, & + error,verbose) + endif + else + if (verbose) print*,'empty chunk' + endif + + END SUBROUTINE COSP_RTTOV_SIMULATE + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE cosp_reg_rttov_simulate - Call regular subroutines in mod_cosp_rttov to run RTTOV + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_REG_RTTOV_SIMULATE(rttovIN,rttovConfig, & ! Inputs + bt_total,bt_clear, & ! Brightness Temp Outputs + rad_total,rad_clear,rad_cloudy, & ! Radiance Outputs + refl_total,refl_clear, & ! Reflectance Outputs + error,verbose) + + use mod_cosp_rttov, only: & + cosp_rttov_allocate, & + cosp_rttov_construct_profiles, & + cosp_rttov_setup_emissivity_reflectance, & + cosp_rttov_call_direct, & + cosp_rttov_save_output, & + cosp_rttov_deallocate_profiles + + type(rttov_in),intent(in) :: & + rttovIN + type(rttov_cfg),intent(inout) :: & + rttovConfig + real(wp),intent(inout),dimension(rttovIN%nPoints,rttovConfig%nchan_out) :: & + bt_total, & ! All-sky + bt_clear, & ! Clear-sky + rad_total, & ! All-sky + rad_clear, & ! Clear-sky + rad_cloudy, & ! Cloudy-sky + refl_total, & ! All-sky + refl_clear ! Clear-sky + character(len=128),intent(inout) :: & + error ! Error messages (only populated if error encountered) + + ! Local variables + type(rttov_radiance) :: radiance + type(rttov_transmission) :: transmission + type(rttov_profile), pointer :: profiles(:) => NULL() ! Input profiles + logical(kind=jplm), pointer :: calcemis(:) => NULL() ! Flag to indicate calculation of emissivity within RTTOV + type(rttov_emissivity), pointer :: emissivity(:) => NULL() ! Input/output surface emissivity + logical(kind=jplm), pointer :: calcrefl(:) => NULL() ! Flag to indicate calculation of BRDF within RTTOV + type(rttov_reflectance), pointer :: reflectance(:) => NULL() ! Input/output surface BRDF + type(rttov_chanprof), pointer :: chanprof(:) => NULL() ! Input channel/profile list + + logical,intent(in) :: verbose + + real(wp),dimension(10) :: driver_time + + ! Run each step for running RTTOV from mod_cosp_rttov (and time them) + call cpu_time(driver_time(1)) + call cosp_rttov_allocate(rttovIN, & + rttovConfig % nChannels_rec, & + rttovConfig % opts, & + rttovConfig % coefs, & + profiles, & + rttovConfig % iChannel, & + chanprof, & + rttovConfig % nchanprof, & + rttovConfig % nprof, & + rttovConfig % swath_mask, & + rttovConfig % rttov_extendatmos, & + transmission, & + radiance, & + calcemis, & + emissivity, & + calcrefl, & + reflectance, & + verbose) + + call cpu_time(driver_time(2)) + call cosp_rttov_construct_profiles(rttovIN, & + profiles, & + rttovConfig % Lrttov_cld, & + rttovConfig % Lrttov_aer, & + rttovConfig % Lrttov_solar, & + rttovConfig % user_tracegas_input, & + rttovConfig % opts % rt_all % CO2_data, & + rttovConfig % opts % rt_all % CH4_data, & + rttovConfig % opts % rt_all % CO_data, & + rttovConfig % opts % rt_all % N2O_data, & + rttovConfig % opts % rt_all % SO2_data, & + rttovConfig % opts % rt_all % ozone_data, & + rttovConfig % CO2_mr, & + rttovConfig % CH4_mr, & + rttovConfig % CO_mr, & + rttovConfig % N2O_mr, & + rttovConfig % SO2_mr, & + rttovConfig % ZenAng, & + rttovConfig % nprof, & + rttovConfig % swath_mask, & + rttovConfig % gas_units, & + rttovConfig % clw_scheme, & + rttovConfig % ice_scheme, & + rttovConfig % icede_param, & + rttovConfig % rttov_extendatmos, & + verbose) + + call cpu_time(driver_time(3)) + + if (associated(rttovIN % emis_grey)) then + call cosp_rttov_setup_emissivity_reflectance(calcemis, & + emissivity, & + calcrefl, & + reflectance, & + emis_grey = rttovIN % emis_grey) ! Config agnostic after allocate step. + else + call cosp_rttov_setup_emissivity_reflectance(calcemis, & + emissivity, & + calcrefl, & + reflectance) + end if + call cpu_time(driver_time(4)) + + call cosp_rttov_call_direct(rttovConfig % rttov_direct_nthreads, & + rttovConfig % opts, & + profiles, & + rttovConfig % coefs, & + chanprof, & + transmission, & + radiance, & + calcemis, & + emissivity, & + calcrefl, & + reflectance, & + verbose) + + call cpu_time(driver_time(5)) + + call cosp_rttov_save_output(rttovIN % nPoints, & + rttovConfig % nchan_out, & + rttovConfig % swath_mask, & + rttovConfig % Lrttov_bt, & + rttovConfig % Lrttov_rad, & + rttovConfig % Lrttov_refl, & + rttovConfig % Lrttov_cld, & + rttovConfig % Lrttov_aer, & + radiance, & + bt_total,bt_clear, & + rad_total,rad_clear,rad_cloudy, & + refl_total,refl_clear) + + call cpu_time(driver_time(6)) + call cosp_rttov_deallocate_profiles(rttovConfig % nprof, & + rttovConfig % nchanprof, & + rttovIN % nLevels, & + rttovConfig % opts, & + profiles, & + rttovConfig % coefs, & + chanprof, & + transmission, & + radiance, & + calcemis, & + emissivity, & + calcrefl, & + reflectance) + call cpu_time(driver_time(7)) + + END SUBROUTINE COSP_REG_RTTOV_SIMULATE + + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE cosp_pc_rttov_simulate - Call subroutines in mod_cosp_rttov to run RTTOV + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE COSP_PC_RTTOV_SIMULATE(rttovIN,rttovConfig, & ! Inputs + bt_clear,rad_clear, & ! Outputs + error,verbose) + + use mod_cosp_rttov, only: & + cosp_pc_rttov_allocate, & + cosp_rttov_construct_profiles, & + cosp_pc_rttov_setup_emissivity, & + cosp_pc_rttov_call_direct, & + cosp_pc_rttov_save_output, & + cosp_pc_rttov_deallocate_profiles + + type(rttov_in),intent(in) :: & + rttovIN + type(rttov_cfg),intent(inout) :: & + rttovConfig + real(wp),intent(inout),dimension(rttovIN%nPoints,rttovConfig%nchan_out) :: & ! Can I do this? I guess so! + bt_clear, & ! All-sky + rad_clear ! All-sky + character(len=128),intent(inout) :: & + error ! Error messages (only populated if error encountered) + + ! Local variables + type(rttov_radiance) :: radiance + type(rttov_transmission) :: transmission + type(rttov_profile), pointer :: profiles(:) => NULL() ! Input profiles + logical(kind=jplm), pointer :: calcemis(:) => NULL() ! Flag to indicate calculation of emissivity within RTTOV + type(rttov_emissivity), pointer :: emissivity(:) => NULL() ! Input/output surface emissivity + logical(kind=jplm), pointer :: calcrefl(:) => NULL() ! Flag to indicate calculation of BRDF within RTTOV + type(rttov_reflectance), pointer :: reflectance(:) => NULL() ! Input/output surface BRDF + type(rttov_chanprof), pointer :: chanprof(:) => NULL() ! Input channel/profile list + integer(KIND=jpim), pointer :: predictindex(:) + + logical,intent(in) :: verbose + real(wp),dimension(10) :: driver_time + + ! Run each step for running RTTOV from mod_cosp_rttov (and time them) + call cpu_time(driver_time(1)) + call cosp_pc_rttov_allocate(rttovIN, & + rttovConfig % PC_coef_filepath, & + rttovConfig % coefs, & + rttovConfig % opts, & + profiles, & + rttovConfig % nchannels_rec, & + rttovConfig % iChannel, & + chanprof, & + rttovConfig % nchanprof, & + rttovConfig % nprof, & + rttovConfig % iChannel_out, & + rttovConfig % swath_mask, & + rttovConfig % rttov_extendatmos, & + transmission, & + radiance, & + calcemis, & + emissivity, & + rttovConfig % pccomp, & + predictindex) + call cpu_time(driver_time(2)) + + call cosp_rttov_construct_profiles(rttovIN, & + profiles, & + rttovConfig % Lrttov_cld, & + rttovConfig % Lrttov_aer, & + rttovConfig % Lrttov_solar, & + rttovConfig % user_tracegas_input, & + rttovConfig % opts % rt_all % CO2_data, & + rttovConfig % opts % rt_all % CH4_data, & + rttovConfig % opts % rt_all % CO_data, & + rttovConfig % opts % rt_all % N2O_data, & + rttovConfig % opts % rt_all % SO2_data, & + rttovConfig % opts % rt_all % ozone_data, & + rttovConfig % CO2_mr, & + rttovConfig % CH4_mr, & + rttovConfig % CO_mr, & + rttovConfig % N2O_mr, & + rttovConfig % SO2_mr, & + rttovConfig % ZenAng, & + rttovConfig % nprof, & + rttovConfig % swath_mask, & + rttovConfig % gas_units, & + rttovConfig % clw_scheme, & + rttovConfig % ice_scheme, & + rttovConfig % icede_param, & + rttovConfig % rttov_extendatmos, & + verbose) + call cpu_time(driver_time(3)) + call cosp_pc_rttov_setup_emissivity(calcemis, & + emissivity) + call cpu_time(driver_time(4)) + call cosp_pc_rttov_call_direct(rttovConfig % rttov_direct_nthreads, & + rttovConfig % opts, & + profiles, & + rttovConfig % coefs, & + chanprof, & + transmission, & + rttovConfig % nchannels_rec, & + rttovConfig % iChannel_out, & + radiance, & + calcemis, & + emissivity, & + rttovConfig % pccomp) + + call cpu_time(driver_time(5)) + call cosp_pc_rttov_save_output(rttovIN % nPoints, & + rttovConfig % nchannels_rec, & + rttovConfig % swath_mask, & + rttovConfig % pccomp, & + rttovConfig % Lrttov_bt, & + rttovConfig % Lrttov_rad, & + bt_clear, & + rad_clear) + + call cpu_time(driver_time(6)) + call cosp_pc_rttov_deallocate_profiles(rttovConfig % nprof, & + rttovConfig % nchanprof, & + rttovIN % nlevels, & + rttovConfig % nChannels_rec, & + rttovConfig % opts, & + profiles, & + rttovConfig % coefs, & + chanprof, & + transmission, & + radiance, & + calcemis, & + emissivity, & + rttovConfig % pccomp, & + predictindex) + + call cpu_time(driver_time(7)) + + END SUBROUTINE COSP_PC_RTTOV_SIMULATE + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! END MODULE + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +END MODULE MOD_COSP_RTTOV_INTERFACE diff --git a/src/simulator/investigate_Reff_UKMOinput.ipynb b/src/simulator/investigate_Reff_UKMOinput.ipynb new file mode 100644 index 0000000000..c9e34ebd18 --- /dev/null +++ b/src/simulator/investigate_Reff_UKMOinput.ipynb @@ -0,0 +1,564 @@ +{ + "cells": [ + { + "cell_type": "markdown", + "id": "b383f9ab-8645-4946-abbf-c368a9df3aef", + "metadata": {}, + "source": [ + "" + ] + }, + { + "cell_type": "code", + "execution_count": 4, + "id": "50923d7e-3f95-4dda-b13c-18abc2848391", + "metadata": {}, + "outputs": [], + "source": [ + "import xarray as xr\n", + "import numpy as np\n", + "\n", + "import sys\n", + "import os\n", + "import glob" + ] + }, + { + "cell_type": "code", + "execution_count": 3, + "id": "4247ee33-73ef-430a-952a-34cbb98c66f9", + "metadata": {}, + "outputs": [], + "source": [ + "cosp_input_dir = '/glade/u/home/jonahshaw/Scripts/git_repos/COSPv2.0/driver/data/inputs/UKMO/'" + ] + }, + { + "cell_type": "code", + "execution_count": 5, + "id": "6b3ebe12-5659-4043-b1c1-65dd7b433cc0", + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "['cosp_input_um_2d.nc',\n", + " 'cosp_input.um_global.nc',\n", + " 'cosp_input_um.nc',\n", + " 'cosp_input.um_global.nc.md5']" + ] + }, + "execution_count": 5, + "metadata": {}, + "output_type": "execute_result" + } + ], + "source": [ + "os.listdir(cosp_input_dir)" + ] + }, + { + "cell_type": "code", + "execution_count": 11, + "id": "a2f77fe4-f91e-4fee-9e2b-fb9c29b86fa9", + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "['/glade/u/home/jonahshaw/Scripts/git_repos/COSPv2.0/driver/data/inputs/UKMO/cosp_input.um_global.nc', '/glade/u/home/jonahshaw/Scripts/git_repos/COSPv2.0/driver/data/inputs/UKMO/cosp_input_um.nc', '/glade/u/home/jonahshaw/Scripts/git_repos/COSPv2.0/driver/data/inputs/UKMO/cosp_input_um_2d.nc']\n" + ] + } + ], + "source": [ + "cosp_input_files = glob.glob('%s/*.nc' % cosp_input_dir)\n", + "cosp_input_files.sort()\n", + "print(cosp_input_files)" + ] + }, + { + "cell_type": "code", + "execution_count": 12, + "id": "9207936f-5417-4d23-b466-30d083be4841", + "metadata": {}, + "outputs": [], + "source": [ + "testfile = xr.open_dataset(cosp_input_files[1])" + ] + }, + { + "cell_type": "code", + "execution_count": 16, + "id": "5f1de400-ab33-4643-bb61-f423792e3599", + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "" + ] + }, + "execution_count": 16, + "metadata": {}, + "output_type": "execute_result" + }, + { + "data": { + "image/png": "iVBORw0KGgoAAAANSUhEUgAAAYIAAAERCAYAAAB2CKBkAAAAOXRFWHRTb2Z0d2FyZQBNYXRwbG90bGliIHZlcnNpb24zLjMuMCwgaHR0cHM6Ly9tYXRwbG90bGliLm9yZy86wFpkAAAACXBIWXMAAAsTAAALEwEAmpwYAAAgsUlEQVR4nO3deZQmdX3v8feHYWBkC+KMAWZA0DtH3BB0AigeL3FjkQseRQNXNIq5kxg3EjWukahZrlGJeFFx1EGMBKKABhRBgguuyMwIjDB4RNwGEBzZXWCm+3P/qGp5aLr7qe6u6qeers/rnDrdtTz1/dWg/X3qt8o2ERHRXVsNugARETFYSQQRER2XRBAR0XFJBBERHZdEEBHRcUkEEREdl0QQEUNL0mpJt0r6QU33G5F0ZbmdX8c9h4EyjiAihpWkpwP3AJ+y/fga7neP7R1mX7LhkjeCiBhati8Dbus9JulRki6StFbSNyTtM6DiDY0kgoiYb1YBr7H9ZOANwIen8dlFktZI+q6k5zVSuhbaetAFiIioi6QdgKcCn5U0dnjb8tzzgXdN8LEbbR9a/r6n7ZskPRL4iqT1tn/cdLkHLYkgIuaTrYA7bO83/oTt84Dzpvqw7ZvKnzdI+hqwPzDvE0GqhiJi3rB9F/ATSS8EUOGJVT4r6aGSxt4eFgMHA9c2VtgWSSKIiKEl6SzgO8CjJW2U9ArgxcArJF0FXAMcXfF2jwHWlJ/7KvB/bXciEaT7aEREx+WNICKi41rVWLyNtvUith90MSKi5e7m9k22l8zmHof+6fb+9W0jla5de/W9F9s+bDbx2qxViWAR23OgnjnoYkREy/23z/nZbO/x69tG+N7Fe1a6dsFuP1o823ht1qpEEBExVwyMMjroYrRCEkFEdJIxm12tami+SyKIiM7KG0EhiSAiOsmYkXSfB5IIIqLDRkkigCSCiOgoAyNJBEASQUR0WN4ICo0mAkl/A/wFRfJdD7zc9u+bjBkRUYWBzWkjABqcYkLSUuC1wIpyCbkFwLFNxYuImA5jRipu813TVUNbAw+RtBnYDrip4XgREdUYRub/3/hKGnsjsH0j8D7g58DNwJ22vzz+Okkry6Xh1mzm3qaKExHxAMXI4mrbfNdk1dBDKeYB3xvYHdhe0vHjr7O9yvYK2ysWFivKRUTMATFScZvvmpyG+lnAT2z/yvZmiiXintpgvIiIyorGYlXa5rsm2wh+DhwkaTvgd8AzgTUNxouIqKwYRzD//8hX0VgisH25pHOAdcAW4PvAqqbiRURM12gHvu1X0WivIdsnASc1GSMiYibyRnC/jCyOiE4yYiSr9QJJBBHRYakaKiQdRkQnGXGfF1Ta+pG0h6SvStog6RpJr5vgmkMk3SnpynJ7RyMPNgN5I4iITioGlNX2XXgL8Hrb6yTtCKyVdInta8dd9w3bR9YVtC5JBBHRWXU1Ftu+mWIGBWzfLWkDsBQYnwhaKVVDEdFJthjxVpU2YPHYVDjltnKy+0raC9gfuHyC00+RdJWkL0l6XDNPNn15I4iIzhqt/kawyfaKfhdJ2gE4FzjR9l3jTq8DHmH7HklHAJ8Hlk+juI3JG0FEdFLRWLx1pa0KSQspksCZts97UDz7Ltv3lL9fCCyUtLjOZ5qpvBFERCfV2VgsScAngA22T57kml2BW2xb0gEUX8R/XUsBZimJICI6a6S+cQQHAy8B1ku6sjz2VmBPANunAccAr5S0hWL+tWPtdiyRlkQQEZ1U58hi29+EqRscbJ8KnFpLwJolEUREZ406zaSQRBARHVVMOpdEAEkEEdFRRmyuMH1EFyQRREQn2YwNFuu8JtcsfnTP5EpXSrpL0olNxYuImB4xWnGb75pcoeyHwH4AkhYANwKfaypeRMR0mLwRjJmrqqFnAj+2/bM5ihcR0VcaiwtzlQiOBc6ao1gREX0ZZWGaUuOJQNI2wFHAWyY5vxJYCbCI7ZouTkQEUFQNba44j9B8NxfvRYcD62zfMtFJ26tsr7C9YiHbzkFxIiIAxEjFbWAllF5YLnSDpLdLOk/Sk+qOMxeJ4DhSLRQRLWOKkcVVtgH6+3Khm6cBhwJnAB+pO0ijTyhpO+DZwIOmZI2IGLS2vxEAI+XP5wIfsf1fwDZ1B2m0gsz2b4GHNRkjImImbA36234VN0r6KPAs4D2StqWBL/BpKYmITioai1s/xcSLgMOA99m+Q9JuwBvrDpJEEBEdpWEYULYYWAMgac/y2HV1B0kiiIhOKhqLWz+O4IsURRWwCNgb+CFQ68L3SQQR0VltH1ls+wm9+2XX0b+sO04SQUR00jCOLLa9TtKf1H3fJIKI6Ky6Fq9viqS/7dndCngS8Ku64yQRREQn2bB5tN2JANix5/ctFG0G59YdJIkgIjqpqBpqdyKw/c65iJNEEBGdNeBRw5OS9AHbJ0q6gKLX0APYPqrOeEkEEdFJLe8++u/lz/fNRbAkgojoqPZWDdleW/78+lzESyKIiM5q63rEktYzQZXQGNv71hkviSAiOqnoNdTauYaOLH++qvw5VlX0YuC3dQdLIoiITmrzgLKx9d0lHWz74J5Tb5b0LeBddcZrZwVZRMQcGEWVtgHavlyUBgBJTwW2rztI3ggiopNa3mtozCuA1ZL+qNy/Azih7iCNJgJJOwMfBx5P8e9+gu3vNBkzIqKqtvYaGlP2HnqipJ0A2b6ziThNvxGcAlxk+xhJ2wDbNRwvIqISW2ypKRFI2gP4FLArMAqssn3KuGtE8TfxCIoG35fZXlfh3s+lmHZ6UXELsF1rG0FjiaDMYE8HXgZg+z7gvqbiRURMV41VQ1uA15ezg+4IrJV0ie1re645HFhebgdSLEJ/4FQ3lXQaxRfoP6WoXTkG+F5dhR7T5HvRIylmyTtd0vclfVzSgxo5JK2UtEbSms3c22BxIiLuN9ZGUGXrey/75rFv97bvBjYAS8dddjTwKRe+C+xcLj05lafafilweznv0FOAPab5qH01mQi2ppgy9SO29wd+A7x5/EW2V9leYXvFQrZtsDgREQ80jUSweOwLa7mtnOyekvYC9gcuH3dqKfCLnv2NPDhZjPf78udvJe0ObKZYpaxWTbYRbAQ22h77xziHCRJBRMQgTHMcwSbbK/pdJGkHimmiT7R91/jTExZjaheUnW7eC6wrr/9Y/+JOT2OJwPYvJf1C0qNt/xB4JnBtv89FRMyVOscISFpIkQTOtH3eBJds5IHVOsuAm6a431bApbbvAM6V9AVgURM9h5ruNfQa4Myyx9ANwMsbjhcRUYkNW2pamKbsEfQJYIPtkye57Hzg1ZLOpmgkvtP2zZOXz6OS3k/RLoDte6GZhtRGE4HtK4G+r1MREYNQY6+hg4GXAOslXVkeeyuwJ4Dt04ALKbqOXk/RfbTKF+MvS3oBcJ7tftVIM5aRxRHRSXXONWT7m0zcBtB7jbl/Ermq/pZiSoktkn5fxrDtnWZU0EkkEUREZ7nlU0zY3nGq85IeZ/ua2cZp9/jqiIgGDcGkc/38e/9L+ssbQUR0kj0Uk871U8sDJBFEREeJkZp6DQ1QLQ3ISQQR0VltbyOYK0kEMW9cfNNVDzp26O5PHEBJYhgMyXoE/dQykefQvxdFRMyIi3aCKtugqHC8pHeU+3tKOuAPj2AfVEecJIKI6Kwh6DX0YYqRxceV+3cDH6o7SKqGIqKTPByNxQfafpKk7wPYvr2csqdWSQQR0VmDrPapaLOkBZS9gyQtoVgBrVZJBBHRWUPQa+iDwOeAh0v6J4oVyt5ed5AkgojopKIhuN2JwPaZktZSTOMv4Hm2N9QdJ4kgIjqr7d1HJZ0C/Kft2huIe7W+pSQioilt7z5KsSrZ2yVdL+m9khqZ1r/RNwJJP6Xo7jQCbKmy1FtExFwwYrTlvYZsnwGcIWkX4AXAeyTtaXt5nXHmomroT21vmoM4ERHT0v5OQ3/wP4B9gL1oYMnftBFERDcNQWOxpPcAzwd+DHwGeHe5hnGtmk4EplhqzcBHba8af4GklcBKgEVs13BxIiJ6tP+V4CfAU5quVWk6ERxs+yZJDwcukXSd7ct6LyiTwyqAnbRL+/+zRMS80dY3Akn72L4O+B6wp6Q9e8/bXldnvKYXr7+p/HmrpM8BBwCXTf2piIjmGRgdbWcioFireCXw/gnOGXhGncEaSwSStge2sn13+ftzgHc1FS8iYloMtPSNwPbK8tfDbf++95ykRXXHa7Lv1B8D35R0FcXrzRdtX9RgvIiIaRmCcQTfrnhsVhp7I7B9A5BVQSKivVraKilpV2Ap8BBJ+3P/2sQ7Qf29atJ9NCI6Sq1tLAYOBV4GLKNoJxgr6F3AW+sOlkQQEd3V0jeCnhHFL7B9btPx2j2+OiKiKQaPqtI2QE+WtPPYjqSHSvrHuoMkEUREh6niNjCH944ktn07cETdQZIIIqK7XHEbnAWSth3bkfQQYNsprp+RtBFERHe1tI2gx6eBSyWdTlHaE4Az6g7SyUSw6a+eWvlaTfQ/lAmOPWxV7V17Y5oO3T29lWMaWjygbIztf5V0NfAsijqqd9u+uO44laqGJC2T9DlJv5J0i6RzJS2ruzAREXOprgFlklZLulXSDyY5f4ikOyVdWW7vmEYxNwAX2X498A1JO07js5VUbSM4HTgf2I1ikMMF5bGIiOE1qmpbf58EDutzzTds71dulabbkfR/gHOAj5aHlgKfr/LZ6aiaCJbYPt32lnL7JLCk7sJERMwludrWTzmr8m0NFPFVwMEUA8mw/SPg4XUHqZoINkk6XtKCcjse+HXdhYmImDNVewwViWCxpDU928oJ7zm1p0i6StKXJD2u4mfutX3f2I6krWmgibtqY/EJwKnAv5WF+HZ5LCJiSGk6jcWbZrnm+jrgEbbvkXQERfVOlXWHvy7prRRzDj0b+GuKqvla9U0EkhYA/2z7qLqDR0QM1Bx1H7V9V8/vF0r6sKTFFVYeezPwCmA98JfAhcDH6y5f30Rge0TSEknb9L6iREQMvdG5CVPOJnqLbUs6gKJaftLqdUmX2n4m8C+23wR8rM/9z69QjNtsv2yiE1Wrhn4KfKsM9puxg7ZPrvj5iIh2qXEcgaSzgEMo2hI2AicBCwFsnwYcA7xS0hbgd8Cx9pQdU3eT9D+BoySdzbh5LiZYqvIxwF9MVUTgQ5OdrJoIbiq3rYBp9WEtq5bWADfaPnI6n42IaFKVHkFV2D6uz/lTKdpZq3oHRbXQMmD8F+6Jlqp8m+2vT3VDSe+c7FylRGB70htU8DqKARE7zeIeERH1a+8UEzfbPlzSO6qMObD9mdlcM2UikHQBU/xT9WtALkcfPxf4J4rFmCMior8PAk8Gnsc01nqXtAJ4G/AIir/vAmx736k+1++N4H3lz+cDu1JMgARwHEW7QT8fAP6OKaqTyv64KwEW1b8CW0TEpOqqGmrA5nKiuaWSPjj+pO3XTvK5M4E3UvQyqtwUPmUiGKtzkvRu20/vOXWBpMum+qykI4Fbba+VdMgUMVYBqwB20i7t/c8SEfOLqTp9xCAcSTHR3DOAtdP43K9sV+lB9ABVG4uXSHpkuSA9kvam/xQTB1O0eB8BLAJ2kvRp28dPt5AREY1o6VfPcnzB2ZI22L5qGh89SdLHgUuBe3vud95UH6qaCP4G+JqkG8r9vSircyZj+y3AW6CYeQ94Q5JARLRJi6uGxvxO0qXAH9t+vKR9gaNsT7Zc5cuBfSi6ro5VDRmYfSKwfZGk5WUAgOts3zvVZyIiWq/9ieBjFHX+HwWwfbWk/wAmSwRPtP2E6Qapuh7BGophzj+3fdV0k4Dtr2UMQUS0TvuXqtzO9vfGHdsyxfXflfTY6QapOvvosRTzYF8h6WxJh0pqbStLREQ/VaegHnD10SZJj6JMR5KOAW6e4vqnAVdK+qGkqyWtL1c4m1LVqqHrgbdJ+nuK1uzVwKik1cAptpuYhzsiolnt7TU05lUUvSr3kXQj8BPgxVNc329xnAlVXrO4bKQ4ATgcOJeiv+rTgK8A+80keETEILW9sbjsqfksSdsDW9m+u/e8pD+3fYakdbafZPtnk91r7JqJzlVKBJLWAndQTH/6pp42gsslHVzlHhERrdPyRDDG9m8mOfU64AzgMX2qgAT80WQnq74RvATYH9gbeNNY84Dtd9l+fsV7RES0x+Dr/+swVre1z5RXFUYmO1E1EZxM8Uawjp5BChERQ234E4EBpqoSqqJqIlhme0aNEBERbaU5WpimQbW0dldNBN+W9ATb6+sIOmiLT/v2oIsQETElSVsBx/SZYvpbdcTqNw31eopXj62Bl5dTTNxLxalNIyJarcVVQ7ZHJb0amDQR2H51HbH6vRFkNHBEzE/D0Vh8iaQ3AP/JA5cJrnXsVr9pqGfVABER0WrtTwQnlD9f1XPMwCPrDFJ5QFlExLzT8kRge++5iJNEEBGdJNrfa0jSQuCVwNjCYF8DPmp7c51xkggiopuGo43gIxRrC3y43H9Jeewv6gySRBAR3dX+RPAntp/Ys/8VSdNZsaySqtNQT5ukRZK+J+kqSddIemdTsSIiZqT96xGMlNNQAyDpkUwxVcRMNflGcC/wDNv3lPVc35T0JdvfbTBmRERlQ1A19Ebgq+UYLgGPoFiOslaNJQLbBu4pdxeWW/v/2SOiO1r+F8n2peUywY+mSASNLBPcWNUQgKQFkq4EbgUusX35BNeslLRG0prNmc8uIuaKi15DVbZBkbQdxVvBa2xfBewpqfaBvo0mAtsjtvcDlgEHSHr8BNessr3C9oqFbNtkcSIiHqj9bQSnA/cBTyn3NzL5wvUz1mgiGGP7Dor+r5nBNCJaYwjWLH6U7X8FNgPY/h01zTjaq8leQ0sk7Vz+/hDgWcB1TcWLiJi29r8R3Ff+/RxbvP5RNLAmTJNvBLtRtHZfDVxB0UbwhQbjRURUVzUJVEgEklZLulXSDyY5L0kflHS9pKslTbh28AT+AbgI2EPSmcClwJsqfrayJnsNXU2xvGVEROuIWqt9PgmcCnxqkvOHA8vL7UCK0cEH9rup7S+Xa8YfRFHk19neVEeBe81JG0FERBvV1UZg+zJgqqmhjwY+5cJ3gZ0l7da3fNKltn9t+4u2v2B7k6RLqz5fVZliIiK6q/obwWJJa3r2V9leNY1IS4Ff9OxvLI/dPNHFkhYB25VxH8r9DcQ7AbtPI24lSQQR0V3VE8Em2ytmEWminj5TRf9L4ESKP/rreo7fBXxoFuWYUBJBRHTT3HYN3Qjs0bO/DLhpsottnwKcIuk1tv9f04VLG0FEdNfcdR89H3hp2XvoIOBO2xNWC42zWtLbJa0CkLS8iZHFeSOIiM6qa/oISWcBh1DU6W8ETqKYXw3bpwEXAkcA1wO/pfrEcauBtcBTy/2NwGeBWrviJxFERGfVVTVk+7g+580D1x2u6lG2/0zSceV9fiep9pHFSQQR0U2DHzVcxZyMLE4iiIjuan8iOIkHjiw+GHhZ3UGSCCKik2oeWdwI25dIWkfDI4uTCCKiszTa8kxQWAosoPh7/XRJ2D6vzgBJBBHRTUPQRiBpNbAvcA0w1sfJQBJBREQd2l41BBxk+7FNB8mAsojorvavR/AdSY0ngrwRRERnDcEbwRkUyeCXFN1GRTEsYd86gzSWCCTtQTE3964UdVuryvkzIiLaof2JYDXwEmA997cR1K7JN4ItwOttr5O0I7BW0iW2r20wZkRENa5viokG/dz2+U0HaXKFspsp59q2fbekDRTdoJIIImLghmEcAXCdpP8ALqBnRPFQdh+VtBfFspWXT3BuJbASYBHbzUVxIiIKbn0meAhFAnhOz7Hh6z4qaQfgXOBE23eNP1+u8rMKYCft0vr/KhExf7T9jcB21VlKZ6XR7qOSFlIkgTPrfpWJiJiVql1HB5gsJC2T9DlJt0q6RdK5kpbVHaexRFBOlfoJYIPtk5uKExExUxqttg3Q6RSL2uxO0cZ6QXmsVk2+ERxM0e3pGZKuLLcjGowXETEtQ5AIltg+3faWcvsksKTuIE32GvomEy/YHBExeGYYGos3SToeOKvcPw74dd1BMsVERHSWXG0boBOAFwG/pOiOf0x5rFaZYiIiuqvFLwSSFgD/bPuopmMlEUREJ7V9QJntEUlLJG1j+74mYyURREQ32cOwMM1PgW9JOh/4zdjBuntiJhFERHe1Pg9wU7ltBezYVJAkgojorDZXDQHYfudcxEkiiIhuMtDSqiFJFzDF+0rdDchJBDFv+Gn7PejY1ut/8qBjI3feOQeliaHQzjwA8L7y5/Mp1nT5dLl/HEW7Qa2SCCKis9paNWT76wCS3m376T2nLpB0Wd3xMqAsIjpLo660DdASSY/8Q3mlvRmmKSYiIlpt8AvTV/E3wNck3VDu70W5fkudkggiopOKAWXtzgS2L5K0HNinPHSd7Xun+sxMpGooIrprtOI2IJLWAK+gWLv4qiaSACQRRESHya60VbqXdJikH0q6XtKbJzh/iKQ7e6blf0eF2x5LsQ7BFZLOlnRoudZLrVI1FBHdVGMbQTlB3IeAZwMbKf5wn2/72nGXfsP2kZWLaF8PvE3S3wNHAquBUUmrgVNs31ZH+ZtcoWx1ubzaD5qKERExc9V6DFXsNXQAcL3tG8oJ4s4Gjq6jlJL2BU4G3kux9O8xwF3AV+q4PzRbNfRJ4LAG7x8RMTt2tQ0WS1rTs43vubMU+EXP/sby2HhPkXSVpC9Jely/4klaC/wbcDmwr+3X2r7c9vuBG6b+dHVNrlB2maS9mrp/RMSseFrLUG6yvWKK8xPV249/lVgHPML2PeWyvZ8HlveJ+xJgf2Bv4E1jzQO232X7+VUKXkUaiyOiu6q/EfSzEdijZ38ZxayhPaF8l+17yt8vBBZKWtznvicD/wvYQjEN9dhWq4E3FpevWCsBFrHdgEsTEZ1S3zCCK4Dl5cjfGyl6+/zv3gsk7QrcYtuSDqD4It5v/eFlthuvYh94IrC9ClgFsJN2affojoiYVzRazyAB21skvRq4GFgArLZ9jaS/Ks+fRtHI+0pJW4DfAcfafV83vi3pCbbX11LQSQw8EUREDISpdbBYWd1z4bhjp/X8fipwapV7SVpflnBr4OXlFBP3UrRF2Pa+dZUbGkwEks4CDqFobd8InGT7E03Fi4iYDlF9sNgAVB5rUIcmew0d19S9IyJq0dJEYPtncxkvVUMR0V0tTQRzLYkgIrqp5jaCYZZEEBGdVVevoWGXRBARHVV5sNi8l0QQEd1kkghKSQQR0V2pGQKSCCKiw1o8jmBOJRGUFjz+0RMe169uf9Cx3z9hzwcd8yTT9y388ppZlSuq0zevfNCxkbkvRgyTJAIgiSAiusqGkdQNQRJBRHRZ3giAJIKI6LIkAiCJICK6ykC19YjnvSSCiOgog9NGAEkEEdFVJo3FpSSCiOiutBEASQQR0WVJBECxeHJjJB0m6YeSrpf05iZjRURMTznpXJVtnmtyqcoFwIeAZwMbgSsknW/72qZiRkRUZiDTUAPNvhEcAFxv+wbb9wFnA0c3GC8iYnryRgA020awFPhFz/5G4MDxF0laCawEWMR2DRYnIqJXppgY02Qi0ATHHpRaba8CVgHspF3mf+qNiHYwOOMIgGYTwUZgj579ZcBNDcaLiJiejCwGmm0juAJYLmlvSdsAxwLnNxgvImJ60kYANPhGYHuLpFcDFwMLgNW2r2kqXkTEtNjpNVRqdECZ7QuBC5uMERExYx34tl9FRhZHREcZj2QNO0giiIiuyjTUf5BEEBHdle6jQMNzDUVEtJUBj7rSVkW/udVU+GB5/mpJT6r7mWYqiSAiusnlwjRVtj565lY7HHgscJykx4677HBgebmtBD5S7wPNXBJBRHSWR0YqbRVUmVvtaOBTLnwX2FnSbvU+0cy0qo3gbm7f9N8+52fAYmDTnAZfP41rfznjKHP/XM2bj88Eea62e8Rsb3A3t1/83z5nccXLF0la07O/qpweZ0yVudUmumYpcHPFMjSmVYnA9hIASWtsrxh0eeo2H59rPj4T5Lm6wPZhNd6uytxqleZfG4RUDUVEzF6VudVaO/9aEkFExOxVmVvtfOClZe+hg4A7bQ+8WghaVjXUY1X/S4bSfHyu+fhMkOeKaZhsbjVJf1WeP41iup0jgOuB3wIvH1R5x5Mz10ZERKelaigiouOSCCIiOq51iaDfMO1hIWm1pFsl/aDn2C6SLpH0o/LnQwdZxumStIekr0raIOkaSa8rjw/tc0laJOl7kq4qn+md5fGhfaZekhZI+r6kL5T78+K5ol6tSgQVh2kPi08C4/spvxm41PZy4NJyf5hsAV5v+zHAQcCryv8+w/xc9wLPsP1EYD/gsLJHxzA/U6/XARt69ufLc0WNWpUIqDZMeyjYvgy4bdzho4Ezyt/PAJ43l2WaLds3215X/n43xR+YpQzxc5XD/e8pdxeWmxniZxojaRnwXODjPYeH/rmifm1LBJMNwZ4v/nis33D58+EDLs+MSdoL2B+4nCF/rrL65ErgVuAS20P/TKUPAH8H9M6aNh+eK2rWtkTQ2iHYcT9JOwDnAifavmvQ5Zkt2yO296MY6XmApMcPuEizJulI4Fbbawddlmi/tiWC1g7BrsktY7MNlj9vHXB5pk3SQookcKbt88rDQ/9cALbvAL5G0bYz7M90MHCUpJ9SVLE+Q9KnGf7niga0LRFUGaY9zM4H/rz8/c+B/xpgWaZNkoBPABtsn9xzamifS9ISSTuXvz8EeBZwHUP8TAC232J7me29KP5/9BXbxzPkzxXNaN3IYklHUNRtjg3T/qfBlmhmJJ0FHEIx7e8twEnA54HPAHsCPwdeaHt8g3JrSXoa8A2KSbvH6p3fStFOMJTPJWlfikbTBRRfjD5j+12SHsaQPtN4kg4B3mD7yPn0XFGf1iWCiIiYW22rGoqIiDmWRBAR0XFJBBERHZdEEBHRcUkEEREdl0QQAyHpnv5XDf6eEV2QRBAR0XFJBDFwkt4o6QpJV/esB/AeSX/dc80/SHr9ZNdHxMwlEcRASXoOsJxiCvL9gCdLejrF/Dh/1nPpi4DPTnF9RMzQ1oMuQHTec8rt++X+DsBy25+Q9HBJuwNLgNtt/1zSaye6HrhsjssdMW8kEcSgCfgX2x+d4Nw5wDHArhRvCP2uj4gZSNVQDNrFwAnlGgdIWippbLGUsylmzjyGIin0uz4iZiBvBDFQtr8s6THAd4pZrrkHOJ5iUZVrJO0I3Nizqtak1w/kASLmgcw+GhHRcakaiojouCSCiIiOSyKIiOi4JIKIiI5LIoiI6LgkgoiIjksiiIjouP8PcKbnmCfswJ4AAAAASUVORK5CYII=\n", + "text/plain": [ + "
" + ] + }, + "metadata": { + "needs_background": "light" + }, + "output_type": "display_data" + } + ], + "source": [ + "testfile['Reff'].sel(point=1).plot()" + ] + }, + { + "cell_type": "code", + "execution_count": 17, + "id": "73a2a2f1-63b2-4a8e-93b9-1cffdef85b8d", + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "" + ] + }, + "execution_count": 17, + "metadata": {}, + "output_type": "execute_result" + }, + { + "data": { + "image/png": "iVBORw0KGgoAAAANSUhEUgAAAXkAAAERCAYAAACepNcKAAAAOXRFWHRTb2Z0d2FyZQBNYXRwbG90bGliIHZlcnNpb24zLjMuMCwgaHR0cHM6Ly9tYXRwbG90bGliLm9yZy86wFpkAAAACXBIWXMAAAsTAAALEwEAmpwYAAAd1klEQVR4nO3debAlZZ3m8e9DsRSFlEJTLlAiYNOCjSxajQgOo4ACSqCB6EgIo6BTxowi7uJKo2N32NqE2KMOJYK0IKiACuqwNDbSKgJVrCIY0qhYgAICAi5QdeuZPzKvHIq75KmbefKck88nIuPezJMnf29i+Ku8b77v+5NtIiJiPK3XdgMiIqI5SfIREWMsST4iYowlyUdEjLEk+YiIMZYkHxExxpLkI2JkSTpF0l2SflLT9baWdJGkmyT9VNI2dVy3TUnyETHKvgQcUOP1/hX4pO0dgd2Bu2q8diuS5CNiZNm+DLi395ikZ0q6QNIKSf8haYcq15L0bGB92xeX137I9h/rb/VgJclHxLhZBhxt+3nAu4HPVfze3wD3SzpX0jWSPilpXmOtHJD1225ARERdJD0B2BP4uqTJwxuVnx0CfHSKr91ue3+KfPhfgN2A24CvAm8Avthsq5uVJB8R42Q94H7bu679ge1zgXNn+O5K4BrbtwJI+iawByOe5NNdExFjw/YDwC8kvRpAhV0qfv0qYDNJi8r9fYCfNtDMgUqSj4iRJelM4HLgWZJWSnoj8DrgjZKuA24EXlHlWrYnKPrwL5F0AyDgC820fHCUpYYjIsZXnuQjIsbYUL143VAbeT6btN2MiBhyD3LfPbYXzX7m9PZ/8Sb+3b0Tlc5dcf3DF9quc9LVwAxVkp/PJjxf+7bdjIgYcv/ms38112v87t4Jrrxw60rnznvaz7eYa7y2DFWSj4gYFANrWNN2MxqXJB8RnWTMKlfrrhllSfIR0Vl5ko+IGFPGTHRgCHmSfER01hqS5CMixpKBiST5iIjxlSf5OZL0DuBNFP9o3gAcafvPTcaMiKjCwKoO9Mk3tqyBpK2AtwFLbO8EzANe21S8iIh+GDNRcRtlTXfXrA9sLGkVsAC4o+F4ERHVGCZGO39X0tiTvO3bgU9RVFi5E/i97YvWPk/SUknLJS1fxcNNNSci4jGKGa/VtlHWZHfNZhTrOG8LbAlsIunwtc+zvcz2EttLNiiqdEVEDICYqLiNsiaXGt4P+IXtu22voii7tWeD8SIiKitevKrSNsqa7JO/DdhD0gLgT8C+wPIG40VEVFaMkx/tBF5FY0ne9hWSzgauBlYD1wDLmooXEdGvNSP+lF5Fo6NrbB8HHNdkjIiIdZEn+YiIMWbERAcqoCbJR0RnpbsmImJMGfGI57XdjMYlyUdEJxWTodJdExExtvLiNSJiTNliwnmSj4gYW2vyJB8RMZ6KF6/jnwLH/w4jIqaQF68REWNuIuPkIyLGU2a8RkSMuTUZXRMRMZ6KBcqS5CMixpIRq7KsQUTEeLLpxGSoJmu8PkvStT3bA5Le3lS8iIj+iDUVt1HWZGWonwG7AkiaB9wOfKOpeBER/TDdeJIfVHfNvsB/2v7VgOJFRMwqL17r81rgzAHFioiYlVGKhtRB0obAwcD7p/l8KbAUYD4Lmm5ORARQdNes6sDaNYP4W+VA4Grbv53qQ9vLbC+xvWQDNhpAcyIiAMRExa32yNKrJW1a/v4hSedKem7tgRhMkj+MdNVExJAxxYzXKlsVkt4h6UZJP5F0pqT5M5z+YdsPSnohsD9wGvD5ud/V4zWa5CUtAF4CnNtknIiIdVHXk7ykrYC3AUts7wTMo3gXOX3owsuBz9v+FrDhHG9nSo12SNn+I/BXTcaIiFgXtupeu2Z9YGNJq4AFwB0znHu7pJOA/YBPSNqIhh66x3/8UETEFIoXr/MqbcAWkpb3bEsfcy37duBTwG3AncDvbV80Q/jXABcCB9i+H9gceE8Dt5llDSKiq/qq8XqP7SXTXknaDHgFsC1wP/B1SYfbPn2ar2wBLC+/u3V57OaqjelHknxEdFLx4rW2kTP7Ab+wfTeApHOBPYHpkvx3yiYImE/xj8PPgL+tq0GTkuQjorNqnPF6G7BHOdjkTxSz/JdPd7Lt5/Tul8Mn31xXY3olyUdEJ9U549X2FZLOBq4GVgPXAMv6+P7Vkv6ulsasJUk+IjqrzkLeto8DjqtyrqR39uyuBzwXuLu2xvRIko+ITrJh1ZrWBhhu2vP7aoo++nOaCJQkHxGdVHTXtJPkbR8/qFhJ8hHRWU2sSzMTSZ+2/XZJ51OMrnkM2wfXHTNJPiI6qeYhlFV9ufz5qUEFTJKPiI4afHeN7RXlz+8PKmaSfER01qDrt0q6gSm6aSbZ3rnumEnyEdFJxeiaeYMOe1D58y3lz8num9cBf2wiYJJ8RHRSG+X/JutcS9rL9l49Hx0r6YfAR+uOmVUoI6Kz1qBKWwM2KQuGACBpT2CTJgLlST4iOqml0TWT3gicIumJ5f79wFFNBGo0yUt6EnAysBPFf9OjbF/eZMyIiKpanAy1AthF0kJAtn/fVKymn+RPBC6wfaikDSmqpUREtM4Wq1tK8gCSXk6xtPB8SWWbXHuffGNJvvwXam/gDQC2HwEeaSpeRES/2uqukfR/KR56X0zR23EocGUTsZr8Z2w7ilXVTpV0jaSTJT3uxYKkpZMltVbxcIPNiYh41GSffJWtAXva/u/AfeU6Ni8Ant5EoCaT/PoUy2d+3vZuwB+AY9c+yfYy20tsL9mAjRpsTkTEY7WY5P9c/vyjpC2BVRTVoWrXZJJfCay0fUW5fzZF0o+IaN3kOPmWkvz55cCUT1IUGvklcGYTgRrrk7f9G0m/lvQs2z+jKIf106biRUT0a9DLGgBIWg+4xPb9wDmSvg3Mb2qETdOja44GzihH1twKHNlwvIiISmxY3ULRENtrJP0zRT88th+G5l5INprkbV8LLGkyRkTEumpxMtRFkl4FnGt72gXL6pAZrxHRSW2sXdPjnRTLGKyW9GdAgG0vrDtQknxEdJZbSvK2N53pc0l/a/vGOmJlgbKI6KwWFyibzZdnP6WaPMlHRCfZrfbJz6a2hiXJR0RHiYkWRtdUVNvL2CT5iOistvrkBylJPiI6qeX15GdT22KOQ/u3SkREo1z0y1fZ6qbC4ZI+Uu5vLWn3vzTN3qOuWEnyEdFZLY6u+RzFjNfDyv0Hgc82ESjdNRHRSW73xevzbT9X0jUAtu8rl3+pXZJ8RHRWswsKzGiVpHmUo2gkLQLWNBEoST4iOqvF0TWfAb4BPFnSxykqQ32oiUBJ8hHRScVL1daWNThD0gqKJdgFvNL2TU3ESpKPiM5qscbricBXbTfysrVXRtdERGe1NYSSohrUhyTdIumTkhpbkr3RJ3lJv6QYGjQBrLadteUjYigYsaal0TW2TwNOk7Q58CrgE5K2tr193bEG0V3zYtv3DCBORERf6nxIL2u2ngzsVF76KNuXz/K1vwZ2ALahofKo6ZOPiG6q/8XricAFtg8tx7wvmO5ESZ8ADgH+E/ga8LGy5mvtmk7ypihzZeAk28vWPkHSUmApwPzp/5tERNSvpkd5SQuBvYE3ANh+hJnXn/kF8IJB9HI0neT3sn2HpCcDF0u62fZlvSeUiX8ZwEJt3t7UhIjonD6e5LeQtLxnf9laD63bAXcDp0raBVgBHGP7D70XkbSD7ZuBK4GtJW392Pb46n7vYTZNF/K+o/x5l6RvALsDl838rYiI5hlYs6Zykr9nloEj6wPPBY62fUU5RPJY4MNrnfdOip6Lf56mSftUbVBVjSV5SZsA69l+sPz9pcBHm4oXEdEXA/X1ya8EVtq+otw/myLJPzakvbT89UDbf+79TNL8uhrTq8nxQ08BfiDpOoo/Tb5j+4IG40VE9KWucfK2fwP8WtKzykP7MvNomR9VPDZnjT3J274V2KWp60dEzFm9bwGPBs4oR9bcChy59gmSngpsBWwsaTcereW6kBlG48xFhlBGREep1iGUtq8FZpvwuT/FCJzFFP3ykw14APhAbY3pkSQfEd014PF8PTNdX2X7nEHEzNo1EdFNBq9Rpa0BzytnyAIgaTNJ/7uJQEnyEdFhqrjV7sDeGa627wNe1kSgJPmI6C5X3Oo3T9JGkzuSNgY2muH8dZY++Yjorvbm2J8OXCLp1LIVRwGnNRGok0n+t9/a8XHHpnvLPjFFf9xUy5NOV3xgqv68NROP/76nqe74zMOvmfqDiJibeidD9Rfa/idJ1wP7UfQHfcz2hU3EqpTkJS0G/gV4IUWx2R9QrMuwsolGRUQMQouFvAFuoqiz8W+SFkja1PaDdQep2id/KnAe8DSKgfznl8ciIkbXGlXbaibpf1AsfXBSeWgr4Ju1B6J6kl9k+1Tbq8vtS8CiJhoUETEocrWtAW8B9qKYBIXtnwNPbiJQ1SR/j6TDJc0rt8OB3zXRoIiIgag6sqaZJP9wueY8AJLWbypS1SR/FPAa4DfAncCh5bGIiBGl4sVrla1+35f0AYo1bF4CfJ2iG7x2s754lTQP+AfbBzfRgIiI1rT34vVY4I3ADcCbge9S1Iet3axJ3vaEpEWSNuz98yIiYuRNM3S5KZIusb0v8I+23wd8ocJ3zqtw6Xttv2GqD6qOk/8l8MMy2F/KWdk+oeL3IyKGSzvj5J8m6b8CB0s6i7XWTJim/N+OwJtmuKaAz073YdUkf0e5rQdsWvE7RfSiu2c5cLvtg/r5bkREkxoaOTOTj1B01SwG1n5Inq783wdtf3+mi0o6frrPKiV529NeoIJjKAb9L5zDNSIi6jf4JH+n7QMlfcR2pXKotr82l3NmTPKSzmeG/wyzvYwtZ8q+HPg4RQHbiIgu+wzwPOCV9FnzWtIS4IPAMyhytwDb3nmm7832JP+p8uchwFMpFtUBOIyin342nwbeywxdPJKWUlQvZ34z1a8iIqbUQnfNqnJRsq0kfWbtD22/bYbvngG8h2JETuVXxjMm+cl+IEkfs713z0fnS7pspu9KOgi4y/YKSS+aIcYyYBnAQm3e7koSEdEdppElC2ZxEMWiZPsAK/r87t22q4y0eYyqL14XSdquLM6NpG2ZfVmDvSjeIL8MmA8slHS67cP7bWRERCMGX/7vHuAsSTfZvq7Prx8n6WTgEuDhnmueO9OXqib5dwCXSrq13N+GsotlOrbfD7wfoHySf3cSfEQMkxa6ayb9SdIlwFNs7yRpZ+Bg2zOVADwS2AHYgEe7awzMPcnbvkDS9mUAgJttPzzTdyIihl57Sf4LFP3rJwHYvl7SV4CZkvwutp/Tb6BKa9dIWk4xBfc229f1m+BtX5ox8hExdNpboGyB7SvXOrZ6lu/8WNKz+w1UdYGy11Ksd3yVpLMk7S+pnZIqERE1qLrMcENdOvdIeiblPyGSDqVY/HEmLwSulfQzSddLuqGsLjWjqt01twAflPRhirfDpwBrJJ0CnGj73irXiYgYKoMfXTPpLRSjCneQdDvwC+B1s3zngHUJVLnGa/li4CjgQOAcijGbLwS+B+y6LsEjItrU1ovXcqTifpI2AdZbu+yfpNfbPq38/Wrbz7X9q+muN3nOVJ9VrfG6ArifYinM9/X0yV8haa8q14iIGDotz8yx/YdpPjoGOK38fcdZumUEPHG6D6s+yR8B7AZsC7xvsjve9kdtH1LxGhERw6O5/vY69PYj7TDtWY+amO6Dqkn+BIon+avpGYQfETHShjfJ/6VlM3XTVFE1yS+2vU6d/hERw0oDLhrSh9reCFdN8j+S9BzbN9QVuE1PecVNbTchIjpK0nrAobMsIfzDuuLNttTwDRR/NqwPHFkua/AwFZe4jIgYai1019heI+mtwLRJ3vZb64o325N8ZqlGxHhq98XrxZLeDXyVx5ZUrX3O0WxLDc+pwz8iYqi1l+SPKn++peeYge3qDlR5MlRExNhpbzLUtoOKlSQfEZ0k6h1dI2kesBy4fbYFGSVtAPxPYLIY06XASbZX1deiQpJ8RHRT/X3yxwA3AQsrnPt5inXhP1fuH1Eee1OtLSJJPiK6rKYkL2kx8HLg48A7K3zl72zv0rP/PUn9VoqqpOpSw32TNF/SlZKuk3SjpOObihURsU6qrye/haTlPdvalfE+DbyX6gW2J8qlhgGQtB0zLE0wF00+yT8M7GP7obL/6QeS/p/tHzcYMyKisj66a+6xvWTKa0gHAXfZXlGWOq3iPcC/l3OPBDyDorxf7RpL8rYNPFTublBuw7tSRER0Tz0ZaS/gYEkvA+YDCyWdPlNNa9uXlCVVn0WR5BsrqdpYdw0Ub5slXQvcBVxs+4opzlk6+SfQqqx9FhGD4mJ0TZVtxsvY77e92PY2FFX0vjdTggeQtIDiaf5o29cBW5d/EdSu0SRve8L2rsBiYHdJO01xzjLbS2wv2YCNmmxORMRjtVfj9VTgEeAF5f5KZi7ivc4aTfKTbN9PMQ40K1lGxNCou8ar7UtnGyNfeqbtfwJWld/7EzWuPNmrydE1iyQ9qfx9Y2A/4Oam4kVE9K29J/lHyrw4Wcj7mTRUq6PJ0TVPA04rZ4GtB3zN9rcbjBcRUV1zCbyKvwcuAJ4u6QyKl7cjN7rmeoqSgRERQ0e0Wsj7orJ29h5lU46xfU8TsTLjNSI6q60kL+kS2/sC35niWK2S5COiuwac5CXNBxZQzKDdjEdfti4EtmwiZpJ8RHTX4J/k3wy8nSKhX91z/AHgs00ETJKPiG5qoTKU7ROBEyUdbftfBhFzIOPkIyKGUntDKE+R9CFJywAkbT+SM14jIoZZHcsarKNTKGa87lnuj/aM14iIYVT3jNc+DGzGa/rkI6Kb2p0MNRYzXiMihlt7Sf44Hj/j9Q1NBEqSj4hOannG68WSriYzXiMimqM1rdYx2gqYR5GH95aE7XPrDpIkHxHd1GKfvKRTgJ2BG3m0LqyBJPmIiLq01V0D7GH72YMIlCGUEdFd7U2GulzSQJJ8nuQjorNafJI/jSLR/4Zi6KQA29657kCNJXlJTwf+FXgqRZ/TsnLdhoiI4dBekj8FOAK4gUf75BvR5JP8auBdtq+WtCmwQtLFtn/aYMyIiGrc2JIFVdxm+7xBBGqyMtSdwJ3l7w9KuoliyFCSfES0rs1x8sDNkr4CnE/PTNeRHUIpaRuKUoBXTPHZUmApwHwWDKI5EREFt5blN6ZI7i/tOTaaQyglPQE4B3i77QfW/tz2MmAZwEJt3urMhIjolhZnvDZStHsqjQ6hlLQBRYI/o4k/QyIi1lnV4ZMN/EMgabGkb0i6S9JvJZ0jaXH9kRpM8pIEfBG4yfYJTcWJiFhXLa4nfypwHkUZwK0o+uZPbSJQk0/ye1EMEdpH0rXl9rIG40VE9KXFJL/I9qm2V5fbl4BFTQRqcnTND2hoEfyIiDkzbb54vUfS4cCZ5f5hwO+aCJRlDSKis1qsDHUU8BrgNxRDzQ8tj9UuyxpERHe18CAvaR7wD7YPHkS8JPmI6KS2JkPZnpC0SNKGth9pOl6SfER0k91m0ZBfAj+UdB7wh0ebVP9IxCT5iOiu9qZf3lFu6wGbNhkoST4iOqvFGa/HDypWknxEdJOBAXfXSDqfGf5+aOJlbJJ8DLUL77juccf233KXKc/9/REveNyxJ3758trbFGNk8E/ynyp/HkJRa+P0cv8win762iXJR0Rn1dVdU7VIku3vl+d/zPbePR+dL+myelrzWEnyEdFZNY6u6bdI0iJJ29m+FUDStozasgYREUOtxhUm16FI0juASyXdWu5vQ1lXo25J8hHRScVkqMpZfgtJy3v2l5W1MB5/3RmKJE2yfYGk7YEdykM32354uvPnIkk+Irqr+gqT99heMttJsxVJ6jlvOUUx7zNt31e5FesgC5RFRGfJrrRVulZ/RZJeS9Gdc5WksyTtX9bgqF2SfER0U42VofotkmT7FtsfBP4G+ArFU/1tko6XtPm63M50mqwMdUpZ2uonTcWIiFh3xdo1VbYK+i6SJGln4ATgkxR/ARwKPAB8b2739VhN9sl/Cfg/FGNHIyKGT01FQ/otkiRpBXA/cDLwvp6XrldI2quWRpWarAx1WfmWOSJi+Lix0n5VHEExAmdb4H2T3fG2P2r7kDoDZXRNRHRXe+X/TqB4kr8aaGTo5KTWk7ykpZSTAOazoOXWRESntLfU8GLbBwwiUOuja2wvs73E9pIN2Kjt5kREh2jNmkpbA34k6TlNXHhtrT/JR0S0wvQzGaoWkm4oI68PHFkua/AwxUtb29657piNJXlJZwIvopgOvBI4zvYXm4oXEdEPUX2iU40OGnTAJkfXHNbUtSMiajHgJG/7VwMNSLprIqLL2htdMzBJ8hHRTS30ybchST4iOquhkTNDJUk+IjrK6a6JiBhbJkk+ImKsjX9vTZJ8RHRXC+PkB27sk/wtn9njccf++m0/ftyxNXvvNuX317vsmtrbFNXtv+Uulc994pcvb7AlMZaS5CMixpQNE+PfX5MkHxHdlSf5iIgxliQfETGmDFSr3zrSkuQjoqMMTp98RMR4MnnxGhEx1tInHxExxjqQ5But8SrpAEk/k3SLpGObjBUR0Z9ygbIq2whrsvzfPOCzwEuAlcBVks6z/dOmYkZEVGagA0sNN/kkvztwi+1bbT8CnAW8osF4ERH9yZP8nGwF/LpnfyXw/LVPkrQUWAownwUNNicioleWNZgrTXHscf8k2l4GLANYqM1H+5/MiBgdBmec/JysBJ7es78YuKPBeBER/enAjNcm++SvAraXtK2kDYHXAuc1GC8ioj/pk193tldLeitwITAPOMX2jU3Fi4joi92J0TWNToay/V3gu03GiIhYZyP+lF5FZrxGREcZT0y03YjGJclHRDdlqeGIiDHXgSGUja5dExExrAx4jSttVQzrWl1J8hHRTS6LhlTZZtGzVteBwLOBwyQ9u+E7qCTdNRHRWTW+eP3LWl0AkibX6mp9QUZ5iIYQSbob+BWwBXBPy81pwjje1zjeE+S+ht0zbC+aywUkXUDx36OK+cCfe/aXlUuyTF7rUOAA228q948Anm/7rXNpYx2G6kl+8n80ScttL2m7PXUbx/sax3uC3FcX2D6gxstVWqurDemTj4iYu6FdqytJPiJi7oZ2ra6h6q7psWz2U0bSON7XON4T5L6iD8O8VtdQvXiNiIh6pbsmImKMJclHRIyxoUvywzo1uF+STpF0l6Sf9BzbXNLFkn5e/tyszTb2S9LTJf27pJsk3SjpmPL4yN6XpPmSrpR0XXlPx5fHR/aeekmaJ+kaSd8u98fivqK6oUrywzw1eB18CVh7HO6xwCW2twcuKfdHyWrgXbZ3BPYA3lL+7zPK9/UwsI/tXYBdgQMk7cFo31OvY4CbevbH5b6ioqFK8vRMDbb9CDA5NXjk2L4MuHetw68ATit/Pw145SDbNFe277R9dfn7gxTJYytG+L5ceKjc3aDczAjf0yRJi4GXAyf3HB75+4r+DFuS3wr4dc/+yvLYuHiK7TuhSJjAk1tuzzqTtA2wG3AFI35fZZfGtcBdwMW2R/6eSp8G3gv0rrA1DvcVfRi2JD+0U4PjUZKeAJwDvN32A223Z65sT9jelWKW4u6Sdmq5SXMm6SDgLtsr2m5LtGvYkvzQTg2uyW8lPQ2g/HlXy+3pm6QNKBL8GbbPLQ+P/H0B2L4fuJTiXcqo39NewMGSfknR7bmPpNMZ/fuKPg1bkh/aqcE1OQ94ffn764FvtdiWvkkS8EXgJtsn9Hw0svclaZGkJ5W/bwzsB9zMCN8TgO33215sexuK/x99z/bhjPh9Rf+GbsarpJdR9CVOTg3+eLstWjeSzgReRLGU6W+B44BvAl8DtgZuA15te+2Xs0NL0guB/wBu4NF+3g9Q9MuP5H1J2pniBeQ8ioeer9n+qKS/YkTvaW2SXgS82/ZB43RfUc3QJfmIiKjPsHXXREREjZLkIyLGWJJ8RMQYS5KPiBhjSfIREWMsST5aIemh2c9q/5oRoy5JPiJijCXJR+skvUfSVZKu71nP/ROS/lfPOX8v6V3TnR8RU0uSj1ZJeimwPcUy07sCz5O0N8V6K/+t59TXAF+f4fyImML6bTcgOu+l5XZNuf8EYHvbX5T0ZElbAouA+2zfJultU50PXDbgdkeMhCT5aJuAf7R90hSfnQ0cCjyV4sl+tvMjYi3prom2XQgcVa5Rj6StJE0WsjiLYgXFQykS/mznR8Ra8iQfrbJ9kaQdgcuLlYx5CDicouDFjZI2BW7vqWY07fmt3EDEkMsqlBERYyzdNRERYyxJPiJijCXJR0SMsST5iIgxliQfETHGkuQjIsZYknxExBj7/2FSjqJ3woo9AAAAAElFTkSuQmCC\n", + "text/plain": [ + "
" + ] + }, + "metadata": { + "needs_background": "light" + }, + "output_type": "display_data" + } + ], + "source": [ + "testfile['Reff'].sel(point=10).plot()" + ] + }, + { + "cell_type": "code", + "execution_count": 15, + "id": "01b07acd-e4a3-4ee2-a45a-7813265d80ed", + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "
\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "
<xarray.DataArray 'hydro' (hydro: 9)>\n",
+       "array([0, 1, 2, 3, 4, 5, 6, 7, 8])\n",
+       "Dimensions without coordinates: hydro
" + ], + "text/plain": [ + "\n", + "array([0, 1, 2, 3, 4, 5, 6, 7, 8])\n", + "Dimensions without coordinates: hydro" + ] + }, + "execution_count": 15, + "metadata": {}, + "output_type": "execute_result" + } + ], + "source": [ + "testfile.hydro" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "6be757aa-c224-48aa-9afa-193fa23634f7", + "metadata": {}, + "outputs": [], + "source": [] + } + ], + "metadata": { + "kernelspec": { + "display_name": "Python [conda env:miniconda3-cheydask]", + "language": "python", + "name": "conda-env-miniconda3-cheydask-py" + }, + "language_info": { + "codemirror_mode": { + "name": "ipython", + "version": 3 + }, + "file_extension": ".py", + "mimetype": "text/x-python", + "name": "python", + "nbconvert_exporter": "python", + "pygments_lexer": "ipython3", + "version": "3.7.8" + } + }, + "nbformat": 4, + "nbformat_minor": 5 +} diff --git a/src/simulator/quickbeam/quickbeam.F90 b/src/simulator/quickbeam/quickbeam.F90 index 6e92863846..06d78b9a82 100644 --- a/src/simulator/quickbeam/quickbeam.F90 +++ b/src/simulator/quickbeam/quickbeam.F90 @@ -46,6 +46,7 @@ ! Also removed called to AVINT for gas and hydrometeor attenuation and replaced with simple ! summation. (Roger Marchand) ! May 2015 - D. Swales - Modified for COSPv2.0 +! Jun 2025 - J.K. Shaw - Parameters and DDT moved to cosp_stats.F90 for interface swathing ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% module quickbeam USE COSP_KINDS, ONLY: wp @@ -55,48 +56,10 @@ module quickbeam pClass_Rain4, pClass_default, Zenonbinval, Zbinvallnd, & N_HYDRO,nCloudsatPrecipClass,cloudsat_preclvl - USE MOD_COSP_STATS, ONLY: COSP_LIDAR_ONLY_CLOUD,hist1D,COSP_CHANGE_VERTICAL_GRID + USE MOD_COSP_STATS, ONLY: COSP_LIDAR_ONLY_CLOUD,hist1D,COSP_CHANGE_VERTICAL_GRID, & + maxhclass,nRe_types,nd,mt_ntt,Re_BIN_LENGTH,Re_MAX_BIN, & + dmin,dmax,radar_cfg implicit none - - integer,parameter :: & - maxhclass = 20, & ! Qucikbeam maximum number of hydrometeor classes. - nRe_types = 550, & ! Quickbeam maximum number or Re size bins allowed in N and Z_scaled look up table. - nd = 85, & ! Qucikbeam number of discrete particles used in construction DSDs. - mt_ntt = 39, & ! Quickbeam number of temperatures in mie LUT. - Re_BIN_LENGTH = 10, & ! Quickbeam minimum Re interval in scale LUTs - Re_MAX_BIN = 250 ! Quickbeam maximum Re interval in scale LUTs - real(wp),parameter :: & - dmin = 0.1, & ! Quickbeam minimum size of discrete particle - dmax = 10000. ! Quickbeam maximum size of discrete particle - - !djs logical :: radar_at_layer_one ! If true radar is assume to be at the edge - ! of the first layer, if the first layer is the - ! surface than a ground-based radar. If the - ! first layer is the top-of-atmosphere, then - ! a space borne radar. - - ! ############################################################################################## - type radar_cfg - ! Radar properties - real(wp) :: freq,k2 - integer :: nhclass ! Number of hydrometeor classes in use - integer :: use_gas_abs, do_ray - logical :: radar_at_layer_one ! If true radar is assume to be at the edge - ! of the first layer, if the first layer is the - ! surface than a ground-based radar. If the - ! first layer is the top-of-atmosphere, then - ! a space borne radar. - - ! Variables used to store Z scale factors - character(len=240) :: scale_LUT_file_name - logical :: load_scale_LUTs, update_scale_LUTs - logical, allocatable, dimension(:,:) :: N_scale_flag - logical, allocatable, dimension(:,:,:) :: Z_scale_flag, Z_scale_added_flag - real(wp), allocatable, dimension(:,:,:) :: Ze_scaled, Zr_scaled, kr_scaled - real(wp), allocatable, dimension(:,:,:) :: fc, rho_eff - real(wp), allocatable, dimension(:) :: base_list, step_list - end type radar_cfg - contains ! ###################################################################################### ! SUBROUTINE quickbeam_subcolumn diff --git a/src/simulator/rttov/cosp_rttov.F90 b/src/simulator/rttov/cosp_rttov.F90 deleted file mode 100644 index 5bde602bbd..0000000000 --- a/src/simulator/rttov/cosp_rttov.F90 +++ /dev/null @@ -1,592 +0,0 @@ -! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -! Copyright (c) 2015, Regents of the University of Colorado -! All rights reserved. -! -! Redistribution and use in source and binary forms, with or without modification, are -! permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of -! conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list -! of conditions and the following disclaimer in the documentation and/or other -! materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be -! used to endorse or promote products derived from this software without specific prior -! written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY -! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL -! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT -! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! History: -! Aug 2008 - V. John - Initial version -! Jun 2010 - A. Bodas-Salcedo - Conversion to module and tidy up -! May 2015 - D. Swales - Modified for COSPv2.0 -! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -MODULE MOD_COSP_RTTOV - USE COSP_KINDS, ONLY: wp - USE MOD_COSP_CONFIG, ONLY: RTTOV_MAX_CHANNELS - USE RTTOV_CONST, only: errorstatus_fatal, errorstatus_warning, errorstatus_success - USE RTTOV_TYPES, only: rttov_coef, profile_type, transmission_type, & - radiance_type, rttov_coef_scatt_ir, rttov_optpar_ir - USE PARKIND1, Only : jpim, jprb - IMPLICIT NONE - - ! Include subroutine interfaces - include "rttov_errorreport.interface" - include "rttov_setup.interface" - include "rttov_errorhandling.interface" - include "rttov_direct.interface" - include "rttov_alloc_prof.interface" - include "rttov_alloc_rad.interface" - include "rttov_dealloc_coef.interface" - - ! Fields set during initialization - integer :: & - nch_in, & ! Number of RTTOV channels - plat_in, & ! RTTOV platform - sat_in, & ! RTTOV satellite - sens_in ! RTTOV instrument - integer,dimension(RTTOV_MAX_CHANNELS) :: & - ichan_in ! RTTOV channel indices - -CONTAINS - - !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! SUBROUTINE RTTOV_PIXEL - !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - SUBROUTINE RTTOV_subcolumn(surfem_in, prf_num_in, nlevels_in, & - zenang_in, p_in,t_in, q_in, o3_in, co2_in, & - ch4_in, n2o_in, co_in, h_surf, u_surf, & - v_surf, t_skin, p_surf, t_surf, q_surf, & - lsmask, latitude, tbs) - ! INPUTS - integer,intent(in) :: & - prf_num_in, & ! Number of profiles to simulate - nlevels_in ! Number of pressure levels - real(wp),intent(in) :: & - zenang_in, & ! Satellite zenith angle - co2_in, & ! Carbon dioxide - ch4_in, & ! Methane - n2o_in, & ! n2o - co_in ! Carbon monoxide - real(wp),intent(in),dimension(nch_in) :: & - surfem_in ! Surface emissivities for the channels - real(wp),intent(in),dimension(prf_num_in) :: & - h_surf, & ! Surface height - u_surf, & ! U component of surface wind - v_surf, & ! V component of surface wind - t_skin, & ! Surface skin temperature - p_surf, & ! Surface pressure - t_surf, & ! 1.5 m Temperature - q_surf, & ! 1.5 m Specific humidity - lsmask, & ! land-sea mask - latitude ! Latitude - real(wp),intent(in),dimension(prf_num_in,nlevels_in) :: & - p_in, & ! Pressure profiles - t_in, & ! Temperature profiles - q_in, & ! Humidity profiles - o3_in ! Ozone profiles - - ! OUTPUTS - real(wp),intent(inout),dimension(prf_num_in,nch_in) :: & - tbs ! Tbs (in the right format) - - ! LOCAL VARIABLES - type(transmission_type) :: transmission - type(radiance_type) :: radiance - type(rttov_coef ), allocatable, dimension(:) :: coef - type(profile_type), allocatable, dimension(:) :: profiles - type(rttov_coef_scatt_ir),allocatable, dimension(:) :: coef_scatt_ir - type(rttov_optpar_ir), allocatable, dimension(:) :: optp - Integer(Kind=jpim), Allocatable, dimension(:,:) :: & - instrument, & ! Instrument id - nchan, & ! Number of channels per instrument and profile - ichan ! Channel list per instrument - Integer(Kind=jpim), Allocatable, dimension(:) :: & - nchan1, & ! Number of channels per instrument and profile - nchannels, & ! Number of channels per instrument - ifull, & ! Full test (with TL,AD,K) per instrument - nprof, & ! Number of profiles per instrument - nsurf, & ! Surface id number per instrument - nwater, & ! Water id number per instrument - channels, & ! Channel list per instrument*profiles - lprofiles, & ! - rttov_errorstatus, & ! rttov error return code - setup_errorstatus ! Setup return code - Integer(Kind=jpim) :: & - nprofiles,iref,isun,asw,mxchn,i,j,jch,errorstatus,io_status,ioout,interp, & - Err_Unit, & ! Logical error unit (<0 for default) - verbosity_level, & ! (<0 for default) - nrttovid, & ! Maximum number of instruments - no_id, & ! Instrument loop index - Nprofs, & ! Number of calls to RTTOV - nch ! Intermediate variable - Integer(Kind=jpim), Parameter :: & - jpnav = 31, & ! Number of profile variables - jpnsav = 6, & ! Number of surface air variables - jpnssv = 6, & ! Number of skin variables - jpncv = 2, & ! Number of cloud variables - sscvar = jpnsav+jpnssv+jpncv ! Number of surface,skin,cloud vars - Integer(Kind=jpim),dimension(60) :: & - alloc_status - Real(Kind=jprb) :: & - zenang, azang, sunzang, sunazang - Real(kind=jprb), allocatable, dimension(:) :: & - emissivity,fresnrefl,input_emissivity - Real(kind=jprb), allocatable, dimension(:,:) :: & - surfem - Real(Kind=jprb),dimension(nch_in*prf_num_in) :: & - tbs_temp ! A temporary variable to hold Tbs - Character (len=3) :: & - cref, csun - Character (len=80) :: & - errMessage - Character (len=14) :: & - NameOfRoutine = 'rttov_multprof' - Logical :: addinterp,refrac,solrad,laerosl,lclouds,lsun,all_channels - Logical,Allocatable,dimension(:) :: & - calcemis - integer(kind=jpim) :: prof_num,nlevels - - ! Type-casting of input arguments that need to be passed to RTTOV - prof_num = prf_num_in - nlevels = nlevels_in - - ! Unit numbers for input/output - IOOUT = 2 - - ! Curretly we plan to calculate only 1 instrument per call - nrttovid = 1 - mxchn = nch_in - errorstatus = 0 - alloc_status(:) = 0 - all_channels = .false. - sunzang = 0._jprb - sunazang = 0._jprb - - ! Initialise error management with default value for - ! the error unit number and Fatal error message output - Err_unit = -1 - verbosity_level = 0 - - ! All error message output - call rttov_errorhandling( Err_unit, verbosity_level, print_checkinput_warnings=.false. ) - io_status = 0 - errmessage = '' - - ! Assigning the zenith angle - zenang = zenang_in - - ! Allocate - allocate (coef(nrttovid), stat = alloc_status(1)) - allocate (coef_scatt_ir(nrttovid),stat = alloc_status(2)) - allocate (optp(nrttovid), stat = alloc_status(3)) - allocate (instrument(3,nrttovid), stat = alloc_status(4)) - allocate (ifull(nrttovid), stat = alloc_status(5)) - allocate (nprof(nrttovid), stat = alloc_status(6)) - allocate (nsurf(nrttovid), stat = alloc_status(7)) - allocate (nwater(nrttovid), stat = alloc_status(8)) - allocate (nchannels(nrttovid), stat = alloc_status(9)) - allocate (nchan1(nrttovid), stat = alloc_status(10)) - allocate (surfem(mxchn,nrttovid), stat = alloc_status(11)) - allocate (ichan (mxchn,nrttovid), stat = alloc_status(12)) - If( any(alloc_status /= 0) ) then - errorstatus = errorstatus_fatal - Write( errMessage, '( "mem allocation error")' ) - Call Rttov_ErrorReport (errorstatus, errMessage, NameOfRoutine) - Stop - End If - surfem(:,:) = 0.0_JPRB - ichan(:,:) = 0 - - !!! FIXME: Shall we get rid of this loop? We use only one instrument - DO NO_ID = 1, NRTTOVID - instrument(1,no_id) = plat_in - instrument(2,no_id) = sat_in - instrument(3,no_id) = sens_in - - !! Forward model only (0) or TL and AD (1) or K (2)?' - ! This version supports only Forward model - IFULL(no_id) = 0 - - ! Number of profiles to test per call - NPROF(no_id) = prof_num - nprofiles = NPROF(no_id) - - ! Total number of profiles to process - NPROFS = prof_num - NPROFS = NPROFS / NPROF(no_id) ! Number of calls to RTTOV - - ! Check whether it is OK to use ocean all the time - NWATER(no_id) = 1 ! Water type (0=fresh water, 1=ocean water) - - ! Set up channel numbers - allocate (nchan(nprof(no_id),nrttovid),stat= alloc_status(3)) - nchan(1:nprof(no_id),no_id) = nch_in - ichan(:, 1) = ichan_in - surfem(:, 1) = surfem_in - - ! nchan(1,no_id) is now the real number of channels selected - do j = 1 , nprof(no_id) - nchan(j,no_id) = nch_in - enddo - - ! Compute channels*profiles - nchannels(no_id) = 0 - Do j = 1 , nprof(no_id) - nchannels(no_id) = nchannels(no_id) + nchan (j,no_id) - End Do - nchan1(no_id) = nchan(1,no_id) - END DO - - ! Do you want clouds or aerosol? - laerosl = .False. - lclouds = .False. - - !######################################################### - ! Beginning of rttov_setup test - !######################################################### - alloc_status = 0 - allocate ( setup_errorstatus(nrttovid),stat= alloc_status(1)) - If( any(alloc_status /= 0) ) then - errorstatus = errorstatus_fatal - Write( errMessage, '( "mem allocation error for errorsetup")' ) - Call Rttov_ErrorReport (errorstatus, errMessage, NameOfRoutine) - Stop - End If - - If (all_channels)Then - Call rttov_setup ( & - setup_errorstatus, &! out - Err_unit, &! in - verbosity_level, &! in - nrttovid, &! in - laerosl, &! in - lclouds, &! in - coef, &! out - coef_scatt_ir, &! out - optp, & - instrument) ! in - Else - Call rttov_setup ( & - setup_errorstatus, &! out - Err_unit, &! in - verbosity_level, &! in - nrttovid, &! in - laerosl, &! in - lclouds, &! in - coef, &! out - coef_scatt_ir, &! out - optp, & - instrument, &! in - ichan ) ! in Optional - Endif - - if(any(setup_errorstatus(:) /= errorstatus_success ) ) then - print*, 'rttov_setup fatal error' - stop - endif - - deallocate( setup_errorstatus ,stat=alloc_status(1)) - If( any(alloc_status /= 0) ) then - errorstatus = errorstatus_fatal - Write( errMessage, '( "mem deallocation error for setup_errorstatus")' ) - Call Rttov_ErrorReport (errorstatus, errMessage, NameOfRoutine) - Stop - End If - - DO no_id = 1, NRTTOVID - if( any(coef(no_id)%ff_val_chn( : ) /= 1 )) then - WRITE(*,*) ' some requested channels have bad validity parameter' - do i = 1, nchan1(no_id) - write(*,*) i, coef(no_id)%ff_val_chn(i) - end do - endif - End Do - - DO no_id = 1, NRTTOVID - - !######################################################### - ! Allocate memory for RTTOV_DIRECT - !######################################################### - allocate( rttov_errorstatus(nprof(no_id)),stat= alloc_status(3)) - - ! Allocate profiles - allocate( profiles(nprof(no_id)),stat= alloc_status(1)) - - ! Allow profile interpolation - interp = 1 - - if(interp == 0) addinterp = .false. - if(interp == 1) addinterp = .true. - asw = 1 - - call rttov_alloc_prof ( & - errorstatus, & - nprof(no_id), & - profiles, & - nlevels, & - coef_scatt_ir(no_id), & - asw, & - addclouds = lclouds, & - addaerosl = laerosl, & - init = .true. ) - - - Do j = 1 , nprof(no_id) - profiles(j) % nlevels = nlevels - Enddo - - alloc_status = 0_jpim - ! number of channels per RTTOV call is only nchannels - allocate(lprofiles (nchannels(no_id)), stat = alloc_status(9)) - allocate(channels (nchannels(no_id)), stat = alloc_status(10)) - allocate(emissivity (nchannels(no_id)), stat = alloc_status(12)) - allocate(fresnrefl (nchannels(no_id)), stat = alloc_status(13)) - allocate(input_emissivity(nchannels(no_id)), stat = alloc_status(14)) - allocate(calcemis (nchannels(no_id)), stat = alloc_status(15)) - - ! allocate transmittance arrays with number of channels - allocate( transmission % tau_layers (profiles(1) % nlevels,nchannels(no_id) ), & - stat= alloc_status(11)) - allocate( transmission % tau_total (nchannels(no_id) ) , & - stat= alloc_status(12)) - - If( Any(alloc_status /= 0) ) Then - errorstatus = errorstatus_fatal - Write( errMessage, '( "allocation of transmission")' ) - Call Rttov_ErrorReport (errorstatus_fatal, errMessage, NameOfRoutine) - !IF (LHOOK) CALL DR_HOOK('RTTOV_DIRECT',1,ZHOOK_HANDLE) - Stop - End If - - transmission % tau_layers = 0._jprb - transmission % tau_total = 0._jprb - - ! Allocate radiance results arrays with number of channels - asw = 1 ! allocate - call rttov_alloc_rad (errorstatus,nchannels(no_id),radiance, & - profiles(1)%nlevels,asw) - - AZANG = 0 - ISUN = 0 - IREF = 1 - - if(iref==0)then - cref='NO' - refrac=.False. - else if(iref==1)then - cref='YES' - refrac=.True. - endif - - if(sunzang<=87._JPRB)then - solrad=.True. - else - solrad=.False. - endif - - if(isun==1)then - lsun=.true. - if(sunzang<=87._JPRB)then - csun='YES' - solrad=.True. - else - csun='NO' - solrad=.False. - endif - else - csun='NO' - solrad=.False. - endif - - do i = 1, NPROF(no_id) - profiles(i) % p(:) = p_in(i, :) - profiles(i) % t(:) = t_in(i, :) - profiles(i) % q(:) = q_in(i, :) - profiles(i) % o3(:) = o3_in(i, :) - profiles(i) % co2(:) = co2_in - profiles(i) % ch4(:) = ch4_in - profiles(i) % n2o(:) = n2o_in - profiles(i) % co(:) = co_in - profiles(i) % ozone_Data = .False. - profiles(i) % co2_Data = .True. - profiles(i) % n2o_data = .True. - profiles(i) % ch4_Data = .True. - profiles(i) % co_Data = .True. - - !FIXME: Make Cloud variables as passing ones if we go for all sky - profiles(i) % cfraction = 0. - profiles(i) % ctp = 500. - profiles(i) % clw_Data = .False. - - ! 2m parameters - profiles(i) % s2m % p = p_surf(i) - profiles(i) % s2m % t = t_in(i, 1) - profiles(i) % s2m % q = q_in(i, 1) - profiles(i) % s2m % u = 2 - profiles(i) % s2m % v = 2 - - ! Skin variables for emissivity calculations - profiles(i) % skin % t = t_skin(i) - profiles(i) % skin % fastem(1) = 3.0 - profiles(i) % skin % fastem(2) = 5.0 - profiles(i) % skin % fastem(3) = 15.0 - profiles(i) % skin % fastem(4) = 0.1 - profiles(i) % skin % fastem(5) = 0.3 - - profiles(i) % zenangle = zenang - profiles(i) % azangle = azang - profiles(i) % latitude = latitude(i) - profiles(i) % elevation = h_surf(i) - profiles(i) % sunzenangle = SUNZANG - profiles(i) % sunazangle = SUNAZANG - profiles(i) % addsolar = solrad - profiles(i) % addrefrac = refrac - ! surface type - profiles(i) % skin % surftype = lsmask(i) - !! FIXME: Check this one - profiles(i) % skin % watertype = nwater(no_id) - profiles(i) % aer_data = laerosl - profiles(i) % cld_data = lclouds - profiles(i) %idg = 0._jprb - profiles(i) %ish = 0._jprb - if( lclouds ) then - profiles(i) %cloud(:,:) = 0._jprb - profiles(i) %cfrac(:,:) = 0._jprb - endif - enddo - - ! Build the list of channels/profiles indices - emissivity(:) = 0.0_JPRB - channels(:) = 0_jpim - lprofiles(:) = 0_jpim - nch = 0_jpim - Do j = 1 , nprof(no_id) - DO jch = 1,nchan1(no_id) - nch = nch +1_jpim - lprofiles ( nch ) = j - if (all_channels)then - channels( nch ) = ichan(jch,no_id) - else - channels( nch ) = jch - endif - emissivity( nch ) = surfem(jch,no_id) - End Do - End Do - - input_emissivity(:) = emissivity(:) - calcemis(:) = emissivity(:) < 0.01_JPRB - - ! FIXME: Check this one with Roger - do j = 1 , NPROFS - call rttov_direct( & - & rttov_errorstatus, &! out - & nprof(no_id), &! in - & nchannels(no_id), &! in - & channels, &! in - & lprofiles, &! in - & addinterp, &! in - & profiles, &! in - & coef(no_id), &! in - & coef_scatt_ir(no_id), & - & optp(no_id) , & - & lsun, &! in - & laerosl, &! in - & lclouds, &! in - & calcemis, &! in - & emissivity, &! inout - & transmission, &! out - & radiance ) ! inout - enddo - - ! Initialising tbs array - tbs(:, :) = 0.0 - tbs_temp(:) = 0.0 - tbs_temp = radiance%bt - - do i = 1, prof_num - tbs(i, :) = tbs_temp((i-1)*nch_in+1:i*nch_in) - enddo - - - If ( any( rttov_errorstatus(:) == errorstatus_warning ) ) Then - Do j = 1, nprof(no_id) - If ( rttov_errorstatus(j) == errorstatus_warning ) Then - write ( ioout, * ) 'rttov warning for profile', j - End If - End Do - End If - - If ( any( rttov_errorstatus(:) == errorstatus_fatal ) ) Then - Do j = 1, nprof(no_id) - If ( rttov_errorstatus(j) == errorstatus_fatal ) Then - write ( ioout, * ) 'rttov error for profile',j - End If - End Do - Stop - End If - - ! Deallocate - ! number of channels per RTTOV call is only nchannels - deallocate( channels ,stat=alloc_status(2)) - deallocate( lprofiles ,stat=alloc_status(3)) - deallocate( emissivity ,stat=alloc_status(4)) - deallocate( fresnrefl ,stat=alloc_status(5)) - deallocate( calcemis ,stat=alloc_status(6)) - deallocate( input_emissivity ,stat= alloc_status(14)) - If( any(alloc_status /= 0) ) then - errorstatus = errorstatus_fatal - Write( errMessage, '( "mem deallocation error for channels etc")' ) - Call Rttov_ErrorReport (errorstatus, errMessage, NameOfRoutine) - Stop - End If - - asw = 0 ! deallocate radiance arrays - call rttov_alloc_rad (errorstatus,nchan1(no_id),radiance,profiles(1) % nlevels,asw) - If(errorstatus /= errorstatus_success) Then - Write( errMessage, '( "deallocation error for radiances")' ) - Call Rttov_ErrorReport (errorstatus, errMessage, NameOfRoutine) - Endif - - ! deallocate transmittances - Deallocate( transmission % tau_total ,stat= alloc_status(7)) - Deallocate( transmission % tau_layers ,stat= alloc_status(8)) - If(errorstatus /= errorstatus_success) Then - Write( errMessage, '( "deallocation error for transmittances")' ) - Call Rttov_ErrorReport (errorstatus, errMessage, NameOfRoutine) - Stop - Endif - - asw = 0 ! deallocate profile arrays - call rttov_alloc_prof (errorstatus,nprof(no_id),profiles,profiles(1)%nlevels,coef_scatt_ir(no_id),asw,& - & addclouds = lclouds, addaerosl = laerosl ) - deallocate( profiles,stat=alloc_status(1)) - If( any(alloc_status /= 0) ) then - errorstatus = errorstatus_fatal - Write( errMessage, '( "mem deallocation error for profiles")' ) - Call Rttov_ErrorReport (errorstatus, errMessage, NameOfRoutine) - Stop - End If - - EndDo - - DO no_id = 1, NRTTOVID - Call rttov_dealloc_coef (errorstatus, coef(no_id),coef_scatt_ir(no_id),optp(no_id)) - If(errorstatus /= errorstatus_success) Then - Write( errMessage, '( "deallocation error for coeffs")' ) - Call Rttov_ErrorReport (errorstatus, errMessage, NameOfRoutine) - Endif - EndDo - - END SUBROUTINE RTTOV_SUBCOLUMN -END MODULE MOD_COSP_RTTOV diff --git a/src/simulator/rttov/cosp_rttov11.F90 b/src/simulator/rttov/cosp_rttov11.F90 deleted file mode 100644 index 94d82379c5..0000000000 --- a/src/simulator/rttov/cosp_rttov11.F90 +++ /dev/null @@ -1,1060 +0,0 @@ -! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -! Copyright (c) 2016, Regents of the University of Colorado -! All rights reserved. -! -! Redistribution and use in source and binary forms, with or without modification, are -! permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of -! conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list -! of conditions and the following disclaimer in the documentation and/or other -! materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be -! used to endorse or promote products derived from this software without specific prior -! written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY -! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL -! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT -! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! History -! March 2016 - M. Johnston - Original version -! April 2016 - D. Swales - Modified for use in COSPv2.0 -! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -module mod_cosp_rttov - use rttov_const, only : errorstatus_success, errorstatus_fatal - use rttov_types, only : rttov_options,rttov_coefs,profile_type, & - transmission_type,radiance_type,rttov_chanprof, & - rttov_emissivity,profile_cloud_type,rttov_scatt_coef, & - rttov_options_scatt - use rttov_const, only : surftype_sea, surftype_land, surftype_seaice - use rttov_unix_env, only : rttov_exit - use cosp_kinds, only : wp - use mod_cosp_config, only : RTTOV_MAX_CHANNELS,N_HYDRO,rttovDir - use cosp_phys_constants, only : mdry=>amd,mO3=>amO3,mco2=>amCO2,mCH4=>amCH4, & - mn2o=>amN2O,mco=>amCO - implicit none -#include "rttov_direct.interface" -#include "rttov_alloc_prof.interface" -#include "rttov_alloc_rad.interface" -#include "rttov_alloc_transmission.interface" -#include "rttov_dealloc_coefs.interface" -#include "rttov_user_options_checkinput.interface" -#include "rttov_read_coefs.interface" -#include "rttov_get_emis.interface" -#include "rttov_boundaryconditions.interface" - - ! Module parameters - integer, parameter :: maxlim = 10000 - real(wp),parameter :: eps = 0.622 - - ! Initialization parameters - integer :: & - platform, & ! RTTOV platform - sensor, & ! RTTOV instrument - satellite, & ! RTTOV satellite - nChannels ! Number of channels - integer,dimension(RTTOV_MAX_CHANNELS) :: & - iChannel ! RTTOV channel numbers - - ! Scattering coefficients (read in once during initialization) - type(rttov_coefs) :: & - coef_rttov - type(rttov_scatt_coef) :: & - coef_scatt - ! RTTOV setup and options (set during initialization) - type(rttov_options) :: & - opts ! defaults to everything optional switched off - type(rttov_options_scatt) :: & - opts_scatt -contains - - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! SUBROUTINE rttov_column - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - subroutine rttov_column(nPoints,nLevels,nSubCols,q,p,t,o3,ph,h_surf,u_surf,v_surf, & - p_surf,t_skin,t2m,q2m,lsmask,lon,lat,seaice,co2,ch4,n2o,co, & - zenang,lCleanup, & - ! Outputs - Tb,error, & - ! Optional arguments for surface emissivity calculation. - surfem,month, & - ! Optional arguments for all-sky calculation. - tca,ciw,clw,rain,snow) - ! Inputs - integer,intent(in) :: & - nPoints, & ! Number of gridpoints - nLevels, & ! Number of vertical levels - nSubCols ! Number of subcolumns - real(wp),intent(in) :: & - co2, & ! CO2 mixing ratio (kg/kg) - ch4, & ! CH4 mixing ratio (kg/kg) - n2o, & ! N2O mixing ratio (kg/kg) - co, & ! CO mixing ratio (kg/kg) - zenang ! Satellite zenith angle - real(wp),dimension(nPoints),intent(in) :: & - h_surf, & ! Surface height (m) - u_surf, & ! Surface u-wind (m/s) - v_surf, & ! Surface v-wind (m/s) - p_surf, & ! Surface pressure (Pa) - t_skin, & ! Skin temperature (K) - t2m, & ! 2-meter temperature (K) - q2m, & ! 2-meter specific humidity (kg/kg) - lsmask, & ! Land/sea mask - lon, & ! Longitude (deg) - lat, & ! Latitude (deg) - seaice ! Seaice fraction (0-1) - real(wp),dimension(nPoints,nLevels),intent(in) :: & - q, & ! Specific humidity (kg/kg) - p, & ! Pressure(Pa) - t, & ! Temperature (K) - o3 ! Ozone - real(wp),dimension(nPoints,nLevels+1),intent(in) :: & - ph ! Pressure @ half-levels (Pa) - logical,intent(in) :: & - lCleanup ! Flag to determine whether to deallocate RTTOV types - - ! Optional inputs (Needed for surface emissivity calculation) - integer,optional :: & - month ! Month (needed to determine table to load) - real(wp),dimension(nChannels),optional :: & - surfem ! Surface emissivity for each RTTOV channel - - ! Optional inputs (Needed for all-sky calculation) - real(wp),dimension(nPoints,nLevels),optional :: & - tca ! Total column cloud amount (0-1) - real(wp),dimension(nPoints,nSubCols,nLevels),optional :: & - ciw, & ! Cloud ice - clw, & ! Cloud liquid - rain, & ! Precipitation flux (kg/m2/s) - snow ! Precipitation flux (kg/m2/s) - - ! Outputs - real(wp),dimension(nPoints,nChannels) :: & - Tb ! RTTOV brightness temperature. - character(len=128) :: & - error ! Error messages (only populated if error encountered) - - ! Local variables - integer :: & - nloop,rmod,il,istart,istop,za,i,j,subcol,errorstatus,npts_it - integer,dimension(60) :: & - alloc_status - real(wp),dimension(nPoints) :: & - sh_surf - real(wp),dimension(nPoints,nLevels) :: & - sh,totalice - real(wp),dimension(nSubCols,nPoints,nChannels) :: & - Tbs ! Subcolumn brightness temperature - logical :: & - use_totalice, mmr_snowrain, cfrac - logical :: & - lallSky, & ! Control for type of brightness temperature calculation - ! (False(default) => clear-sky brightness temperature, True => All-sky) - lsfcEmis ! Control for surface emissivity calculation (true => compute surface emissivity, - ! provided that the field "month" is available) - -#include "rttov_read_coefs.interface" -#include "rttov_read_scattcoeffs.interface" -#include "rttov_user_options_checkinput.interface" -#include "rttov_dealloc_coefs.interface" -#include "rttov_dealloc_scattcoeffs.interface" -#include "rttov_setup_emis_atlas.interface" -#include "rttov_deallocate_emis_atlas.interface" -#include "rttov_print_opts.interface" -#include "rttov_print_profile.interface" -#include "rttov_boundaryconditions.interface" - - ! Initialize some things - totalice = 0._wp - Tbs(:,:,:) = 0._wp - Tb(:,:) = 0._wp - error = '' - - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! Setup for call to RTTOV - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! First, check to see if we are doing an all-sky or clear-sky calculation brightness - ! temperature - lallSky = .false. - if (present(tca) .and. present(clw) .and. present(ciw) .and. present(rain) & - .and. present(snow)) lallSky=.true. - - ! Check to see if we need to compute the surface emissivity (defualt is to compute - ! surface emissivity using the atlas tables) - lsfcEmis = .true. - if (present(surfem)) lsfcEmis = .false. - - ! We also need the month for the emissivity atlas, so check... - if (.not. present(month)) lsfcEmis = .false. - - if (lsfcEmis .eq. .false. .and. .not. present(surfem)) then - error = 'ERROR (rttov_column): User did not provide surface emissivity and did not '//& - 'request the surface emissivity to be calculated!!!' - return - endif - - ! Convert specific humidity to ppmv - sh = ( q / ( q + eps * ( 1._wp - q ) ) ) * 1e6 - sh_surf = ( q2m / ( q2m + eps * ( 1._wp - q2m ) ) ) * 1e6 - - ! Settings unique to all-sky call. - use_totalice = .false. - mmr_snowrain = .true. - cfrac = .true. - opts_scatt%lusercfrac = cfrac - - ! RTTOV can handle only about 100 profiles at a time (fixme: check this with roger), - ! so we are putting a loop of 100 - nloop = npoints / maxlim - rmod = mod( npoints, maxlim ) - if( rmod .ne. 0 ) then - nloop = nloop + 1 - endif - - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! Initialize emissivity atlas data for chosen sensor. - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - call rttov_setup_emis_atlas(errorstatus,opts,month,coef_rttov,path=trim(rttovDir)//"emis_data/") - if (errorstatus /= errorstatus_success) then - error = 'ERROR (rttov_column): Error reading emis atlas data!' - return - endif - - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! Some quality control prior to RTTOV call - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! Ensure the options and coefficients are consistent - if(opts_scatt%config%do_checkinput) then - call rttov_user_options_checkinput(errorstatus, opts, coef_rttov) - if (errorstatus /= errorstatus_success) then - error = 'ERROR (rttov_column): Error when checking input data!' - return - endif - endif - - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! Call to RTTOV - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! Looping over maxlim number of profiles - do il = 1, nloop - istart = (il - 1) * maxlim + 1 - istop = min(il * maxlim, npoints) - if( ( il .eq. nloop ) .and. ( rmod .ne. 0 ) ) then - npts_it = rmod - else - npts_it = maxlim - endif - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! Clear-sky brightness temperature - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if (.not. lallSky) then - call rttov_multprof(nChannels,iChannel,surfem,npts_it,nLevels,platform, & - satellite,sensor,opts,coef_rttov,zenang, & - p(istart:istop,:)/100._wp,t(istart:istop,:), & - sh(istart:istop,:),(mdry/mo3)*o3(istart:istop,:)*1e6, & - (mdry/mco2)*co2*1e6,(mdry/mch4)*ch4*1e6,(mdry/mn2o)*n2o*1e6,& - (mdry/mco)*co*1e6,h_surf(istart:istop),u_surf(istart:istop),& - v_surf(istart:istop),t_skin(istart:istop), & - p_surf(istart:istop)/100.,t2m(istart:istop), & - sh_surf(istart:istop),lsmask(istart:istop), & - seaice(istart:istop),lat(istart:istop),lon(istart:istop), & - Tb(istart:istop,:)) - endif - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! All-sky brightness temperature - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if (lallSky) then - ! Loop over all subcolumns - do subcol = 1, nSubCols - ! Call RTTOV - call cosp_rttov_mwscatt(nChannels,iChannel,surfem,nPoints,nlevels,platform, & - satellite,sensor,opts,opts_scatt,coef_rttov, & - coef_scatt,zenang,p(istart:istop,:)/100._wp, & - ph(istart:istop,:)/100._wp,t(istart:istop, :), & - sh(istart:istop, :), & - (mdry/mo3)*o3(istart:istop,:)*1e6, & - clw(istart:istop,subcol,:), & - ciw(istart:istop,subcol,:),tca(istart:istop, :), & - totalice(istart:istop,:),snow(istart:istop,subcol,:),& - rain(istart:istop,subcol,:),(mdry/mco2)*co2*1e6, & - (mdry/mch4)*ch4*1e6,(mdry/mn2o)*n2o*1e6, & - (mdry/mco)*co*1e6,h_surf(istart:istop), & - u_surf(istart:istop),v_surf(istart:istop), & - t_skin(istart:istop), p_surf(istart:istop)/100., & - t2m(istart:istop),sh_surf(istart:istop), & - lsmask(istart:istop),seaice(istart:istop), & - lat(istart:istop),lon(istart:istop), use_totalice, & - mmr_snowrain,cfrac,Tbs(subcol,istart:istop,:)) - enddo - endif - enddo - - ! For all-sky calculation we need to average together all of the cloudy subcolumns. - if (lallSky) then - do subcol = 1, nSubCols - Tb = Tb + tbs(subcol,:,:) - enddo - Tb = Tb/nSubCols - endif - - ! Free up space - if (lCleanup) then - call rttov_dealloc_coefs(errorstatus,coef_rttov) - call rttov_deallocate_emis_atlas(coef_rttov) - if (lallSky) call rttov_dealloc_scattcoeffs(coef_scatt) - endif - end subroutine rttov_column - - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! SUBROUTINE rttov_multprof - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - subroutine rttov_multprof( & - nch_in, & ! number of channels - ichan_in, & ! channel indices - surfem_in, & ! surface emissivity values - prf_num_in, & ! number of profiles to simulate - nlevels_in, & ! number of pressure levels - plat_in, & ! platform number - sat_in, & ! satellite number - sens_in, & ! instrument number - opts, & - coef_rttov, & - zenang_in, & ! zenith angle - p_in, & ! pressure [hpa] - t_in, & ! temperature [ k ] - q_in, & ! specific humidity [ ppmv ] - o3_in, & ! ozone vmr [ ppmv ] - co2_in, & ! co2 vmr [ ppmv ] *this is a single value* - ch4_in, & ! ch4 vmr [ ppmv ] *this is a single value* - n2o_in, & ! n2o vmr [ ppmv ] *this is a single value* - co_in, & ! co vmr [ ppmv ] *this is a single value* - h_surf, & ! surface height [ m ] - u_surf, & ! u wind at 10 m [ m/s ] - v_surf, & ! v wind at 10 m [ m/s ] - t_skin, & ! skin temperatre [ k ] - p_surf, & ! surface pressure - t_surf, & ! 1.5 m temperature [ k ] - q_surf, & ! 1.5 m specific humidity [ ppmv ] - lsmask, & ! land sea mask - seaice, & ! seaice fraction - latitude, & ! latitude [ deg north ] - longitude, & ! longitude [ deg east ] - tbs & ! brightness temperature [ k ] (output) - ) - - !------ input arguments. no rttov kinds should be used here ----------------- - integer, intent(in) :: nch_in ! number of channels to be computed - integer, intent(in) :: ichan_in(nch_in) ! indices of selected channels - real(wp), intent(in) :: surfem_in(nch_in) ! surface emissivities for the channels - integer, intent(in) :: prf_num_in - integer, intent(in) :: nlevels_in - integer, intent(in) :: plat_in ! satellite platform - integer, intent(in) :: sat_in ! satellite number - integer, intent(in) :: sens_in ! satellite sensor - real(wp), intent(in) :: zenang_in ! satellite zenith angle - - type(rttov_options) :: opts - type(rttov_coefs) :: coef_rttov - - real(wp), intent(in) :: p_in(prf_num_in, nlevels_in) ! pressure profiles - real(wp), intent(in) :: t_in(prf_num_in, nlevels_in) ! temperature profiles - real(wp), intent(in) :: q_in(prf_num_in, nlevels_in) ! humidity profiles - real(wp), intent(in) :: o3_in(prf_num_in, nlevels_in) ! ozone profiles - - ! the following trace gases contain constant values - real(wp), intent(in) :: co2_in ! carbon dioxide - real(wp), intent(in) :: ch4_in ! methane - real(wp), intent(in) :: n2o_in ! n2o - real(wp), intent(in) :: co_in ! carbon monoxide - real(wp), intent(in) :: h_surf(prf_num_in) ! surface height - real(wp), intent(in) :: u_surf(prf_num_in) ! u component of surface wind - real(wp), intent(in) :: v_surf(prf_num_in) ! v component of surface wind - real(wp), intent(in) :: t_skin(prf_num_in) ! surface skin temperature - real(wp), intent(in) :: p_surf(prf_num_in) ! surface pressure - real(wp), intent(in) :: t_surf(prf_num_in) ! 1.5 m temperature - real(wp), intent(in) :: q_surf(prf_num_in) ! 1.5 m specific humidity - real(wp), intent(in) :: lsmask(prf_num_in) ! land-sea mask - real(wp), intent(in) :: seaice(prf_num_in) ! sea-ice fraction - real(wp), intent(in) :: latitude(prf_num_in) ! latitude - real(wp), intent(in) :: longitude(prf_num_in) ! longitude - - real(wp), intent(inout) :: tbs(prf_num_in, nch_in) ! tbs (in the right format) - - !------ local variables. use only rttov kinds or derived types. - ! logical variables are declared with the same kind - ! as integers, as they are affected inthe same way by flags like -qintsize=8 - - ! type(rttov_options) :: opts ! options structure - ! type(rttov_coefs), allocatable :: coefs(:) ! coefficients structure - type(rttov_chanprof), allocatable :: chanprof(:) ! input channel/profile list - type(profile_type), allocatable :: profiles(:) ! input profiles - logical, allocatable :: calcemis(:) ! flag to indicate calculation of emissivity within rttov - type(rttov_emissivity), allocatable :: emissivity(:) ! input/output surface emissivity - type(transmission_type) :: transmission ! output transmittances - type(radiance_type) :: radiance ! output radiances - - integer, allocatable :: instrument(:,:) ! instrument id (3 x n_instruments) - integer, allocatable :: nchan(:) ! number of channels per instrument - integer, allocatable :: ichan(:,:) ! channel list per instrument - - integer :: asw - integer :: mxchn - integer :: nrttovid ! maximum number of instruments - integer :: no_id ! instrument loop index - integer :: i, j, jch - integer :: nprof ! number of calls to rttov - integer :: nch ! intermediate variable - integer :: errorstatus - integer :: ich, ich_temp, nchanprof, nchannels, chan - integer :: alloc_status(60) - - real(wp), allocatable :: input_emissivity (:) - - character (len=14) :: nameofroutine = 'rttov_multprof' - - logical :: refrac, solrad, laerosl, lclouds, lsun, all_channels - - ! local variables for input arguments that need type casting to avoid type-mismatch with - ! rttov kinds. this happens with some compiler flags (-qintsize=8). - integer :: prof_num - integer :: nlevels - - ! -------------------------------------------------------------------------- - ! 0. initialise cosp-specific things - ! -------------------------------------------------------------------------- - - ! type-casting of input arguments that need to be passed to rttov - prof_num = prf_num_in - nlevels = nlevels_in - nprof = prof_num - - ! currently we plan to calculate only 1 instrument per call - nrttovid = 1 - mxchn = nch_in - - errorstatus = 0 - alloc_status(:) = 0 - - ! allocate(coefs(nrttovid), stat = alloc_status(1)) - - ! allocate(instrument(3, nrttovid), stat = alloc_status(4)) - - !maximum number of channels allowed for one instrument is mxchn - ! allocate(surfem(nch_in, nrttovid), stat = alloc_status(11)) - allocate(ichan(nch_in, nrttovid), stat = alloc_status(12)) - call rttov_error('ichan mem allocation error for profile array' , lalloc = .true.) - - - do no_id = 1, nrttovid - ichan(:, no_id) = ichan_in - enddo - - asw = 1 ! switch for allocation passed into rttov subroutines - - ! allocate input profile arrays - allocate(profiles(nprof), stat = alloc_status(1)) - call rttov_error('Profile mem allocation error' , lalloc = .true.) - - call rttov_alloc_prof( & - errorstatus, & - nprof, & - profiles, & - nlevels, & - opts, & - asw, & - coefs = coef_rttov, & - init = .true.) - call rttov_error('Profile 2 mem allocation error' , lalloc = .true.) - ! -------------------------------------------------------------------------- - ! 5. store profile data in profile type - ! -------------------------------------------------------------------------- - do i = 1, nprof - profiles(i)%p(:) = p_in(i, :) - profiles(i)%t(:) = t_in(i, :) - profiles(i)%q(:) = q_in(i, :) - - where(profiles(i)%q(:) < 1e-4) - profiles(i)%q(:) = 1e-4 - end where - - profiles(i)%cfraction = 0. - profiles(i)%ctp = 500. - - ! 2m parameters - profiles(i)%s2m%p = p_surf(i) - profiles(i)%s2m%t = t_surf(i) - profiles(i)%s2m%q = q_surf(i) - profiles(i)%s2m%u = u_surf(i) ! dar: hard-coded at 2ms-1? - profiles(i)%s2m%v = v_surf(i) ! dar: hard-coded at 2ms-1? - profiles(i)%s2m%wfetc = 10000. ! dar: default? - - ! skin variables for emissivity calculations - profiles(i)%skin%t = t_skin(i) - - ! fastem coefficients - for mw calculations - profiles(i)%skin%fastem(1) = 3.0 - profiles(i)%skin%fastem(2) = 5.0 - profiles(i)%skin%fastem(3) = 15.0 - profiles(i)%skin%fastem(4) = 0.1 - profiles(i)%skin%fastem(5) = 0.3 - - profiles(i)%zenangle = zenang_in ! pass in from cosp - - profiles(i)%azangle = 0. ! hard-coded in rttov9 int - - profiles(i)%latitude = latitude(i) - profiles(i)%longitude = longitude(i) - profiles(i)%elevation = h_surf(i) - - profiles(i)%sunzenangle = 0. ! hard-coded in rttov9 int - profiles(i)%sunazangle = 0. ! hard-coded in rttov9 int - - ! surface type - ! land-sea mask indicates proportion of land in grid - if (lsmask(i) < 0.5) then - profiles(i)%skin%surftype = surftype_sea - else - profiles(i)%skin%surftype = surftype_land - endif - ! sea-ice fraction - if (seaice(i) >= 0.5) then - profiles(i)%skin%surftype = surftype_seaice - endif - - ! dar: hard-coded to 1 (=ocean water) in rttov 9 int - profiles(i)%skin%watertype = 1 - profiles(i) %idg = 0. - profiles(i) %ish = 0. - enddo - ! end of 5. - - ich_temp = 1 - nchannels = nch_in - do no_id = 1, nrttovid - - ! -------------------------------------------------------------------------- - ! 3. build the list of profile/channel indices in chanprof - ! -------------------------------------------------------------------------- - - allocate(nchan(nprof)) ! number of channels per profile - nchan(:) = size(ichan(:,no_id)) ! = nch_in - - ! size of chanprof array is total number of channels over all profiles - ! square in this case - here same channels done for all profiles - nchanprof = sum(nchan(:)) - - ! pack channels and input emissivity arrays - allocate(chanprof(nchanprof)) - ! allocate(emis(nchanprof)) - chanprof(:)%chan =0 - - nch = 0 - do j = 1, nprof - do jch = 1, nchan(j) - nch = nch + 1 - chanprof(nch)%prof = j - if(ichan(jch, no_id) < 1) then - errorstatus = errorstatus_fatal - call rttov_error('Sensor channel number must be 1 or greater' , lalloc = .true.) - else - chanprof(nch)%chan = ichan(jch, no_id) - endif - enddo - enddo - ! end of 3. - - ! allocate output radiance arrays - call rttov_alloc_rad( & - errorstatus, & - nchanprof, & - radiance, & - nlevels - 1, & ! nlayers - asw) - call rttov_error('allocation error for radiance arrays' , lalloc = .true.) - - ! allocate transmittance structure - call rttov_alloc_transmission( & - errorstatus, & - transmission, & - nlevels - 1, & - nchanprof, & - asw, & - init=.true.) - call rttov_error('allocation error for transmission arrays' , lalloc = .true.) - - ! allocate arrays for surface emissivity - allocate(calcemis(nchanprof), stat=alloc_status(1)) - allocate(emissivity(nchanprof), stat=alloc_status(2)) - call rttov_error('mem allocation error for emissivity arrays' , lalloc = .true.) - - call rttov_get_emis( & - & errorstatus, & - & opts, & - & chanprof, & - & profiles, & - & coef_rttov, & - !& resolution=resolution, & ! *** MW atlas native - ! resolution is 0.25 degree lat/lon; if you know better - ! value for satellite footprint (larger than this) then - ! you can specify it here - & emissivity=emissivity(:)%emis_in) - ! & emissivity(:)%emis_in) - - call rttov_error('Get emissivity error' , lalloc = .true.) - calcemis(:) = .false. - ! calculate emissivity for missing and ocean location (fastem) - where (emissivity(:)%emis_in <= 0.0) - calcemis(:) = .true. - endwhere - - call rttov_direct( & - errorstatus, &! out - chanprof, & - opts, & - profiles, &! in - coef_rttov, &! in - transmission, &! out - radiance, & - calcemis = calcemis, &! in - emissivity = emissivity) ! inout - call rttov_error('rttov_direct error', lalloc = .true.) - - tbs(1:prof_num , ich_temp:ich_temp + size(ichan(:,no_id)) - 1) = & - transpose(reshape(radiance%bt(1:nchanprof), (/ size(ichan(:,no_id)), prof_num/) )) - - ich_temp = ich_temp + size(ichan(:,no_id)) - - ! -------------------------------------------------------------------------- - ! 8. deallocate all rttov arrays and structures - ! -------------------------------------------------------------------------- - deallocate (nchan, stat=alloc_status(3)) - deallocate (chanprof, stat=alloc_status(4)) - deallocate (emissivity, stat=alloc_status(5)) - deallocate (calcemis, stat=alloc_status(6)) - call rttov_error('rttov array deallocation error', lalloc = .true.) - - asw = 0 ! switch for deallocation passed into rttov subroutines - - ! deallocate radiance arrays - call rttov_alloc_rad(errorstatus, nchannels, radiance, nlevels - 1, asw) - call rttov_error('radiance deallocation error', lalloc = .true.) - - ! deallocate transmission arrays - call rttov_alloc_transmission(errorstatus, transmission, nlevels - 1, nchannels, asw) - call rttov_error('transmission deallocation error', lalloc = .true.) - - enddo - - ! deallocate profile arrays - call rttov_alloc_prof(errorstatus, nprof, profiles, nlevels, opts, asw) - call rttov_error('profile deallocation error', lalloc = .true.) - - deallocate(profiles, stat=alloc_status(1)) - call rttov_error('mem deallocation error for profile array', lalloc= .true.) - - contains - - subroutine rttov_error(msg, lalloc) - character(*) :: msg - logical :: lalloc - - if(lalloc) then - if (any(alloc_status /= 0)) then - write(*,*) msg - errorstatus = 1 - call rttov_exit(errorstatus) - endif - else - if (errorstatus /= errorstatus_success) then - write(*,*) msg - call rttov_exit(errorstatus) - endif - endif - end subroutine rttov_error - - end subroutine rttov_multprof - !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - !----------------- subroutine cosp_rttov_mwscatt --------------- - !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - subroutine cosp_rttov_mwscatt(& - nch_in, & ! number of channels - ichan_in, & ! channel indices - surfem_in, & ! surface emissivity values - prf_num_in, & ! number of profiles to simulate - nlevels_in, & ! number of pressure levels - plat_in, & ! platform number - sat_in, & ! satellite number - sens_in, & ! instrument number - opts, & - opts_scatt, & - coef_rttov, & - coef_scatt, & - zenang_in, & ! zenith angle - p_in, & ! pressure [hpa] - ph_in, & ! pressure on half levels [hpa] - t_in, & ! temperature [ k ] - q_in, & ! specific humidity [ ppmv ] - o3_in, & ! ozone vmr [ ppmv ] - clw_in, & ! cloud water [0-1] - ciw_in, & ! cloud ice [0-1] - cc_in, & ! effective cloud fraction [0-1] - totalice_in,& ! total ice, except snow [kg/kg] or [kg/m2/s] - sp_in, & ! solid precip with snow [kg/kg] or [kg/m2/s] - rain_in, & ! total liquid water [kg/kg] or [kg/m2/s] - co2_in, & ! co2 vmr [ ppmv ] *this is a single value* - ch4_in, & ! ch4 vmr [ ppmv ] *this is a single value* - n2o_in, & ! n2o vmr [ ppmv ] *this is a single value* - co_in, & ! co vmr [ ppmv ] *this is a single value* - h_surf, & ! surface height [ m ] - u_surf, & ! u wind at 10 m [ m/s ] - v_surf, & ! v wind at 10 m [ m/s ] - t_skin, & ! skin temperatre [ k ] - p_surf, & ! surface pressure - t_surf, & ! 1.5 m temperature [ k ] - q_surf, & ! 1.5 m specific humidity [ ppmv ] - lsmask, & ! land sea mask - seaice, & ! seaice fraction - latitude, & ! latitude [ deg north ] - longitude, & ! longitude [ deg east ] - use_totalice,& ! separate ice and snow, or total ice hydrometeor types - mmr_snowrain,& ! set units for snow and rain: if true units are kg/kg (the default) - cfrac, & ! opts_scatt%lusercfrac=true., supply the effective cloud fraction - tbs & ! brightness temperature [ k ] (output) - ) - - - - - - implicit none - - !------ input arguments. no rttov kinds should be used here ----------------- - integer, intent(in) :: nch_in ! number of channels to be computed - integer, intent(in) :: ichan_in(nch_in) ! indices of selected channels - real(wp), intent(in) :: surfem_in(nch_in) ! surface emissivities for the channels - integer, intent(in) :: prf_num_in - integer, intent(in) :: nlevels_in - integer, intent(in) :: plat_in ! satellite platform - integer, intent(in) :: sat_in ! satellite number - integer, intent(in) :: sens_in ! satellite sensor - real(wp), intent(in) :: zenang_in ! satellite zenith angle - - type(rttov_options) :: opts - type(rttov_options_scatt) :: opts_scatt - type(rttov_coefs) :: coef_rttov - type(rttov_scatt_coef) :: coef_scatt - - real(wp), intent(in) :: p_in(prf_num_in, nlevels_in) ! pressure profiles - real(wp), intent(in) :: t_in(prf_num_in, nlevels_in) ! temperature profiles - real(wp), intent(in) :: q_in(prf_num_in, nlevels_in) ! humidity profiles - real(wp), intent(in) :: o3_in(prf_num_in, nlevels_in) ! ozone profiles - real(wp), intent(in) :: clw_in(prf_num_in, nlevels_in) - real(wp), intent(in) :: ciw_in(prf_num_in, nlevels_in) - real(wp), intent(in) :: cc_in(prf_num_in, nlevels_in) - real(wp), intent(in) :: totalice_in(prf_num_in, nlevels_in) - real(wp), intent(in) :: sp_in(prf_num_in, nlevels_in) - real(wp), intent(in) :: rain_in(prf_num_in, nlevels_in) - real(wp), intent(in) :: ph_in(prf_num_in, nlevels_in+1) - - ! the following trace gases contain constant values - real(wp), intent(in) :: co2_in ! carbon dioxide - real(wp), intent(in) :: ch4_in ! methane - real(wp), intent(in) :: n2o_in ! n2o - real(wp), intent(in) :: co_in ! carbon monoxide - real(wp), intent(in) :: h_surf(prf_num_in) ! surface height - real(wp), intent(in) :: u_surf(prf_num_in) ! u component of surface wind - real(wp), intent(in) :: v_surf(prf_num_in) ! v component of surface wind - real(wp), intent(in) :: t_skin(prf_num_in) ! surface skin temperature - real(wp), intent(in) :: p_surf(prf_num_in) ! surface pressure - real(wp), intent(in) :: t_surf(prf_num_in) ! 1.5 m temperature - real(wp), intent(in) :: q_surf(prf_num_in) ! 1.5 m specific humidity - real(wp), intent(in) :: lsmask(prf_num_in) ! land-sea mask - real(wp), intent(in) :: seaice(prf_num_in) ! seaice fraction - real(wp), intent(in) :: latitude(prf_num_in) ! latitude - real(wp), intent(in) :: longitude(prf_num_in) ! longitude - logical, intent(in) :: cfrac, use_totalice, mmr_snowrain - - real(wp), intent(inout) :: tbs(prf_num_in, nch_in) ! tbs (in the right format) - !****************** local variables ********************************************** - logical , allocatable :: calcemis (:) - type(rttov_emissivity) , allocatable :: emissivity (:) - integer , allocatable :: frequencies (:) - type(rttov_chanprof) , allocatable :: chanprof (:) ! channel and profile indices - type(profile_type) , allocatable :: profiles (:) - type(profile_cloud_type) , allocatable :: cld_profiles(:) - - integer, allocatable :: ichan(:,:) ! channel list per instrument - - integer :: errorstatus - type (radiance_type) :: radiance - ! type (rttov_options) :: opts ! defaults to everything optional switched off - ! type (rttov_options_scatt) :: opts_scatt - ! type (rttov_coefs) :: coef_rttov - ! type (rttov_scatt_coef) :: coef_scatt - - ! integer, allocatable :: instrument (:,:) - integer :: j,k,asw - integer :: nchanxnprof, ninstruments - real(wp) :: zenangle - character (len=256) :: outstring - integer :: alloc_status(60) - -#include "rttov_init_rad.interface" -#include "rttov_scatt_setupindex.interface" -#include "rttov_scatt.interface" -#include "rttov_alloc_rad.interface" -#include "rttov_alloc_prof.interface" -#include "rttov_alloc_scatt_prof.interface" -#include "rttov_get_emis.interface" -#include "rttov_boundaryconditions.interface" - - errorstatus = 0 - alloc_status(:) = 0 - ninstruments = 1 ! number of sensors or platforms - - allocate(ichan(nch_in, ninstruments), stat = alloc_status(3)) - - do j = 1, ninstruments - ichan(:, j) = ichan_in - enddo - - nchanxnprof = prf_num_in * nch_in ! total channels to simulate * profiles - - allocate (chanprof(nchanxnprof)) - allocate (frequencies(nchanxnprof)) - allocate (emissivity(nchanxnprof)) - allocate (calcemis(nchanxnprof)) - allocate (profiles(prf_num_in)) - allocate (cld_profiles(prf_num_in)) - - ! request rttov / fastem to calculate surface emissivity - calcemis = .true. - emissivity % emis_in = 0.0 - - ! setup indices - call rttov_scatt_setupindex ( & - & prf_num_in, & ! in - & nch_in, & ! in - & coef_rttov%coef, & ! in - & nchanxnprof, & ! in - & chanprof, & ! out - & frequencies) ! out - - ! allocate profiles (input) and radiance (output) structures - asw = 1 - call rttov_alloc_prof( errorstatus,prf_num_in,profiles,nlevels_in,opts,asw, init = .true.) - call rttov_alloc_scatt_prof(prf_num_in,cld_profiles, nlevels_in, .false., 1, init = .true.) - call rttov_alloc_rad(errorstatus,nchanxnprof,radiance,nlevels_in-1,asw) - - ! fill the profile structures with data - do j = 1, prf_num_in - profiles(j)%latitude = latitude(j) - profiles(j)%longitude = longitude(j) - profiles(j)%elevation = h_surf(j) - profiles(j)%sunzenangle = 0.0 ! hard-coded in rttov9 int - profiles(j)%sunazangle = 0.0 ! hard-coded in rttov9 int - profiles(j)%azangle = 0.0 - profiles(j)%zenangle = zenang_in - profiles(j)%s2m%t = t_surf(j) - profiles(j)%s2m%q = q_surf(j) - profiles(j)%s2m%u = u_surf(j) - profiles(j)%s2m%v = v_surf(j) - profiles(j)%s2m%wfetc = 10000. - profiles(j)%skin%t = t_skin(j) - profiles(j)%skin%watertype = 1 ! ocean water - if (lsmask(j) < 0.5) then - profiles(j)%skin%surftype = surftype_sea - else - profiles(j)%skin%surftype = surftype_land - endif - if (seaice(j) >= 0.5) then - profiles(j)%skin%surftype = surftype_seaice - endif - profiles(j)%skin%fastem(1) = 3.0 - profiles(j)%skin%fastem(2) = 5.0 - profiles(j)%skin%fastem(3) = 15.0 - profiles(j)%skin%fastem(4) = 0.1 - profiles(j)%skin%fastem(5) = 0.3 - profiles(j)%cfraction = 0.0 - profiles(j)%ctp = 500.0 ! not used but still required by rttov - profiles(j)%p(:) = p_in(j,:) - profiles(j)%t(:) = t_in(j,:) - profiles(j)%q(:) = q_in(j,:) - profiles(j)%idg = 0. - profiles(j)%ish = 0. - where(profiles(j)%q(:) < 1e-4) - profiles(j)%q(:) = 1e-4 - end where - cld_profiles(j)%ph(:) = ph_in(j,:) - cld_profiles(j)%cc(:) = cc_in(j,:) - cld_profiles(j)%clw(:) = clw_in(j,:) - cld_profiles(j)%ciw(:) = ciw_in(j,:) - cld_profiles(j)%rain(:) = rain_in(j,:) - cld_profiles(j)%sp(:) = sp_in(j,:) - profiles(j)%s2m%p = cld_profiles(j)%ph(nlevels_in+1) - enddo - - call rttov_get_emis( & - & errorstatus, & - & opts, & - & chanprof, & - & profiles, & - & coef_rttov, & - ! & resolution=resolution, & ! *** MW atlas native resolution is - ! 0.25 degree lat/lon; if you know better value for satellite - ! footprint (larger than this) then you can specify it here - & emissivity=emissivity(:)%emis_in) - if (errorstatus /= errorstatus_success) then - write(*,*) 'In COSP_RTTOV11: Error RTTOV_GET_EMIS!' - call rttov_exit(errorstatus) - endif - - calcemis(:) = .false. - where (emissivity(:)%emis_in <= 0.) - calcemis(:) = .true. - endwhere - - call rttov_scatt (& - & errorstatus, &! out - & opts_scatt, &! in - & nlevels_in, &! in - & chanprof, &! in - & frequencies, &! in - & profiles, &! in - & cld_profiles, &! in - & coef_rttov, &! in - & coef_scatt, &! in - & calcemis, &! in - & emissivity, &! in - & radiance) ! out - - if (errorstatus /= errorstatus_success) then - write(*,*) 'In COSP_RTTOV11: Error RTTOV_SCATT!' - call rttov_exit(errorstatus) - endif - - !write(*,*) 'Checking emissivities: ', maxval(emissivity(:)%emis_out), \ - ! minval(emissivity(:)%emis_out) - tbs(1:prf_num_in,1:1+size(ichan(:,1))-1) = & - transpose(reshape(radiance%bt(1:nchanxnprof),(/ size(ichan(:,1)),prf_num_in/) )) - - ! deallocate all storage - asw = 0 - ! call rttov_dealloc_coefs(errorstatus,coef_rttov) - ! call rttov_dealloc_scattcoeffs(coef_scatt) - call rttov_alloc_prof(errorstatus,prf_num_in,profiles,nlevels_in,opts,asw) - call rttov_alloc_scatt_prof(prf_num_in,cld_profiles,nlevels_in,.false.,asw) - call rttov_alloc_rad(errorstatus,nchanxnprof,radiance,nlevels_in-1,asw) - deallocate(ichan,chanprof,frequencies,emissivity,calcemis) !instrument, - !*************************************************************************** - !-------- end section -------- - !*************************************************************************** - end subroutine cosp_rttov_mwscatt - function construct_rttov_coeffilename(platform,satellite,instrument) - ! Inputs - integer,intent(in) :: platform,satellite,instrument - ! Outputs - character(len=256) :: construct_rttov_coeffilename - ! Local variables - character(len=256) :: coef_file - integer :: error - - ! Initialize - error = 0 - - ! Platform - if (platform .eq. 1) coef_file = 'rtcoef_noaa_' - if (platform .eq. 10) coef_file = 'rtcoef_metop_' - if (platform .eq. 11) coef_file = 'rtcoef_envisat_' - if (platform .ne. 1 .and. platform .ne. 10 .and. platform .ne. 11) then - error=error+1 - write ( *,* ) 'Unsupported platform ID ',platform - return - endif - - ! Satellite - if (satellite .lt. 10) then - coef_file = trim(coef_file) // char(satellite+48) - else if (satellite .lt. 100) then - coef_file = trim(coef_file) // char(int(satellite/10)+48) - coef_file = trim(coef_file) // char(satellite-int(satellite/10)*10+48) - else - error=error+1 - write ( *,* ) 'Unsupported satellite number ',satellite - return - endif - - ! Sensor - if (sensor .eq. 3) coef_file = trim(coef_file) // '_amsua.dat' - if (sensor .eq. 5) coef_file = trim(coef_file) // '_avhrr.dat' - if (sensor .eq. 49) coef_file = trim(coef_file) // '_mwr.dat' - if (sensor .ne. 3 .and. sensor .ne. 5 .and. sensor .ne. 49) then - error=error+1 - write ( *,* ) 'Unsupported sensor number ', sensor - return - endif - - if (error .eq. 0) construct_rttov_coeffilename=coef_file - - end function construct_rttov_coeffilename - function construct_rttov_scatfilename(platform,satellite,instrument) - ! Inputs - integer,intent(in) :: platform,satellite,instrument - ! Outputs - character(len=256) :: construct_rttov_scatfilename - ! Local variables - character(len=256) :: coef_file - integer :: error - - ! Initialize - error = 0 - - ! Platform - if (platform .eq. 1) coef_file = 'sccldcoef_noaa_' - if (platform .eq. 10) coef_file = 'sccldcoef_metop_' - if (platform .eq. 11) coef_file = 'sccldcoef_envisat_' - if (platform .ne. 1 .and. platform .ne. 10 .and. platform .ne. 11) then - error=error+1 - write ( *,* ) 'Unsupported platform ID ',platform - return - endif - - ! Satellite - if (satellite .lt. 10) then - coef_file = trim(coef_file) // char(satellite+48) - else if (satellite .lt. 100) then - coef_file = trim(coef_file) // char(int(satellite/10)+48) - coef_file = trim(coef_file) // char(satellite-int(satellite/10)*10+48) - else - error=error+1 - write ( *,* ) 'Unsupported satellite number ',satellite - return - endif - - ! Sensor - if (sensor .eq. 3) coef_file = trim(coef_file) // '_amsua.dat' - if (sensor .eq. 5) coef_file = trim(coef_file) // '_avhrr.dat' - if (sensor .eq. 49) coef_file = trim(coef_file) // '_mwr.dat' - if (sensor .ne. 3 .and. sensor .ne. 5 .and. sensor .ne. 49) then - error=error+1 - write ( *,* ) 'Unsupported sensor number ', sensor - return - endif - - if (error .eq. 0) construct_rttov_scatfilename=coef_file - - end function construct_rttov_scatfilename - -end module mod_cosp_rttov diff --git a/src/simulator/rttov/cosp_rttovSTUB.F90 b/src/simulator/rttov/cosp_rttovSTUB.F90 index 73a0018362..3b1ecdbdbf 100644 --- a/src/simulator/rttov/cosp_rttovSTUB.F90 +++ b/src/simulator/rttov/cosp_rttovSTUB.F90 @@ -32,9 +32,10 @@ MODULE MOD_COSP_RTTOV use cosp_kinds, only : wp - use mod_cosp_config, only : RTTOV_MAX_CHANNELS,N_HYDRO,rttovDir + use mod_cosp_config, only : N_HYDRO use cosp_phys_constants, only : mdry=>amd,mO3=>amO3,mco2=>amCO2,mCH4=>amCH4, & mn2o=>amN2O,mco=>amCO + IMPLICIT NONE ! Module parameters @@ -43,170 +44,60 @@ MODULE MOD_COSP_RTTOV ! Initialization parameters integer :: & - platform, & ! RTTOV platform - sensor, & ! RTTOV instrument - satellite, & ! RTTOV satellite nChannels ! Number of channels - integer,dimension(RTTOV_MAX_CHANNELS) :: & - iChannel ! RTTOV channel numbers -CONTAINS - subroutine rttov_column(nPoints,nLevels,nSubCols,q,p,t,o3,ph,h_surf,u_surf,v_surf, & - p_surf,t_skin,t2m,q2m,lsmask,lon,lat,seaice,co2,ch4,n2o,co, & - zenang,lCleanup, & - ! Outputs - Tb,error, & - ! Optional arguments for surface emissivity calculation. - surfem,month, & - ! Optional arguments for all-sky calculation. - tca,ciw,clw,rain,snow) - ! Inputs - integer,intent(in) :: & - nPoints, & ! Number of gridpoints - nLevels, & ! Number of vertical levels - nSubCols ! Number of subcolumns - real(wp),intent(in) :: & - co2, & ! CO2 mixing ratio (kg/kg) - ch4, & ! CH4 mixing ratio (kg/kg) - n2o, & ! N2O mixing ratio (kg/kg) - co, & ! CO mixing ratio (kg/kg) - zenang ! Satellite zenith angle - real(wp),dimension(nPoints),intent(in) :: & - h_surf, & ! Surface height (m) - u_surf, & ! Surface u-wind (m/s) - v_surf, & ! Surface v-wind (m/s) - p_surf, & ! Surface pressure (Pa) - t_skin, & ! Skin temperature (K) - t2m, & ! 2-meter temperature (K) - q2m, & ! 2-meter specific humidity (kg/kg) - lsmask, & ! Land/sea mask - lon, & ! Longitude (deg) - lat, & ! Latitude (deg) - seaice ! Seaice fraction (0-1) - real(wp),dimension(nPoints,nLevels),intent(in) :: & - q, & ! Specific humidity (kg/kg) - p, & ! Pressure(Pa) - t, & ! Temperature (K) - o3 ! Ozone - real(wp),dimension(nPoints,nLevels+1),intent(in) :: & - ph ! Pressure @ half-levels (Pa) - logical,intent(in) :: & - lCleanup ! Flag to determine whether to deallocate RTTOV types + integer,allocatable,dimension(:) :: & + iChannel + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! TYPE rttov_IN - Data type specific to inputs required by RTTOV + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + type rttov_IN + integer,pointer :: & ! JKS trying this + nPoints, & ! Number of profiles to simulate + nLevels, & ! Number of levels + nSubCols ! Number of subcolumns + real(kind=wp),pointer :: & + emis_grey => null() + integer,dimension(:),pointer :: & + month +! real(wp),dimension(:),pointer :: & +! surfem ! Surface emissivities for the channels +! refl, & ! Surface reflectances for the channels + real(wp),dimension(:),pointer :: & + h_surf, & ! Surface height + u_surf, & ! U component of surface wind + v_surf, & ! V component of surface wind + t_skin, & ! Surface skin temperature + p_surf, & ! Surface pressure + t2m => null(), & ! 2 m Temperature + q2m => null(), & ! 2 m Specific humidity + sfcmask, & ! sea-land-ice mask (0=sea, 1=land, 2=seaice) + latitude, & ! Latitude (degrees) + longitude, & ! Longitude (degrees) + time_frac, & ! Fractional UTC time [0-1] + sza => null() ! Solar zenith angle (deg) + real(wp),dimension(:,:),pointer :: & + p, & ! Pressure @ model levels + ph, & ! Pressure @ model half levels + t, & ! Temperature + q, & ! Specific humidity + o3, & ! Ozone + co2, & ! Carbon dioxide + ch4, & ! Methane + n2o, & ! n2o + co, & ! Carbon monoxide + so2, & ! Sulfur dioxide + rttov_date, & ! Date of the profile as year (e.g. 2013), month (1-12), and day (1-31) + rttov_time, & ! Time of profile as hour, minute, second. + ! These fields below are needed ONLY for the RTTOV all-sky brightness temperature + tca, & ! Cloud fraction + cldIce, & ! Cloud ice + cldLiq, & ! Cloud liquid + DeffIce, & ! Cloud ice effective diameter (um) + DeffLiq, & ! Cloud liquid effective diameter (um) + fl_rain, & ! Precipitation flux (startiform+convective rain) (kg/m2/s) + fl_snow ! Precipitation flux (stratiform+convective snow) + end type rttov_IN - ! Optional inputs (Needed for surface emissivity calculation) - integer,optional :: & - month ! Month (needed to determine table to load) - real(wp),dimension(nChannels),optional :: & - surfem ! Surface emissivity for each RTTOV channel - - ! Optional inputs (Needed for all-sky calculation) - real(wp),dimension(nPoints,nLevels),optional :: & - tca ! Total column cloud amount (0-1) - real(wp),dimension(nPoints,nSubCols,nLevels),optional :: & - ciw, & ! Cloud ice - clw, & ! Cloud liquid - rain, & ! Precipitation flux (kg/m2/s) - snow ! Precipitation flux (kg/m2/s) - - ! Outputs - real(wp),dimension(nPoints,nChannels) :: & - Tb ! RTTOV brightness temperature. - character(len=128) :: & - error ! Error messages (only populated if error encountered) - - end subroutine rttov_column - function construct_rttov_coeffilename(platform,satellite,instrument) - ! Inputs - integer,intent(in) :: platform,satellite,instrument - ! Outputs - character(len=256) :: construct_rttov_coeffilename - ! Local variables - character(len=256) :: coef_file - integer :: error - - ! Initialize - error = 0 - - ! Platform - if (platform .eq. 1) coef_file = 'rtcoef_noaa_' - if (platform .eq. 10) coef_file = 'rtcoef_metop_' - if (platform .eq. 11) coef_file = 'rtcoef_envisat_' - if (platform .ne. 1 .and. platform .ne. 10 .and. platform .ne. 11) then - error=error+1 - write ( *,* ) 'Unsupported platform ID ',platform - return - endif - - ! Satellite - if (satellite .lt. 10) then - coef_file = trim(coef_file) // char(satellite+48) - else if (satellite .lt. 100) then - coef_file = trim(coef_file) // char(int(satellite/10)+48) - coef_file = trim(coef_file) // char(satellite-int(satellite/10)*10+48) - else - error=error+1 - write ( *,* ) 'Unsupported satellite number ',satellite - return - endif - - ! Sensor - if (sensor .eq. 3) coef_file = trim(coef_file) // '_amsua.dat' - if (sensor .eq. 5) coef_file = trim(coef_file) // '_avhrr.dat' - if (sensor .eq. 49) coef_file = trim(coef_file) // '_mwr.dat' - if (sensor .ne. 3 .and. sensor .ne. 5 .and. sensor .ne. 49) then - error=error+1 - write ( *,* ) 'Unsupported sensor number ', sensor - return - endif - - if (error .eq. 0) construct_rttov_coeffilename=coef_file - - end function construct_rttov_coeffilename - function construct_rttov_scatfilename(platform,satellite,instrument) - ! Inputs - integer,intent(in) :: platform,satellite,instrument - ! Outputs - character(len=256) :: construct_rttov_scatfilename - ! Local variables - character(len=256) :: coef_file - integer :: error - - ! Initialize - error = 0 - - ! Platform - if (platform .eq. 1) coef_file = 'sccldcoef_noaa_' - if (platform .eq. 10) coef_file = 'sccldcoef_metop_' - if (platform .eq. 11) coef_file = 'sccldcoef_envisat_' - if (platform .ne. 1 .and. platform .ne. 10 .and. platform .ne. 11) then - error=error+1 - write ( *,* ) 'Unsupported platform ID ',platform - return - endif - - ! Satellite - if (satellite .lt. 10) then - coef_file = trim(coef_file) // char(satellite+48) - else if (satellite .lt. 100) then - coef_file = trim(coef_file) // char(int(satellite/10)+48) - coef_file = trim(coef_file) // char(satellite-int(satellite/10)*10+48) - else - error=error+1 - write ( *,* ) 'Unsupported satellite number ',satellite - return - endif - - ! Sensor - if (sensor .eq. 3) coef_file = trim(coef_file) // '_amsua.dat' - if (sensor .eq. 5) coef_file = trim(coef_file) // '_avhrr.dat' - if (sensor .eq. 49) coef_file = trim(coef_file) // '_mwr.dat' - if (sensor .ne. 3 .and. sensor .ne. 5 .and. sensor .ne. 49) then - error=error+1 - write ( *,* ) 'Unsupported sensor number ', sensor - return - endif - - if (error .eq. 0) construct_rttov_scatfilename=coef_file - - end function construct_rttov_scatfilename END MODULE MOD_COSP_RTTOV diff --git a/src/simulator/rttov/cosp_rttov_v13.F90 b/src/simulator/rttov/cosp_rttov_v13.F90 new file mode 100644 index 0000000000..58d92f7abe --- /dev/null +++ b/src/simulator/rttov/cosp_rttov_v13.F90 @@ -0,0 +1,1626 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2016, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History +! March 2016 - M. Johnston - Original version +! April 2016 - D. Swales - Modified for use in COSPv2.0 +! JKS fill this in when working :) + +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +module mod_cosp_rttov +! Use RTTOV v13 types here, more may be needed + use rttov_types, only : rttov_options,rttov_coefs,rttov_profile, & + rttov_transmission,rttov_radiance,rttov_chanprof, & + rttov_emissivity,rttov_reflectance,rttov_opt_param, & + rttov_pccomp + use rttov_const, only : surftype_sea, surftype_land, surftype_seaice, & + errorstatus_success,errorstatus_fatal, & + platform_name,inst_name, & + sensor_id_mw,sensor_id_po + use rttov_unix_env, only : rttov_exit + use cosp_kinds, only : wp + use mod_cosp_config, only : N_HYDRO + use cosp_phys_constants, only : mdry=>amd,mH2O=>amw,mO3=>amO3,mCO2=>amCO2, & + mCH4=>amCH4,mN2O=>amN2O,mCO=>amCO,mSO2=>amSO2 + + + ! The rttov_emis_atlas_data type must be imported separately + use mod_rttov_emis_atlas, ONLY : & + rttov_emis_atlas_data, & + atlas_type_ir, atlas_type_mw + + ! The rttov_brdf_atlas_data type must be imported separately + use mod_rttov_brdf_atlas, ONLY : rttov_brdf_atlas_data + + ! jpim, jprb and jplm are the RTTOV integer, real and logical KINDs + use parkind1, ONLY : jpim, jprb, jplm + + use rttov_unix_env, ONLY : rttov_exit + + implicit none + +! New includes for v13 (will need to clean up others) +#include "rttov_direct.interface" +#include "rttov_parallel_direct.interface" +#include "rttov_dealloc_coefs.interface" +#include "rttov_alloc_direct.interface" +#include "rttov_init_emis_refl.interface" +#include "rttov_print_opts.interface" +#include "rttov_print_profile.interface" +#include "rttov_get_pc_predictindex.interface" + +! checking inputs +!#include "rttov_dealloc_coef_scatt.interface" +!#include "rttov_dealloc_coef.interface" +!#include "rttov_dealloc_coef_pccomp.interface" + +! Includes when directly inputting cloud optical parameters +! #include "rttov_init_opt_param.interface" +! #include "rttov_bpr_init.interface" +! #include "rttov_bpr_calc.interface" +! #include "rttov_bpr_dealloc.interface" +! #include "rttov_legcoef_calc.interface" +#include "rttov_calc_solar_angles.interface" + + ! Scattering coefficients (read in once during initialization) +! JKS - KISS +! type(rttov_scatt_coef) :: & +! coef_scatt + + ! module-wides variables for input. Not sure if unsafe for threading. + !==================== + + INTEGER(KIND=jpim) :: errorstatus ! Return error status of RTTOV subroutine calls + INTEGER(KIND=jpim) :: alloc_status(60) + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! TYPE rttov_in + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + type rttov_IN + integer(kind=jpim),pointer :: & ! JKS trying this + nPoints, & ! Number of profiles to simulate + nLevels, & ! Number of levels + nSubCols ! Number of subcolumns + real(kind=wp),pointer :: & + emis_grey => null() +! real(wp),dimension(:),pointer :: & +! surfem ! Surface emissivities for the channels +! refl, & ! Surface reflectances for the channels + real(wp),dimension(:),pointer :: & + h_surf, & ! Surface height + u_surf, & ! U component of surface wind + v_surf, & ! V component of surface wind + t_skin, & ! Surface skin temperature + p_surf, & ! Surface pressure + t2m => null(), & ! 2 m Temperature + q2m => null(), & ! 2 m Specific humidity + sfcmask, & ! sea-land-ice mask (0=sea, 1=land, 2=seaice) + latitude, & ! Latitude (degrees) + longitude, & ! Longitude (degrees) + sza => null() ! Solar zenith angle (deg) + real(wp),dimension(:,:),pointer :: & + p, & ! Pressure @ model levels + ph, & ! Pressure @ model half levels + t, & ! Temperature + q, & ! Specific humidity + o3, & ! Ozone + co2, & ! Carbon dioxide + ch4, & ! Methane + n2o, & ! n2o + co, & ! Carbon monoxide + so2, & ! Sulfur dioxide + rttov_date, & ! Date of the profile as year (e.g. 2013), month (1-12), and day (1-31) + rttov_time, & ! Time of profile as hour, minute, second. + ! These fields below are needed ONLY for the RTTOV all-sky brightness temperature + tca, & ! Cloud fraction + cldIce, & ! Cloud ice + cldLiq, & ! Cloud liquid + DeffLiq, & ! Cloud liquid effective diameter + DeffIce, & ! Cloud ice effective diameter + fl_rain, & ! Precipitation flux (startiform+convective rain) (kg/m2/s) + fl_snow ! Precipitation flux (stratiform+convective snow) + end type rttov_IN + +contains + + ! Wrapper function for exiting RTTOV and reporting the error + subroutine rttov_error(msg, lalloc) + character(*) :: msg + logical :: lalloc + + if(lalloc) then + if (any(alloc_status /= 0)) then + write(*,*) msg + errorstatus = 1 + call rttov_exit(errorstatus) + endif + else + if (errorstatus /= errorstatus_success) then + write(*,*) msg + call rttov_exit(errorstatus) + endif + endif + end subroutine rttov_error + + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE cosp_rttov_swath - JKS + ! ------------------------------------------------------ + ! Determine which gridcells should be swathed. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + subroutine cosp_rttov_swath(rttovIN,rttov_Nlocaltime, & + rttov_localtime,rttov_localtime_width, & + inst_swath_mask, debug) + + type(rttov_in),intent(in) :: & + rttovIN + integer(KIND=jpim),intent(in) :: & + rttov_Nlocaltime + real(kind=jprb), dimension(rttov_Nlocaltime), intent(in) :: & + rttov_localtime, & + rttov_localtime_width + logical(jplm),dimension(rttovIN % nPoints),intent(inout) :: & + inst_swath_mask + logical,intent(in),optional :: & + debug + + !---- Local variables ----! + ! Loop variables + integer(kind=jpim) :: j, jch, nch + + real(kind=jprb),parameter :: & + pi = 4.D0*DATAN(1.D0), & ! yum + radius = 6371.0 ! Earth's radius in km (mean volumetric) + + real(kind=jprb), dimension(rttovIN % nPoints,rttov_Nlocaltime) :: & + sat_lon, & ! Central longitude of the instrument. + dlon, & ! distance to satellite longitude in degrees + dx ! distance to satellite longitude in km? + + logical(kind=jplm), dimension(rttovIN % nPoints,rttov_Nlocaltime) :: & + swath_mask_all ! Mask of logicals over all local times + + integer, dimension(rttovIN % nPoints) :: & + rttov_DOY ! Array of day of year values + real(kind=jprb), dimension(rttovIN % nPoints) :: & + localtime_offsets ! Offset values to avoid striping with hourly RT calls. [hours] + logical :: verbose = .false. + + if (present(debug)) verbose = debug + + ! Compute the day of the year and determine the localtime offset + do j=1,rttovIN%nPoints + call get_DOY(int(rttovIN%rttov_date(j,2)), int(rttovIN%rttov_date(j,3)), rttov_DOY(j)) + end do + localtime_offsets = (mod(rttov_DOY(:), 5) - 2) / 5.0 ! Need to cast to real + + ! Handle swathing here. Initial code from Genevieve with implementation changes. + swath_mask_all = .false. + if (rttov_Nlocaltime .gt. 0) then + ! Iterate over local times + do j=1,rttov_Nlocaltime + ! Calculate the central longitude for each gridcell and orbit + sat_lon(:,j) = 15.0 * (rttov_localtime(j) + localtime_offsets(:) - (rttovIN%rttov_time(:,1) + rttovIN%rttov_time(:,2) / 60)) + ! Calculate distance (in degrees) from each grid cell to the satellite central long + dlon(:,j) = mod((rttovIN%longitude - sat_lon(:,j) + 180.0), 360.0) - 180.0 + ! calculate distance to satellite in km. Remember to convert to radians for cos/sine calls + dx(:,j) = dlon(:,j) * (pi/180.0) * COS(rttovIN%latitude * pi / 180) * radius + ! Determine if a gridcell falls in the swath width + where (abs(dx(:,j))<(rttov_localtime_width(j)*0.5)) + swath_mask_all(:,j) = .true. + end where + end do + + inst_swath_mask = ANY( swath_mask_all(:,:),2) + else + inst_swath_mask(:) = .true. ! Compute on all columns in no local times are passed. + end if + if (verbose) print*,'inst_swath_mask: ',inst_swath_mask + + end subroutine cosp_rttov_swath + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE rttov_allocate - JKS + ! ------------------------------------------------------ + ! 3. Allocate RTTOV input and output structures + ! 4. Build the list of profile/channel indices in inst_chanprof + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + subroutine cosp_rttov_allocate(rttovIN,inst_nChannels_rec,inst_opts,inst_coefs, & + inst_profiles, inst_iChannel, inst_chanprof, & + inst_nchanprof,inst_nprof,inst_swath_mask, & + inst_extend_atmos, & + inst_transmission,inst_radiance,inst_calcemis, & + inst_emissivity,inst_calcrefl,inst_reflectance, & + debug) + + type(rttov_in),intent(in) :: & + rttovIN + integer(kind=jpim),intent(in) :: & + inst_nChannels_rec + type(rttov_options),intent(in) :: & + inst_opts + type(rttov_coefs),intent(in) :: & + inst_coefs + type(rttov_profile),pointer,intent(out) :: & + inst_profiles(:) + integer(kind=jpim),dimension(inst_nChannels_rec),intent(in) :: & + inst_iChannel + type(rttov_chanprof),pointer,intent(inout) :: & + inst_chanprof(:) + integer(kind=jpim),intent(inout) :: & + inst_nchanprof + integer(kind=jpim),intent(in) :: & + inst_nprof ! Now accounting for orbits + logical(jplm),dimension(rttovIN % nPoints),intent(inout) :: & + inst_swath_mask + integer(kind=jpim),intent(in) :: & + inst_extend_atmos + type(rttov_transmission),intent(out) :: & + inst_transmission + type(rttov_radiance),intent(out) :: & + inst_radiance + logical(kind=jplm),pointer,intent(out) :: & + inst_calcemis(:) + type(rttov_emissivity),pointer,intent(out) :: & + inst_emissivity(:) + logical(kind=jplm),pointer,intent(out) :: & + inst_calcrefl(:) + type(rttov_reflectance),pointer,intent(out) :: & + inst_reflectance(:) + logical,intent(in),optional :: & + debug + + !---- Local variables ----! + ! Loop variables + integer(kind=jpim) :: j, jch, nch, nlevels_rttov + logical :: verbose = .false. + + if (present(debug)) verbose = debug + + if (inst_extend_atmos .eq. 0) nlevels_rttov = rttovIN%nLevels+1 ! Just use pressure levels that are supplied. + if (inst_extend_atmos .eq. 1) nlevels_rttov = rttovIN%nLevels+2 ! Simplying extend the atmosphere with a single top layer. CAM6-like. + ! To-do: implement a SARTA-like interpolation to a standard atmosphere. + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 3. Allocate RTTOV input and output structures + ! ------------------------------------------------------ + ! Largely from RTTOV documentation. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + ! Determine the total number of radiances to simulate (nchanprof). + inst_nchanprof = inst_nChannels_rec * inst_nprof + + if (verbose) then + print*,'inst_nprof: ',inst_nprof + print*,'inst_nChannels_rec: ',inst_nChannels_rec + print*,'inst_nchanprof: ',inst_nchanprof + end if + + ! Allocate structures for rttov_direct + call rttov_alloc_direct( & + errorstatus, & + 1_jpim, & ! 1 => allocate + inst_nprof, & + inst_nchanprof, & + nlevels_rttov, & ! "levels" means interfaces, not layers + inst_chanprof, & + inst_opts, & + inst_profiles, & + inst_coefs, & + inst_transmission, & + inst_radiance, & + calcemis=inst_calcemis, & + emissivity=inst_emissivity, & + calcrefl=inst_calcrefl, & + reflectance=inst_reflectance, & + init=.TRUE._jplm) + call rttov_error('error for rttov_alloc_direct structures' , lalloc = .false.) + call rttov_error('allocation error for rttov_alloc_direct structures' , lalloc = .true.) + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 4. Build the list of profile/channel indices in chanprof + ! ------------------------------------------------------ + ! Largely from RTTOV documentation. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + nch = 0_jpim + do j = 1, inst_nprof + do jch = 1, inst_nChannels_rec ! nChannels + nch = nch + 1_jpim + inst_chanprof(nch)%prof = j + inst_chanprof(nch)%chan = inst_iChannel(jch) ! Example code used channel_list + end do + end do + if (verbose) print*,'Done with "cosp_rttov_allocate"' + + end subroutine cosp_rttov_allocate + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE pc_rttov_allocate - Subroutine for running PC-RTTOV + ! ------------------------------------------------------ + ! 3. Allocate RTTOV input and output structures + ! 4. Build the list of profile/channel indices in chanprof + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + subroutine cosp_pc_rttov_allocate(rttovIN,inst_PC_coef_filepath, & + inst_coefs,inst_opts,inst_profiles, & + inst_nchannels_rec,inst_iChannel_in,inst_chanprof, & + inst_nchanprof,inst_nprof,inst_iChannel_out, & + inst_swath_mask,inst_extend_atmos,inst_transmission, & + inst_radiance, inst_calcemis,inst_emissivity,inst_pccomp, & + inst_predictindex,debug) + + type(rttov_in),intent(in) :: & + rttovIN + character(256),intent(in) :: & + inst_PC_coef_filepath + type(rttov_coefs),intent(in) :: & + inst_coefs + type(rttov_options),intent(inout) :: & + inst_opts + type(rttov_profile),pointer,intent(out) :: & + inst_profiles(:) + integer(kind=jpim),intent(inout) :: & + inst_nchannels_rec + integer(kind=jpim),intent(in),dimension(inst_nchannels_rec) :: & + inst_iChannel_in ! Channel indices the user initially requests. + type(rttov_chanprof),pointer,intent(inout) :: & + inst_chanprof(:) + integer(kind=jpim),intent(inout) :: & + inst_nchanprof + integer(kind=jpim),intent(in) :: & + inst_nprof + integer(kind=jpim),intent(inout),allocatable :: & + inst_iChannel_out(:) ! Passing out the channel indices + logical(jplm),dimension(rttovIN % nPoints),intent(inout) :: & + inst_swath_mask + integer(kind=jpim),intent(in) :: & + inst_extend_atmos + type(rttov_transmission),intent(out) :: & + inst_transmission + type(rttov_radiance),intent(out) :: & + inst_radiance + logical(kind=jplm),pointer,intent(out) :: & + inst_calcemis(:) + type(rttov_emissivity),pointer,intent(out) :: & + inst_emissivity(:) + type(rttov_pccomp),intent(inout) :: & + inst_pccomp ! Output PC structure + integer(kind=jpim),pointer,intent(inout) :: & + inst_predictindex(:) + logical,intent(in),optional :: & + debug + + ! Loop variables + integer(kind=jpim) :: j, jch, nch, nlevels_rttov + integer(kind=jpim) :: lo, hi + + ! Local variables + integer(kind=jpim) :: inst_npred_pc + + logical :: verbose = .false. + + if (present(debug)) verbose = debug + + if (inst_extend_atmos .eq. 0) nlevels_rttov = rttovIN%nLevels+1 ! Just use pressure levels that are supplied. + if (inst_extend_atmos .eq. 1) nlevels_rttov = rttovIN%nLevels+2 ! Simplying extend the atmosphere with a single top layer. CAM6-like. + ! To-do: implement a SARTA-like interpolation to a standard atmosphere. + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 3. Allocate RTTOV input and output structures + ! ------------------------------------------------------ + ! Largely from RTTOV documentation. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + nullify(inst_predictindex) + call rttov_get_pc_predictindex(errorstatus, inst_opts, inst_predictindex, file_pccoef=inst_PC_coef_filepath) + call rttov_error('rttov_get_pc_predictindex fatal error' , lalloc = .false.) + + ! Determine the total number of radiances to simulate (nchanprof). + inst_npred_pc = SIZE(inst_predictindex) + inst_nchanprof = inst_npred_pc * inst_nprof ! Size of chanprof array is total number of predictors over all profiles + + ! if (verbose) then + ! print*,'inst_nprof: ',inst_nprof + ! print*,'inst_nChannels_rec: ',inst_nChannels_rec + ! print*,'inst_nchanprof: ',inst_nchanprof + ! end if + + ! Determine the number of reconstructed radiances per profile (nchannels_rec) + if (allocated(inst_iChannel_out)) deallocate(inst_iChannel_out) ! Reset because this variable is internal and used by multiple instruments. + if (inst_opts % rt_ir % pc % addradrec) then + if (inst_nchannels_rec < 0) then + ! If the number of channels is negative, don't reconstruct radiances at all + if (verbose) print*,'radrec 1.' + inst_opts % rt_ir % pc % addradrec = .FALSE. + else if (inst_nchannels_rec == 0) then + ! If the number of channels is set to 0 then reconstruct all instrument channels + if (verbose) print*,'radrec 2.' + inst_nchannels_rec = inst_coefs % coef % fmv_chn + allocate(inst_iChannel_out(inst_nchannels_rec)) + inst_iChannel_out = (/ (j, j = 1, inst_nchannels_rec) /) + else + ! Otherwise read the channel list from the file + if (verbose) print*,'radrec 3.' + allocate(inst_iChannel_out(inst_nchannels_rec)) + inst_iChannel_out = inst_iChannel_in + endif + endif + + ! Ensure we don't have unassociated pointers below when addradrec is FALSE + if (inst_nchannels_rec <= 0) allocate(inst_iChannel_out(0)) + + ! Allocate structures for rttov_direct + CALL rttov_alloc_direct( & + errorstatus, & + 1_jpim, & ! 1 => allocate + inst_nprof, & + inst_nchanprof, & + nlevels_rttov, & ! "levels" means interfaces, not layers + inst_chanprof, & + inst_opts, & + inst_profiles, & + inst_coefs, & + inst_transmission, & + inst_radiance, & + calcemis=inst_calcemis, & + emissivity=inst_emissivity, & + npcscores=inst_opts%rt_ir%pc%npcscores * inst_nprof, & + nchannels_rec=inst_nchannels_rec * inst_nprof, & + pccomp=inst_pccomp, & + init=.TRUE._jplm) + call rttov_error('error for rttov_direct structures (PC-RTTOV)' , lalloc = .false.) + call rttov_error('allocation error for rttov_direct structures (PC-RTTOV)' , lalloc = .true.) + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 4. Build the list of profile/channel indices in chanprof + ! ------------------------------------------------------ + ! Largely from RTTOV documentation. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + ! Populate chanprof using the channel list obtained above in inst_predictindex(:) + do j = 1, inst_nprof + lo = (j - 1) * inst_npred_pc + 1 + hi = lo + inst_npred_pc - 1 + inst_chanprof(lo:hi)%prof = j + inst_chanprof(lo:hi)%chan = inst_predictindex(:) + end do + + end subroutine cosp_pc_rttov_allocate + + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 5. rttov_construct_profiles: 5. Read profile data + ! ------------------------------------------------------ + ! Largely from cosp_rttov_v11.F90 file. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + subroutine cosp_rttov_construct_profiles(rttovIN, & + inst_profiles, & + Lrttov_cld, & + Lrttov_aer, & + Lrttov_solar, & + Luser_tracegas, & + Ldo_co2, & + Ldo_ch4, & + Ldo_co, & + Ldo_n2o, & + Ldo_so2, & + Ldo_o3, & + inst_co2_mr, & + inst_ch4_mr, & + inst_co_mr, & + inst_n2o_mr, & + inst_so2_mr, & + inst_zenang, & + inst_nprof, & + inst_swath_mask, & + inst_gas_units, & + inst_clw_scheme, & + inst_ice_scheme, & + inst_icede_param, & + inst_extend_atmos, & + debug) + + type(rttov_in),intent(in) :: & + rttovIN + type(rttov_profile),target,intent(inout) :: & + inst_profiles(:) + logical,intent(in) :: & + Lrttov_cld, & + Lrttov_aer, & + Lrttov_solar, & + Luser_tracegas, & ! Use user-supplied trace gas columns from instrument namelists. + Ldo_co2, & + Ldo_ch4, & + Ldo_co, & + Ldo_n2o, & + Ldo_so2, & + Ldo_o3 + real(wp),intent(in) :: & + inst_co2_mr, & + inst_ch4_mr, & + inst_co_mr, & + inst_n2o_mr, & + inst_so2_mr, & + inst_zenang + integer(kind=jpim),intent(in) :: & + inst_nprof, & + inst_gas_units, & + inst_clw_scheme, & + inst_ice_scheme, & + inst_icede_param, & + inst_extend_atmos + logical(kind=jplm),dimension(rttovIN % nPoints),intent(in) :: & + inst_swath_mask + logical,intent(in),optional :: & + debug + + ! Loop variables + integer(kind=jpim) :: i, j, k, kk ! Use i to iterate over profile, j for swath_mask, k for vertical interpolation, kk to move from profile vertical coord to rttovIN coord + integer(kind=jpim) :: modeltop_index + logical :: verbose = .false. + + if (present(debug)) verbose = debug + + ! Store profile data from rttovIN in profile type. + ! See RTTOV user guide pg 163 for description of "profiles" type + + ! "The rttov_profile structure is composed of the atmospheric part + ! and two other structures for 2 meter air and skin surface. + ! If you are not able to provide ozone, CO2, etc profiles the flags + ! ozone_data, co2_data and so on in the options structure should be + ! set to false." + + ! Iterate over all columns + j = 0 ! Initialize input + do i = 1, rttovIN%nPoints + if (i .gt. rttovIN%nPoints) exit + if (inst_swath_mask(i)) then ! only added masked columns to profiles + j = j + 1 ! Increment first + ! Ensure j is within bounds + if (j > size(inst_profiles)) then + call rttov_error('Profile index out of bounds in main loop', lalloc = .false.) + if (verbose) print*,"Went too far for inst_profiles in main loop" + exit + end if + ! To imitate CAM6-RRTMG, set a model top index. If inst_extend_atmos==1 then just increment that index by one and retroactively apply it to the top layer. + ! This will be the same index that the vertical interpolation operates over so it will fix that too! + + ! top layer thickness + if (inst_extend_atmos == 0) then + inst_profiles(j)%p(1:inst_profiles(j)%nlevels) = rttovIN%ph(i, :) * 1e-2 ! convert Pa to hPa. Pressure on levels. + if (inst_profiles(j)%p(1) .le. 0) inst_profiles(j)%p(1) = 2.25 ! If the model top is set to zero (like the COSPv2 driver and CAM6) make it 2.25mb. CAM-like correction + modeltop_index = 1 + else if (inst_extend_atmos == 1) then + modeltop_index = 2 + inst_profiles(j)%p(1) = 1e-4 + inst_profiles(j)%p(2) = 2.25 + inst_profiles(j)%p(3:inst_profiles(j)%nlevels) = rttovIN%ph(i, 2:rttovIN%nlevels) * 1e-2 ! JKS confirm correct indices. + end if + + ! Handle the top and bottom levels separately. + ! Top interface supplied by the input. + call interpolate_logp(100*inst_profiles(j)%p(modeltop_index),rttovIN%p(i,1),rttovIN%p(i,2),rttovIN%q(i,1),rttovIN%q(i,2),inst_profiles(j)%q(modeltop_index)) + call interpolate_logp(100*inst_profiles(j)%p(modeltop_index),rttovIN%p(i,1),rttovIN%p(i,2),rttovIN%t(i,1),rttovIN%t(i,2),inst_profiles(j)%t(modeltop_index)) + ! Bottom + call interpolate_logp(100*inst_profiles(j)%p(inst_profiles(j)%nlevels),rttovIN%p(i,rttovIN%nlevels-1),rttovIN%p(i,rttovIN%nlevels),rttovIN%q(i,rttovIN%nlevels-1),rttovIN%q(i,rttovIN%nlevels),inst_profiles(j)%q(inst_profiles(j)%nlevels)) + call interpolate_logp(100*inst_profiles(j)%p(inst_profiles(j)%nlevels),rttovIN%p(i,rttovIN%nlevels-1),rttovIN%p(i,rttovIN%nlevels),rttovIN%t(i,rttovIN%nlevels-1),rttovIN%t(i,rttovIN%nlevels),inst_profiles(j)%t(inst_profiles(j)%nlevels)) + + do k=modeltop_index+1,inst_profiles(j)%nlevels-1 ! Iterate from the layer directly below the first supplied model layer (top of model) to the layer above the last supplied model layer (surface) + kk = k + 1 - modeltop_index + call interpolate_logp(100*inst_profiles(j)%p(k),rttovIN%p(i,kk-1),rttovIN%p(i,kk),rttovIN%q(i,kk-1),rttovIN%q(i,kk),inst_profiles(j)%q(k)) + call interpolate_logp(100*inst_profiles(j)%p(k),rttovIN%p(i,kk-1),rttovIN%p(i,kk),rttovIN%t(i,kk-1),rttovIN%t(i,kk),inst_profiles(j)%t(k)) + end do + + ! Trace gas concentrations on levels (not layers!) + ! Initialize trace gas concentrations from user input. + if (Luser_tracegas) then + if (Ldo_co2) inst_profiles(j)%co2(1:inst_profiles(j)%nlevels) = inst_co2_mr + if (Ldo_n2o) inst_profiles(j)%n2o(1:inst_profiles(j)%nlevels) = inst_n2o_mr + if (Ldo_co) inst_profiles(j)%co(1:inst_profiles(j)%nlevels) = inst_co_mr + if (Ldo_ch4) inst_profiles(j)%ch4(1:inst_profiles(j)%nlevels) = inst_ch4_mr + if (Ldo_so2) inst_profiles(j)%so2(1:inst_profiles(j)%nlevels) = inst_so2_mr + ! if (Ldo_o3) inst_profiles(j)%o3(1:inst_profiles(j)%nlevels) = rttovIN%o3(i, :) + if (Ldo_o3) then ! no O3 user input set up + call interpolate_logp(100*inst_profiles(j)%p(modeltop_index),rttovIN%p(i,1),rttovIN%p(i,2),rttovIN%o3(i,1),rttovIN%o3(i,2),inst_profiles(j)%o3(modeltop_index)) + call interpolate_logp(100*inst_profiles(j)%p(inst_profiles(j)%nlevels),rttovIN%p(i,rttovIN%nlevels-1),rttovIN%p(i,rttovIN%nlevels),rttovIN%o3(i,rttovIN%nlevels-1),rttovIN%o3(i,rttovIN%nlevels),inst_profiles(j)%o3(inst_profiles(j)%nlevels)) + do k=modeltop_index+1,inst_profiles(j)%nlevels-1 + kk = k + 1 - modeltop_index + call interpolate_logp(100*inst_profiles(j)%p(k),rttovIN%p(i,kk-1),rttovIN%p(i,kk),rttovIN%o3(i,kk-1),rttovIN%o3(i,kk),inst_profiles(j)%o3(k)) + end do + end if + else ! For when trace gas columns are supplied by the model. Units must match (kg/kg over moist air) and concentration must be supplied on model levels (not layers), requiring interpolation. + if (Ldo_co2) then ! CO2 + call interpolate_logp(100*inst_profiles(j)%p(modeltop_index),rttovIN%p(i,1),rttovIN%p(i,2),rttovIN%co2(i,1),rttovIN%co2(i,2),inst_profiles(j)%co2(modeltop_index)) + call interpolate_logp(100*inst_profiles(j)%p(inst_profiles(j)%nlevels),rttovIN%p(i,rttovIN%nlevels-1),rttovIN%p(i,rttovIN%nlevels),rttovIN%co2(i,rttovIN%nlevels-1),rttovIN%co2(i,rttovIN%nlevels),inst_profiles(j)%co2(inst_profiles(j)%nlevels)) + do k=modeltop_index+1,inst_profiles(j)%nlevels-1 + kk = k + 1 - modeltop_index + call interpolate_logp(100*inst_profiles(j)%p(k),rttovIN%p(i,kk-1),rttovIN%p(i,kk),rttovIN%co2(i,kk-1),rttovIN%co2(i,kk),inst_profiles(j)%co2(k)) + end do + end if + if (Ldo_n2o) then ! N2O + call interpolate_logp(100*inst_profiles(j)%p(modeltop_index),rttovIN%p(i,1),rttovIN%p(i,2),rttovIN%n2o(i,1),rttovIN%n2o(i,2),inst_profiles(j)%n2o(modeltop_index)) + call interpolate_logp(100*inst_profiles(j)%p(inst_profiles(j)%nlevels),rttovIN%p(i,rttovIN%nlevels-1),rttovIN%p(i,rttovIN%nlevels),rttovIN%n2o(i,rttovIN%nlevels-1),rttovIN%n2o(i,rttovIN%nlevels),inst_profiles(j)%n2o(inst_profiles(j)%nlevels)) + do k=modeltop_index+1,inst_profiles(j)%nlevels-1 + kk = k + 1 - modeltop_index + call interpolate_logp(100*inst_profiles(j)%p(k),rttovIN%p(i,kk-1),rttovIN%p(i,kk),rttovIN%n2o(i,kk-1),rttovIN%n2o(i,kk),inst_profiles(j)%n2o(k)) + end do + end if + if (Ldo_co) then ! CO + call interpolate_logp(100*inst_profiles(j)%p(modeltop_index),rttovIN%p(i,1),rttovIN%p(i,2),rttovIN%co(i,1),rttovIN%co(i,2),inst_profiles(j)%co(modeltop_index)) + call interpolate_logp(100*inst_profiles(j)%p(inst_profiles(j)%nlevels),rttovIN%p(i,rttovIN%nlevels-1),rttovIN%p(i,rttovIN%nlevels),rttovIN%co(i,rttovIN%nlevels-1),rttovIN%co(i,rttovIN%nlevels),inst_profiles(j)%co(inst_profiles(j)%nlevels)) + do k=modeltop_index+1,inst_profiles(j)%nlevels-1 + kk = k + 1 - modeltop_index + call interpolate_logp(100*inst_profiles(j)%p(k),rttovIN%p(i,kk-1),rttovIN%p(i,kk),rttovIN%co(i,kk-1),rttovIN%co(i,kk),inst_profiles(j)%co(k)) + end do + end if + if (Ldo_ch4) then ! CH4 + call interpolate_logp(100*inst_profiles(j)%p(modeltop_index),rttovIN%p(i,1),rttovIN%p(i,2),rttovIN%ch4(i,1),rttovIN%ch4(i,2),inst_profiles(j)%ch4(modeltop_index)) + call interpolate_logp(100*inst_profiles(j)%p(inst_profiles(j)%nlevels),rttovIN%p(i,rttovIN%nlevels-1),rttovIN%p(i,rttovIN%nlevels),rttovIN%ch4(i,rttovIN%nlevels-1),rttovIN%ch4(i,rttovIN%nlevels),inst_profiles(j)%ch4(inst_profiles(j)%nlevels)) + do k=modeltop_index+1,inst_profiles(j)%nlevels-1 + kk = k + 1 - modeltop_index + call interpolate_logp(100*inst_profiles(j)%p(k),rttovIN%p(i,kk-1),rttovIN%p(i,kk),rttovIN%ch4(i,kk-1),rttovIN%ch4(i,kk),inst_profiles(j)%ch4(k)) + end do + end if + if (Ldo_so2) then ! SO2 + call interpolate_logp(100*inst_profiles(j)%p(modeltop_index),rttovIN%p(i,1),rttovIN%p(i,2),rttovIN%so2(i,1),rttovIN%so2(i,2),inst_profiles(j)%so2(modeltop_index)) + call interpolate_logp(100*inst_profiles(j)%p(inst_profiles(j)%nlevels),rttovIN%p(i,rttovIN%nlevels-1),rttovIN%p(i,rttovIN%nlevels),rttovIN%so2(i,rttovIN%nlevels-1),rttovIN%so2(i,rttovIN%nlevels),inst_profiles(j)%so2(inst_profiles(j)%nlevels)) + do k=modeltop_index+1,inst_profiles(j)%nlevels-1 + kk = k + 1 - modeltop_index + call interpolate_logp(100*inst_profiles(j)%p(k),rttovIN%p(i,kk-1),rttovIN%p(i,kk),rttovIN%so2(i,kk-1),rttovIN%so2(i,kk),inst_profiles(j)%so2(k)) + end do + end if + if (Ldo_o3) then ! Ozone + call interpolate_logp(100*inst_profiles(j)%p(modeltop_index),rttovIN%p(i,1),rttovIN%p(i,2),rttovIN%o3(i,1),rttovIN%o3(i,2),inst_profiles(j)%o3(modeltop_index)) + call interpolate_logp(100*inst_profiles(j)%p(inst_profiles(j)%nlevels),rttovIN%p(i,rttovIN%nlevels-1),rttovIN%p(i,rttovIN%nlevels),rttovIN%o3(i,rttovIN%nlevels-1),rttovIN%o3(i,rttovIN%nlevels),inst_profiles(j)%o3(inst_profiles(j)%nlevels)) + do k=modeltop_index+1,inst_profiles(j)%nlevels-1 + kk = k + 1 - modeltop_index + call interpolate_logp(100*inst_profiles(j)%p(k),rttovIN%p(i,kk-1),rttovIN%p(i,kk),rttovIN%o3(i,kk-1),rttovIN%o3(i,kk),inst_profiles(j)%o3(k)) + end do + end if + end if + + ! If adding CAM-like model top layer, copy temperature and trace gas values to the new top level. + if (inst_extend_atmos==1) then ! Replicate RRTMG-LW operations in CAM6 + inst_profiles(j)%t(1) = inst_profiles(j)%t(modeltop_index) + inst_profiles(j)%t(inst_profiles(j)%nlevels) = rttovIN%t_skin(i) ! RRTMG sets the lowest atmospheric temperature equal to the surface skin temperature + inst_profiles(j)%q(1) = inst_profiles(j)%q(modeltop_index) + if (Ldo_co2) inst_profiles(j)%co2(1) = inst_profiles(j)%co2(modeltop_index) + if (Ldo_n2o) inst_profiles(j)%n2o(1) = inst_profiles(j)%n2o(modeltop_index) + if (Ldo_co) inst_profiles(j)%co(1) = inst_profiles(j)%co(modeltop_index) + if (Ldo_ch4) inst_profiles(j)%ch4(1) = inst_profiles(j)%ch4(modeltop_index) + if (Ldo_so2) inst_profiles(j)%so2(1) = inst_profiles(j)%so2(modeltop_index) + if (Ldo_o3) inst_profiles(j)%o3(1) = 0.0 + ! CAM sets the top layer O3 to a linear interpolation between the highest layer and zero O3 at 50 Pa. So the top interface should just be zero then (see rrtmg_state.F90) + ! if (Ldo_o3) call interpolate_logp(100*inst_profiles(j)%p(1),50._wp,rttovIN%p(i,1),0.0_wp,rttovIN%o3(i,1),inst_profiles(j)%o3(1)) + end if + + ! q and o3 coefficient limit is 0.1e-10 for MMRs over moist air + if (inst_profiles(j)%gas_units .eq. 1) then + where(inst_profiles(j)%q(:) < 0.1e-10) + inst_profiles(j)%q(:) = 0.11e-10 + end where + where(inst_profiles(j)%o3(:) < 0.1e-10) + inst_profiles(j)%o3(:) = 0.11e-10 + end where + end if + + ! 2m parameters + inst_profiles(j)%s2m%p = rttovIN%p_surf(i) * 1e-2 ! convert Pa to hPa + if (inst_extend_atmos==1) then + inst_profiles(j)%s2m%t = rttovIN%t_skin(i) + else + inst_profiles(j)%s2m%t = rttovIN%t2m(i) + end if + inst_profiles(j)%s2m%q = rttovIN%q2m(i) ! Should be the same as gas units (kg/kg) + inst_profiles(j)%s2m%u = rttovIN%u_surf(i) + inst_profiles(j)%s2m%v = rttovIN%v_surf(i) + inst_profiles(j)%s2m%wfetc = 10000. ! only used by sea surface solar BRDF model. + + ! skin variables for emissivity calculations + inst_profiles(j)%skin%t = rttovIN%t_skin(i) + + ! fastem coefficients - for mw calculations + inst_profiles(j)%skin%fastem(1) = 3.0 + inst_profiles(j)%skin%fastem(2) = 5.0 + inst_profiles(j)%skin%fastem(3) = 15.0 + inst_profiles(j)%skin%fastem(4) = 0.1 + inst_profiles(j)%skin%fastem(5) = 0.3 + + ! Viewing angles + inst_profiles(j)%zenangle = inst_zenang ! pass in from cosp + inst_profiles(j)%azangle = 0. ! hard-coded in rttov9 int JKS-? + + inst_profiles(j)%latitude = rttovIN%latitude(i) + inst_profiles(j)%longitude = rttovIN%longitude(i) + inst_profiles(j)%elevation = rttovIN%h_surf(i) * 1e-3 ! Convert m to km + + ! Solar angles. This is overwritten in the solar code now. + if (associated(rttovIN%sza)) then + inst_profiles(j)%sunzenangle = rttovIN%sza(i) ! SZA in degrees + else + if (verbose) print*,'No solar zenith angle passed. Setting to zero.' + inst_profiles(j)%sunzenangle = 0. + end if + inst_profiles(j)%sunazangle = 0. ! hard-coded in like rttov9 + + ! surface type. sfcmask is 0 for ocean, 1 for land, and 2 for sea ice + if (rttovIN%sfcmask(i) .lt. 0.5) then + inst_profiles(j)%skin%surftype = surftype_land + else if (rttovIN%sfcmask(i) .lt. 1.5) then + inst_profiles(j)%skin%surftype = surftype_sea + else + inst_profiles(j)%skin%surftype = surftype_seaice + end if + + ! land-sea mask (lsmask) indicates proportion of land in grid (not in CESM implementation! just a binary mask there) +! if (rttovIN%lsmask(i) < 0.5) then +! inst_profiles(j)%skin%surftype = surftype_sea +! else +! inst_profiles(j)%skin%surftype = surftype_land +! endif + ! sea-ice fraction +! if (rttovIN%icefrac(i) >= 0.5) then +! inst_profiles(j)%skin%surftype = surftype_seaice +! endif + + ! dar: hard-coded to 1 (=ocean water) in rttov 9 int + inst_profiles(j)%skin%watertype = 1 + !inst_profiles(j) %idg = 0. ! Depreciated? + !inst_profiles(j) %ish = 0. ! Depreciated? + + ! Correct units if dry mass mixing ratios in ppmv were supplied + ! Units for gas abundances: (must be the same for all profiles) + ! 2 => ppmv over moist air + ! 1=> kg/kg over moist air (default) + ! 0 (or less) => ppmv over dry air + ! JKS added 3 => kg/kg over dry air, which requires conversion. + if (inst_gas_units .eq. 3) then + ! Convert to ppmv over dry air + inst_profiles(j)%s2m%q = (inst_profiles(j)%s2m%q / (1.0 - inst_profiles(j)%s2m%q)) * mdry / mH2O * 1.e6 + inst_profiles(j)%q(:) = (inst_profiles(j)%q(:) / (1.0 - inst_profiles(j)%q(:))) * mdry / mH2O * 1.e6 + inst_profiles(j)%o3(:) = inst_profiles(j)%o3(:) * mdry / mO3 * 1.e6 + inst_profiles(j)%co2(:) = inst_profiles(j)%co2(:) * mdry / mCO2 * 1.e6 + inst_profiles(j)%ch4(:) = inst_profiles(j)%ch4(:) * mdry / mCH4 * 1.e6 + inst_profiles(j)%n2o(:) = inst_profiles(j)%n2o(:) * mdry / mN2O * 1.e6 + inst_profiles(j)%co(:) = inst_profiles(j)%co(:) * mdry / mCO * 1.e6 + inst_profiles(j)%so2(:) = inst_profiles(j)%so2(:) * mdry / mSO2 * 1.e6 + inst_profiles(j)%gas_units = 0 + ! Alternately, convert kg/kg/ over dry air to kg/kg over moist air + ! inst_profiles(j)%o3(:) = inst_profiles(j)%o3(:) * (1.0 - inst_profiles(j)%q(:)) + ! inst_profiles(j)%co2(:) = inst_profiles(j)%co2(:) * (1.0 - inst_profiles(j)%q(:)) + ! inst_profiles(j)%ch4(:) = inst_profiles(j)%ch4(:) * (1.0 - inst_profiles(j)%q(:)) + ! inst_profiles(j)%n2o(:) = inst_profiles(j)%n2o(:) * (1.0 - inst_profiles(j)%q(:)) + ! inst_profiles(j)%co(:) = inst_profiles(j)%co(:) * (1.0 - inst_profiles(j)%q(:)) + ! inst_profiles(j)%so2(:) = inst_profiles(j)%so2(:) * (1.0 - inst_profiles(j)%q(:)) + ! inst_profiles(j)%gas_units = 1 + else + inst_profiles(j)%gas_units = inst_gas_units + end if + + end if + end do + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Only add the cloud fields if simulating cloud. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + if (Lrttov_cld) then + + ! Set cloud mass mixing ratio units + inst_profiles(:)%mmr_cldaer = .true. ! kg/kg for cloud and aerosol (default) + + ! See RTTOV documentation page 75 for details. + inst_profiles(:)%clw_scheme = inst_clw_scheme ! 1: OPAC 2: Deff + inst_profiles(:)%ice_scheme = inst_ice_scheme ! 1:Baum 2:Baran(2014) 3:Baran(2018) + if (inst_icede_param .eq. 0) then ! Need a filler even if icede is suppled + inst_profiles(:)%icede_param = 2 + else ! Only use the model diameters if icede_param supplied on [1:4] + inst_profiles(:)%icede_param = inst_icede_param ! 1: Ou and Liou, 2: Wyser(recommended), 3: Boudala, 4: McFarquhar. Only used if ice effective diameter not input + end if + ! inst_profiles(:)%clw_scheme = 2 ! Deff scheme avoids cloud types but requires an effective diameter value + ! ! inst_profiles(:)%clwde_scheme = 1. ! Scheme for cloud liquid water cotent to effective diameter. User guide says do not change. + ! inst_profiles(:)%ice_scheme = 1 !1:Baum 2:Baran(2014) 3:Baran(2018) + ! inst_profiles(:)%icede_param = 2 ! 2:Wyser(recommended). Only used if ice effective diameter not input + + j = 0 ! Initialize input + do i = 1,rttovIN%nPoints + if (i .gt. rttovIN%nPoints) exit + if (inst_swath_mask(i)) then ! only added masked columns to profiles + j = j + 1 ! Increment profile counter + if (j > size(inst_profiles)) then + call rttov_error('Profile index out of bounds in Lrttov_cld loop', lalloc = .false.) + if (verbose) print*,"Went too far for inst_profiles in Lrttov_cld loop" + exit + end if + ! Cloud scheme stuff. Values are on layers, not levels like the gas concentrations. + inst_profiles(j)%cfrac(modeltop_index:inst_profiles(j)%nlayers) = rttovIN%tca(i,:) ! Cloud fraction for each layer + inst_profiles(j)%cloud(1,modeltop_index:inst_profiles(j)%nlayers) = rttovIN%cldLiq(i,:) ! Cloud water mixing ratio (all in the first type for Deff) + inst_profiles(j)%cloud(6,modeltop_index:inst_profiles(j)%nlayers) = rttovIN%cldIce(i,:) ! Cloud ice mixing ratio (1 type). See pg 74. + + inst_profiles(j)%clwde(modeltop_index:inst_profiles(j)%nlayers) = rttovIN%DeffLiq(i,:) ! Cloud water effective diameter (um) + if (inst_icede_param .eq. 0) then ! Only use the model diameters if icede_param supplied + inst_profiles(j)%icede(modeltop_index:inst_profiles(j)%nlayers) = rttovIN%DeffIce(i,:) ! Cloud ice effective diameter (um) + end if + + ! Example UKMO input has effective radii for multiple cloud types, making identification of a single + ! liquid droplet or ice crystal effective diameter difficult. + ! I opt to let RTTOV decide on the effective radius values, but more complex implementation + ! could do a more thorough conversion between UKMO output and RTTOV input + ! inst_profiles(j)%clwde = ! Cloud water effective diameter + ! inst_profiles(j)%icede = ! Cloud ice effective diameter + + ! Old code for simple cloud schemes only + ! inst_profiles(j)%cfraction = 0. + ! inst_profiles(j)%ctp = 500. + + ! Other options not implemented +! inst_profiles(j)%clw = ! Cloud liquid water (kg/kg) – MW only, + end if + end do + end if + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Only add the aerosol fields if simulating aerosol. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + if (Lrttov_aer) then + + ! Set aerosol mass mixing ratio units + inst_profiles%mmr_cldaer = .true. ! kg/kg for cloud and aerosol (default) + ! Read in aerosol profiles +! j = 0 ! Initialize input +! do i = 1,rttovIN%nPoints +! if (i .gt. rttovIN%nPoints) +! if (inst_swath_mask(i)) then ! only added masked columns to profiles +! j = j + 1 ! Increment profile counter +! inst_profiles(j)%aerosols(naertyp,nlayers) = rttovIN%aerosols ! Aerosols in different modes (see User Guide pg 80) +! end if +! end do + end if + + if (Lrttov_solar) then + + ! Populate longitude, latitude, time, and date profile fields + ! Read in aerosol profiles + j = 0 ! Initialize input + do i = 1,rttovIN%nPoints + if (i .gt. rttovIN%nPoints) exit + if (inst_swath_mask(i)) then ! only added masked columns to profiles + j = j + 1 ! Increment profile counter + ! Ensure j is within bounds + if (j > size(inst_profiles)) then + call rttov_error('Profile index out of bounds in Lrttov_solar loop', lalloc = .false.) + if (verbose) print*,"Went too far for inst_profiles in Lrttov_solar loop" + exit + end if + inst_profiles(j)%date(:) = rttovIN%rttov_date(i,:) + inst_profiles(j)%time(:) = rttovIN%rttov_time(i,:) + end if + end do + + ! Call functions to calculate the appropriate solar zenith and azimuthal angles. + call RTTOV_CALC_SOLAR_ANGLES(errorstatus, inst_profiles) + call rttov_error('Error when calling RTTOV_CALC_SOLAR_ANGLES', lalloc = .false.) + +! if (verbose) then +! print*,'inst_profiles(:))%sunzenangle: ',inst_profiles(:)%sunzenangle +! print*,'inst_profiles(:))%sunazangle: ',inst_profiles(:)%sunazangle +! print*,'inst_profiles(:))%zenangle: ',inst_profiles(:)%zenangle +! print*,'inst_profiles(:))%azangle: ',inst_profiles(:)%azangle +! end if + end if + + ! if (verbose) then ! JKS remove at some point + ! print*,"inst_profiles(1)%gas_units: ",inst_profiles(1)%gas_units + ! print*,'inst_profiles(1)%skin%t: ',inst_profiles(1)%skin%t + ! print*,"inst_profiles(1)%s2m%t: ",inst_profiles(1)%s2m%t + ! print*,'inst_profiles(1)%p(:): ',inst_profiles(1)%p(:) + ! print*,'inst_profiles(1)%t(:): ',inst_profiles(1)%t(:) + ! print*,'inst_profiles(1)%q(:): ',inst_profiles(1)%q(:) + ! print*,'inst_profiles(1)%co2(:): ',inst_profiles(1)%co2(:) + ! print*,'inst_profiles(1)%ch4(:): ',inst_profiles(1)%ch4(:) + ! print*,'inst_profiles(1)%o3(:): ',inst_profiles(1)%o3(:) + ! print*,'inst_profiles(1)%n2o(:): ',inst_profiles(1)%n2o(:) + ! end if + + ! if (verbose) then + ! print*,'inst_profiles(1)%nlevels: ',inst_profiles(1)%nlevels + ! print*,'inst_profiles(1)%nlayers: ',inst_profiles(1)%nlayers + ! print*,'shape(rttovIN%t): ', shape(rttovIN%t) + ! print*,'shape(rttovIN%p): ', shape(rttovIN%p) + ! print*,'shape(rttovIN%ph): ', shape(rttovIN%ph) + ! print*,'shape(inst_profiles(1)%p(:)): ',shape(inst_profiles(1)%p(:)) + ! print*,'shape(inst_profiles(1)%t(:)): ',shape(inst_profiles(1)%t(:)) + ! print*,'shape(inst_profiles(1)%q(:)): ',shape(inst_profiles(1)%q(:)) + ! print*,'shape(inst_profiles(1)%cfrac(:)): ',shape(inst_profiles(1)%cfrac(:)) + ! print*,'shape(rttovIN%tca(1,:)): ',shape(rttovIN%tca(1,:)) + ! print*,'rttovIN%ph(1,:): ', rttovIN%ph(1,:) + ! print*,'rttovIN%p(1,:): ', rttovIN%p(1,:) + ! print*,'rttovIN%t(1,:): ', rttovIN%t(1,:) + ! print*,'rttovIN%q(1,:): ', rttovIN%q(1,:) + ! print*,'rttovIN%o3(1,:): ', rttovIN%o3(1,:) + ! print*,'inst_profiles(1)%p(:): ',inst_profiles(1)%p(:) + ! print*,'inst_profiles(1)%t(:): ',inst_profiles(1)%t(:) + ! print*,'inst_profiles(1)%q(:): ',inst_profiles(1)%q(:) + ! print*,'inst_profiles(1)%o3(:): ',inst_profiles(1)%o3(:) + ! print*,'inst_profiles(1)%cfrac: ',inst_profiles(1)%cfrac + ! print*,'inst_profiles(1)%co2(:): ',inst_profiles(1)%co2(:) + ! print*,'inst_profiles(1)%skin%t: ',inst_profiles(1)%skin%t + ! print*,'inst_profiles(1)%s2m%t: ',inst_profiles(1)%s2m%t + ! print*,'inst_profiles(1)%s2m%p: ',inst_profiles(1)%s2m%p + ! end if + + ! JKS - nothing to check here, this will never trigger. + ! call rttov_error('error in aerosol profile initialization' , lalloc = .true.) + + ! JKS To-do: set up scattering profiles (MW only) (rttov_profile_cloud) + + end subroutine cosp_rttov_construct_profiles + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 6. rttov_setup_emissivity_reflectance - Specify surface emissivity and reflectance + ! ------------------------------------------------------ + ! From RTTOV example files. Will need to be expanded on to pass in values. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! subroutine cosp_rttov_setup_emissivity_reflectance(emis_in,refl_in) + +! real(kind=jprb),intent(in),dimension(Npoints,Nchan),optional :: & +! emis_in, & ! User input emissivities +! refl_in ! User input reflectivities + +! real(kind=jprb),intent(in),optional :: emis_in(SIZE(emissivity % emis_in)) +! real(kind=jprb),intent(in),optional :: refl_in(SIZE(reflectance % refl_in)) + + ! Set emissivities/reflectivites here. +! if (present(emis_in)) emissivity(:) % emis_in = emis_in +! if (present(refl_in)) reflectance(:) % refl_in = refl_in + + subroutine cosp_rttov_setup_emissivity_reflectance(inst_calcemis, & + inst_emissivity, & + inst_calcrefl, & + inst_reflectance, & + emis_grey) + + logical(kind=jplm),pointer,intent(inout) :: & + inst_calcemis(:) + type(rttov_emissivity),pointer,intent(inout) :: & + inst_emissivity(:) + logical(kind=jplm),pointer,intent(inout) :: & + inst_calcrefl(:) + type(rttov_reflectance),pointer,intent(inout) :: & + inst_reflectance(:) + + real(kind=wp),intent(in),pointer,optional :: emis_grey + + ! In this example we have no values for input emissivities or reflectances + ! so we initialise all inputs to zero + call rttov_init_emis_refl(inst_emissivity, inst_reflectance) + call rttov_error('error for emissivity/reflectance initialization' , lalloc = .true.) + + if (present(emis_grey)) inst_emissivity(:) % emis_in = emis_grey ! Use greybody emissivity. + + ! Calculate emissivity within RTTOV where the input emissivity value is + ! zero or less (all channels in this case) + inst_calcemis(:) = (inst_emissivity(:) % emis_in <= 0._jprb) + + ! Calculate reflectances within RTTOV where the input BRDF value is zero or + ! less (all channels in this case) + inst_calcrefl(:) = (inst_reflectance(:) % refl_in <= 0._jprb) + + end subroutine cosp_rttov_setup_emissivity_reflectance + + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 6. rttov_setup_emissivity_reflectance - Specify surface emissivity for PC-RTTOV + ! ------------------------------------------------------ + ! From RTTOV example files. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine cosp_pc_rttov_setup_emissivity(inst_calcemis, & + inst_emissivity) + + logical(kind=jplm),pointer,intent(inout) :: & + inst_calcemis(:) + type(rttov_emissivity),pointer,intent(inout) :: & + inst_emissivity(:) + + ! PC-RTTOV requires using RTTOV to calculate the surface emissivities. + ! Reflectances are never calculated for hyper-spectral IR sounders + call rttov_init_emis_refl(inst_emissivity) + inst_calcemis(:) = .TRUE. + call rttov_error('error for emissivity initialization (PC-RTTOV)' , lalloc = .true.) + + end subroutine cosp_pc_rttov_setup_emissivity + + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 7. rttov_call_direct - Call RTTOV forward model (Woohoo!) + ! ------------------------------------------------------ + ! From RTTOV example files. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + subroutine cosp_rttov_call_direct(inst_nthreads, & + inst_opts, & + inst_profiles, & + inst_coefs, & + inst_chanprof, & + inst_transmission, & + inst_radiance, & + inst_calcemis, & + inst_emissivity, & + inst_calcrefl, & + inst_reflectance, & + debug) + + integer(KIND=jpim),intent(in) :: & + inst_nthreads + type(rttov_options),intent(in) :: & + inst_opts + type(rttov_profile),target,intent(in) :: & + inst_profiles(:) + type(rttov_coefs),intent(in) :: & + inst_coefs + type(rttov_chanprof),pointer,intent(in) :: & + inst_chanprof(:) + type(rttov_transmission),intent(inout) :: & + inst_transmission + type(rttov_radiance),intent(inout) :: & + inst_radiance + logical(kind=jplm),pointer,intent(in) :: & + inst_calcemis(:) + type(rttov_emissivity),pointer,intent(in) :: & + inst_emissivity(:) + logical(kind=jplm),pointer,intent(in) :: & + inst_calcrefl(:) + type(rttov_reflectance),pointer,intent(in) :: & + inst_reflectance(:) + logical,intent(in),optional :: & + debug + + ! Local variables + logical :: verbose = .false. + + if (present(debug)) verbose = debug + + if (verbose) then + print*,'shape(inst_chanprof%prof): ',shape(inst_chanprof%prof) + print*,'shape(inst_chanprof%chan): ',shape(inst_chanprof%chan) + print*,'shape(inst_profiles): ',shape(inst_profiles) + print*,'inst_profiles(1)' + call rttov_print_profile(inst_profiles(1)) + print*,'inst_profiles(size(inst_profiles))' + call rttov_print_profile(inst_profiles(size(inst_profiles))) + end if + +! print*,'NTHRDS tests' +! print*,'inst_profiles(:)%s2m%p: ',inst_profiles(:)%s2m%p +! print*,'inst_profiles(1)%p_surf: ',inst_profiles(1)%p + + if (inst_nthreads <= 1) then + if (verbose) print*,'Calling rttov_direct' + call rttov_direct( & + errorstatus, &! out error flag + inst_chanprof, &! in channel and profile index structure + inst_opts, &! in options structure + inst_profiles, &! in profile array + inst_coefs, &! in coefficients structure + inst_transmission, &! inout computed transmittances + inst_radiance, &! inout computed radiances + calcemis = inst_calcemis, &! in flag for internal emissivity calcs + emissivity = inst_emissivity, &! inout input/output emissivities per channel + calcrefl = inst_calcrefl, &! in flag for internal BRDF calcs + reflectance = inst_reflectance) ! inout input/output BRDFs per channel + else + if (verbose) print*,'Calling rttov_parallel_direct' + call rttov_parallel_direct( & + errorstatus, &! out error flag + inst_chanprof, &! in channel and profile index structure + inst_opts, &! in options structure + inst_profiles, &! in profile array + inst_coefs, &! in coefficients structure + inst_transmission, &! inout computed transmittances + inst_radiance, &! inout computed radiances + calcemis = inst_calcemis, &! in flag for internal emissivity calcs + emissivity = inst_emissivity, &! inout input/output emissivities per channel + calcrefl = inst_calcrefl, &! in flag for internal BRDF calcs + reflectance = inst_reflectance,&! inout input/output BRDFs per channel + nthreads = inst_nthreads) ! in number of threads to use + endif + call rttov_error('rttov_direct error', lalloc = .false.) + call rttov_error('rttov_direct allocation error', lalloc = .true.) + + end subroutine cosp_rttov_call_direct + + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 7. rttov_call_direct - Call PC-RTTOV forward model (Woohoo!) + ! ------------------------------------------------------ + ! From RTTOV example files. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine cosp_pc_rttov_call_direct(inst_nthreads, & + inst_opts, & + inst_profiles, & + inst_coefs, & + inst_chanprof, & + inst_transmission, & + inst_nchannels_rec, & + inst_channels_rec, & + inst_radiance, & + inst_calcemis, & + inst_emissivity, & + inst_pccomp, & + debug) + + integer(KIND=jpim),intent(in) :: & + inst_nthreads + type(rttov_options),intent(in) :: & + inst_opts + type(rttov_profile),target,intent(in) :: & + inst_profiles(:) + type(rttov_coefs),intent(in) :: & + inst_coefs + type(rttov_chanprof),pointer,intent(in) :: & + inst_chanprof(:) + type(rttov_transmission),intent(inout) :: & + inst_transmission + integer(jpim),intent(in) :: & + inst_nchannels_rec + integer(jpim),dimension(inst_nchannels_rec),intent(in) :: & + inst_channels_rec + type(rttov_radiance),intent(inout) :: & + inst_radiance + logical(kind=jplm),pointer,intent(in) :: & + inst_calcemis(:) + type(rttov_emissivity),pointer,intent(in) :: & + inst_emissivity(:) + type(rttov_pccomp),intent(inout) :: & + inst_pccomp ! Output PC structure + + logical,intent(in),optional :: & + debug + logical :: verbose = .false. + + if (present(debug)) verbose = debug + + if (inst_nthreads <= 1) then + if (verbose) print*,'Calling rttov_direct (PC-RTTOV)' + call rttov_direct( & + errorstatus, &! out error flag + inst_chanprof, &! in channel and profile index structure + inst_opts, &! in options structure + inst_profiles, &! in profile array + inst_coefs, &! in coefficients structure + inst_transmission, &! inout computed transmittances + inst_radiance, &! inout computed radiances + calcemis = inst_calcemis, &! in flag for internal emissivity calcs + emissivity = inst_emissivity, &! inout input/output emissivities per channel + pccomp = inst_pccomp,&! inout computed PC scores + channels_rec = inst_channels_rec) ! in reconstructed channel list + else + if (verbose) print*,'Calling rttov_parallel_direct (PC-RTTOV)' + call rttov_parallel_direct( & + errorstatus, &! out error flag + inst_chanprof, &! in channel and profile index structure + inst_opts, &! in options structure + inst_profiles, &! in profile array + inst_coefs, &! in coefficients structure + inst_transmission, &! inout computed transmittances + inst_radiance, &! inout computed radiances + calcemis = inst_calcemis, &! in flag for internal emissivity calcs + emissivity = inst_emissivity, &! inout input/output emissivities per channel + pccomp = inst_pccomp, &! inout computed PC scores + channels_rec = inst_channels_rec,&! in reconstructed channel list + nthreads = inst_nthreads) ! in number of threads to use + endif + call rttov_error('rttov_direct error (PC-RTTOV)', lalloc = .false.) + call rttov_error('rttov_direct allocation error (PC-RTTOV)', lalloc = .true.) + + end subroutine cosp_pc_rttov_call_direct + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 8. Save output data + ! ------------------------------------------------------ + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + subroutine cosp_rttov_save_output(nPoints,inst_nchan_out,inst_swath_mask, & + Lrttov_bt,Lrttov_rad,Lrttov_refl, & + Lrttov_cld,Lrttov_aer,inst_radiance, & + bt_total,bt_clear, & + rad_total,rad_clear,rad_cloudy, & + refl_total,refl_clear) + integer,intent(in) :: & + nPoints, & + inst_nchan_out + logical,dimension(nPoints),intent(in) :: & + inst_swath_mask + logical,intent(in) :: & + Lrttov_bt, & + Lrttov_rad, & + Lrttov_refl, & + Lrttov_cld, & + Lrttov_aer + type(rttov_radiance),intent(in) :: & + inst_radiance + real(wp),dimension(nPoints,inst_nchan_out),intent(inout) :: & + bt_total, & + bt_clear, & + rad_total, & + rad_clear, & + rad_cloudy, & + refl_total, & + refl_clear + + ! Local iterators. i is the gridcell index. j is the swath cells index. + integer :: i, j + + ! Documentation for RTTOV radiance structure in RTTOV User Guide pg 166 + ! Only save output if appropriate + if (count(inst_swath_mask) .eq. nPoints) then ! No swathing, save all output + if (Lrttov_bt) then + bt_total(1:nPoints, 1:inst_nchan_out) = & + transpose(reshape(inst_radiance%bt(1:inst_nchan_out * nPoints), (/ inst_nchan_out, nPoints/) )) + end if + if (Lrttov_bt .and. (Lrttov_cld .or. Lrttov_aer)) then + bt_clear(1:nPoints, 1:inst_nchan_out) = & + transpose(reshape(inst_radiance%bt_clear(1:inst_nchan_out * nPoints), (/ inst_nchan_out, nPoints/) )) + end if + + if (Lrttov_rad) then + rad_total(1:nPoints, 1:inst_nchan_out) = & + transpose(reshape(inst_radiance%total(1:inst_nchan_out * nPoints), (/ inst_nchan_out, nPoints/) )) + end if + if (Lrttov_rad .and. (Lrttov_cld .or. Lrttov_aer)) then + rad_clear(1:nPoints, 1:inst_nchan_out) = & + transpose(reshape(inst_radiance%clear(1:inst_nchan_out * nPoints), (/ inst_nchan_out, nPoints/) )) + rad_cloudy(1:nPoints, 1:inst_nchan_out) = & + transpose(reshape(inst_radiance%cloudy(1:inst_nchan_out * nPoints), (/ inst_nchan_out, nPoints/) )) + end if + + if (Lrttov_refl) then + refl_total(1:nPoints, 1:inst_nchan_out) = & + transpose(reshape(inst_radiance%refl(1:inst_nchan_out * nPoints), (/ inst_nchan_out, nPoints/) )) + end if + if (Lrttov_refl .and. (Lrttov_cld .or. Lrttov_aer)) then + refl_clear(1:nPoints, 1:inst_nchan_out) = & + transpose(reshape(inst_radiance%refl_clear(1:inst_nchan_out * nPoints), (/ inst_nchan_out, nPoints/) )) + end if + else ! If swathing is occurring, assign the outputs appropriately. + ! The radiance structure has shape nchanprof and the outputs have shape (nPoints, inst_nchan_out) + j = 0 + do i=1,nPoints + ! if (i .gt. nPoints) exit + if (inst_swath_mask(i)) then ! only added masked columns to profiles + if (Lrttov_bt) then + bt_total(i, 1:inst_nchan_out) = inst_radiance%bt(1 + (j * inst_nchan_out):(j+1) * inst_nchan_out) + end if + if (Lrttov_bt .and. (Lrttov_cld .or. Lrttov_aer)) then + bt_clear(i, 1:inst_nchan_out) = inst_radiance%bt_clear(1 + (j * inst_nchan_out):(j+1) * inst_nchan_out) + end if + if (Lrttov_rad) then + rad_total(i, 1:inst_nchan_out) = inst_radiance%total(1 + (j * inst_nchan_out):(j+1) * inst_nchan_out) + end if + if (Lrttov_rad .and. (Lrttov_cld .or. Lrttov_aer)) then + rad_clear(i, 1:inst_nchan_out) = inst_radiance%clear(1 + (j * inst_nchan_out):(j+1) * inst_nchan_out) + rad_cloudy(i, 1:inst_nchan_out) = inst_radiance%cloudy(1 + (j * inst_nchan_out):(j+1) * inst_nchan_out) + end if + if (Lrttov_refl) then + refl_total(i, 1:inst_nchan_out) = inst_radiance%refl(1 + (j * inst_nchan_out):(j+1) * inst_nchan_out) + end if + if (Lrttov_refl .and. (Lrttov_cld .or. Lrttov_aer)) then + refl_clear(i, 1:inst_nchan_out) = inst_radiance%refl_clear(1 + (j * inst_nchan_out):(j+1) * inst_nchan_out) + end if + j = j + 1 ! Increment profile counter afterwards + end if + end do + end if + + end subroutine cosp_rttov_save_output + + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 8. Save output data (PC-RTTOV) + ! ------------------------------------------------------ + ! PC-RTTOV only does clear-sky IR calculations (can handle aerosols, but I'll ignore that for now. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + subroutine cosp_pc_rttov_save_output(nPoints, & + inst_nchannels_rec, & + inst_swath_mask, & + inst_pccomp, & + Lrttov_bt, & + Lrttov_rad, & + bt_clear, & + rad_clear, & + debug) + + integer,intent(in) :: & + nPoints, & + inst_nchannels_rec + logical,dimension(nPoints),intent(in) :: & + inst_swath_mask + type(rttov_pccomp),intent(in) :: & + inst_pccomp ! Output PC structure + logical,intent(in) :: & + Lrttov_bt, & + Lrttov_rad + real(wp),dimension(nPoints,inst_nchannels_rec),intent(inout) :: & ! Can I do this? I guess so! + bt_clear, & + rad_clear + logical,intent(in),optional :: & + debug + + ! Local iterators. i is the gridcell index. j is the swath cells index. + integer :: i, j + logical :: verbose = .false. + + if (present(debug)) verbose = debug + + if (verbose) then + print*,'shape(bt_total): ',shape(bt_clear) + print*,'shape(rad_total): ',shape(rad_clear) + print*,'nPoints: ',nPoints + print*,'inst_nchannels_rec: ',inst_nchannels_rec + print*,'size(inst_pccomp%bt_pccomp): ',size(inst_pccomp%bt_pccomp) + print*,'size(inst_pccomp%total_pccomp): ',size(inst_pccomp%total_pccomp) + print*,'inst_nchannels_rec * nPoints: ',inst_nchannels_rec * nPoints + end if + + ! Documentation for RTTOV radiance structure in RTTOV User Guide pg 166 + + ! Only save output if appropriate + if (count(inst_swath_mask) .eq. nPoints) then ! No swathing, save all output + if (Lrttov_bt) then + bt_clear(1:nPoints, 1:inst_nchannels_rec) = & + transpose(reshape(inst_pccomp%bt_pccomp(1:(inst_nchannels_rec * nPoints)), (/ inst_nchannels_rec, nPoints/) )) + end if + if (Lrttov_rad) then + rad_clear(1:nPoints, 1:inst_nchannels_rec) = & + transpose(reshape(inst_pccomp%total_pccomp(1:(inst_nchannels_rec * nPoints)), (/ inst_nchannels_rec, nPoints/) )) + end if + else ! If swathing is occurring, assign the outputs appropriately + j = 0 + do i=1,nPoints + ! if (i .gt. nPoints) exit + if (inst_swath_mask(i)) then ! only added masked columns to profiles + if (Lrttov_bt) then + bt_clear(i, 1:inst_nchannels_rec) = inst_pccomp%bt_pccomp(1 + (j * inst_nchannels_rec):(j+1) * inst_nchannels_rec) + end if + if (Lrttov_rad) then + rad_clear(i, 1:inst_nchannels_rec) = inst_pccomp%total_pccomp(1 + (j * inst_nchannels_rec):(j+1) * inst_nchannels_rec) + end if + j = j + 1 ! Increment profile counter afterwards + end if + end do + end if + + end subroutine cosp_pc_rttov_save_output + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 9. Deallocate all RTTOV arrays and structures + ! ------------------------------------------------------ + ! From RTTOV example files. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + subroutine cosp_rttov_deallocate_profiles(inst_nprof, & + inst_nchanprof, & + nLevels, & + inst_opts, & + inst_profiles, & + inst_coefs, & + inst_chanprof, & + inst_transmission, & + inst_radiance, & + inst_calcemis, & + inst_emissivity, & + inst_calcrefl, & + inst_reflectance) + + integer(kind=jpim),intent(in) :: & + inst_nprof, & + inst_nchanprof, & + nLevels + type(rttov_options),intent(in) :: & + inst_opts + type(rttov_profile),pointer,intent(in) :: & + inst_profiles(:) + type(rttov_coefs),intent(in) :: & + inst_coefs + type(rttov_chanprof),pointer,intent(inout) :: & + inst_chanprof(:) + type(rttov_transmission),intent(inout) :: & + inst_transmission + type(rttov_radiance),intent(inout) :: & + inst_radiance + logical(kind=jplm),pointer,intent(inout) :: & + inst_calcemis(:) + type(rttov_emissivity),pointer,intent(inout) :: & + inst_emissivity(:) + logical(kind=jplm),pointer,intent(inout) :: & + inst_calcrefl(:) + type(rttov_reflectance),pointer,intent(inout) :: & + inst_reflectance(:) + + ! Deallocate structures for rttov_direct + call rttov_alloc_direct( & + errorstatus, & + 0_jpim, & ! 0 => deallocate + inst_nprof, & + inst_nchanprof, & + nLevels+1, & ! "levels" means interfaces, not layers + ! nLevels, & + inst_chanprof, & + inst_opts, & + inst_profiles, & + inst_coefs, & + inst_transmission, & + inst_radiance, & + calcemis=inst_calcemis, & + emissivity=inst_emissivity, & + calcrefl=inst_calcrefl, & + reflectance=inst_reflectance) + call rttov_error('error for rttov_direct structures', lalloc = .false.) + call rttov_error('deallocation error for rttov_direct structures', lalloc = .true.) + + end subroutine cosp_rttov_deallocate_profiles + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 9. Deallocate all RTTOV arrays and structures (PC-RTTOV) + ! ------------------------------------------------------ + ! From RTTOV example files. + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + subroutine cosp_pc_rttov_deallocate_profiles(inst_nprof, & + inst_nchanprof, & + nlevels, & + inst_nChannels_rec, & + inst_opts, & + inst_profiles, & + inst_coefs, & + inst_chanprof, & + inst_transmission, & + inst_radiance, & + inst_calcemis, & + inst_emissivity, & + inst_pccomp, & + inst_predictindex) + + integer(kind=jpim),intent(in) :: & + inst_nprof, & + inst_nchanprof, & + nlevels, & + inst_nChannels_rec + type(rttov_options),intent(in) :: & + inst_opts + type(rttov_profile),pointer,intent(in) :: & + inst_profiles(:) + type(rttov_coefs),intent(in) :: & + inst_coefs + type(rttov_chanprof),pointer,intent(inout) :: & + inst_chanprof(:) + type(rttov_transmission),intent(inout) :: & + inst_transmission + type(rttov_radiance),intent(inout) :: & + inst_radiance + logical(kind=jplm),pointer,intent(inout) :: & + inst_calcemis(:) + type(rttov_emissivity),pointer,intent(inout) :: & + inst_emissivity(:) + type(rttov_pccomp),intent(inout) :: & + inst_pccomp ! Output PC structure + integer(kind=jpim),pointer,intent(inout) :: & + inst_predictindex(:) + + if (ASSOCIATED(inst_predictindex)) deallocate (inst_predictindex, stat=alloc_status(10)) + call rttov_error('mem dellocation error for "inst_predictindex"', lalloc = .true.) + + ! Deallocate structures for rttov_direct + call rttov_alloc_direct( & + errorstatus, & + 0_jpim, & ! 0 => deallocate + inst_nprof, & + inst_nchanprof, & + nLevels+1, & ! "levels" means interfaces, not layers + ! nLevels, & + inst_chanprof, & + inst_opts, & + inst_profiles, & + inst_coefs, & + inst_transmission, & + inst_radiance, & + calcemis=inst_calcemis, & + emissivity=inst_emissivity, & + npcscores=inst_opts%rt_ir%pc%npcscores * inst_nprof, & + nchannels_rec=inst_nChannels_rec * inst_nprof, & + pccomp=inst_pccomp) + call rttov_error('deallocation error for rttov_direct structures (PC-RTTOV)', lalloc = .true.) + + end subroutine cosp_pc_rttov_deallocate_profiles + + subroutine cosp_rttov_deallocate_coefs(inst_coefs) + + type(rttov_coefs),intent(inout) :: & + inst_coefs + + call rttov_dealloc_coefs(errorstatus, inst_coefs) + if (errorstatus /= errorstatus_success) then + write(*,*) 'coefs deallocation error' + endif + + end subroutine cosp_rttov_deallocate_coefs + + subroutine interpolate_logp(ptarget,p1,p2,z1,z2,ztarget) + + real(jprb),intent(in) :: ptarget + real(WP),intent(in) :: p1,p2,z1,z2 + real(jprb),intent(out) :: ztarget ! variable interpolated to the target pressure level + + ! Normal procedure where ptarget falls within [p1,p2] + if ((ptarget .gt. p1) .and. (ptarget .lt. p2)) then + ztarget = z1 + (z2-z1) * log(ptarget / p1) / log(p2 / p1) + elseif (ptarget .lt. p1) then ! Top of model level. ptarget may be zero... + ztarget = z1 ! Just set it to the layer value?? Not sure how to handle this if ptarget=0. I think that this is fine. We're basically out of range. + elseif (ptarget .gt. p2) then ! surface level + ztarget = z2 + (z2-z1) * log(ptarget / p2) / log(p2 / p1) + end if + + end subroutine interpolate_logp + + subroutine get_DOY(month, day, DOY) + + integer,intent(in) :: & + month, & + day + integer,intent(out) :: & + DOY + + ! This subroutine does not handle leap years because it is not relevant to the purpose. + ! Simple look-up table for DOY. + if (month .eq. 1) DOY = day + if (month .eq. 2) DOY = 31 + day + if (month .eq. 3) DOY = 59 + day + if (month .eq. 4) DOY = 90 + day + if (month .eq. 5) DOY = 120 + day + if (month .eq. 6) DOY = 151 + day + if (month .eq. 7) DOY = 181 + day + if (month .eq. 8) DOY = 212 + day + if (month .eq. 9) DOY = 243 + day + if (month .eq. 10) DOY = 273 + day + if (month .eq. 11) DOY = 304 + day + if (month .eq. 12) DOY = 334 + day + + end subroutine get_DOY + +!########################## +! Module End +!########################## +end module mod_cosp_rttov \ No newline at end of file diff --git a/subsample_and_optics_example/optics/quickbeam_optics/quickbeam_optics.F90 b/subsample_and_optics_example/optics/quickbeam_optics/quickbeam_optics.F90 index 62f3a3f2a7..dd39c73b3a 100644 --- a/subsample_and_optics_example/optics/quickbeam_optics/quickbeam_optics.F90 +++ b/subsample_and_optics_example/optics/quickbeam_optics/quickbeam_optics.F90 @@ -37,10 +37,11 @@ module mod_quickbeam_optics USE optics_lib, ONLY: m_wat,m_ice,MieInt USE cosp_math_constants, ONLY: pi USE cosp_phys_constants, ONLY: rhoice - use quickbeam, ONLY: radar_cfg,dmin,dmax,Re_BIN_LENGTH, & + use quickbeam, ONLY: dmin,dmax,Re_BIN_LENGTH, & Re_MAX_BIN,nRe_types,nd,maxhclass use mod_cosp_config, ONLY: N_HYDRO use mod_cosp_error, ONLY: errorMessage + use mod_cosp_stats, ONLY: radar_cfg implicit none ! Derived type for particle size distribution