diff --git a/.gitmodules b/.gitmodules index 418d917c26..d8a34d6ce1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -151,7 +151,7 @@ fxDONOTUSEurl = https://github.com/ESCOMP/CMEPS.git [submodule "cdeps"] path = components/cdeps url = https://github.com/ESCOMP/CDEPS.git -fxtag = cdeps1.0.45 +fxtag = cdeps1.0.48 fxrequired = ToplevelRequired fxDONOTUSEurl = https://github.com/ESCOMP/CDEPS.git @@ -172,7 +172,7 @@ fxDONOTUSEurl = https://github.com/NCAR/ParallelIO [submodule "cice"] path = components/cice url = https://github.com/ESCOMP/CESM_CICE -fxtag = cesm_cice6_5_0_10 +fxtag = cesm_cice6_5_0_12 fxrequired = ToplevelRequired fxDONOTUSEurl = https://github.com/ESCOMP/CESM_CICE diff --git a/bld/build-namelist b/bld/build-namelist index 7a5c8c1132..d37fe78c24 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -511,6 +511,7 @@ if ($adia_mode or $ideal_mode) { $simple_phys = 1; } # Single column mode my $scam = $cfg->get('scam'); +my $scam_iop = $cfg->get('scam_iop'); # Coupling interval # The default is for CAM to couple to the surface components every CAM timestep. @@ -2516,7 +2517,7 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam } # MEGAN emissions - if (($chem eq 'trop_mam4' or $chem eq 'waccm_sc_mam4' or $chem eq 'ghg_mam4') and !$aqua_mode and !$scam){ + if (($chem eq 'trop_mam4' or $chem eq 'waccm_sc_mam4' or $chem eq 'ghg_mam4') and !$aqua_mode){ my $val = "'SOAE = 0.5954*isoprene + 5.1004*(carene_3 + pinene_a + thujene_a + bornene +'," . "' terpineol_4 + terpineol_a + terpinyl_ACT_a + myrtenal + sabinene + pinene_b + camphene +'," . "' fenchene_a + limonene + phellandrene_a + terpinene_a + terpinene_g + terpinolene +'," @@ -4089,6 +4090,30 @@ if ($dyn eq 'sld') { # Single column model if ($cfg->get('scam')) { add_default($nl, 'iopfile'); + add_default($nl, 'nhtfrq'); + add_default($nl, 'mfilt'); + add_default($nl, 'scm_use_obs_uv'); + add_default($nl, 'scale_dry_air_mass'); + add_default($nl, 'scm_relaxation'); + add_default($nl, 'scm_relax_bot_p'); + add_default($nl, 'scm_relax_top_p'); + add_default($nl, 'scm_relax_linear'); + add_default($nl, 'scm_relax_tau_bot_sec'); + add_default($nl, 'scm_relax_tau_top_sec'); + if ($chem =~ /_mam/) { + add_default($nl, 'scm_relax_fincl'); + } + if ($scam_iop) { + add_default($nl, 'iopfile'); + } + if ($scam_iop eq 'SAS') { + add_default($nl, 'use_gw_front'); + add_default($nl, 'scm_backfill_iop_w_init'); + } + if ($scam_iop eq 'twp06') { + add_default($nl, 'iradsw'); + add_default($nl, 'iradlw'); + } } # CAM generates IOP file for SCAM diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index 1d402ec245..6a4a5436fb 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -147,12 +147,16 @@ Turn on CO2 cycle in biogeochemistry model: 0 => no, 1 => yes. Modifications that allow perturbation growth testing: 0=off, 1=on. -Configure CAM for single column mode: 0=off, 1=on. This option only -supported for the Eulerian dycore. +Configure CAM for single column mode and specify an IOP: 0=no, 1=yes. +This option only supported for the Eulerian and SE dycores. + + +Single column IOP +Supported for Eulerian and SE dycores. Configure CAM to generate an IOP file that can be used to drive SCAM: 0=no, 1=yes. -This option only supported for the Eulerian dycore. +Supported for Eulerian and SE dycores. Horizontal grid specifier. The recognized values depend on diff --git a/bld/configure b/bld/configure index 3c99ef5697..8e21a98fd8 100755 --- a/bld/configure +++ b/bld/configure @@ -124,7 +124,10 @@ OPTIONS -camiop Configure CAM to generate an IOP file that can be used to drive SCAM. This switch only works with the Eulerian dycore. - -scam Compiles model in single column mode. Only works with Eulerian dycore. + -scam Compiles model in single column mode and configures for iop + [ arm95 | arm97 | atex | bomex | cgilsS11 | cgilsS12 | cgilsS6 | dycomsRF01 | + dycomsRF02 | gateIII | mpace | rico | sparticus | togaII | twp06 | SAS | camfrc ]. + Default: arm97 CAM parallelization: @@ -297,7 +300,7 @@ GetOptions( "psubcols=s" => \$opts{'psubcols'}, "rad=s" => \$opts{'rad'}, "offline_drv=s" => \$opts{'offline_drv'}, - "scam" => \$opts{'scam'}, + "scam=s" => \$opts{'scam'}, "silhs" => \$opts{'silhs'}, "s|silent" => \$opts{'silent'}, "smp!" => \$opts{'smp'}, @@ -1207,15 +1210,25 @@ if ($print>=2) { print "Perturbation growth testing: $pergro$eol"; } #----------------------------------------------------------------------------------------------- # Single column mode + +# Set default iop +my $scam_iop; + +# Allow the user to override the default via the commandline. +if (defined $opts{'scam'}) { + $scam_iop = lc($opts{'scam'}); + $cfg_ref->set('scam_iop', $scam_iop); +} + if (defined $opts{'scam'}) { $cfg_ref->set('scam', 1); } my $scam = $cfg_ref->get('scam') ? "ON" : "OFF"; -# The only dycore supported in SCAM mode is Eulerian -if ($scam eq 'ON' and $dyn_pkg ne 'eul') { +# The only dycores supported in SCAM mode are Eulerian and Spectral Elements +if ($scam eq 'ON' and !($dyn_pkg eq 'eul' or $dyn_pkg eq 'se')) { die <<"EOF"; -** ERROR: SCAM mode only works with Eulerian dycore. +** ERROR: SCAM mode only works with Eulerian or SE dycores. ** Requested dycore is: $dyn_pkg EOF } @@ -1229,10 +1242,10 @@ if (defined $opts{'camiop'}) { } my $camiop = $cfg_ref->get('camiop') ? "ON" : "OFF"; -# The only dycore supported in CAMIOP mode is Eulerian -if ($camiop eq 'ON' and $dyn_pkg ne 'eul') { +# The only dycores supported in SCAM mode are Eulerian and Spectral Elements +if ($camiop eq 'ON' and !($dyn_pkg eq 'eul' or $dyn_pkg eq 'se')) { die <<"EOF"; -** ERROR: CAMIOP mode only works with Eulerian dycore. +** ERROR: CAMIOP mode only works with the Eulerian or Spectral Element dycores. ** Requested dycore is: $dyn_pkg EOF } diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index ddb1505ad1..8a8f649839 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -220,6 +220,11 @@ atm/cam/inic/se/FCts4MTHIST_ne3pg3_spinup02.cam.i.1980-01-01_c240702.nc atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L32_01-01-31_c221214.nc +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-09-01-00000.nc +atm/cam/inic/se/cami_0000-01-01_ne3np4_L30_c120315.nc +atm/cam/inic/se/cami_0000-01-01_ne3np4_L30_c120315.nc +atm/cam/inic/se/cami_0000-01-01_ne3np4_L26_c120525.nc +atm/cam/inic/se/cami_0000-01-01_ne3np4_L26_c120525.nc atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L58_01-01-31_c221214.nc atm/cam/inic/se/cam6_FMTHIST_ne3pg3_mg37_L93_79-02-01_c240517.nc atm/cam/inic/homme/cami-mam3_0000-01_ne5np4_L30.140707.nc @@ -317,7 +322,7 @@ atm/cam/topo/se/ne60pg2_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171014.nc atm/cam/topo/se/ne120pg2_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171012.nc atm/cam/topo/se/ne240pg2_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171014.nc - +atm/cam/topo/se/ne3np4_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230717.nc atm/cam/topo/se/ne3pg3_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230209.nc atm/cam/topo/se/ne5pg3_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw064_20170516.nc atm/cam/topo/se/ne16pg3_nc3000_Co120_Fi001_PF_nullRR_Nsw084_20171012.nc @@ -1992,6 +1997,8 @@ OFF + +atm/cam/chem/trop_mam/atmsrf_ne3np4_230718.nc atm/cam/chem/trop_mam/atmsrf_ne3np4.pg3_221214.nc atm/cam/chem/trop_mam/atmsrf_ne5np4_110920.nc atm/cam/chem/trop_mam/atmsrf_ne5pg3_201105.nc @@ -2978,12 +2985,141 @@ -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/ARM97_4scam.nc - 1500 - 9 - .true. - slt + 1 + 10000 + .true. + 0.0D0 + .true. + 10800._r8 + + 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', 'ncl_a3', + 'num_a1', 'num_a2', 'num_a3', 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' + + + 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', 'ncl_a3', + 'num_a1', 'num_a2', 'num_a3', 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' + + + 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', 'ncl_a3', + 'num_a1', 'num_a2', 'num_a3', 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' + + 105000.D0 + 200.D0 + .true. + 864000.D0 + 172800.D0 + + + + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/ARM95_4scam.nc + 368.9e-6 + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/ARM97_4scam.nc + 368.9e-6 + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-02-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-02-01-00000.nc +atm/cam/scam/iop/ATEX_48hr_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/BOMEX_5day_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/S11_CTL_MixedLayerInit_reduced.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/S12_CTL_MixedLayerInit_reduced.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/S6_CTL_reduced.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/DYCOMSrf01_4day_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/DYCOMSrf02_48hr_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-08-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-08-01-00000.nc +atm/cam/scam/iop/GATEIII_4scam_c170809.nc + + +atm/cam/scam/iop/micre2017_3mo.cam.i.2017-01-01-00000.regrid.ne3np4.nc +atm/cam/scam/iop/micre2017_3mo.cam.i.2017-01-01-00000.regrid.Gaus_64x128.nc +atm/cam/scam/iop/micre2017_3mo.macquarie2017.iop.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-10-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-10-01-00000.nc +atm/cam/scam/iop/MPACE_4scam.nc + + 'CLDST', 'CNVCLD', + 'ICWMR','ICIMR','FREQL','FREQI','LANDFRAC','CDNUMC','FICE','WSUB','CCN3','ICLDIWP', + 'CDNUMC', 'AQSNOW', 'WSUB', 'CCN3', 'FREQI', 'FREQL', 'FREQR', 'FREQS', 'CLDLIQ', 'CLDICE', + 'FSDS', 'FLDS','AREL','AREI','NSNOW','QSNOW','DSNOW', + 'FLNT','FLNTC','FSNT','FSNTC','FSNS','FSNSC','FLNT','FLNTC','QRS','QRSC','QRL','QRLC', + 'LWCF','SWCF', 'NCAI', 'NCAL', 'NIHF','NIDEP','NIIMM','NIMEY','ICLDIWP','ICLDTWP', 'CONCLD', + 'QCSEVAP', 'QISEVAP', 'QVRES', 'CMELIQ', 'CMEIOUT', 'EVAPPREC', 'EVAPSNOW', 'TAQ', + 'ICLMRCU', 'ICIMRCU' ,'ICWMRSH' ,'ICWMRDP', 'ICLMRTOT' , 'ICIMRTOT' , 'SH_CLD' , 'DP_CLD', + 'LIQCLDF','ICECLDF', 'ICWMRST', 'ICIMRST', 'EFFLIQ', 'EFFICE','ADRAIN','ADSNOW','WSUBI', + 'TGCLDLWP','GCLDLWP' + + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/RICO_3day_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/SAS_ideal_4scam.nc + 368.9e-6 + .false. + .true. + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-04-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-04-01-00000.nc +atm/cam/scam/iop/SPARTICUS_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-12-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-12-01-00000.nc +atm/cam/scam/iop/TOGAII_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-01-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-01-01-00000.nc +atm/cam/scam/iop/TWP06_4scam.nc + 1 + 1 + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/ARM97_4scam.nc diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index e0c4b46778..d954b533cf 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -6002,6 +6002,12 @@ Use the SCAM-IOP specified observed water vapor at each time step instead of for Default: FALSE + +Use the SCAM-IOP 3d forcing if true, use combination of dycore vertical advection and iop horiz advection if false +Default:False + + Force scam to use the lat lon fields specified in the scam namelist not what is closest to IOP avail lat lon diff --git a/bld/namelist_files/use_cases/scam_arm95.xml b/bld/namelist_files/use_cases/scam_arm95.xml deleted file mode 100644 index bf9ebc7391..0000000000 --- a/bld/namelist_files/use_cases/scam_arm95.xml +++ /dev/null @@ -1,22 +0,0 @@ - - - - - -368.9e-6 - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/ARM95_4scam.nc - 36.6 - 262.5 - 19950718 - 19800 - 1259 - 1500 - 1 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_arm97.xml b/bld/namelist_files/use_cases/scam_arm97.xml deleted file mode 100644 index 7508853f08..0000000000 --- a/bld/namelist_files/use_cases/scam_arm97.xml +++ /dev/null @@ -1,22 +0,0 @@ - - - - - -368.9e-6 - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/ARM97_4scam.nc - 36.6 - 262.5 - 19970618 - 84585 - 2088 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_gateIII.xml b/bld/namelist_files/use_cases/scam_gateIII.xml deleted file mode 100644 index c5c822d5e3..0000000000 --- a/bld/namelist_files/use_cases/scam_gateIII.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/GATEIII_4scam.nc - 9.00 - 336.0 - 19740830 - 0 - 1440 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_mpace.xml b/bld/namelist_files/use_cases/scam_mpace.xml deleted file mode 100644 index a559a8489e..0000000000 --- a/bld/namelist_files/use_cases/scam_mpace.xml +++ /dev/null @@ -1,30 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/MPACE_4scam.nc - 70.5 - 206.0 - 20041005 - 7171 - 1242 - 1500 - 9 - nsteps - 'CLDST', 'CNVCLD', - 'ICWMR','ICIMR','FREQL','FREQI','LANDFRAC','CDNUMC','FICE','WSUB','CCN3','ICLDIWP', - 'CDNUMC', 'AQSNOW', 'WSUB', 'CCN3', 'FREQI', 'FREQL', 'FREQR', 'FREQS', 'CLDLIQ', 'CLDICE', - 'FSDS', 'FLDS','AREL','AREI','NSNOW','QSNOW','DSNOW', - 'FLNT','FLNTC','FSNT','FSNTC','FSNS','FSNSC','FLNT','FLNTC','QRS','QRSC','QRL','QRLC', - 'LWCF','SWCF', 'NCAI', 'NCAL', 'NIHF','NIDEP','NIIMM','NIMEY','ICLDIWP','ICLDTWP', 'CONCLD', - 'QCSEVAP', 'QISEVAP', 'QVRES', 'CMELIQ', 'CMEIOUT', 'EVAPPREC', 'EVAPSNOW', 'TAQ', - 'ICLMRCU', 'ICIMRCU' ,'ICWMRSH' ,'ICWMRDP', 'ICLMRTOT' , 'ICIMRTOT' , 'SH_CLD' , 'DP_CLD', - 'LIQCLDF','ICECLDF', 'ICWMRST', 'ICIMRST', 'EFFLIQ', 'EFFICE','ADRAIN','ADSNOW','WSUBI', - 'TGCLDLWP','GCLDLWP' - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_sparticus.xml b/bld/namelist_files/use_cases/scam_sparticus.xml deleted file mode 100644 index 105994b36b..0000000000 --- a/bld/namelist_files/use_cases/scam_sparticus.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/scam/iop/SPARTICUS_4scam.nc - 36.6 - 262.51 - 20100401 - 3599 - 2156 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_togaII.xml b/bld/namelist_files/use_cases/scam_togaII.xml deleted file mode 100644 index 9b2706382b..0000000000 --- a/bld/namelist_files/use_cases/scam_togaII.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/scam/iop/TOGAII_4scam.nc - -2.10 - 154.69 - 19921218 - 64800 - 1512 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_twp06.xml b/bld/namelist_files/use_cases/scam_twp06.xml deleted file mode 100644 index e599a45b16..0000000000 --- a/bld/namelist_files/use_cases/scam_twp06.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/scam/iop/TWP06_4scam.nc - -12.43 - 130.89 - 20060117 - 10800 - 1926 - 1500 - 9 - nsteps - - -2000 - - diff --git a/cime_config/SystemTests/sct.py b/cime_config/SystemTests/sct.py index 23108fc3a5..462280eb10 100644 --- a/cime_config/SystemTests/sct.py +++ b/cime_config/SystemTests/sct.py @@ -30,15 +30,17 @@ def __init__(self, case): def _case_one_setup(self): append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "inithist = 'CAMIOP'") + if self._case.get_value("CAM_DYCORE") == "se": + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scale_dry_air_mass = 0.0D0") CAM_CONFIG_OPTS = self._case1.get_value("CAM_CONFIG_OPTS") + self._case.set_value("BFBFLAG","TRUE") def _case_two_setup(self): case_name = self._case.get_value("CASE") RUN_STARTDATE = self._case1.get_value("RUN_STARTDATE") - append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "ncdata = '../"+case_name+".cam.i."+RUN_STARTDATE+"-00000.nc'") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "NDENS = 1,1,1,1,1,1") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "MFILT = 1,7,1,1,1,1") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "nhtfrq = 1,1,1,1,1,1") @@ -47,6 +49,8 @@ def _case_two_setup(self): append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "inithist = 'YEARLY'") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scm_cambfb_mode = .true.") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scm_use_obs_uv = .true.") + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scm_relaxation = .false.") + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scm_use_3dfrc = .true.") for comp in self._case.get_values("COMP_CLASSES"): self._case.set_value("NTASKS_{}".format(comp), 1) self._case.set_value("NTHRDS_{}".format(comp), 1) @@ -54,18 +58,28 @@ def _case_two_setup(self): if self._case.get_value("COMP_INTERFACE") == "mct": self._case.set_value("PTS_MODE","TRUE") - self._case.set_value("PTS_LAT",-20.0) - self._case.set_value("PTS_LON",140.0) - CAM_CONFIG_OPTS = self._case1.get_value("CAM_CONFIG_OPTS") - self._case.set_value("CAM_CONFIG_OPTS","{} -scam ".format(CAM_CONFIG_OPTS)) + self._case.set_value("BFBFLAG","TRUE") + + CAM_CONFIG_OPTS = self._case1.get_value("CAM_CONFIG_OPTS").replace('-camiop','') + self._case.set_value("CAM_CONFIG_OPTS","{} -scam camfrc ".format(CAM_CONFIG_OPTS)) + if self._case.get_value("CAM_DYCORE") == "se": + self._case.set_value("PTS_LAT",44.80320177421346) + self._case.set_value("PTS_LON",276.7082039324993) + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scale_dry_air_mass = 0.0D0") + else: + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "ncdata = '../"+case_name+".cam.i."+RUN_STARTDATE+"-00000.nc'") + self._case.set_value("PTS_LAT",-20.0) + self._case.set_value("PTS_LON",140.0) + + self._case.set_value("STOP_N",5) self._case.case_setup(test_mode=True, reset=True) def _component_compare_test(self, suffix1, suffix2, success_change=False, ignore_fieldlist_diffs=False): with self._test_status: - stat,netcdf_filename,err=run_cmd('ls ./run/case2run/*h1i*8400.nc ') + stat,netcdf_filename,err=run_cmd('ls ./run/case2run/*h1*0000.nc ') stat,DIFFs,err=run_cmd('ncdump -ff -p 9,17 -v QDIFF,TDIFF '+netcdf_filename+' | egrep //\.\*DIFF | sed s/^\ \*// | sed s/^0,/0.0,/ | sed s/^0\;/0.0\;/ | sed s/\[,\;\].\*// | uniq') array_of_DIFFs=DIFFs.split("\n") answer=max([abs(float(x)) for x in array_of_DIFFs]) diff --git a/cime_config/buildcpp b/cime_config/buildcpp index 5bbcf7d851..a5016f95f2 100644 --- a/cime_config/buildcpp +++ b/cime_config/buildcpp @@ -81,10 +81,6 @@ def buildcpp(case): if nlev: config_opts += ["-nlev", nlev] - # Some settings for single column mode. - if pts_mode: - config_opts.append("-scam") - if mpilib == 'mpi-serial': config_opts.append("-nospmd") else: diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 9af37fe033..6d652e8e03 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -9,9 +9,9 @@ =============== --> CAM cam7 physics: - CAM cam6 physics: - CAM cam5 physics: - CAM cam4 physics: + CAM cam6 physics: + CAM cam5 physics: + CAM cam4 physics: CAM cam3 physics: CAM simplified and non-versioned physics : @@ -28,7 +28,7 @@ SINGLE COLUMN CAM =============== --> - CAM stand-alone single column mode -- need to define usermods directory with IOP settings: + CAM stand-alone single column mode -- user defined IOP settings can be placed under the usermods scam_user directory: CAM specified dynamics is used in finite volume dynamical core: CAM physics is nudged towards prescribed meteorology: + -scam arm95 + -scam arm97 + -scam atex + -scam bomex + -scam cgilss11 + -scam cgilss12 + -scam cgilss6 + -scam dycomsrf01 + -scam dycomsrf02 + -scam gateIII + -scam mpace + -scam rico + -scam sparticus + -scam togaII + -scam twp06 + -scam camfrc + -phys adiabatic -phys adiabatic @@ -304,9 +321,6 @@ dctest_tj2016 dctest_frierson dctest_baro_kessler - - - run_component_cam env_run.xml @@ -363,7 +377,8 @@ $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/aquap $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/aquap - $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/scam_mandatory + $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/scam_mandatory + $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/scam_camfrc run_component_cam env_case.xml diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 002e8b184f..bcf685e66d 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -121,8 +121,98 @@ - FSCAM - 2000_CAM60%SCAM_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + FSCAMARM95 + 2000_CAM60%FSCAMARM95_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMARM97 + 2000_CAM60%SCAMARM97_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMATEX + 2000_CAM60%SCAMATEX_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMBOMEX + 2000_CAM60%SCAMBOMEX_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMCGILSS11 + 2000_CAM60%SCAMCGILSS11_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMCGILSS12 + 2000_CAM60%SCAMCGILSS12_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMCGILSS6 + 2000_CAM60%SCAMCGILSS6_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMDYCOMSRF01 + 2000_CAM60%SCAMDYCOMSRF01_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMDYCOMSRF02 + 2000_CAM60%SCAMDYCOMSRF02_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMGATE3 + 2000_CAM60%SCAMGATE3_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMMPACE + 2000_CAM60%SCAMMPACE_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMRICO + 2000_CAM60%SCAMRICO_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMSPARTICUS + 2000_CAM60%SCAMSPARTICUS_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMTOGA2 + 2000_CAM60%SCAMTOGA2_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMTWP06 + 2000_CAM60%SCAMTWP06_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMCAMFRC + 2000_CAM60%SCAMCAMFRC_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV @@ -213,7 +303,7 @@ QPSCAMC5 - 2000_CAM50%SCAM_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + 2000_CAM50%SCAMARM97_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV @@ -584,7 +674,6 @@ - 1997-06-18 1979-01-01 1950-01-01 2000-01-01 @@ -606,12 +695,70 @@ 2004-01-01 1950-01-01 + 1995-07-18 + 1997-06-18 + 1969-02-15 + 1969-06-25 + 1997-07-15 + 1997-07-15 + 1997-07-15 + 1999-07-11 + 1999-07-11 + 1974-08-30 + 2004-10-05 + 1995-07-15 + 2010-04-01 + 1992-12-18 + 2006-01-17 + 1997-06-18 + + + + + + 418 + 695 + 47 + 119 + 719 + 719 + 719 + 47 + 47 + 479 + 413 + 71 + 717 + 480 + 641 + 10 + + + + + + nhours - 84585 + 19800 + 84585 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 7171 + 0 + 3599 + 0 + 10800 + 0 @@ -717,13 +864,43 @@ - 36.6 + 36.6 + 36.6 + 15.0 + 15.0 + 32.0 + 35.0 + 17.0 + 31.5 + 31.5 + 9.0 + 70.5 + 18.0 + 36.6 + -2.1 + -12.43 + 36.6 - 262.5 + 262.5 + 262.5 + 345.0 + 300.0 + 231.0 + 235.0 + 211.0 + 238.5 + 238.5 + 336.0 + 206.0 + 298.5 + 262.51 + 154.69 + 130.89 + 262.5 diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index c074a75baf..7b50ec52f3 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -1,42 +1,8 @@ - - - none - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - - none @@ -109,6 +75,43 @@ + + + + none + + 24 + 24 + 24 + 24 + 24 + 24 + 24 + 24 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + @@ -2066,6 +2069,39 @@ 1 + + none + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 2e9445c61e..68a0ddbac3 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -1159,16 +1159,28 @@ + + + + + + + + + + + + @@ -1188,6 +1200,7 @@ + @@ -1349,10 +1362,21 @@ + + + + + + + + + + + @@ -1456,21 +1480,23 @@ - + + - + + diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods deleted file mode 100644 index 4b0f7f1abb..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods +++ /dev/null @@ -1 +0,0 @@ -../../../../usermods_dirs/scam_mpace diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands deleted file mode 100644 index eb40ad83e0..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands +++ /dev/null @@ -1,2 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam deleted file mode 100644 index 8482082dce..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam +++ /dev/null @@ -1,4 +0,0 @@ -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=9,9,9,9,9,9 -inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm deleted file mode 100644 index 0d83b5367b..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm +++ /dev/null @@ -1,27 +0,0 @@ -!---------------------------------------------------------------------------------- -! Users should add all user specific namelist changes below in the form of -! namelist_var = new_namelist_value -! -! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options -! are set in the CLM_NAMELIST_OPTS env variable. -! -! EXCEPTIONS: -! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting -! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting -! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting -! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting -! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting -! Set irrigate by the CLM_BLDNML_OPTS -irrig setting -! Set dtime with L_NCPL option -! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options -! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases -! (includes $inst_string for multi-ensemble cases) -! Set glc_grid with CISM_GRID option -! Set glc_smb with GLC_SMB option -! Set maxpatch_glcmec with GLC_NEC option -! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable -!---------------------------------------------------------------------------------- -hist_nhtfrq = 9 -hist_mfilt = 1 -hist_ndens = 1 - diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cpl deleted file mode 100644 index 398535cf65..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cpl +++ /dev/null @@ -1,2 +0,0 @@ -reprosum_diffmax=1.0e-14 -reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands b/cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands index 2898a75de3..3901f7a7b0 100644 --- a/cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands @@ -1,4 +1,3 @@ -./xmlchange -append CAM_CONFIG_OPTS="-scam" ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL ./xmlchange EPS_AAREA=9.0e-4 diff --git a/cime_config/usermods_dirs/scam_SAS/shell_commands b/cime_config/usermods_dirs/scam_SAS/shell_commands deleted file mode 100755 index 17c5081867..0000000000 --- a/cime_config/usermods_dirs/scam_SAS/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=272.85 -./xmlchange PTS_LAT=32.5 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2013-06-10 -./xmlchange START_TOD=43200 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_SAS/user_nl_cam b/cime_config/usermods_dirs/scam_SAS/user_nl_cam deleted file mode 100644 index 9a5a9304d7..0000000000 --- a/cime_config/usermods_dirs/scam_SAS/user_nl_cam +++ /dev/null @@ -1,17 +0,0 @@ -use_gw_front = .false. -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/SAS_ideal_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-06-01-00000.nc" -mfilt=30 -nhtfrq=1 -co2vmr=368.9e-6 -scm_use_obs_uv = .true. -scm_backfill_iop_w_init = .true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_arm95/shell_commands b/cime_config/usermods_dirs/scam_arm95/shell_commands deleted file mode 100755 index e902f2be49..0000000000 --- a/cime_config/usermods_dirs/scam_arm95/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=262.5 -./xmlchange PTS_LAT=36.6 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1995-07-18 -./xmlchange START_TOD=19800 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1259 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_arm95/user_nl_cam b/cime_config/usermods_dirs/scam_arm95/user_nl_cam deleted file mode 100644 index 591b415e0d..0000000000 --- a/cime_config/usermods_dirs/scam_arm95/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/ARM95_4scam.nc" -mfilt=1500 -nhtfrq=1 -co2vmr=368.9e-6 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_arm97/shell_commands b/cime_config/usermods_dirs/scam_arm97/shell_commands deleted file mode 100755 index a695db6d58..0000000000 --- a/cime_config/usermods_dirs/scam_arm97/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=262.5 -./xmlchange PTS_LAT=36.6 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-06-18 -./xmlchange START_TOD=84585 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=2088 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_arm97/user_nl_cam b/cime_config/usermods_dirs/scam_arm97/user_nl_cam deleted file mode 100644 index 3327b2c69a..0000000000 --- a/cime_config/usermods_dirs/scam_arm97/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/ARM97_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-06-01-00000.nc" -mfilt=2088 -nhtfrq=1 -co2vmr=368.9e-6 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_atex/shell_commands b/cime_config/usermods_dirs/scam_atex/shell_commands deleted file mode 100755 index cea0583b9b..0000000000 --- a/cime_config/usermods_dirs/scam_atex/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=345. -./xmlchange PTS_LAT=15. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1969-02-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=2 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_atex/user_nl_cam b/cime_config/usermods_dirs/scam_atex/user_nl_cam deleted file mode 100644 index d658f99157..0000000000 --- a/cime_config/usermods_dirs/scam_atex/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/ATEX_48hr_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-02-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_bomex/user_nl_cam b/cime_config/usermods_dirs/scam_bomex/user_nl_cam deleted file mode 100644 index e9132902b8..0000000000 --- a/cime_config/usermods_dirs/scam_bomex/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/BOMEX_5day_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-06-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_bomex/shell_commands b/cime_config/usermods_dirs/scam_camfrc/shell_commands similarity index 79% rename from cime_config/usermods_dirs/scam_bomex/shell_commands rename to cime_config/usermods_dirs/scam_camfrc/shell_commands index 6d2bb04886..b12fe28bb0 100755 --- a/cime_config/usermods_dirs/scam_bomex/shell_commands +++ b/cime_config/usermods_dirs/scam_camfrc/shell_commands @@ -1,15 +1,15 @@ # setup SCAM lon and lat for this iop # this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=300. -./xmlchange PTS_LAT=15. +./xmlchange PTS_LON=276.7082039324993 +./xmlchange PTS_LAT=44.80320177421346 # Specify the starting/ending time for the IOP # The complete time slice of IOP file is specified below # but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1969-06-25 +./xmlchange RUN_STARTDATE=1997-01-01 ./xmlchange START_TOD=0 ./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=5 +./xmlchange STOP_N=1 # usermods_dir/scam_mandatory will be included for all single column # runs by default. This usermods directory contains mandatory settings diff --git a/cime_config/usermods_dirs/scam_camfrc/user_nl_cam b/cime_config/usermods_dirs/scam_camfrc/user_nl_cam new file mode 100644 index 0000000000..1dc04efa8e --- /dev/null +++ b/cime_config/usermods_dirs/scam_camfrc/user_nl_cam @@ -0,0 +1,10 @@ +mfilt=2088 +nhtfrq=1 +co2vmr=368.9e-6 +scm_use_obs_uv = .true. +scm_relaxation = .false. +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS11/shell_commands b/cime_config/usermods_dirs/scam_cgilsS11/shell_commands deleted file mode 100755 index 37056ed761..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS11/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=231. -./xmlchange PTS_LAT=32. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam deleted file mode 100644 index c58ac57499..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S11_CTL_MixedLayerInit_reduced.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS12/shell_commands b/cime_config/usermods_dirs/scam_cgilsS12/shell_commands deleted file mode 100755 index fefce8216e..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS12/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=235. -./xmlchange PTS_LAT=35. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam deleted file mode 100644 index 52e9e20093..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S12_CTL_MixedLayerInit_reduced.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS6/shell_commands b/cime_config/usermods_dirs/scam_cgilsS6/shell_commands deleted file mode 100755 index 5ecc09e2a4..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS6/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=211. -./xmlchange PTS_LAT=17. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam deleted file mode 100644 index 6b2a0222f4..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S6_CTL_reduced.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands b/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands deleted file mode 100755 index 241e785227..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=238.5 -./xmlchange PTS_LAT=31.5 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1999-07-11 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=144 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam b/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam deleted file mode 100644 index 76a2c10c55..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/DYCOMSrf01_4day_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_use_obs_T =.true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands b/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands deleted file mode 100755 index 241e785227..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=238.5 -./xmlchange PTS_LAT=31.5 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1999-07-11 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=144 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam b/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam deleted file mode 100644 index 57ebe708ed..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/DYCOMSrf02_48hr_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_use_obs_T =.true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_gateIII/shell_commands b/cime_config/usermods_dirs/scam_gateIII/shell_commands deleted file mode 100755 index 03642e292a..0000000000 --- a/cime_config/usermods_dirs/scam_gateIII/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=336.0 -./xmlchange PTS_LAT=9.00 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1974-08-30 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1440 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_gateIII/user_nl_cam b/cime_config/usermods_dirs/scam_gateIII/user_nl_cam deleted file mode 100644 index 96e7b2ddbc..0000000000 --- a/cime_config/usermods_dirs/scam_gateIII/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/GATEIII_4scam_c170809.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-08-01-00000.nc" -mfilt=1440 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_micre2017/shell_commands b/cime_config/usermods_dirs/scam_micre2017/shell_commands deleted file mode 100755 index b7b2225466..0000000000 --- a/cime_config/usermods_dirs/scam_micre2017/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON= 141.5 -./xmlchange PTS_LAT= -56.0 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2017-01-01 -./xmlchange START_TOD=0000 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=90 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_micre2017/user_nl_cam b/cime_config/usermods_dirs/scam_micre2017/user_nl_cam deleted file mode 100644 index 675974b5e7..0000000000 --- a/cime_config/usermods_dirs/scam_micre2017/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile='$DIN_LOC_ROOT/atm/cam/scam/iop/micre2017_3mo.macquarie2017.iop.nc' -ncdata ='$DIN_LOC_ROOT/atm/cam/scam/iop/micre2017_3mo.cam.i.2017-01-01-00000.regrid.Gaus_64x128.nc' -mfilt=9000 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_mpace/shell_commands b/cime_config/usermods_dirs/scam_mpace/shell_commands deleted file mode 100755 index d9d0e50837..0000000000 --- a/cime_config/usermods_dirs/scam_mpace/shell_commands +++ /dev/null @@ -1,17 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=206.0 -./xmlchange PTS_LAT=70.5 - - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2004-10-05 -./xmlchange START_TOD=7171 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1242 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_mpace/user_nl_cam b/cime_config/usermods_dirs/scam_mpace/user_nl_cam deleted file mode 100644 index cb3263e871..0000000000 --- a/cime_config/usermods_dirs/scam_mpace/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/MPACE_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-10-01-00000.nc" -mfilt=1242 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_rico/shell_commands b/cime_config/usermods_dirs/scam_rico/shell_commands deleted file mode 100755 index ad424f951b..0000000000 --- a/cime_config/usermods_dirs/scam_rico/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=298.5 -./xmlchange PTS_LAT=18. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1995-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=216 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_rico/user_nl_cam b/cime_config/usermods_dirs/scam_rico/user_nl_cam deleted file mode 100644 index 968b1e3c71..0000000000 --- a/cime_config/usermods_dirs/scam_rico/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/RICO_3day_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_use_obs_T =.true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_sparticus/shell_commands b/cime_config/usermods_dirs/scam_sparticus/shell_commands deleted file mode 100755 index 68dbd4467c..0000000000 --- a/cime_config/usermods_dirs/scam_sparticus/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=262.51 -./xmlchange PTS_LAT=36.6 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2010-04-01 -./xmlchange START_TOD=3599 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=2156 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_sparticus/user_nl_cam b/cime_config/usermods_dirs/scam_sparticus/user_nl_cam deleted file mode 100644 index d12c7a3609..0000000000 --- a/cime_config/usermods_dirs/scam_sparticus/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/SPARTICUS_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-04-01-00000.nc" -mfilt=2156 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_togaII/shell_commands b/cime_config/usermods_dirs/scam_togaII/shell_commands deleted file mode 100755 index 6ab21646b1..0000000000 --- a/cime_config/usermods_dirs/scam_togaII/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=154.69 -./xmlchange PTS_LAT=-2.10 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1992-12-18 -./xmlchange START_TOD=64800 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1512 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_togaII/user_nl_cam b/cime_config/usermods_dirs/scam_togaII/user_nl_cam deleted file mode 100644 index f6a36ad6eb..0000000000 --- a/cime_config/usermods_dirs/scam_togaII/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/TOGAII_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-12-01-00000.nc" -mfilt=9 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_twp06/shell_commands b/cime_config/usermods_dirs/scam_twp06/shell_commands deleted file mode 100755 index 7787ba2453..0000000000 --- a/cime_config/usermods_dirs/scam_twp06/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=130.89 -./xmlchange PTS_LAT=-12.32 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2006-01-17 -./xmlchange START_TOD=10800 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1926 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_twp06/user_nl_cam b/cime_config/usermods_dirs/scam_twp06/user_nl_cam deleted file mode 100644 index 565a384502..0000000000 --- a/cime_config/usermods_dirs/scam_twp06/user_nl_cam +++ /dev/null @@ -1,16 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/TWP06_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-01-01-00000.nc" -mfilt=1926 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. -iradlw = 1 -iradsw = 1 diff --git a/components/cice b/components/cice index b56154b318..bdf6ea04d6 160000 --- a/components/cice +++ b/components/cice @@ -1 +1 @@ -Subproject commit b56154b318b41312faec8a8ebee86c866b47c9f2 +Subproject commit bdf6ea04d6133434fcaa4de5336de106f01290d0 diff --git a/doc/ChangeLog b/doc/ChangeLog index 973ef3b4e3..31167ed661 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,309 @@ +=============================================================== + +Tag name: cam6_4_023 +Originator(s): jet +Date: Aug 26, 2024 +One-line Summary: cam6_4_023: SCAM-SE feature addition plus bugfixes and some refactoring +Github PR URL: https://github.com/ESCOMP/CAM/pull/958 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +This update includes some refactoring of SCAM, a few bugfixes, and adding the capability to use +spectral elements dycore to do vertical transport in the column. The SE feature addition follows +the E3SM implementation where a complete coarse resolution (ne3np4) of the SE dycore is initialized +but only a single element is run through vertical transport. The single column chosen by scmlat, scmlon. + +Like the Eulerian version, SCAM-SE also has a bit for bit test to validate an exact run through +the same physics as the full 3d model. Because SCAM updates the solution using a slightly different +order of operations, the bfb capability is tested by making a special diagnostic run of CAM where +the 3d model derives the phys/dyn tendency each time step and then recalculates the prognostic +solution using the derived tendencies and SCAM's prognostic equation. This new solution (which is +less precise (roundoff) due to the change in order of operations) is substituted for the full 3d +solution at each time step of the model run. The substitution of the roundoff state in the 3d run +allows SCAM to reproduce (BFB) each time step using the captured tendencies in the cam iop history file. + +The SCAM-SE vertical advection skips the horizontal step and derives the floating level tendency +based on the IOP prescribed vertical velocity. The floating levels are subsequently remapped at +the end of the vertically Lagrangian dynamics step. + +Closes Issue SCAM-SE - Allow use of spectral elements dycore in single column mode. #957 +Closes Issue some SCAM IOP's are broken #853 +Closes Issue Unhelpful error message when running SCAM and IOP file is too short #742 + +Describe any changes made to build system: Allow SCAM to be built with spectral element dycore + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets:New boundary data for SE SCM + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-09-01-00000.nc + A atm/cam/inic/se/cami_0000-01-01_ne3np4_L30_c120315.nc + A atm/cam/inic/se/cami_0000-01-01_ne3np4_L26_c120525.nc + A atm/cam/topo/se/ne3np4_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230717.nc + A atm/cam/chem/trop_mam/atmsrf_ne3np4_230718.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-01-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-02-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-04-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-08-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-10-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-12-01-00000.nc + A atm/cam/scam/iop/micre2017_3mo.cam.i.2017-01-01-00000.regrid.ne3np4.nc + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume, cacraig + +List all files eliminated: + + D bld/namelist_files/use_cases/scam_arm95.xml + D bld/namelist_files/use_cases/scam_arm97.xml + D bld/namelist_files/use_cases/scam_gateIII.xml + D bld/namelist_files/use_cases/scam_mpace.xml + D bld/namelist_files/use_cases/scam_sparticus.xml + D bld/namelist_files/use_cases/scam_togaII.xml + D bld/namelist_files/use_cases/scam_twp06.xml + - These are now available via xml defaults + D cime_config/usermods_dirs/scam_arm95/shell_commands + D cime_config/usermods_dirs/scam_arm95/user_nl_cam + D cime_config/usermods_dirs/scam_arm97/shell_commands + D cime_config/usermods_dirs/scam_arm97/user_nl_cam + D cime_config/usermods_dirs/scam_atex/shell_commands + D cime_config/usermods_dirs/scam_atex/user_nl_cam + D cime_config/usermods_dirs/scam_bomex/user_nl_cam + D cime_config/usermods_dirs/scam_cgilsS11/shell_commands + D cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam + D cime_config/usermods_dirs/scam_cgilsS12/shell_commands + D cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam + D cime_config/usermods_dirs/scam_cgilsS6/shell_commands + D cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam + D cime_config/usermods_dirs/scam_dycomsRF01/shell_commands + D cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam + D cime_config/usermods_dirs/scam_dycomsRF02/shell_commands + D cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam + D cime_config/usermods_dirs/scam_gateIII/shell_commands + D cime_config/usermods_dirs/scam_gateIII/user_nl_cam + D cime_config/usermods_dirs/scam_micre2017/shell_commands + D cime_config/usermods_dirs/scam_micre2017/user_nl_cam + D cime_config/usermods_dirs/scam_mpace/shell_commands + D cime_config/usermods_dirs/scam_mpace/user_nl_cam + D cime_config/usermods_dirs/scam_rico/shell_commands + D cime_config/usermods_dirs/scam_rico/user_nl_cam + D cime_config/usermods_dirs/scam_SAS/shell_commands + D cime_config/usermods_dirs/scam_SAS/user_nl_cam + D cime_config/usermods_dirs/scam_sparticus/shell_commands + D cime_config/usermods_dirs/scam_sparticus/user_nl_cam + D cime_config/usermods_dirs/scam_togaII/shell_commands + D cime_config/usermods_dirs/scam_togaII/user_nl_cam + D cime_config/usermods_dirs/scam_twp06/shell_commands + D cime_config/usermods_dirs/scam_twp06/user_nl_cam + - replace by xml defaults + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cpl + - no longer valid for mpace setup + D src/control/history_defaults.F90 + - after moving scam specific code there was nothing left here + + +List all files added and what they do: N/A + A cime_config/usermods_dirs/scam_camfrc/shell_commands + A cime_config/usermods_dirs/scam_camfrc/user_nl_cam + A cime_config/usermods_dirs/scam_mandatory/shell_commands + - template directories for usermods to scam. + + A src/dynamics/se/apply_iop_forcing.F90 + A src/dynamics/se/dycore/se_single_column_mod.F90 + - enable iop forcing for SE SCM + +List all existing files that have been modified, and describe the changes: + M .gitmodules + - update cice to fix scam failure + - update cdeps to fix CDEPS regression test build failures + M bld/build-namelist + - update namelist defaults for scm relaxation. + M bld/config_files/definition.xml + - new configurations option for scam_iops + M bld/configure + - new configure options for SCAM refactor + M bld/namelist_files/namelist_defaults_cam.xml + M bld/namelist_files/namelist_definition.xml + - new configurations option for scam_iops + M cime_config/buildcpp + - setup new build for se SCAM test + M cime_config/config_component.xml + M cime_config/config_compsets.xml + - add scam defaults to cime + M cime_config/config_pes.xml + - add scam se pe defaults + M cime_config/SystemTests/sct.py + - setup new BFB se SCAM test + M cime_config/testdefs/testlist_cam.xml + - fix mpace test and add test_scam category + M cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands + - add new scam se regression tests + M cime_config/usermods_dirs/scam_mandatory/shell_commands + - add warmstart logic + M src/control/cam_comp.F90 + - cleanup some of the BFB_CAM_SCAM_IOP cppdefs + M src/control/cam_history.F90 + - set write_camiop logical if CAMIOP history type is requested by user. + M src/control/getinterpnetcdfdata.F90 + M src/control/history_scam.F90 + - generalize for output on single column grid + M src/control/ncdio_atm.F90 + - add physgrid_scm, scam uses the full physgrid to read data from boundary and + M src/control/scamMod.F90 + - new control parameters for SCAM-SE + M src/dynamics/eul/diag_dynvar_ic.F90 + M src/dynamics/eul/dyn_comp.F90 + M src/dynamics/eul/dynpkg.F90 + - remove more scam CPP defines + M src/dynamics/eul/dyn_grid.F90 + M src/dynamics/eul/iop.F90 + - generalize to use common routines for SE and EUL + M src/dynamics/eul/restart_dynamics.F90 + - remove more scam CPP defines + M src/dynamics/eul/scmforecast.F90 + M src/dynamics/eul/stepon.F90 + M src/dynamics/eul/tfilt_massfix.F90 + - refactor/cleanup + M src/dynamics/se/advect_tend.F90 + - capture SE advective tendencies for BFB testing + M src/dynamics/se/dp_coupling.F90 + - phys/dyn interface additions for SE-SCAM + M src/dynamics/se/dycore/prim_advance_mod.F90 + M src/dynamics/se/dycore/prim_driver_mod.F90 + M src/dynamics/se/dycore/vertremap_mod.F90 + M src/dynamics/se/dycore/viscosity_mod.F90 + - refactor/cleanup + M src/dynamics/se/dyn_comp.F90 + M src/dynamics/se/dyn_grid.F90 + - add SE single column mod + M src/dynamics/se/gravity_waves_sources.F90 + - hvcoord + M src/dynamics/se/stepon.F90 + - add SE SCAM iop update calls + M src/infrastructure/phys_grid.F90 + - update for single column phys grid + M src/physics/cam7/physpkg.F90 + M src/physics/cam/cam_diagnostics.F90 + - clean up BFB cpp defs + M src/physics/cam/check_energy.F90 + - add heat_glob for SE iop + M src/physics/cam/chem_surfvals.F90 + - add column initialization for greenhouse gasses + M src/physics/cam/clubb_intr.F90 + - use model grid box size not arbitrary SCM column size + M src/physics/cam/convect_shallow.F90 + - add DQP diagnostic + M src/physics/cam/phys_grid.F90 + - define scm single column grid for scm history + M src/physics/cam/physpkg.F90 + - clean up BFB cpp defs + M src/utils/cam_grid_support.F90 + - add trim to grid name + M src/utils/hycoef.F90 + - add hvcoord struct + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + - pre-existing pend/failures -- need fix in CLM external + + SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep BFAIL + - New Test; Failure expected (SCAM on spectral element grid) + + SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s BFAIL + - New Test; Failure expected; FSCAM compset named changed to FSCAMARM97 + + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + - Roundoff answer changes expected to existing SCAM prep cases + + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + - Expected differenc due to cice update, only 2 fields different as new cice has annual restarts off. + + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: NLFAIL) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: NLFAIL) details: + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: NLFAIL) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: NLFAIL) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: NLFAIL) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: NLFAIL) details + - Expected failures, In addition to differences these tests also failed namelist comparisons due to the updated cice + +derecho/nvhpc/aux_cam: + ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: NLFAIL) + - Expected failures due to the updated cice + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure - issue #670 + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + - Roundoff answer changes expected to existing SCAM cases + +izumi/gnu/aux_cam: + SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: FAIL) + - New Test Failure expected. + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + - Roundoff answer changes expected to existing SCAM cases + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + - Expected namelist failure due to cice update. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: SCAM tests +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate - larger changes confined to top levels that were ignored in previous versions. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +=============================================================== =============================================================== Tag name: cam6_4_022 diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 9982df6d2c..a040762067 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -70,7 +70,6 @@ subroutine cam_init( & ! !----------------------------------------------------------------------- - use history_defaults, only: bldfld use cam_initfiles, only: cam_initfiles_open use dyn_grid, only: dyn_grid_init use phys_grid, only: phys_grid_init @@ -81,15 +80,12 @@ subroutine cam_init( & use stepon, only: stepon_init use ionosphere_interface, only: ionosphere_init use camsrfexch, only: hub2atm_alloc, atm2hub_alloc - use cam_history, only: intht - use history_scam, only: scm_intht + use cam_history, only: intht, write_camiop + use history_scam, only: scm_intht, initialize_iop_history use cam_pio_utils, only: init_pio_subsystem use cam_instance, only: inst_suffix use cam_snapshot_common, only: cam_snapshot_deactivate use air_composition, only: air_composition_init -#if (defined BFB_CAM_SCAM_IOP) - use history_defaults, only: initialize_iop_history -#endif use phys_grid_ctem, only: phys_grid_ctem_reg ! Arguments @@ -193,14 +189,11 @@ subroutine cam_init( & call cam_read_restart(cam_in, cam_out, dyn_in, dyn_out, pbuf2d, stop_ymd, stop_tod) -#if (defined BFB_CAM_SCAM_IOP) - call initialize_iop_history() -#endif end if - call phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) + if (write_camiop) call initialize_iop_history() - call bldfld () ! master field list (if branch, only does hash tables) + call phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call stepon_init(dyn_in, dyn_out) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index a0b35e5a1d..99fb9b3a0b 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -182,6 +182,7 @@ module cam_history character(len=16) :: host ! host name character(len=8) :: inithist = 'YEARLY' ! If set to '6-HOURLY, 'DAILY', 'MONTHLY' or ! 'YEARLY' then write IC file + logical :: write_camiop = .false. ! setup to use iop fields if true. logical :: inithist_all = .false. ! Flag to indicate set of fields to be ! included on IC file ! .false. include only required fields @@ -317,8 +318,9 @@ module cam_history module procedure addfld_nd end interface - ! Needed by cam_diagnostics - public :: inithist_all + + public :: inithist_all ! Needed by cam_diagnostics + public :: write_camiop ! Needed by cam_comp integer :: lcltod_start(ptapes) ! start time of day for local time averaging (sec) integer :: lcltod_stop(ptapes) ! stop time of day for local time averaging, stop > start is wrap around (sec) @@ -852,25 +854,6 @@ subroutine history_readnl(nlfile) end do end if - ! Write out inithist info - if (masterproc) then - if (inithist == '6-HOURLY' ) then - write(iulog,*)'Initial conditions history files will be written 6-hourly.' - else if (inithist == 'DAILY' ) then - write(iulog,*)'Initial conditions history files will be written daily.' - else if (inithist == 'MONTHLY' ) then - write(iulog,*)'Initial conditions history files will be written monthly.' - else if (inithist == 'YEARLY' ) then - write(iulog,*)'Initial conditions history files will be written yearly.' - else if (inithist == 'CAMIOP' ) then - write(iulog,*)'Initial conditions history files will be written for IOP.' - else if (inithist == 'ENDOFRUN' ) then - write(iulog,*)'Initial conditions history files will be written at end of run.' - else - write(iulog,*)'Initial conditions history files will not be created' - end if - end if - ! Print out column-output information do t = 1, size(fincllonlat, 2) if (ANY(len_trim(fincllonlat(:,t)) > 0)) then @@ -916,6 +899,27 @@ subroutine history_readnl(nlfile) interpolate_info(t)%interp_nlon = interpolate_nlon(t) end do + ! Write out inithist info + if (masterproc) then + if (inithist == '6-HOURLY' ) then + write(iulog,*)'Initial conditions history files will be written 6-hourly.' + else if (inithist == 'DAILY' ) then + write(iulog,*)'Initial conditions history files will be written daily.' + else if (inithist == 'MONTHLY' ) then + write(iulog,*)'Initial conditions history files will be written monthly.' + else if (inithist == 'YEARLY' ) then + write(iulog,*)'Initial conditions history files will be written yearly.' + else if (inithist == 'CAMIOP' ) then + write(iulog,*)'Initial conditions history files will be written for IOP.' + else if (inithist == 'ENDOFRUN' ) then + write(iulog,*)'Initial conditions history files will be written at end of run.' + else + write(iulog,*)'Initial conditions history files will not be created' + end if + end if + if (inithist == 'CAMIOP') then + write_camiop=.true. + end if ! separate namelist reader for the satellite history file call sat_hist_readnl(nlfile, hfilename_spec, mfilt, fincl, nhtfrq, avgflag_pertape) diff --git a/src/dynamics/eul/getinterpnetcdfdata.F90 b/src/control/getinterpnetcdfdata.F90 similarity index 85% rename from src/dynamics/eul/getinterpnetcdfdata.F90 rename to src/control/getinterpnetcdfdata.F90 index a86ae52621..536d72d5de 100644 --- a/src/dynamics/eul/getinterpnetcdfdata.F90 +++ b/src/control/getinterpnetcdfdata.F90 @@ -3,13 +3,12 @@ module getinterpnetcdfdata ! Description: ! Routines for extracting a column from a netcdf file ! -! Author: -! +! Author: +! ! Modules Used: ! use cam_abortutils, only: endrun use pmgrid, only: plev - use scamMod, only: scm_crm_mode use cam_logfile, only: iulog implicit none @@ -22,10 +21,10 @@ module getinterpnetcdfdata contains subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & - varName, have_surfdat, surfdat, fill_ends, & - press, npress, ps, outData, STATUS ) + varName, have_surfdat, surfdat, fill_ends, scm_crm_mode, & + press, npress, ps, hyam, hybm, outData, STATUS ) -! getinterpncdata: extracts the entire level dimension for a +! getinterpncdata: extracts the entire level dimension for a ! particular lat,lon,time from a netCDF file ! and interpolates it onto the input pressure levels, placing ! result in outData, and the error status inx STATUS @@ -41,12 +40,15 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & integer, intent(in) :: NCID ! NetCDF ID integer, intent(in) :: TimeIdx ! time index - real(r8), intent(in) :: camlat,camlon ! target lat and lon to be extracted + real(r8), intent(in) :: camlat,camlon ! target lat and lon to be extracted logical, intent(in) :: have_surfdat ! is surfdat provided - logical, intent(in) :: fill_ends ! extrapolate the end values + logical, intent(in) :: fill_ends ! extrapolate the end values + logical, intent(in) :: scm_crm_mode ! scam column radiation mode integer, intent(in) :: npress ! number of dataset pressure levels real(r8), intent(in) :: press(npress) ! dataset pressure levels - real(r8), intent(in) :: ps ! dataset pressure levels + real(r8), intent(in) :: ps ! surface pressure + real(r8), intent(in) :: hyam(:) ! dataset hybrid midpoint pressure levels + real(r8), intent(in) :: hybm(:) ! dataset hybrid midpoint pressure levels ! ---------- outputs ---------- @@ -67,7 +69,7 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & integer dims_set integer i integer var_dimIDs( NF90_MAX_VAR_DIMS ) - integer start( NF90_MAX_VAR_DIMS ) + integer start( NF90_MAX_VAR_DIMS ) integer count( NF90_MAX_VAR_DIMS ) character varName*(*) @@ -115,9 +117,9 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & write(iulog,* ) 'ERROR - extractdata.F:Cant get dimension IDs for', varName return endif -! -! Initialize the start and count arrays -! +! +! Initialize the start and count arrays +! dims_set = 0 nlev = 1 do i = var_ndims, 1, -1 @@ -127,12 +129,12 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & if ( dim_name .EQ. 'lat' ) then start( i ) = latIdx - count( i ) = 1 ! Extract a single value + count( i ) = 1 ! Extract a single value dims_set = dims_set + 1 usable_var = .true. endif - if ( dim_name .EQ. 'lon' ) then + if ( dim_name .EQ. 'lon' .or. dim_name .EQ. 'ncol' .or. dim_name .EQ. 'ncol_d' ) then start( i ) = lonIdx count( i ) = 1 ! Extract a single value dims_set = dims_set + 1 @@ -155,10 +157,10 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & usable_var = .true. endif - if ( dim_name .EQ. 'time' .OR. dim_name .EQ. 'tsec' ) then + if ( dim_name .EQ. 'time' .OR. dim_name .EQ. 'tsec' ) then start( i ) = TimeIdx - count( i ) = 1 ! Extract a single value - dims_set = dims_set + 1 + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 usable_var = .true. endif @@ -187,11 +189,11 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & if ( nlev .eq. 1 ) then outdata(1) = tmp(1) - return ! no need to do interpolation + return ! no need to do interpolation endif ! if ( use_camiop .and. nlev.eq.plev) then if ( nlev.eq.plev .or. nlev.eq.plev+1) then - outData(:nlev)= tmp(:nlev)! no need to do interpolation + outData(:nlev)= tmp(:nlev)! no need to do interpolation else ! ! add the surface data if available, else @@ -224,7 +226,7 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & endif ! ! reset status to zero -! +! STATUS = 0 ! do i=1, npress @@ -236,7 +238,7 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & enddo #endif ! - call interplevs( tmp(:npress), press, npress, ps, fill_ends,outdata ) + call interplevs( tmp(:npress), press, npress, ps, fill_ends, hyam, hybm, outdata ) endif @@ -245,10 +247,9 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & end subroutine getinterpncdata subroutine interplevs( inputdata, dplevs, nlev, & - ps, fill_ends, outdata) + ps, fill_ends, hyam, hybm, outdata) use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 - use hycoef, only: hyam, hybm use interpolate_data, only: lininterp implicit none @@ -264,12 +265,14 @@ subroutine interplevs( inputdata, dplevs, nlev, & ! ------- inputs ----------- integer, intent(in) :: nlev ! num press levels in dataset - real(r8), intent(in) :: ps ! surface pressure + real(r8), intent(in) :: ps ! surface pressure + real(r8), intent(in) :: hyam(:) ! a midpoint pressure + real(r8), intent(in) :: hybm(:) ! b midpoint pressure real(r8), intent(in) :: inputdata(nlev) ! data from netcdf dataset - real(r8), intent(in) :: dplevs(nlev) ! input data pressure levels + real(r8), intent(in) :: dplevs(nlev) ! input data pressure levels logical, intent(in) :: fill_ends ! fill in missing end values(used for - ! global model datasets) + ! global model datasets) ! ------- outputs ---------- @@ -281,7 +284,7 @@ subroutine interplevs( inputdata, dplevs, nlev, & real(r8) interpdata( PLEV ) - integer dstart_lev, dend_lev + integer dstart_lev, dend_lev integer mstart_lev, mend_lev integer data_nlevs, model_nlevs, i integer STATUS @@ -293,14 +296,14 @@ subroutine interplevs( inputdata, dplevs, nlev, & do i = 1, plev mplevs( i ) = 1000.0_r8 * hyam( i ) + ps * hybm( i ) / 100.0_r8 end do -! +! ! the following algorithm assumes that pressures are increasing in the ! arrays -! -! +! +! ! Find the data pressure levels that are just outside the range ! of the model pressure levels, and that contain valid values -! +! dstart_lev = 1 do i= 1, nlev if ( dplevs(i) .LE. mplevs(1) ) dstart_lev = i @@ -312,7 +315,7 @@ subroutine interplevs( inputdata, dplevs, nlev, & dend_lev = i endif end do -! +! ! Find the model pressure levels that are just inside the range ! of the data pressure levels ! @@ -340,10 +343,10 @@ subroutine interplevs( inputdata, dplevs, nlev, & outdata( i+mstart_lev-1 ) = interpdata( i ) end do ! -! fill in the missing end values +! fill in the missing end values ! (usually done if this is global model dataset) ! - if ( fill_ends ) then + if ( fill_ends ) then do i=1, mstart_lev outdata(i) = inputdata(1) end do @@ -355,4 +358,3 @@ subroutine interplevs( inputdata, dplevs, nlev, & return end subroutine interplevs end module getinterpnetcdfdata - diff --git a/src/control/history_defaults.F90 b/src/control/history_defaults.F90 deleted file mode 100644 index 73e5554e14..0000000000 --- a/src/control/history_defaults.F90 +++ /dev/null @@ -1,143 +0,0 @@ -module history_defaults -!----------------------------------------------------------------------- -! -! Purpose: contains calls to setup default history stuff that has not found -! a proper home yet. Shouldn't really exist. -! -! Public functions/subroutines: -! bldfld -! -! Author: B.A. Boville from code in cam_history.F90 -!----------------------------------------------------------------------- - use constituents, only: pcnst, cnst_name - - use cam_history, only: addfld, add_default, horiz_only - implicit none - - PRIVATE - - public :: bldfld - -#if ( defined BFB_CAM_SCAM_IOP ) - public :: initialize_iop_history -#endif - -CONTAINS - - -!####################################################################### - subroutine bldfld () -! -!----------------------------------------------------------------------- -! -! Purpose: -! -! Build Master Field List of all possible fields in a history file. Each field has -! associated with it a "long_name" netcdf attribute that describes what the field is, -! and a "units" attribute. -! -! Method: Call a subroutine to add each field -! -! Author: CCM Core Group -! -!----------------------------------------------------------------------- -! -! Local workspace -! - integer m ! Index - -!jt -!jt Maybe add this to scam specific initialization -!jt - -#if ( defined BFB_CAM_SCAM_IOP ) - call addfld ('CLAT1&IC', horiz_only, 'I', ' ','cos lat for bfb testing', gridname='gauss_grid') - call add_default ('CLAT1&IC',0,'I') - call addfld ('CLON1&IC', horiz_only, 'I', ' ','cos lon for bfb testing', gridname='gauss_grid') - call add_default ('CLON1&IC',0,'I') - call addfld ('PHI&IC', horiz_only, 'I', ' ','lat for bfb testing', gridname='gauss_grid') - call add_default ('PHI&IC',0, 'I') - call addfld ('LAM&IC', horiz_only, 'I', ' ','lon for bfb testing', gridname='gauss_grid') - call add_default ('LAM&IC',0, 'I') -#endif - - call addfld ('DQP', (/ 'lev' /), 'A', 'kg/kg/s','Specific humidity tendency due to precipitation', & - gridname='physgrid') - - end subroutine bldfld - -!####################################################################### -#if ( defined BFB_CAM_SCAM_IOP ) - subroutine initialize_iop_history() -! -! !DESCRIPTION: -! !USES: - use iop - use phys_control, only: phys_getopts -! !ARGUMENTS: - implicit none -! -! !CALLED FROM: -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer m -!----------------------------------------------------------------------- - call addfld ('CLAT', horiz_only, 'A', ' ', 'cos lat for bfb testing', gridname='gauss_grid') - call add_default ('CLAT',2,' ') - call addfld ('q', (/ 'lev' /), 'A', 'kg/kg', 'Q for scam',gridname='gauss_grid') - call add_default ('q',2, ' ') - call addfld ('u', (/ 'lev' /), 'A', 'm/s', 'U for scam',gridname='gauss_grid') - call add_default ('u',2,' ') - call addfld ('v', (/ 'lev' /), 'A', 'm/s', 'V for scam',gridname='gauss_grid') - call add_default ('v',2,' ') - call addfld ('t', (/ 'lev' /), 'A', 'K', 'Temperature for scam',gridname='gauss_grid') - call add_default ('t',2,' ') - call addfld ('Tg', horiz_only, 'A', 'K', 'Surface temperature (radiative) for scam',gridname='physgrid') - call add_default ('Tg',2,' ') - call addfld ('Ps', horiz_only, 'A', 'Pa', 'Ps for scam',gridname='gauss_grid') - call add_default ('Ps',2,' ') - call addfld ('divT3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for T',gridname='gauss_grid') - call add_default ('divT3d',2,' ') - call addfld ('divU3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for U',gridname='gauss_grid') - call add_default ('divU3d',2,' ') - call addfld ('divV3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for V',gridname='gauss_grid') - call add_default ('divV3d',2,' ') - call addfld ('fixmas', horiz_only, 'A', 'percent','Mass fixer',gridname='gauss_grid') - call add_default ('fixmas',2,' ') - call addfld ('beta', horiz_only, 'A', 'percent','Mass fixer',gridname='gauss_grid') - call add_default ('beta',2,' ') - do m=1,pcnst - call addfld (trim(cnst_name(m))//'_dten', (/ 'lev' /), 'A', 'kg/kg', & - trim(cnst_name(m))//' IOP Dynamics Residual for '//trim(cnst_name(m)),gridname='gauss_grid') - call add_default (trim(cnst_name(m))//'_dten',2,' ') - call addfld (trim(cnst_name(m))//'_alph', horiz_only, 'A', 'kg/kg',trim(cnst_name(m))//' alpha constituent fixer', & - gridname='gauss_grid') - call add_default (trim(cnst_name(m))//'_alph',2,' ') - call addfld (trim(cnst_name(m))//'_dqfx', (/ 'lev' /), 'A', 'kg/kg',trim(cnst_name(m))//' dqfx3 fixer', & - gridname='gauss_grid') - call add_default (trim(cnst_name(m))//'_dqfx',2,' ') - end do - call addfld ('shflx', horiz_only, 'A', 'W/m2', 'Surface sensible heat flux for scam',gridname='physgrid') - call add_default ('shflx',2,' ') - call addfld ('lhflx', horiz_only, 'A', 'W/m2', 'Surface latent heat flux for scam',gridname='physgrid') - call add_default ('lhflx',2,' ') - call addfld ('trefht', horiz_only, 'A', 'K', 'Reference height temperature',gridname='physgrid') - call add_default ('trefht',2,' ') - call addfld ('Tsair', horiz_only, 'A', 'K', 'Reference height temperature for scam',gridname='physgrid') - call add_default ('Tsair',2,' ') - call addfld ('phis', horiz_only, 'I', 'm2/s2','Surface geopotential for scam',gridname='physgrid') - call add_default ('phis',2,' ') - call addfld ('Prec', horiz_only, 'A', 'm/s', 'Total (convective and large-scale) precipitation rate for scam', & - gridname='physgrid') - call add_default ('Prec',2,' ') - call addfld ('omega', (/ 'lev' /), 'A', 'Pa/s', 'Vertical velocity (pressure)',gridname='physgrid') - call add_default ('omega',2,' ') - - end subroutine initialize_iop_history -#endif - -end module history_defaults diff --git a/src/control/history_scam.F90 b/src/control/history_scam.F90 index 2c81ce1a78..e171fcee96 100644 --- a/src/control/history_scam.F90 +++ b/src/control/history_scam.F90 @@ -1,106 +1,219 @@ module history_scam -!----------------------------------------------------------------------- -! +!----------------------------------------------------------------------- +! ! Purpose: SCAM specific history code. ! ! Public functions/subroutines: ! bldfld, h_default -! +! ! Author: anonymous from code in cam_history.F90 !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_history, only: addfld, add_default, horiz_only + use cam_grid_support, only: max_hcoordname_len implicit none PRIVATE public :: scm_intht + public :: initialize_iop_history !####################################################################### CONTAINS subroutine scm_intht() -!----------------------------------------------------------------------- -! -! Purpose: +!----------------------------------------------------------------------- +! +! Purpose: ! ! add master list fields to scm -! +! ! Method: Call a subroutine to add each field -! +! ! Author: CCM Core Group -! +! !----------------------------------------------------------------------- - use cam_history, only: addfld, add_default, horiz_only + use dycore, only: dycore_is + use cam_history, only: write_camiop !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- ! Local variables ! - integer m,j ! Indices - real(r8) dummy + character(len=max_hcoordname_len) outgrid + + if (dycore_is('SE')) then + ! for camiop mode use the GLL grid otherwise use physics grids for SCM mode output + if (write_camiop) then + outgrid = 'GLL' + else + outgrid = 'physgrid' + end if + else if (dycore_is('EUL')) then + outgrid = 'gauss_grid' + else + outgrid = 'unknown' + end if ! ! Call addfld to add each field to the Master Field List. ! - call addfld ('TDIFF', (/ 'lev' /), 'A', 'K','difference from observed temp', gridname='gauss_grid') - call addfld ('UDIFF', (/ 'lev' /), 'A', 'K','difference from observed u wind', gridname='gauss_grid') - call addfld ('VDIFF', (/ 'lev' /), 'A', 'K','difference from observed v wind', gridname='gauss_grid') + call addfld ('TDIFF', (/ 'lev' /), 'A', 'K','difference from observed temp', gridname=trim(outgrid)) + call addfld ('UDIFF', (/ 'lev' /), 'A', 'K','difference from observed u wind', gridname=trim(outgrid)) + call addfld ('VDIFF', (/ 'lev' /), 'A', 'K','difference from observed v wind', gridname=trim(outgrid)) call addfld ('TOBS', (/ 'lev' /), 'A', 'K','observed temp') - call addfld ('QDIFF', (/ 'lev' /), 'A', 'kg/kg','difference from observed water', gridname='gauss_grid') + call addfld ('QDIFF', (/ 'lev' /), 'A', 'kg/kg','difference from observed water', gridname=trim(outgrid)) call addfld ('QOBS', (/ 'lev' /), 'A', 'kg/kg','observed water', gridname='physgrid') call addfld ('PRECOBS', (/ 'lev' /), 'A', 'mm/day','Total (convective and large-scale) precipitation rate', & gridname='physgrid') call addfld ('DIVQ', (/ 'lev' /), 'A', 'kg/kg/s','Q advection tendency (horizontal)', gridname='physgrid') - call addfld ('DIVQ3D', (/ 'lev' /), 'A', 'kg/kg/s','Q advection tendency (horiz/vert combined)', gridname='gauss_grid') + call addfld ('DIVQ3D', (/ 'lev' /), 'A', 'kg/kg/s','Q advection tendency (horiz/vert combined)', gridname=trim(outgrid)) call addfld ('DIVV', (/ 'lev' /), 'A', 'm/s2','V advection tendency (horizontal)', gridname='physgrid') call addfld ('DIVU', (/ 'lev' /), 'A', 'm/s2','U advection tendency (horizontal)', gridname='physgrid') call addfld ('DIVT', (/ 'lev' /), 'A', 'K/s','T advection tendency (horizontal)', gridname='physgrid') - call addfld ('DIVT3D', (/ 'lev' /), 'A', 'K/s','T advection tendency (horiz/vert combined)', gridname='gauss_grid') - call addfld ('DIVU3D', (/ 'lev' /), 'A', 'K/s','U advection tendency (horiz/vert combined)', gridname='gauss_grid') - call addfld ('DIVV3D', (/ 'lev' /), 'A', 'K/s','V advection tendency (horiz/vert combined)', gridname='gauss_grid') + call addfld ('DIVT3D', (/ 'lev' /), 'A', 'K/s','T advection tendency (horiz/vert combined)', gridname=trim(outgrid)) + call addfld ('DIVU3D', (/ 'lev' /), 'A', 'K/s','U advection tendency (horiz/vert combined)', gridname=trim(outgrid)) + call addfld ('DIVV3D', (/ 'lev' /), 'A', 'K/s','V advection tendency (horiz/vert combined)', gridname=trim(outgrid)) call addfld ('SHFLXOBS', horiz_only, 'A', 'W/m2','Obs Surface sensible heat flux', gridname='physgrid') call addfld ('LHFLXOBS', horiz_only, 'A', 'W/m2','Obs Surface latent heat flux', gridname='physgrid') - call addfld ('TRELAX', (/ 'lev' /), 'A', 'K','t relaxation amount', gridname='gauss_grid') - call addfld ('QRELAX', (/ 'lev' /), 'A', 'kg/kg','q relaxation amount', gridname='gauss_grid') - call addfld ('TAURELAX', (/ 'lev' /), 'A', 'seconds','relaxation time constant', gridname='gauss_grid') + call addfld ('TRELAX', (/ 'lev' /), 'A', 'K','t relaxation amount', gridname=trim(outgrid)) + call addfld ('QRELAX', (/ 'lev' /), 'A', 'kg/kg','q relaxation amount', gridname=trim(outgrid)) + call addfld ('TAURELAX', (/ 'lev' /), 'A', 'seconds','relaxation time constant', gridname=trim(outgrid)) call add_default ('TDIFF', 1, ' ') call add_default ('QDIFF', 1, ' ') ! Vertical advective forcing of 'T,u,v,qv,ql,qi,nl,ni' in forecast.F90 - call addfld ('TTEN_XYADV', (/ 'lev' /), 'I', 'K/s', 'T horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('UTEN_XYADV', (/ 'lev' /), 'I', 'm/s^2', 'U horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('VTEN_XYADV', (/ 'lev' /), 'I', 'm/s^2', 'V horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('QVTEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QV horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('QLTEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QL horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('QITEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QI horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('NLTEN_XYADV', (/ 'lev' /), 'I', '#/kg/s', 'NL horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('NITEN_XYADV', (/ 'lev' /), 'I', '#/kg/s', 'NI horizontal advective forcing', gridname='gauss_grid' ) - -! call addfld ('T3D_ADV_SLT', 'K/s' , pver, 'I', 'T 3d slt advective forcing', gridname='physgrid') -! call addfld ('U3D_ADV_SLT', 'm/s^2' , pver, 'I', 'U 3d slt advective forcing', gridname='physgrid') -! call addfld ('V3D_ADV_SLT', 'm/s^2' , pver, 'I', 'V 3d slt advective forcing', gridname='physgrid') - call addfld ('TTEN_ZADV', (/ 'lev' /), 'I', 'K/s', 'T vertical advective forcing', gridname='gauss_grid' ) - call addfld ('UTEN_ZADV', (/ 'lev' /), 'I', 'm/s^2', 'U vertical advective forcing', gridname='gauss_grid' ) - call addfld ('VTEN_ZADV', (/ 'lev' /), 'I', 'm/s^2', 'V vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QVTEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QV vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QLTEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QL vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QITEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QI vertical advective forcing', gridname='gauss_grid' ) - call addfld ('NLTEN_ZADV', (/ 'lev' /), 'I', '#/kg/s', 'NL vertical advective forcing', gridname='gauss_grid' ) - call addfld ('NITEN_ZADV', (/ 'lev' /), 'I', '#/kg/s', 'NI vertical advective forcing', gridname='gauss_grid' ) - - call addfld ('TTEN_PHYS', (/ 'lev' /), 'I', 'K/s', 'T vertical advective forcing', gridname='gauss_grid' ) - call addfld ('UTEN_PHYS', (/ 'lev' /), 'I', 'm/s^2', 'U vertical advective forcing', gridname='gauss_grid' ) - call addfld ('VTEN_PHYS', (/ 'lev' /), 'I', 'm/s^2', 'V vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QVTEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QV vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QLTEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QL vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QITEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QI vertical advective forcing', gridname='gauss_grid' ) - call addfld ('NLTEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NL vertical advective forcing', gridname='gauss_grid' ) - call addfld ('NITEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NI vertical advective forcing', gridname='gauss_grid' ) + call addfld ('TTEN_XYADV', (/ 'lev' /), 'I', 'K/s', 'T horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('UTEN_XYADV', (/ 'lev' /), 'I', 'm/s^2', 'U horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('VTEN_XYADV', (/ 'lev' /), 'I', 'm/s^2', 'V horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('QVTEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QV horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('QLTEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QL horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('QITEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QI horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('NLTEN_XYADV', (/ 'lev' /), 'I', '#/kg/s', 'NL horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('NITEN_XYADV', (/ 'lev' /), 'I', '#/kg/s', 'NI horizontal advective forcing', gridname=trim(outgrid) ) + + call addfld ('TTEN_ZADV', (/ 'lev' /), 'I', 'K/s', 'T vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('UTEN_ZADV', (/ 'lev' /), 'I', 'm/s^2', 'U vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('VTEN_ZADV', (/ 'lev' /), 'I', 'm/s^2', 'V vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QVTEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QV vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QLTEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QL vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QITEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QI vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('NLTEN_ZADV', (/ 'lev' /), 'I', '#/kg/s', 'NL vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('NITEN_ZADV', (/ 'lev' /), 'I', '#/kg/s', 'NI vertical advective forcing', gridname=trim(outgrid) ) + + call addfld ('TTEN_PHYS', (/ 'lev' /), 'I', 'K/s', 'T vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('UTEN_PHYS', (/ 'lev' /), 'I', 'm/s^2', 'U vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('VTEN_PHYS', (/ 'lev' /), 'I', 'm/s^2', 'V vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QVTEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QV vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QLTEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QL vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QITEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QI vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('NLTEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NL vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('NITEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NI vertical advective forcing', gridname=trim(outgrid) ) end subroutine scm_intht +!####################################################################### + subroutine initialize_iop_history() +!----------------------------------------------------------------------- +! +! Purpose: Add fields and set defaults for SCAM CAM BFB IOP initial file +! as well as single column output history +! +! Method: Call a subroutine to add each field +! +!----------------------------------------------------------------------- +! +! !USES: + use constituents, only: pcnst, cnst_name + use dycore, only: dycore_is +! !ARGUMENTS: + implicit none + +! !LOCAL VARIABLES: + integer m + character(len=max_hcoordname_len) outgrid + +!----------------------------------------------------------------------- + + if (dycore_is('SE')) then + outgrid = 'GLL' + else if (dycore_is('EUL')) then + outgrid = 'gauss_grid' + else if (dycore_is('EUL')) then + outgrid = 'unknown' + end if + + if (trim(outgrid) == 'gauss_grid') then + call addfld ('CLAT1&IC', horiz_only, 'I', ' ','cos lat for bfb testing', gridname=trim(outgrid)) + call add_default ('CLAT1&IC',0,'I') + call addfld ('CLON1&IC', horiz_only, 'I', ' ','cos lon for bfb testing', gridname=trim(outgrid)) + call add_default ('CLON1&IC',0,'I') + call addfld ('PHI&IC', horiz_only, 'I', ' ','lat for bfb testing', gridname=trim(outgrid)) + call add_default ('PHI&IC',0, 'I') + call addfld ('LAM&IC', horiz_only, 'I', ' ','lon for bfb testing', gridname=trim(outgrid)) + call add_default ('LAM&IC',0, 'I') + + call addfld ('CLAT', horiz_only, 'A', ' ', 'cos lat for bfb testing', gridname=trim(outgrid)) + call add_default ('CLAT',2,' ') + + call addfld ('fixmas', horiz_only, 'A', 'percent','Mass fixer',gridname=trim(outgrid)) + call add_default ('fixmas',2,' ') + call addfld ('beta', horiz_only, 'A', 'percent','Energy fixer',gridname=trim(outgrid)) + call add_default ('beta',2,' ') + end if + + call addfld ('q', (/ 'lev' /), 'A', 'kg/kg', 'Q for scam',gridname=trim(outgrid)) + call add_default ('q',2, ' ') + call addfld ('u', (/ 'lev' /), 'A', 'm/s', 'U for scam',gridname=trim(outgrid)) + call add_default ('u',2,' ') + call addfld ('v', (/ 'lev' /), 'A', 'm/s', 'V for scam',gridname=trim(outgrid)) + call add_default ('v',2,' ') + call addfld ('t', (/ 'lev' /), 'A', 'K', 'Temperature for scam',gridname=trim(outgrid)) + call add_default ('t',2,' ') + call addfld ('Tg', horiz_only, 'A', 'K', 'Surface temperature (radiative) for scam',gridname='physgrid') + call add_default ('Tg',2,' ') + call addfld ('Ps', horiz_only, 'A', 'Pa', 'Surface Pressure for SCAM',gridname=trim(outgrid)) + call add_default ('Ps',2,' ') + call addfld ('divT3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for T',gridname=trim(outgrid)) + call add_default ('divT3d',2,' ') + call addfld ('divU3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for U',gridname=trim(outgrid)) + call add_default ('divU3d',2,' ') + call addfld ('divV3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for V',gridname=trim(outgrid)) + call add_default ('divV3d',2,' ') + call addfld ('heat_glob',horiz_only, 'A', 'K/s', 'Global mean total energy difference') + call add_default ('heat_glob',2,' ') + do m=1,pcnst + call addfld (trim(cnst_name(m))//'_dten', (/ 'lev' /), 'A', 'kg/kg', & + trim(cnst_name(m))//' IOP Dynamics Residual for '//trim(cnst_name(m)),gridname=trim(outgrid)) + call add_default (trim(cnst_name(m))//'_dten',2,' ') + if (trim(outgrid) == 'gauss_grid') then + call addfld (trim(cnst_name(m))//'_alph', horiz_only, 'A', 'kg/kg',trim(cnst_name(m))//' alpha constituent fixer', & + gridname=trim(outgrid)) + call add_default (trim(cnst_name(m))//'_alph',2,' ') + call addfld (trim(cnst_name(m))//'_dqfx', (/ 'lev' /), 'A', 'kg/kg',trim(cnst_name(m))//' dqfx3 fixer', & + gridname=trim(outgrid)) + call add_default (trim(cnst_name(m))//'_dqfx',2,' ') + end if + end do + call addfld ('shflx', horiz_only, 'A', 'W/m2', 'Surface sensible heat flux for scam',gridname='physgrid') + call add_default ('shflx',2,' ') + call addfld ('lhflx', horiz_only, 'A', 'W/m2', 'Surface latent heat flux for scam',gridname='physgrid') + call add_default ('lhflx',2,' ') + call addfld ('trefht', horiz_only, 'A', 'K', 'Reference height temperature',gridname='physgrid') + call add_default ('trefht',2,' ') + call addfld ('Tsair', horiz_only, 'A', 'K', 'Reference height temperature for scam',gridname='physgrid') + call add_default ('Tsair',2,' ') + call addfld ('phis', horiz_only, 'I', 'm2/s2','Surface geopotential for scam',gridname='physgrid') + call add_default ('phis',2,' ') + call addfld ('Prec', horiz_only, 'A', 'm/s', 'Total (convective and large-scale) precipitation rate for scam', & + gridname='physgrid') + call add_default ('Prec',2,' ') + call addfld ('omega', (/ 'lev' /), 'A', 'Pa/s', 'Vertical velocity (pressure)',gridname='physgrid') + call add_default ('omega',2,' ') + + end subroutine initialize_iop_history !####################################################################### end module history_scam diff --git a/src/control/ncdio_atm.F90 b/src/control/ncdio_atm.F90 index fd57906da4..f727fc8f25 100644 --- a/src/control/ncdio_atm.F90 +++ b/src/control/ncdio_atm.F90 @@ -20,6 +20,9 @@ module ncdio_atm use scamMod, only: scmlat,scmlon,single_column use cam_logfile, only: iulog use string_utils, only: to_lower + use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id, & + cam_grid_dimensions, cam_grid_get_latvals, cam_grid_get_lonvals, & + max_hcoordname_len ! ! !PUBLIC TYPES: implicit none @@ -40,11 +43,8 @@ module ncdio_atm module procedure infld_real_3d_3d end interface - public :: infld - integer STATUS - real(r8) surfdat !----------------------------------------------------------------------- contains @@ -66,10 +66,8 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & ! !USES ! - use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel - use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname - use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id, & - cam_grid_dimensions + use pio, only: pio_read_darray, pio_setdebuglevel + use pio, only: PIO_MAX_NAME, pio_inq_dimname use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill ! @@ -93,7 +91,7 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & ! !LOCAL VARIABLES: type(io_desc_t), pointer :: iodesc integer :: grid_id ! grid ID for data mapping - integer :: i, j ! indices + integer :: j ! index integer :: ierr ! error status type(var_desc_t) :: varid ! variable id integer :: no_fill @@ -104,56 +102,49 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & integer :: dimlens(PIO_MAX_VAR_DIMS) ! file variable shape integer :: grid_dimlens(2) - ! Offsets for reading global variables - integer :: strt(1) = 1 ! start ncol index for netcdf 1-d - integer :: cnt (1) = 1 ! ncol count for netcdf 1-d character(len=PIO_MAX_NAME) :: tmpname character(len=128) :: errormsg logical :: readvar_tmp ! if true, variable is on tape character(len=*), parameter :: subname='INFLD_REAL_1D_2D' ! subroutine name - - ! For SCAM - real(r8) :: closelat, closelon - integer :: lonidx, latidx - - nullify(iodesc) + character(len=max_hcoordname_len) :: vargridname ! Name of variable's grid ! !----------------------------------------------------------------------- ! ! call pio_setdebuglevel(3) + nullify(iodesc) + ! ! Error conditions ! if (present(gridname)) then - grid_id = cam_grid_id(trim(gridname)) + vargridname=trim(gridname) else - grid_id = cam_grid_id('physgrid') + vargridname='physgrid' + end if + + if (single_column .and. vargridname=='physgrid') then + vargridname='physgrid_scm' end if + + grid_id = cam_grid_id(trim(vargridname)) + if (.not. cam_grid_check(grid_id)) then if(masterproc) then - if (present(gridname)) then - write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) - else - write(errormsg, *)': Internal error, no "physgrid" gridname' - end if + write(errormsg, *)': invalid gridname, "',trim(vargridname),'", specified for field ',trim(varname) end if call endrun(trim(subname)//errormsg) end if - ! Get the number of columns in the global grid. - call cam_grid_dimensions(grid_id, grid_dimlens) - if (debug .and. masterproc) then - if (present(gridname)) then - write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) - else - write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' - end if - call shr_sys_flush(iulog) + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(vargridname) + call shr_sys_flush(iulog) end if + + ! Get the number of columns in the global grid. + call cam_grid_dimensions(grid_id, grid_dimlens) ! ! Read netCDF file ! @@ -190,7 +181,7 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & else ! Check that the number of columns in the file matches the number of ! columns in the grid object. - if (dimlens(1) /= grid_dimlens(1)) then + if (dimlens(1) /= grid_dimlens(1) .and. .not. single_column) then readvar = .false. return end if @@ -213,20 +204,14 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & ndims = ndims - 1 end if - ! NB: strt and cnt were initialized to 1 - if (single_column) then - !!XXgoldyXX: Clearly, this will not work for an unstructured dycore - call endrun(trim(subname)//': SCAM not supported in this configuration') - else - ! All distributed array processing - call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:ndims), & - pio_double, iodesc) - call pio_read_darray(ncid, varid, iodesc, field, ierr) - if (present(fillvalue)) then - ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) - end if - end if - + ! nb: strt and cnt were initialized to 1 + ! all distributed array processing + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:ndims), & + pio_double, iodesc) + call pio_read_darray(ncid, varid, iodesc, field, ierr) + if (present(fillvalue)) then + ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) + end if if (masterproc) write(iulog,*) subname//': read field '//trim(varname) @@ -245,7 +230,7 @@ end subroutine infld_real_1d_2d ! ! !INTERFACE: subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & - dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel, & + dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel, & fillvalue) ! ! !DESCRIPTION: @@ -256,8 +241,7 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & ! use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel - use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname - use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id + use pio, only: PIO_MAX_NAME, pio_inq_dimname use cam_pio_utils, only: cam_permute_array, calc_permutation use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill @@ -307,6 +291,7 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & logical :: readvar_tmp ! if true, variable is on tape character(len=*), parameter :: subname='INFLD_REAL_2D_2D' ! subroutine name character(len=PIO_MAX_NAME) :: field_dnames(2) + character(len=max_hcoordname_len) :: vargridname ! Name of variable's grid ! For SCAM real(r8) :: closelat, closelon @@ -329,30 +314,27 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & ! Error conditions ! if (present(gridname)) then - grid_id = cam_grid_id(trim(gridname)) + vargridname=trim(gridname) else - grid_id = cam_grid_id('physgrid') + vargridname='physgrid' + end if + + if (single_column .and. vargridname=='physgrid') then + vargridname='physgrid_scm' end if + + grid_id = cam_grid_id(trim(vargridname)) if (.not. cam_grid_check(grid_id)) then if(masterproc) then - if (present(gridname)) then - write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) - else - write(errormsg, *)': Internal error, no "physgrid" gridname' - end if + write(errormsg, *)': invalid gridname, "',trim(vargridname),'", specified for field ',trim(varname) end if call endrun(trim(subname)//errormsg) end if - if (debug .and. masterproc) then - if (present(gridname)) then - write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) - else - write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' + if (debug .and. masterproc) then + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(vargridname) + call shr_sys_flush(iulog) end if - call shr_sys_flush(iulog) - end if - ! ! Read netCDF file ! @@ -485,10 +467,7 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & ! use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel - use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname - use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id, & - cam_grid_dimensions - use cam_pio_utils, only: cam_permute_array, calc_permutation + use pio, only: PIO_MAX_NAME, pio_inq_dimname use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill ! @@ -515,14 +494,11 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & ! !LOCAL VARIABLES: type(io_desc_t), pointer :: iodesc integer :: grid_id ! grid ID for data mapping - integer :: i, j, k ! indices + integer :: j ! index integer :: ierr ! error status type(var_desc_t) :: varid ! variable id integer :: arraydimsize(3) ! field dimension lengths - integer :: arraydimids(2) ! Dimension IDs - integer :: permutation(2) - logical :: ispermuted integer :: ndims ! number of dimensions integer :: dimids(PIO_MAX_VAR_DIMS) ! file variable dims @@ -534,56 +510,49 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & integer :: cnt (3) = 1 ! ncol, lev counts for netcdf 2-d character(len=PIO_MAX_NAME) :: tmpname - real(r8), pointer :: tmp3d(:,:,:) ! input data for permutation - logical :: readvar_tmp ! if true, variable is on tape character(len=*), parameter :: subname='INFLD_REAL_2D_3D' ! subroutine name character(len=128) :: errormsg character(len=PIO_MAX_NAME) :: field_dnames(2) character(len=PIO_MAX_NAME) :: file_dnames(3) - - ! For SCAM - real(r8) :: closelat, closelon - integer :: lonidx, latidx - - nullify(iodesc) + character(len=max_hcoordname_len) :: vargridname ! Name of variable's grid ! !----------------------------------------------------------------------- ! ! call pio_setdebuglevel(3) + nullify(iodesc) + ! ! Error conditions ! if (present(gridname)) then - grid_id = cam_grid_id(trim(gridname)) + vargridname=trim(gridname) else - grid_id = cam_grid_id('physgrid') + vargridname='physgrid' end if + + ! if running single column mode then we need to use scm grid to read proper column + if (single_column .and. vargridname=='physgrid') then + vargridname='physgrid_scm' + end if + + grid_id = cam_grid_id(trim(vargridname)) if (.not. cam_grid_check(grid_id)) then if(masterproc) then - if (present(gridname)) then - write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) - else - write(errormsg, *)': Internal error, no "physgrid" gridname' - end if + write(errormsg, *)': invalid gridname, "',trim(vargridname),'", specified for field ',trim(varname) end if call endrun(trim(subname)//errormsg) end if - ! Get the number of columns in the global grid. - call cam_grid_dimensions(grid_id, grid_dimlens) - if (debug .and. masterproc) then - if (present(gridname)) then - write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) - else - write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' - end if + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(vargridname) call shr_sys_flush(iulog) end if + ! Get the number of columns in the global grid. + call cam_grid_dimensions(grid_id, grid_dimlens) ! ! Read netCDF file ! @@ -623,7 +592,7 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & else ! Check that the number of columns in the file matches the number of ! columns in the grid object. - if (dimlens(1) /= grid_dimlens(1) .and. dimlens(2) /= grid_dimlens(1)) then + if (dimlens(1) /= grid_dimlens(1) .and. dimlens(2) /= grid_dimlens(1) .and. .not. single_column) then readvar = .false. return end if @@ -649,20 +618,13 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & field_dnames(1) = dimname1 field_dnames(2) = dimname2 ! NB: strt and cnt were initialized to 1 - if (single_column) then - !!XXgoldyXX: Clearly, this will not work for an unstructured dycore - ! Check for permuted dimensions ('out of order' array) -! call calc_permutation(dimids(1:2), arraydimids, permutation, ispermuted) - call endrun(trim(subname)//': SCAM not supported in this configuration') - else - ! All distributed array processing - call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:2), & - pio_double, iodesc, field_dnames=field_dnames, & - file_dnames=file_dnames(1:2)) - call pio_read_darray(ncid, varid, iodesc, field, ierr) - if (present(fillvalue)) then - ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) - end if + ! All distributed array processing + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:2), & + pio_double, iodesc, field_dnames=field_dnames, & + file_dnames=file_dnames(1:2)) + call pio_read_darray(ncid, varid, iodesc, field, ierr) + if (present(fillvalue)) then + ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) end if if (masterproc) write(iulog,*) subname//': read field '//trim(varname) @@ -693,8 +655,7 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & ! use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel - use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname - use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id + use pio, only: PIO_MAX_NAME, pio_inq_dimname use cam_pio_utils, only: cam_permute_array, calc_permutation use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill @@ -749,6 +710,7 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & character(len=128) :: errormsg character(len=PIO_MAX_NAME) :: field_dnames(3) character(len=PIO_MAX_NAME) :: file_dnames(4) + character(len=max_hcoordname_len) :: vargridname ! Name of variable's grid ! For SCAM real(r8) :: closelat, closelon @@ -771,35 +733,32 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & dim1b, dim1e, dim2b, dim2e, dim3b, dim3e, & field, readvar, gridname, timelevel) else - ! ! Error conditions ! if (present(gridname)) then - grid_id = cam_grid_id(trim(gridname)) + vargridname=trim(gridname) else - grid_id = cam_grid_id('physgrid') + vargridname='physgrid' end if + + ! if running single column mode then we need to use scm grid to read proper column + if (single_column .and. vargridname=='physgrid') then + vargridname='physgrid_scm' + end if + + grid_id = cam_grid_id(trim(vargridname)) if (.not. cam_grid_check(grid_id)) then if(masterproc) then - if (present(gridname)) then - write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) - else - write(errormsg, *)': Internal error, no "physgrid" gridname' - end if + write(errormsg, *)': invalid gridname, "',trim(vargridname),'", specified for field ',trim(varname) end if call endrun(trim(subname)//errormsg) end if if (debug .and. masterproc) then - if (present(gridname)) then - write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) - else - write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' - end if + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(vargridname) call shr_sys_flush(iulog) end if - ! ! Read netCDF file ! diff --git a/src/control/scamMod.F90 b/src/control/scamMod.F90 index b18169b340..e26a2e63b9 100644 --- a/src/control/scamMod.F90 +++ b/src/control/scamMod.F90 @@ -14,31 +14,47 @@ module scamMod ! this module provide flexibility to affect the forecast by overriding ! parameterization prognosed tendencies with observed tendencies ! of a particular field program recorded on the IOP file. - ! + ! ! Public functions/subroutines: ! scam_readnl !----------------------------------------------------------------------- -use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl +use spmd_utils, only: masterproc,npes use pmgrid, only: plon, plat, plev, plevp -use constituents, only: pcnst +use constituents, only: cnst_get_ind, pcnst, cnst_name +use netcdf, only: NF90_NOERR,NF90_CLOSE,NF90_GET_VAR,NF90_INQUIRE_DIMENSION, & + NF90_INQ_DIMID, NF90_INQ_VARID, NF90_NOWRITE, NF90_OPEN, & + NF90_GET_ATT,NF90_GLOBAL,NF90_INQUIRE_ATTRIBUTE, & + NF90_INQUIRE_VARIABLE, NF90_MAX_VAR_DIMS, nf90_get_var use shr_scam_mod, only: shr_scam_getCloseLatLon -use dycore, only: dycore_is use cam_logfile, only: iulog use cam_abortutils, only: endrun +use time_manager, only: get_curr_date, get_nstep,is_first_step,get_start_date,timemgr_time_inc +use error_messages, only: handle_ncerr + implicit none private ! PUBLIC INTERFACES: -public scam_readnl ! read SCAM namelist options +public :: scam_readnl ! read SCAM namelist options +public :: readiopdata ! read iop boundary data +public :: setiopupdate ! find index in iopboundary data for current time +public :: plevs0 ! Define the pressures of the interfaces and midpoints +public :: scmiop_flbc_inti +public :: setiopupdate_init ! PUBLIC MODULE DATA: real(r8), public :: pressure_levels(plev) real(r8), public :: scmlat ! input namelist latitude for scam real(r8), public :: scmlon ! input namelist longitude for scam +real(r8), public :: closeioplat ! closest iop latitude for scam +real(r8), public :: closeioplon ! closest iop longitude for scam +integer, public :: closeioplatidx ! file array index of closest iop latitude for scam +integer, public :: closeioplonidx ! file array index closest iop longitude for scam integer, parameter :: num_switches = 20 @@ -47,34 +63,35 @@ module scamMod logical, public :: single_column ! Using IOP file or not logical, public :: use_iop ! Using IOP file or not logical, public :: use_pert_init ! perturb initial values -logical, public :: use_pert_frc ! perturb forcing +logical, public :: use_pert_frc ! perturb forcing logical, public :: switch(num_switches) ! Logical flag settings from GUI logical, public :: l_uvphys ! If true, update u/v after TPHYS logical, public :: l_uvadvect ! If true, T, U & V will be passed to SLT -logical, public :: l_conv ! use flux divergence terms for T and q? +logical, public :: l_conv ! use flux divergence terms for T and q? logical, public :: l_divtr ! use flux divergence terms for constituents? logical, public :: l_diag ! do we want available diagnostics? integer, public :: error_code ! Error code from netCDF reads integer, public :: initTimeIdx integer, public :: seedval +integer :: bdate, last_date, last_sec -character*(max_path_len), public :: modelfile -character*(max_path_len), public :: analysisfile -character*(max_path_len), public :: sicfile -character*(max_path_len), public :: userfile -character*(max_path_len), public :: sstfile -character*(max_path_len), public :: lsmpftfile -character*(max_path_len), public :: pressfile -character*(max_path_len), public :: topofile -character*(max_path_len), public :: ozonefile -character*(max_path_len), public :: iopfile -character*(max_path_len), public :: absemsfile -character*(max_path_len), public :: aermassfile -character*(max_path_len), public :: aeropticsfile -character*(max_path_len), public :: timeinvfile -character*(max_path_len), public :: lsmsurffile -character*(max_path_len), public :: lsminifile +character(len=max_path_len), public :: modelfile +character(len=max_path_len), public :: analysisfile +character(len=max_path_len), public :: sicfile +character(len=max_path_len), public :: userfile +character(len=max_path_len), public :: sstfile +character(len=max_path_len), public :: lsmpftfile +character(len=max_path_len), public :: pressfile +character(len=max_path_len), public :: topofile +character(len=max_path_len), public :: ozonefile +character(len=max_path_len), public :: iopfile +character(len=max_path_len), public :: absemsfile +character(len=max_path_len), public :: aermassfile +character(len=max_path_len), public :: aeropticsfile +character(len=max_path_len), public :: timeinvfile +character(len=max_path_len), public :: lsmsurffile +character(len=max_path_len), public :: lsminifile ! note that scm_zadv_q is set to slt to be consistent with CAM BFB testing @@ -102,16 +119,18 @@ module scamMod real(r8), public :: qinitobs(plev,pcnst)! initial tracer field real(r8), public :: cldliqobs(plev) ! actual W.V. Mixing ratio real(r8), public :: cldiceobs(plev) ! actual W.V. Mixing ratio -real(r8), public :: numliqobs(plev) ! actual -real(r8), public :: numiceobs(plev) ! actual -real(r8), public :: precobs(1) ! observed precipitation -real(r8), public :: lhflxobs(1) ! observed surface latent heat flux +real(r8), public :: numliqobs(plev) ! actual +real(r8), public :: numiceobs(plev) ! actual +real(r8), public :: precobs(1) ! observed precipitation +real(r8), public :: lhflxobs(1) ! observed surface latent heat flux +real(r8), public :: heat_glob_scm(1) ! observed heat total real(r8), public :: shflxobs(1) ! observed surface sensible heat flux real(r8), public :: q1obs(plev) ! observed apparent heat source real(r8), public :: q2obs(plev) ! observed apparent heat sink -real(r8), public :: tdiff(plev) ! model minus observed temp +real(r8), public :: tdiff(plev) ! model minus observed temp real(r8), public :: tground(1) ! ground temperature -real(r8), public :: tobs(plev) ! actual temperature +real(r8), public :: psobs ! observed surface pressure +real(r8), public :: tobs(plev) ! observed temperature real(r8), public :: tsair(1) ! air temperature at the surface real(r8), public :: udiff(plev) ! model minus observed uwind real(r8), public :: uobs(plev) ! actual u wind @@ -124,6 +143,13 @@ module scamMod real(r8), public :: asdirobs(1) ! observed asdir real(r8), public :: asdifobs(1) ! observed asdif +real(r8), public :: co2vmrobs(1) ! observed co2vmr +real(r8), public :: ch4vmrobs(1) ! observed ch3vmr +real(r8), public :: n2ovmrobs(1) ! observed n2ovmr +real(r8), public :: f11vmrobs(1) ! observed f11vmr +real(r8), public :: f12vmrobs(1) ! observed f12vmr +real(r8), public :: soltsiobs(1) ! observed solar + real(r8), public :: wfld(plev) ! Vertical motion (slt) real(r8), public :: wfldh(plevp) ! Vertical motion (slt) real(r8), public :: divq(plev,pcnst) ! Divergence of moisture @@ -142,22 +168,23 @@ module scamMod ! SCAM public data defaults logical, public :: doiopupdate = .false. ! do we need to read next iop timepoint -logical, public :: have_lhflx = .false. ! dataset contains lhflx +logical, public :: have_lhflx = .false. ! dataset contains lhflx logical, public :: have_shflx = .false. ! dataset contains shflx +logical, public :: have_heat_glob = .false. ! dataset contains heat total logical, public :: have_tg = .false. ! dataset contains tg logical, public :: have_tsair = .false. ! dataset contains tsair -logical, public :: have_divq = .false. ! dataset contains divq +logical, public :: have_divq = .false. ! dataset contains divq logical, public :: have_divt = .false. ! dataset contains divt -logical, public :: have_divq3d = .false. ! dataset contains divq3d +logical, public :: have_divq3d = .false. ! dataset contains divq3d logical, public :: have_vertdivu = .false. ! dataset contains vertdivu logical, public :: have_vertdivv = .false. ! dataset contains vertdivv logical, public :: have_vertdivt = .false. ! dataset contains vertdivt -logical, public :: have_vertdivq = .false. ! dataset contains vertdivq +logical, public :: have_vertdivq = .false. ! dataset contains vertdivq logical, public :: have_divt3d = .false. ! dataset contains divt3d logical, public :: have_divu3d = .false. ! dataset contains divu3d logical, public :: have_divv3d = .false. ! dataset contains divv3d logical, public :: have_divu = .false. ! dataset contains divu -logical, public :: have_divv = .false. ! dataset contains divv +logical, public :: have_divv = .false. ! dataset contains divv logical, public :: have_omega = .false. ! dataset contains omega logical, public :: have_phis = .false. ! dataset contains phis logical, public :: have_ptend = .false. ! dataset contains ptend @@ -165,10 +192,10 @@ module scamMod logical, public :: have_q = .false. ! dataset contains q logical, public :: have_q1 = .false. ! dataset contains Q1 logical, public :: have_q2 = .false. ! dataset contains Q2 -logical, public :: have_prec = .false. ! dataset contains prec +logical, public :: have_prec = .false. ! dataset contains prec logical, public :: have_t = .false. ! dataset contains t -logical, public :: have_u = .false. ! dataset contains u -logical, public :: have_v = .false. ! dataset contains v +logical, public :: have_u = .false. ! dataset contains u +logical, public :: have_v = .false. ! dataset contains v logical, public :: have_cld = .false. ! dataset contains cld logical, public :: have_cldliq = .false. ! dataset contains cldliq logical, public :: have_cldice = .false. ! dataset contains cldice @@ -179,41 +206,47 @@ module scamMod logical, public :: have_aldif = .false. ! dataset contains aldif logical, public :: have_asdir = .false. ! dataset contains asdir logical, public :: have_asdif = .false. ! dataset contains asdif -logical, public :: use_camiop = .false. ! use cam generated forcing +logical, public :: use_camiop = .false. ! use cam generated forcing logical, public :: use_3dfrc = .false. ! use 3d forcing logical, public :: isrestart = .false. ! If this is a restart step or not - + ! SCAM namelist defaults logical, public :: scm_backfill_iop_w_init = .false. ! Backfill missing IOP data from initial file logical, public :: scm_relaxation = .false. ! Use relaxation logical, public :: scm_crm_mode = .false. ! Use column radiation mode logical, public :: scm_cambfb_mode = .false. ! Use extra CAM IOP fields to assure bit for bit match with CAM run -logical, public :: scm_use_obs_T = .false. ! Use the SCAM-IOP specified observed T at each time step instead of forecasting. -logical, public :: scm_force_latlon = .false. ! force scam to use the lat lon fields specified in the scam namelist not what is closest to iop avail lat lon -real*8, public :: scm_relax_top_p = 1.e36_r8 ! upper bound for scm relaxation -real*8, public :: scm_relax_bot_p = -1.e36_r8 ! lower bound for scm relaxation -real*8, public :: scm_relax_tau_sec = 10800._r8 ! relaxation time constant (sec) +logical, public :: scm_use_obs_T = .false. ! Use the SCAM-IOP observed T at each timestep instead of forecasting. +logical, public :: scm_force_latlon = .false. ! force scam to use the lat lon fields specified in the namelist not closest +real(r8), public :: scm_relaxation_low ! lowest level to apply relaxation +real(r8), public :: scm_relaxation_high ! highest level to apply relaxation +real(r8), public :: scm_relax_top_p = 0._r8 ! upper bound for scm relaxation +real(r8), public :: scm_relax_bot_p = huge(1._r8) ! lower bound for scm relaxation +real(r8), public :: scm_relax_tau_sec = 10800._r8 ! relaxation time constant (sec) ! +++BPM: ! modification... allow a linear ramp in relaxation time scale: logical, public :: scm_relax_linear = .false. -real*8, public :: scm_relax_tau_bot_sec = 10800._r8 -real*8, public :: scm_relax_tau_top_sec = 10800._r8 +real(r8), public :: scm_relax_tau_bot_sec = 10800._r8 +real(r8), public :: scm_relax_tau_top_sec = 10800._r8 character(len=26), public :: scm_relax_fincl(pcnst) ! ! note that scm_use_obs_uv is set to true to be consistent with CAM BFB testing ! -logical, public :: scm_use_obs_uv = .true. ! Use the SCAM-IOP specified observed u,v at each time step instead of forecasting. +logical, public :: scm_use_obs_uv = .true. ! Use the SCAM-IOP observed u,v at each time step instead of forecasting. -logical, public :: scm_use_obs_qv = .false. ! Use the SCAM-IOP specified observed qv at each time step instead of forecasting. +logical, public :: scm_use_obs_qv = .false. ! Use the SCAM-IOP observed qv at each time step instead of forecasting. +logical, public :: scm_use_3dfrc = .false. ! Use CAMIOP 3d forcing if true, else use dycore vertical plus horizontal logical, public :: scm_iop_lhflxshflxTg = .false. !turn off LW rad logical, public :: scm_iop_Tg = .false. !turn off LW rad character(len=200), public :: scm_clubb_iop_name ! IOP name for CLUBB +integer, allocatable, public :: tsec(:) +integer, public :: ntime + !======================================================================= contains !======================================================================= @@ -224,8 +257,6 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) use units, only: getunit, freeunit use dycore, only: dycore_is use wrap_nf, only: wrap_open - use spmd_utils, only : masterproc,npes - use netcdf, only : nf90_inquire_attribute,NF90_NOERR,NF90_GLOBAL,NF90_NOWRITE !---------------------------Arguments----------------------------------- @@ -240,40 +271,38 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) integer :: unitn, ierr, i integer :: ncid integer :: iatt - integer :: latidx, lonidx logical :: adv - real(r8) :: ioplat,ioplon ! this list should include any variable that you might want to include in the namelist namelist /scam_nl/ iopfile, scm_iop_lhflxshflxTg, scm_iop_Tg, scm_relaxation, & scm_relax_top_p,scm_relax_bot_p,scm_relax_tau_sec, & scm_cambfb_mode,scm_crm_mode,scm_zadv_uv,scm_zadv_T,scm_zadv_q,& - scm_use_obs_T, scm_use_obs_uv, scm_use_obs_qv, & + scm_use_obs_T, scm_use_obs_uv, scm_use_obs_qv, scm_use_3dfrc, & scm_relax_linear, scm_relax_tau_top_sec, & - scm_relax_tau_bot_sec, scm_force_latlon, scm_relax_fincl, scm_backfill_iop_w_init + scm_relax_tau_bot_sec, scm_force_latlon, scm_relax_fincl, & + scm_backfill_iop_w_init single_column=single_column_in iopfile = ' ' scm_clubb_iop_name = ' ' scm_relax_fincl(:) = ' ' - if( single_column ) then - if( npes.gt.1) call endrun('SCAM_READNL: SCAM doesnt support using more than 1 pe.') + if( npes>1) call endrun('SCAM_READNL: SCAM doesnt support using more than 1 pe.') - if (.not. dycore_is('EUL') .or. plon /= 1 .or. plat /=1 ) then + if ( .not. (dycore_is('EUL') .or. dycore_is('SE')) .or. plon /= 1 .or. plat /=1 ) then call endrun('SCAM_SETOPTS: must compile model for SCAM mode when namelist parameter single_column is .true.') endif scmlat=scmlat_in scmlon=scmlon_in - - if( scmlat .lt. -90._r8 .or. scmlat .gt. 90._r8 ) then + + if( scmlat < -90._r8 .or. scmlat > 90._r8 ) then call endrun('SCAM_READNL: SCMLAT must be between -90. and 90. degrees.') - elseif( scmlon .lt. 0._r8 .or. scmlon .gt. 360._r8 ) then + elseif( scmlon < 0._r8 .or. scmlon > 360._r8 ) then call endrun('SCAM_READNL: SCMLON must be between 0. and 360. degrees.') end if - + ! Read namelist if (masterproc) then unitn = getunit() @@ -288,11 +317,11 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) close(unitn) call freeunit(unitn) end if - + ! Error checking: - + iopfile = trim(iopfile) - if( iopfile .ne. "" ) then + if( iopfile /= "" ) then use_iop = .true. else call endrun('SCAM_READNL: must specify IOP file for single column mode') @@ -300,23 +329,22 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) call wrap_open( iopfile, NF90_NOWRITE, ncid ) - if( nf90_inquire_attribute( ncid, NF90_GLOBAL, 'CAM_GENERATED_FORCING', iatt ) .EQ. NF90_NOERR ) then + if( nf90_inquire_attribute( ncid, NF90_GLOBAL, 'CAM_GENERATED_FORCING', iatt ) == NF90_NOERR ) then use_camiop = .true. else use_camiop = .false. endif - + ! If we are not forcing the lat and lon from the namelist use the closest lat and lon that is found in the IOP file. if (.not.scm_force_latlon) then - call shr_scam_GetCloseLatLon( ncid, scmlat, scmlon, ioplat, ioplon, latidx, lonidx ) + call shr_scam_GetCloseLatLon( ncid, scmlat, scmlon, closeioplat, closeioplon, closeioplatidx, closeioplonidx ) write(iulog,*) 'SCAM_READNL: using closest IOP column to lat/lon specified in drv_in' write(iulog,*) ' requested lat,lon =',scmlat,', ',scmlon - write(iulog,*) ' closest IOP lat,lon =',ioplat,', ',ioplon - - scmlat = ioplat - scmlon = ioplon + write(iulog,*) ' closest IOP lat,lon =',closeioplat,', ',closeioplon + scmlat = closeioplat + scmlon = closeioplon end if - + if (masterproc) then write (iulog,*) 'Single Column Model Options: ' write (iulog,*) '=============================' @@ -335,6 +363,7 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) write (iulog,*) ' scm_relax_tau_top_sec = ',scm_relax_tau_top_sec write (iulog,*) ' scm_relax_top_p = ',scm_relax_top_p write (iulog,*) ' scm_use_obs_T = ',scm_use_obs_T + write (iulog,*) ' scm_use_3dfrc = ',scm_use_3dfrc write (iulog,*) ' scm_use_obs_qv = ',scm_use_obs_qv write (iulog,*) ' scm_use_obs_uv = ',scm_use_obs_uv write (iulog,*) ' scm_zadv_T = ',trim(scm_zadv_T) @@ -343,7 +372,7 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) write (iulog,*) ' scm_relax_finc: ' ! output scm_relax_fincl character array do i=1,pcnst - if (scm_relax_fincl(i) .ne. '') then + if (scm_relax_fincl(i) /= '') then adv = mod(i,4)==0 if (adv) then write (iulog, "(A18)") "'"//trim(scm_relax_fincl(i))//"'," @@ -357,9 +386,1204 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) print * end if end if - + end subroutine scam_readnl +subroutine readiopdata(hyam, hybm, hyai, hybi, ps0) +!----------------------------------------------------------------------- +! +! Open and read netCDF file containing initial IOP conditions +! +!---------------------------Code history-------------------------------- +! +! Written by J. Truesdale August, 1996, revised January, 1998 +! +!----------------------------------------------------------------------- + use getinterpnetcdfdata, only: getinterpncdata + use string_utils, only: to_lower + use wrap_nf, only: wrap_inq_dimid,wrap_get_vara_realx +!----------------------------------------------------------------------- + implicit none + + character(len=*), parameter :: sub = "read_iop_data" +! +!------------------------------Input Arguments-------------------------- +! + real(r8),intent(in) :: hyam(plev),hybm(plev),hyai(plevp),hybi(plevp),ps0 +! +!------------------------------Locals----------------------------------- +! + integer :: NCID, status + integer :: time_dimID, lev_dimID, lev_varID, varid + integer :: i,j + integer :: nlev + integer :: total_levs + integer :: u_attlen + + integer :: k, m + integer :: icldliq,icldice + integer :: inumliq,inumice + + logical :: have_srf ! value at surface is available + logical :: fill_ends ! + logical :: have_cnst(pcnst) + real(r8) :: dummy + real(r8) :: srf(1) ! value at surface + real(r8) :: hyamiop(plev) ! a hybrid coef midpoint + real(r8) :: hybmiop(plev) ! b hybrid coef midpoint + real(r8) :: pmid(plev) ! pressure at model levels (time n) + real(r8) :: pint(plevp) ! pressure at model interfaces (n ) + real(r8) :: pdel(plev) ! pdel(k) = pint (k+1)-pint (k) + real(r8) :: weight + real(r8) :: tmpdata(1) + real(r8) :: coldata(plev) + real(r8), allocatable :: dplevs( : ) + integer :: strt4(4),cnt4(4) + integer :: nstep + integer :: ios + character(len=128) :: units ! Units + + nstep = get_nstep() + fill_ends= .false. + +! +! Open IOP dataset +! + call handle_ncerr( nf90_open (iopfile, 0, ncid),& + 'ERROR - scamMod.F90:readiopdata', __LINE__) + +! +! if the dataset is a CAM generated dataset set use_camiop to true +! CAM IOP datasets have a global attribute called CAM_GENERATED_IOP +! + if ( nf90_inquire_attribute( ncid, NF90_GLOBAL, 'CAM_GENERATED_FORCING', attnum=i )== NF90_NOERR ) then + use_camiop = .true. + else + use_camiop = .false. + endif + +!===================================================================== +! +! Read time variables + + + status = nf90_inq_dimid (ncid, 'time', time_dimID ) + if (status /= NF90_NOERR) then + status = nf90_inq_dimid (ncid, 'tsec', time_dimID ) + if (status /= NF90_NOERR) then + if (masterproc) write(iulog,*) sub//':ERROR - Could not find dimension ID for time/tsec' + status = NF90_CLOSE ( ncid ) + call endrun(sub // ':ERROR - time/tsec must be present on the IOP file.') + end if + end if + + call handle_ncerr( nf90_inquire_dimension( ncid, time_dimID, len=ntime ),& + 'Error - scamMod.F90:readiopdata unable to find time dimension', __LINE__) + +! +!====================================================== +! read level data +! + status = NF90_INQ_DIMID( ncid, 'lev', lev_dimID ) + if ( status /= nf90_noerr ) then + if (masterproc) write(iulog,*) sub//':ERROR - Could not find variable dim ID for lev' + status = NF90_CLOSE ( ncid ) + call endrun(sub // ':ERROR - Could not find variable dim ID for lev') + end if + + call handle_ncerr( nf90_inquire_dimension( ncid, lev_dimID, len=nlev ),& + 'Error - scamMod.f90:readiopdata unable to find level dimension', __LINE__) + + allocate(dplevs(nlev+1),stat=ios) + if( ios /= 0 ) then + write(iulog,*) sub//':ERROR: failed to allocate dplevs; error = ',ios + call endrun(sub//':ERROR:readiopdata failed to allocate dplevs') + end if + + status = NF90_INQ_VARID( ncid, 'lev', lev_varID ) + if ( status /= nf90_noerr ) then + if (masterproc) write(iulog,*) sub//':ERROR - scamMod.F90:readiopdata:Could not find variable ID for lev' + status = NF90_CLOSE ( ncid ) + call endrun(sub//':ERROR:ould not find variable ID for lev') + end if + + call handle_ncerr( nf90_get_var (ncid, lev_varID, dplevs(:nlev)),& + 'Error - scamMod.F90:readiopdata unable to read pressure levels', __LINE__) +! +!CAM generated forcing already has pressure on millibars convert standard IOP if needed. +! + call handle_ncerr(nf90_inquire_attribute(ncid, lev_varID, 'units', len=u_attlen),& + 'Error - scamMod.F90:readiopdata unable to find units attribute', __LINE__) + call handle_ncerr(nf90_get_att(ncid, lev_varID, 'units', units),& + 'Error - scamMod.F90:readiopdata unable to read units attribute', __LINE__) + units=trim(to_lower(units(1:u_attlen))) + + if ( units=='pa' .or. units=='pascal' .or. units=='pascals' ) then +! +! convert pressure from Pascals to Millibars ( lev is expressed in pascals in iop datasets ) +! + do i=1,nlev + dplevs( i ) = dplevs( i )/100._r8 + end do + endif + + status = nf90_inq_varid( ncid, 'Ps', varid ) + if ( status /= nf90_noerr ) then + have_ps= .false. + if (masterproc) write(iulog,*) sub//':Could not find variable Ps' + if ( .not. scm_backfill_iop_w_init ) then + status = NF90_CLOSE( ncid ) + call endrun(sub//':ERROR :IOP file must contain Surface Pressure (Ps) variable') + else + if ( is_first_step() .and. masterproc) write(iulog,*) 'Using surface pressure value from IC file if present' + endif + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, psobs, strt4) + have_ps = .true. + endif + + +! If the IOP dataset has hyam,hybm,etc it is assumed to be a hybrid level +! dataset + + status = nf90_inq_varid( ncid, 'hyam', varid ) + if ( status == nf90_noerr .and. have_ps) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, hyamiop, strt4) + status = nf90_inq_varid( ncid, 'hybm', varid ) + status = nf90_get_var(ncid, varid, hybmiop, strt4) + do i = 1, nlev + dplevs( i ) = 1000.0_r8 * hyamiop( i ) + psobs * hybmiop( i ) / 100.0_r8 + end do + endif + +! add the surface pressure to the pressure level data, so that +! surface boundary condition will be set properly, +! making sure that it is the highest pressure in the array. +! + + total_levs = nlev+1 + dplevs(nlev+1) = psobs/100.0_r8 ! ps is expressed in pascals + do i= nlev, 1, -1 + if ( dplevs(i) > psobs/100.0_r8) then + total_levs = i + dplevs(i) = psobs/100.0_r8 + end if + end do + if (.not. use_camiop ) then + nlev = total_levs + endif + if ( nlev == 1 ) then + if (masterproc) write(iulog,*) sub//':Error - scamMod.F90:readiopdata: Ps too low!' + call endrun(sub//':ERROR:Ps value on datasets is incongurent with levs data - mismatch in units?') + endif + +!===================================================================== +!get global vmrs from camiop file + status = nf90_inq_varid( ncid, 'co2vmr', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,co2vmrobs) + else + if (is_first_step()) write(iulog,*)'using column value of co2vmr from boundary data as global volume mixing ratio' + end if + status = nf90_inq_varid( ncid, 'ch4vmr', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,ch4vmrobs) + else + if (is_first_step()) write(iulog,*)'using column value of ch4vmr from boundary data as global volume mixing ratio' + end if + status = nf90_inq_varid( ncid, 'n2ovmr', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,n2ovmrobs) + else + if (is_first_step()) write(iulog,*)'using column value of n2ovmr from boundary data as global volume mixing ratio' + end if + status = nf90_inq_varid( ncid, 'f11vmr', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,f11vmrobs) + else + if (is_first_step()) write(iulog,*)'using column value of f11vmr from boundary data as global volume mixing ratio' + end if + status = nf90_inq_varid( ncid, 'f12vmr', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,f12vmrobs) + else + if (is_first_step()) write(iulog,*)'using column value of f12vmr from boundary data as global volume mixing ratio' + end if + status = nf90_inq_varid( ncid, 'soltsi', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,soltsiobs) + else + if (is_first_step()) write(iulog,*)'using column value of soltsi from boundary data as global solar tsi' + end if +!===================================================================== +!get state variables from camiop file + + status = nf90_inq_varid( ncid, 'Tsair', varid ) + if ( status /= nf90_noerr ) then + have_tsair = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,tsair) + have_tsair = .true. + endif +! +! read in Tobs For cam generated iop readin small t to avoid confusion +! with capital T defined in cam +! + tobs(:)= 0._r8 + + if ( use_camiop ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx,'t', have_tsair, & + tsair(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm,tobs, status ) + else + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx,'T', have_tsair, & + tsair(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, tobs, status ) + endif + if ( status /= nf90_noerr ) then + have_t = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable T on IOP file' + if ( scm_backfill_iop_w_init ) then + if (masterproc) write(iulog,*) sub//':Using value of T(tobs) from IC file if it exists' + else + if (masterproc) write(iulog,*) sub//':set tobs to 0.' + endif +! +! set T3 to Tobs on first time step +! + else + have_t = .true. + endif + + status = nf90_inq_varid( ncid, 'Tg', varid ) + if (status /= nf90_noerr) then + if (masterproc) write(iulog,*) sub//':Could not find variable Tg on IOP dataset' + if ( have_tsair ) then + if (masterproc) write(iulog,*) sub//':Using Tsair' + tground = tsair ! use surface value from T field + have_Tg = .true. + else + have_Tg = .true. + if (masterproc) write(iulog,*) sub//':Using T at lowest level from IOP dataset' + tground = tobs(plev) + endif + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,tground) + have_Tg = .true. + endif + + status = nf90_inq_varid( ncid, 'qsrf', varid ) + + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + qobs(:)= 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'q', have_srf, & + srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, qobs, status ) + if ( status /= nf90_noerr ) then + have_q = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable q on IOP file' + if ( scm_backfill_iop_w_init ) then + if (masterproc) write(iulog,*) sub//':Using values for q from IC file if available' + else + if (masterproc) write(iulog,*) sub//':Setting qobs to 0.' + endif + else + have_q = .true. + endif + + cldobs = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'cld', .false., & + dummy, fill_ends, scm_crm_mode, dplevs, nlev,psobs, hyam, hybm, cldobs, status ) + if ( status /= nf90_noerr ) then + have_cld = .false. + else + have_cld = .true. + endif + + clwpobs = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'clwp', .false., & + dummy, fill_ends, scm_crm_mode, dplevs, nlev,psobs, hyam, hybm, clwpobs, status ) + if ( status /= nf90_noerr ) then + have_clwp = .false. + else + have_clwp = .true. + endif + +! +! read divq (horizontal advection) +! + status = nf90_inq_varid( ncid, 'divqsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divq(:,:)=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'divq', have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divq(:,1), status ) + if ( status /= nf90_noerr ) then + have_divq = .false. + else + have_divq = .true. + endif + +! +! read vertdivq if available +! + status = nf90_inq_varid( ncid, 'vertdivqsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + vertdivq=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivq', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, vertdivq(:,1), status ) + if ( status /= nf90_noerr ) then + have_vertdivq = .false. + else + have_vertdivq = .true. + endif + + status = nf90_inq_varid( ncid, 'vertdivqsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif +! +! add calls to get dynamics tendencies for all prognostic consts +! + divq3d=0._r8 + + do m = 1, pcnst + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_dten', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divq3d(:,m), status ) + write(iulog,*)'checking ',trim(cnst_name(m))//'_dten',status + if ( status /= nf90_noerr ) then + have_cnst(m) = .false. + divq3d(1:,m)=0._r8 + else + if (m==1) have_divq3d = .true. + have_cnst(m) = .true. + endif + + coldata = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_dqfx', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, coldata, status ) + if ( STATUS /= NF90_NOERR ) then + dqfxcam(1,:,m)=0._r8 + else + dqfxcam(1,:,m)=coldata(:) + endif + + tmpdata = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_alph', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, tmpdata, status ) + if ( status /= nf90_noerr ) then + alphacam(m)=0._r8 + else + alphacam(m)=tmpdata(1) + endif + + end do + + + numliqobs = 0._r8 + call cnst_get_ind('NUMLIQ', inumliq, abort=.false.) + if ( inumliq > 0 ) then + have_srf = .false. + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'NUMLIQ', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, numliqobs, status ) + if ( status /= nf90_noerr ) then + have_numliq = .false. + else + have_numliq = .true. + endif + else + have_numliq = .false. + end if + + have_srf = .false. + + cldliqobs = 0._r8 + call cnst_get_ind('CLDLIQ', icldliq, abort=.false.) + if ( icldliq > 0 ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'CLDLIQ', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, cldliqobs, status ) + if ( status /= nf90_noerr ) then + have_cldliq = .false. + else + have_cldliq = .true. + endif + else + have_cldliq = .false. + endif + + cldiceobs = 0._r8 + call cnst_get_ind('CLDICE', icldice, abort=.false.) + if ( icldice > 0 ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'CLDICE', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, cldiceobs, status ) + if ( status /= nf90_noerr ) then + have_cldice = .false. + else + have_cldice = .true. + endif + else + have_cldice = .false. + endif + + numiceobs = 0._r8 + call cnst_get_ind('NUMICE', inumice, abort=.false.) + if ( inumice > 0 ) then + have_srf = .false. + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'NUMICE', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, numiceobs, status ) + if ( status /= nf90_noerr ) then + have_numice = .false. + else + have_numice = .true. + endif + else + have_numice = .false. + end if + +! +! read divu (optional field) +! + status = nf90_inq_varid( ncid, 'divusrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divu = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divu', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divu, status ) + if ( status /= nf90_noerr ) then + have_divu = .false. + else + have_divu = .true. + endif +! +! read divv (optional field) +! + status = nf90_inq_varid( ncid, 'divvsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divv = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divv', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divv, status ) + if ( status /= nf90_noerr ) then + have_divv = .false. + else + have_divv = .true. + endif +! +! read divt (optional field) +! + status = nf90_inq_varid( ncid, 'divtsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divt=0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'divT', have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divt, status ) + if ( status /= nf90_noerr ) then + have_divt = .false. + else + have_divt = .true. + endif + +! +! read vertdivt if available +! + status = nf90_inq_varid( ncid, 'vertdivTsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + vertdivt=0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivTx', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, vertdivt, status ) + if ( status /= nf90_noerr ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivT', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, vertdivt, status ) + if ( status /= nf90_noerr ) then + have_vertdivt = .false. + else + have_vertdivt = .true. + endif + else + have_vertdivt = .true. + endif +! +! read divt3d (combined vertical/horizontal advection) +! (optional field) + + status = nf90_inq_varid( ncid, 'divT3dsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divT3d = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divT3d', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divt3d, status ) + write(iulog,*)'checking divT3d:',status,nf90_noerr + if ( status /= nf90_noerr ) then + have_divt3d = .false. + else + have_divt3d = .true. + endif + + divU3d = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divU3d', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divu3d, status ) + if ( status /= nf90_noerr ) then + have_divu3d = .false. + else + have_divu3d = .true. + endif + + divV3d = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divV3d', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divv3d, status ) + if ( status /= nf90_noerr ) then + have_divv3d = .false. + else + have_divv3d = .true. + endif + + status = nf90_inq_varid( ncid, 'Ptend', varid ) + if ( status /= nf90_noerr ) then + have_ptend = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable Ptend. Setting to zero' + ptend = 0.0_r8 + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_ptend = .true. + ptend= srf(1) + endif + + wfld=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'omega', .true., ptend, fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, wfld, status ) + if ( status /= nf90_noerr ) then + have_omega = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable omega on IOP' + if ( scm_backfill_iop_w_init ) then + if (masterproc) write(iulog,*) sub//'Using omega from IC file' + else + if (masterproc) write(iulog,*) sub//'setting Omega to 0. throughout the column' + endif + else + have_omega = .true. + endif + call plevs0(plev, psobs, ps0, hyam, hybm, hyai, hybi, pint, pmid ,pdel) +! +! Build interface vector for the specified omega profile +! (weighted average in pressure of specified level values) +! + wfldh(:) = 0.0_r8 + + do k=2,plev + weight = (pint(k) - pmid(k-1))/(pmid(k) - pmid(k-1)) + wfldh(k) = (1.0_r8 - weight)*wfld(k-1) + weight*wfld(k) + end do + + status = nf90_inq_varid( ncid, 'usrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,srf) + have_srf = .true. + endif + + uobs=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'u', have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, uobs, status ) + if ( status /= nf90_noerr ) then + have_u = .false. + else + have_u = .true. + endif + + status = nf90_inq_varid( ncid, 'vsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,srf) + have_srf = .true. + endif + + vobs=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'v', have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, vobs, status ) + if ( status /= nf90_noerr ) then + have_v = .false. + else + have_v = .true. + endif + + status = nf90_inq_varid( ncid, 'Prec', varid ) + if ( status /= nf90_noerr ) then + have_prec = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,precobs) + have_prec = .true. + endif + + q1obs = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'Q1', & + .false., dummy, fill_ends, scm_crm_mode, & ! datasets don't contain Q1 at surface + dplevs, nlev,psobs, hyam, hybm, q1obs, status ) + if ( status /= nf90_noerr ) then + have_q1 = .false. + else + have_q1 = .true. + endif + + q1obs = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'Q2', & + .false., dummy, fill_ends, scm_crm_mode, & ! datasets don't contain Q2 at surface + dplevs, nlev,psobs, hyam, hybm, q1obs, status ) + if ( status /= nf90_noerr ) then + have_q2 = .false. + else + have_q2 = .true. + endif + +! Test for BOTH 'lhflx' and 'lh' without overwriting 'have_lhflx'. +! Analagous changes made for the surface heat flux + + status = nf90_inq_varid( ncid, 'lhflx', varid ) + if ( status /= nf90_noerr ) then + status = nf90_inq_varid( ncid, 'lh', varid ) + if ( status /= nf90_noerr ) then + have_lhflx = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,lhflxobs) + have_lhflx = .true. + endif + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,lhflxobs) + have_lhflx = .true. + endif + + status = nf90_inq_varid( ncid, 'shflx', varid ) + if ( status /= nf90_noerr ) then + status = nf90_inq_varid( ncid, 'sh', varid ) + if ( status /= nf90_noerr ) then + have_shflx = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,shflxobs) + have_shflx = .true. + endif + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,shflxobs) + have_shflx = .true. + endif + + ! If REPLAY is used, then need to read in the global + ! energy fixer + status = nf90_inq_varid( ncid, 'heat_glob', varid ) + if (status /= nf90_noerr) then + have_heat_glob = .false. + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,heat_glob_scm) + have_heat_glob = .true. + endif + +! +! fill in 3d forcing variables if we have both horizontal +! and vertical components, but not the 3d +! + if ( .not. have_cnst(1) .and. have_divq .and. have_vertdivq ) then + do k=1,plev + do m=1,pcnst + divq3d(k,m) = divq(k,m) + vertdivq(k,m) + enddo + enddo + have_divq3d = .true. + endif + + if ( .not. have_divt3d .and. have_divt .and. have_vertdivt ) then + if (masterproc) write(iulog,*) sub//'Don''t have divt3d - using divt and vertdivt' + do k=1,plev + divt3d(k) = divt(k) + vertdivt(k) + enddo + have_divt3d = .true. + endif +! +! make sure that use_3dfrc flag is set to true if we only have +! 3d forcing available +! + if (scm_use_3dfrc) then + if (have_divt3d .and. have_divq3d) then + use_3dfrc = .true. + else + call endrun(sub//':ERROR :IOP file must have both divt3d and divq3d forcing when scm_use_3dfrc is set to .true.') + endif + endif + + status = nf90_inq_varid( ncid, 'beta', varid ) + if ( status /= nf90_noerr ) then + betacam = 0._r8 + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + betacam=srf(1) + endif + + status = nf90_inq_varid( ncid, 'fixmas', varid ) + if ( status /= nf90_noerr ) then + fixmascam=1.0_r8 + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + fixmascam=srf(1) + endif + + status = nf90_close( ncid ) + + deallocate(dplevs) + +end subroutine readiopdata + +subroutine setiopupdate + +!----------------------------------------------------------------------- +! +! Open and read netCDF file to extract time information +! +!---------------------------Code history-------------------------------- +! +! Written by John Truesdale August, 1996 +! +!----------------------------------------------------------------------- + implicit none + + character(len=*), parameter :: sub = "setiopupdate" + +!------------------------------Locals----------------------------------- + + integer :: next_date, next_sec + integer :: ncsec,ncdate ! current time of day,date + integer :: yr, mon, day ! year, month, and day component +!------------------------------------------------------------------------------ + + call get_curr_date(yr,mon,day,ncsec) + ncdate=yr*10000 + mon*100 + day + +!------------------------------------------------------------------------------ +! Check if iop data needs to be updated and set doiopupdate accordingly +!------------------------------------------------------------------------------ + + if ( is_first_step() ) then + doiopupdate = .true. + + else + + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(iopTimeIdx+1)) + if ( ncdate > next_date .or. (ncdate == next_date & + .and. ncsec >= next_sec)) then + doiopupdate = .true. + ! check to see if we need to move iopindex ahead more than 1 step + do while ( ncdate > next_date .or. (ncdate == next_date .and. ncsec >= next_sec)) + iopTimeIdx = iopTimeIdx + 1 + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(iopTimeIdx+1)) + end do +#if DEBUG > 2 + if (masterproc) write(iulog,*) sub//'nstep = ',get_nstep() + if (masterproc) write(iulog,*) sub//'ncdate=',ncdate,' ncsec=',ncsec + if (masterproc) write(iulog,*) sub//'next_date=',next_date,' next_sec=',next_sec + if (masterproc) write(iulog,*) sub//':******* do iop update' +#endif + else + doiopupdate = .false. + end if + endif ! if (endstep = 1 ) +! +! make sure we're +! not going past end of iop data +! + if ( ncdate > last_date .or. (ncdate == last_date & + .and. ncsec > last_sec)) then + call endrun(sub//':ERROR: Reached the end of the time varient dataset') + endif + +#if DEBUG > 1 + if (masterproc) write(iulog,*) sub//':iop time index = ' , ioptimeidx +#endif + +end subroutine setiopupdate !=============================================================================== +subroutine plevs0 (nver, ps, ps0, hyam, hybm, hyai, hybi, pint ,pmid ,pdel) + +!----------------------------------------------------------------------- +! +! Purpose: +! Define the pressures of the interfaces and midpoints from the +! coordinate definitions and the surface pressure. +! +! Author: B. Boville +! +!----------------------------------------------------------------------- + implicit none + + +!----------------------------------------------------------------------- + integer , intent(in) :: nver ! vertical dimension + real(r8), intent(in) :: ps ! Surface pressure (pascals) + real(r8), intent(in) :: ps0 ! reference pressure (pascals) + real(r8), intent(in) :: hyam(plev) ! hybrid midpoint coef + real(r8), intent(in) :: hybm(plev) ! hybrid midpoint coef + real(r8), intent(in) :: hyai(plevp) ! hybrid interface coef + real(r8), intent(in) :: hybi(plevp) ! hybrid interface coef + real(r8), intent(out) :: pint(nver+1) ! Pressure at model interfaces + real(r8), intent(out) :: pmid(nver) ! Pressure at model levels + real(r8), intent(out) :: pdel(nver) ! Layer thickness (pint(k+1) - pint(k)) +!----------------------------------------------------------------------- + +!---------------------------Local workspace----------------------------- + integer :: k ! Longitude, level indices +!----------------------------------------------------------------------- +! +! Set interface pressures +! +!$OMP PARALLEL DO PRIVATE (K) + do k=1,nver+1 + pint(k) = hyai(k)*ps0 + hybi(k)*ps + end do +! +! Set midpoint pressures and layer thicknesses +! +!$OMP PARALLEL DO PRIVATE (K) + do k=1,nver + pmid(k) = hyam(k)*ps0 + hybm(k)*ps + pdel(k) = pint(k+1) - pint(k) + end do + +end subroutine plevs0 + +subroutine scmiop_flbc_inti ( co2vmr, ch4vmr, n2ovmr, f11vmr, f12vmr ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Get start count for variable + ! + !----------------------------------------------------------------------- + + implicit none + + real(r8), intent(out) :: co2vmr, ch4vmr, n2ovmr, f11vmr, f12vmr + + !----------------------------------------------------------------------- + + co2vmr=co2vmrobs(1) + ch4vmr=ch4vmrobs(1) + n2ovmr=n2ovmrobs(1) + f11vmr=f11vmrobs(1) + f12vmr=f12vmrobs(1) +end subroutine scmiop_flbc_inti + +subroutine get_start_count (ncid ,varid ,scmlat, scmlon, timeidx, start ,count) + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! set global lower boundary conditions + ! + !----------------------------------------------------------------------- + + implicit none + + character(len=*), parameter :: sub = "get_start_count" + +!----------------------------------------------------------------------- + integer , intent(in) :: ncid ! file id + integer , intent(in) :: varid ! variable id + integer , intent(in) :: TimeIdx ! time index + real(r8), intent(in) :: scmlat,scmlon! scm lat/lon + integer , intent(out) :: start(:),count(:) + +!---------------------------Local workspace----------------------------- + integer :: dims_set,nlev,var_ndims + logical :: usable_var + character(len=cl) :: dim_name + integer :: var_dimIDs( NF90_MAX_VAR_DIMS ) + real(r8) :: closelat,closelon + integer :: latidx,lonidx,status,i +!----------------------------------------------------------------------- + + call shr_scam_GetCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx) + + STATUS = NF90_INQUIRE_VARIABLE( NCID, varID, ndims=var_ndims ) +! +! surface variables +! + if ( var_ndims == 0 ) then + call endrun(sub//':ERROR: var_ndims is 0 for varid:',varid) + endif + + STATUS = NF90_INQUIRE_VARIABLE( NCID, varID, dimids=var_dimIDs) + if ( STATUS /= NF90_NOERR ) then + write(iulog,* ) sub//'ERROR - Cant get dimension IDs for varid', varid + call endrun(sub//':ERROR: Cant get dimension IDs for varid',varid) + endif +! +! Initialize the start and count arrays +! + dims_set = 0 + nlev = 1 + do i = var_ndims, 1, -1 + + usable_var = .false. + STATUS = NF90_INQUIRE_DIMENSION( NCID, var_dimIDs( i ), dim_name ) + + if ( trim(dim_name) == 'lat' ) then + start( i ) = latIdx + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( trim(dim_name) == 'lon' .or. trim(dim_name) == 'ncol' .or. trim(dim_name) == 'ncol_d' ) then + start( i ) = lonIdx + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( trim(dim_name) == 'lev' ) then + STATUS = NF90_INQUIRE_DIMENSION( NCID, var_dimIDs( i ), len=nlev ) + start( i ) = 1 + count( i ) = nlev ! Extract all levels + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( trim(dim_name) == 'ilev' ) then + STATUS = NF90_INQUIRE_DIMENSION( NCID, var_dimIDs( i ), len=nlev ) + start( i ) = 1 + count( i ) = nlev ! Extract all levels + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( trim(dim_name) == 'time' .OR. trim(dim_name) == 'tsec' ) then + start( i ) = TimeIdx + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 + usable_var = .true. + endif + end do + end subroutine get_start_count + +!========================================================================= +subroutine setiopupdate_init + +!----------------------------------------------------------------------- +! +! Open and read netCDF file to extract time information +! This subroutine should be called at the first SCM time step +! +!---------------------------Code history-------------------------------- +! +! Written by John Truesdale August, 1996 +! Modified for E3SM by Peter Bogenschutz 2017 - onward +! +!----------------------------------------------------------------------- + implicit none + +!------------------------------Locals----------------------------------- + + integer :: NCID,i + integer :: tsec_varID, time_dimID + integer :: bdate_varID + integer :: STATUS + integer :: next_date, next_sec + integer :: ncsec,ncdate ! current time of day,date + integer :: yr, mon, day ! year, month, and day component + integer :: start_ymd,start_tod + + character(len=*), parameter :: sub = "setiopupdate_init" +!!------------------------------------------------------------------------------ + + ! Open and read pertinent information from the IOP file + + call handle_ncerr( nf90_open (iopfile, 0, ncid),& + 'ERROR - scamMod.F90:setiopupdate_init Failed to open iop file', __LINE__) + + ! Read time (tsec) variable + + STATUS = NF90_INQ_VARID( NCID, 'tsec', tsec_varID ) + if ( STATUS /= NF90_NOERR ) then + write(iulog,*)sub//':ERROR: Cant get variable ID for tsec' + STATUS = NF90_CLOSE ( NCID ) + call endrun(sub//':ERROR: Cant get variable ID for tsec') + end if + + STATUS = NF90_INQ_VARID( NCID, 'bdate', bdate_varID ) + if ( STATUS /= NF90_NOERR ) then + STATUS = NF90_INQ_VARID( NCID, 'basedate', bdate_varID ) + if ( STATUS /= NF90_NOERR ) then + write(iulog,*)'ERROR - setiopupdate:Cant get variable ID for base date' + STATUS = NF90_CLOSE ( NCID ) + call endrun(sub//':ERROR: Cant get variable ID for base date') + endif + endif + + STATUS = NF90_INQ_DIMID( NCID, 'time', time_dimID ) + if ( STATUS /= NF90_NOERR ) then + STATUS = NF90_INQ_DIMID( NCID, 'tsec', time_dimID ) + if ( STATUS /= NF90_NOERR ) then + write(iulog,* )'ERROR - setiopupdate:Could not find variable dim ID for time' + STATUS = NF90_CLOSE ( NCID ) + call endrun(sub//':ERROR:Could not find variable dim ID for time') + end if + end if + + if ( STATUS /= NF90_NOERR ) & + write(iulog,*)'ERROR - setiopupdate:Cant get variable dim ID for time' + + STATUS = NF90_INQUIRE_DIMENSION( NCID, time_dimID, len=ntime ) + if ( STATUS /= NF90_NOERR )then + write(iulog,*)'ERROR - setiopupdate:Cant get time dimlen' + endif + + if (.not.allocated(tsec)) allocate(tsec(ntime)) + + STATUS = NF90_GET_VAR( NCID, tsec_varID, tsec ) + if ( STATUS /= NF90_NOERR )then + write(iulog,*)'ERROR - setiopupdate:Cant get variable tsec' + endif + STATUS = NF90_GET_VAR( NCID, bdate_varID, bdate ) + if ( STATUS /= NF90_NOERR )then + write(iulog,*)'ERROR - setiopupdate:Cant get variable bdate' + endif + + ! Close the netCDF file + STATUS = NF90_CLOSE( NCID ) + + ! determine the last date in the iop dataset + + call timemgr_time_inc(bdate, 0, last_date, last_sec, inc_s=tsec(ntime)) + + ! set the iop dataset index + iopTimeIdx=0 + do i=1,ntime ! set the first ioptimeidx + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(i)) + call get_start_date(yr,mon,day,start_tod) + start_ymd = yr*10000 + mon*100 + day + + if ( start_ymd > next_date .or. (start_ymd == next_date & + .and. start_tod >= next_sec)) then + iopTimeIdx = i + endif + enddo + + call get_curr_date(yr,mon,day,ncsec) + ncdate=yr*10000 + mon*100 + day + + if (iopTimeIdx == 0.or.iopTimeIdx >= ntime) then + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(1)) + write(iulog,*) 'Error::setiopupdate: Current model time does not fall within IOP period' + write(iulog,*) ' Current CAM Date is ',ncdate,' and ',ncsec,' seconds' + write(iulog,*) ' IOP start is ',next_date,' and ',next_sec,'seconds' + write(iulog,*) ' IOP end is ',last_date,' and ',last_sec,'seconds' + call endrun(sub//':ERROR: Current model time does not fall within IOP period') + endif + + doiopupdate = .true. + +end subroutine setiopupdate_init + end module scamMod diff --git a/src/dynamics/eul/diag_dynvar_ic.F90 b/src/dynamics/eul/diag_dynvar_ic.F90 index c963605fe6..f7e20c3df9 100644 --- a/src/dynamics/eul/diag_dynvar_ic.F90 +++ b/src/dynamics/eul/diag_dynvar_ic.F90 @@ -1,15 +1,15 @@ subroutine diag_dynvar_ic(phis, ps, t3, u3, v3, q3) ! -!----------------------------------------------------------------------- -! +!----------------------------------------------------------------------- +! ! Purpose: record state variables to IC file ! !----------------------------------------------------------------------- ! use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid - use cam_history , only: outfld, write_inithist + use cam_history , only: outfld, write_inithist, write_camiop use constituents, only: pcnst, cnst_name use commap, only:clat,clon use dyn_grid, only : get_horiz_grid_d @@ -44,16 +44,16 @@ subroutine diag_dynvar_ic(phis, ps, t3, u3, v3, q3) call outfld('T&IC ' , t3 (1,1,lat), plon, lat) call outfld('U&IC ' , u3 (1,1,lat), plon, lat) call outfld('V&IC ' , v3 (1,1,lat), plon, lat) -#if (defined BFB_CAM_SCAM_IOP) - clat_plon(:)=clat(lat) - call outfld('CLAT1&IC ', clat_plon, plon, lat) - call outfld('CLON1&IC ', clon, plon, lat) - call get_horiz_grid_d(plat, clat_d_out=phi) - call get_horiz_grid_d(plon, clon_d_out=lam) - clat_plon(:)=phi(lat) - call outfld('LAM&IC ', lam, plon, lat) - call outfld('PHI&IC ', clat_plon, plon, lat) -#endif + if (write_camiop) then + clat_plon(:)=clat(lat) + call outfld('CLAT1&IC ', clat_plon, plon, lat) + call outfld('CLON1&IC ', clon, plon, lat) + call get_horiz_grid_d(plat, clat_d_out=phi) + call get_horiz_grid_d(plon, clon_d_out=lam) + clat_plon(:)=phi(lat) + call outfld('LAM&IC ', lam, plon, lat) + call outfld('PHI&IC ', clat_plon, plon, lat) + end if do m=1,pcnst call outfld(trim(cnst_name(m))//'&IC', q3(1,1,m,lat), plon, lat) diff --git a/src/dynamics/eul/dyn_comp.F90 b/src/dynamics/eul/dyn_comp.F90 index 442c9f3228..bb753fdd33 100644 --- a/src/dynamics/eul/dyn_comp.F90 +++ b/src/dynamics/eul/dyn_comp.F90 @@ -11,7 +11,7 @@ module dyn_comp use physconst, only: pi use pmgrid, only: plon, plat, plev, plevp, plnlv, beglat, endlat -use commap, only: clat, clon +use commap, only: clat, clon, latdeg use dyn_grid, only: ptimelevels @@ -32,7 +32,7 @@ module dyn_comp use scamMod, only: single_column, use_camiop, have_u, have_v, & have_cldliq, have_cldice, loniop, latiop, scmlat, scmlon, & - qobs,tobs,scm_cambfb_mode + qobs,tobs,scm_cambfb_mode,uobs,vobs,psobs use cam_pio_utils, only: clean_iodesc_list, cam_pio_get_var use pio, only: file_desc_t, pio_noerr, pio_inq_varid, pio_get_att, & @@ -221,9 +221,6 @@ subroutine dyn_init(dyn_in, dyn_out) use scamMod, only: single_column #if (defined SPMD) use spmd_dyn, only: spmdbuf -#endif -#if (defined BFB_CAM_SCAM_IOP ) - use history_defaults, only: initialize_iop_history #endif use dyn_tests_utils, only: vc_dycore, vc_moist_pressure,string_vc, vc_str_lgth ! Arguments are not used in this dycore, included for compatibility @@ -258,10 +255,6 @@ subroutine dyn_init(dyn_in, dyn_out) call set_phis() if (initial_run) then - -#if (defined BFB_CAM_SCAM_IOP ) - call initialize_iop_history() -#endif call read_inidat() call clean_iodesc_list() end if @@ -367,8 +360,9 @@ subroutine read_inidat() use ncdio_atm, only: infld - use iop, only: setiopupdate,readiopdata - + use scamMod, only: setiopupdate,setiopupdate_init,readiopdata + use iop, only: iop_update_prognostics + use hycoef, only: hyam, hybm, hyai, hybi, ps0 ! Local variables integer i,c,m,n,lat ! indices @@ -529,6 +523,7 @@ subroutine read_inidat() deallocate ( phis_tmp ) if (single_column) then + call setiopupdate_init() if ( scm_cambfb_mode ) then fieldname = 'CLAT1' @@ -537,8 +532,9 @@ subroutine read_inidat() if (.not. readvar) then call endrun('CLAT not on iop initial file') else - clat(:) = clat2d(1,:) - clat_p(:)=clat(:) + clat = clat2d(1,1) + clat_p(:)=clat2d(1,1) + latdeg(1) = clat(1)*45._r8/atan(1._r8) end if fieldname = 'CLON1' @@ -582,11 +578,8 @@ subroutine read_inidat() loniop(1)=(mod(scmlon-2.0_r8+360.0_r8,360.0_r8))*pi/180.0_r8 loniop(2)=(mod(scmlon+2.0_r8+360.0_r8,360.0_r8))*pi/180.0_r8 call setiopupdate() - ! readiopdata will set all n1 level prognostics to iop value timestep 0 - call readiopdata(timelevel=1) - ! set t3, and q3(n1) values from iop on timestep 0 - t3(1,:,1,1) = tobs - q3(1,:,1,1,1) = qobs + call readiopdata(hyam,hybm,hyai,hybi,ps0) + call iop_update_prognostics(1,t3=t3,u3=u3,v3=v3,q3=q3,ps=ps) end if end if @@ -608,7 +601,7 @@ subroutine set_phis() ! Local variables type(file_desc_t), pointer :: fh_topo - + integer :: ierr, pio_errtype integer :: lonid, latid integer :: mlon, morec ! lon/lat dimension lengths from topo file @@ -628,7 +621,7 @@ subroutine set_phis() readvar = .false. - if (associated(fh_topo)) then + if (associated(fh_topo)) then call pio_seterrorhandling(fh_topo, PIO_BCAST_ERROR, pio_errtype) diff --git a/src/dynamics/eul/dyn_grid.F90 b/src/dynamics/eul/dyn_grid.F90 index e8cd67b0a0..62d3d73f0c 100644 --- a/src/dynamics/eul/dyn_grid.F90 +++ b/src/dynamics/eul/dyn_grid.F90 @@ -17,6 +17,7 @@ module dyn_grid use cam_abortutils, only: endrun use cam_logfile, only: iulog +use shr_const_mod, only: SHR_CONST_PI, SHR_CONST_REARTH #if (defined SPMD) use spmd_dyn, only: spmdinit_dyn @@ -54,6 +55,8 @@ module dyn_grid integer, parameter, public :: ptimelevels = 3 ! number of time levels in the dycore +real(r8), parameter :: rad2deg = 180._r8/SHR_CONST_PI + integer :: ngcols_d = 0 ! number of dynamics columns !======================================================================================== @@ -73,7 +76,7 @@ subroutine dyn_grid_init latdeg, londeg, xm use time_manager, only: get_step_size use scamMod, only: scmlat, scmlon, single_column - use hycoef, only: hycoef_init, hypi, hypm, hypd, nprlev + use hycoef, only: hycoef_init, hypi, hypm, hypd, nprlev, hyam,hybm,hyai,hybi,ps0 use ref_pres, only: ref_pres_init use eul_control_mod, only: ifax, trig, eul_nsplit @@ -863,7 +866,6 @@ end function get_dyn_grid_parm !------------------------------------------------------------------------------- subroutine dyn_grid_find_gcols( lat, lon, nclosest, owners, indx, jndx, rlat, rlon, idyn_dists ) use spmd_utils, only: iam - use shr_const_mod, only: SHR_CONST_PI, SHR_CONST_REARTH use pmgrid, only: plon, plat real(r8), intent(in) :: lat @@ -886,7 +888,6 @@ subroutine dyn_grid_find_gcols( lat, lon, nclosest, owners, indx, jndx, rlat, rl real(r8), allocatable :: clat_d(:), clon_d(:), distmin(:) integer, allocatable :: igcol(:) - real(r8), parameter :: rad2deg = 180._r8/SHR_CONST_PI latr = lat/rad2deg lonr = lon/rad2deg diff --git a/src/dynamics/eul/dynpkg.F90 b/src/dynamics/eul/dynpkg.F90 index 94fcec48f9..0d3a2810f7 100644 --- a/src/dynamics/eul/dynpkg.F90 +++ b/src/dynamics/eul/dynpkg.F90 @@ -1,14 +1,14 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & cwava ,detam ,flx_net ,ztodt ) -!----------------------------------------------------------------------- -! -! Purpose: +!----------------------------------------------------------------------- +! +! Purpose: ! Driving routines for dynamics and transport. -! -! Method: -! -! Author: +! +! Method: +! +! Author: ! Original version: CCM3 ! !----------------------------------------------------------------------- @@ -20,10 +20,9 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & use scanslt, only: scanslt_run, plond, platd, advection_state use scan2, only: scan2run use scamMod, only: single_column,scm_crm_mode,switch,wfldh -#if ( defined BFB_CAM_SCAM_IOP ) use iop, only: t2sav,fusav,fvsav -#endif use perf_mod + use cam_history, only: write_camiop !----------------------------------------------------------------------- implicit none @@ -36,7 +35,7 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & real(r8), intent(inout) :: fu(plon,plev,beglat:endlat) ! u wind tendency real(r8), intent(inout) :: fv(plon,plev,beglat:endlat) ! v wind tendency - real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints + real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints real(r8), intent(inout) :: cwava(plat) ! weight applied to global integrals real(r8), intent(inout) :: detam(plev) ! intervals between vert full levs. real(r8), intent(in) :: flx_net(plon,beglat:endlat) ! net flux from physics @@ -60,7 +59,7 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & real(r8) grd1(2*maxm,plev,plat/2) ! | real(r8) grd2(2*maxm,plev,plat/2) ! | real(r8) grfu1(2*maxm,plev,plat/2) ! |- see quad for definitions - real(r8) grfu2(2*maxm,plev,plat/2) ! | + real(r8) grfu2(2*maxm,plev,plat/2) ! | real(r8) grfv1(2*maxm,plev,plat/2) ! | real(r8) grfv2(2*maxm,plev,plat/2) ! | real(r8) grut1(2*maxm,plev,plat/2) ! | @@ -80,13 +79,13 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & ! SCANDYN Dynamics scan !---------------------------------------------------------- ! -#if ( defined BFB_CAM_SCAM_IOP ) -do c=beglat,endlat - t2sav(:plon,:,c)= t2(:plon,:,c) - fusav(:plon,:,c)= fu(:plon,:,c) - fvsav(:plon,:,c)= fv(:plon,:,c) -enddo -#endif +if (write_camiop) then + do c=beglat,endlat + t2sav(:plon,:,c)= t2(:plon,:,c) + fusav(:plon,:,c)= fu(:plon,:,c) + fvsav(:plon,:,c)= fv(:plon,:,c) + enddo +end if if ( single_column ) then etadot(1,:,1)=wfldh(:) @@ -150,4 +149,3 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & return end subroutine dynpkg - diff --git a/src/dynamics/eul/iop.F90 b/src/dynamics/eul/iop.F90 index 24791ad0ed..0754030830 100644 --- a/src/dynamics/eul/iop.F90 +++ b/src/dynamics/eul/iop.F90 @@ -1,43 +1,19 @@ module iop -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- !BOP ! ! !MODULE: iop -! -! !DESCRIPTION: +! +! !DESCRIPTION: ! iop specific routines ! ! !USES: ! use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use constituents, only: readtrace, cnst_get_ind, pcnst, cnst_name + use constituents, only: pcnst use eul_control_mod, only: eul_nsplit - use netcdf, only: NF90_NOERR,NF90_CLOSE,NF90_GET_VAR,NF90_INQUIRE_DIMENSION, & - NF90_INQ_DIMID, NF90_INQ_VARID, NF90_NOWRITE, NF90_OPEN, & - NF90_GET_ATT,NF90_GLOBAL,NF90_INQUIRE_ATTRIBUTE - use phys_control, only: phys_getopts - use pmgrid, only: beglat,endlat,plon,plev,plevp - use prognostics, only: n3,t3,q3,u3,v3,ps - use scamMod, only: use_camiop, ioptimeidx, have_ps, scm_backfill_iop_w_init, have_tsair, & - tobs, have_t, tground, have_tg, qobs, have_q, have_cld, & - have_clwp, divq, have_divq, vertdivq, have_vertdivq, divq3d, & - have_divq3d, dqfxcam, have_numliq, have_cldliq, have_cldice, & - have_numice, have_divu, have_divv, divt, have_divt, vertdivt, & - have_vertdivt, divt3d, have_divt3d, have_divu3d, have_divv3d, & - have_ptend, ptend, wfld, uobs, have_u, uobs, vobs, have_v, & - vobs, have_prec, have_q1, have_q2, have_lhflx, have_shflx, & - use_3dfrc, betacam, fixmascam, alphacam, doiopupdate, & - cldiceobs, cldliqobs, cldobs, clwpobs, divu, & - divu3d, divv, divv3d, iopfile, lhflxobs, numiceobs, numliqobs, & - precobs, q1obs, scmlat, scmlon, shflxobs, tsair, have_omega, wfldh,qinitobs - use shr_kind_mod, only: r8 => shr_kind_r8, max_chars=>shr_kind_cl - use shr_scam_mod, only: shr_scam_GetCloseLatLon - use spmd_utils, only: masterproc - use string_utils, only: to_lower - use time_manager, only: timemgr_init, get_curr_date, get_curr_calday,& - get_nstep,is_first_step,get_start_date,timemgr_time_inc - use wrap_nf, only: wrap_inq_dimid,wrap_get_vara_realx + use pmgrid, only: beglat,endlat,plon,plev + use shr_kind_mod, only: r8 => shr_kind_r8 ! ! !PUBLIC TYPES: implicit none @@ -45,26 +21,20 @@ module iop private - real(r8), allocatable,target :: dqfx3sav(:,:,:,:) - real(r8), allocatable,target :: t2sav(:,:,:) - real(r8), allocatable,target :: fusav(:,:,:) - real(r8), allocatable,target :: fvsav(:,:,:) + real(r8), allocatable,target :: dqfx3sav(:,:,:,:) + real(r8), allocatable,target :: t2sav(:,:,:) + real(r8), allocatable,target :: fusav(:,:,:) + real(r8), allocatable,target :: fvsav(:,:,:) real(r8), allocatable,target :: divq3dsav(:,:,:,:) - real(r8), allocatable,target :: divt3dsav(:,:,:) - real(r8), allocatable,target :: divu3dsav(:,:,:) - real(r8), allocatable,target :: divv3dsav(:,:,:) + real(r8), allocatable,target :: divt3dsav(:,:,:) + real(r8), allocatable,target :: divu3dsav(:,:,:) + real(r8), allocatable,target :: divv3dsav(:,:,:) real(r8), allocatable,target :: betasav(:) - integer :: closelatidx,closelonidx,latid,lonid,levid,timeid - - real(r8):: closelat,closelon - ! ! !PUBLIC MEMBER FUNCTIONS: public :: init_iop_fields - public :: readiopdata ! read iop boundary data - public :: setiopupdate ! find index in iopboundary data for current time -! public :: scam_use_iop_srf + public :: iop_update_prognostics ! !PUBLIC DATA: public betasav, & dqfx3sav, divq3dsav, divt3dsav,divu3dsav,divv3dsav,t2sav,fusav,fvsav @@ -76,7 +46,7 @@ module iop !EOP ! ! !PRIVATE MEMBER FUNCTIONS: -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- contains subroutine init_iop_fields() @@ -90,7 +60,7 @@ subroutine init_iop_fields() if (eul_nsplit>1) then call endrun('iop module cannot be used with eul_nsplit>1') endif - + if(.not.allocated(betasav)) then allocate (betasav(beglat:endlat)) betasav(:)=0._r8 @@ -130,1026 +100,35 @@ subroutine init_iop_fields() endif end subroutine init_iop_fields -subroutine readiopdata(timelevel) - - -!----------------------------------------------------------------------- -! -! Open and read netCDF file containing initial IOP conditions -! -!---------------------------Code history-------------------------------- -! -! Written by J. Truesdale August, 1996, revised January, 1998 -! -!----------------------------------------------------------------------- - use ppgrid, only: begchunk, endchunk - use phys_grid, only: clat_p - use commap, only: latdeg, clat - use getinterpnetcdfdata, only: getinterpncdata - use shr_sys_mod, only: shr_sys_flush - use hycoef, only: hyam, hybm - use error_messages, only: handle_ncerr -!----------------------------------------------------------------------- - implicit none -#if ( defined RS6000 ) - implicit automatic ( a-z ) -#endif - - character(len=*), parameter :: sub = "read_iop_data" - -!------------------------------Input Arguments-------------------------- -! -integer, optional, intent(in) :: timelevel - -!------------------------------Locals----------------------------------- -! - integer ntimelevel - integer NCID, status - integer time_dimID, lev_dimID, lev_varID - integer tsec_varID, bdate_varID,varid - integer i,j - integer nlev - integer total_levs - integer u_attlen - - integer bdate, ntime,nstep - integer, allocatable :: tsec(:) - integer k, m - integer icldliq,icldice - integer inumliq,inumice,idx - - logical have_srf ! value at surface is available - logical fill_ends ! - logical have_cnst(pcnst) - real(r8) dummy - real(r8) lat,xlat - real(r8) srf(1) ! value at surface - real(r8) pmid(plev) ! pressure at model levels (time n) - real(r8) pint(plevp) ! pressure at model interfaces (n ) - real(r8) pdel(plev) ! pdel(k) = pint (k+1)-pint (k) - real(r8) weight - real(r8) tmpdata(1) - real(r8) coldata(plev) - real(r8), allocatable :: dplevs( : ) - integer strt4(4),cnt4(4),strt5(4),cnt5(4) - character(len=16) :: lowername - character(len=max_chars) :: units ! Units - - nstep = get_nstep() - fill_ends= .false. - - if (present(timelevel)) then - ntimelevel=timelevel - else - ntimelevel=n3 - end if - -! -! Open IOP dataset -! - call handle_ncerr( nf90_open (iopfile, 0, ncid),& - 'readiopdata.F90', __LINE__) - -! -! if the dataset is a CAM generated dataset set use_camiop to true -! CAM IOP datasets have a global attribute called CAM_GENERATED_IOP -! - if ( nf90_inquire_attribute( ncid, NF90_GLOBAL, 'CAM_GENERATED_FORCING', attnum=i )== NF90_NOERR ) then - use_camiop = .true. - else - use_camiop = .false. - endif - -!===================================================================== -! -! Read time variables - - - status = nf90_inq_dimid (ncid, 'time', time_dimID ) - if (status /= NF90_NOERR) then - status = nf90_inq_dimid (ncid, 'tsec', time_dimID ) - if (status /= NF90_NOERR) then - if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find dimension ID for time/tsec' - status = NF90_CLOSE ( ncid ) - call endrun - end if - end if - - call handle_ncerr( nf90_inquire_dimension( ncid, time_dimID, len=ntime ),& - 'readiopdata.F90', __LINE__) - - allocate(tsec(ntime)) - - status = nf90_inq_varid (ncid, 'tsec', tsec_varID ) - call handle_ncerr( nf90_get_var (ncid, tsec_varID, tsec),& - 'readiopdata.F90', __LINE__) - - status = nf90_inq_varid (ncid, 'nbdate', bdate_varID ) - if (status /= NF90_NOERR) then - status = nf90_inq_varid (ncid, 'bdate', bdate_varID ) - if (status /= NF90_NOERR) then - if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find variable ID for bdate' - status = NF90_CLOSE ( ncid ) - call endrun - end if - end if - call handle_ncerr( nf90_get_var (ncid, bdate_varID, bdate),& - 'readiopdata.F90', __LINE__) - -! -!====================================================== -! read level data -! - status = NF90_INQ_DIMID( ncid, 'lev', lev_dimID ) - if ( status .ne. nf90_noerr ) then - if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find variable dim ID for lev' - status = NF90_CLOSE ( ncid ) - return - end if - - call handle_ncerr( nf90_inquire_dimension( ncid, lev_dimID, len=nlev ),& - 'readiopdata.F90', __LINE__) - - allocate(dplevs(nlev+1)) - - status = NF90_INQ_VARID( ncid, 'lev', lev_varID ) - if ( status .ne. nf90_noerr ) then - if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find variable ID for lev' - status = NF90_CLOSE ( ncid ) - return - end if - - call handle_ncerr( nf90_get_var (ncid, lev_varID, dplevs(:nlev)),& - 'readiopdata.F90', __LINE__) -! -!CAM generated forcing already has pressure on millibars convert standard IOP if needed. -! - call handle_ncerr(nf90_inquire_attribute(ncid, lev_varID, 'units', len=u_attlen),& - 'readiopdata.F90', __LINE__) - call handle_ncerr(nf90_get_att(ncid, lev_varID, 'units', units),& - 'readiopdata.F90', __LINE__) - units=trim(to_lower(units(1:u_attlen))) - - if ( units=='pa' .or. units=='pascal' .or. units=='pascals' ) then -! -! convert pressure from Pascals to Millibars ( lev is expressed in pascals in iop datasets ) -! - do i=1,nlev - dplevs( i ) = dplevs( i )/100._r8 - end do - endif - - - call shr_scam_GetCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,closelatidx,closelonidx) - - lonid = 0 - latid = 0 - levid = 0 - timeid = 0 - - call wrap_inq_dimid(ncid, 'lat', latid) - call wrap_inq_dimid(ncid, 'lon', lonid) - call wrap_inq_dimid(ncid, 'lev', levid) - call wrap_inq_dimid(ncid, 'time', timeid) - - strt4(1) = closelonidx - strt4(2) = closelatidx - strt4(3) = iopTimeIdx - strt4(4) = 1 - cnt4(1) = 1 - cnt4(2) = 1 - cnt4(3) = 1 - cnt4(4) = 1 - - status = nf90_inq_varid( ncid, 'Ps', varid ) - if ( status .ne. nf90_noerr ) then - have_ps = .false. - if (masterproc) write(iulog,*) sub//':Could not find variable Ps' - if ( .not. scm_backfill_iop_w_init ) then - status = NF90_CLOSE( ncid ) - return - else - if ( is_first_step() .and. masterproc) write(iulog,*) 'Using pressure value from Analysis Dataset' - endif - else - status = nf90_get_var(ncid, varid, ps(1,1,ntimelevel), strt4) - have_ps = .true. - endif - - -! If the IOP dataset has hyam,hybm,etc it is assumed to be a hybrid level -! dataset. - - status = nf90_inq_varid( ncid, 'hyam', varid ) - if ( status == nf90_noerr ) then - do i = 1, nlev - dplevs( i ) = 1000.0_r8 * hyam( i ) + ps(1,1,ntimelevel) * hybm( i ) / 100.0_r8 - end do - endif - -! add the surface pressure to the pressure level data, so that -! surface boundary condition will be set properly, -! making sure that it is the highest pressure in the array. -! - - total_levs = nlev+1 - dplevs(nlev+1) = ps(1,1,ntimelevel)/100.0_r8 ! ps is expressed in pascals - do i= nlev, 1, -1 - if ( dplevs(i) > ps(1,1,ntimelevel)/100.0_r8) then - total_levs = i - dplevs(i) = ps(1,1,ntimelevel)/100.0_r8 - end if - end do - if (.not. use_camiop ) then - nlev = total_levs - endif - if ( nlev == 1 ) then - if (masterproc) write(iulog,*) sub//':Error - Readiopdata.F: Ps too low!' - return - endif - -!===================================================================== - - - status = nf90_inq_varid( ncid, 'Tsair', varid ) - if ( status .ne. nf90_noerr ) then - have_tsair = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,tsair) - have_tsair = .true. - endif - -! -! read in Tobs For cam generated iop readin small t to avoid confusion -! with capital T defined in cam -! - - tobs(:)= t3(1,:,1,ntimelevel) - - if ( use_camiop ) then - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx,'t', have_tsair, & - tsair(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel),tobs, status ) - else - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx,'T', have_tsair, & - tsair(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), tobs, status ) - endif - if ( status .ne. nf90_noerr ) then - have_t = .false. - if (masterproc) write(iulog,*) sub//':Could not find variable T' - if ( .not. scm_backfill_iop_w_init ) then - status = NF90_CLOSE( ncid ) - return - else - if (masterproc) write(iulog,*) sub//':Using value from Analysis Dataset' - endif -! -! set T3 to Tobs on first time step -! - else - have_t = .true. - endif - - status = nf90_inq_varid( ncid, 'Tg', varid ) - if (status .ne. nf90_noerr) then - if (masterproc) write(iulog,*) sub//':Could not find variable Tg on IOP dataset' - if ( have_tsair ) then - if (masterproc) write(iulog,*) sub//':Using Tsair' - tground = tsair ! use surface value from T field - have_Tg = .true. - else - have_Tg = .true. - if (masterproc) write(iulog,*) sub//':Using T at lowest level from IOP dataset' - tground = tobs(plev) - endif - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,tground) - have_Tg = .true. - endif - - status = nf90_inq_varid( ncid, 'qsrf', varid ) - - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - if (is_first_step()) then - qinitobs(:,:)=q3(1,:,:,1,ntimelevel) - end if - - qobs(:)= q3(1,:,1,1,ntimelevel) - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'q', have_srf, & - srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), qobs, status ) - if ( status .ne. nf90_noerr ) then - have_q = .false. - if (masterproc) write(iulog,*) sub//':Could not find variable q' - if ( .not. scm_backfill_iop_w_init ) then - status = nf90_close( ncid ) - return - else - if (masterproc) write(iulog,*) sub//':Using values from Analysis Dataset' - endif - else - have_q = .true. - endif - - cldobs = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'cld', .false., & - dummy, fill_ends, dplevs, nlev,ps(1,1,ntimelevel), cldobs, status ) - if ( status .ne. nf90_noerr ) then - have_cld = .false. - else - have_cld = .true. - endif - - clwpobs = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'clwp', .false., & - dummy, fill_ends, dplevs, nlev,ps(1,1,ntimelevel), clwpobs, status ) - if ( status .ne. nf90_noerr ) then - have_clwp = .false. - else - have_clwp = .true. - endif - -! -! read divq (horizontal advection) -! - status = nf90_inq_varid( ncid, 'divqsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - divq(:,:)=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & - 'divq', have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divq(:,1), status ) - if ( status .ne. nf90_noerr ) then - have_divq = .false. - else - have_divq = .true. - endif - -! -! read vertdivq if available -! - status = nf90_inq_varid( ncid, 'vertdivqsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - vertdivq=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivq', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), vertdivq(:,1), status ) - if ( status .ne. nf90_noerr ) then - have_vertdivq = .false. - else - have_vertdivq = .true. - endif - - status = nf90_inq_varid( ncid, 'vertdivqsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - -! -! add calls to get dynamics tendencies for all prognostic consts -! - divq3d=0._r8 - - do m = 1, pcnst - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_dten', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divq3d(:,m), status ) - if ( status .ne. nf90_noerr ) then - have_cnst(m) = .false. - divq3d(1:,m)=0._r8 - else - if (m==1) have_divq3d = .true. - have_cnst(m) = .true. - endif - - coldata = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_dqfx', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), coldata, status ) - if ( STATUS .NE. NF90_NOERR ) then - dqfxcam(1,:,m)=0._r8 - else - dqfxcam(1,:,m)=coldata(:) - endif - - tmpdata = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_alph', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), tmpdata, status ) - if ( status .ne. nf90_noerr ) then -! have_cnst(m) = .false. - alphacam(m)=0._r8 - else - alphacam(m)=tmpdata(1) -! have_cnst(m) = .true. - endif - - end do - - - numliqobs = 0._r8 - call cnst_get_ind('NUMLIQ', inumliq, abort=.false.) - if ( inumliq > 0 ) then - have_srf = .false. - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'NUMLIQ', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), numliqobs, status ) - if ( status .ne. nf90_noerr ) then - have_numliq = .false. - else - have_numliq = .true. - do i=1, PLEV - q3(1,i,inumliq,1,ntimelevel)=numliqobs(i) - end do - endif - else - have_numliq = .false. - end if - - have_srf = .false. - - cldliqobs = 0._r8 - call cnst_get_ind('CLDLIQ', icldliq, abort=.false.) - if ( icldliq > 0 ) then - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'CLDLIQ', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), cldliqobs, status ) - if ( status .ne. nf90_noerr ) then - have_cldliq = .false. - else - have_cldliq = .true. - do i=1, PLEV - q3(1,i,icldliq,1,ntimelevel)=cldliqobs(i) - end do - endif - else - have_cldliq = .false. - endif - - cldiceobs = 0._r8 - call cnst_get_ind('CLDICE', icldice, abort=.false.) - if ( icldice > 0 ) then - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'CLDICE', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), cldiceobs, status ) - if ( status .ne. nf90_noerr ) then - have_cldice = .false. - else - have_cldice = .true. - do i=1, PLEV - q3(1,i,icldice,1,ntimelevel)=cldiceobs(i) - end do - endif - else - have_cldice = .false. - endif - - numiceobs = 0._r8 - call cnst_get_ind('NUMICE', inumice, abort=.false.) - if ( inumice > 0 ) then - have_srf = .false. - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'NUMICE', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), numiceobs, status ) - if ( status .ne. nf90_noerr ) then - have_numice = .false. - else - have_numice = .true. - do i=1, PLEV - q3(1,i,inumice,1,ntimelevel)=numiceobs(i) - end do - endif - else - have_numice = .false. - end if - -! -! read divu (optional field) -! - status = nf90_inq_varid( ncid, 'divusrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - divu = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divu', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divu, status ) - if ( status .ne. nf90_noerr ) then - have_divu = .false. - else - have_divu = .true. - endif -! -! read divv (optional field) -! - status = nf90_inq_varid( ncid, 'divvsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - divv = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divv', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divv, status ) - if ( status .ne. nf90_noerr ) then - have_divv = .false. - else - have_divv = .true. - endif -! -! read divt (optional field) -! - status = nf90_inq_varid( ncid, 'divtsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - divt=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & - 'divT', have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divt, status ) - if ( status .ne. nf90_noerr ) then - have_divt = .false. - else - have_divt = .true. - endif - -! -! read vertdivt if available -! - status = nf90_inq_varid( ncid, 'vertdivTsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - vertdivt=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivT', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), vertdivt, status ) - if ( status .ne. nf90_noerr ) then - have_vertdivt = .false. - else - have_vertdivt = .true. - endif -! -! read divt3d (combined vertical/horizontal advection) -! (optional field) - - status = nf90_inq_varid( ncid, 'divT3dsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - divT3d = 0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divT3d', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divt3d, status ) - if ( status .ne. nf90_noerr ) then - have_divt3d = .false. - else - have_divt3d = .true. - endif - - divU3d = 0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divU3d', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divu3d, status ) - if ( status .ne. nf90_noerr ) then - have_divu3d = .false. - else - have_divu3d = .true. - endif - - divV3d = 0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divV3d', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divv3d, status ) - if ( status .ne. nf90_noerr ) then - have_divv3d = .false. - else - have_divv3d = .true. - endif - - status = nf90_inq_varid( ncid, 'Ptend', varid ) - if ( status .ne. nf90_noerr ) then - have_ptend = .false. - if (masterproc) write(iulog,*) sub//':Could not find variable Ptend. Setting to zero' - ptend = 0.0_r8 - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_ptend = .true. - ptend= srf(1) - endif - - wfld=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & - 'omega', .true., ptend, fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), wfld, status ) - if ( status .ne. nf90_noerr ) then - have_omega = .false. - if (masterproc) write(iulog,*) sub//':Could not find variable omega' - if ( .not. scm_backfill_iop_w_init ) then - status = nf90_close( ncid ) - return - else - if (masterproc) write(iulog,*) sub//'Using value from Analysis Dataset' - endif - else - have_omega = .true. - endif - call plevs0(1 ,plon ,plev ,ps(1,1,ntimelevel) ,pint,pmid ,pdel) - call shr_sys_flush( iulog ) -! -! Build interface vector for the specified omega profile -! (weighted average in pressure of specified level values) -! - wfldh(:) = 0.0_r8 - - do k=2,plev - weight = (pint(k) - pmid(k-1))/(pmid(k) - pmid(k-1)) - wfldh(k) = (1.0_r8 - weight)*wfld(k-1) + weight*wfld(k) - end do - - status = nf90_inq_varid( ncid, 'usrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,srf) - have_srf = .true. - endif - - uobs=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & - 'u', have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), uobs, status ) - if ( status .ne. nf90_noerr ) then - have_u = .false. - else - have_u = .true. - do i=1, PLEV - u3(1,i,1,ntimelevel) = uobs(i) ! set u to uobs at first time step - end do - endif - - status = nf90_inq_varid( ncid, 'vsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,srf) - have_srf = .true. - endif - - vobs=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & - 'v', have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), vobs, status ) - if ( status .ne. nf90_noerr ) then - have_v = .false. - else - have_v = .true. - do i=1, PLEV - v3(1,i,1,ntimelevel) = vobs(i) ! set u to uobs at first time step - end do - endif - call shr_sys_flush( iulog ) - - status = nf90_inq_varid( ncid, 'Prec', varid ) - if ( status .ne. nf90_noerr ) then - have_prec = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,precobs) - have_prec = .true. - endif - - q1obs = 0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'Q1', & - .false., dummy, fill_ends, & ! datasets don't contain Q1 at surface - dplevs, nlev,ps(1,1,ntimelevel), q1obs, status ) - if ( status .ne. nf90_noerr ) then - have_q1 = .false. - else - have_q1 = .true. - endif - - q1obs = 0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'Q2', & - .false., dummy, fill_ends, & ! datasets don't contain Q2 at surface - dplevs, nlev,ps(1,1,ntimelevel), q1obs, status ) - if ( status .ne. nf90_noerr ) then - have_q2 = .false. - else - have_q2 = .true. - endif - -! Test for BOTH 'lhflx' and 'lh' without overwriting 'have_lhflx'. -! Analagous changes made for the surface heat flux - - status = nf90_inq_varid( ncid, 'lhflx', varid ) - if ( status .ne. nf90_noerr ) then - status = nf90_inq_varid( ncid, 'lh', varid ) - if ( status .ne. nf90_noerr ) then - have_lhflx = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,lhflxobs) - have_lhflx = .true. - endif - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,lhflxobs) - have_lhflx = .true. - endif - - status = nf90_inq_varid( ncid, 'shflx', varid ) - if ( status .ne. nf90_noerr ) then - status = nf90_inq_varid( ncid, 'sh', varid ) - if ( status .ne. nf90_noerr ) then - have_shflx = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,shflxobs) - have_shflx = .true. - endif - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,shflxobs) - have_shflx = .true. - endif - - call shr_sys_flush( iulog ) - -! -! fill in 3d forcing variables if we have both horizontal -! and vertical components, but not the 3d -! - if ( .not. have_cnst(1) .and. have_divq .and. have_vertdivq ) then - do k=1,plev - do m=1,pcnst - divq3d(k,m) = divq(k,m) + vertdivq(k,m) - enddo - enddo - have_divq3d = .true. - endif - - if ( .not. have_divt3d .and. have_divt .and. have_vertdivt ) then - if (masterproc) write(iulog,*) sub//'Don''t have divt3d - using divt and vertdivt' - do k=1,plev - divt3d(k) = divt(k) + vertdivt(k) - enddo - have_divt3d = .true. - endif -! -! make sure that use_3dfrc flag is set to true if we only have -! 3d forcing available -! - if ( .not. have_divt .or. .not. have_divq ) then - use_3dfrc = .true. - endif - call shr_sys_flush( iulog ) - - status = nf90_inq_varid( ncid, 'CLAT', varid ) - if ( status == nf90_noerr ) then - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,clat) - clat_p(1)=clat(1) - latdeg(1) = clat(1)*45._r8/atan(1._r8) - endif - - status = nf90_inq_varid( ncid, 'beta', varid ) - if ( status .ne. nf90_noerr ) then - betacam = 0._r8 - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - betacam=srf(1) - endif - - status = nf90_inq_varid( ncid, 'fixmas', varid ) - if ( status .ne. nf90_noerr ) then - fixmascam=1.0_r8 - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - fixmascam=srf(1) - endif - - call shr_sys_flush( iulog ) - - status = nf90_close( ncid ) - call shr_sys_flush( iulog ) - - deallocate(dplevs,tsec) - - return -end subroutine readiopdata - -subroutine setiopupdate - -!----------------------------------------------------------------------- -! -! Open and read netCDF file to extract time information -! -!---------------------------Code history-------------------------------- -! -! Written by John Truesdale August, 1996 -! -!----------------------------------------------------------------------- - implicit none -#if ( defined RS6000 ) - implicit automatic (a-z) -#endif - character(len=*), parameter :: sub = "setiopupdate" - -!------------------------------Locals----------------------------------- - - integer NCID,i - integer tsec_varID, time_dimID - integer, allocatable :: tsec(:) - integer ntime - integer bdate, bdate_varID - integer STATUS - integer next_date, next_sec, last_date, last_sec - integer :: ncsec,ncdate ! current time of day,date - integer :: yr, mon, day ! year, month, and day component - integer :: start_ymd,start_tod - save tsec, ntime, bdate - save last_date, last_sec + subroutine iop_update_prognostics(timelevel,ps,t3,u3,v3,q3) !------------------------------------------------------------------------------ - - if ( is_first_step() ) then -! -! Open IOP dataset -! - STATUS = NF90_OPEN( iopfile, NF90_NOWRITE, NCID ) -! -! Read time (tsec) variable -! - STATUS = NF90_INQ_VARID( NCID, 'tsec', tsec_varID ) - if ( STATUS .NE. NF90_NOERR .and. masterproc) write(iulog,*) & - sub//':ERROR - setiopupdate.F:', & - 'Cant get variable ID for tsec' - - STATUS = NF90_INQ_VARID( NCID, 'bdate', bdate_varID ) - if ( STATUS .NE. NF90_NOERR ) then - STATUS = NF90_INQ_VARID( NCID, 'basedate', bdate_varID ) - if ( STATUS .NE. NF90_NOERR .and. masterproc) write(iulog,*) & - sub//':ERROR - setiopupdate.F:Cant get variable ID for bdate' - endif - - STATUS = NF90_INQ_DIMID( NCID, 'time', time_dimID ) - if ( STATUS .NE. NF90_NOERR ) then - STATUS = NF90_INQ_DIMID( NCID, 'tsec', time_dimID ) - if ( STATUS .NE. NF90_NOERR ) then - write(iulog,* )'ERROR - setiopupdate.F:Could not find variable dim ID for time' - STATUS = NF90_CLOSE ( NCID ) - return - end if - end if - - if ( STATUS .NE. NF90_NOERR .and. masterproc) write(iulog,*) & - sub//':ERROR - setiopupdate.F:Cant get variable dim ID for time' - - STATUS = NF90_INQUIRE_DIMENSION( NCID, time_dimID, len=ntime ) - if ( STATUS .NE. NF90_NOERR ) then - if (masterproc) write(iulog,*) sub//':ERROR - setiopupdate.F:Cant get time dimlen' - endif - - if (.not.allocated(tsec)) allocate(tsec(ntime)) - - STATUS = NF90_GET_VAR( NCID, tsec_varID, tsec ) - if ( STATUS .NE. NF90_NOERR )then - if (masterproc) write(iulog,*) sub//':ERROR - setiopupdate.F:Cant get variable tsec' - endif - STATUS = NF90_GET_VAR( NCID, bdate_varID, bdate ) - if ( STATUS .NE. NF90_NOERR )then - if (masterproc) write(iulog,*) sub//':ERROR - setiopupdate.F:Cant get variable bdate' - endif -! Close the netCDF file - STATUS = NF90_CLOSE( NCID ) -! -! determine the last date in the iop dataset -! - call timemgr_time_inc(bdate, 0, last_date, last_sec, inc_s=tsec(ntime)) -! -! set the iop dataset index -! - iopTimeIdx=0 - do i=1,ntime ! set the first ioptimeidx - call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(i)) - call get_start_date(yr,mon,day,start_tod) - start_ymd = yr*10000 + mon*100 + day - - if ( start_ymd > next_date .or. (start_ymd == next_date & - .and. start_tod >= next_sec)) then - iopTimeIdx = i - endif - enddo - - call get_curr_date(yr,mon,day,ncsec) - ncdate=yr*10000 + mon*100 + day - - if (iopTimeIdx == 0.or.iopTimeIdx >= ntime) then - call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(1)) - if (masterproc) then - write(iulog,*) 'Error::setiopupdate: Current model time does not fall within IOP period' - write(iulog,*) ' Current CAM Date is ',ncdate,' and ',ncsec,' seconds' - write(iulog,*) ' IOP start is ',next_date,' and ',next_sec,' seconds' - write(iulog,*) ' IOP end is ',last_date,' and ',last_sec,' seconds' - end if - call endrun - endif - - doiopupdate = .true. - +! Copy IOP forcing fields into prognostics which for Eulerian is just PS !------------------------------------------------------------------------------ -! Check if iop data needs to be updated and set doiopupdate accordingly -!------------------------------------------------------------------------------ - else ! endstep > 1 - - call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(iopTimeIdx+1)) - - call get_curr_date(yr, mon, day, ncsec) - ncdate = yr*10000 + mon*100 + day + use scamMod, only: tobs,uobs,vobs,qobs,psobs + implicit none - if ( ncdate > next_date .or. (ncdate == next_date & - .and. ncsec >= next_sec)) then - iopTimeIdx = iopTimeIdx + 1 - doiopupdate = .true. -#if DEBUG > 2 - if (masterproc) write(iulog,*) sub//'nstep = ',get_nstep() - if (masterproc) write(iulog,*) sub//'ncdate=',ncdate,' ncsec=',ncsec - if (masterproc) write(iulog,*) sub//'next_date=',next_date,' next_sec=',next_sec - if (masterproc) write(iulog,*) sub//':******* do iop update' -#endif - else - doiopupdate = .false. - end if - endif ! if (endstep == 0 ) -! -! make sure we're -! not going past end of iop data -! - if ( ncdate > last_date .or. (ncdate == last_date & - .and. ncsec > last_sec)) then - if ( .not. scm_backfill_iop_w_init ) then - call endrun(sub//':ERROR - setiopupdate.c:Reached the end of the time varient dataset') - else - doiopupdate = .false. - end if - endif + !----------------------------------------------------------------------- -#if DEBUG > 1 - if (masterproc) write(iulog,*) sub//':iop time index = ' , ioptimeidx -#endif + integer, intent(in) :: timelevel + real(r8), optional, intent(inout) :: q3(:,:,:,:,:) + real(r8), optional, intent(inout) :: u3(:,:,:,:) + real(r8), optional, intent(inout) :: v3(:,:,:,:) + real(r8), optional, intent(inout) :: t3(:,:,:,:) + real(r8), optional, intent(inout) :: ps(:,:,:) - return +!---------------------------Local workspace----------------------------- + integer :: ioptop + character(len=*), parameter :: sub = "iop_update_prognostics" +!----------------------------------------------------------------------- + ! set prognostics from iop + ! Find level where tobs is no longer zero + ioptop = minloc(tobs(:), 1, BACK=.true.)+1 + if (present(ps)) ps(1,1,timelevel) = psobs + if (present(t3)) t3(1,ioptop:,1,timelevel) = tobs(ioptop:) + if (present(q3)) q3(1,ioptop:,1,1,timelevel) = qobs(ioptop:) + if (present(u3)) u3(1,ioptop:,1,timelevel) = uobs(ioptop:) + if (present(v3)) v3(1,ioptop:,1,timelevel) = vobs(ioptop:) -end subroutine setiopupdate + end subroutine iop_update_prognostics end module iop - diff --git a/src/dynamics/eul/restart_dynamics.F90 b/src/dynamics/eul/restart_dynamics.F90 index 348c2aa26c..dc80678f1b 100644 --- a/src/dynamics/eul/restart_dynamics.F90 +++ b/src/dynamics/eul/restart_dynamics.F90 @@ -9,11 +9,10 @@ module restart_dynamics pdeld, ps, vort, div, & dps, phis, dpsl, dpsm, omga, ptimelevels use scanslt, only: lammp, phimp, sigmp, qfcst -#if ( defined BFB_CAM_SCAM_IOP ) use iop, only: dqfx3sav,divq3dsav,divt3dsav,t2sav,betasav,fusav,fvsav -#endif use cam_logfile, only: iulog use spmd_utils, only: masterproc + use cam_history, only: write_camiop implicit none private @@ -125,7 +124,7 @@ subroutine init_restart_varlist() vcnt=vcnt+1 call set_r_var('PDELD', ptimelevels, vcnt, v4=pdeld ) - + vcnt=vcnt+1 call set_r_var('LAMMP', 1, vcnt, v3=lammp ) @@ -138,32 +137,32 @@ subroutine init_restart_varlist() call set_r_var('Q_fcst', 1, vcnt, v4=qfcst ) -#if ( defined BFB_CAM_SCAM_IOP ) -! -! Write scam values -! - vcnt=vcnt+1 - call set_r_var('DQFX', 1, vcnt, v4=dqfx3sav ) + if (write_camiop) then + ! + ! Write scam values + ! + vcnt=vcnt+1 + call set_r_var('DQFX', 1, vcnt, v4=dqfx3sav ) - vcnt=vcnt+1 - call set_r_var('DIVQ', 1, vcnt, v4=divq3dsav ) + vcnt=vcnt+1 + call set_r_var('DIVQ', 1, vcnt, v4=divq3dsav ) - vcnt=vcnt+1 - call set_r_var('DIVT', 1, vcnt, v3=divt3dsav ) + vcnt=vcnt+1 + call set_r_var('DIVT', 1, vcnt, v3=divt3dsav ) - vcnt=vcnt+1 - call set_r_var('T2', 1, vcnt, v3=t2sav ) + vcnt=vcnt+1 + call set_r_var('T2', 1, vcnt, v3=t2sav ) - vcnt=vcnt+1 - call set_r_var('FU', 1, vcnt, v3=fusav ) + vcnt=vcnt+1 + call set_r_var('FU', 1, vcnt, v3=fusav ) - vcnt=vcnt+1 - call set_r_var('FV', 1, vcnt, v3=fvsav ) + vcnt=vcnt+1 + call set_r_var('FV', 1, vcnt, v3=fvsav ) - vcnt=vcnt+1 - call set_r_var('BETA', 1, vcnt, v1=betasav ) + vcnt=vcnt+1 + call set_r_var('BETA', 1, vcnt, v1=betasav ) -#endif + end if if(vcnt.ne.restartvarcnt) then write(iulog,*) 'vcnt= ',vcnt, ' restartvarcnt=',restartvarcnt @@ -231,11 +230,11 @@ subroutine init_restart_dynamics(File, dyn_out) qdims(1:2) = hdimids(1:2) qdims(3) = vdimids(1) qdims(5) = timelevels_dimid - + call init_restart_varlist() do i=1,restartvarcnt - + call get_restart_var(i, name, timelevels, ndims, vdesc) if(timelevels>1) then if(ndims==3) then @@ -356,15 +355,15 @@ subroutine write_restart_dynamics (File, dyn_out) else if(ndims==5) then call pio_write_darray(File, vdesc, iodesc4d, transfer(restartvars(i)%v5d(:,:,:,:,ct), mold), ierr) end if - + end do - + end if end do call pio_freedecomp(File, iodesc2d) call pio_freedecomp(File, iodesc3d) call pio_freedecomp(File, iodesc4d) - + return end subroutine write_restart_dynamics @@ -393,10 +392,8 @@ subroutine read_restart_dynamics (File, dyn_in, dyn_out) use pmgrid, only: plon, plat, beglat, endlat use ppgrid, only: pver - -#if ( defined BFB_CAM_SCAM_IOP ) + use iop, only: init_iop_fields -#endif use massfix, only: alpha, hw1, hw2, hw3 use prognostics, only: n3m2, n3m1, n3 @@ -467,9 +464,8 @@ subroutine read_restart_dynamics (File, dyn_in, dyn_out) call init_restart_varlist() -#if ( defined BFB_CAM_SCAM_IOP ) - call init_iop_fields() -#endif + if (write_camiop) call init_iop_fields() + do i=1,restartvarcnt call get_restart_var(i, name, timelevels, ndims, vdesc) @@ -533,13 +529,13 @@ function get_restart_decomp(hdim1, hdim2, nlev) result(ldof) endlatxy = get_dyn_grid_parm('endlatxy') plat = get_dyn_grid_parm('plat') - - + + lcnt=(endlatxy-beglatxy+1)*nlev*(endlonxy-beglonxy+1) allocate(ldof(lcnt)) lcnt=0 - ldof(:)=0 + ldof(:)=0 do j=beglatxy,endlatxy do k=1,nlev do i=beglonxy, endlonxy diff --git a/src/dynamics/eul/scmforecast.F90 b/src/dynamics/eul/scmforecast.F90 index f9c0cbc6a8..decdff9c7f 100644 --- a/src/dynamics/eul/scmforecast.F90 +++ b/src/dynamics/eul/scmforecast.F90 @@ -1,11 +1,11 @@ module scmforecast - ! --------------------------------------------------------------------------- ! + ! --------------------------------------------------------------------------- ! ! ! ! Compute Time-Marched 'T, u, v, q' for SCAM by summing the 'physics', ! - ! 'horizontal advection', and 'vertical advection' tendencies. ! - ! This module is used only for SCAM. ! - ! ! - ! --------------------------------------------------------------------------- ! + ! 'horizontal advection', and 'vertical advection' tendencies. ! + ! This module is used only for SCAM. ! + ! ! + ! --------------------------------------------------------------------------- ! use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_control_mod, only: adiabatic @@ -19,26 +19,26 @@ module scmforecast ! Private module data ! -!======================================================================= +!======================================================================= contains -!======================================================================= +!======================================================================= - subroutine forecast( lat , nlon , ztodt , & + subroutine forecast( lat , nlon , ztodt , & psm1 , psm2 , ps , & u3 , u3m1 , u3m2 , & v3 , v3m1 , v3m2 , & t3 , t3m1 , t3m2 , & - q3 , q3m1 , q3m2 , & + q3 , q3m1 , q3m2 , & tten_phys , uten_phys , vten_phys , & qminus , qfcst ) - ! --------------------------------------------------------------------------- ! + ! --------------------------------------------------------------------------- ! ! ! ! Compute Time-Marched 'T, u, v, q' for SCAM by summing the 'physics', ! - ! 'horizontal advection', and 'vertical advection' tendencies. ! - ! This module is used only for SCAM. ! - ! ! + ! 'horizontal advection', and 'vertical advection' tendencies. ! + ! This module is used only for SCAM. ! + ! ! ! Author : Sungsu Park. 2010. Sep. ! ! ! ! --------------------------------------------------------------------------- ! @@ -79,8 +79,8 @@ subroutine forecast( lat , nlon , ztodt , & ! x3 : final state variable after time-marching ! ! --------------------------------------------------- ! - integer, intent(in) :: lat - integer, intent(in) :: nlon + integer, intent(in) :: lat + integer, intent(in) :: nlon real(r8), intent(in) :: ztodt ! Twice time step unless nstep = 0 [ s ] real(r8), intent(in) :: ps(plon) ! Surface pressure [ Pa ] @@ -100,13 +100,15 @@ subroutine forecast( lat , nlon , ztodt , & real(r8), intent(inout) :: uten_phys(plev) ! Tendency of u by the sum of 'physics + geostrophic forcing' [ m/s/s ] real(r8), intent(inout) :: vten_phys(plev) ! Tendency of v by the sum of 'physics + geostrophic forcing' [ m/s/s ] real(r8) qten_phys(plev,pcnst) ! Tendency of q by the 'physics' [ #/kg/s, kg/kg/s ] - real(r8), intent(in) :: qminus(plon,plev,pcnst) ! ( qminus - q3m2 ) / ztodt = Tendency of tracers by the 'physics' [ #/kg/s, kg/kg/s ] + real(r8), intent(in) :: qminus(plon,plev,pcnst) ! (qminus - q3m2) / ztodt = + ! Tendency of tracers by the 'physics' [ #/kg/s, kg/kg/s ] real(r8), intent(out) :: t3(plev) ! Temperature [ K ] real(r8), intent(out) :: u3(plev) ! Zonal wind [ m/s ] real(r8), intent(out) :: v3(plev) ! Meridional wind [ m/s ] real(r8), intent(inout) :: q3(plev,pcnst) ! Tracers [ #/kg, kg/kg ] - real(r8), intent(inout) :: qfcst(plon,plev,pcnst) ! ( Input qfcst - q3m2 ) / ztodt = Tendency of q by the sum of 'physics' + 'SLT vertical advection' [ #/kg/s, kg/kg/s ] + real(r8), intent(inout) :: qfcst(plon,plev,pcnst) ! ( Input qfcst - q3m2 ) / ztodt = Tendency of q by the sum of 'physics' + + ! 'SLT vertical advection' [ #/kg/s, kg/kg/s ] ! --------------- ! @@ -115,25 +117,28 @@ subroutine forecast( lat , nlon , ztodt , & integer dummy integer dummy_dyndecomp - integer i, k, m - integer ixcldliq, ixcldice, ixnumliq, ixnumice + integer i, k, m + integer ixcldliq, ixcldice, ixnumliq, ixnumice, ioptop real(r8) weight, fac - real(r8) pmidm1(plev) - real(r8) pintm1(plevp) - real(r8) pdelm1(plev) - real(r8) wfldint(plevp) - real(r8) pdelb(plon,plev) - real(r8) tfcst(plev) ! ( tfcst - t3m2 ) / ztodt = Tendency of T by the sum of 'physics' + 'SLT/EUL/XXX vertical advection' [ K/s ] - real(r8) ufcst(plev) ! ( ufcst - u3m2 ) / ztodt = Tendency of u by the sum of 'physics' + 'SLT/EUL/XXX vertical advection' [ m/s/s ] - real(r8) vfcst(plev) ! ( vfcst - u3m2 ) / ztodt = Tendency of v by the sum of 'physics' + 'SLT/EUL/XXX vertical advection' [ m/s/s ] + real(r8) pmidm1(plev) + real(r8) pintm1(plevp) + real(r8) pdelm1(plev) + real(r8) wfldint(plevp) + real(r8) pdelb(plon,plev) + real(r8) tfcst(plev) ! ( tfcst - t3m2 ) / ztodt = Tendency of T by the sum of 'physics' + + ! 'SLT/EUL/XXX vertical advection' [ K/s ] + real(r8) ufcst(plev) ! ( ufcst - u3m2 ) / ztodt = Tendency of u by the sum of 'physics' + + ! 'SLT/EUL/XXX vertical advection' [ m/s/s ] + real(r8) vfcst(plev) ! ( vfcst - u3m2 ) / ztodt = Tendency of v by the sum of 'physics' + + ! 'SLT/EUL/XXX vertical advection' [ m/s/s ] logical scm_fincl_empty ! ----------------------------------------------- ! ! Centered Eulerian vertical advective tendencies ! ! ----------------------------------------------- ! real(r8) tten_zadv_EULc(plev) ! Vertical advective forcing of t [ K/s ] - real(r8) uten_zadv_EULc(plev) ! Vertical advective forcing of u [ m/s/s ] - real(r8) vten_zadv_EULc(plev) ! Vertical advective forcing of v [ m/s/s ] + real(r8) uten_zadv_EULc(plev) ! Vertical advective forcing of u [ m/s/s ] + real(r8) vten_zadv_EULc(plev) ! Vertical advective forcing of v [ m/s/s ] real(r8) qten_zadv_EULc(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] ! --------------------------------- ! @@ -145,15 +150,15 @@ subroutine forecast( lat , nlon , ztodt , & ! Eulerian compression heating ! ! ---------------------------- ! - real(r8) tten_comp_EUL(plev) ! Compression heating by vertical advection [ K/s ] - + real(r8) tten_comp_EUL(plev) ! Compression heating by vertical advection [ K/s ] + ! ----------------------------------- ! ! Final vertical advective tendencies ! - ! ----------------------------------- ! + ! ----------------------------------- ! real(r8) tten_zadv(plev) ! Vertical advective forcing of t [ K/s ] - real(r8) uten_zadv(plev) ! Vertical advective forcing of u [ m/s/s ] - real(r8) vten_zadv(plev) ! Vertical advective forcing of v [ m/s/s ] + real(r8) uten_zadv(plev) ! Vertical advective forcing of u [ m/s/s ] + real(r8) vten_zadv(plev) ! Vertical advective forcing of v [ m/s/s ] real(r8) qten_zadv(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] ! --------------------------- ! @@ -210,18 +215,19 @@ subroutine forecast( lat , nlon , ztodt , & 'use_obs_T ', scm_use_obs_T , & 'relaxation ', scm_relaxation , & 'use_3dfrc ', use_3dfrc - + !---BPM ! ---------------------------- ! - ! ! + ! ! ! Main Computation Begins Here ! ! ! ! ---------------------------- ! dummy = 2 dummy_dyndecomp = 1 + ioptop = minloc(tobs(:), 1, BACK=.true.)+1 ! ------------------------------------------------------------ ! @@ -239,19 +245,19 @@ subroutine forecast( lat , nlon , ztodt , & ! Note 'tten_phys, uten_phys, vten_phys' are already input. ! ! ------------------------------------------------------------ ! - qten_phys(:plev,:pcnst) = ( qminus(1,:plev,:pcnst) - q3m2(:plev,:pcnst) ) / ztodt + qten_phys(:plev,:pcnst) = ( qminus(1,:plev,:pcnst) - q3m2(:plev,:pcnst) ) / ztodt ! ----------------------------------------------------- ! ! Extract SLT-transported vertical advective tendencies ! ! TODO : Add in SLT transport of t u v as well ! ! ----------------------------------------------------- ! - qten_zadv_SLT(:plev,:pcnst) = ( qfcst(1,:plev,:pcnst) - qminus(1,:plev,:pcnst) ) / ztodt + qten_zadv_SLT(:plev,:pcnst) = ( qfcst(1,:plev,:pcnst) - qminus(1,:plev,:pcnst) ) / ztodt ! ------------------------------------------------------- ! - ! use_camiop = .true. : Use CAM-generated 3D IOP file ! - ! = .false. : Use User-generated SCAM IOP file ! - ! ------------------------------------------------------- ! + ! use_camiop = .true. : Use CAM-generated 3D IOP file ! + ! = .false. : Use User-generated SCAM IOP file ! + ! ------------------------------------------------------- ! if( use_camiop ) then @@ -260,7 +266,7 @@ subroutine forecast( lat , nlon , ztodt , & ufcst(k) = u3m2(k) + ztodt * uten_phys(k) + ztodt * divu3d(k) vfcst(k) = v3m2(k) + ztodt * vten_phys(k) + ztodt * divv3d(k) do m = 1, pcnst - ! Below two lines are identical but in order to reproduce the bit-by-bit results + ! Below two lines are identical but in order to reproduce the bit-by-bit results ! of CAM-3D simulation, I simply rewrite the 'original' into the 'expanded' one. ! Below is the 'original' one. ! qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) + divq3d(k,m) ) @@ -272,18 +278,18 @@ subroutine forecast( lat , nlon , ztodt , & else ! ---------------------------------------------------------------------------- ! - ! Compute 'omega'( wfldint ) at the interface from the value at the mid-point. ! + ! Compute 'omega'( wfldint ) at the interface from the value at the mid-point. ! ! SCAM-IOP file must provide omega at the mid-point not at the interface. ! ! ---------------------------------------------------------------------------- ! - + wfldint(1) = 0._r8 do k = 2, plev weight = ( pintm1(k) - pmidm1(k-1) ) / ( pmidm1(k) - pmidm1(k-1) ) wfldint(k) = ( 1._r8 - weight ) * wfld(k-1) + weight * wfld(k) enddo wfldint(plevp) = 0._r8 - - ! ------------------------------------------------------------ ! + + ! ------------------------------------------------------------ ! ! Compute Eulerian compression heating due to vertical motion. ! ! ------------------------------------------------------------ ! @@ -292,13 +298,13 @@ subroutine forecast( lat , nlon , ztodt , & enddo ! ---------------------------------------------------------------------------- ! - ! Compute Centered Eulerian vertical advective tendencies for all 't, u, v, q' ! - ! ---------------------------------------------------------------------------- ! + ! Compute Centered Eulerian vertical advective tendencies for all 't, u, v, q' ! + ! ---------------------------------------------------------------------------- ! do k = 2, plev - 1 fac = 1._r8 / ( 2.0_r8 * pdelm1(k) ) tten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( t3m1(k+1) - t3m1(k) ) + wfldint(k) * ( t3m1(k) - t3m1(k-1) ) ) - vten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( v3m1(k+1) - v3m1(k) ) + wfldint(k) * ( v3m1(k) - v3m1(k-1) ) ) + vten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( v3m1(k+1) - v3m1(k) ) + wfldint(k) * ( v3m1(k) - v3m1(k-1) ) ) uten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( u3m1(k+1) - u3m1(k) ) + wfldint(k) * ( u3m1(k) - u3m1(k-1) ) ) do m = 1, pcnst qten_zadv_EULc(k,m) = -fac * ( wfldint(k+1) * ( q3m1(k+1,m) - q3m1(k,m) ) + wfldint(k) * ( q3m1(k,m) - q3m1(k-1,m) ) ) @@ -324,7 +330,7 @@ subroutine forecast( lat , nlon , ztodt , & end do ! ------------------------------------- ! - ! Manupulate individual forcings before ! + ! Manupulate individual forcings before ! ! computing the final forecasted state ! ! ------------------------------------- ! @@ -379,20 +385,20 @@ subroutine forecast( lat , nlon , ztodt , & ! -------------------------------------------------------------- ! ! Check horizontal advection u,v,t,q ! ! -------------------------------------------------------------- ! - if (.not. have_divu) divu=0._r8 - if (.not. have_divv) divv=0._r8 - if (.not. have_divt) divt=0._r8 - if (.not. have_divq) divq=0._r8 + if (.not. have_divu) divu=0._r8 + if (.not. have_divv) divv=0._r8 + if (.not. have_divt) divt=0._r8 + if (.not. have_divq) divq=0._r8 ! ----------------------------------- ! - ! ! + ! ! ! Compute the final forecasted states ! ! ! - ! ----------------------------------- ! + ! ----------------------------------- ! ! make sure we have everything ! - ! ----------------------------------- ! + ! ----------------------------------- ! - if( .not. scm_use_obs_uv .and. .not. have_divu .and. .not. have_divv ) then + if( .not. scm_use_obs_uv .and. .not. have_divu .and. .not. have_divv ) then call endrun( subname//':: divu and divv not on the iop Unable to forecast Wind Set & scm_use_obs_uv=true to use observed u and v') end if @@ -408,7 +414,7 @@ subroutine forecast( lat , nlon , ztodt , & ufcst(k) = u3m2(k) + ztodt * ( uten_phys(k) + divu(k) + uten_zadv(k) ) vfcst(k) = v3m2(k) + ztodt * ( vten_phys(k) + divv(k) + vten_zadv(k) ) do m = 1, pcnst - qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) + divq(k,m) + qten_zadv(k,m) ) + qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) + divq(k,m) + qten_zadv(k,m) ) enddo enddo @@ -453,32 +459,35 @@ subroutine forecast( lat , nlon , ztodt , & ! at each time step if specified by the switch. ! ! If SCAM-IOP has 't,u,v,q' profile at a single initial time step. ! ! ---------------------------------------------------------------- ! - - if( scm_use_obs_T .and. have_t ) then + + if( scm_use_obs_T .and. have_t ) then do k = 1, plev tfcst(k) = tobs(k) enddo endif - - if( scm_use_obs_uv .and. have_u .and. have_v ) then - do k = 1, plev - ufcst(k) = uobs(k) - vfcst(k) = vobs(k) - enddo + + if( scm_use_obs_uv .and. have_u .and. have_v ) then + ufcst(:plev) = uobs(:plev) + vfcst(:plev) = vobs(:plev) endif - - if( scm_use_obs_qv .and. have_q ) then + + if( scm_use_obs_qv .and. have_q ) then do k = 1, plev qfcst(1,k,1) = qobs(k) enddo endif - + + !If not using camiop then fillt tobs/qobs with background CAM state above IOP top before t3/q3 update below + if( .not. use_camiop ) then + tobs(1:ioptop-1)=t3(1:ioptop-1) + qobs(1:ioptop-1)=q3(1:ioptop-1,1) + end if ! ------------------------------------------------------------------- ! ! Relaxation to the observed or specified state ! ! We should specify relaxation time scale ( rtau ) and ! ! target-relaxation state ( in the current case, either 'obs' or 0 ) ! ! ------------------------------------------------------------------- ! - + relax_T(:) = 0._r8 relax_u(:) = 0._r8 relax_v(:) = 0._r8 @@ -503,34 +512,34 @@ subroutine forecast( lat , nlon , ztodt , & do k = 1, plev if( scm_relaxation ) then - if ( pmidm1(k).le.scm_relax_bot_p.and.pmidm1(k).ge.scm_relax_top_p ) then ! inside layer + if ( pmidm1(k)<=scm_relax_bot_p.and.pmidm1(k) >= scm_relax_top_p ) then ! inside layer if (scm_relax_linear) then rtau(k) = rslope*pmidm1(k) + rycept ! linear regime else rtau(k) = max( ztodt, scm_relax_tau_sec ) ! constant for whole layer / no relax outside endif - else if (scm_relax_linear .and. pmidm1(k).le.scm_relax_top_p ) then ! not linear => do nothing / linear => use upper value + else if (scm_relax_linear .and. pmidm1(k)<=scm_relax_top_p ) then ! not linear => do nothing / linear => use upper value rtau(k) = scm_relax_tau_top_sec ! above layer keep rtau equal to the top endif ! +BPM: this can't be the best way... ! I put this in because if rtau doesn't get set above, then I don't want to do any relaxation in that layer. - ! maybe the logic of this whole loop needs to be re-thinked. - if (rtau(k).ne.0) then + ! maybe the logic of this whole loop needs to be re-thinked. + if (rtau(k) /= 0) then relax_T(k) = - ( tfcst(k) - tobs(k) ) / rtau(k) relax_u(k) = - ( ufcst(k) - uobs(k) ) / rtau(k) - relax_v(k) = - ( vfcst(k) - vobs(k) ) / rtau(k) + relax_v(k) = - ( vfcst(k) - vobs(k) ) / rtau(k) relax_q(k,1) = - ( qfcst(1,k,1) - qobs(k) ) / rtau(k) do m = 2, pcnst relax_q(k,m) = - ( qfcst(1,k,m) - qinitobs(k,m) ) / rtau(k) enddo - if (scm_fincl_empty .or. ANY(scm_relax_fincl(:).eq.'T')) & + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:)=='T')) & tfcst(k) = tfcst(k) + relax_T(k) * ztodt - if (scm_fincl_empty .or.ANY(scm_relax_fincl(:).eq.'U')) & + if (scm_fincl_empty .or.ANY(scm_relax_fincl(:)=='U')) & ufcst(k) = ufcst(k) + relax_u(k) * ztodt - if (scm_fincl_empty .or. ANY(scm_relax_fincl(:).eq.'V')) & + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:)=='V')) & vfcst(k) = vfcst(k) + relax_v(k) * ztodt do m = 1, pcnst - if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) .eq. trim(to_upper(cnst_name(m)))) ) then + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) == trim(to_upper(cnst_name(m)))) ) then qfcst(1,k,m) = qfcst(1,k,m) + relax_q(k,m) * ztodt end if enddo @@ -540,22 +549,22 @@ subroutine forecast( lat , nlon , ztodt , & call outfld( 'TRELAX' , relax_T , plon, dummy ) call outfld( 'QRELAX' , relax_q(1:plev,1) , plon, dummy ) call outfld( 'TAURELAX' , rtau , plon, dummy ) - + ! --------------------------------------------------------- ! ! Assign the final forecasted state to the output variables ! ! --------------------------------------------------------- ! - + t3(1:plev) = tfcst(1:plev) u3(1:plev) = ufcst(1:plev) v3(1:plev) = vfcst(1:plev) q3(1:plev,1:pcnst) = qfcst(1,1:plev,1:pcnst) - + tdiff(1:plev) = t3(1:plev) - tobs(1:plev) qdiff(1:plev) = q3(1:plev,1) - qobs(1:plev) call outfld( 'QDIFF' , qdiff, plon, dummy_dyndecomp ) call outfld( 'TDIFF' , tdiff, plon, dummy_dyndecomp ) - + return end subroutine forecast diff --git a/src/dynamics/eul/stepon.F90 b/src/dynamics/eul/stepon.F90 index 61c3eea1ce..4c86f1d27e 100644 --- a/src/dynamics/eul/stepon.F90 +++ b/src/dynamics/eul/stepon.F90 @@ -16,8 +16,7 @@ module stepon use ppgrid, only: begchunk, endchunk use physics_types, only: physics_state, physics_tend use time_manager, only: is_first_step, get_step_size - use iop, only: setiopupdate, readiopdata - use scamMod, only: use_iop,doiopupdate,use_pert_frc,wfld,wfldh,single_column + use scamMod, only: use_iop,doiopupdate,use_pert_frc,wfld,wfldh,single_column,setiopupdate, readiopdata use perf_mod use aerosol_properties_mod, only: aerosol_properties @@ -75,12 +74,11 @@ subroutine stepon_init(dyn_in, dyn_out) use dyn_comp, only: dyn_import_t, dyn_export_t use scanslt, only: scanslt_initial use commap, only: clat + use cam_history, only: write_camiop use constituents, only: pcnst use physconst, only: gravit use eul_control_mod,only: eul_nsplit -#if ( defined BFB_CAM_SCAM_IOP ) use iop, only:init_iop_fields -#endif !----------------------------------------------------------------------- ! Arguments ! @@ -151,11 +149,9 @@ subroutine stepon_init(dyn_in, dyn_out) call t_stopf ('stepon_startup') -#if ( defined BFB_CAM_SCAM_IOP ) - if (is_first_step()) then + if (is_first_step() .and. write_camiop) then call init_iop_fields() endif -#endif ! get aerosol properties aero_props_obj => aerosol_properties_object() @@ -294,6 +290,10 @@ subroutine stepon_run3( ztodt, cam_out, phys_state, dyn_in, dyn_out ) !----------------------------------------------------------------------- use dyn_comp, only: dyn_import_t, dyn_export_t use eul_control_mod,only: eul_nsplit + use prognostics, only: ps + use iop, only: iop_update_prognostics + use hycoef, only: hyam, hybm, hyai, hybi, ps0 + real(r8), intent(in) :: ztodt ! twice time step unless nstep=0 type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) type(physics_state), intent(in):: phys_state(begchunk:endchunk) @@ -309,10 +309,12 @@ subroutine stepon_run3( ztodt, cam_out, phys_state, dyn_in, dyn_out ) call setiopupdate end if - ! Update IOP properties e.g. omega, divT, divQ - - if (doiopupdate) call readiopdata() + ! Read IOP data and update prognostics if needed + if (doiopupdate) then + call readiopdata(hyam, hybm, hyai, hybi, ps0) + call iop_update_prognostics(n3,ps=ps) + end if endif !---------------------------------------------------------- diff --git a/src/dynamics/eul/tfilt_massfix.F90 b/src/dynamics/eul/tfilt_massfix.F90 index a603c38fc9..0a43280a09 100644 --- a/src/dynamics/eul/tfilt_massfix.F90 +++ b/src/dynamics/eul/tfilt_massfix.F90 @@ -38,7 +38,7 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 use cam_control_mod, only: ideal_phys, tj2016_phys - use cam_history, only: outfld + use cam_history, only: outfld, write_camiop use eul_control_mod, only: fixmas,eps use pmgrid, only: plon, plev, plevp, plat use commap, only: clat @@ -51,10 +51,9 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & use phys_control, only: phys_getopts use qneg_module, only: qneg3 -#if ( defined BFB_CAM_SCAM_IOP ) use iop use constituents, only: cnst_get_ind, cnst_name -#endif + implicit none ! @@ -139,12 +138,10 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & ! real(r8) engk ! Kinetic energy integral ! real(r8) engp ! Potential energy integral integer i, k, m,j,ixcldliq,ixcldice,ixnumliq,ixnumice -#if ( defined BFB_CAM_SCAM_IOP ) real(r8) :: u3forecast(plon,plev) real(r8) :: v3forecast(plon,plev) real(r8) :: t3forecast(plon,plev),delta_t3(plon,plev) real(r8) :: q3forecast(plon,plev,pcnst),delta_q3(plon,plev,pcnst) -#endif real(r8) fixmas_plon(plon) real(r8) beta_plon(plon) real(r8) clat_plon(plon) @@ -152,64 +149,63 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & !----------------------------------------------------------------------- nstep = get_nstep() -#if ( defined BFB_CAM_SCAM_IOP ) -! -! Calculate 3d dynamics term -! - do k=1,plev - do i=1,nlon - divt3dsav(i,k,lat)=(t3(i,k)-tm2(i,k))/ztodt -t2sav(i,k,lat) - divu3dsav(i,k,lat)=(u3(i,k)-um2(i,k))/ztodt -fusav(i,k,lat) - divv3dsav(i,k,lat)=(v3(i,k)-vm2(i,k))/ztodt -fvsav(i,k,lat) - t3forecast(i,k)=tm2(i,k)+ztodt*t2sav(i,k,lat)+ztodt*divt3dsav(i,k,lat) - u3forecast(i,k)=um2(i,k)+ztodt*fusav(i,k,lat)+ztodt*divu3dsav(i,k,lat) - v3forecast(i,k)=vm2(i,k)+ztodt*fvsav(i,k,lat)+ztodt*divv3dsav(i,k,lat) + if (write_camiop) then + ! + ! Calculate 3d dynamics term + ! + do k=1,plev + do i=1,nlon + divt3dsav(i,k,lat)=(t3(i,k)-tm2(i,k))/ztodt -t2sav(i,k,lat) + divu3dsav(i,k,lat)=(u3(i,k)-um2(i,k))/ztodt -fusav(i,k,lat) + divv3dsav(i,k,lat)=(v3(i,k)-vm2(i,k))/ztodt -fvsav(i,k,lat) + t3forecast(i,k)=tm2(i,k)+ztodt*t2sav(i,k,lat)+ztodt*divt3dsav(i,k,lat) + u3forecast(i,k)=um2(i,k)+ztodt*fusav(i,k,lat)+ztodt*divu3dsav(i,k,lat) + v3forecast(i,k)=vm2(i,k)+ztodt*fvsav(i,k,lat)+ztodt*divv3dsav(i,k,lat) + end do end do - end do - do i=1,nlon - do m=1,pcnst - do k=1,plev - divq3dsav(i,k,m,lat)= (qfcst(i,k,m)-qminus(i,k,m))/ztodt - q3forecast(i,k,m)=qminus(i,k,m)+divq3dsav(i,k,m,lat)*ztodt + do i=1,nlon + do m=1,pcnst + do k=1,plev + divq3dsav(i,k,m,lat)= (qfcst(i,k,m)-qminus(i,k,m))/ztodt + q3forecast(i,k,m)=qminus(i,k,m)+divq3dsav(i,k,m,lat)*ztodt + end do end do end do - end do - q3(:nlon,:,:)=q3forecast(:nlon,:,:) - t3(:nlon,:)=t3forecast(:nlon,:) - qfcst(:nlon,:,:)=q3(:nlon,:,:) - -! -! outflds for iop history tape - to get bit for bit with scam -! the n-1 values are put out. After the fields are written out -! the current time level of info will be buffered for output next -! timestep -! - call outfld('t',t3 ,plon ,lat ) - call outfld('q',q3 ,plon ,lat ) - call outfld('Ps',ps ,plon ,lat ) - call outfld('u',u3 ,plon ,lat ) - call outfld('v',v3 ,plon ,lat ) -! -! read single values into plon arrays for output to history tape -! it would be nice if history tape supported 1 dimensional array variables -! - fixmas_plon(:)=fixmas - beta_plon(:)=beta - clat_plon(:)=clat(lat) - - call outfld('fixmas',fixmas_plon,plon ,lat ) - call outfld('beta',beta_plon ,plon ,lat ) - call outfld('CLAT ',clat_plon ,plon ,lat ) - call outfld('divT3d',divt3dsav(1,1,lat) ,plon ,lat ) - call outfld('divU3d',divu3dsav(1,1,lat) ,plon ,lat ) - call outfld('divV3d',divv3dsav(1,1,lat) ,plon ,lat ) - do m =1,pcnst - call outfld(trim(cnst_name(m))//'_dten',divq3dsav(1,1,m,lat) ,plon ,lat ) - end do -#endif - + q3(:nlon,:,:)=q3forecast(:nlon,:,:) + t3(:nlon,:)=t3forecast(:nlon,:) + qfcst(:nlon,:,:)=q3(:nlon,:,:) + + ! + ! outflds for iop history tape - to get bit for bit with scam + ! the n-1 values are put out. After the fields are written out + ! the current time level of info will be buffered for output next + ! timestep + ! + call outfld('t',t3 ,plon ,lat ) + call outfld('q',q3 ,plon ,lat ) + call outfld('Ps',ps ,plon ,lat ) + call outfld('u',u3 ,plon ,lat ) + call outfld('v',v3 ,plon ,lat ) + ! + ! read single values into plon arrays for output to history tape + ! it would be nice if history tape supported 1 dimensional array variables + ! + fixmas_plon(:)=fixmas + beta_plon(:)=beta + clat_plon(:)=clat(lat) + + call outfld('fixmas',fixmas_plon,plon ,lat ) + call outfld('beta',beta_plon ,plon ,lat ) + call outfld('CLAT ',clat_plon ,plon ,lat ) + call outfld('divT3d',divt3dsav(1,1,lat) ,plon ,lat ) + call outfld('divU3d',divu3dsav(1,1,lat) ,plon ,lat ) + call outfld('divV3d',divv3dsav(1,1,lat) ,plon ,lat ) + do m =1,pcnst + call outfld(trim(cnst_name(m))//'_dten',divq3dsav(1,1,m,lat) ,plon ,lat ) + end do + end if coslat = cos(clat(lat)) do i=1,nlon @@ -291,9 +287,9 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & dqfx3(i,k,m) = dqfxcam(i,k,m) else dqfx3(i,k,m) = alpha(m)*etamid(k)*abs(qfcst(i,k,m) - qminus(i,k,m)) -#if ( defined BFB_CAM_SCAM_IOP ) - dqfx3sav(i,k,m,lat) = dqfx3(i,k,m) -#endif + if (write_camiop) then + dqfx3sav(i,k,m,lat) = dqfx3(i,k,m) + endif endif end do if (lfixlim) then @@ -333,14 +329,13 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & end do ! i end do ! k - -#if ( defined BFB_CAM_SCAM_IOP ) - do m=1,pcnst - alpha_plon(:)= alpha(m) - call outfld(trim(cnst_name(m))//'_alph',alpha_plon ,plon ,lat ) - call outfld(trim(cnst_name(m))//'_dqfx',dqfx3sav(1,1,m,lat) ,plon ,lat ) - end do -#endif + if (write_camiop) then + do m=1,pcnst + alpha_plon(:)= alpha(m) + call outfld(trim(cnst_name(m))//'_alph',alpha_plon ,plon ,lat ) + call outfld(trim(cnst_name(m))//'_dqfx',dqfx3sav(1,1,m,lat) ,plon ,lat ) + end do + end if ! ! Check for and correct invalid constituents ! diff --git a/src/dynamics/fv3 b/src/dynamics/fv3 index 66227690a9..df3550b0f6 160000 --- a/src/dynamics/fv3 +++ b/src/dynamics/fv3 @@ -1 +1 @@ -Subproject commit 66227690a9fb43a64492de32de14562a25ede717 +Subproject commit df3550b0f6a835778f32ccc8c6291942e0413f62 diff --git a/src/dynamics/se/advect_tend.F90 b/src/dynamics/se/advect_tend.F90 index 44ea0ff6f7..3512b57507 100644 --- a/src/dynamics/se/advect_tend.F90 +++ b/src/dynamics/se/advect_tend.F90 @@ -10,8 +10,14 @@ module advect_tend private public :: compute_adv_tends_xyz + public :: compute_write_iop_fields real(r8), allocatable :: adv_tendxyz(:,:,:,:,:) + real(r8), allocatable :: iop_qtendxyz(:,:,:,:,:) + real(r8), allocatable :: iop_qtendxyz_init(:,:,:,:,:) + real(r8), allocatable :: derivedfq(:,:,:,:,:) + real(r8), allocatable :: iop_ttendxyz(:,:,:,:) + real(r8), allocatable :: iop_ttendxyz_init(:,:,:,:) contains @@ -22,18 +28,18 @@ module advect_tend ! - second call computes and outputs the tendencies !---------------------------------------------------------------------- subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) - use cam_history, only: outfld, hist_fld_active + use cam_history, only: outfld use time_manager, only: get_step_size - use constituents, only: tottnam,pcnst + use constituents, only: tottnam,pcnst use dimensions_mod, only: nc,np,nlev,use_cslam use element_mod, only: element_t - use fvm_control_volume_mod, only: fvm_struct + use fvm_control_volume_mod, only: fvm_struct implicit none type (element_t), intent(in) :: elem(:) type(fvm_struct), intent(in) :: fvm(:) integer, intent(in) :: nets,nete,qn0,n0 - real(r8) :: dt,idt + real(r8) :: dt integer :: i,j,ic,nx,ie logical :: init real(r8), allocatable, dimension(:,:) :: ftmp @@ -44,7 +50,7 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) nx=np endif allocate( ftmp(nx*nx,nlev) ) - + init = .false. if ( .not. allocated( adv_tendxyz ) ) then init = .true. @@ -68,7 +74,6 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) if ( .not. init ) then dt = get_step_size() - idt = 1._r8/dt do ie=nets,nete do ic = 1,pcnst @@ -85,4 +90,173 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) deallocate(ftmp) end subroutine compute_adv_tends_xyz + !---------------------------------------------------------------------- + ! computes camiop specific tendencies + ! and writes these to the camiop file + ! called twice each time step: + ! - first call sets the initial mixing ratios/state + ! - second call computes and outputs the tendencies + !---------------------------------------------------------------------- + subroutine compute_write_iop_fields(elem,fvm,nets,nete,qn0,n0) + use cam_abortutils, only: endrun + use cam_history, only: outfld, hist_fld_active + use time_manager, only: get_step_size + use constituents, only: pcnst,cnst_name + use dimensions_mod, only: nc,np,nlev,use_cslam,npsq + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct + implicit none + + type (element_t), intent(inout) :: elem(:) + type(fvm_struct), intent(inout) :: fvm(:) + integer, intent(in) :: nets,nete,qn0,n0 + real(r8) :: dt + real(r8), allocatable :: q_new(:,:,:) + real(r8), allocatable :: q_adv(:,:,:) + real(r8), allocatable :: t_adv(:,:) + real(r8), allocatable :: out_q(:,:) + real(r8), allocatable :: out_t(:,:) + real(r8), allocatable :: out_u(:,:) + real(r8), allocatable :: out_v(:,:) + real(r8), allocatable :: out_ps(:) + + integer :: i,j,ic,nx,ie,nxsq,p + integer :: ierr + logical :: init + character(len=*), parameter :: sub = 'compute_write_iop_fields:' + !---------------------------------------------------------------------------- + + if (use_cslam) then + nx=nc + else + nx=np + endif + nxsq=nx*nx + + init = .false. + dt = get_step_size() + + if ( .not. allocated( iop_qtendxyz ) ) then + init = .true. + + allocate( iop_qtendxyz(nx,nx,nlev,pcnst,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_qtendxyz' ) + iop_qtendxyz = 0._r8 + allocate( derivedfq(nx,nx,nlev,pcnst,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate derivedfq' ) + derivedfq = 0._r8 + allocate( iop_qtendxyz_init(nx,nx,nlev,pcnst,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_qtendxyz' ) + iop_qtendxyz_init = 0._r8 + allocate( iop_ttendxyz(nx,nx,nlev,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_ttendxyz' ) + iop_ttendxyz = 0._r8 + allocate( iop_ttendxyz_init(nx,nx,nlev,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_ttendxyz_init' ) + iop_ttendxyz_init = 0._r8 + endif + + ! save initial/calc tendencies on second call to this routine. + if (use_cslam) then + do ie=nets,nete + do ic=1,pcnst + iop_qtendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - iop_qtendxyz(:,:,:,ic,ie) + end do + end do + else + do ie=nets,nete + do ic=1,pcnst + iop_qtendxyz(:,:,:,ic,ie) = elem(ie)%state%Qdp(:,:,:,ic,qn0)/elem(ie)%state%dp3d(:,:,:,n0) - iop_qtendxyz(:,:,:,ic,ie) + enddo + end do + end if + do ie=nets,nete + iop_ttendxyz(:,:,:,ie) = elem(ie)%state%T(:,:,:,n0) - iop_ttendxyz(:,:,:,ie) + end do + + if (init) then + do ie=nets,nete + iop_ttendxyz_init(:,:,:,ie) = iop_ttendxyz(:,:,:,ie) + iop_qtendxyz_init(:,:,:,:,ie) = iop_qtendxyz(:,:,:,:,ie) + derivedfq(:,:,:,:,ie)=elem(ie)%derived%FQ(:,:,:,:)/dt + end do + end if + + if ( .not. init ) then + allocate( q_adv(nxsq,nlev,pcnst),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate q_adv' ) + q_adv = 0._r8 + allocate( t_adv(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate t_adv' ) + t_adv = 0._r8 + allocate( q_new(nx,nx,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate q_new' ) + q_new = 0._r8 + allocate( out_q(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_q' ) + out_q = 0._r8 + allocate( out_t(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_t' ) + out_t = 0._r8 + allocate( out_u(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_u' ) + out_u = 0._r8 + allocate( out_v(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_v' ) + out_v = 0._r8 + allocate( out_ps(npsq),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_ps' ) + out_ps = 0._r8 + do ie=nets,nete + do j=1,nx + do i=1,nx + t_adv(i+(j-1)*np,:) = iop_ttendxyz(i,j,:,ie)/dt - elem(ie)%derived%FT(i,j,:) + out_u(i+(j-1)*np,:) = elem(ie)%state%v(i,j,1,:,n0) + out_v(i+(j-1)*np,:) = elem(ie)%state%v(i,j,2,:,n0) + out_ps(i+(j-1)*np) = elem(ie)%state%psdry(i,j) + + ! to retain bfb, replace state q and t with roundoff version calculated using the ordering and tendencies of the + ! scam prognostic equation + elem(ie)%state%T(i,j,:,n0) = iop_ttendxyz_init(i,j,:,ie) + dt*(elem(ie)%derived%FT(i,j,:) + t_adv(i+(j-1)*np,:)) + out_t(i+(j-1)*np,:) = elem(ie)%state%T(i,j,:,n0) + do p=1,pcnst + q_adv(i+(j-1)*nx,:,p) = iop_qtendxyz(i,j,:,p,ie)/dt - derivedfq(i,j,:,p,ie) + q_new(i,j,:) = iop_qtendxyz_init(i,j,:,p,ie) + dt*(derivedfq(i,j,:,p,ie) + q_adv(i+(j-1)*nx,:,p)) + if (use_cslam) then + fvm(ie)%c(i,j,:,p)=q_new(i,j,:) + else + elem(ie)%state%Qdp(i,j,:,p,qn0)=q_new(i,j,:)*elem(ie)%state%dp3d(i,j,:,n0) + end if + enddo + out_q(i+(j-1)*nx,:) = elem(ie)%state%Qdp(i,j,:,1,qn0)/elem(ie)%state%dp3d(i,j,:,n0) + end do + end do + call outfld('Ps',out_ps,npsq,ie) + call outfld('t',out_t,npsq,ie) + call outfld('q',out_q,nxsq,ie) + call outfld('u',out_u,npsq,ie) + call outfld('v',out_v,npsq,ie) + call outfld('divT3d',t_adv,npsq,ie) + do p=1,pcnst + call outfld(trim(cnst_name(p))//'_dten',q_adv(:,:,p),nxsq,ie) + enddo + end do + + deallocate(iop_ttendxyz) + deallocate(iop_ttendxyz_init) + deallocate(iop_qtendxyz) + deallocate(iop_qtendxyz_init) + deallocate(derivedfq) + deallocate(out_t) + deallocate(out_q) + deallocate(out_u) + deallocate(out_v) + deallocate(out_ps) + deallocate(t_adv) + deallocate(q_adv) + deallocate(q_new) + + endif + end subroutine compute_write_iop_fields + end module advect_tend diff --git a/src/dynamics/se/apply_iop_forcing.F90 b/src/dynamics/se/apply_iop_forcing.F90 new file mode 100644 index 0000000000..06e2a48472 --- /dev/null +++ b/src/dynamics/se/apply_iop_forcing.F90 @@ -0,0 +1,238 @@ +module apply_iop_forcing_mod + +use shr_kind_mod, only:r8 => shr_kind_r8, i8 => shr_kind_i8 +use pmgrid, only:plev, plevp, plon +use constituents, only:pcnst, cnst_get_ind, cnst_name +use physconst, only:rair,cpair +use cam_logfile, only:iulog +use hybvcoord_mod, only: hvcoord_t +use scamMod, only: use_3dfrc, single_column, have_u, have_v, divT3d, divq3d, divt, divq, & + wfld, uobs, vobs, tobs, qobs, plevs0, have_divt3d, have_divq3d, & + scm_relax_bot_p,scm_relax_linear,scm_relax_tau_bot_sec, & + scm_relax_tau_sec,scm_relax_tau_top_sec,scm_relax_top_p, & + scm_relaxation,scm_relax_fincl,qinitobs + +use cam_abortutils, only: endrun +use string_utils, only: to_upper + +implicit none + +public advance_iop_forcing +public advance_iop_nudging + +!========================================================================= +contains +!========================================================================= + +subroutine advance_iop_forcing(scm_dt, ps_in, & ! In + u_in, v_in, t_in, q_in, t_phys_frc, q_phys_frc, hvcoord, & ! In + u_update, v_update, t_update, q_update) ! Out + +!----------------------------------------------------------------------- +! +! Purpose: +! Apply large scale forcing for t, q, u, and v as provided by the +! case IOP forcing file. +! +! Author: +! Original version: Adopted from CAM3.5/CAM5 +! Updated version for E3SM: Peter Bogenschutz (bogenschutz1@llnl.gov) +! and replaces the forecast.F90 routine in CAM3.5/CAM5/CAM6/E3SMv1/E3SMv2 +! +!----------------------------------------------------------------------- + + ! Input arguments + real(r8), intent(in) :: ps_in ! surface pressure [Pa] + real(r8), intent(in) :: u_in(plev) ! zonal wind [m/s] + real(r8), intent(in) :: v_in(plev) ! meridional wind [m/s] + real(r8), intent(in) :: t_in(plev) ! temperature [K] + real(r8), intent(in) :: q_in(plev,pcnst) ! q tracer array [units vary] already vertically advected + real(r8), intent(in) :: t_phys_frc(plev) ! temperature forcing from physics [K/s] + real(r8), intent(in) :: q_phys_frc(plev,pcnst) ! change in q due to physics. + type (hvcoord_t), intent(in) :: hvcoord + real(r8), intent(in) :: scm_dt ! model time step [s] + + ! Output arguments + real(r8), intent(out) :: t_update(plev) ! updated temperature [K] + real(r8), intent(out) :: q_update(plev,pcnst)! updated q tracer array [units vary] + real(r8), intent(out) :: u_update(plev) ! updated zonal wind [m/s] + real(r8), intent(out) :: v_update(plev) ! updated meridional wind [m/s] + + ! Local variables + real(r8) pmidm1(plev) ! pressure at model levels + real(r8) pintm1(plevp) ! pressure at model interfaces + real(r8) pdelm1(plev) ! pdel(k) = pint (k+1)-pint (k) + real(r8) t_lsf(plev) ! storage for temperature large scale forcing + real(r8) q_lsf(plev,pcnst) ! storage for moisture large scale forcing + real(r8) fac, t_expan + + integer i,k,m ! longitude, level, constituent indices + + character(len=*), parameter :: subname = 'advance_iop_forcing' + + ! Get vertical level profiles + call plevs0(plev, ps_in, hvcoord%ps0, hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, pintm1 ,pmidm1 ,pdelm1) + + ! Advance T and Q due to large scale forcing + if (use_3dfrc) then + if(.not.(have_divt3d.and.have_divq3d)) call endrun(subname//": FATAL: divt3d and divq3d not available") + t_lsf(:plev) = divt3d(:plev) + q_lsf(:plev,:pcnst) = divq3d(:plev,:pcnst) + else + t_lsf(:plev) = divt(:plev) + q_lsf(:plev,:pcnst) = divq(:plev,:pcnst) + endif + + do k=1,plev + ! Initialize thermal expansion term to zero. This term is only + ! considered if three dimensional forcing is not provided by IOP forcing file. + t_expan = 0._r8 + + if (.not. use_3dfrc) then + t_expan = scm_dt*wfld(k)*t_in(k)*rair/(cpair*pmidm1(k)) + endif + + if (use_3dfrc) then + do m=1,pcnst + ! When using 3d dynamics tendencies, SCM skips the vertical advection step and thus + ! q_in at this point has not had physics tendencies applied + q_update(k,m) = q_in(k,m) + scm_dt*(q_phys_frc(k,m) + q_lsf(k,m)) + end do + t_update(k) = t_in(k) + t_expan + scm_dt*(t_phys_frc(k) + t_lsf(k)) + else + do m=1,pcnst + ! When not using 3d dynamics tendencies, q_in at this point has had physics tend + ! applied and has been vertically advected. Only horizontal dyn tend needed for forecast. + q_update(k,m) = q_in(k,m) + scm_dt*q_lsf(k,m) + end do + t_update(k) = t_in(k) + t_expan + scm_dt*t_lsf(k) + end if + end do + + ! Set U and V fields + + if ( have_v .and. have_u ) then + do k=1,plev + u_update(k) = uobs(k) + v_update(k) = vobs(k) + enddo + endif + +end subroutine advance_iop_forcing + +!========================================================================= + +subroutine advance_iop_nudging(ztodt, ps_in, & ! In + tfcst, qfcst, ufcst, vfcst, hvcoord, & ! Inout + relaxt, relaxq ) ! Out + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Option to nudge t and q to observations as specified by the IOP file + !----------------------------------------------------------------------- + + ! Input arguments + real(r8), intent(in) :: ztodt ! model time step [s] + real(r8), intent(in) :: ps_in ! surface pressure [Pa] + type (hvcoord_t), intent(in) :: hvcoord + + ! Output arguments + real(r8), intent(inout) :: tfcst(plev) ! updated temperature [K] + real(r8), intent(inout) :: qfcst(plon,plev,pcnst) ! updated const field + real(r8), intent(inout) :: ufcst(plev) ! updated U wind + real(r8), intent(inout) :: vfcst(plev) ! updated V wind + real(r8), intent(out) :: relaxt(plev) ! relaxation of temperature [K/s] + real(r8), intent(out) :: relaxq(plev) ! relaxation of vapor [kg/kg/s] + + ! Local variables + integer :: i, k, m + real(r8) pmidm1(plev) ! pressure at model levels + real(r8) pintm1(plevp) ! pressure at model interfaces + real(r8) pdelm1(plev) ! pdel(k) = pint (k+1)-pint (k) + + ! --------------------------- ! + ! For 'scm_relaxation' switch ! + ! --------------------------- ! + + real(r8) rtau(plev) + real(r8) relax_T(plev) + real(r8) relax_u(plev) + real(r8) relax_v(plev) + real(r8) relax_q(plev,pcnst) + ! +++BPM: allow linear relaxation profile + real(r8) rslope ! [optional] slope for linear relaxation profile + real(r8) rycept ! [optional] y-intercept for linear relaxtion profile + logical scm_fincl_empty + + ! ------------------------------------------------------------------- ! + ! Relaxation to the observed or specified state ! + ! We should specify relaxation time scale ( rtau ) and ! + ! target-relaxation state ( in the current case, either 'obs' or 0 ) ! + ! ------------------------------------------------------------------- ! + + if ( .not. scm_relaxation) return + + call plevs0(plev, ps_in, hvcoord%ps0, hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, pintm1 ,pmidm1 ,pdelm1) + + relax_T(:) = 0._r8 + relax_u(:) = 0._r8 + relax_v(:) = 0._r8 + relax_q(:plev,:pcnst) = 0._r8 + ! +++BPM: allow linear relaxation profile + ! scm_relaxation is a logical from scamMod + ! scm_relax_tau_top_sec and scm_relax_tau_bot_sec are the relaxation times at top and bottom of layer + ! also defined in scamMod + if ( scm_relax_linear ) then + rslope = (scm_relax_top_p - scm_relax_bot_p)/(scm_relax_tau_top_sec - scm_relax_tau_bot_sec) + rycept = scm_relax_tau_top_sec - (rslope*scm_relax_top_p) + endif + + scm_fincl_empty=.true. + do i=1,pcnst + if (len_trim(scm_relax_fincl(i)) > 0) then + scm_fincl_empty=.false. + scm_relax_fincl(i)=trim(to_upper(scm_relax_fincl(i))) + end if + end do + + do k = 1, plev + if ( pmidm1(k) <= scm_relax_bot_p.and.pmidm1(k) >= scm_relax_top_p ) then ! inside layer + if (scm_relax_linear) then + rtau(k) = rslope*pmidm1(k) + rycept ! linear regime + else + rtau(k) = max( ztodt, scm_relax_tau_sec ) ! constant for whole layer / no relax outside + endif + else if (scm_relax_linear .and. pmidm1(k) <= scm_relax_top_p ) then ! not linear => do nothing / linear => use upper value + rtau(k) = scm_relax_tau_top_sec ! above layer keep rtau equal to the top + endif + ! +BPM: this can't be the best way... + ! I put this in because if rtau doesn't get set above, then I don't want to do any relaxation in that layer. + ! maybe the logic of this whole loop needs to be re-thinked. + if (rtau(k) /= 0) then + relax_T(k) = - ( tfcst(k) - tobs(k) ) / rtau(k) + relax_u(k) = - ( ufcst(k) - uobs(k) ) / rtau(k) + relax_v(k) = - ( vfcst(k) - vobs(k) ) / rtau(k) + relax_q(k,1) = - ( qfcst(1,k,1) - qobs(k) ) / rtau(k) + do m = 2, pcnst + relax_q(k,m) = - ( qfcst(1,k,m) - qinitobs(k,m) ) / rtau(k) + enddo + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) == 'T')) & + tfcst(k) = tfcst(k) + relax_T(k) * ztodt + if (scm_fincl_empty .or.ANY(scm_relax_fincl(:) == 'U')) & + ufcst(k) = ufcst(k) + relax_u(k) * ztodt + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) == 'V')) & + vfcst(k) = vfcst(k) + relax_v(k) * ztodt + do m = 1, pcnst + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) == trim(to_upper(cnst_name(m)))) ) then + qfcst(1,k,m) = qfcst(1,k,m) + relax_q(k,m) * ztodt + end if + enddo + end if + enddo + +end subroutine advance_iop_nudging + +!----------------------------------------------------------------------- + +end module apply_iop_forcing_mod diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index beba3d3611..919b7f3510 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -15,7 +15,7 @@ module dp_coupling use physics_types, only: physics_state, physics_tend, physics_cnst_limit use phys_grid, only: get_ncols_p -use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p +use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p, phys_columns_on_task use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_get_field use dp_mapping, only: nphys_pts @@ -224,7 +224,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) allocate(frontga_phys(pcols, pver, begchunk:endchunk)) end if !$omp parallel do num_threads(max_num_threads) private (col_ind, lchnk, icol, ie, blk_ind, ilyr, m) - do col_ind = 1, columns_on_task + do col_ind = 1, phys_columns_on_task call get_dyn_col_p(col_ind, ie, blk_ind) call get_chunk_info_p(col_ind, lchnk, icol) phys_state(lchnk)%ps(icol) = ps_tmp(blk_ind(1), ie) @@ -306,7 +306,7 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) ! Convert the physics output state into the dynamics input state. - use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p + use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p, phys_columns_on_task use bndry_mod, only: bndry_exchange use edge_mod, only: edgeVpack, edgeVunpack use fvm_mapping, only: phys2dyn_forcings_fvm @@ -383,7 +383,7 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) call t_startf('pd_copy') !$omp parallel do num_threads(max_num_threads) private (col_ind, lchnk, icol, ie, blk_ind, ilyr, m) - do col_ind = 1, columns_on_task + do col_ind = 1, phys_columns_on_task call get_dyn_col_p(col_ind, ie, blk_ind) call get_chunk_info_p(col_ind, lchnk, icol) diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 2732bae233..018c281253 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -508,7 +508,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dBH') rhypervis_subcycle=1.0_r8/real(hypervis_subcycle,kind=r8) - call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord) + call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend) do ie=nets,nete ! compute mean flux diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index dc012e2d12..e2d470f616 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -163,7 +163,7 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) do k=1,nlev pmid_ref =hvcoord%hyam(k)*hvcoord%ps0 + hvcoord%hybm(k)*ps_ref(:,:,ie) dp0 = ( hvcoord%hyai(k+1) - hvcoord%hyai(k) )*hvcoord%ps0 + & - ( hvcoord%hybi(k+1) - hvcoord%hybi(k) )*hvcoord%ps0 + ( hvcoord%hybi(k+1) - hvcoord%hybi(k) )*hvcoord%ps0 if (hvcoord%hybm(k)>0) then elem(ie)%derived%T_ref(:,:,k) = T0+T1*(pmid_ref/hvcoord%ps0)**cappa ! @@ -184,7 +184,7 @@ end subroutine prim_init2 !=======================================================================================================! - subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubstep, omega_cn) + subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubstep, single_column, omega_cn) ! ! advance all variables (u,v,T,ps,Q,C) from time t to t + dt_q ! @@ -238,7 +238,8 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep type (TimeLevel_t), intent(inout):: tl integer, intent(in) :: nsubstep ! nsubstep = 1 .. nsplit - real (kind=r8) , intent(inout):: omega_cn(2,nets:nete) !min and max of vertical Courant number + logical, intent(in) :: single_column + real (kind=r8) , intent(inout):: omega_cn(2,nets:nete) !min and max of vertical Courant number real(kind=r8) :: dt_q, dt_remap, dt_phys integer :: ie, q,k,n0_qdp,np1_qdp,r, nstep_end,region_num_threads,i,j @@ -265,7 +266,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! ! initialize variables for computing vertical Courant number ! - if (variable_nsplit.or.compute_diagnostics) then + if (variable_nsplit.or.compute_diagnostics) then if (nsubstep==1) then do ie=nets,nete omega_cn(1,ie) = 0.0_r8 @@ -306,11 +307,17 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') end if call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBL') - call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r,nsubstep==nsplit,dt_remap) + if (single_column) then + ! Single Column Case + ! Loop over rsplit vertically lagrangian timesteps + call prim_step_scm(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) + else + call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r,nsubstep==nsplit,dt_remap) + end if call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,n0_qdp,'dAL') enddo - + ! defer final timelevel update until after remap and diagnostics call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) @@ -320,12 +327,12 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! always for tracers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') if (variable_nsplit.or.compute_diagnostics) then ! ! initialize variables for computing vertical Courant number - ! + ! do ie=nets,nete dp_end(:,:,:,ie) = elem(ie)%state%dp3d(:,:,:,tl%np1) end do @@ -339,8 +346,8 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR') - if (nsubstep==nsplit) then - call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) + if (nsubstep==nsplit.and. .not. single_column) then + call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) end if ! now we have: @@ -441,8 +448,8 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s use fvm_mapping, only: cslam2gll #ifdef waccm_debug use cam_history, only: outfld -#endif - +#endif + type (element_t) , intent(inout) :: elem(:) type(fvm_struct), intent(inout) :: fvm(:) @@ -575,7 +582,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s ! ! FVM transport ! - if ((mod(rstep,fvm_supercycling) == 0).and.(mod(rstep,fvm_supercycling_jet) == 0)) then + if ((mod(rstep,fvm_supercycling) == 0).and.(mod(rstep,fvm_supercycling_jet) == 0)) then ! call omp_set_nested(.true.) ! !$OMP PARALLEL NUM_THREADS(vert_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew2,kbeg,kend) @@ -612,7 +619,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s ! call Prim_Advec_Tracers_fvm(elem,fvm,hvcoord,hybrid,& dt_q,tl,nets,nete,ghostBufQnhcJet_h,ghostBufQ1_h, ghostBufFluxJet_h,kmin_jet,kmax_jet) - end if + end if #ifdef waccm_debug do ie=nets,nete @@ -623,8 +630,81 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s endif end subroutine prim_step + subroutine prim_step_scm(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) + ! + ! prim_step version for single column model (SCM) + ! Here we simply want to compute the floating level tendency + ! based on the prescribed large scale vertical velocity + ! Take qsplit dynamics steps and one tracer step + ! for vertically lagrangian option, this subroutine does only + ! the horizontal step + ! + ! input: + ! tl%nm1 not used + ! tl%n0 data at time t + ! tl%np1 new values at t+dt_q + ! + ! then we update timelevel pointers: + ! tl%nm1 = tl%n0 + ! tl%n0 = tl%np1 + ! so that: + ! tl%nm1 tracers: t dynamics: t+(qsplit-1)*dt + ! tl%n0 time t + dt_q + ! + use hybvcoord_mod, only: hvcoord_t + use se_dyn_time_mod, only: TimeLevel_t, timelevel_update + use control_mod, only: statefreq, qsplit, nu_p + use prim_advection_mod, only: deriv + use hybrid_mod, only: config_thread_region, get_loop_ranges + + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct), intent(inout) :: fvm(:) + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + type (hvcoord_t), intent(in) :: hvcoord ! hybrid vertical coordinate struct + integer, intent(in) :: nets ! starting thread element number (private) + integer, intent(in) :: nete ! ending thread element number (private) + real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep + type (TimeLevel_t), intent(inout) :: tl + integer, intent(in) :: rstep ! vertical remap subcycling step + + integer :: ie,n + + ! =============== + ! initialize mean flux accumulation variables and save some variables at n0 + ! for use by advection + ! =============== + do ie=nets,nete + elem(ie)%derived%vn0=0 ! mean horizontal mass flux + if (nu_p>0) then + elem(ie)%derived%dpdiss_ave=0 + elem(ie)%derived%dpdiss_biharmonic=0 + endif + elem(ie)%derived%dp(:,:,:)=elem(ie)%state%dp3d(:,:,:,tl%n0) + enddo + + ! =============== + ! Dynamical Step + ! =============== + + call t_startf('set_prescribed_scm') + call set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + + call t_stopf('set_prescribed_scm') + do n=2,qsplit + call TimeLevel_update(tl,"leapfrog") + + call t_startf('set_prescribed_scm') + + call set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + + call t_stopf('set_prescribed_scm') + enddo + + end subroutine prim_step_scm !=======================================================================================================! @@ -729,4 +809,62 @@ subroutine get_global_ave_surface_pressure(elem, global_ave_ps_inic) deallocate(tmp) end subroutine get_global_ave_surface_pressure + subroutine set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + use control_mod, only: tstep_type, qsplit + use derivative_mod, only: derivative_t + use dimensions_mod, only: np, nlev + use element_mod, only: element_t + use hybvcoord_mod, only: hvcoord_t + use hybrid_mod, only: hybrid_t + use se_dyn_time_mod, only: TimeLevel_t, timelevel_qdp + use fvm_control_volume_mod, only: fvm_struct + implicit none + + type (element_t), intent(inout), target :: elem(:) + type(fvm_struct) , intent(inout) :: fvm(:) + type (derivative_t) , intent(in) :: deriv + type (hvcoord_t) :: hvcoord + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8), intent(in) :: dt + type (TimeLevel_t) , intent(in) :: tl + integer , intent(in) :: nets + integer , intent(in) :: nete + + ! Local + integer :: ie,nm1,n0,np1,k,qn0,qnp1,p + real(kind=r8) :: eta_dot_dpdn(np,np,nlev+1) + + + nm1 = tl%nm1 + n0 = tl%n0 + np1 = tl%np1 + + call TimeLevel_Qdp(tl, qsplit, qn0, qnp1) ! compute current Qdp() timelevel + + do ie=nets,nete + do k=1,nlev + eta_dot_dpdn(:,:,k)=elem(ie)%derived%omega(:,:,k) + enddo + eta_dot_dpdn(:,:,nlev+1) = eta_dot_dpdn(:,:,nlev) + + do k=1,nlev + elem(ie)%state%dp3d(:,:,k,np1) = elem(ie)%state%dp3d(:,:,k,n0) & + + dt*(eta_dot_dpdn(:,:,k+1) - eta_dot_dpdn(:,:,k)) + enddo + + do k=1,nlev + elem(ie)%state%T(:,:,k,np1) = elem(ie)%state%T(:,:,k,n0) + enddo + + do p=1,qsize + do k=1,nlev + elem(ie)%state%Qdp(:,:,k,p,qnp1) = elem(ie)%state%Qdp(:,:,k,p,qn0) & + + elem(ie)%state%Qdp(:,:,k,p,qn0)/elem(ie)%state%dp3d(:,:,k,n0) * & + dt*(eta_dot_dpdn(:,:,k+1) - eta_dot_dpdn(:,:,k)) + enddo + enddo + enddo + end subroutine set_prescribed_scm + end module prim_driver_mod diff --git a/src/dynamics/se/dycore/vertremap_mod.F90 b/src/dynamics/se/dycore/vertremap_mod.F90 index 3b57fd891e..59fc6afddd 100644 --- a/src/dynamics/se/dycore/vertremap_mod.F90 +++ b/src/dynamics/se/dycore/vertremap_mod.F90 @@ -17,7 +17,6 @@ module vertremap_mod use shr_kind_mod, only: r8=>shr_kind_r8 use dimensions_mod, only: np,nlev,qsize,nlevp,npsq,nc - use hybvcoord_mod, only: hvcoord_t use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use perf_mod, only: t_startf, t_stopf ! _EXTERNAL @@ -25,7 +24,7 @@ module vertremap_mod use cam_abortutils, only: endrun implicit none - + public remap1 ! remap any field, splines, monotone public remap1_nofilter ! remap any field, splines, no filter ! todo: tweak interface to match remap1 above, rename remap1_ppm: @@ -65,19 +64,19 @@ subroutine remap1(Qdp,nx,qstart,qstop,qsize,dp1,dp2,ptop,identifier,Qdp_mass,kor if (any(kord(:) >= 0)) then if (.not.qdp_mass) then do itrac=1,qsize - if (kord(itrac) >= 0) then + if (kord(itrac) >= 0) then Qdp(:,:,:,itrac) = Qdp(:,:,:,itrac)*dp1(:,:,:) end if end do - end if + end if call remap_Q_ppm(qdp,nx,qstart,qstop,qsize,dp1,dp2,kord) if (.not.qdp_mass) then do itrac=1,qsize - if (kord(itrac) >= 0) then + if (kord(itrac) >= 0) then Qdp(:,:,:,itrac) = Qdp(:,:,:,itrac)/dp2(:,:,:) end if end do - end if + end if endif if (any(kord(:)<0)) then ! @@ -89,20 +88,20 @@ subroutine remap1(Qdp,nx,qstart,qstop,qsize,dp1,dp2,ptop,identifier,Qdp_mass,kor kord_local = abs(kord) logp = .false. else - kord_local = abs(kord/10) + kord_local = abs(kord/10) if (identifier==1) then logp = .true. else - logp = .false. + logp = .false. end if end if ! ! modified FV3 vertical remapping - ! + ! if (qdp_mass) then inv_dp = 1.0_r8/dp1 do itrac=1,qsize - if (kord(itrac)<0) then + if (kord(itrac)<0) then Qdp(:,:,:,itrac) = Qdp(:,:,:,itrac)*inv_dp(:,:,:) end if end do @@ -124,7 +123,7 @@ subroutine remap1(Qdp,nx,qstart,qstop,qsize,dp1,dp2,ptop,identifier,Qdp_mass,kor pe2(i,k) = log(pe2(i,k)) end do end do - + do itrac=1,qsize if (kord(itrac)<0) then call map1_ppm( nlev, pe1(:,:), Qdp(:,:,:,itrac), gz, & @@ -457,7 +456,7 @@ subroutine binary_search(pio, pivot, k) real(kind=r8), intent(in) :: pio(nlev+2), pivot integer, intent(inout) :: k integer :: lo, hi, mid - + if (pio(k) > pivot) then lo = 1 hi = k @@ -597,7 +596,7 @@ subroutine linextrap(dx1,dx2,dx3,dx4,y1,y2,y3,y4,lo,hi) y4 = (1.0_r8-a)*y1 + a*y2 y3 = max(lo, min(hi, y3)) y4 = max(lo, min(hi, y4)) - end subroutine linextrap + end subroutine linextrap end module vertremap_mod !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/src/dynamics/se/dycore/viscosity_mod.F90 b/src/dynamics/se/dycore/viscosity_mod.F90 index 04b0a1a91d..51bf63a3da 100644 --- a/src/dynamics/se/dycore/viscosity_mod.F90 +++ b/src/dynamics/se/dycore/viscosity_mod.F90 @@ -1,9 +1,9 @@ module viscosity_mod ! ! This module should be renamed "global_deriv_mod.F90" -! -! It is a collection of derivative operators that must be applied to the field -! over the sphere (as opposed to derivative operators that can be applied element +! +! It is a collection of derivative operators that must be applied to the field +! over the sphere (as opposed to derivative operators that can be applied element ! by element) ! ! @@ -50,10 +50,9 @@ module viscosity_mod CONTAINS -subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord) +subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend) use derivative_mod, only : subcell_Laplace_fluxes use dimensions_mod, only : use_cslam, nu_div_lev,nu_lev - use hybvcoord_mod, only : hvcoord_t !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! compute weak biharmonic operator ! input: h,v (stored in elem()%, in lat-lon coordinates @@ -69,25 +68,24 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, real (kind=r8), dimension(np,np,nlev,nets:nete) :: ttens,dptens type (EdgeBuffer_t) , intent(inout) :: edge3 type (derivative_t) , intent(in) :: deriv - type (hvcoord_t) , intent(in) :: hvcoord ! local integer :: i,j,k,kptr,ie,kblk ! real (kind=r8), dimension(:,:), pointer :: rspheremv real (kind=r8), dimension(np,np) :: tmp real (kind=r8), dimension(np,np) :: tmp2 real (kind=r8), dimension(np,np,2) :: v - + real (kind=r8), dimension(np,np,nlev) :: lap_p_wk real (kind=r8), dimension(np,np,nlevp) :: T_i real (kind=r8) :: nu_ratio1, nu_ratio2, dp_thresh logical var_coef1 - + kblk = kend - kbeg + 1 - + if (use_cslam) dpflux = 0 - !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. if(hypervis_scaling > 0) var_coef1 = .false. @@ -123,10 +121,10 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, kptr = kbeg - 1 call edgeVpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) - kptr = kbeg - 1 + nlev + kptr = kbeg - 1 + nlev call edgeVpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) - kptr = kbeg - 1 + 2*nlev + kptr = kbeg - 1 + 2*nlev call edgeVpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) kptr = kbeg - 1 + 3*nlev @@ -137,7 +135,7 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, do ie=nets,nete !CLEAN rspheremv => elem(ie)%rspheremp(:,:) - + kptr = kbeg - 1 call edgeVunpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) @@ -157,7 +155,7 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, call subcell_Laplace_fluxes(tmp, deriv, elem(ie), np, nc,dpflux(:,:,:,k,ie)) enddo endif - + ! apply inverse mass matrix, then apply laplace again !$omp parallel do num_threads(vert_num_threads) private(k,v,tmp,tmp2) do k=kbeg,kend @@ -198,37 +196,37 @@ subroutine biharmonic_wk_omega(elem,ptens,deriv,edge3,hybrid,nets,nete,kbeg,kend real (kind=r8), dimension(np,np,2) :: v real (kind=r8) :: nu_ratio1, nu_ratio2 logical var_coef1 - + kblk = kend - kbeg + 1 - - !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. if(hypervis_scaling > 0) var_coef1 = .false. - + nu_ratio1=1 nu_ratio2=1 - + do ie=nets,nete - + !$omp parallel do num_threads(vert_num_threads) private(k,tmp) do k=kbeg,kend - tmp=elem(ie)%derived%omega(:,:,k) + tmp=elem(ie)%derived%omega(:,:,k) call laplace_sphere_wk(tmp,deriv,elem(ie),ptens(:,:,k,ie),var_coef=var_coef1) enddo - + kptr = kbeg - 1 call edgeVpack(edge3,ptens(:,:,kbeg:kend,ie),kblk,kptr,ie) enddo - + call bndry_exchange(hybrid,edge3,location='biharmonic_wk_omega') - + do ie=nets,nete rspheremv => elem(ie)%rspheremp(:,:) - + kptr = kbeg - 1 call edgeVunpack(edge3,ptens(:,:,kbeg:kend,ie),kblk,kptr,ie) - + ! apply inverse mass matrix, then apply laplace again !$omp parallel do num_threads(vert_num_threads) private(k,tmp) do k=kbeg,kend @@ -256,14 +254,14 @@ subroutine biharmonic_wk_scalar(elem,qtens,deriv,edgeq,hybrid,nets,nete) ! local integer :: k,kptr,i,j,ie,ic,q -integer :: kbeg,kend,qbeg,qend +integer :: kbeg,kend,qbeg,qend real (kind=r8), dimension(np,np) :: lap_p logical var_coef1 integer :: kblk,qblk ! The per thead size of the vertical and tracers call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) - !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. if(hypervis_scaling > 0) var_coef1 = .false. @@ -273,7 +271,7 @@ subroutine biharmonic_wk_scalar(elem,qtens,deriv,edgeq,hybrid,nets,nete) qblk = qend - qbeg + 1 ! calculate size of the block of tracers do ie=nets,nete - do q=qbeg,qend + do q=qbeg,qend do k=kbeg,kend lap_p(:,:)=qtens(:,:,k,q,ie) call laplace_sphere_wk(lap_p,deriv,elem(ie),qtens(:,:,k,q,ie),var_coef=var_coef1) @@ -285,11 +283,11 @@ subroutine biharmonic_wk_scalar(elem,qtens,deriv,edgeq,hybrid,nets,nete) call bndry_exchange(hybrid,edgeq,location='biharmonic_wk_scalar') - + do ie=nets,nete ! apply inverse mass matrix, then apply laplace again - do q=qbeg,qend + do q=qbeg,qend kptr = nlev*(q-1) + kbeg - 1 call edgeVunpack(edgeq, qtens(:,:,kbeg:kend,q,ie),kblk,kptr,ie) do k=kbeg,kend @@ -305,7 +303,7 @@ end subroutine biharmonic_wk_scalar subroutine make_C0(zeta,elem,hybrid,nets,nete) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! apply DSS (aka assembly procedure) to zeta. +! apply DSS (aka assembly procedure) to zeta. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (hybrid_t) , intent(in) :: hybrid @@ -341,7 +339,7 @@ subroutine make_C0(zeta,elem,hybrid,nets,nete) enddo enddo -call FreeEdgeBuffer(edge1) +call FreeEdgeBuffer(edge1) end subroutine @@ -409,7 +407,7 @@ subroutine make_C0_vector(v,elem,hybrid,nets,nete) enddo enddo -call FreeEdgeBuffer(edge2) +call FreeEdgeBuffer(edge2) #endif end subroutine @@ -420,11 +418,11 @@ subroutine make_C0_vector(v,elem,hybrid,nets,nete) subroutine compute_zeta_C0_contra(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 vorticity. That is, solve: +! compute C0 vorticity. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in contra-variant coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -459,11 +457,11 @@ subroutine compute_zeta_C0_contra(zeta,elem,hybrid,nets,nete,nt) subroutine compute_div_C0_contra(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 divergence. That is, solve: +! compute C0 divergence. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in contra-variant coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -496,11 +494,11 @@ subroutine compute_div_C0_contra(zeta,elem,hybrid,nets,nete,nt) subroutine compute_zeta_C0_par(zeta,elem,par,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 vorticity. That is, solve: +! compute C0 vorticity. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (parallel_t) :: par @@ -523,11 +521,11 @@ subroutine compute_zeta_C0_par(zeta,elem,par,nt) subroutine compute_div_C0_par(zeta,elem,par,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 divergence. That is, solve: +! compute C0 divergence. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -552,11 +550,11 @@ subroutine compute_div_C0_par(zeta,elem,par,nt) subroutine compute_zeta_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 vorticity. That is, solve: +! compute C0 vorticity. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -587,11 +585,11 @@ subroutine compute_zeta_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) subroutine compute_div_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 divergence. That is, solve: +! compute C0 divergence. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -627,22 +625,22 @@ subroutine compute_div_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) subroutine neighbor_minmax(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) - + type (hybrid_t) , intent(in) :: hybrid type (EdgeBuffer_t) , intent(inout) :: edgeMinMax integer :: nets,nete real (kind=r8) :: min_neigh(nlev,qsize,nets:nete) real (kind=r8) :: max_neigh(nlev,qsize,nets:nete) integer :: kblk, qblk - ! local + ! local integer:: ie, q, k, kptr integer:: kbeg, kend, qbeg, qend call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) - + kblk = kend - kbeg + 1 ! calculate size of the block of vertical levels qblk = qend - qbeg + 1 ! calculate size of the block of tracers - + do ie=nets,nete do q = qbeg, qend kptr = nlev*(q - 1) + kbeg - 1 @@ -651,7 +649,7 @@ subroutine neighbor_minmax(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) call edgeSpack(edgeMinMax,max_neigh(kbeg:kend,q,ie),kblk,kptr,ie) enddo enddo - + call bndry_exchange(hybrid,edgeMinMax,location='neighbor_minmax') do ie=nets,nete @@ -667,7 +665,7 @@ subroutine neighbor_minmax(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) enddo end subroutine neighbor_minmax - + subroutine neighbor_minmax_start(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) @@ -679,7 +677,7 @@ subroutine neighbor_minmax_start(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh integer :: kblk, qblk integer :: kbeg, kend, qbeg, qend - ! local + ! local integer :: ie,q, k,kptr call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 5dcffe7347..586ee06b1f 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -46,6 +46,9 @@ module dyn_comp use edge_mod, only: initEdgeBuffer, edgeVpack, edgeVunpack, FreeEdgeBuffer use edgetype_mod, only: EdgeBuffer_t use bndry_mod, only: bndry_exchange +use se_single_column_mod, only: scm_setinitial +use scamMod, only: single_column, readiopdata, use_iop, setiopupdate_init +use hycoef, only: hyai, hybi, ps0 implicit none private @@ -747,8 +750,13 @@ subroutine dyn_init(dyn_in, dyn_out) call set_phis(dyn_in) if (initial_run) then - call read_inidat(dyn_in) - call clean_iodesc_list() + call read_inidat(dyn_in) + if (use_iop .and. masterproc) then + call setiopupdate_init() + call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + call scm_setinitial(dyn_in%elem) + end if + call clean_iodesc_list() end if ! ! initialize diffusion in dycore @@ -990,6 +998,8 @@ subroutine dyn_run(dyn_state) use hybrid_mod, only: config_thread_region, get_loop_ranges use control_mod, only: qsplit, rsplit, ftype_conserve use thread_mod, only: horz_num_threads + use scamMod, only: single_column, use_3dfrc + use se_single_column_mod, only: apply_SC_forcing,ie_scm type(dyn_export_t), intent(inout) :: dyn_state @@ -1008,6 +1018,7 @@ subroutine dyn_run(dyn_state) real(r8), allocatable, dimension(:,:,:) :: ps_before real(r8), allocatable, dimension(:,:,:) :: abs_ps_tend real (kind=r8) :: omega_cn(2,nelemd) !min and max of vertical Courant number + integer :: nets_in,nete_in !---------------------------------------------------------------------------- #ifdef debug_coupling @@ -1019,6 +1030,7 @@ subroutine dyn_run(dyn_state) if (iam >= par%nprocs) return + if (.not. use_3dfrc ) then ldiag = hist_fld_active('ABS_dPSdt') if (ldiag) then allocate(ps_before(np,np,nelemd)) @@ -1125,8 +1137,15 @@ subroutine dyn_run(dyn_state) end if ! forward-in-time RK, with subcycling - call prim_run_subcycle(dyn_state%elem, dyn_state%fvm, hybrid, nets, nete, & - tstep, TimeLevel, hvcoord, n, omega_cn) + if (single_column) then + nets_in=ie_scm + nete_in=ie_scm + else + nets_in=nets + nete_in=nete + end if + call prim_run_subcycle(dyn_state%elem, dyn_state%fvm, hybrid, nets_in, nete_in, & + tstep, TimeLevel, hvcoord, n, single_column, omega_cn) if (ldiag) then do ie = nets, nete @@ -1150,6 +1169,13 @@ subroutine dyn_run(dyn_state) if (ldiag) then deallocate(ps_before,abs_ps_tend) endif + + end if ! not use_3dfrc + + if (single_column) then + call apply_SC_forcing(dyn_state%elem,hvcoord,TimeLevel,3,.false.) + end if + ! output vars on CSLAM fvm grid call write_dyn_vars(dyn_state) @@ -1353,8 +1379,9 @@ subroutine read_inidat(dyn_in) allocate(dbuf3(npsq,nlev,nelemd)) ! Check that columns in IC file match grid definition. - call check_file_layout(fh_ini, elem, dyn_cols, 'ncdata', .true.) - + if (.not. single_column) then + call check_file_layout(fh_ini, elem, dyn_cols, 'ncdata', .true.) + end if ! Read 2-D field fieldname = 'PS' @@ -1874,10 +1901,14 @@ subroutine set_phis(dyn_in) ! Set name of grid object which will be used to read data from file ! into internal data structure via PIO. - if (.not.use_cslam) then - grid_name = 'GLL' + if (single_column) then + grid_name = 'SCM' else - grid_name = 'physgrid_d' + if (fv_nphys == 0) then + grid_name = 'GLL' + else + grid_name = 'physgrid_d' + end if end if ! Get number of global columns from the grid object and check that @@ -1891,7 +1922,7 @@ subroutine set_phis(dyn_in) call endrun(sub//': dimension ncol not found in bnd_topo file') end if ierr = pio_inq_dimlen(fh_topo, ncol_did, ncol_size) - if (ncol_size /= dyn_cols) then + if (ncol_size /= dyn_cols .and. .not. single_column) then if (masterproc) then write(iulog,*) sub//': ncol_size=', ncol_size, ' : dyn_cols=', dyn_cols end if diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index aa3ec8027a..69d9bbc520 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -59,6 +59,7 @@ module dyn_grid integer, parameter :: fvm_decomp = 102 ! The FVM (CSLAM) grid integer, parameter :: physgrid_d = 103 ! physics grid on dynamics decomp integer, parameter :: ini_decomp = 104 ! alternate dynamics grid for reading initial file +integer, parameter :: ini_decomp_scm = 205 ! alternate dynamics grid for reading initial file character(len=3), protected :: ini_grid_name ! Name of horizontal grid dimension in initial file. @@ -732,8 +733,8 @@ subroutine define_cam_grids() use cam_grid_support, only: horiz_coord_t, horiz_coord_create use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register use dimensions_mod, only: nc - use shr_const_mod, only: PI => SHR_CONST_PI - + use shr_const_mod, only: PI => SHR_CONST_PI + use scamMod, only: closeioplon,closeioplat,closeioplonidx,single_column ! Local variables integer :: i, ii, j, k, ie, mapind character(len=8) :: latname, lonname, ncolname, areaname @@ -741,6 +742,7 @@ subroutine define_cam_grids() type(horiz_coord_t), pointer :: lat_coord type(horiz_coord_t), pointer :: lon_coord integer(iMap), pointer :: grid_map(:,:) + integer(iMap), pointer :: grid_map_scm(:,:) !grid_map decomp for single column mode real(r8), allocatable :: pelat_deg(:) ! pe-local latitudes (degrees) real(r8), allocatable :: pelon_deg(:) ! pe-local longitudes (degrees) @@ -748,6 +750,8 @@ subroutine define_cam_grids() real(r8), pointer :: pearea_wt(:) ! pe-local areas normalized for unit sphere integer(iMap) :: fdofP_local(npsq,nelemd) ! pe-local map for dynamics decomp integer(iMap), allocatable :: pemap(:) ! pe-local map for PIO decomp + integer(iMap), allocatable :: pemap_scm(:) ! pe-local map for single column PIO decomp + real(r8) :: latval(1),lonval(1) integer :: ncols_fvm, ngcols_fvm real(r8), allocatable :: fvm_coord(:) @@ -859,7 +863,6 @@ subroutine define_cam_grids() ! If dim name is 'ncol', create INI grid ! We will read from INI grid, but use GLL grid for all output if (trim(ini_grid_hdim_name) == 'ncol') then - lat_coord => horiz_coord_create('lat', 'ncol', ngcols_d, & 'latitude', 'degrees_north', 1, size(pelat_deg), pelat_deg, map=pemap) lon_coord => horiz_coord_create('lon', 'ncol', ngcols_d, & @@ -894,6 +897,42 @@ subroutine define_cam_grids() ! to it. It can be nullified. nullify(grid_map) + !--------------------------------- + ! Create SCM grid object when running single column mode + !--------------------------------- + + if ( single_column) then + allocate(pemap_scm(1)) + pemap_scm = 0_iMap + pemap_scm = closeioplonidx + + ! Map for scm grid + allocate(grid_map_scm(3,npsq)) + grid_map_scm = 0_iMap + mapind = 1 + j = 1 + do i = 1, npsq + grid_map_scm(1, mapind) = i + grid_map_scm(2, mapind) = j + grid_map_scm(3, mapind) = pemap_scm(1) + mapind = mapind + 1 + end do + latval=closeioplat + lonval=closeioplon + + lat_coord => horiz_coord_create('lat', 'ncol', 1, & + 'latitude', 'degrees_north', 1, 1, latval, map=pemap_scm) + lon_coord => horiz_coord_create('lon', 'ncol', 1, & + 'longitude', 'degrees_east', 1, 1, lonval, map=pemap_scm) + + call cam_grid_register('SCM', ini_decomp_scm, lat_coord, lon_coord, & + grid_map_scm, block_indexed=.false., unstruct=.true.) + deallocate(pemap_scm) + ! grid_map cannot be deallocated as the cam_filemap_t object just points + ! to it. It can be nullified. + nullify(grid_map_scm) + end if + !--------------------------------- ! Create FVM grid object for CSLAM !--------------------------------- diff --git a/src/dynamics/se/gravity_waves_sources.F90 b/src/dynamics/se/gravity_waves_sources.F90 index a19733b465..a929dfeaf1 100644 --- a/src/dynamics/se/gravity_waves_sources.F90 +++ b/src/dynamics/se/gravity_waves_sources.F90 @@ -74,7 +74,7 @@ subroutine gws_src_fnct(elem, tl, tlq, frontgf, frontga,nphys) call get_loop_ranges(hybrid,ibeg=nets,iend=nete) allocate(frontgf_thr(nphys,nphys,nlev,nets:nete)) - allocate(frontga_thr(nphys,nphys,nlev,nets:nete)) + allocate(frontga_thr(nphys,nphys,nlev,nets:nete)) call compute_frontogenesis(frontgf_thr,frontga_thr,tl,tlq,elem,deriv,hybrid,nets,nete,nphys) if (fv_nphys>0) then do ie=nets,nete @@ -111,14 +111,14 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! use physconst, only: cappa use air_composition,only: dry_air_species_num, thermodynamic_active_species_num - use air_composition,only: thermodynamic_active_species_idx_dycore + use air_composition,only: thermodynamic_active_species_idx_dycore use derivative_mod, only: gradient_sphere, ugradv_sphere use edge_mod, only: edgevpack, edgevunpack use bndry_mod, only: bndry_exchange use dyn_grid, only: hvcoord use dimensions_mod, only: fv_nphys,ntrac use fvm_mapping, only: dyn2phys_vector,dyn2phys - + type(hybrid_t), intent(in) :: hybrid type(element_t), intent(inout), target :: elem(:) type(derivative_t), intent(in) :: ederiv @@ -157,16 +157,16 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, pint(:,:) = pint(:,:)+elem(ie)%state%dp3d(:,:,k,tl) ! theta(:,:) = elem(ie)%state%T(:,:,k,tl)*(psurf_ref / p(:,:))**cappa - ! gradth(:,:,:,k,ie) = gradient_sphere(theta,ederiv,elem(ie)%Dinv) - call gradient_sphere(theta,ederiv,elem(ie)%Dinv,gradth(:,:,:,k,ie)) + ! gradth(:,:,:,k,ie) = gradient_sphere(theta,ederiv,elem(ie)%Dinv) + call gradient_sphere(theta,ederiv,elem(ie)%Dinv,gradth(:,:,:,k,ie)) ! compute C = (grad(theta) dot grad ) u - C(:,:,:) = ugradv_sphere(gradth(:,:,:,k,ie), elem(ie)%state%v(:,:,:,k,tl),ederiv,elem(ie)) + C(:,:,:) = ugradv_sphere(gradth(:,:,:,k,ie), elem(ie)%state%v(:,:,:,k,tl),ederiv,elem(ie)) ! gradth dot C - frontgf_gll(:,:,k,ie) = -( C(:,:,1)*gradth(:,:,1,k,ie) + C(:,:,2)*gradth(:,:,2,k,ie) ) + frontgf_gll(:,:,k,ie) = -( C(:,:,1)*gradth(:,:,1,k,ie) + C(:,:,2)*gradth(:,:,2,k,ie) ) ! apply mass matrix gradth(:,:,1,k,ie)=gradth(:,:,1,k,ie)*elem(ie)%spheremp(:,:) gradth(:,:,2,k,ie)=gradth(:,:,2,k,ie)*elem(ie)%spheremp(:,:) - frontgf_gll(:,:,k,ie)=frontgf_gll(:,:,k,ie)*elem(ie)%spheremp(:,:) + frontgf_gll(:,:,k,ie)=frontgf_gll(:,:,k,ie)*elem(ie)%spheremp(:,:) enddo ! pack call edgeVpack(edge3, frontgf_gll(:,:,:,ie),nlev,0,ie) @@ -180,7 +180,7 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, do k=1,nlev gradth(:,:,1,k,ie)=gradth(:,:,1,k,ie)*elem(ie)%rspheremp(:,:) gradth(:,:,2,k,ie)=gradth(:,:,2,k,ie)*elem(ie)%rspheremp(:,:) - frontgf_gll(:,:,k,ie)=frontgf_gll(:,:,k,ie)*elem(ie)%rspheremp(:,:) + frontgf_gll(:,:,k,ie)=frontgf_gll(:,:,k,ie)*elem(ie)%rspheremp(:,:) end do if (fv_nphys>0) then uv_tmp(:,:,:) = dyn2phys_vector(gradth(:,:,:,:,ie),elem(ie)) @@ -201,7 +201,7 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, area_inv = 1.0_r8/area_inv do k=1,nlev frontgf(:,:,k,ie) = dyn2phys(frontgf_gll(:,:,k,ie),elem(ie)%metdet,area_inv) - end do + end do else do k=1,nlev frontgf(:,:,k,ie)=frontgf_gll(:,:,k,ie) diff --git a/src/dynamics/se/se_single_column_mod.F90 b/src/dynamics/se/se_single_column_mod.F90 new file mode 100644 index 0000000000..1653b2e43e --- /dev/null +++ b/src/dynamics/se/se_single_column_mod.F90 @@ -0,0 +1,373 @@ +module se_single_column_mod +!-------------------------------------------------------- +! +! Module for the SE single column model + +use shr_kind_mod, only: r8=>shr_kind_r8 +use element_mod, only: element_t +use scamMod, only: have_t, have_q, have_u, have_v, have_ps, have_numliq, & + have_cldliq, have_numice, have_cldice, have_omega, use_camiop, & + tobs, qobs,have_numliq, numliqobs, cldliqobs, numiceobs, cldiceobs, & + wfld, psobs,uobs,vobs,tobs,divt,divQ,divT3d,divq3d,precobs,lhflxobs, & + shflxobs, tground, have_ps, have_tg, have_lhflx, have_shflx, have_t, & + have_omega, have_cldliq, have_divt, have_divq, have_divt3d, have_divq3d, & + use_3dfrc,scmlat,scmlon +use constituents, only: cnst_get_ind, pcnst +use dimensions_mod, only: nelemd, np, nlev, qsize +use time_manager, only: get_nstep, is_first_step, get_step_size, is_first_restart_step +use ppgrid, only: begchunk +use se_dyn_time_mod, only: timelevel_qdp +use cam_history, only: outfld + +implicit none + +private +save + +public scm_setinitial +public scm_setfield +public apply_SC_forcing +public iop_broadcast +public scm_dyn_grid_indicies + +integer, public :: indx_scm, ie_scm, i_scm, j_scm + +integer :: tl_f, tl_fqdp, thelev + +!========================================================================= +contains +!========================================================================= + +subroutine scm_setinitial(elem) + + use dyn_grid, only: TimeLevel + use control_mod, only: qsplit + + implicit none + + type(element_t), intent(inout) :: elem(:) + + integer :: k + integer :: inumliq, inumice, icldliq, icldice + + call scm_dyn_grid_indicies(elem,scmlat,scmlon,ie_scm,i_scm,j_scm,indx_scm) + + tl_f = timelevel%n0 + call TimeLevel_Qdp(timelevel, qsplit, tl_fqdp) + + if (.not. use_camiop .and. get_nstep() == 0) then + call cnst_get_ind('NUMLIQ', inumliq, abort=.false.) + call cnst_get_ind('NUMICE', inumice, abort=.false.) + call cnst_get_ind('CLDLIQ', icldliq) + call cnst_get_ind('CLDICE', icldice) + + ! Find level where tobs is no longer zero + thelev=minloc(abs(tobs), 1, mask=abs(tobs) > 0) + + if (get_nstep() <= 1) then + do k=1,thelev-1 + tobs(k)=elem(ie_scm)%state%T(i_scm,j_scm,k,tl_f) + qobs(k)=elem(ie_scm)%state%qdp(i_scm,j_scm,k,1,tl_fqdp)/elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + enddo + else + tobs(:)=elem(ie_scm)%state%T(i_scm,j_scm,:,tl_f) + qobs(:)=elem(ie_scm)%state%qdp(i_scm,j_scm,:,1,tl_fqdp)/elem(ie_scm)%state%dp3d(i_scm,j_scm,:,tl_f) + endif + + if (get_nstep() == 0) then + do k=thelev, NLEV + if (have_t) elem(ie_scm)%state%T(i_scm,j_scm,k,tl_f)=tobs(k) + if (have_q) elem(ie_scm)%state%qdp(i_scm,j_scm,k,1,tl_fqdp)=qobs(k)*elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + enddo + + do k=1,NLEV + if (have_ps) elem(ie_scm)%state%psdry(i_scm,j_scm) = psobs + if (have_u) elem(ie_scm)%state%v(i_scm,j_scm,1,k,tl_f) = uobs(k) + if (have_v) elem(ie_scm)%state%v(i_scm,j_scm,2,k,tl_f) = vobs(k) + if (have_numliq) elem(ie_scm)%state%qdp(i_scm,j_scm,k,inumliq,tl_fqdp) = & + numliqobs(k)*elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + if (have_cldliq) elem(ie_scm)%state%qdp(i_scm,j_scm,k,icldliq,tl_fqdp) = & + cldliqobs(k)*elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + if (have_numice) elem(ie_scm)%state%qdp(i_scm,j_scm,k,inumice,tl_fqdp) = & + numiceobs(k)*elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + if (have_cldice) elem(ie_scm)%state%qdp(i_scm,j_scm,k,icldice,tl_fqdp) = & + cldiceobs(k)*elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + if (have_omega) elem(ie_scm)%derived%omega(i_scm,j_scm,k) = wfld(k) + enddo + + endif + + endif + +end subroutine scm_setinitial + +subroutine scm_setfield(elem,iop_update_phase1) + +!--------------------------------------------------------- +! Purpose: Update various fields based on available data +! provided by IOP file +!---------------------------------------------------------- + + use control_mod, only: qsplit + use dyn_grid, only: TimeLevel + + implicit none + + logical, intent(in) :: iop_update_phase1 + type(element_t), intent(inout) :: elem(:) + + integer :: k + integer :: tl_f, tl_fqdp + + tl_f = timelevel%n0 + call TimeLevel_Qdp(timelevel, qsplit, tl_fqdp) + + if (have_ps .and. use_camiop .and. .not. iop_update_phase1) elem(ie_scm)%state%psdry(:,:) = psobs + if (have_ps .and. .not. use_camiop) elem(ie_scm)%state%psdry(:,:) = psobs + do k=1, NLEV + if (have_omega .and. iop_update_phase1) elem(ie_scm)%derived%omega(:,:,k)=wfld(k) ! set t to tobs at first + if (k < thelev) then + tobs(k) = elem(ie_scm)%state%T(i_scm,j_scm,k,tl_f) + qobs(k) = elem(ie_scm)%state%qdp(i_scm,j_scm,k,1,tl_fqdp)/elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + uobs(k) = elem(ie_scm)%state%v(i_scm,j_scm,1,k,tl_f) + vobs(k) = elem(ie_scm)%state%v(i_scm,j_scm,2,k,tl_f) + end if + end do + +end subroutine scm_setfield + +subroutine apply_SC_forcing(elem,hvcoord,tl,n,t_before_advance) +! + use scamMod, only: single_column, use_3dfrc + use hybvcoord_mod, only: hvcoord_t + use se_dyn_time_mod,only: TimeLevel_t + use control_mod, only: qsplit + use apply_iop_forcing_mod, only:advance_iop_forcing, advance_iop_nudging + + type (element_t), intent(inout), target :: elem(:) + type (hvcoord_t), intent(in) :: hvcoord + type (TimeLevel_t), intent(in) :: tl + logical, intent(in) :: t_before_advance + integer, intent(in) :: n + + integer :: k, m + real (r8) :: dt + logical :: iop_nudge_tq = .false. + real (r8), dimension(nlev,pcnst) :: stateQ_in, q_update, q_phys_frc + real (r8), dimension(nlev) :: t_phys_frc, t_update, u_update, v_update + real (r8), dimension(nlev) :: t_in, u_in, v_in + real (r8), dimension(nlev) :: relaxt, relaxq + real (r8), dimension(nlev) :: tdiff_dyn, qdiff_dyn + +!----------------------------------------------------------------------- + + tl_f = tl%n0 + + call TimeLevel_Qdp(tl, qsplit, tl_fqdp) + + dt = get_step_size() + + ! Set initial profiles for current column + do m=1,pcnst + stateQ_in(:nlev,m) = elem(ie_scm)%state%Qdp(i_scm,j_scm,:nlev,m,tl_fqdp)/elem(ie_scm)%state%dp3d(i_scm,j_scm,:nlev,tl_f) + end do + t_in(:nlev) = elem(ie_scm)%state%T(i_scm,j_scm,:nlev,tl_f) + u_in(:nlev) = elem(ie_scm)%state%v(i_scm,j_scm,1,:nlev,tl_f) + v_in(:nlev) = elem(ie_scm)%state%v(i_scm,j_scm,2,:nlev,tl_f) + + t_phys_frc(:) = elem(ie_scm)%derived%fT(i_scm,j_scm,:) + q_phys_frc(:,:qsize) = elem(ie_scm)%derived%fQ(i_scm,j_scm,:,:qsize)/dt + + ! Call the main subroutine to update t, q, u, and v according to + ! large scale forcing as specified in IOP file. + call advance_iop_forcing(dt,elem(ie_scm)%state%psdry(i_scm,j_scm),& ! In + u_in,v_in,t_in,stateQ_in,t_phys_frc, q_phys_frc, hvcoord, & ! In + u_update,v_update,t_update,q_update) ! Out + + ! Nudge to observations if desired, for T & Q only if in SCM mode + if (iop_nudge_tq ) then + call advance_iop_nudging(dt,elem(ie_scm)%state%psdry(i_scm,j_scm),& ! In + t_update,q_update,u_update,v_update, hvcoord, & ! Inout + relaxt,relaxq) ! Out + endif + + if (use_3dfrc) then ! vertical remap of dynamics not run need to update state%dp3d using new psdry + do k=1,nlev + elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) = (hvcoord%hyai(k+1)-hvcoord%hyai(k))*hvcoord%ps0 + & + (hvcoord%hybi(k+1)-hvcoord%hybi(k))*elem(ie_scm)%state%psdry(i_scm,j_scm) + end do + end if + + ! Update qdp using new dp3d + do m=1,pcnst + ! Update the Qdp array + elem(ie_scm)%state%Qdp(i_scm,j_scm,:nlev,m,tl_fqdp) = & + q_update(:nlev,m) * elem(ie_scm)%state%dp3d(i_scm,j_scm,:nlev,tl_f) + enddo + + ! Update prognostic variables to the current values + elem(ie_scm)%state%T(i_scm,j_scm,:,tl_f) = t_update(:) + elem(ie_scm)%state%v(i_scm,j_scm,1,:,tl_f) = u_update(:) + elem(ie_scm)%state%v(i_scm,j_scm,2,:,tl_f) = v_update(:) + + ! Evaluate the differences in state information from observed + ! (done for diganostic purposes only) + do k = 1, nlev + tdiff_dyn(k) = t_update(k) - tobs(k) + qdiff_dyn(k) = q_update(k,1) - qobs(k) + end do + + ! Add various diganostic outfld calls + call outfld('TDIFF',tdiff_dyn,1,begchunk) + call outfld('QDIFF',qdiff_dyn,1,begchunk) + call outfld('TOBS',tobs,1,begchunk) + call outfld('QOBS',qobs,1,begchunk) + call outfld('DIVQ',divq,1,begchunk) + call outfld('DIVT',divt,1,begchunk) + call outfld('DIVQ3D',divq3d,1,begchunk) + call outfld('DIVT3D',divt3d,1,begchunk) + call outfld('PRECOBS',precobs,1,begchunk) + call outfld('LHFLXOBS',lhflxobs,1,begchunk) + call outfld('SHFLXOBS',shflxobs,1,begchunk) + + call outfld('TRELAX',relaxt,1,begchunk) + call outfld('QRELAX',relaxq,1,begchunk) + + + end subroutine apply_SC_forcing +!========================================================================= + subroutine iop_broadcast() + + !--------------------------------------------------------- + ! Purpose: Broadcast relevant logical + ! flags and data to all processors + !---------------------------------------------------------- + + use spmd_utils, only: mpi_logical, mpi_real8, masterproc, iam, mpicom, mstrid=>masterprocid + use cam_abortutils, only: endrun + + integer :: ierr + character(len=*), parameter :: sub = 'radiation_readnl' + +#ifdef SPMD + call mpi_bcast(have_ps,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_ps") + call mpi_bcast(have_tg,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_tg") + call mpi_bcast(have_lhflx,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_lhflx") + call mpi_bcast(have_shflx,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_shflx") + call mpi_bcast(have_t,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_t") + call mpi_bcast(have_q,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_q") + call mpi_bcast(have_u,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_u") + call mpi_bcast(have_v,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_v") + call mpi_bcast(have_omega,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_omega") + call mpi_bcast(have_cldliq,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_cldliq") + call mpi_bcast(have_divt,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_divt") + call mpi_bcast(have_divq,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_divq") + call mpi_bcast(have_divt3d,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_divt3d") + call mpi_bcast(have_divq3d,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_divq3d") + call mpi_bcast(use_3dfrc,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_3dfrc") + + call mpi_bcast(psobs,1,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: psobs") + call mpi_bcast(tground,1,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: tground") + call mpi_bcast(lhflxobs,1,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: lhflxobs") + call mpi_bcast(shflxobs,1,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: shflxobs") + + call mpi_bcast(tobs,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: tobs") + call mpi_bcast(qobs,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: qobs") + call mpi_bcast(uobs,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: uobs") + call mpi_bcast(vobs,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: vobs") + call mpi_bcast(cldliqobs,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: cldliqobs") + call mpi_bcast(wfld,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: wfld") + + call mpi_bcast(divt,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: divt") + call mpi_bcast(divq,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: divq") + call mpi_bcast(divt3d,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: divt3d") + call mpi_bcast(divq3d,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: divq3d") + +#endif + + end subroutine iop_broadcast + +!========================================================================= + subroutine scm_dyn_grid_indicies(elem,scmlat,scmlon,ie_scm,i_scm,j_scm,indx_scm) + + !--------------------------------------------------------- + ! Purpose: Determine closest column index in the IOP file + ! based on the input scm latitude and longitude + !---------------------------------------------------------- + + use shr_const_mod, only: SHR_CONST_PI + use cam_abortutils, only: endrun + + type(element_t), intent(in) :: elem(:) + real (r8), intent(in) :: scmlat,scmlon + integer, intent(out) :: ie_scm, j_scm, i_scm, indx_scm + + integer :: i, j, indx, ie + real(r8) :: scmposlon, minpoint, testlat, testlon, testval + integer :: ierr + real(r8), parameter :: rad2deg = 180.0_r8 / SHR_CONST_PI + character(len=*), parameter :: sub = 'scm_dyn_grid_indicies' + + ie_scm=0 + i_scm=0 + j_scm=0 + indx_scm=0 + minpoint = 1000 + scmposlon = mod(scmlon + 360._r8,360._r8) + do ie=1, nelemd + indx=1 + do j=1, np + do i=1, np + testlat=elem(ie)%spherep(i,j)%lat * rad2deg + testlon=elem(ie)%spherep(i,j)%lon * rad2deg + if (testlon < 0._r8) testlon=testlon+360._r8 + testval=abs(scmlat-testlat)+abs(scmposlon-testlon) + if (testval < minpoint) then + ie_scm=ie + indx_scm=indx + i_scm=i + j_scm=j + minpoint=testval + if (minpoint < 1.e-7_r8) minpoint=0._r8 + endif + indx=indx+1 + enddo + enddo + enddo + + if (ie_scm == 0 .or. i_scm == 0 .or. j_scm == 0 .or. indx_scm == 0) then + call endrun(sub//':FATAL: Could not find closest SCM point on input datafile') + endif + + end subroutine scm_dyn_grid_indicies + + end module se_single_column_mod diff --git a/src/dynamics/se/stepon.F90 b/src/dynamics/se/stepon.F90 index 82f6ec03e2..2d49a434cc 100644 --- a/src/dynamics/se/stepon.F90 +++ b/src/dynamics/se/stepon.F90 @@ -1,7 +1,7 @@ module stepon use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: iam, mpicom +use spmd_utils, only: iam, mpicom, masterproc use ppgrid, only: begchunk, endchunk use physics_types, only: physics_state, physics_tend @@ -11,11 +11,18 @@ module stepon use cam_abortutils, only: endrun use parallel_mod, only: par -use dimensions_mod, only: nelemd +use dimensions_mod, only: np, npsq, nlev, nelemd use aerosol_properties_mod, only: aerosol_properties use aerosol_state_mod, only: aerosol_state use microp_aero, only: aerosol_state_object, aerosol_properties_object +use scamMod, only: use_iop, doiopupdate, single_column, & + setiopupdate, readiopdata +use se_single_column_mod, only: scm_setfield, iop_broadcast +use dyn_grid, only: hvcoord +use time_manager, only: get_step_size, is_first_restart_step +use cam_history, only: outfld, write_camiop, addfld, add_default, horiz_only +use cam_history, only: write_inithist, hist_fld_active, fieldname_len implicit none private @@ -29,6 +36,7 @@ module stepon class(aerosol_properties), pointer :: aero_props_obj => null() logical :: aerosols_transported = .false. +logical :: iop_update_phase1 !========================================================================================= contains @@ -36,7 +44,6 @@ module stepon subroutine stepon_init(dyn_in, dyn_out ) - use cam_history, only: addfld, add_default, horiz_only use constituents, only: pcnst, cnst_name, cnst_longname use dimensions_mod, only: fv_nphys, cnst_name_gll, cnst_longname_gll, qsize @@ -95,7 +102,6 @@ end subroutine stepon_init subroutine stepon_run1( dtime_out, phys_state, phys_tend, & pbuf2d, dyn_in, dyn_out ) - use time_manager, only: get_step_size use dp_coupling, only: d_p_coupling use physics_buffer, only: physics_buffer_desc @@ -123,6 +129,31 @@ subroutine stepon_run1( dtime_out, phys_state, phys_tend, & call diag_dynvar_ic(dyn_out%elem, dyn_out%fvm) end if + ! Determine whether it is time for an IOP update; + ! doiopupdate set to true if model time step > next available IOP + + + if (use_iop .and. masterproc) then + call setiopupdate + end if + + if (single_column) then + + ! If first restart step then ensure that IOP data is read + if (is_first_restart_step()) then + if (masterproc) call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + call iop_broadcast() + endif + + iop_update_phase1 = .true. + if ((is_first_restart_step() .or. doiopupdate) .and. masterproc) then + call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + endif + call iop_broadcast() + + call scm_setfield(dyn_out%elem,iop_update_phase1) + endif + call t_barrierf('sync_d_p_coupling', mpicom) call t_startf('d_p_coupling') ! Move data into phys_state structure. @@ -205,10 +236,12 @@ subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out) use camsrfexch, only: cam_out_t use dyn_comp, only: dyn_run - use advect_tend, only: compute_adv_tends_xyz + use advect_tend, only: compute_adv_tends_xyz, compute_write_iop_fields use dyn_grid, only: TimeLevel use se_dyn_time_mod,only: TimeLevel_Qdp use control_mod, only: qsplit + use constituents, only: pcnst, cnst_name + ! arguments real(r8), intent(in) :: dtime ! Time-step type(cam_out_t), intent(inout) :: cam_out(:) ! Output from CAM to surface @@ -219,10 +252,21 @@ subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out) integer :: tl_f, tl_fQdp !-------------------------------------------------------------------------------------- + if (single_column) then + ! Update IOP properties e.g. omega, divT, divQ + iop_update_phase1 = .false. + if (doiopupdate) then + if (masterproc) call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + call iop_broadcast() + call scm_setfield(dyn_out%elem,iop_update_phase1) + endif + endif + call t_startf('comp_adv_tends1') tl_f = TimeLevel%n0 call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp) call compute_adv_tends_xyz(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) + if (write_camiop) call compute_write_iop_fields(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) call t_stopf('comp_adv_tends1') call t_barrierf('sync_dyn_run', mpicom) @@ -234,6 +278,7 @@ subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out) tl_f = TimeLevel%n0 call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp) call compute_adv_tends_xyz(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) + if (write_camiop) call compute_write_iop_fields(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) call t_stopf('comp_adv_tends2') end subroutine stepon_run3 @@ -251,7 +296,6 @@ end subroutine stepon_final subroutine diag_dynvar_ic(elem, fvm) use constituents, only: cnst_type - use cam_history, only: write_inithist, outfld, hist_fld_active, fieldname_len use dyn_grid, only: TimeLevel use se_dyn_time_mod, only: TimeLevel_Qdp ! dynamics typestep diff --git a/src/infrastructure/phys_grid.F90 b/src/infrastructure/phys_grid.F90 index 3426c86f27..8da2f0b461 100644 --- a/src/infrastructure/phys_grid.F90 +++ b/src/infrastructure/phys_grid.F90 @@ -21,7 +21,7 @@ module phys_grid ! !------------------------------------------------------------------------------ use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: begchunk, endchunk + use ppgrid, only: begchunk, endchunk, pver, pverp, pcols use physics_column_type, only: physics_column_t use perf_mod, only: t_adj_detailf, t_startf, t_stopf @@ -63,6 +63,7 @@ module phys_grid ! The identifier for the physics grid integer, parameter, public :: phys_decomp = 100 + integer, parameter, public :: phys_decomp_scm = 200 !! PUBLIC TYPES @@ -110,15 +111,13 @@ module phys_grid end interface get_lon_all_p !!XXgoldyXX: ^ temporary interface to allow old code to compile - - integer, protected, public :: pver = 0 - integer, protected, public :: pverp = 0 integer, protected, public :: num_global_phys_cols = 0 integer, protected, public :: columns_on_task = 0 integer, protected, public :: index_top_layer = 0 integer, protected, public :: index_bottom_layer = 0 integer, protected, public :: index_top_interface = 1 integer, protected, public :: index_bottom_interface = 0 + integer, public :: phys_columns_on_task = 0 !============================================================================== CONTAINS @@ -130,7 +129,6 @@ subroutine phys_grid_readnl(nlfile) use cam_logfile, only: iulog use spmd_utils, only: mpicom, mstrid=>masterprocid, masterproc use spmd_utils, only: mpi_integer - use ppgrid, only: pcols character(len=*), intent(in) :: nlfile @@ -184,13 +182,13 @@ subroutine phys_grid_init() use cam_abortutils, only: endrun use cam_logfile, only: iulog use spmd_utils, only: npes, mpicom, masterprocid, masterproc, iam - use ppgrid, only: pcols use dyn_grid, only: get_dyn_grid_info, physgrid_copy_attributes_d use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register use cam_grid_support, only: iMap, hclen => max_hcoordname_len use cam_grid_support, only: horiz_coord_t, horiz_coord_create use cam_grid_support, only: cam_grid_attribute_copy, cam_grid_attr_exists use shr_const_mod, only: PI => SHR_CONST_PI + use scamMod, only: scmlon,scmlat,single_column,closeioplatidx,closeioplonidx ! Local variables integer :: index @@ -203,6 +201,7 @@ subroutine phys_grid_init() real(r8), pointer :: latvals(:) real(r8) :: lonmin, latmin integer(iMap), pointer :: grid_map(:,:) + integer(iMap), pointer :: grid_map_scm(:,:) integer(iMap), allocatable :: coord_map(:) type(horiz_coord_t), pointer :: lat_coord type(horiz_coord_t), pointer :: lon_coord @@ -217,10 +216,14 @@ subroutine phys_grid_init() character(len=hclen) :: copy_gridname character(len=*), parameter :: subname = 'phys_grid_init: ' real(r8), parameter :: rarea_sphere = 1.0_r8 / (4.0_r8*PI) + real (r8), allocatable :: dynlats(:),dynlons(:),pos_dynlons(:) + real (r8) :: pos_scmlon,minpoint,testpoint + integer :: scm_col_index, i, num_lev nullify(lonvals) nullify(latvals) nullify(grid_map) + if (single_column) nullify(grid_map_scm) nullify(lat_coord) nullify(lon_coord) nullify(area_d) @@ -235,11 +238,39 @@ subroutine phys_grid_init() call t_startf("phys_grid_init") ! Gather info from the dycore - call get_dyn_grid_info(hdim1_d, hdim2_d, pver, index_top_layer, & + call get_dyn_grid_info(hdim1_d, hdim2_d, num_lev, index_top_layer, & index_bottom_layer, unstructured, dyn_columns) + + ! Set up the physics decomposition + columns_on_task = size(dyn_columns) + + if (single_column) then + allocate(dynlats(columns_on_task),dynlons(columns_on_task),pos_dynlons(columns_on_task)) + dynlats(:) = dyn_columns(:)%lat_deg + dynlons(:) = dyn_columns(:)%lon_deg + + pos_dynlons(:)= mod(dynlons(:) + 360._r8,360._r8) + pos_scmlon = mod(scmlon + 360._r8,360._r8) + + if (unstructured) then + minpoint=1000.0_r8 + do i=1,columns_on_task + testpoint=abs(pos_dynlons(i)-pos_scmlon)+abs(dynlats(i)-scmlat) + if (testpoint < minpoint) then + minpoint=testpoint + scm_col_index=i + endif + enddo + end if + hdim1_d = 1 + hdim2_d = 1 + phys_columns_on_task = 1 + deallocate(dynlats,dynlons,pos_dynlons) + else + phys_columns_on_task = columns_on_task + end if ! hdim1_d * hdim2_d is the total number of columns num_global_phys_cols = hdim1_d * hdim2_d - pverp = pver + 1 !!XXgoldyXX: Can we enforce interface numbering separate from dycore? !!XXgoldyXX: This will work for both CAM and WRF/MPAS physics !!XXgoldyXX: This only has a 50% chance of working on a single level model @@ -251,14 +282,12 @@ subroutine phys_grid_init() index_top_interface = index_top_layer + 1 end if - ! Set up the physics decomposition - columns_on_task = size(dyn_columns) if (allocated(phys_columns)) then deallocate(phys_columns) end if - allocate(phys_columns(columns_on_task)) - if (columns_on_task > 0) then - col_index = columns_on_task + allocate(phys_columns(phys_columns_on_task)) + if (phys_columns_on_task > 0) then + col_index = phys_columns_on_task num_chunks = col_index / pcols if ((num_chunks * pcols) < col_index) then num_chunks = num_chunks + 1 @@ -273,13 +302,20 @@ subroutine phys_grid_init() col_index = 0 ! Simple chunk assignment do index = begchunk, endchunk - chunks(index)%ncols = MIN(pcols, (columns_on_task - col_index)) + chunks(index)%ncols = MIN(pcols, (phys_columns_on_task - col_index)) chunks(index)%chunk_index = index allocate(chunks(index)%phys_cols(chunks(index)%ncols)) do phys_col = 1, chunks(index)%ncols col_index = col_index + 1 ! Copy information supplied by the dycore - phys_columns(col_index) = dyn_columns(col_index) + if (single_column) then + phys_columns(col_index) = dyn_columns(scm_col_index) +! !scm physics only has 1 global column + phys_columns(col_index)%global_col_num = 1 + phys_columns(col_index)%coord_indices(:)=scm_col_index + else + phys_columns(col_index) = dyn_columns(col_index) + end if ! Fill in physics decomp info phys_columns(col_index)%phys_task = iam phys_columns(col_index)%local_phys_chunk = index @@ -299,10 +335,13 @@ subroutine phys_grid_init() ! unstructured if (unstructured) then allocate(grid_map(3, pcols * (endchunk - begchunk + 1))) + if (single_column) allocate(grid_map_scm(3, pcols * (endchunk - begchunk + 1))) else allocate(grid_map(4, pcols * (endchunk - begchunk + 1))) + if (single_column) allocate(grid_map_scm(4, pcols * (endchunk - begchunk + 1))) end if grid_map = 0_iMap + if (single_column) grid_map_scm = 0_iMap allocate(latvals(size(grid_map, 2))) allocate(lonvals(size(grid_map, 2))) @@ -330,22 +369,29 @@ subroutine phys_grid_init() end if grid_map(1, index) = int(icol, iMap) grid_map(2, index) = int(ichnk, iMap) + if (single_column) then + grid_map_scm(1, index) = int(icol, iMap) + grid_map_scm(2, index) = int(ichnk, iMap) + end if if (icol <= ncol) then if (unstructured) then gcol = phys_columns(col_index)%global_col_num if (gcol > 0) then - grid_map(3, index) = int(gcol, iMap) + grid_map(3, index) = int(gcol, iMap) + if (single_column) grid_map_scm(3, index) = closeioplonidx end if ! else entry remains 0 else ! lon gcol = phys_columns(col_index)%coord_indices(1) if (gcol > 0) then grid_map(3, index) = int(gcol, iMap) + if (single_column) grid_map_scm(3, index) = closeioplonidx end if ! else entry remains 0 ! lat gcol = phys_columns(col_index)%coord_indices(2) if (gcol > 0) then grid_map(4, index) = gcol + if (single_column) grid_map_scm(4, index) = closeioplatidx end if ! else entry remains 0 end if end if ! Else entry remains 0 @@ -398,6 +444,8 @@ subroutine phys_grid_init() end if call cam_grid_register('physgrid', phys_decomp, lat_coord, lon_coord, & grid_map, unstruct=unstructured, block_indexed=.true.) + if (single_column) call cam_grid_register('physgrid_scm', phys_decomp_scm, lat_coord, lon_coord, & + grid_map_scm, unstruct=unstructured, block_indexed=.true.) ! Copy required attributes from the dynamics array nullify(copy_attributes) call physgrid_copy_attributes_d(copy_gridname, copy_attributes) @@ -414,7 +462,7 @@ subroutine phys_grid_init() ! (Note, a separate physics grid is only supported for ! unstructured grids). allocate(area_d(size(grid_map, 2))) - do col_index = 1, columns_on_task + do col_index = 1, phys_columns_on_task area_d(col_index) = phys_columns(col_index)%area end do call cam_grid_attribute_register('physgrid', 'area', & @@ -422,7 +470,7 @@ subroutine phys_grid_init() nullify(area_d) ! Belongs to attribute now allocate(areawt_d(size(grid_map, 2))) - do col_index = 1, columns_on_task + do col_index = 1, phys_columns_on_task areawt_d(col_index) = phys_columns(col_index)%weight*rarea_sphere end do call cam_grid_attribute_register('physgrid', 'areawt', & @@ -433,16 +481,17 @@ subroutine phys_grid_init() end if end if ! Cleanup pointers (they belong to the grid now) - nullify(grid_map) - deallocate(latvals) - nullify(latvals) - deallocate(lonvals) - nullify(lonvals) ! Cleanup, we are responsible for copy attributes if (associated(copy_attributes)) then deallocate(copy_attributes) nullify(copy_attributes) end if + nullify(grid_map) + if (single_column) nullify(grid_map_scm) + deallocate(latvals) + nullify(latvals) + deallocate(lonvals) + nullify(lonvals) ! Set flag indicating physics grid is now set phys_grid_set = .true. @@ -526,7 +575,7 @@ end function phys_grid_initialized !======================================================================== integer function get_nlcols_p() - get_nlcols_p = columns_on_task + get_nlcols_p = phys_columns_on_task end function get_nlcols_p !======================================================================== @@ -1106,7 +1155,6 @@ end subroutine dump_grid_map subroutine scatter_field_to_chunk(fdim,mdim,ldim, & hdim1d,globalfield,localchunks) use cam_abortutils, only: endrun - use ppgrid, only: pcols !----------------------------------------------------------------------- ! ! Purpose: DUMMY FOR WEAK SCALING TESTS diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 9c16325357..2886c44222 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -12,7 +12,7 @@ module cam_diagnostics use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dtype_r8 use physics_buffer, only: dyn_time_lvls, pbuf_get_field, pbuf_get_index, pbuf_old_tim_idx -use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all +use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all, write_camiop use cam_history_support, only: max_fieldname_len use constituents, only: pcnst, cnst_name, cnst_longname, cnst_cam_outfld use constituents, only: ptendnam, apcnst, bpcnst, cnst_get_ind @@ -221,7 +221,7 @@ subroutine diag_init_dry(pbuf2d) call register_vector_field('UAP','VAP') call addfld (apcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (after physics)') - if (.not.dycore_is('EUL')) then + if (.not.dycore_is('EUL')) then call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)') end if call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency') @@ -365,7 +365,7 @@ subroutine diag_init_dry(pbuf2d) call add_default ('UAP ' , history_budget_histfile_num, ' ') call add_default ('VAP ' , history_budget_histfile_num, ' ') call add_default (apcnst(1) , history_budget_histfile_num, ' ') - if (.not.dycore_is('EUL')) then + if (.not.dycore_is('EUL')) then call add_default ('TFIX ' , history_budget_histfile_num, ' ') end if end if @@ -942,9 +942,7 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) call outfld('PHIS ',state%phis, pcols, lchnk ) -#if (defined BFB_CAM_SCAM_IOP ) - call outfld('phis ',state%phis, pcols, lchnk ) -#endif + if (write_camiop) call outfld('phis ',state%phis, pcols, lchnk ) call outfld( 'CPAIRV', cpairv(:ncol,:,lchnk), ncol, lchnk ) call outfld( 'RAIRV', rairv(:ncol,:,lchnk), ncol, lchnk ) @@ -1035,9 +1033,7 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) call outfld('OMEGA ',state%omega, pcols, lchnk ) endif -#if (defined BFB_CAM_SCAM_IOP ) - call outfld('omega ',state%omega, pcols, lchnk ) -#endif + if (write_camiop) call outfld('omega ',state%omega, pcols, lchnk ) ftem(:ncol,:) = state%omega(:ncol,:)*state%t(:ncol,:) call outfld('OMEGAT ',ftem, pcols, lchnk ) @@ -1699,9 +1695,7 @@ subroutine diag_conv(state, ztodt, pbuf) call outfld('PRECLav ', precl, pcols, lchnk ) call outfld('PRECCav ', precc, pcols, lchnk ) -#if ( defined BFB_CAM_SCAM_IOP ) - call outfld('Prec ' , prect, pcols, lchnk ) -#endif + if (write_camiop) call outfld('Prec ' , prect, pcols, lchnk ) ! Total convection tendencies. @@ -1799,11 +1793,13 @@ subroutine diag_surf (cam_in, cam_out, state, pbuf) call outfld('RHREFHT', ftem, pcols, lchnk) -#if (defined BFB_CAM_SCAM_IOP ) - call outfld('shflx ',cam_in%shf, pcols, lchnk) - call outfld('lhflx ',cam_in%lhf, pcols, lchnk) - call outfld('trefht ',cam_in%tref, pcols, lchnk) -#endif + if (write_camiop) then + call outfld('shflx ',cam_in%shf, pcols, lchnk) + call outfld('lhflx ',cam_in%lhf, pcols, lchnk) + call outfld('trefht ',cam_in%tref, pcols, lchnk) + call outfld('Tg', cam_in%ts, pcols, lchnk) + call outfld('Tsair',cam_in%ts, pcols, lchnk) + end if ! ! Ouput ocn and ice fractions ! @@ -2060,7 +2056,7 @@ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) ! Total physics tendency for Temperature ! (remove global fixer tendency from total for FV and SE dycores) - if (.not.dycore_is('EUL')) then + if (.not.dycore_is('EUL')) then call check_energy_get_integrals( heat_glob_out=heat_glob ) ftem2(:ncol) = heat_glob/cpair call outfld('TFIX', ftem2, pcols, lchnk ) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 1410a52a2f..290d0022de 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -31,6 +31,8 @@ module check_energy use constituents, only: cnst_get_ind, pcnst, cnst_name, cnst_get_type_byind use time_manager, only: is_first_step use cam_logfile, only: iulog + use scamMod, only: single_column, use_camiop, heat_glob_scm + use cam_history, only: outfld, write_camiop implicit none private @@ -510,6 +512,7 @@ subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk use physics_types, only: dyn_te_idx + use cam_history, only: write_camiop !----------------------------------------------------------------------- ! Compute global mean total energy of physics input and output states ! computed consistently with dynamical core vertical coordinate @@ -588,8 +591,11 @@ subroutine check_energy_fix(state, ptend, nstep, eshflx) !---------------------------Local storage------------------------------- integer :: i ! column integer :: ncol ! number of atmospheric columns in chunk + integer :: lchnk ! chunk number + real(r8) :: heat_out(pcols) !----------------------------------------------------------------------- - ncol = state%ncol + lchnk = state%lchnk + ncol = state%ncol call physics_ptend_init(ptend, state%psetcols, 'chkenergyfix', ls=.true.) @@ -597,9 +603,22 @@ subroutine check_energy_fix(state, ptend, nstep, eshflx) ! disable the energy fix for offline driver heat_glob = 0._r8 #endif -! add (-) global mean total energy difference as heating + + ! Special handling of energy fix for SCAM - supplied via CAMIOP - zero's for normal IOPs + if (single_column) then + if ( use_camiop) then + heat_glob = heat_glob_scm(1) + else + heat_glob = 0._r8 + endif + endif ptend%s(:ncol,:pver) = heat_glob + if (nstep > 0 .and. write_camiop) then + heat_out(:ncol) = heat_glob + call outfld('heat_glob', heat_out(:ncol), pcols, lchnk) + endif + ! compute effective sensible heat flux do i = 1, ncol eshflx(i) = heat_glob * (state%pint(i,pver+1) - state%pint(i,1)) * rga @@ -943,10 +962,10 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) ! - + mr_cnst = rga*rearth**3 mo_cnst = rga*omega*rearth**4 - + mr = 0.0_r8 mo = 0.0_r8 do k = 1, pver @@ -954,12 +973,12 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) cos_lat = cos(state%lat(i)) mr_tmp = mr_cnst*state%u(i,k)*state%pdel(i,k)*cos_lat mo_tmp = mo_cnst*state%pdel(i,k)*cos_lat**2 - + mr(i) = mr(i) + mr_tmp mo(i) = mo(i) + mo_tmp end do end do - + call outfld(name_out(mridx) ,mr, pcols,lchnk ) call outfld(name_out(moidx) ,mo, pcols,lchnk ) diff --git a/src/physics/cam/chem_surfvals.F90 b/src/physics/cam/chem_surfvals.F90 index 812ddc8fcd..84af83b71a 100644 --- a/src/physics/cam/chem_surfvals.F90 +++ b/src/physics/cam/chem_surfvals.F90 @@ -512,6 +512,7 @@ subroutine chem_surfvals_set() use ppgrid, only: begchunk, endchunk use mo_flbc, only: flbc_gmean_vmr, flbc_chk + use scamMod, only: single_column, scmiop_flbc_inti, use_camiop !---------------------------Local variables----------------------------- @@ -527,7 +528,12 @@ subroutine chem_surfvals_set() elseif (scenario_ghg == 'CHEM_LBC_FILE') then ! set mixing ratios from cam-chem/waccm lbc file call flbc_chk() - call flbc_gmean_vmr(co2vmr,ch4vmr,n2ovmr,f11vmr,f12vmr) + if (single_column .and. use_camiop) then + call scmiop_flbc_inti( co2vmr, ch4vmr, n2ovmr, f11vmr, f12vmr ) + else + ! set by lower boundary conditions file + call flbc_gmean_vmr(co2vmr,ch4vmr,n2ovmr,f11vmr,f12vmr) + endif endif if (masterproc .and. is_end_curr_day()) then diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 06d70a98da..061e24fdcd 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -39,6 +39,7 @@ module clubb_intr use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag use cloud_fraction, only: dp1, dp2 #endif + use scamMOD, only: single_column,scm_clubb_iop_name,scm_cambfb_mode implicit none @@ -2113,7 +2114,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef CLUBB_SGS use hb_diff, only: pblintd - use scamMOD, only: single_column,scm_clubb_iop_name use clubb_api_module, only: & nparams, & setup_parameters_api, & @@ -2778,16 +2778,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Define the grid box size. CLUBB needs this information to determine what ! the maximum length scale should be. This depends on the column for ! variable mesh grids and lat-lon grids - if (single_column) then - ! If single column specify grid box size to be something - ! similar to a GCM run - grid_dx(:) = 100000._r8 - grid_dy(:) = 100000._r8 - else - - call grid_size(state1, grid_dx, grid_dy) - end if + call grid_size(state1, grid_dx, grid_dy) if (clubb_do_icesuper) then @@ -3086,7 +3078,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! This section of code block is NOT called in ! ! global simulations ! ! ------------------------------------------------- ! - if (single_column) then + if (single_column .and. .not. scm_cambfb_mode) then ! Initialize zo if variable ustar is used if (cam_in%landfrac(1) >= 0.5_r8) then @@ -4327,7 +4319,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo - if (single_column) then + if (single_column .and. .not. scm_cambfb_mode) then if (trim(scm_clubb_iop_name) == 'ATEX_48hr' .or. & trim(scm_clubb_iop_name) == 'BOMEX_5day' .or. & trim(scm_clubb_iop_name) == 'DYCOMSrf01_4day' .or. & diff --git a/src/physics/cam/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 index ffd1db8f5f..daed093b67 100644 --- a/src/physics/cam/convect_shallow.F90 +++ b/src/physics/cam/convect_shallow.F90 @@ -215,6 +215,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) call addfld( 'CMFMC', (/ 'ilev' /), 'A', 'kg/m2/s', 'Moist convection (deep+shallow) mass flux' ) call addfld( 'CMFSL', (/ 'ilev' /), 'A', 'W/m2', 'Moist shallow convection liquid water static energy flux' ) call addfld( 'CMFLQ', (/ 'ilev' /), 'A', 'W/m2', 'Moist shallow convection total water flux' ) + call addfld ('DQP', (/ 'lev' /), 'A', 'kg/kg/s', 'Specific humidity tendency due to precipitation' ) call addfld( 'CBMF', horiz_only, 'A', 'kg/m2/s', 'Cloud base mass flux' ) call addfld( 'CLDTOP', horiz_only, 'I', '1', 'Vertical index of cloud top' ) call addfld( 'CLDBOT', horiz_only, 'I', '1', 'Vertical index of cloud base' ) diff --git a/src/physics/cam/phys_grid.F90 b/src/physics/cam/phys_grid.F90 index ca1670e4c2..e87726469f 100644 --- a/src/physics/cam/phys_grid.F90 +++ b/src/physics/cam/phys_grid.F90 @@ -111,6 +111,7 @@ module phys_grid ! The identifier for the physics grid integer, parameter, public :: phys_decomp = 100 + integer, parameter, public :: phys_decomp_scm = 200 ! dynamics field grid information integer, private :: hdim1_d, hdim2_d @@ -451,6 +452,8 @@ subroutine phys_grid_init( ) !----------------------------------------------------------------------- use mpi, only: MPI_REAL8, MPI_MAX use shr_mem_mod, only: shr_mem_getusage + use shr_scam_mod, only: shr_scam_GetCloseLatLon + use scamMod, only: closeioplonidx, closeioplatidx, single_column use pmgrid, only: plev use dycore, only: dycore_is use dyn_grid, only: get_block_bounds_d, & @@ -525,6 +528,7 @@ subroutine phys_grid_init( ) real(r8), allocatable :: latdeg_p(:) real(r8), allocatable :: londeg_p(:) integer(iMap), pointer :: grid_map(:,:) + integer(iMap), pointer :: grid_map_scm(:,:) integer(iMap), allocatable :: coord_map(:) type(horiz_coord_t), pointer :: lat_coord type(horiz_coord_t), pointer :: lon_coord @@ -540,6 +544,7 @@ subroutine phys_grid_init( ) nullify(lonvals) nullify(latvals) nullify(grid_map) + if (single_column) nullify(grid_map_scm) nullify(lat_coord) nullify(lon_coord) @@ -1105,10 +1110,13 @@ subroutine phys_grid_init( ) unstructured = dycore_is('UNSTRUCTURED') if (unstructured) then allocate(grid_map(3, pcols * (endchunk - begchunk + 1))) + if (single_column) allocate(grid_map_scm(3, pcols * (endchunk - begchunk + 1))) else allocate(grid_map(4, pcols * (endchunk - begchunk + 1))) + if (single_column) allocate(grid_map_scm(4, pcols * (endchunk - begchunk + 1))) end if grid_map = 0 + if (single_column) grid_map_scm = 0 allocate(latvals(size(grid_map, 2))) allocate(lonvals(size(grid_map, 2))) p = 0 @@ -1132,12 +1140,21 @@ subroutine phys_grid_init( ) p = p + 1 grid_map(1, p) = i grid_map(2, p) = lcid + if (single_column) then + grid_map_scm(1, p) = i + grid_map_scm(2, p) = lcid + end if if ((i <= ncols) .and. (gcols(i) > 0)) then if (unstructured) then grid_map(3, p) = gcols(i) + if (single_column) grid_map_scm(3, p) = closeioplonidx else - grid_map(3, p) = get_lon_p(lcid, i) - grid_map(4, p) = get_lat_p(lcid, i) + grid_map(3, p) = get_lon_p(lcid, i) + grid_map(4, p) = get_lat_p(lcid, i) + if (single_column) then + grid_map_scm(3, p) = closeioplonidx + grid_map_scm(4, p) = closeioplatidx + end if end if else if (i <= ncols) then @@ -1184,6 +1201,8 @@ subroutine phys_grid_init( ) end if call cam_grid_register('physgrid', phys_decomp, lat_coord, lon_coord, & grid_map, unstruct=unstructured, block_indexed=.true.) + if (single_column) call cam_grid_register('physgrid_scm', phys_decomp_scm, lat_coord, lon_coord, & + grid_map_scm, unstruct=unstructured, block_indexed=.true.) ! Copy required attributes from the dynamics array nullify(copy_attributes) call physgrid_copy_attributes_d(copy_gridname, copy_attributes) @@ -1223,6 +1242,7 @@ subroutine phys_grid_init( ) end if ! Cleanup pointers (they belong to the grid now) nullify(grid_map) + if (single_column) nullify(grid_map_scm) deallocate(latvals) nullify(latvals) deallocate(lonvals) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 1f7fad27af..550efdbe6d 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1088,9 +1088,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) use spcam_drivers, only: tphysbc_spcam use spmd_utils, only: mpicom use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate -#if (defined BFB_CAM_SCAM_IOP ) - use cam_history, only: outfld -#endif + use cam_history, only: outfld, write_camiop use cam_abortutils, only: endrun #if ( defined OFFLINE_DYN ) use metdata, only: get_met_srf1 @@ -1158,11 +1156,11 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) !----------------------------------------------------------------------- ! -#if (defined BFB_CAM_SCAM_IOP ) - do c=begchunk, endchunk - call outfld('Tg',cam_in(c)%ts,pcols ,c ) - end do -#endif + if (write_camiop) then + do c=begchunk, endchunk + call outfld('Tg',cam_in(c)%ts,pcols ,c ) + end do + end if call t_barrierf('sync_bc_physics', mpicom) call t_startf ('bc_physics') diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index 9561780ecb..af9fc8d3ef 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -1055,9 +1055,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) use check_energy, only: check_energy_gmean use spmd_utils, only: mpicom use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate -#if (defined BFB_CAM_SCAM_IOP ) - use cam_history, only: outfld -#endif + use cam_history, only: outfld, write_camiop use cam_abortutils, only: endrun #if ( defined OFFLINE_DYN ) use metdata, only: get_met_srf1 @@ -1125,11 +1123,11 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) !----------------------------------------------------------------------- ! -#if (defined BFB_CAM_SCAM_IOP ) - do c=begchunk, endchunk - call outfld('Tg',cam_in(c)%ts,pcols ,c ) - end do -#endif + if (write_camiop) then + do c=begchunk, endchunk + call outfld('Tg',cam_in(c)%ts,pcols ,c ) + end do + end if call t_barrierf('sync_bc_physics', mpicom) call t_startf ('bc_physics') diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index de3cbb210b..48c33d4974 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -1655,7 +1655,7 @@ function cam_grid_get_areawt(id) result(wtvals) nullify(attrptr) gridind = get_cam_grid_index(id) if (gridind > 0) then - select case(cam_grids(gridind)%name) + select case(trim(cam_grids(gridind)%name)) case('GLL') wtname='area_weight_gll' case('EUL')