<p><b>lowrie@lanl.gov</b> 2013-04-21 19:31:32 -0600 (Sun, 21 Apr 2013)</p><p><br>
Merge in trunk changes.<br>
</p><hr noshade><pre><font color="gray">Index: branches/mpas_cdg_advection
===================================================================
--- branches/mpas_cdg_advection 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection 2013-04-22 01:31:32 UTC (rev 2783)
Property changes on: branches/mpas_cdg_advection
___________________________________________________________________
Modified: svn:mergeinfo
## -1,9 +1,11 ##
/branches/atmos_physics:1672-1846
/branches/cam_mpas_nh:1260-1270
+/branches/history_attribute:2698-2745
/branches/ocean_projects/ale_split_exp:1437-1483
/branches/ocean_projects/ale_vert_coord:1225-1383
/branches/ocean_projects/ale_vert_coord_new:1387-1428
/branches/ocean_projects/cesm_coupling:2147-2344
+/branches/ocean_projects/comment_cleanup:2626-2630
/branches/ocean_projects/diagnostics_revision:2439-2462
/branches/ocean_projects/explicit_vmix_removal:2486-2490
/branches/ocean_projects/gmvar:1214-1514,1517-1738
## -21,6 +23,7 ##
/branches/ocean_projects/sea_level_pressure:2488-2528
/branches/ocean_projects/split_explicit_mrp:1134-1138
/branches/ocean_projects/split_explicit_timestepping:1044-1097
+/branches/ocean_projects/variable_name_change:2689-2767
/branches/ocean_projects/vert_adv_mrp:704-745
/branches/ocean_projects/vol_cons_RK_imp_mix:1965-1992
/branches/ocean_projects/zstar_restart_new:1762-1770
## -29,6 +32,9 ##
/branches/omp_blocks/halo:1570-1638
/branches/omp_blocks/io:1639-1787
/branches/omp_blocks/multiple_blocks:1803-2084
+/branches/scratch_indication:2555-2656
/branches/source_renaming:1082-1113
/branches/time_manager:924-962
-/trunk/mpas:2390-2599
+/branches/xml_registry:2610-2662
+/branches/zoltan_cleaning:2753-2760
+/trunk/mpas:2390-2782
\ No newline at end of property
Modified: branches/mpas_cdg_advection/Makefile
===================================================================
--- branches/mpas_cdg_advection/Makefile 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/Makefile 2013-04-22 01:31:32 UTC (rev 2783)
@@ -4,15 +4,7 @@
# This flag must be off for nersc hopper:
FILE_OFFSET = -DOFFSET64BIT
-#########################
-# Section for Zoltan TPL
-#########################
-ifdef ZOLTAN_HOME
- ZOLTAN_DEFINE = -DHAVE_ZOLTAN
-endif
-#########################
-
dummy:
( $(MAKE) error )
@@ -32,7 +24,7 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) $(FILE_OFFSET)" )
ftn:
( $(MAKE) all \
@@ -47,7 +39,7 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET)" )
pgi:
( $(MAKE) all \
@@ -65,7 +57,7 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET)" )
pgi-nersc:
( $(MAKE) all \
@@ -80,7 +72,7 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET)" )
pgi-llnl:
( $(MAKE) all \
@@ -95,7 +87,7 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET)" )
ifort:
( $(MAKE) all \
@@ -113,7 +105,7 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE -m64 $(FILE_OFFSET)" )
gfortran:
( $(MAKE) all \
@@ -131,7 +123,7 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE -m64 $(FILE_OFFSET)" )
g95:
( $(MAKE) all \
@@ -146,7 +138,7 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET)" )
pathscale-nersc:
( $(MAKE) all \
@@ -161,7 +153,7 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET)" )
cray-nersc:
( $(MAKE) all \
@@ -176,7 +168,7 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET)" )
intel-nersc:
( $(MAKE) all \
@@ -191,11 +183,20 @@
"DEBUG = $(DEBUG)" \
"SERIAL = $(SERIAL)" \
"USE_PAPI = $(USE_PAPI)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET)" )
-CPPINCLUDES = -I../inc -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include
-FCINCLUDES = -I../inc -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include
-LIBS = -L$(PIO) -L$(PNETCDF)/lib -L$(NETCDF)/lib -lpio -lpnetcdf
+CPPINCLUDES =
+FCINCLUDES =
+LIBS =
+ifneq ($(wildcard $(PIO)/lib), ) # Check for newer PIO version
+ CPPINCLUDES = -I../inc -I$(NETCDF)/include -I$(PIO)/include -I$(PNETCDF)/include
+ FCINCLUDES = -I../inc -I$(NETCDF)/include -I$(PIO)/include -I$(PNETCDF)/include
+ LIBS = -L$(PIO)/lib -L$(PNETCDF)/lib -L$(NETCDF)/lib -lpio -lpnetcdf
+else
+ CPPINCLUDES = -I../inc -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include
+ FCINCLUDES = -I../inc -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include
+ LIBS = -L$(PIO) -L$(PNETCDF)/lib -L$(NETCDF)/lib -lpio -lpnetcdf
+endif
NCLIB = -lnetcdf
NCLIBF = -lnetcdff
@@ -208,25 +209,7 @@
CPP = cpp -C -P -traditional
RANLIB = ranlib
-#########################
-# Section for Zoltan TPL
-#########################
-ifdef ZOLTAN_HOME
- ifdef ZOLTAN_INC_PATH
- FCINCLUDES += -I$(ZOLTAN_INC_PATH)
- else
- FCINCLUDES += -I$(ZOLTAN_HOME)/include
- endif
- ifdef ZOLTAN_LIB_PATH
- LIBS += -L$(ZOLTAN_LIB_PATH) -lzoltan
- else
- LIBS += -L$(ZOLTAN_HOME)/lib -lzoltan
- endif
-endif
-#########################
-
-
ifdef CORE
ifeq "$(DEBUG)" "true"
@@ -353,12 +336,12 @@
@cd src; ls -d core_* | grep ".*" | sed "s/core_/ /g"
@echo ""
@echo "Available Options:"
- @echo " SERIAL=true - builds serial version. Default is parallel version."
+#@echo " SERIAL=true - builds serial version. Default is parallel version."
@echo " DEBUG=true - builds debug version. Default is optimized version."
@echo " USE_PAPI=true - builds version using PAPI for timers. Default is off."
@echo " TAU=true - builds version using TAU hooks for profiling. Default is off."
@echo ""
- @echo "Ensure that NETCDF (and PAPI if USE_PAPI=true) are environment variables"
+ @echo "Ensure that NETCDF, PNETCDF, PIO, and PAPI (if USE_PAPI=true) are environment variables"
@echo "that point to the absolute paths for the libraries."
@echo ""
Modified: branches/mpas_cdg_advection/namelist.input.nhyd_atmos
===================================================================
--- branches/mpas_cdg_advection/namelist.input.nhyd_atmos 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/namelist.input.nhyd_atmos 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,56 +1,56 @@
&nhyd_model
config_time_integration = 'SRK3'
config_dt = 450.0
- config_start_time = '2010-10-23_00:00:00'
+ config_start_time = '2010-10-23_00:00:00'
config_run_duration = '5_00:00:00'
config_number_of_sub_steps = 6
- config_h_mom_eddy_visc2 = 0.0
- config_h_mom_eddy_visc4 = 0.0
- config_v_mom_eddy_visc2 = 0.0
- config_h_theta_eddy_visc2 = 0.0
- config_h_theta_eddy_visc4 = 0.0
- config_v_theta_eddy_visc2 = 0.0
- config_horiz_mixing = '2d_smagorinsky'
- config_len_disp = 120000.0
- config_theta_adv_order = 3
- config_scalar_adv_order = 3
- config_w_adv_order = 3
- config_u_vadv_order = 3
- config_w_vadv_order = 3
- config_theta_vadv_order = 3
- config_scalar_vadv_order = 3
- config_coef_3rd_order = 0.25
- config_positive_definite = .true.
- config_monotonic = .false.
- config_epssm = 0.1
- config_smdiv = 0.1
- config_h_ScaleWithMesh = .false.
- config_sfc_update_interval = "none"
- config_newpx = .false.
+ config_h_mom_eddy_visc2 = 0.0
+ config_h_mom_eddy_visc4 = 0.0
+ config_v_mom_eddy_visc2 = 0.0
+ config_h_theta_eddy_visc2 = 0.0
+ config_h_theta_eddy_visc4 = 0.0
+ config_v_theta_eddy_visc2 = 0.0
+ config_horiz_mixing = '2d_smagorinsky'
+ config_len_disp = 120000.0
+ config_visc4_2dsmag = 0.05
+ config_u_vadv_order = 3
+ config_w_vadv_order = 3
+ config_theta_vadv_order = 3
+ config_scalar_vadv_order = 3
+ config_w_adv_order = 3
+ config_theta_adv_order = 3
+ config_scalar_adv_order = 3
+ config_scalar_advection = .true.
+ config_positive_definite = .false.
+ config_monotonic = .true.
+ config_coef_3rd_order = 0.25
+ config_epssm = 0.1
+ config_smdiv = 0.1
+ config_h_ScaleWithMesh = .false.
+ config_newpx = .false.
+ config_sfc_update_interval = 'none'
/
config_stop_time = '0000-01-16_00:00:00'
&damping
config_zd = 22000.0
- config_xnutr = 0.0
+ config_xnutr = 0.2
/
&io
- config_input_name = 'x1.40962.init.nc'
- config_output_name = 'x1.40962.output.nc'
- config_restart_name = 'restart.nc'
- config_output_interval = '1_00:00:00'
+ config_input_name = 'x1.40962.init.nc'
+ config_output_name = 'x1.40962.output.nc'
+ config_restart_name = 'x1.40962.restart.nc'
+ config_output_interval = '1_00:00:00'
config_frames_per_outfile = 1
- config_pio_num_iotasks = 0
- config_pio_stride = 1
+ config_pio_num_iotasks = 0
+ config_pio_stride = 1
/
- config_sfc_update_name = 'sfc_update.nc'
+ config_sfc_update_name = 'x1.40962.sfc_update.nc'
&decomposition
- config_number_of_blocks = 0
+ config_number_of_blocks = 0
config_block_decomp_file_prefix = 'x1.40962.graph.info.part.'
- config_explicit_proc_decomp = .false.
- config_proc_decomp_file_prefix = 'graph.info.part.'
/
&restart
@@ -59,27 +59,30 @@
/
&physics
- config_frac_seaice = .false.
- config_sfc_albedo = .true.
- config_sst_update = .false.
- config_sstdiurn_update = .false.
- config_deepsoiltemp_update = .false.
-
- config_n_microp = 5
-
- config_radtlw_interval = '00:30:00'
- config_radtsw_interval = '00:30:00'
- config_conv_interval = 'none'
- config_pbl_interval = 'none'
-
- config_microp_scheme = 'wsm6'
- config_conv_shallow_scheme = 'off'
- config_conv_deep_scheme = 'kain_fritsch'
- config_eddy_scheme = 'off'
- config_lsm_scheme = 'noah'
- config_pbl_scheme = 'ysu'
- config_radt_cld_scheme = 'off'
- config_radt_lw_scheme = 'rrtmg_lw'
- config_radt_sw_scheme = 'rrtmg_sw'
- config_sfclayer_scheme = 'monin_obukhov'
+ config_frac_seaice = .false.
+ config_sfc_albedo = .true.
+ config_sfc_snowalbedo = .true.
+ config_sst_update = .false.
+ config_sstdiurn_update = .false.
+ config_deepsoiltemp_update = .false.
+ config_bucket_update = 'none'
+ config_bucket_rainc = 100.0
+ config_bucket_rainnc = 100.0
+ config_bucket_radt = 1.0e9
+ config_radtlw_interval = '00:30:00'
+ config_radtsw_interval = '00:30:00'
+ config_conv_interval = 'none'
+ config_pbl_interval = 'none'
+ config_n_microp = 5
+ config_microp_scheme = 'wsm6'
+ config_conv_shallow_scheme = 'off'
+ config_conv_deep_scheme = 'kain_fritsch'
+ config_eddy_scheme = 'off'
+ config_lsm_scheme = 'noah'
+ config_pbl_scheme = 'ysu'
+ config_gwdo_scheme = 'off'
+ config_radt_cld_scheme = 'off'
+ config_radt_lw_scheme = 'rrtmg_lw'
+ config_radt_sw_scheme = 'rrtmg_sw'
+ config_sfclayer_scheme = 'monin_obukhov'
/
Modified: branches/mpas_cdg_advection/namelist.input.ocean
===================================================================
--- branches/mpas_cdg_advection/namelist.input.ocean 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/namelist.input.ocean 2013-04-22 01:31:32 UTC (rev 2783)
@@ -113,7 +113,7 @@
/
&pressure_gradient
config_pressure_gradient_type = 'pressure_and_zmid'
- config_rho0 = 1014.65
+ config_density0 = 1014.65
/
&eos
config_eos_type = 'jm'
@@ -123,7 +123,7 @@
config_eos_linear_beta = 7.64e-1
config_eos_linear_Tref = 19.0
config_eos_linear_Sref = 35.0
- config_eos_linear_rhoref = 1025.022
+ config_eos_linear_densityref = 1025.022
/
&split_explicit_ts
config_n_ts_iter = 2
@@ -132,11 +132,11 @@
config_n_bcl_iter_end = 2
config_n_btr_subcycles = 20
config_n_btr_cor_iter = 2
- config_u_correction = .true.
+ config_vel_correction = .true.
config_btr_subcycle_loop_factor = 2
- config_btr_gam1_uWt1 = 0.5
+ config_btr_gam1_velWt1 = 0.5
config_btr_gam2_SSHWt1 = 1.0
- config_btr_gam3_uWt2 = 1.0
+ config_btr_gam3_velWt2 = 1.0
config_btr_solve_SSH2 = .false.
/
&debug
@@ -146,16 +146,16 @@
config_prescribe_thickness = .false.
config_include_KE_vertex = .false.
config_check_tracer_monotonicity = .false.
- config_disable_h_all_tend = .false.
- config_disable_h_hadv = .false.
- config_disable_h_vadv = .false.
- config_disable_u_all_tend = .false.
- config_disable_u_coriolis = .false.
- config_disable_u_pgrad = .false.
- config_disable_u_hmix = .false.
- config_disable_u_windstress = .false.
- config_disable_u_vmix = .false.
- config_disable_u_vadv = .false.
+ config_disable_thick_all_tend = .false.
+ config_disable_thick_hadv = .false.
+ config_disable_thick_vadv = .false.
+ config_disable_vel_all_tend = .false.
+ config_disable_vel_coriolis = .false.
+ config_disable_vel_pgrad = .false.
+ config_disable_vel_hmix = .false.
+ config_disable_vel_windstress = .false.
+ config_disable_vel_vmix = .false.
+ config_disable_vel_vadv = .false.
config_disable_tr_all_tend = .false.
config_disable_tr_adv = .false.
config_disable_tr_hmix = .false.
Modified: branches/mpas_cdg_advection/src/Makefile
===================================================================
--- branches/mpas_cdg_advection/src/Makefile 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/Makefile 2013-04-22 01:31:32 UTC (rev 2783)
@@ -10,7 +10,6 @@
all: mpas
-
mpas: reg_includes externals frame ops dycore drver
$(LINKER) $(LDFLAGS) -o $(CORE)_model.exe driver/*.o -L. -ldycore -lops -lframework $(LIBS) -I./external/esmf_time_f90 -L./external/esmf_time_f90 -lesmf_time
@@ -23,7 +22,7 @@
reg_includes:
( cd registry; $(MAKE) CC="$(SCC)" )
- ( cd inc; $(CPP) ../core_$(CORE)/Registry | ../registry/parse > Registry.processed)
+ ( cd inc; $(CPP) ../core_$(CORE)/Registry.xml | ../registry/parse > Registry.processed)
frame: reg_includes externals
( cd framework; $(MAKE) CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" all )
Modified: branches/mpas_cdg_advection/src/Makefile.in.CESM_OCN
===================================================================
--- branches/mpas_cdg_advection/src/Makefile.in.CESM_OCN 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/Makefile.in.CESM_OCN 2013-04-22 01:31:32 UTC (rev 2783)
@@ -7,7 +7,7 @@
PNETCDF=$(PNETCDF_PATH)
PIO=$(EXEROOT)/pio
FILE_OFFSET = -DOFFSET64BIT
-CPPFLAGS += $(MODEL_FORMULATION) $(FILE_OFFSET) $(ZOLTAN_DEFINE) -DMPAS_CESM -D_MPI# -DUNDERSCORE
+CPPFLAGS += $(MODEL_FORMULATION) $(FILE_OFFSET) -DMPAS_CESM -D_MPI# -DUNDERSCORE
CPPINCLUDES += -I$(EXEROOT)/ocn/source/inc -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include
FCINCLUDES += -I$(EXEROOT)/ocn/source/inc -I$(EXEROOT)/csm_share -I$(EXEROOT)/gptl -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include
LIBS += -L$(PIO) -L$(PNETCDF)/lib -L$(NETCDF)/lib -lpio -lpnetcdf -lnetcdf
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/Makefile
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/Makefile 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/Makefile 2013-04-22 01:31:32 UTC (rev 2783)
@@ -6,6 +6,8 @@
ifeq ($(CORE),nhyd_atmos)
COREDEF = -Dnon_hydrostatic_core
endif
+HYDROSTATIC = -Ddo_hydrostatic_pressure
+#HYDROSTATIC =
dummy:
echo "****** make non-hydrostatic core ******"
@@ -17,16 +19,17 @@
OBJS = \
mpas_atmphys_driver_cloudiness.o \
mpas_atmphys_driver_convection_deep.o \
+ mpas_atmphys_driver_gwdo.o \
mpas_atmphys_driver_lsm.o \
mpas_atmphys_driver_microphysics.o \
mpas_atmphys_driver_radiation_lw.o \
mpas_atmphys_driver_radiation_sw.o \
mpas_atmphys_driver_sfclayer.o \
mpas_atmphys_driver_pbl.o \
+ mpas_atmphys_driver.o \
mpas_atmphys_camrad_init.o \
mpas_atmphys_control.o \
mpas_atmphys_date_time.o \
- mpas_atmphys_driver.o \
mpas_atmphys_init.o \
mpas_atmphys_landuse.o \
mpas_atmphys_lsm_noahinit.o \
@@ -73,6 +76,10 @@
./physics_wrf/module_cu_kfeta.o \
./physics_wrf/module_cu_tiedtke.o
+mpas_atmphys_driver_gwdo.o: \
+ mpas_atmphys_vars.o \
+ ./physics_wrf/module_bl_gwdo.o
+
mpas_atmphys_driver_lsm.o: \
mpas_atmphys_constants.o \
mpas_atmphys_landuse.o \
@@ -203,6 +210,7 @@
mpas_atmphys_driver.o: \
mpas_atmphys_driver_convection_deep.o \
+ mpas_atmphys_driver_gwdo.o \
mpas_atmphys_driver_pbl.o \
mpas_atmphys_driver_radiation_lw.o \
mpas_atmphys_driver_radiation_sw.o \
@@ -225,5 +233,5 @@
.F.o:
$(RM) $@ $*.mod
- $(CPP) $(CPPFLAGS) $(COREDEF) $(CPPINCLUDES) -DIWORDSIZE=4 -DRWORDSIZE=8 $< > $*.f90
+ $(CPP) $(CPPFLAGS) $(COREDEF) $(HYDROSTATIC) $(CPPINCLUDES) -DIWORDSIZE=4 -DRWORDSIZE=8 $< > $*.f90
$(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../operators -I./physics_wrf -I./physics_eaung -I../external/esmf_time_f90
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_control.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_control.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_control.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -35,16 +35,17 @@
write(0,*)
write(0,*) '--- enter subroutine physics_namelist_check:'
- write(0,*) ' config_microp_scheme = ', config_microp_scheme
- write(0,*) ' config_conv_shallow_scheme = ', config_conv_shallow_scheme
- write(0,*) ' config_conv_deep_scheme = ', config_conv_deep_scheme
- write(0,*) ' config_eddy_scheme = ', config_eddy_scheme
- write(0,*) ' config_lsm_scheme = ', config_lsm_scheme
- write(0,*) ' config_pbl_scheme = ', config_pbl_scheme
- write(0,*) ' config_radt_cld_scheme = ', config_radt_cld_scheme
- write(0,*) ' config_radt_lw_scheme = ', config_radt_lw_scheme
- write(0,*) ' config_radt_sw_scheme = ', config_radt_sw_scheme
- write(0,*) ' config_sfclayer_scheme = ', config_sfclayer_scheme
+ write(0,*) ' config_microp_scheme = ', trim(config_microp_scheme)
+ write(0,*) ' config_conv_shallow_scheme = ', trim(config_conv_shallow_scheme)
+ write(0,*) ' config_conv_deep_scheme = ', trim(config_conv_deep_scheme)
+ write(0,*) ' config_eddy_scheme = ', trim(config_eddy_scheme)
+ write(0,*) ' config_lsm_scheme = ', trim(config_lsm_scheme)
+ write(0,*) ' config_pbl_scheme = ', trim(config_pbl_scheme)
+ write(0,*) ' config_gwdo_scheme = ', trim(config_gwdo_scheme)
+ write(0,*) ' config_radt_cld_scheme = ', trim(config_radt_cld_scheme)
+ write(0,*) ' config_radt_lw_scheme = ', trim(config_radt_lw_scheme)
+ write(0,*) ' config_radt_sw_scheme = ', trim(config_radt_sw_scheme)
+ write(0,*) ' config_sfclayer_scheme = ', trim(config_sfclayer_scheme)
!cloud microphysics scheme:
if(.not. (config_microp_scheme .eq. 'off' .or. &
@@ -93,6 +94,22 @@
endif
+!gravity wave drag over orography scheme:
+ if(.not. (config_gwdo_scheme .eq. 'off' .or. &
+ config_gwdo_scheme .eq. 'ysu_gwdo')) then
+
+ write(mpas_err_message,'(A,A10)') 'illegal value for gwdo_scheme: ', &
+ trim(config_gwdo_scheme)
+ call physics_error_fatal(mpas_err_message)
+
+ elseif(config_gwdo_scheme .eq. 'ysu_gwdo' .and. config_pbl_scheme .ne. 'ysu') then
+
+ write(mpas_err_message,'(A,A10)') 'turn YSU PBL scheme on with config_gwdo = ysu_gwdo:', &
+ trim(config_gwdo_scheme)
+ call physics_error_fatal(mpas_err_message)
+
+ endif
+
!diffusion scheme:
if(.not. (config_eddy_scheme .eq. 'off')) then
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_date_time.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_date_time.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_date_time.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -85,7 +85,6 @@
!local variables:
character(len=StrKIND):: day15,mon
- character(len=StrKIND):: yr
integer:: l,n
integer:: julyr,julday,int_month,month1,month2
@@ -144,7 +143,7 @@
endif
enddo find_month
- 201 format(i6,3(1x,e15.8))
+! 201 format(i6,3(1x,e15.8))
end subroutine monthly_interp_to_date
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -5,6 +5,7 @@
use mpas_atmphys_driver_cloudiness
use mpas_atmphys_driver_convection_deep
+ use mpas_atmphys_driver_gwdo
use mpas_atmphys_driver_pbl
use mpas_atmphys_driver_lsm
use mpas_atmphys_driver_radiation_sw
@@ -59,7 +60,8 @@
!physics prep step:
#ifdef non_hydrostatic_core
- call MPAS_to_physics(block%mesh,block%state%time_levs(1)%state,block%diag)
+ call MPAS_to_physics(block%mesh,block%state%time_levs(1)%state,block%diag, &
+ block%diag_physics)
#elif hydrostatic_core
call MPAS_to_physics(block%state%time_levs(1)%state,block%diag)
#endif
@@ -118,6 +120,14 @@
call deallocate_pbl
endif
+ !call to gravity wave drag over orography scheme:
+ if(config_gwdo_scheme .ne. 'off') then
+ call allocate_gwdo
+ call driver_gwdo(itimestep,block%mesh,block%sfc_input,block%diag_physics, &
+ block%tend_physics)
+ call deallocate_gwdo
+ endif
+
!call to convection scheme:
call update_convection_step1(block%mesh,block%diag_physics,block%tend_physics)
if(l_conv) then
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -290,7 +290,10 @@
else
ktau = itimestep + 1
endif
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
call kf_eta_cps ( &
+ pcps = pres_hyd_p , t = t_p , &
! dt = dt_dyn , ktau = itimestep , &
dt = dt_dyn , ktau = ktau , &
areaCell = area_p , cudt = cudt , &
@@ -298,9 +301,8 @@
rho = rho_p , raincv = raincv_p , &
pratec = pratec_p , nca = nca_p , &
u = u_p , v = v_p , &
- th = th_p , t = t_p , &
+ th = th_p , pi = pi_p , &
w = w_p , dz8w = dz_p , &
- pcps = pres_p , pi = pi_p , &
w0avg = w0avg_p , xlv0 = xlv0 , &
xlv1 = xlv1 , xls0 = xls0 , &
xls1 = xls1 , cp = cp , &
@@ -320,22 +322,90 @@
ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
ims = ims , ime = ime , jms = jms , jme = jme , kms = kds , kme = kme , &
its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
- )
+ )
+#else
+!... REARRANGED CALL:
+ call kf_eta_cps ( &
+ pcps = pres_p , t = t_p , &
+! dt = dt_dyn , ktau = itimestep , &
+ dt = dt_dyn , ktau = ktau , &
+ areaCell = area_p , cudt = cudt , &
+ curr_secs = curr_secs , adapt_step_flag = adapt_step_flag , &
+ rho = rho_p , raincv = raincv_p , &
+ pratec = pratec_p , nca = nca_p , &
+ u = u_p , v = v_p , &
+ th = th_p , pi = pi_p , &
+ w = w_p , dz8w = dz_p , &
+ w0avg = w0avg_p , xlv0 = xlv0 , &
+ xlv1 = xlv1 , xls0 = xls0 , &
+ xls1 = xls1 , cp = cp , &
+ r = r_d , g = g , &
+ ep1 = ep_1 , ep2 = ep_2 , &
+ svp1 = svp1 , svp2 = svp2 , &
+ svp3 = svp3 , svpt0 = svpt0 , &
+ stepcu = n_cu , cu_act_flag = cu_act_flag , &
+ warm_rain = warm_rain , cutop = cutop_p , &
+ cubot = cubot_p , qv = qv_p , &
+ f_qv = f_qv , f_qc = f_qc , &
+ f_qr = f_qr , f_qi = f_qi , &
+ f_qs = f_qs , rthcuten = rthcuten_p , &
+ rqvcuten = rqvcuten_p , rqccuten = rqccuten_p , &
+ rqrcuten = rqrcuten_p , rqicuten = rqicuten_p , &
+ rqscuten = rqscuten_p , &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kds , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+#endif
+!... CALL FROM REVISION 1721:
+! call kf_eta_cps ( &
+! dt = dt_dyn , ktau = itimestep , &
+! dt = dt_dyn , ktau = ktau , &
+! areaCell = area_p , cudt = cudt , &
+! curr_secs = curr_secs , adapt_step_flag = adapt_step_flag , &
+! rho = rho_p , raincv = raincv_p , &
+! pratec = pratec_p , nca = nca_p , &
+! u = u_p , v = v_p , &
+! th = th_p , t = t_p , &
+! w = w_p , dz8w = dz_p , &
+! pcps = pres_p , pi = pi_p , &
+! w0avg = w0avg_p , xlv0 = xlv0 , &
+! xlv1 = xlv1 , xls0 = xls0 , &
+! xls1 = xls1 , cp = cp , &
+! r = r_d , g = g , &
+! ep1 = ep_1 , ep2 = ep_2 , &
+! svp1 = svp1 , svp2 = svp2 , &
+! svp3 = svp3 , svpt0 = svpt0 , &
+! stepcu = n_cu , cu_act_flag = cu_act_flag , &
+! warm_rain = warm_rain , cutop = cutop_p , &
+! cubot = cubot_p , qv = qv_p , &
+! f_qv = f_qv , f_qc = f_qc , &
+! f_qr = f_qr , f_qi = f_qi , &
+! f_qs = f_qs , rthcuten = rthcuten_p , &
+! rqvcuten = rqvcuten_p , rqccuten = rqccuten_p , &
+! rqrcuten = rqrcuten_p , rqicuten = rqicuten_p , &
+! rqscuten = rqscuten_p , &
+! ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+! ims = ims , ime = ime , jms = jms , jme = jme , kms = kds , kme = kme , &
+! its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+! )
case("tiedtke")
write(0,*) '--- enter subroutine cu_tiedtke:'
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
call cu_tiedtke ( &
+ pcps = pres_hyd_p , p8w = pres2_hyd_p , &
+ znu = znu_hyd_p , t3d = t_p , &
dt = dt_dyn , itimestep = itimestep , &
stepcu = n_cu , raincv = raincv_p , &
pratec = pratec_p , qfx = qfx_p , &
- znu = znu_p , u3d = u_p , &
- v3d = v_p , w = w_p , &
- t3d = t_p , qv3d = qv_p , &
+ u3d = u_p , v3d = v_p , &
+ w = w_p , qv3d = qv_p , &
qc3d = qc_p , qi3d = qi_p , &
pi3d = pi_p , rho3d = rho_p , &
qvften = rqvdynten_p , qvpblten = rqvdynblten_p , &
- dz8w = dz_p , pcps = pres_p , &
- p8w = pres2_p , xland = xland_p , &
+ dz8w = dz_p , xland = xland_p , &
cu_act_flag = cu_act_flag , cudt = dt_cu , &
! curr_secs = curr_secs , adapt_step_flag = adapt_step_flag , &
! cudtacttime = cudtacttime , f_qv = f_qv , &
@@ -349,6 +419,60 @@
ims = ims , ime = ime , jms = jms , jme = jme , kms = kds , kme = kme , &
its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
)
+#else
+!... REARRANGED CALL:
+ call cu_tiedtke ( &
+ pcps = pres_p , p8w = pres2_p , &
+ znu = znu_p , t3d = t_p , &
+ dt = dt_dyn , itimestep = itimestep , &
+ stepcu = n_cu , raincv = raincv_p , &
+ pratec = pratec_p , qfx = qfx_p , &
+ u3d = u_p , v3d = v_p , &
+ w = w_p , qv3d = qv_p , &
+ qc3d = qc_p , qi3d = qi_p , &
+ pi3d = pi_p , rho3d = rho_p , &
+ qvften = rqvdynten_p , qvpblten = rqvdynblten_p , &
+ dz8w = dz_p , xland = xland_p , &
+ cu_act_flag = cu_act_flag , cudt = dt_cu , &
+! curr_secs = curr_secs , adapt_step_flag = adapt_step_flag , &
+! cudtacttime = cudtacttime , f_qv = f_qv , &
+ f_qv = f_qv , &
+ f_qc = f_qc , f_qr = f_qr , &
+ f_qi = f_qi , f_qs = f_qs , &
+ rthcuten = rthcuten_p , rqvcuten = rqvcuten_p , &
+ rqccuten = rqccuten_p , rqicuten = rqicuten_p , &
+ rucuten = rucuten_p , rvcuten = rvcuten_p , &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kds , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+#endif
+!... CALL FROM REVISION 1721:
+! call cu_tiedtke ( &
+! dt = dt_dyn , itimestep = itimestep , &
+! stepcu = n_cu , raincv = raincv_p , &
+! pratec = pratec_p , qfx = qfx_p , &
+! znu = znu_p , u3d = u_p , &
+! v3d = v_p , w = w_p , &
+! t3d = t_p , qv3d = qv_p , &
+! qc3d = qc_p , qi3d = qi_p , &
+! pi3d = pi_p , rho3d = rho_p , &
+! qvften = rqvdynten_p , qvpblten = rqvdynblten_p , &
+! dz8w = dz_p , pcps = pres_p , &
+! p8w = pres2_p , xland = xland_p , &
+! cu_act_flag = cu_act_flag , cudt = dt_cu , &
+! curr_secs = curr_secs , adapt_step_flag = adapt_step_flag , &
+! cudtacttime = cudtacttime , f_qv = f_qv , &
+! f_qv = f_qv , &
+! f_qc = f_qc , f_qr = f_qr , &
+! f_qi = f_qi , f_qs = f_qs , &
+! rthcuten = rthcuten_p , rqvcuten = rqvcuten_p , &
+! rqccuten = rqccuten_p , rqicuten = rqicuten_p , &
+! rucuten = rucuten_p , rvcuten = rvcuten_p , &
+! ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+! ims = ims , ime = ime , jms = jms , jme = jme , kms = kds , kme = kme , &
+! its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+! )
case default
Copied: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_gwdo.F (from rev 2782, trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver_gwdo.F)
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_gwdo.F (rev 0)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_gwdo.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,236 @@
+!=============================================================================================
+ module mpas_atmphys_driver_gwdo
+ use mpas_configure, only: len_disp => config_len_disp
+ use mpas_grid_types
+
+ use mpas_atmphys_constants
+ use mpas_atmphys_vars
+
+!from wrf physics:
+ use module_bl_gwdo
+
+ implicit none
+ private
+ public:: allocate_gwdo, &
+ deallocate_gwdo, &
+ driver_gwdo
+
+ integer,private:: i,j,k
+
+ contains
+
+!=============================================================================================
+ subroutine allocate_gwdo
+!=============================================================================================
+
+ if(.not.allocated(dx_p) ) allocate(dx_p(ims:ime,jms:jme) )
+ if(.not.allocated(var2d_p) ) allocate(var2d_p(ims:ime,jms:jme) )
+ if(.not.allocated(con_p) ) allocate(con_p(ims:ime,jms:jme) )
+ if(.not.allocated(oa1_p) ) allocate(oa1_p(ims:ime,jms:jme) )
+ if(.not.allocated(oa2_p) ) allocate(oa2_p(ims:ime,jms:jme) )
+ if(.not.allocated(oa3_p) ) allocate(oa3_p(ims:ime,jms:jme) )
+ if(.not.allocated(oa4_p) ) allocate(oa4_p(ims:ime,jms:jme) )
+ if(.not.allocated(ol1_p) ) allocate(ol1_p(ims:ime,jms:jme) )
+ if(.not.allocated(ol2_p) ) allocate(ol2_p(ims:ime,jms:jme) )
+ if(.not.allocated(ol3_p) ) allocate(ol3_p(ims:ime,jms:jme) )
+ if(.not.allocated(ol4_p) ) allocate(ol4_p(ims:ime,jms:jme) )
+ if(.not.allocated(kpbl_p )) allocate(kpbl_p(ims:ime,jms:jme) )
+ if(.not.allocated(dusfcg_p)) allocate(dusfcg_p(ims:ime,jms:jme))
+ if(.not.allocated(dvsfcg_p)) allocate(dvsfcg_p(ims:ime,jms:jme))
+
+ if(.not.allocated(dtaux3d_p)) allocate(dtaux3d_p(ims:ime,kms:kme,jms:jme))
+ if(.not.allocated(dtauy3d_p)) allocate(dtauy3d_p(ims:ime,kms:kme,jms:jme))
+ if(.not.allocated(rublten_p)) allocate(rublten_p(ims:ime,kms:kme,jms:jme))
+ if(.not.allocated(rvblten_p)) allocate(rvblten_p(ims:ime,kms:kme,jms:jme))
+
+ end subroutine allocate_gwdo
+
+!=============================================================================================
+ subroutine deallocate_gwdo
+!=============================================================================================
+
+ if(allocated(dx_p) ) deallocate(dx_p )
+ if(allocated(var2d_p) ) deallocate(var2d_p )
+ if(allocated(con_p) ) deallocate(con_p )
+ if(allocated(oa1_p) ) deallocate(oa1_p )
+ if(allocated(oa2_p) ) deallocate(oa2_p )
+ if(allocated(oa3_p) ) deallocate(oa3_p )
+ if(allocated(oa4_p) ) deallocate(oa4_p )
+ if(allocated(ol1_p) ) deallocate(ol1_p )
+ if(allocated(ol2_p) ) deallocate(ol2_p )
+ if(allocated(ol3_p) ) deallocate(ol3_p )
+ if(allocated(ol4_p) ) deallocate(ol4_p )
+ if(allocated(kpbl_p )) deallocate(kpbl_p )
+ if(allocated(dusfcg_p)) deallocate(dusfcg_p)
+ if(allocated(dvsfcg_p)) deallocate(dvsfcg_p)
+
+ if(allocated(dtaux3d_p)) deallocate(dtaux3d_p)
+ if(allocated(dtauy3d_p)) deallocate(dtauy3d_p)
+ if(allocated(rublten_p)) deallocate(rublten_p)
+ if(allocated(rvblten_p)) deallocate(rvblten_p)
+
+ end subroutine deallocate_gwdo
+
+!=============================================================================================
+ subroutine gwdo_from_MPAS(mesh,sfc_input,diag_physics,tend_physics)
+!=============================================================================================
+
+!input arguments:
+ type(mesh_type),intent(in):: mesh
+ type(sfc_input_type),intent(in) :: sfc_input
+ type(diag_physics_type),intent(in):: diag_physics
+ type(tend_physics_type),intent(in):: tend_physics
+
+!local variables:
+ integer:: iEdge
+
+!---------------------------------------------------------------------------------------------
+
+ do j = jts,jte
+ do i = its,ite
+ iEdge = mesh%nEdgesOnCell%array(i)
+ dx_p(i,j) = maxval(mesh%dcEdge%array(mesh%edgesOnCell%array(1:iEdge,i)))
+ enddo
+ enddo
+
+ do j = jts,jte
+ do i = its,ite
+ var2d_p(i,j) = sfc_input % var2d % array(i)
+ con_p(i,j) = sfc_input % con % array(i)
+ oa1_p(i,j) = sfc_input % oa1 % array(i)
+ oa2_p(i,j) = sfc_input % oa2 % array(i)
+ oa3_p(i,j) = sfc_input % oa3 % array(i)
+ oa4_p(i,j) = sfc_input % oa4 % array(i)
+ ol1_p(i,j) = sfc_input % ol1 % array(i)
+ ol2_p(i,j) = sfc_input % ol2 % array(i)
+ ol3_p(i,j) = sfc_input % ol3 % array(i)
+ ol4_p(i,j) = sfc_input % ol4 % array(i)
+ enddo
+ enddo
+
+ do j = jts,jte
+ do i = its,ite
+ kpbl_p(i,j) = diag_physics % kpbl % array(i)
+ dusfcg_p(i,j) = diag_physics % dusfcg % array(i)
+ dvsfcg_p(i,j) = diag_physics % dvsfcg % array(i)
+ enddo
+ enddo
+
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+ dtaux3d_p(i,k,j) = diag_physics % dtaux3d % array(k,i)
+ dtauy3d_p(i,k,j) = diag_physics % dtauy3d % array(k,i)
+ rublten_p(i,k,j) = tend_physics % rublten % array(k,i)
+ rvblten_p(i,k,j) = tend_physics % rvblten % array(k,i)
+ enddo
+ enddo
+ enddo
+
+ end subroutine gwdo_from_MPAS
+
+!=============================================================================================
+ subroutine gwdo_to_MPAS(diag_physics,tend_physics)
+!=============================================================================================
+
+!inout arguments:
+ type(diag_physics_type),intent(inout):: diag_physics
+ type(tend_physics_type),intent(inout):: tend_physics
+
+!---------------------------------------------------------------------------------------------
+
+ do j = jts,jte
+ do i = its,ite
+ diag_physics % dusfcg % array(i) = dusfcg_p(i,j)
+ diag_physics % dvsfcg % array(i) = dvsfcg_p(i,j)
+ enddo
+ enddo
+
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+ diag_physics % dtaux3d % array(k,i) = dtaux3d_p(i,k,j)
+ diag_physics % dtauy3d % array(k,i) = dtauy3d_p(i,k,j)
+ diag_physics % rubldiff % array(k,i) = rublten_p(i,k,j)-tend_physics%rublten%array(k,i)
+ diag_physics % rvbldiff % array(k,i) = rvblten_p(i,k,j)-tend_physics%rvblten%array(k,i)
+
+ tend_physics % rublten % array(k,i) = rublten_p(i,k,j)
+ tend_physics % rvblten % array(k,i) = rvblten_p(i,k,j)
+ enddo
+ enddo
+ enddo
+
+!write(0,*)
+!write(0,*) '--- end subroutine gwdo_to_MPAS:'
+!do i = its,ite
+! write(0,101) i,diag_physics%dusfcg%array(i),diag_physics%dvsfcg%array(i)
+!enddo
+!101 format(i8,2(1x,e15.8))
+
+ end subroutine gwdo_to_MPAS
+
+!=============================================================================================
+ subroutine driver_gwdo(itimestep,mesh,sfc_input,diag_physics,tend_physics)
+!=============================================================================================
+
+!input arguments:
+ type(mesh_type),intent(in):: mesh
+ type(sfc_input_type),intent(in):: sfc_input
+ integer,intent(in):: itimestep
+
+!inout arguments:
+ type(diag_physics_type),intent(inout):: diag_physics
+ type(tend_physics_type),intent(inout):: tend_physics
+
+!local variables:
+ integer:: i,iCell,iEdge
+ real(kind=RKIND),dimension(:),allocatable:: dx_max
+
+!---------------------------------------------------------------------------------------------
+ write(0,*)
+ write(0,*) '--- enter subroutine driver_gwdo: dt_pbl=',dt_pbl
+
+!copy all MPAS arrays to rectanguler grid arrays:
+ call gwdo_from_MPAS(mesh,sfc_input,diag_physics,tend_physics)
+
+ gwdo_select: select case (trim(gwdo_scheme))
+
+ case("ysu_gwdo")
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
+ call gwdo ( &
+ p3d = pres_hydd_p , p3di = pres2_hydd_p , pi3d = pi_p , &
+ u3d = u_p , v3d = v_p , t3d = t_p , &
+ qv3d = qv_p , z = z_p , rublten = rublten_p , &
+ rvblten = rvblten_p , dtaux3d = dtaux3d_p , dtauy3d = dtauy3d_p , &
+ dusfcg = dusfcg_p , dvsfcg = dvsfcg_p , kpbl2d = kpbl_p , &
+ itimestep = itimestep , dt = dt_pbl , dx = dx_p , &
+ cp = cp , g = g , rd = R_d , &
+ rv = R_v , ep1 = ep_1 , pi = pii , &
+ var2d = var2d_p , oc12d = con_p , oa2d1 = oa1_p , &
+ oa2d2 = oa2_p , oa2d3 = oa3_p , oa2d4 = oa4_p , &
+ ol2d1 = ol1_p , ol2d2 = ol2_p , ol2d3 = ol3_p , &
+ ol2d4 = ol4_p , &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+#else
+!... REARRANGED CALL:
+ call gwdo ( &
+ )
+#endif
+
+ case default
+
+ end select gwdo_select
+
+!copy all arrays back to the MPAS grid:
+ call gwdo_to_MPAS(diag_physics,tend_physics)
+ write(0,*) '--- end subroutine driver_gwdo'
+
+ end subroutine driver_gwdo
+
+!=============================================================================================
+ end module mpas_atmphys_driver_gwdo
+!=============================================================================================
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_lsm.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_lsm.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_lsm.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -75,7 +75,7 @@
if(.not.allocated(qsfc_p) ) allocate(qsfc_p(ims:ime,jms:jme) )
if(.not.allocated(qz0_p) ) allocate(qz0_p(ims:ime,jms:jme) )
if(.not.allocated(rainbl_p) ) allocate(rainbl_p(ims:ime,jms:jme) )
- if(.not.allocated(rib_p) ) allocate(rib_p(ims:ime,jms:jme) )
+ if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) )
if(.not.allocated(sfc_albbck_p) ) allocate(sfc_albbck_p(ims:ime,jms:jme) )
if(.not.allocated(sfc_albedo_p) ) allocate(sfc_albedo_p(ims:ime,jms:jme) )
if(.not.allocated(sfc_emibck_p) ) allocate(sfc_emibck_p(ims:ime,jms:jme) )
@@ -139,7 +139,7 @@
if(allocated(qsfc_p) ) deallocate(qsfc_p )
if(allocated(qz0_p) ) deallocate(qz0_p )
if(allocated(rainbl_p) ) deallocate(rainbl_p )
- if(allocated(rib_p) ) deallocate(rib_p )
+ if(allocated(br_p) ) deallocate(br_p )
if(allocated(sfc_albbck_p) ) deallocate(sfc_albbck_p )
if(allocated(sfc_albedo_p) ) deallocate(sfc_albedo_p )
if(allocated(sfc_emibck_p) ) deallocate(sfc_emibck_p )
@@ -221,7 +221,7 @@
qgh_p(i,j) = diag_physics % qgh % array(i)
qsfc_p(i,j) = diag_physics % qsfc % array(i)
qz0_p(i,j) = diag_physics % qz0 % array(i)
- rib_p(i,j) = diag_physics % rib % array(i)
+ br_p(i,j) = diag_physics % br % array(i)
sfc_albedo_p(i,j) = diag_physics % sfc_albedo % array(i)
sfc_emibck_p(i,j) = diag_physics % sfc_emibck % array(i)
sfc_emiss_p(i,j) = diag_physics % sfc_emiss % array(i)
@@ -309,7 +309,7 @@
diag_physics % qgh % array(i) = qgh_p(i,j)
diag_physics % qsfc % array(i) = qsfc_p(i,j)
diag_physics % qz0 % array(i) = qz0_p(i,j)
- diag_physics % rib % array(i) = rib_p(i,j)
+ diag_physics % br % array(i) = br_p(i,j)
diag_physics % sfc_albedo % array(i) = sfc_albedo_p(i,j)
diag_physics % sfc_emibck % array(i) = sfc_emibck_p(i,j)
diag_physics % sfc_emiss % array(i) = sfc_emiss_p(i,j)
@@ -405,7 +405,46 @@
lsm_select: select case (trim(lsm_scheme))
case("noah")
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
call lsm( &
+ dz8w = dz_p , p8w3d = pres2_hyd_p , t3d = t_p , &
+ qv3d = qv_p , xland = xland_p , xice = xice_p , &
+ ivgtyp = ivgtyp_p , isltyp = isltyp_p , tmn = tmn_p , &
+ vegfra = vegfra_p , shdmin = shdmin_p , shdmax = shdmax_p , &
+ snoalb = snoalb_p , glw = glw_p , gsw = gsw_p , &
+ swdown = swdown_p , rainbl = rainbl_p , embck = sfc_emibck_p , &
+ sr = sr_p , qgh = qgh_p , cpm = cpm_p , &
+ qz0 = qz0_p , tsk = tsk_p , hfx = hfx_p , &
+ qfx = qfx_p , lh = lh_p , grdflx = grdflx_p , &
+ qsfc = qsfc_p , cqs2 = cqs2_p , chs = chs_p , &
+ chs2 = chs2_p , snow = snow_p , snowc = snowc_p , &
+ snowh = snowh_p , canwat = canwat_p , smstav = smstav_p , &
+ smstot = smstot_p , sfcrunoff = sfcrunoff_p , udrunoff = udrunoff_p , &
+ acsnom = acsnom_p , acsnow = acsnow_p , snotime = snotime_p , &
+ snopcx = snopcx_p , emiss = sfc_emiss_p , rib = br_p , &
+ potevp = potevp_p , albedo = sfc_albedo_p , albbck = sfc_albbck_p , &
+ z0 = z0_p , znt = znt_p , lai = lai_p , &
+ noahres = noahres_p , chklowq = chklowq_p , sh2o = sh2o_p , &
+ smois = smois_p , tslb = tslb_p , smcrel = smcrel_p , &
+ dzs = dzs_p , isurban = isurban , isice = isice , &
+ rovcp = rcp , dt = dt_pbl , myj = myj , &
+ itimestep = itimestep , frpcpn = frpcpn , rdlai2d = rdlai2d , &
+ xice_threshold = xice_threshold , &
+ usemonalb = config_sfc_albedo , &
+ mminlu = input_landuse_data , &
+ num_soil_layers = num_soil_layers , &
+ num_roof_layers = num_soil_layers , &
+ num_wall_layers = num_soil_layers , &
+ num_road_layers = num_soil_layers , &
+ num_urban_layers = num_soil_layers , &
+ sf_urban_physics = sf_urban_physics , &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+#else
+ call lsm( &
dz8w = dz_p , p8w3d = pres2_p , t3d = t_p , &
qv3d = qv_p , xland = xland_p , xice = xice_p , &
ivgtyp = ivgtyp_p , isltyp = isltyp_p , tmn = tmn_p , &
@@ -420,7 +459,7 @@
snowh = snowh_p , canwat = canwat_p , smstav = smstav_p , &
smstot = smstot_p , sfcrunoff = sfcrunoff_p , udrunoff = udrunoff_p , &
acsnom = acsnom_p , acsnow = acsnow_p , snotime = snotime_p , &
- snopcx = snopcx_p , emiss = sfc_emiss_p , rib = rib_p , &
+ snopcx = snopcx_p , emiss = sfc_emiss_p , rib = br_p , &
potevp = potevp_p , albedo = sfc_albedo_p , albbck = sfc_albbck_p , &
z0 = z0_p , znt = znt_p , lai = lai_p , &
noahres = noahres_p , chklowq = chklowq_p , sh2o = sh2o_p , &
@@ -441,6 +480,7 @@
ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
)
+#endif
case default
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_microphysics.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_microphysics.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_microphysics.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -294,6 +294,9 @@
end do
+!... calculate the 10cm radar reflectivity, if needed:
+ if(l_diags) call compute_radar_reflectivity(diag_physics)
+
!... copy updated precipitation from the wrf-physics grid back to the geodesic-dynamics grid:
call precip_to_MPAS(config_bucket_rainnc,diag_physics)
@@ -382,7 +385,8 @@
type(diag_physics_type),intent(inout):: diag_physics
!local variables:
- integer:: i,j
+ integer:: i,j,k
+ real(kind=RKIND):: rho_a
!---------------------------------------------------------------------------------------------
@@ -391,6 +395,14 @@
do j = jts,jte
do i = its,ite
+ !precipitable water:
+ diag_physics % precipw % array(i) = 0._RKIND
+ do k = kts,kte
+ rho_a = rho_p(i,k,j) / (1._RKIND + qv_p(i,k,j))
+ diag_physics % precipw % array(i) = &
+ diag_physics % precipw % array(i) + qv_p(i,k,j) * rho_a * dz_p(i,k,j)
+ enddo
+
!time-step precipitation:
diag_physics % rainncv % array(i) = rainnc_p(i,j)
@@ -438,5 +450,81 @@
end subroutine precip_to_MPAS
!=============================================================================================
+ subroutine compute_radar_reflectivity(diag_physics)
+!=============================================================================================
+
+!inout arguments:
+ type(diag_physics_type),intent(inout):: diag_physics
+
+!local variables:
+ integer:: i,j,k
+ real(kind=RKIND),dimension(:),allocatable:: qv1d,qr1d,qs1d,qg1d,t1d,p1d,dBZ1d
+
+!---------------------------------------------------------------------------------------------
+!write(0,*)
+!write(0,*) '--- enter subroutine COMPUTE_RADAR_REFLECTIVITY:'
+
+ microp_select: select case(microp_scheme)
+
+ case ("kessler")
+ call physics_error_fatal('--- calculation of radar reflectivity is not available' // &
+ 'with kessler cloud microphysics')
+
+ case ("thompson")
+ call physics_error_fatal('--- calculation of radar reflectivity is not available' // &
+ 'with thompson cloud microphysics')
+
+ case ("wsm6")
+
+ if(.not.allocated(p1d) ) allocate(p1d(kts:kte) )
+ if(.not.allocated(t1d) ) allocate(t1d(kts:kte) )
+ if(.not.allocated(qv1d) ) allocate(qv1d(kts:kte) )
+ if(.not.allocated(qr1d) ) allocate(qr1d(kts:kte) )
+ if(.not.allocated(qs1d) ) allocate(qs1d(kts:kte) )
+ if(.not.allocated(qg1d) ) allocate(qg1d(kts:kte) )
+ if(.not.allocated(dBz1d)) allocate(dBZ1d(kts:kte))
+
+ do j = jts,jte
+ do i = its,ite
+ do k = kts,kte
+ p1d(k) = pres_p(i,k,j)
+ t1d(k) = th_p(i,k,j) * pi_p(i,k,j)
+ qv1d(k) = qv_p(i,k,j)
+ qr1d(k) = qr_p(i,k,j)
+ qs1d(k) = qs_p(i,k,j)
+ qg1d(k) = qg_p(i,k,j)
+ dBZ1d(k) = -35._RKIND
+ enddo
+
+ call refl10cm_wsm6(qv1d,qr1d,qs1d,qg1d,t1d,p1d,dBZ1d,kts,kte,i,j)
+
+ do k = kts,kte
+ dBZ1d(k) = max(-35._RKIND,dBZ1d(k))
+! write(0,201) i,k,dBZ1d(k)
+ enddo
+ diag_physics % refl10cm_max % array(i) = maxval(dBZ1d(:))
+! if(diag_physics % refl10cm_max % array(i) .gt. 0.) &
+! write(0,201) j,i,diag_physics % refl10cm_max % array(i)
+ enddo
+ enddo
+
+ if(allocated(p1d) ) deallocate(p1d )
+ if(allocated(t1d) ) deallocate(t1d )
+ if(allocated(qv1d) ) deallocate(qv1d )
+ if(allocated(qr1d) ) deallocate(qr1d )
+ if(allocated(qs1d) ) deallocate(qs1d )
+ if(allocated(qg1d) ) deallocate(qg1d )
+ if(allocated(dBz1d)) deallocate(dBZ1d)
+
+ case default
+
+ end select microp_select
+!write(0,*) '--- end subroutine COMPUTE_RADAR_REFLECTIVITY'
+
+ 201 format(2i6,e15.8)
+
+ end subroutine compute_radar_reflectivity
+
+!=============================================================================================
end module mpas_atmphys_driver_microphysics
!=============================================================================================
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_pbl.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_pbl.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_pbl.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -24,11 +24,14 @@
!from surface-layer model:
if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) )
+ if(.not.allocated(ctopo_p) ) allocate(ctopo_p(ims:ime,jms:jme) )
+ if(.not.allocated(ctopo2_p) ) allocate(ctopo2_p(ims:ime,jms:jme) )
if(.not.allocated(gz1oz0_p) ) allocate(gz1oz0_p(ims:ime,jms:jme) )
if(.not.allocated(hfx_p) ) allocate(hfx_p(ims:ime,jms:jme) )
if(.not.allocated(psih_p) ) allocate(psih_p(ims:ime,jms:jme) )
if(.not.allocated(psim_p) ) allocate(psim_p(ims:ime,jms:jme) )
if(.not.allocated(qfx_p) ) allocate(qfx_p(ims:ime,jms:jme) )
+ if(.not.allocated(regime_p) ) allocate(regime_p(ims:ime,jms:jme) )
if(.not.allocated(u10_p) ) allocate(u10_p(ims:ime,jms:jme) )
if(.not.allocated(ust_p) ) allocate(ust_p(ims:ime,jms:jme) )
if(.not.allocated(v10_p) ) allocate(v10_p(ims:ime,jms:jme) )
@@ -46,6 +49,10 @@
if(.not.allocated(rqvblten_p)) allocate(rqvblten_p(ims:ime,kms:kme,jms:jme) )
if(.not.allocated(rqcblten_p)) allocate(rqcblten_p(ims:ime,kms:kme,jms:jme) )
if(.not.allocated(rqiblten_p)) allocate(rqiblten_p(ims:ime,kms:kme,jms:jme) )
+!temporary for debugging the YSU PBL scheme:
+ if(.not.allocated(kzh_p) ) allocate(kzh_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(kzm_p) ) allocate(kzm_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(kzq_p) ) allocate(kzq_p(ims:ime,kms:kme,jms:jme) )
end subroutine allocate_pbl
@@ -55,11 +62,14 @@
!from surface-layer model:
if(allocated(br_p) ) deallocate(br_p )
+ if(allocated(ctopo_p) ) deallocate(ctopo_p )
+ if(allocated(ctopo2_p) ) deallocate(ctopo2_p )
if(allocated(gz1oz0_p) ) deallocate(gz1oz0_p )
if(allocated(hfx_p) ) deallocate(hfx_p )
if(allocated(psih_p) ) deallocate(psih_p )
if(allocated(psim_p) ) deallocate(psim_p )
if(allocated(qfx_p) ) deallocate(qfx_p )
+ if(allocated(regime_p) ) deallocate(regime_p )
if(allocated(u10_p) ) deallocate(u10_p )
if(allocated(ust_p) ) deallocate(ust_p )
if(allocated(v10_p) ) deallocate(v10_p )
@@ -77,6 +87,10 @@
if(allocated(rqvblten_p)) deallocate(rqvblten_p )
if(allocated(rqcblten_p)) deallocate(rqcblten_p )
if(allocated(rqiblten_p)) deallocate(rqiblten_p )
+!temporary for debugging the YSU PBL scheme:
+ if(allocated(kzh_p) ) deallocate(kzh_p )
+ if(allocated(kzm_p) ) deallocate(kzm_p )
+ if(allocated(kzq_p) ) deallocate(kzq_p )
end subroutine deallocate_pbl
@@ -100,6 +114,7 @@
psim_p(i,j) = diag_physics % psim % array(i)
psih_p(i,j) = diag_physics % psih % array(i)
qfx_p(i,j) = diag_physics % qfx % array(i)
+ regime_p(i,j) = diag_physics % regime % array(i)
u10_p(i,j) = diag_physics % u10 % array(i)
ust_p(i,j) = diag_physics % ust % array(i)
v10_p(i,j) = diag_physics % v10 % array(i)
@@ -108,6 +123,8 @@
xland_p(i,j) = sfc_input % xland % array(i)
!initialization for YSU PBL scheme:
+ ctopo_p(i,j) = 1._RKIND
+ ctopo2_p(i,j) = 1._RKIND
kpbl_p(i,j) = 1
enddo
enddo
@@ -122,9 +139,12 @@
rqvblten_p(i,k,j) = 0.
rqcblten_p(i,k,j) = 0.
rqiblten_p(i,k,j) = 0.
+!temporary for debugging the YSU PBL scheme:
+ kzh_p(i,k,j) = 0._RKIND
+ kzm_p(i,k,j) = 0._RKIND
+ kzq_p(i,k,j) = 0._RKIND
enddo
enddo
-
enddo
end subroutine pbl_from_MPAS
@@ -156,6 +176,10 @@
tend_physics % rqvblten % array(k,i) = rqvblten_p(i,k,j)
tend_physics % rqcblten % array(k,i) = rqcblten_p(i,k,j)
tend_physics % rqiblten % array(k,i) = rqiblten_p(i,k,j)
+!temporary for debugging the YSU PBL scheme:
+ diag_physics % kzh % array(k,i) = kzh_p(i,k,j)
+ diag_physics % kzm % array(k,i) = kzm_p(i,k,j)
+ diag_physics % kzq % array(k,i) = kzq_p(i,k,j)
enddo
enddo
enddo
@@ -182,26 +206,55 @@
pbl_select: select case (trim(pbl_scheme))
case("ysu")
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
call ysu ( &
- u3d = u_p , v3d = v_p , th3d = th_p , &
- t3d = t_p , qv3d = qv_p , qc3d = qc_p , &
- qi3d = qi_p , p3d = pres_p , p3di = pres2_p , &
- pi3d = pi_p , rublten = rublten_p , rvblten = rvblten_p , &
- rthblten = rthblten_p , rqvblten = rqvblten_p , rqcblten = rqcblten_p , &
- rqiblten = rqiblten_p , flag_qi = f_qi , cp = cp , &
- g = g , rovcp = rcp , rd = R_d , &
- rovg = rdg , ep1 = ep_1 , ep2 = ep_2 , &
- karman = karman , xlv = xlv , rv = R_v , &
- dz8w = dz_p , psfc = psfc_p , znt = znt_p , &
+ p3d = pres_hyd_p , p3di = pres2_hyd_p , psfc = psfc_p , &
+ th3d = th_p , t3d = t_p , dz8w = dz_p , &
+ pi3d = pi_p , u3d = u_p , v3d = v_p , &
+ qv3d = qv_p , qc3d = qc_p , qi3d = qi_p , &
+ rublten = rublten_p , rvblten = rvblten_p , rthblten = rthblten_p , &
+ rqvblten = rqvblten_p , rqcblten = rqcblten_p , rqiblten = rqiblten_p , &
+ flag_qi = f_qi , cp = cp , g = g , &
+ rovcp = rcp , rd = R_d , rovg = rdg , &
+ ep1 = ep_1 , ep2 = ep_2 , karman = karman , &
+ xlv = xlv , rv = R_v , znt = znt_p , &
ust = ust_p , hpbl = hpbl_p , psim = psim_p , &
psih = psih_p , xland = xland_p , hfx = hfx_p , &
- qfx = qfx_p , gz1oz0 = gz1oz0_p , wspd = wspd_p , &
- br = br_p , dt = dt_pbl , kpbl2d = kpbl_p , &
- exch_h = exch_p , u10 = u10_p , v10 = v10_p , &
+ qfx = qfx_p , wspd = wspd_p , br = br_p , &
+ dt = dt_pbl , kpbl2d = kpbl_p , exch_h = exch_p , &
+ u10 = u10_p , v10 = v10_p , ctopo = ctopo_p , &
+ ctopo2 = ctopo2_p , regime = regime_p , rho = rho_p , &
+ kzhout = kzh_p , kzmout = kzm_p , kzqout = kzq_p , &
ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
)
+#else
+!... REARRANGED CALL:
+ call ysu ( &
+ p3d = pres_p , p3di = pres2_p , psfc = psfc_p , &
+ th3d = th_p , t3d = t_p , dz8w = dz_p , &
+ pi3d = pi_p , u3d = u_p , v3d = v_p , &
+ qv3d = qv_p , qc3d = qc_p , qi3d = qi_p , &
+ rublten = rublten_p , rvblten = rvblten_p , rthblten = rthblten_p , &
+ rqvblten = rqvblten_p , rqcblten = rqcblten_p , rqiblten = rqiblten_p , &
+ flag_qi = f_qi , cp = cp , g = g , &
+ rovcp = rcp , rd = R_d , rovg = rdg , &
+ ep1 = ep_1 , ep2 = ep_2 , karman = karman , &
+ xlv = xlv , rv = R_v , znt = znt_p , &
+ ust = ust_p , hpbl = hpbl_p , psim = psim_p , &
+ psih = psih_p , xland = xland_p , hfx = hfx_p , &
+ qfx = qfx_p , wspd = wspd_p , br = br_p , &
+ dt = dt_pbl , kpbl2d = kpbl_p , exch_h = exch_p , &
+ u10 = u10_p , v10 = v10_p , ctopo = ctopo_p , &
+ ctopo2 = ctopo2_p , regime = regime_p , rho = rho_p , &
+ kzhout = kzh_p , kzmout = kzm_p , kzqout = kzq_p , &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+#endif
case default
@@ -209,7 +262,7 @@
!copy all arrays back to the MPAS grid:
call pbl_to_MPAS(diag_physics,tend_physics)
- write(0,*) '--- enter subroutine driver_pbl'
+ write(0,*) '--- end subroutine driver_pbl'
end subroutine driver_pbl
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_radiation_lw.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_radiation_lw.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_radiation_lw.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -524,14 +524,42 @@
case ("rrtmg_lw")
write(0,*) '--- enter subroutine rrtmg_lwrad:'
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
call rrtmg_lwrad( &
+ p3d = pres_hyd_p , p8w = pres2_hyd_p , pi3d = pi_p , &
+ t3d = t_p , t8w = t2_p , rho3d = rho_p , &
+ rthratenlw = rthratenlw_p , lwupt = lwupt_p , lwuptc = lwuptc_p , &
+ lwdnt = lwdnt_p , lwdntc = lwdntc_p , lwupb = lwupb_p , &
+ lwupbc = lwupbc_p , lwdnb = lwdnb_p , lwdnbc = lwdnbc_p , &
+ lwcf = lwcf_p , glw = glw_p , olr = olrtoa_p , &
+ emiss = sfc_emiss_p , tsk = tsk_p , dz8w = dz_p , &
+ cldfra3d = cldfrac_p , r = R_d , g = g , &
+ icloud = icloud , warm_rain = warm_rain , f_ice_phy = f_ice , &
+ f_rain_phy = f_rain , xland = xland_p , xice = xice_p , &
+ snow = snow_p , qv3d = qv_p , qc3d = qc_p , &
+ qr3d = qr_p , qi3d = qi_p , qs3d = qs_p , &
+ qg3d = qg_p , f_qv = f_qv , f_qc = f_qc , &
+ f_qr = f_qr , f_qi = f_qi , f_qs = f_qs , &
+ f_qg = f_qg , &
+ !begin optional arguments:
+ !lwupflx = lwupflx_p , lwupflxc = lwupflxc_p , lwdnflx = lwdnflx_p , &
+ !lwdnflxc = lwdnflxc_p , &
+ !end optional arguments.
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+#else
+!... REARRANGED CALL:
+ call rrtmg_lwrad( &
+ p3d = pres_p , p8w = pres2_p , pi3d = pi_p , &
+ t3d = t_p , t8w = t2_p , rho3d = rho_p , &
rthratenlw = rthratenlw_p , lwupt = lwupt_p , lwuptc = lwuptc_p , &
lwdnt = lwdnt_p , lwdntc = lwdntc_p , lwupb = lwupb_p , &
lwupbc = lwupbc_p , lwdnb = lwdnb_p , lwdnbc = lwdnbc_p , &
lwcf = lwcf_p , glw = glw_p , olr = olrtoa_p , &
- emiss = sfc_emiss_p , t3d = t_p , t8w = t2_p , &
- tsk = tsk_p , p3d = pres_p , p8w = pres2_p , &
- pi3d = pi_p , rho3d = rho_p , dz8w = dz_p , &
+ emiss = sfc_emiss_p , tsk = tsk_p , dz8w = dz_p , &
cldfra3d = cldfrac_p , r = R_d , g = g , &
icloud = icloud , warm_rain = warm_rain , f_ice_phy = f_ice , &
f_rain_phy = f_rain , xland = xland_p , xice = xice_p , &
@@ -541,13 +569,39 @@
f_qr = f_qr , f_qi = f_qi , f_qs = f_qs , &
f_qg = f_qg , &
!begin optional arguments:
- !lwupflx = lwupflx_p , lwupflxc = lwupflxc_p , lwdnflx = lwdnflx_p, &
- !lwdnflxc = lwdnflxc_p , &
+ !lwupflx = lwupflx_p , lwupflxc = lwupflxc_p , lwdnflx = lwdnflx_p, &
+ !lwdnflxc = lwdnflxc_p , &
!end optional arguments.
ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
)
+#endif
+!... CALL FROM REVISION 1721:
+! call rrtmg_lwrad( &
+! rthratenlw = rthratenlw_p , lwupt = lwupt_p , lwuptc = lwuptc_p , &
+! lwdnt = lwdnt_p , lwdntc = lwdntc_p , lwupb = lwupb_p , &
+! lwupbc = lwupbc_p , lwdnb = lwdnb_p , lwdnbc = lwdnbc_p , &
+! lwcf = lwcf_p , glw = glw_p , olr = olrtoa_p , &
+! emiss = sfc_emiss_p , t3d = t_p , t8w = t2_p , &
+! tsk = tsk_p , p3d = pres_p , p8w = pres2_p , &
+! pi3d = pi_p , rho3d = rho_p , dz8w = dz_p , &
+! cldfra3d = cldfrac_p , r = R_d , g = g , &
+! icloud = icloud , warm_rain = warm_rain , f_ice_phy = f_ice , &
+! f_rain_phy = f_rain , xland = xland_p , xice = xice_p , &
+! snow = snow_p , qv3d = qv_p , qc3d = qc_p , &
+! qr3d = qr_p , qi3d = qi_p , qs3d = qs_p , &
+! qg3d = qg_p , f_qv = f_qv , f_qc = f_qc , &
+! f_qr = f_qr , f_qi = f_qi , f_qs = f_qs , &
+! f_qg = f_qg , &
+! !begin optional arguments:
+! !lwupflx = lwupflx_p , lwupflxc = lwupflxc_p , lwdnflx = lwdnflx_p, &
+! !lwdnflxc = lwdnflxc_p , &
+! !end optional arguments.
+! ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+! ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
+! its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+! )
write(0,*) '--- exit subroutine rrtmg_lwrad'
case ("cam_lw")
@@ -562,7 +616,12 @@
call mpas_timer_start("camrad")
write(0,*) '--- enter subroutine camrad_lw: doabsems=',doabsems
call mpas_timer_start("camrad")
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
call camrad( dolw = .true. , dosw = .false. , &
+ p_phy = pres_hyd_p , p8w = pres2_hyd_p , &
+ pi_phy = pi_p , t_phy = t_p , &
+ z = zmid_p , dz8w = dz_p , &
rthratenlw = rthratenlw_p , rthratensw = rthratensw_p , &
swupt = swupt_p , swuptc = swuptc_p , &
swdnt = swdnt_p , swdntc = swdntc_p , &
@@ -579,9 +638,56 @@
coszr = coszr_p , albedo = sfc_albedo_p , &
emiss = sfc_emiss_p , tsk = tsk_p , &
xlat = xlat_p , xlong = xlon_p , &
- t_phy = t_p , pi_phy = pi_p , &
+ rho_phy = rho_p , qv3d = qv_p , &
+ qc3d = qc_p , qr3d = qr_p , &
+ qi3d = qi_p , qs3d = qs_p , &
+ qg3d = qg_p , f_qv = f_qv , &
+ f_qc = f_qc , f_qr = f_qr , &
+ f_qi = f_qi , f_qs = f_qs , &
+ f_qg = f_qg , f_ice_phy = f_ice , &
+ f_rain_phy = f_rain , cldfra = cldfrac_p , &
+ xland = xland_p , xice = xice_p , &
+ num_months = num_months , levsiz = num_oznlevels , &
+ pin0 = pin_p , ozmixm = ozmixm_p , &
+ paerlev = num_aerlevels , naer_c = num_aerosols , &
+ m_psp = m_psp_p , m_psn = m_psn_p , &
+ aerosolcp = aerosolcp_p , aerosolcn = aerosolcn_p , &
+ m_hybi0 = m_hybi_p , snow = snow_p , &
+ cam_abs_dim1 = cam_abs_dim1 , cam_abs_dim2 = cam_abs_dim2 , &
+ gmt = gmt , yr = year , &
+ julday = julday , julian = curr_julday , &
+ dt = dt_dyn , xtime = xtime_m , &
+ declin = declin , solcon = solcon , &
+ radt = radt , degrad = degrad , &
+ n_cldadv = 3 , abstot_3d = abstot_p , &
+ absnxt_3d = absnxt_p , emstot_3d = emstot_p , &
+ doabsems = doabsems , &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+#else
+!... REARRANGED CALL:
+ call camrad( dolw = .true. , dosw = .false. , &
p_phy = pres_p , p8w = pres2_p , &
+ pi_phy = pi_p , t_phy = t_p , &
z = zmid_p , dz8w = dz_p , &
+ rthratenlw = rthratenlw_p , rthratensw = rthratensw_p , &
+ swupt = swupt_p , swuptc = swuptc_p , &
+ swdnt = swdnt_p , swdntc = swdntc_p , &
+ lwupt = lwupt_p , lwuptc = lwuptc_p , &
+ lwdnt = lwdnt_p , lwdntc = lwdntc_p , &
+ swupb = swupb_p , swupbc = swupbc_p , &
+ swdnb = swdnb_p , swdnbc = swdnbc_p , &
+ lwupb = lwupb_p , lwupbc = lwupbc_p , &
+ lwdnb = lwdnb_p , lwdnbc = lwdnbc_p , &
+ swcf = swcf_p , lwcf = lwcf_p , &
+ gsw = gsw_p , glw = glw_p , &
+ olr = olrtoa_p , cemiss = cemiss_p , &
+ taucldc = taucldc_p , taucldi = taucldi_p , &
+ coszr = coszr_p , albedo = sfc_albedo_p , &
+ emiss = sfc_emiss_p , tsk = tsk_p , &
+ xlat = xlat_p , xlong = xlon_p , &
rho_phy = rho_p , qv3d = qv_p , &
qc3d = qc_p , qr3d = qr_p , &
qi3d = qi_p , qs3d = qs_p , &
@@ -610,6 +716,56 @@
ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
)
+#endif
+!... CALL FROM REVISION 1721:
+! call camrad( dolw = .true. , dosw = .false. , &
+! rthratenlw = rthratenlw_p , rthratensw = rthratensw_p , &
+! swupt = swupt_p , swuptc = swuptc_p , &
+! swdnt = swdnt_p , swdntc = swdntc_p , &
+! lwupt = lwupt_p , lwuptc = lwuptc_p , &
+! lwdnt = lwdnt_p , lwdntc = lwdntc_p , &
+! swupb = swupb_p , swupbc = swupbc_p , &
+! swdnb = swdnb_p , swdnbc = swdnbc_p , &
+! lwupb = lwupb_p , lwupbc = lwupbc_p , &
+! lwdnb = lwdnb_p , lwdnbc = lwdnbc_p , &
+! swcf = swcf_p , lwcf = lwcf_p , &
+! gsw = gsw_p , glw = glw_p , &
+! olr = olrtoa_p , cemiss = cemiss_p , &
+! taucldc = taucldc_p , taucldi = taucldi_p , &
+! coszr = coszr_p , albedo = sfc_albedo_p , &
+! emiss = sfc_emiss_p , tsk = tsk_p , &
+! xlat = xlat_p , xlong = xlon_p , &
+! t_phy = t_p , pi_phy = pi_p , &
+! p_phy = pres_p , p8w = pres2_p , &
+! z = zmid_p , dz8w = dz_p , &
+! rho_phy = rho_p , qv3d = qv_p , &
+! qc3d = qc_p , qr3d = qr_p , &
+! qi3d = qi_p , qs3d = qs_p , &
+! qg3d = qg_p , f_qv = f_qv , &
+! f_qc = f_qc , f_qr = f_qr , &
+! f_qi = f_qi , f_qs = f_qs , &
+! f_qg = f_qg , f_ice_phy = f_ice , &
+! f_rain_phy = f_rain , cldfra = cldfrac_p , &
+! xland = xland_p , xice = xice_p , &
+! num_months = num_months , levsiz = num_oznlevels , &
+! pin0 = pin_p , ozmixm = ozmixm_p , &
+! paerlev = num_aerlevels , naer_c = num_aerosols , &
+! m_psp = m_psp_p , m_psn = m_psn_p , &
+! aerosolcp = aerosolcp_p , aerosolcn = aerosolcn_p , &
+! m_hybi0 = m_hybi_p , snow = snow_p , &
+! cam_abs_dim1 = cam_abs_dim1 , cam_abs_dim2 = cam_abs_dim2 , &
+! gmt = gmt , yr = year , &
+! julday = julday , julian = curr_julday , &
+! dt = dt_dyn , xtime = xtime_m , &
+! declin = declin , solcon = solcon , &
+! radt = radt , degrad = degrad , &
+! n_cldadv = 3 , abstot_3d = abstot_p , &
+! absnxt_3d = absnxt_p , emstot_3d = emstot_p , &
+! doabsems = doabsems , &
+! ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+! ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
+! its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+! )
call mpas_timer_stop("camrad")
! write(0,*) 'max lwupb =',maxval(lwupb_p(its:ite,jms:jme))
! write(0,*) 'max lwupbc =',maxval(lwupbc_p(its:ite,jms:jme))
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_radiation_sw.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_radiation_sw.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_radiation_sw.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -21,6 +21,14 @@
init_radiation_sw, &
radconst
+!add-ons and modifications to sourcecode:
+! * removed commented out sourcecode left from revision 1721. removed commented out calls to
+! subroutines rrtmg_swrad and camrad.
+! * updated call to subroutine rrtmg_swrad in order to use module_ra_rrtmg_sw.F from WRF 3.4.1
+! instead of WRF 3.2.1. Results are unchanged.
+! Laura D. Fowler (birch.ucar.edu) / 2013-03-13.
+
+
integer,private:: i,j,k,n
contains
@@ -63,6 +71,15 @@
radiation_sw_select: select case (trim(radt_sw_scheme))
case("rrtmg_sw")
+ if(.not.allocated(alswvisdir_p) ) allocate(alswvisdir_p(ims:ime,jms:jme) )
+ if(.not.allocated(alswvisdif_p) ) allocate(alswvisdif_p(ims:ime,jms:jme) )
+ if(.not.allocated(alswnirdir_p) ) allocate(alswnirdir_p(ims:ime,jms:jme) )
+ if(.not.allocated(alswnirdif_p) ) allocate(alswnirdif_p(ims:ime,jms:jme) )
+ if(.not.allocated(swvisdir_p) ) allocate(swvisdir_p(ims:ime,jms:jme) )
+ if(.not.allocated(swvisdif_p) ) allocate(swvisdif_p(ims:ime,jms:jme) )
+ if(.not.allocated(swnirdir_p) ) allocate(swnirdir_p(ims:ime,jms:jme) )
+ if(.not.allocated(swnirdif_p) ) allocate(swnirdif_p(ims:ime,jms:jme) )
+
if(.not.allocated(swdnflx_p) ) allocate(swdnflx_p(ims:ime,kms:kme+1,jms:jme) )
if(.not.allocated(swdnflxc_p) ) allocate(swdnflxc_p(ims:ime,kms:kme+1,jms:jme) )
if(.not.allocated(swupflx_p) ) allocate(swupflx_p(ims:ime,kms:kme+1,jms:jme) )
@@ -146,6 +163,11 @@
radiation_sw_select: select case (trim(radt_sw_scheme))
case("rrtmg_sw")
+ if(allocated(alswvisdir_p) ) deallocate(alswvisdir_p )
+ if(allocated(alswvisdif_p) ) deallocate(alswvisdif_p )
+ if(allocated(alswnirdir_p) ) deallocate(alswnirdir_p )
+ if(allocated(alswnirdif_p) ) deallocate(alswnirdif_p )
+
if(allocated(swdnflx_p) ) deallocate(swdnflx_p )
if(allocated(swdnflxc_p) ) deallocate(swdnflxc_p )
if(allocated(swupflx_p) ) deallocate(swupflx_p )
@@ -497,39 +519,78 @@
case ("rrtmg_sw")
write(0,*) '--- enter subroutine rrtmg_swrad:'
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
call rrtmg_swrad( &
- rthratensw = rthratensw_p , swupt = swupt_p , swuptc = swuptc_p , &
- swdnt = swdnt_p , swdntc = swdntc_p , swupb = swupb_p , &
- swupbc = swupbc_p , swdnb = swdnb_p , swdnbc = swdnbc_p , &
- swcf = swcf_p , gsw = gsw_p , xtime = xtime_m , &
- gmt = gmt , xlat = xlat_p , xlong = xlon_p , &
- radt = radt , degrad = degrad , declin = declin , &
- coszr = coszr_p , julday = julday , solcon = solcon , &
- albedo = sfc_albedo_p , t3d = t_p , t8w = t2_p , &
- tsk = tsk_p , p3d = pres_p , p8w = pres2_p , &
- pi3d = pi_p , rho3d = rho_p , dz8w = dz_p , &
- cldfra3d = cldfrac_p , r = R_d , g = g , &
- icloud = icloud , warm_rain = warm_rain , f_ice_phy = f_ice , &
- f_rain_phy = f_rain , xland = xland_p , xice = xice_p , &
- snow = snow_p , qv3d = qv_p , qc3d = qc_p , &
- qr3d = qr_p , qi3d = qi_p , qs3d = qs_p , &
- qg3d = qg_p , f_qv = f_qv , f_qc = f_qc , &
- f_qr = f_qr , f_qi = f_qi , f_qs = f_qs , &
- f_qg = f_qg , &
+ p3d = pres_hyd_p , p8w = pres2_hyd_p , pi3d = pi_p ,&
+ t3d = t_p , t8w = t2_p , rho3d = rho_p ,&
+ rthratensw = rthratensw_p , swupt = swupt_p , swuptc = swuptc_p ,&
+ swdnt = swdnt_p , swdntc = swdntc_p , swupb = swupb_p ,&
+ swupbc = swupbc_p , swdnb = swdnb_p , swdnbc = swdnbc_p ,&
+ swcf = swcf_p , gsw = gsw_p , xtime = xtime_m ,&
+ gmt = gmt , xlat = xlat_p , xlong = xlon_p ,&
+ radt = radt , degrad = degrad , declin = declin ,&
+ coszr = coszr_p , julday = julday , solcon = solcon ,&
+ albedo = sfc_albedo_p , tsk = tsk_p , dz8w = dz_p ,&
+ cldfra3d = cldfrac_p , r = R_d , g = g ,&
+ icloud = icloud , warm_rain = warm_rain , f_ice_phy = f_ice ,&
+ f_rain_phy = f_rain , xland = xland_p , xice = xice_p ,&
+ snow = snow_p , qv3d = qv_p , qc3d = qc_p ,&
+ qr3d = qr_p , qi3d = qi_p , qs3d = qs_p ,&
+ qg3d = qg_p , sf_surface_physics = sf_surface_physics , &
!begin optional arguments:
- swupflx = swupflx_p , swupflxc = swupflxc_p , swdnflx = swdnflx_p , &
- swdnflxc = swdnflxc_p , &
+ f_qv = f_qv , f_qc = f_qc , f_qr = f_qr ,&
+ f_qi = f_qi , f_qs = f_qs , f_qg = f_qg ,&
+ alswvisdir = alswvisdir_p , alswvisdif = alswvisdif_p , alswnirdir = alswnirdir_p,&
+ alswnirdif = alswnirdif_p , swvisdir = swvisdir_p , swvisdif = swvisdif_p ,&
+ swnirdir = swnirdir_p , swnirdif = swnirdif_p , &
!end optional arguments.
- ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
- ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
- its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde ,&
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme ,&
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
)
+#else
+!... REARRANGED CALL:
+ call rrtmg_swrad( &
+ p3d = pres_p , p8w = pres2_p , pi3d = pi_p ,&
+ t3d = t_p , t8w = t2_p , rho3d = rho_p ,&
+ rthratensw = rthratensw_p , swupt = swupt_p , swuptc = swuptc_p ,&
+ swdnt = swdnt_p , swdntc = swdntc_p , swupb = swupb_p ,&
+ swupbc = swupbc_p , swdnb = swdnb_p , swdnbc = swdnbc_p ,&
+ swcf = swcf_p , gsw = gsw_p , xtime = xtime_m ,&
+ gmt = gmt , xlat = xlat_p , xlong = xlon_p ,&
+ radt = radt , degrad = degrad , declin = declin ,&
+ coszr = coszr_p , julday = julday , solcon = solcon ,&
+ albedo = sfc_albedo_p , tsk = tsk_p , dz8w = dz_p ,&
+ cldfra3d = cldfrac_p , r = R_d , g = g ,&
+ icloud = icloud , warm_rain = warm_rain , f_ice_phy = f_ice ,&
+ f_rain_phy = f_rain , xland = xland_p , xice = xice_p ,&
+ snow = snow_p , qv3d = qv_p , qc3d = qc_p ,&
+ qr3d = qr_p , qi3d = qi_p , qs3d = qs_p ,&
+ qg3d = qg_p , sf_surface_physics = sf_surface_physics , &
+ !begin optional arguments:
+ f_qv = f_qv , f_qc = f_qc , f_qr = f_qr ,&
+ f_qi = f_qi , f_qs = f_qs , f_qg = f_qg ,&
+ alswvisdir = alswvisdir_p , alswvisdif = alswvisdif_p , alswnirdir = alswnirdir_p,&
+ alswnirdif = alswnirdif_p , swvisdir = swvisdir_p , swvisdif = swvisdif_p ,&
+ swnirdir = swnirdir_p , swnirdif = swnirdif_p , &
+ !end optional arguments.
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde ,&
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme ,&
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+#endif
write(0,*) '--- exit subroutine rrtmg_swrad'
case ("cam_sw")
write(0,*) '--- enter subroutine camrad_sw:'
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
call camrad( dolw = .false. , dosw = .true. , &
+ p_phy = pres_hyd_p , p8w = pres2_hyd_p , &
+ pi_phy = pi_p , t_phy = t_p , &
+ z = zmid_p , dz8w = dz_p , &
rthratenlw = rthratenlw_p , rthratensw = rthratensw_p , &
swupt = swupt_p , swuptc = swuptc_p , &
swdnt = swdnt_p , swdntc = swdntc_p , &
@@ -546,9 +607,61 @@
coszr = coszr_p , albedo = sfc_albedo_p , &
emiss = sfc_emiss_p , tsk = tsk_p , &
xlat = xlat_p , xlong = xlon_p , &
- t_phy = t_p , pi_phy = pi_p , &
+ rho_phy = rho_p , qv3d = qv_p , &
+ qc3d = qc_p , qr3d = qr_p , &
+ qi3d = qi_p , qs3d = qs_p , &
+ qg3d = qg_p , f_qv = f_qv , &
+ f_qc = f_qc , f_qr = f_qr , &
+ f_qi = f_qi , f_qs = f_qs , &
+ f_qg = f_qg , f_ice_phy = f_ice , &
+ f_rain_phy = f_rain , cldfra = cldfrac_p , &
+ xland = xland_p , xice = xice_p , &
+ num_months = num_months , levsiz = num_oznlevels , &
+ pin0 = pin_p , ozmixm = ozmixm_p , &
+ paerlev = num_aerlevels , naer_c = num_aerosols , &
+ m_psp = m_psp_p , m_psn = m_psn_p , &
+ aerosolcp = aerosolcp_p , aerosolcn = aerosolcn_p , &
+ m_hybi0 = m_hybi_p , snow = snow_p , &
+ cam_abs_dim1 = cam_abs_dim1 , cam_abs_dim2 = cam_abs_dim2 , &
+ gmt = gmt , yr = year , &
+ julday = julday , julian = curr_julday , &
+ dt = dt_dyn , xtime = xtime_m , &
+ declin = declin , solcon = solcon , &
+ radt = radt , degrad = degrad , &
+ n_cldadv = 3 , abstot_3d = abstot_p , &
+ absnxt_3d = absnxt_p , emstot_3d = emstot_p , &
+ doabsems = doabsems , &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+! do j = jts,jte
+! do i = its,ite
+! write(0,200) j,i,swdnt_p(i,j),swdnb_p(i,j),swupt_p(i,j),swupb_p(i,j)
+! enddo
+! enddo
+#else
+!... REARRANGED CALL:
+ call camrad( dolw = .false. , dosw = .true. , &
p_phy = pres_p , p8w = pres2_p , &
+ pi_phy = pi_p , t_phy = t_p , &
z = zmid_p , dz8w = dz_p , &
+ rthratenlw = rthratenlw_p , rthratensw = rthratensw_p , &
+ swupt = swupt_p , swuptc = swuptc_p , &
+ swdnt = swdnt_p , swdntc = swdntc_p , &
+ lwupt = lwupt_p , lwuptc = lwuptc_p , &
+ lwdnt = lwdnt_p , lwdntc = lwdntc_p , &
+ swupb = swupb_p , swupbc = swupbc_p , &
+ swdnb = swdnb_p , swdnbc = swdnbc_p , &
+ lwupb = lwupb_p , lwupbc = lwupbc_p , &
+ lwdnb = lwdnb_p , lwdnbc = lwdnbc_p , &
+ swcf = swcf_p , lwcf = lwcf_p , &
+ gsw = gsw_p , glw = glw_p , &
+ olr = olrtoa_p , cemiss = cemiss_p , &
+ taucldc = taucldc_p , taucldi = taucldi_p , &
+ coszr = coszr_p , albedo = sfc_albedo_p , &
+ emiss = sfc_emiss_p , tsk = tsk_p , &
+ xlat = xlat_p , xlong = xlon_p , &
rho_phy = rho_p , qv3d = qv_p , &
qc3d = qc_p , qr3d = qr_p , &
qi3d = qi_p , qs3d = qs_p , &
@@ -577,6 +690,7 @@
ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
)
+#endif
! write(0,*) 'doabsems =',doabsems
! write(0,*) 'max swupb =',maxval(swupb_p(its:ite,jms:jme))
! write(0,*) 'max swupbc =',maxval(swupbc_p(its:ite,jms:jme))
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_sfclayer.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_sfclayer.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_driver_sfclayer.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,4 +1,4 @@
-!=============================================================================================
+!==================================================================================================
module mpas_atmphys_driver_sfclayer
use mpas_grid_types
@@ -17,15 +17,17 @@
integer,parameter,private:: isfflx = 1 !=1 for surface heat and moisture fluxes.
integer,parameter,private:: isftcflx = 0 !=0,(Charnock and Carlson-Boland).
- integer,parameter,private:: iz0tlnd = 0 !=0,(Carlson-Boland)
+ integer,parameter,private:: iz0tlnd = 0 !=0,(Carlson-Boland).
+ integer,parameter,private:: scm_force_flux = 0 !SCM surface forcing by surface fluxes.
+ !0=no 1=yes (WRF single column model option only).
integer,private:: i,j
contains
-!=============================================================================================
+!==================================================================================================
subroutine allocate_sfclayer
-!=============================================================================================
+!==================================================================================================
if(.not.allocated(area_p) ) allocate(area_p(ims:ime,jms:jme) )
if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) )
@@ -33,13 +35,15 @@
if(.not.allocated(cda_p) ) allocate(cda_p(ims:ime,jms:jme) )
if(.not.allocated(chs_p) ) allocate(chs_p(ims:ime,jms:jme) )
if(.not.allocated(chs2_p) ) allocate(chs2_p(ims:ime,jms:jme) )
+ if(.not.allocated(ck_p) ) allocate(ck_p(ims:ime,jms:jme) )
+ if(.not.allocated(cka_p) ) allocate(cka_p(ims:ime,jms:jme) )
if(.not.allocated(cpm_p) ) allocate(cpm_p(ims:ime,jms:jme) )
if(.not.allocated(cqs2_p) ) allocate(cqs2_p(ims:ime,jms:jme) )
- if(.not.allocated(ck_p) ) allocate(ck_p(ims:ime,jms:jme) )
- if(.not.allocated(cka_p) ) allocate(cka_p(ims:ime,jms:jme) )
if(.not.allocated(gz1oz0_p) ) allocate(gz1oz0_p(ims:ime,jms:jme) )
if(.not.allocated(flhc_p) ) allocate(flhc_p(ims:ime,jms:jme) )
if(.not.allocated(flqc_p) ) allocate(flqc_p(ims:ime,jms:jme) )
+ if(.not.allocated(fh_p) ) allocate(fh_p(ims:ime,jms:jme) )
+ if(.not.allocated(fm_p) ) allocate(fm_p(ims:ime,jms:jme) )
if(.not.allocated(hfx_p) ) allocate(hfx_p(ims:ime,jms:jme) )
if(.not.allocated(hpbl_p) ) allocate(hpbl_p(ims:ime,jms:jme) )
if(.not.allocated(lh_p) ) allocate(lh_p(ims:ime,jms:jme) )
@@ -67,9 +71,9 @@
end subroutine allocate_sfclayer
-!=============================================================================================
+!==================================================================================================
subroutine deallocate_sfclayer
-!=============================================================================================
+!==================================================================================================
if(allocated(area_p) ) deallocate(area_p )
if(allocated(br_p) ) deallocate(br_p )
@@ -77,13 +81,15 @@
if(allocated(cda_p) ) deallocate(cda_p )
if(allocated(chs_p) ) deallocate(chs_p )
if(allocated(chs2_p) ) deallocate(chs2_p )
+ if(allocated(ck_p) ) deallocate(ck_p )
+ if(allocated(cka_p) ) deallocate(cka_p )
if(allocated(cpm_p) ) deallocate(cpm_p )
if(allocated(cqs2_p) ) deallocate(cqs2_p )
- if(allocated(ck_p) ) deallocate(ck_p )
- if(allocated(cka_p) ) deallocate(cka_p )
if(allocated(gz1oz0_p) ) deallocate(gz1oz0_p )
if(allocated(flhc_p) ) deallocate(flhc_p )
if(allocated(flqc_p) ) deallocate(flqc_p )
+ if(allocated(fh_p) ) deallocate(fh_p )
+ if(allocated(fm_p) ) deallocate(fm_p )
if(allocated(hfx_p) ) deallocate(hfx_p )
if(allocated(hpbl_p) ) deallocate(hpbl_p )
if(allocated(lh_p) ) deallocate(lh_p )
@@ -111,16 +117,16 @@
end subroutine deallocate_sfclayer
-!=============================================================================================
+!==================================================================================================
subroutine sfclayer_from_MPAS(mesh,diag_physics,sfc_input)
-!=============================================================================================
+!==================================================================================================
!input arguments:
type(mesh_type),intent(in):: mesh
type(sfc_input_type),intent(in):: sfc_input
type(diag_physics_type),intent(inout):: diag_physics
-!---------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
do j = jts,jte
do i = its,ite
@@ -131,64 +137,59 @@
tsk_p(i,j) = sfc_input % skintemp % array(i)
xland_p(i,j) = sfc_input % xland % array(i)
!inout variables:
+ br_p(i,j) = diag_physics % br % array(i)
+ cpm_p(i,j) = diag_physics % cpm % array(i)
+ chs_p(i,j) = diag_physics % chs % array(i)
+ chs2_p(i,j) = diag_physics % chs2 % array(i)
+ cqs2_p(i,j) = diag_physics % cqs2 % array(i)
+ fh_p(i,j) = diag_physics % fh % array(i)
+ fm_p(i,j) = diag_physics % fm % array(i)
+ flhc_p(i,j) = diag_physics % flhc % array(i)
+ flqc_p(i,j) = diag_physics % flqc % array(i)
+ gz1oz0_p(i,j) = diag_physics % gz1oz0 % array(i)
hfx_p(i,j) = diag_physics % hfx % array(i)
qfx_p(i,j) = diag_physics % qfx % array(i)
+ qgh_p(i,j) = diag_physics % qgh % array(i)
qsfc_p(i,j) = diag_physics % qsfc % array(i)
+ lh_p(i,j) = diag_physics % lh % array(i)
mol_p(i,j) = diag_physics % mol % array(i)
+ psim_p(i,j) = diag_physics % psim % array(i)
+ psih_p(i,j) = diag_physics % psih % array(i)
+ regime_p(i,j) = diag_physics % regime % array(i)
+ rmol_p(i,j) = diag_physics % rmol % array(i)
ust_p(i,j) = diag_physics % ust % array(i)
- ustm_p(i,j) = diag_physics % ustm % array(i)
+ wspd_p(i,j) = diag_physics % wspd % array(i)
znt_p(i,j) = diag_physics % znt % array(i)
zol_p(i,j) = diag_physics % zol % array(i)
!output variables:
- br_p(i,j) = 0.
- cpm_p(i,j) = cp
- cd_p(i,j) = 0.
- cda_p(i,j) = 0.
- chs_p(i,j) = 0.
- chs2_p(i,j) = 0.
- ck_p(i,j) = 0.
- cka_p(i,j) = 0.
- cqs2_p(i,j) = 0.
- flhc_p(i,j) = 0.
- flqc_p(i,j) = 0.
- gz1oz0_p(i,j) = 0.
- lh_p(i,j) = 0.
- psim_p(i,j) = 0.
- psih_p(i,j) = 0.
- qgh_p(i,j) = 0.
- regime_p(i,j) = 0.
- rmol_p(i,j) = 0.
- wspd_p(i,j) = 0.
- q2_p(i,j) = 0.
- t2m_p(i,j) = 0.
- th2m_p(i,j) = 0.
- u10_p(i,j) = 0.
- v10_p(i,j) = 0.
+ q2_p(i,j) = 0._RKIND
+ t2m_p(i,j) = 0._RKIND
+ th2m_p(i,j) = 0._RKIND
+ u10_p(i,j) = 0._RKIND
+ v10_p(i,j) = 0._RKIND
enddo
enddo
end subroutine sfclayer_from_MPAS
-!=============================================================================================
+!==================================================================================================
subroutine sfclayer_to_MPAS(diag_physics)
-!=============================================================================================
+!==================================================================================================
!inout arguments:
type(diag_physics_type),intent(inout):: diag_physics
-!---------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
do j = jts,jte
do i = its,ite
diag_physics % br % array(i) = br_p(i,j)
diag_physics % cpm % array(i) = cpm_p(i,j)
- diag_physics % cd % array(i) = cd_p(i,j)
- diag_physics % cda % array(i) = cda_p(i,j)
diag_physics % chs % array(i) = chs_p(i,j)
diag_physics % chs2 % array(i) = chs2_p(i,j)
- diag_physics % ck % array(i) = ck_p(i,j)
- diag_physics % cka % array(i) = cka_p(i,j)
diag_physics % cqs2 % array(i) = cqs2_p(i,j)
+ diag_physics % fh % array(i) = fh_p(i,j)
+ diag_physics % fm % array(i) = fm_p(i,j)
diag_physics % flhc % array(i) = flhc_p(i,j)
diag_physics % flqc % array(i) = flqc_p(i,j)
diag_physics % gz1oz0 % array(i) = gz1oz0_p(i,j)
@@ -203,7 +204,6 @@
diag_physics % regime % array(i) = regime_p(i,j)
diag_physics % rmol % array(i) = rmol_p(i,j)
diag_physics % ust % array(i) = ust_p(i,j)
- diag_physics % ustm % array(i) = ustm_p(i,j)
diag_physics % wspd % array(i) = wspd_p(i,j)
diag_physics % zol % array(i) = zol_p(i,j)
diag_physics % znt % array(i) = znt_p(i,j)
@@ -218,14 +218,14 @@
end subroutine sfclayer_to_MPAS
-!=============================================================================================
+!==================================================================================================
subroutine init_sfclayer
-!=============================================================================================
+!==================================================================================================
!local variables:
logical:: allowed_to_read
-!---------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
write(0,*)
write(0,*) '--- enter sfclayer_initialization:'
sfclayer_select: select case (trim(sfclayer_scheme))
@@ -242,9 +242,9 @@
end subroutine init_sfclayer
-!=============================================================================================
+!==================================================================================================
subroutine driver_sfclayer(mesh,diag_physics,sfc_input)
-!=============================================================================================
+!==================================================================================================
!input and inout arguments:
!--------------------------
@@ -256,7 +256,7 @@
!----------------
real(kind=RKIND):: dx
-!---------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
write(0,*)
write(0,*) '--- enter subroutine driver_sfclayer:'
@@ -267,32 +267,67 @@
case("monin_obukhov")
dx = sqrt(maxval(mesh % areaCell % array))
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
call sfclay( &
- u3d = u_p , v3d = v_p , t3d = t_p , &
- qv3d = qv_p , p3d = pres_p , dz8w = dz_p , &
- cp = cp , g = g , rovcp = rcp , &
- R = R_d , xlv = xlv , psfc = psfc_p , &
- chs = chs_p , chs2 = chs2_p , cqs2 = cqs2_p , &
- cpm = cpm_p , znt = znt_p , ust = ust_p , &
- pblh = hpbl_p , mavail = mavail_p , zol = zol_p , &
- mol = mol_p , regime = regime_p , psim = psim_p , &
- psih = psih_p , xland = xland_p , hfx = hfx_p , &
- qfx = qfx_p , lh = lh_p , tsk = tsk_p , &
- flhc = flhc_p , flqc = flqc_p , qgh = qgh_p , &
- qsfc = qsfc_p , rmol = rmol_p , u10 = u10_p , &
- v10 = v10_p , th2 = th2m_p , t2 = t2m_p , &
- q2 = q2_p , gz1oz0 = gz1oz0_p , wspd = wspd_p , &
- br = br_p , isfflx = isfflx , dx = dx , &
- svp1 = svp1 , svp2 = svp2 , svp3 = svp3 , &
- svpt0 = svpt0 , ep1 = ep_1 , ep2 = ep_2 , &
- karman = karman , eomeg = eomeg , stbolt = stbolt , &
- P1000mb = P0 , ustm = ustm_p , ck = ck_p , &
- cka = cka_p , cd = cd_p , cda = cda_p , &
- isftcflx = isftcflx , iz0tlnd = iz0tlnd , areaCell = area_p , &
+ p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , &
+ u3d = u_p , v3d = v_p , qv3d = qv_p , &
+ dz8w = dz_p , cp = cp , g = g , &
+ rovcp = rcp , R = R_d , xlv = xlv , &
+ chs = chs_p , chs2 = chs2_p , cqs2 = cqs2_p , &
+ cpm = cpm_p , znt = znt_p , ust = ust_p , &
+ pblh = hpbl_p , mavail = mavail_p , zol = zol_p , &
+ mol = mol_p , regime = regime_p , psim = psim_p , &
+ psih = psih_p , fm = fm_p , fh = fh_p , &
+ xland = xland_p , hfx = hfx_p , qfx = qfx_p , &
+ lh = lh_p , tsk = tsk_p , flhc = flhc_p , &
+ flqc = flqc_p , qgh = qgh_p , qsfc = qsfc_p , &
+ rmol = rmol_p , u10 = u10_p , v10 = v10_p , &
+ th2 = th2m_p , t2 = t2m_p , q2 = q2_p , &
+ gz1oz0 = gz1oz0_p , wspd = wspd_p , br = br_p , &
+ isfflx = isfflx , dx = dx , svp1 = svp1 , &
+ svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , &
+ ep1 = ep_1 , ep2 = ep_2 , karman = karman , &
+ eomeg = eomeg , stbolt = stbolt , P1000mb = P0 , &
+ areaCell = area_p , ustm = ustm_p , ck = ck_p , &
+ cka = cka_p , cd = cd_p , cda = cda_p , &
+ isftcflx = isftcflx , iz0tlnd = iz0tlnd , &
+ scm_force_flux = scm_force_flux , &
ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
)
+#else
+!... REARRANGED CALL:
+ call sfclay( &
+ p3d = pres_p , psfc = psfc_p , t3d = t_p , &
+ u3d = u_p , v3d = v_p , qv3d = qv_p , &
+ dz8w = dz_p , cp = cp , g = g , &
+ rovcp = rcp , R = R_d , xlv = xlv , &
+ chs = chs_p , chs2 = chs2_p , cqs2 = cqs2_p , &
+ cpm = cpm_p , znt = znt_p , ust = ust_p , &
+ pblh = hpbl_p , mavail = mavail_p , zol = zol_p , &
+ mol = mol_p , regime = regime_p , psim = psim_p , &
+ psih = psih_p , fm = fm_p , fh = fh_p , &
+ xland = xland_p , hfx = hfx_p , qfx = qfx_p , &
+ lh = lh_p , tsk = tsk_p , flhc = flhc_p , &
+ flqc = flqc_p , qgh = qgh_p , qsfc = qsfc_p , &
+ rmol = rmol_p , u10 = u10_p , v10 = v10_p , &
+ th2 = th2m_p , t2 = t2m_p , q2 = q2_p , &
+ gz1oz0 = gz1oz0_p , wspd = wspd_p , br = br_p , &
+ isfflx = isfflx , dx = dx , svp1 = svp1 , &
+ svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , &
+ ep1 = ep_1 , ep2 = ep_2 , karman = karman , &
+ eomeg = eomeg , stbolt = stbolt , P1000mb = P0 , &
+ areaCell = area_p , ustm = ustm_p , ck = ck_p , &
+ cka = cka_p , cd = cd_p , cda = cda_p , &
+ isftcflx = isftcflx , iz0tlnd = iz0tlnd , &
+ scm_force_flux = scm_force_flux , &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+#endif
case default
@@ -305,6 +340,6 @@
end subroutine driver_sfclayer
-!=============================================================================================
+!==================================================================================================
end module mpas_atmphys_driver_sfclayer
-!=============================================================================================
+!==================================================================================================
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_initialize_real.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_initialize_real.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_initialize_real.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,4 +1,4 @@
-!=============================================================================================
+!==================================================================================================
module mpas_atmphys_initialize_real
use mpas_kind_types
use mpas_configure, only: config_met_prefix, &
@@ -7,11 +7,9 @@
config_nsoillevels, &
config_start_time, &
config_sfc_prefix
+ use mpas_dmpar
use mpas_grid_types
- use init_atm_hinterp
- use init_atm_llxy
- use init_atm_read_met
-
+ use mpas_init_atm_surface
use mpas_atmphys_date_time
use mpas_atmphys_utilities
@@ -21,140 +19,17 @@
contains
-!=============================================================================================
- subroutine physics_initialize_sst(mesh,fg)
-!=============================================================================================
-
+!==================================================================================================
+ subroutine physics_initialize_real(mesh,fg,dminfo)
+!==================================================================================================
!input arguments:
- type(mesh_type),intent(in) :: mesh
+ type(mesh_type),intent(in):: mesh
+ type(dm_info),intent(in) :: dminfo
!inout arguments:
type(fg_type),intent(inout):: fg
!local variables:
- character(len=StrKIND):: timeString
- integer:: i,j,iCell,istatus
- integer,dimension(5) :: interp_list
-
- type(met_data) :: field
- type(proj_info):: proj
-
- real(kind=RKIND):: lat, lon, x, y
- real(kind=RKIND),allocatable,dimension(:,:):: slab_r8
-
-!---------------------------------------------------------------------------------------------
-
- write(0,*) '--- enter subroutine physics_initialize_sst:'
-
-!set interpolation sequence to be used for SST/SEAICE field:
- interp_list(1) = FOUR_POINT
- interp_list(2) = SEARCH
- interp_list(3) = 0
-
-!open intermediate file:
- call read_met_init(trim(config_sfc_prefix),.false.,config_start_time(1:13),istatus)
- if(istatus /= 0) &
- write(0,*) 'Error reading ',trim(config_sfc_prefix)//':'//config_start_time(1:13)
- write(0,*) 'Processing ',trim(config_sfc_prefix)//':'//config_start_time(1:13)
-
-!scan through all the fields in the file:
- call read_next_met_field(field,istatus)
- do while (istatus == 0)
-
- !initialization of the sea-surface temperature (SST) and sea-ice fraction (XICE) arrays,
- !prior to reading the input data:
- fg % sst % array (1:mesh%nCells) = 0.0_RKIND
- fg % xice % array (1:mesh%nCells) = 0.0_RKIND
-
- if(index(field % field,'SKINTEMP') /= 0 .or. &
- index(field % field,'SST' ) /= 0 .or. &
- index(field % field,'SEAICE' ) /= 0 ) then
-
- !Interpolation routines use real(kind=RKIND), so copy from default real array
- allocate(slab_r8(field % nx, field % ny))
- do j=1,field % ny
- do i=1,field % nx
- slab_r8(i,j) = field % slab(i,j)
- end do
- end do
-
- !
- !Set up map projection
- !
- call map_init(proj)
-
- if(field % iproj == PROJ_LATLON) then
- call map_set(PROJ_LATLON, proj, &
- latinc = real(field % deltalat,RKIND), &
- loninc = real(field % deltalon,RKIND), &
- knowni = 1.0_RKIND, &
- knownj = 1.0_RKIND, &
- lat1 = real(field % startlat,RKIND), &
- lon1 = real(field % startlon,RKIND))
- else if (field % iproj == PROJ_GAUSS) then
- call map_set(PROJ_GAUSS, proj, &
- nlat = nint(field % deltalat), &
- loninc = real(field % deltalon,RKIND), &
- lat1 = real(field % startlat,RKIND), &
- lon1 = real(field % startlon,RKIND))
-! nxmax = nint(360.0 / field % deltalon), &
- else if (field % iproj == PROJ_PS) then
- call map_set(PROJ_PS, proj, &
- dx = real(field % dx,RKIND), &
- truelat1 = real(field % truelat1,RKIND), &
- stdlon = real(field % xlonc,RKIND), &
- knowni = real(field % nx / 2.0,RKIND), &
- knownj = real(field % ny / 2.0,RKIND), &
- lat1 = real(field % startlat,RKIND), &
- lon1 = real(field % startlon,RKIND))
- end if
-
- !Interpolate field to each MPAS grid cell:
- do iCell=1,mesh % nCells
- lat = mesh % latCell % array(iCell) * DEG_PER_RAD
- lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
- call latlon_to_ij(proj, lat, lon, x, y)
- if (y < 0.5) then
- y = 1.0
- else if (y >= real(field%ny)+0.5) then
- y = real(field % ny)
- endif
- if (x < 0.5) then
- lon = lon + 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- else if (x >= real(field%nx)+0.5) then
- lon = lon - 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- end if
-
- if(index(field % field,'SST') /= 0) then
- fg % sst % array(iCell) = interp_sequence(x,y,1,slab_r8,1,field%nx, &
- 1,field%ny,1,1,-1.e30_RKIND,interp_list,1)
- elseif(index(field % field,'SEAICE') /= 0) then
- fg % xice % array(iCell) = interp_sequence(x,y,1,slab_r8,1,field%nx, &
- 1,field%ny,1,1,-1.e30_RKIND,interp_list,1)
- endif
- end do
-
- deallocate(slab_r8)
- deallocate(field % slab)
-! exit
- end if
- call read_next_met_field(field,istatus)
- enddo
-
- end subroutine physics_initialize_sst
-
-!=============================================================================================
- subroutine physics_initialize_real(mesh,fg)
-!=============================================================================================
-!input arguments:
- type(mesh_type),intent(in) :: mesh
-
-!inout arguments:
- type(fg_type),intent(inout):: fg
-
-!local variables:
character(len=StrKIND):: initial_date
integer:: iCell,nCellsSolve
@@ -171,19 +46,19 @@
real(kind=RKIND),dimension(:),pointer:: skintemp,sst
-!---------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
write(0,*)
write(0,*) '--- enter physics_initialize_real:'
nCellsSolve = mesh % nCellsSolve
- landmask => mesh % landmask % array
- albedo12m => mesh % albedo12m % array
- greenfrac => mesh % greenfrac % array
- shdmin => mesh % shdmin % array
- shdmax => mesh % shdmax % array
- snoalb => mesh % snoalb % array
+ landmask => mesh % landmask % array
+ albedo12m => mesh % albedo12m % array
+ greenfrac => mesh % greenfrac % array
+ shdmin => mesh % shdmin % array
+ shdmax => mesh % shdmax % array
+ snoalb => mesh % snoalb % array
sfc_albbck => fg % sfc_albbck % array
vegfra => fg % vegfra % array
@@ -200,32 +75,9 @@
!input file. calling this subroutine will overwrite the arrays sst and seaice already read
!in the file defined by config_input_name:
if(config_input_sst) then
- call physics_initialize_sst(mesh,fg)
-
- if(maxval(xice(1:nCellsSolve)) == 0._RKIND .and. minval(xice(1:nCellsSolve)) == 0._RKIND) then
- write(0,*)
- write(0,*) "The input file does not contain sea-ice data. We freeze the really cold ocean instead"
- do iCell = 1, nCellsSolve
- if(landmask(iCell).eq.0 .and. sst(iCell).lt.271._RKIND) xice(iCell) = 1._RKIND
- enddo
- endif
- write(0,*) 'max sst =',maxval(fg % sst % array(1:mesh%nCells))
- write(0,*) 'min sst =',minval(fg % sst % array(1:mesh%nCells))
- write(0,*) 'max xice =',maxval(fg % xice % array(1:mesh%nCells))
- write(0,*) 'min xice =',minval(fg % xice % array(1:mesh%nCells))
-
- do iCell = 1, nCellsSolve
- !recalculate the sea-ice flag:
- if(xice(iCell) .gt. 0._RKIND) then
- seaice(iCell) = 1._RKIND
- else
- seaice(iCell) = 0._RKIND
- endif
-
- !set the skin temperature to the sea-surface temperature over the oceans:
- if(landmask(iCell).eq.0 .and. sst(iCell).gt.170._RKIND .and. sst(iCell).lt.400._RKIND) &
- skintemp(iCell) = sst(iCell)
- enddo
+ write(0,*) '--- read sea-surface temperature from auxillary file:'
+ call interp_sfc_to_MPAS(config_start_time(1:13),mesh,fg,dminfo)
+ call physics_init_sst(mesh,fg)
endif
!initialization of the surface background albedo: interpolation of the monthly values to the
@@ -269,10 +121,10 @@
enddo
!initialization of soil layers properties:
- call init_soil_layers(mesh,fg)
+ call init_soil_layers(mesh,fg,dminfo)
-!adjustment of all surface fields for seaice points:
- call init_seaice_points(mesh,fg)
+!initialize seaice points:
+ call physics_init_seaice(mesh,fg)
!define xland over land and ocean:
do iCell = 1, nCellsSolve
@@ -287,17 +139,18 @@
end subroutine physics_initialize_real
-!=============================================================================================
- subroutine init_soil_layers(mesh,fg)
-!=============================================================================================
+!==================================================================================================
+ subroutine init_soil_layers(mesh,fg,dminfo)
+!==================================================================================================
!input arguments:
type(mesh_type),intent(in):: mesh
+ type(dm_info),intent(in) :: dminfo
!inout arguments:
type(fg_type),intent(inout):: fg
-!---------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
!adjust the annual mean deep soil temperature:
call adjust_input_soiltemps(mesh,fg)
@@ -306,13 +159,13 @@
call init_soil_layers_depth(mesh,fg)
!initialize the temperature, moisture, and liquid water of the individual soil layers:
- call init_soil_layers_properties(mesh,fg)
+ call init_soil_layers_properties(mesh,fg,dminfo)
end subroutine init_soil_layers
-!=============================================================================================
+!==================================================================================================
subroutine adjust_input_soiltemps(mesh,fg)
-!=============================================================================================
+!==================================================================================================
!input arguments:
type(mesh_type),intent(in) :: mesh
@@ -329,7 +182,7 @@
real(kind=RKIND),dimension(:),pointer :: skintemp,soiltemp,tmn
real(kind=RKIND),dimension(:,:),pointer:: st_fg
-!---------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
nCellsSolve = mesh % nCellsSolve
nFGSoilLevels = mesh % nFGSoilLevels
@@ -347,12 +200,12 @@
if(landmask(iCell) .eq. 1) then
!adjust the annual deep mean soil temperature and skin temperatures over land:
- tmn(iCell) = soiltemp(iCell) - 0.0065 * ter(iCell)
- skintemp(iCell) = skintemp(iCell) - 0.0065 * (ter(iCell)-soilz(iCell))
+ tmn(iCell) = soiltemp(iCell) - 0.0065_RKIND * ter(iCell)
+ skintemp(iCell) = skintemp(iCell) - 0.0065_RKIND * (ter(iCell)-soilz(iCell))
!adjust the soil layer temperatures:
do ifgSoil = 1, nFGSoilLevels
- st_fg(ifgSoil,iCell) = st_fg(ifgSoil,iCell) - 0.0065 * (ter(iCell)-soilz(iCell))
+ st_fg(ifgSoil,iCell) = st_fg(ifgSoil,iCell) - 0.0065_RKIND * (ter(iCell)-soilz(iCell))
enddo
elseif(landmask(iCell) .eq. 0) then
@@ -364,12 +217,12 @@
end subroutine adjust_input_soiltemps
-!=============================================================================================
+!==================================================================================================
subroutine init_soil_layers_depth(mesh,fg)
-!=============================================================================================
+!==================================================================================================
!input arguments:
- type(mesh_type),intent(in) :: mesh
+ type(mesh_type),intent(in):: mesh
!inout arguments:
type(fg_type),intent(inout):: fg
@@ -377,7 +230,7 @@
!local variables:
integer:: iCell,iSoil
-!---------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
write(0,*)
write(0,*) '--- enter subroutine init_soil_layers_depth:'
@@ -388,65 +241,57 @@
do iCell = 1, mesh % nCells
iSoil = 1
- fg % zs_fg % array(iSoil,iCell) = 0.5 * fg % dzs_fg % array(iSoil,iCell)
-! if(iCell .eq. 1) write(0,101) iSoil,fg % dzs_fg % array(iSoil,iCell), &
-! fg % zs_fg % array(iSoil,iCell)
+ fg % zs_fg % array(iSoil,iCell) = 0.5_RKIND * fg % dzs_fg % array(iSoil,iCell)
do iSoil = 2, mesh % nFGSoilLevels
fg % zs_fg % array(iSoil,iCell) = fg % zs_fg % array(iSoil-1,iCell) &
- + 0.5 * fg % dzs_fg % array(iSoil-1,iCell) &
- + 0.5 * fg % dzs_fg % array(iSoil,iCell)
-! if(iCell .eq. 1) write(0,101) iSoil,fg % dzs_fg % array(iSoil,iCell), &
-! fg % zs_fg % array(iSoil,iCell)
+ + 0.5_RKIND * fg % dzs_fg % array(iSoil-1,iCell) &
+ + 0.5_RKIND * fg % dzs_fg % array(iSoil,iCell)
enddo
enddo
- 101 format(i4,2(1x,e15.8))
do iCell = 1, mesh % nCells
- fg % dzs % array(1,iCell) = 0.10
- fg % dzs % array(2,iCell) = 0.30
- fg % dzs % array(3,iCell) = 0.60
- fg % dzs % array(4,iCell) = 1.00
+ fg % dzs % array(1,iCell) = 0.10_RKIND
+ fg % dzs % array(2,iCell) = 0.30_RKIND
+ fg % dzs % array(3,iCell) = 0.60_RKIND
+ fg % dzs % array(4,iCell) = 1.00_RKIND
iSoil = 1
- fg % zs % array(iSoil,iCell) = 0.5 * fg % dzs % array(iSoil,iCell)
-! if(iCell .eq. 1) write(0,101) iSoil,fg % dzs % array(iSoil,iCell), &
-! fg % zs % array(iSoil,iCell)
-
+ fg % zs % array(iSoil,iCell) = 0.5_RKIND * fg % dzs % array(iSoil,iCell)
do iSoil = 2, mesh % nSoilLevels
- fg % zs % array(iSoil,iCell) = fg % zs % array(iSoil-1,iCell) &
- + 0.5 * fg % dzs % array(iSoil-1,iCell) &
- + 0.5 * fg % dzs % array(iSoil,iCell)
-! if(iCell .eq. 1) write(0,101) iSoil,fg % dzs % array(iSoil,iCell), &
-! fg % zs % array(iSoil,iCell)
+ fg % zs % array(iSoil,iCell) = fg % zs % array(iSoil-1,iCell) &
+ + 0.5_RKIND * fg % dzs % array(iSoil-1,iCell) &
+ + 0.5_RKIND * fg % dzs % array(iSoil,iCell)
enddo
enddo
end subroutine init_soil_layers_depth
-!=============================================================================================
- subroutine init_soil_layers_properties(mesh,fg)
-!=============================================================================================
+!==================================================================================================
+ subroutine init_soil_layers_properties(mesh,fg,dminfo)
+!==================================================================================================
!input arguments:
- type(mesh_type),intent(in) :: mesh
+ type(mesh_type),intent(in):: mesh
+ type(dm_info),intent(in) :: dminfo
!inout arguments:
type(fg_type),intent(inout):: fg
!local variables:
- integer:: iCell,ifgSoil,iSoil,is
+ integer:: iCell,ifgSoil,iSoil
integer:: nCells,nFGSoilLevels,nSoilLevels
+ integer:: num_sm,num_st
integer,dimension(:),pointer:: landmask
real(kind=RKIND),dimension(:,:),allocatable:: zhave,sm_input,st_input
real(kind=RKIND),dimension(:),pointer :: skintemp,tmn
- real(kind=RKIND),dimension(:,:),pointer:: dzs,zs,tslb,smois,sh2o
+ real(kind=RKIND),dimension(:,:),pointer:: dzs,zs,tslb,smois,sh2o,smcrel
real(kind=RKIND),dimension(:,:),pointer:: sm_fg,st_fg,zs_fg
-!---------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
!write(0,*)
write(0,*) '--- enter subroutine init_soil_layers_properties:'
@@ -463,14 +308,33 @@
st_fg => fg % st_fg % array
sm_fg => fg % sm_fg % array
- zs => fg % zs % array
- dzs => fg % dzs % array
- sh2o => fg % sh2o % array
- smois => fg % smois % array
- tslb => fg % tslb % array
+ zs => fg % zs % array
+ dzs => fg % dzs % array
+ sh2o => fg % sh2o % array
+ smcrel => fg % smcrel % array
+ smois => fg % smois % array
+ tslb => fg % tslb % array
skintemp => fg % skintemp % array
tmn => fg % tmn % array
+!check that interpolation of the meteorological data to the MPAS grid did not create negative
+!values for the first-guess soil temperatures and soil moistures.
+ num_sm = 0
+ num_st = 0
+ do iCell = 1, nCells
+ do ifgSoil = 1, nFGSoilLevels
+ if(st_fg(ifgSoil,iCell) .le. 0._RKIND) num_st = num_st + 1
+ if(sm_fg(ifgSoil,iCell) .lt. 0._RKIND) num_sm = num_sm + 1
+ enddo
+ enddo
+ if(num_st .gt. 0) then
+ write(0,*) 'Error in interpolation of st_fg to MPAS grid: num_st =', num_st
+ call mpas_dmpar_abort(dminfo)
+ elseif(num_sm .gt. 0) then
+ write(0,*) 'Error in interpolation of sm_fg to MPAS grid: num_sm =', num_sm
+ call mpas_dmpar_abort(dminfo)
+ endif
+
if(config_nsoillevels .ne. 4) &
call physics_error_fatal('NOAH lsm uses 4 soil layers. Correct config_nsoillevels.')
@@ -481,17 +345,17 @@
do iCell = 1, nCells
ifgSoil = 1
- zhave(ifgSoil,iCell) = 0.
+ zhave(ifgSoil,iCell) = 0._RKIND
st_input(ifgSoil,iCell) = skintemp(iCell)
sm_input(ifgSoil,iCell) = sm_fg(ifgSoil+1,iCell)
do ifgSoil = 1, nFGSoilLevels
- zhave(ifgSoil+1,iCell) = zs_fg(ifgSoil,iCell) / 100.
+ zhave(ifgSoil+1,iCell) = zs_fg(ifgSoil,iCell) / 100._RKIND
st_input(ifgSoil+1,iCell) = st_fg(ifgSoil,iCell)
sm_input(ifgSoil+1,iCell) = sm_fg(ifgSoil,iCell)
enddo
- zhave(nFGSoilLevels+2,iCell) = 300./100.
+ zhave(nFGSoilLevels+2,iCell) = 300._RKIND/100._RKIND
st_input(nFGSoilLevels+2,iCell) = tmn(iCell)
sm_input(nFGSoilLevels+2,iCell) = sm_input(nFGSoilLevels,iCell)
@@ -530,7 +394,8 @@
+ sm_input(ifgSoil+1,iCell) * (zs(iSoil,iCell)-zhave(ifgSoil,iCell))) &
/ (zhave(ifgSoil+1,iCell)-zhave(ifgSoil,iCell))
- sh2o(iSoil,iCell) = 0.
+ sh2o(iSoil,iCell) = 0._RKIND
+ smcrel(iSoil,iCell) = 0._RKIND
exit input
endif
@@ -542,9 +407,10 @@
!fill the soil temperatures with the skin temperatures over oceans:
do iSoil = 1, nSoilLevels
- tslb(iSoil,iCell) = skintemp(iCell)
- smois(iSoil,iCell) = 1.0
- sh2o(iSoil,iCell) = 1.0
+ tslb(iSoil,iCell) = skintemp(iCell)
+ smois(iSoil,iCell) = 1._RKIND
+ sh2o(iSoil,iCell) = 1._RKIND
+ smcrel(iSoil,iCell) = 0._RKIND
enddo
endif
@@ -555,10 +421,10 @@
do iCell = 1, nCells
- if(landmask(iCell).eq. 1 .and. tslb(1,iCell).gt.170. .and. tslb(1,iCell).lt.400. .and. &
- smois(1,iCell).lt.0.005) then
+ if(landmask(iCell).eq. 1 .and. tslb(1,iCell).gt.170._RKIND .and. tslb(1,iCell).lt.400._RKIND &
+ .and. smois(1,iCell).lt.0.005_RKIND) then
do iSoil = 1, nSoilLevels
- smois(iSoil,iCell) = 0.005
+ smois(iSoil,iCell) = 0.005_RKIND
enddo
endif
@@ -574,19 +440,78 @@
end subroutine init_soil_layers_properties
-!=============================================================================================
- subroutine init_seaice_points(mesh,fg)
-!=============================================================================================
+!==================================================================================================
+ subroutine physics_init_sst(mesh,input)
+!==================================================================================================
+!input arguments:
+ type(mesh_type),intent(in):: mesh
+
+#if !defined(non_hydrostatic_core)
+!inout arguments: this subroutine is called from the MPAS initialization side.
+ type(fg_type),intent(inout):: input
+#else
+!inout arguments: this subroutine is called from the MPAS model side.
+ type(sfc_input_type),intent(inout):: input
+#endif
+
+!local variables:
+ integer:: iCell,nCells
+ integer,dimension(:),pointer:: landmask
+
+ real(kind=RKIND),dimension(:),pointer :: sst,tsk,xice
+ real(kind=RKIND),dimension(:,:),pointer:: tslb
+
+!--------------------------------------------------------------------------------------------------
+ write(0,*)
+ write(0,*) '--- enter subroutine physics_update_sst:'
+
+!initialization:
+ nCells = mesh % nCells
+
+ landmask => mesh % landmask % array
+ sst => input % sst % array
+ tsk => input % skintemp % array
+ tslb => input % tslb % array
+ xice => input % xice % array
+
+!update the skin temperature and the soil temperature of the first soil layer with the updated
+!sea-surface temperatures:
+!change made so that the SSTs read for the surface update file are the same as the skin temperature
+!over the oceans.
+!do iCell = 1, nCells
+! if(landmask(iCell) == 0 .and. xice(iCell) == 0) then
+! tsk(iCell) = sst(iCell)
+! endif
+!enddo
+ do iCell = 1, nCells
+ if(landmask(iCell) == 0) then
+ tsk(iCell) = sst(iCell)
+ endif
+ enddo
+
+ write(0,*) '--- end subroutine physics_update_sst:'
+
+ end subroutine physics_init_sst
+
+!==================================================================================================
+ subroutine physics_init_seaice(mesh,input)
+!==================================================================================================
+
!input arguments:
type(mesh_type),intent(in) :: mesh
-!inout arguments:
- type(fg_type),intent(inout):: fg
+#if !defined(non_hydrostatic_core)
+!inout arguments: this subroutine is called from the MPAS initialization side.
+ type(fg_type),intent(inout):: input
+#else
+!inout arguments: this subroutine is called from the MPAS model side.
+ type(sfc_input_type),intent(inout):: input
+#endif
!local variables:
character(len=StrKIND):: mess
- integer:: iCell,iSoil,nCellsSolve,nSoilLevels
+ integer:: iCell,iSoil,nCells,nSoilLevels
integer:: num_seaice_changes
integer,dimension(:),pointer:: landmask,isltyp,ivgtyp
@@ -594,8 +519,8 @@
real(kind=RKIND):: mid_point_depth
real(kind=RKIND),dimension(:),pointer :: vegfra
real(kind=RKIND),dimension(:),pointer :: seaice,xice
- real(kind=RKIND),dimension(:),pointer :: skintemp,sst,tmn
- real(kind=RKIND),dimension(:,:),pointer:: tslb,smois,sh2o
+ real(kind=RKIND),dimension(:),pointer :: skintemp,tmn
+ real(kind=RKIND),dimension(:,:),pointer:: tslb,smois,sh2o,smcrel
!note that this threshold is also defined in module_physics_vars.F.It is defined here to avoid
!adding "use module_physics_vars" since this subroutine is only used for the initialization of
@@ -603,85 +528,108 @@
real(kind=RKIND),parameter:: xice_tsk_threshold = 271.
real(kind=RKIND),parameter:: total_depth = 3. ! 3-meter soil depth.
-!---------------------------------------------------------------------------------------------
-
+!--------------------------------------------------------------------------------------------------
write(0,*)
- write(0,*) '--- enter init_seaice_points:'
- write(0,*) '--- config_frac_seaice :', config_frac_seaice
+ write(0,*) '--- enter physics_init_seaice:'
- nCellsSolve = mesh % nCellsSolve
+ nCells = mesh % nCells
nSoilLevels = mesh % nSoilLevels
landmask => mesh % landmask % array
isltyp => mesh % soilcat_top % array
ivgtyp => mesh % lu_index % array
- seaice => fg % seaice % array
- xice => fg % xice % array
- vegfra => fg % vegfra % array
+ seaice => input % seaice % array
+ xice => input % xice % array
+ vegfra => input % vegfra % array
- skintemp => fg % skintemp % array
- sst => fg % sst % array
- tmn => fg % tmn % array
+ skintemp => input % skintemp % array
+ tmn => input % tmn % array
- tslb => fg % tslb % array
- smois => fg % smois % array
- sh2o => fg % sh2o % array
+ tslb => input % tslb % array
+ smois => input % smois % array
+ sh2o => input % sh2o % array
+ smcrel => input % smcrel % array
- if(.not. config_frac_seaice) then
- xice_threshold = 0.5
- elseif(config_frac_seaice) then
- xice_threshold = 0.02
- endif
+ do iCell = 1, nCells
+ seaice(iCell) = 0._RKIND
+ enddo
!make sure that all the cells flagged as sea-ice cells are defined as ocean cells:
num_seaice_changes = 0
- do iCell = 1, nCellsSolve
- if((landmask(iCell).eq.1 .and. xice(iCell).gt.0.) .or. xice(iCell).gt.200.) then
+ do iCell = 1, nCells
+ if((landmask(iCell).eq.1 .and. xice(iCell).gt.0._RKIND) .or. xice(iCell).gt.200._RKIND) then
num_seaice_changes = num_seaice_changes + 1
- seaice(iCell) = 0.
- xice(iCell) = 0.
+ seaice(iCell) = 0._RKIND
+ xice(iCell) = 0._RKIND
endif
enddo
- write(mess,fmt='(A,i12)') 'number of seaice cells converted to land cells=', &
+ write(mess,fmt='(A,i12)') 'number of seaice cells converted to land cells 1 =', &
num_seaice_changes
call physics_message(mess)
+!assign the threshold value for xice as a function of config_frac_seaice:
+ if(.not. config_frac_seaice) then
+ xice_threshold = 0.5_RKIND
+ do iCell = 1,nCells
+ if(xice(iCell) >= xice_threshold) then
+ xice(iCell) = 1._RKIND
+ else
+ xice(iCell) = 0._RKIND
+ endif
+ enddo
+ elseif(config_frac_seaice) then
+ xice_threshold = 0.02
+ endif
+ write(0,*) '--- config_frac_seaice :', config_frac_seaice
+ write(0,*) '--- xice_threshold :', xice_threshold
+
+!convert seaice points to land points:
num_seaice_changes = 0
- do iCell =1 , nCellsSolve
+ do iCell = 1, nCells
if(xice(iCell) .ge. xice_threshold .or. &
- (landmask(iCell).eq.0 .and. skintemp(iCell).lt.xice_tsk_threshold)) then
+ (landmask(iCell).eq.0 .and. skintemp(iCell).lt.xice_tsk_threshold)) then
num_seaice_changes = num_seaice_changes + 1
!sea-ice points are converted to land points:
- if(.not. config_frac_seaice) xice(iCell) = 1.0
- if(landmask(iCell) .eq. 0) tmn(iCell) = 271.4
+ if(.not. config_frac_seaice) xice(iCell) = 1._RKIND
+ if(landmask(iCell) .eq. 0) tmn(iCell) = 271.4_RKIND
ivgtyp(iCell) = 24 ! (isice = 24)
isltyp(iCell) = 16
- vegfra(iCell) = 0.
- landmask(iCell) = 1.
+ vegfra(iCell) = 0._RKIND
+ landmask(iCell) = 1._RKIND
do iSoil = 1, nSoilLevels
mid_point_depth = total_depth/nSoilLevels/2. &
+ (iSoil-1)*(total_depth/nSoilLevels)
tslb(iSoil,iCell) = ((total_depth-mid_point_depth) * skintemp(iCell) &
+ mid_point_depth * tmn(iCell)) / total_depth
- smois(iSoil,iCell) = 1.0
- sh2o(iSoil,iCell) = 0.0
+ smois(iSoil,iCell) = 1._RKIND
+ sh2o(iSoil,iCell) = 0._RKIND
+ smcrel(iSoil,iCell) = 0._RKIND
enddo
elseif(xice(iCell) .lt. xice_threshold) then
- xice(iCell) = 0.
+ xice(iCell) = 0._RKIND
endif
enddo
+ write(mess,fmt='(A,i12)') 'number of seaice cells converted to land cells 2 =', &
+ num_seaice_changes
+ call physics_message(mess)
- end subroutine init_seaice_points
+!finally, update the sea-ice flag:
+ do iCell = 1, nCells
+ if(xice(iCell) > 0._RKIND) seaice(iCell) = 1._RKIND
+ enddo
+ write(0,*) '--- end physics_init_seaice:'
-!=============================================================================================
+ end subroutine physics_init_seaice
+
+!==================================================================================================
end module mpas_atmphys_initialize_real
-!=============================================================================================
+!==================================================================================================
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_interface_nhyd.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_interface_nhyd.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_interface_nhyd.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -54,6 +54,15 @@
if(.not.allocated(qs_p) ) allocate(qs_p(ims:ime,kms:kme,jms:jme) )
if(.not.allocated(qg_p) ) allocate(qg_p(ims:ime,kms:kme,jms:jme) )
+!... arrays used for calculating the hydrostatic pressure and exner function:
+ if(.not.allocated(psfc_hyd_p) ) allocate(psfc_hyd_p(ims:ime,jms:jme) )
+ if(.not.allocated(psfc_hydd_p) ) allocate(psfc_hydd_p(ims:ime,jms:jme) )
+ if(.not.allocated(pres_hyd_p) ) allocate(pres_hyd_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pres_hydd_p) ) allocate(pres_hydd_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pres2_hyd_p) ) allocate(pres2_hyd_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pres2_hydd_p)) allocate(pres2_hydd_p(ims:ime,kms:kme,jms:jme))
+ if(.not.allocated(znu_hyd_p) ) allocate(znu_hyd_p(ims:ime,kms:kme,jms:jme) )
+
end subroutine allocate_forall_physics
!=============================================================================================
@@ -91,10 +100,18 @@
if(allocated(qs_p) ) deallocate(qs_p )
if(allocated(qg_p) ) deallocate(qg_p )
+ if(allocated(psfc_hyd_p) ) deallocate(psfc_hyd_p )
+ if(allocated(psfc_hydd_p) ) deallocate(psfc_hydd_p )
+ if(allocated(pres_hyd_p) ) deallocate(pres_hyd_p )
+ if(allocated(pres_hydd_p) ) deallocate(pres_hydd_p )
+ if(allocated(pres2_hyd_p) ) deallocate(pres2_hyd_p )
+ if(allocated(pres2_hydd_p)) deallocate(pres2_hydd_p)
+ if(allocated(znu_hyd_p) ) deallocate(znu_hyd_p )
+
end subroutine deallocate_forall_physics
!=============================================================================================
- subroutine MPAS_to_physics(mesh,state,diag)
+ subroutine MPAS_to_physics(mesh,state,diag,diag_physics)
!=============================================================================================
!input variables:
@@ -102,6 +119,9 @@
type(state_type),intent(in):: state
type(diag_type) ,intent(in):: diag
+!inout variables:
+ type(diag_physics_type),intent(inout):: diag_physics
+
!local variables:
integer:: i,k,j
real(kind=RKIND):: z0,z1,z2,w1,w2
@@ -114,7 +134,7 @@
real(kind=RKIND),dimension(:,:),pointer:: rho_zz,theta_m,qv,pressure_p,u,v,w
real(kind=RKIND),dimension(:,:),pointer:: qvs,rh
- real(kind=RKIND):: rho1,rho2,tem1,tem2
+ real(kind=RKIND):: rho_a,rho1,rho2,tem1,tem2
!---------------------------------------------------------------------------------------------
@@ -152,18 +172,7 @@
u => diag % uReconstructZonal % array
v => diag % uReconstructMeridional % array
-!ldf (2012-01-06): updates the surface pressure as is done in subroutine microphysics_to_MPAS.
-!do j = jts,jte
-!do i = its,ite
-! sfc_pressure(i) = 0.5*g*(zgrid(2,i)-zgrid(1,i)) &
-! * (1.25 * rho_zz(1,i) * zz(1,i) * (1. + qv(1,i)) &
-! - 0.25 * rho_zz(2,i) * zz(2,i) * (1. + qv(1,i)))
-! sfc_pressure(i) = sfc_pressure(i) + pressure_p(1,i) + pressure_b(1,i)
-!enddo
-!enddo
-!ldf end.
-!ldf (2012-01-09): updates the surface pressure using zgrid.
-!do j = jts,jte
+!calculation of the surface pressure using hydrostatic assumption down to the surface::
do i = its,ite
tem1 = zgrid(2,i)-zgrid(1,i)
tem2 = zgrid(3,i)-zgrid(2,i)
@@ -173,17 +182,15 @@
* (rho1 + 0.5*(rho2-rho1)*tem1/(tem1+tem2))
sfc_pressure(i) = sfc_pressure(i) + pressure_p(1,i) + pressure_b(1,i)
enddo
+
+!arrays located at theta points:
+!do j = jts, jte
+!do i = its, ite
+! psfc_p(i,j) = diag % surface_pressure % array(i)
!enddo
-!ldf end.
+!enddo
-!copy sounding variables from the geodesic grid to the rectangular grid:
do j = jts, jte
- do i = its, ite
- psfc_p(i,j) = diag % surface_pressure % array(i)
- enddo
- enddo
-
- do j = jts, jte
do k = kts, kte
do i = its, ite
@@ -216,6 +223,7 @@
enddo
enddo
+!arrays located at w points:
do j = jts, jte
do k = kts,kte+1
do i = its,ite
@@ -225,38 +233,26 @@
enddo
enddo
+!check that the pressure in the layer above the surface is greater than that in the layer
+!above it:
do j = jts,jte
do i = its,ite
- if(pres_p(i,1,j) .lt. pres_p(i,2,j)) then
+ if(pres_p(i,1,j) .le. pres_p(i,2,j)) then
write(0,*)
- write(0,*) '--- subroutine MPAS_to_phys: pres:',j,i
- write(0,*) 'latCell=', latCell(i)
- write(0,*) 'lonCell=', lonCell(i)
+ write(0,*) '--- subroutine MPAS_to_phys - pressure(1) < pressure(2):'
+ write(0,*) 'i =', i
+ write(0,*) 'latCell=', latCell(i)/degrad
+ write(0,*) 'lonCell=', lonCell(i)/degrad
do k = kts,kte
- write(0,201) j,i,k,pressure_b(k,i),pressure_p(k,i),pres_p(i,k,j),zz(k,i), &
+ write(0,201) j,i,k,dz_p(i,k,j),pressure_b(k,i),pressure_p(k,i),pres_p(i,k,j), &
rho_p(i,k,j),th_p(i,k,j),t_p(i,k,j),qv_p(i,k,j)
enddo
- write(0,*)
- do k = kts,kte
- write(0,201) j,i,k,qv_p(i,k,j),qc_p(i,k,j),qr_p(i,k,j),qi_p(i,k,j),qs_p(i,k,j), &
- qg_p(i,k,j)
- enddo
- write(0,*)
- stop
+! stop
endif
enddo
enddo
!interpolation of pressure and temperature from theta points to w points:
-!do j = jts,jte
-!do k = kts+1,kte
-!do i = its,ite
-! t2_p(i,k,j) = fzm(k)*t_p(i,k,j) + fzp(k)*t_p(i,k-1,j)
-! pres2_p(i,k,j) = fzm(k)*pres_p(i,k,j) + fzp(k)*pres_p(i,k-1,j)
-!enddo
-!enddo
-!enddo
-!ldf(2011-01-10):
do j = jts,jte
do k = kts+1,kte
do i = its,ite
@@ -286,7 +282,8 @@
enddo
enddo
-!interpolation of pressure and temperature from theta points to the surface:
+!ldf (2012-06-22): recalculates the pressure at the surface as an extrapolation of the
+!pressures in the 2 layers above the surface, as was originally done:
k = kts
do j = jts,jte
do i = its,ite
@@ -296,34 +293,45 @@
w1 = (z0-z2)/(z1-z2)
w2 = 1.-w1
t2_p(i,k,j) = w1*t_p(i,k,j)+w2*t_p(i,k+1,j)
- !use surface pressure calculated in subroutine recover_large_step_variables.
- !pres2_p(i,k,j) = w1*pres_p(i,k,j)+w2*pres_p(i,k+1,j)
- pres2_p(i,k,j) = psfc_p(i,j)
+ pres2_p(i,k,j) = w1*pres_p(i,k,j)+w2*pres_p(i,k+1,j)
+ psfc_p(i,j) = pres2_p(i,k,j)
enddo
- enddo
+ enddo
+
+!calculation of the hydrostatic pressure:
do j = jts,jte
do i = its,ite
- if(pres2_p(i,1,j) .lt. pres2_p(i,2,j)) then
- write(0,*)
- write(0,*) '--- subroutine MPAS_to_phys: pres2:',j,i
- do k = kts,kte+1
- write(0,201) j,i,k,pres2_p(i,k,j)
- enddo
-! write(0,*)
-! do k = kts,kte
-! write(0,201) j,i,k,pressure_b(k,i),pressure_p(k,i),pres_p(i,k,j),zz(k,i), &
-! rho_p(i,k,j),th_p(i,k,j),t_p(i,k,j),qv_p(i,k,j)
-! enddo
-! write(0,*)
-! do k = kts,kte
-! write(0,201) j,i,k,qv_p(i,k,j),qc_p(i,k,j),qr_p(i,k,j),qi_p(i,k,j),qs_p(i,k,j), &
-! qg_p(i,k,j)
-! enddo
- stop
- endif
+ !pressure at w-points:
+ k = kte+1
+ pres2_hyd_p(i,k,j) = pres2_p(i,k,j)
+ pres2_hydd_p(i,k,j) = pres2_p(i,k,j)
+ do k = kte,1,-1
+ rho_a = rho_p(i,k,j) / (1.+qv_p(i,k,j))
+ pres2_hyd_p(i,k,j) = pres2_hyd_p(i,k+1,j) + g*rho_p(i,k,j)*dz_p(i,k,j)
+ pres2_hydd_p(i,k,j) = pres2_hydd_p(i,k+1,j) + g*rho_a*dz_p(i,k,j)
+ enddo
+ !pressure at theta-points:
+ do k = kte,1,-1
+ pres_hyd_p(i,k,j) = 0.5*(pres2_hyd_p(i,k+1,j)+pres2_hyd_p(i,k,j))
+ pres_hydd_p(i,k,j) = 0.5*(pres2_hydd_p(i,k+1,j)+pres2_hydd_p(i,k,j))
+ enddo
+ !surface pressure:
+ psfc_hyd_p(i,j) = pres2_hyd_p(i,1,j)
+ psfc_hydd_p(i,j) = pres2_hydd_p(i,1,j)
+ !znu:
+ do k = kte,1,-1
+ znu_hyd_p(i,k,j) = pres_hyd_p(i,k,j) / psfc_hyd_p(i,j)
+ enddo
enddo
enddo
+!save the model-top pressure:
+ do j = jts,jte
+ do i = its,ite
+ diag_physics % plrad % array(i) = pres2_p(i,kte+1,j)
+ enddo
+ enddo
+
!formats:
201 format(3i8,10(1x,e15.8))
202 format(2i6,10(1x,e15.8))
@@ -546,15 +554,6 @@
enddo
!updates the surface pressure.
-!do j = jts,jte
-!do i = its,ite
-! sfc_pressure(i) = 0.5*g*(zgrid(2,i)-zgrid(1,i)) &
-! * (1.25 * rho_zz(1,i) * zz(1,i) * (1. + qv_p(i,1,j)) &
-! - 0.25 * rho_zz(2,i) * zz(2,i) * (1. + qv_p(i,2,j)))
-! sfc_pressure(i) = sfc_pressure(i) + pressure_p(1,i) + pressure_b(1,i)
-!enddo
-!enddo
-!ldf (2012-01-09):
do j = jts,jte
do i = its,ite
tem1 = zgrid(2,i)-zgrid(1,i)
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_manager.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_manager.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_manager.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -14,6 +14,12 @@
private
public:: physics_timetracker,physics_run_init
+!add-ons and modifications to sourcecode:
+!* added initialization of variable sf_surface_physics in subroutine physics_run_init. see
+! definition of sf_surface_physics in mpas_atmphys_vars.F
+! Laura D. Fowler (birch.ucar.edu) / 2013-03-11.
+
+
integer, public:: year !Current year.
integer, public:: julday !Initial Julian day.
real(kind=RKIND), public:: curr_julday !Current Julian day (= 0.0 at 0Z on January 1st).
@@ -55,6 +61,9 @@
integer, parameter:: acradtAlarmID = 20
type(MPAS_TimeInterval_Type):: acradtTimeStep
+!defines alarm to compute some physics diagnostics, such as radar reflectivity:
+ integer, parameter:: diagAlarmID = 21
+
integer :: h, m, s, s_n, s_d, DoY, yr
real(kind=RKIND) :: utc_h
@@ -229,6 +238,14 @@
write(0,*) '--- time to apply limit to accumulated radiation diags. L_ACRADT =',l_acradt
endif
+!check to see if it is time to calculate additional physics diagnostics:
+ l_diags = .false.
+ if(mpas_is_alarm_ringing(clock,diagAlarmID,ierr=ierr)) then
+ call mpas_reset_clock_alarm(clock,diagAlarmID,ierr=ierr)
+ l_diags = .true.
+ endif
+ write(0,*) '--- time to calculate additional physics_diagnostics =',l_diags
+
end subroutine physics_timetracker
!=============================================================================================
@@ -419,6 +436,11 @@
call physics_error_fatal('subroutine physics_init: error creating alarm radiation limit')
endif
+!set alarm to calculate physics diagnostics on IO outpt only:
+ call mpas_set_timeInterval(alarmTimeStep,timeString=config_output_interval,ierr=ierr)
+ alarmStartTime = startTime
+ call mpas_add_clock_alarm(clock,diagAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr)
+
write(0,102) dt_radtlw,dt_radtsw,dt_cu,dt_pbl
!initialization of physics dimensions to mimic a rectangular grid:
@@ -447,11 +469,14 @@
lsm_scheme = trim(config_lsm_scheme)
microp_scheme = trim(config_microp_scheme)
pbl_scheme = trim(config_pbl_scheme)
+ gwdo_scheme = trim(config_gwdo_scheme)
radt_cld_scheme = trim(config_radt_cld_scheme)
radt_lw_scheme = trim(config_radt_lw_scheme)
radt_sw_scheme = trim(config_radt_sw_scheme)
sfclayer_scheme = trim(config_sfclayer_scheme)
+ if(trim(config_lsm_scheme) .eq. "noah") sf_surface_physics = 2
+
!initialization of local physics time-steps:
!... dynamics:
dt_dyn = config_dt
@@ -466,6 +491,7 @@
l_radtlw = .false.
l_radtsw = .false.
!... others:
+ l_diags = .false.
l_camlw = .false.
l_acrain = .false.
l_acradt = .false.
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_todynamics.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_todynamics.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_todynamics.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -12,15 +12,16 @@
contains
!=============================================================================================
-subroutine physics_addtend(mesh, state, diag, tend, tend_physics, mass, mass_edge)
+subroutine physics_addtend(mesh, state, diag, tend, tend_physics, mass, mass_edge, rk_step)
!=============================================================================================
!input variables:
!----------------
-type(mesh_type),intent(in):: mesh
+ type(mesh_type),intent(in):: mesh
type(state_type),intent(in):: state
type(diag_type),intent(in):: diag
type(tend_physics_type),intent(inout):: tend_physics
+ integer, intent(in):: rk_step
real(kind=RKIND),dimension(:,:),intent(in):: mass
real(kind=RKIND),dimension(:,:),intent(in):: mass_edge
@@ -54,9 +55,6 @@
!ldf end.
!=============================================================================================
-!write(0,*)
-!write(0,*) '--- enter subroutine physics_add_tend:'
-
block => mesh % block
nCells = mesh % nCells
@@ -120,13 +118,6 @@
enddo
enddo
endif
-write(0,*) 'max rthblten = ',maxval(rthblten(:,1:nCellsSolve))
-write(0,*) 'min rthblten = ',minval(rthblten(:,1:nCellsSolve))
-!write(0,*) 'max rqvblten = ',maxval(rqvblten(:,1:nCellsSolve))
-!write(0,*) 'min rqvblten = ',minval(rqvblten(:,1:nCellsSolve))
-!write(0,*) 'max tend = ',maxval(tend_scalars(tend%index_qv,:,1:nCellsSolve))
-!write(0,*) 'min tend = ',minval(tend_scalars(tend%index_qv,:,1:nCellsSolve))
-!write(0,*)
!add coupled tendencies due to convection:
if(config_conv_deep_scheme .ne. 'off') then
@@ -154,13 +145,6 @@
enddo
enddo
endif
-write(0,*) 'max rthcuten = ',maxval(rthcuten(:,1:nCellsSolve))
-write(0,*) 'min rthcuten = ',minval(rthcuten(:,1:nCellsSolve))
-!write(0,*) 'max rqvcuten = ',maxval(rqvcuten(:,1:nCellsSolve))
-!write(0,*) 'min rqvcuten = ',minval(rqvcuten(:,1:nCellsSolve))
-!write(0,*) 'max tend = ',maxval(tend_scalars(tend%index_qv,:,1:nCellsSolve))
-!write(0,*) 'min tend = ',minval(tend_scalars(tend%index_qv,:,1:nCellsSolve))
-!write(0,*)
!add coupled tendencies due to longwave radiation:
if(config_radt_lw_scheme .ne. 'off') then
@@ -170,8 +154,6 @@
enddo
enddo
endif
-write(0,*) 'max rthratenlw = ',maxval(rthratenlw(:,1:nCellsSolve))
-write(0,*) 'min rthratenlw = ',minval(rthratenlw(:,1:nCellsSolve))
!add coupled tendencies due to shortwave radiation:
if(config_radt_sw_scheme .ne. 'off') then
@@ -181,8 +163,6 @@
enddo
enddo
endif
-write(0,*) 'max rthratensw = ',maxval(rthratensw(:,1:nCellsSolve))
-write(0,*) 'min rthratensw = ',minval(rthratensw(:,1:nCellsSolve))
!if non-hydrostatic core, convert the tendency for the potential temperature to a
!tendency for the modified potential temperature:
@@ -205,6 +185,21 @@
deallocate(theta)
deallocate(tend_th)
+ if(rk_step .eq. 3) then
+ write(0,*)
+ write(0,*) '--- enter subroutine physics_addtend:'
+ write(0,*) 'max rthblten = ',maxval(rthblten(:,1:nCellsSolve))
+ write(0,*) 'min rthblten = ',minval(rthblten(:,1:nCellsSolve))
+ write(0,*) 'max rthcuten = ',maxval(rthcuten(:,1:nCellsSolve))
+ write(0,*) 'min rthcuten = ',minval(rthcuten(:,1:nCellsSolve))
+ write(0,*) 'max rthratenlw = ',maxval(rthratenlw(:,1:nCellsSolve))
+ write(0,*) 'min rthratenlw = ',minval(rthratenlw(:,1:nCellsSolve))
+ write(0,*) 'max rthratensw = ',maxval(rthratensw(:,1:nCellsSolve))
+ write(0,*) 'min rthratensw = ',minval(rthratensw(:,1:nCellsSolve))
+ write(0,*) '--- end subroutine physics_addtend'
+ write(0,*)
+ endif
+
!formats:
201 format(2i6,10(1x,e15.8))
202 format(3i6,10(1x,e15.8))
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_update_surface.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_update_surface.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_update_surface.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -54,7 +54,7 @@
shdmax => sfc_input % shdmax % array
!updates the surface background albedo for the current date as a function of the monthly-mean
-!surface background albedo valid on the 15th day of the month, if input_sfc_albedo is true:
+!surface background albedo valid on the 15th day of the month, if config_sfc_albedo is true:
if(config_sfc_albedo) then
call monthly_interp_to_date(nCellsSolve,current_date,albedo12m,sfc_albbck)
@@ -146,6 +146,9 @@
if(config_frac_seaice) then
if(xice(iCell).ne.xicem(iCell) .and. xicem(iCell).gt.xice_threshold) then
+ !Fractional values of sfc_albedo and sfc_emiss are valid according to the earlier
+ !fractional sea-ice fraction, xicem. We recompute them for the new sea-ice fraction,
+ !xice.
sfc_albedo(iCell) = 0.08 + (sfc_albedo(iCell) -0.08) * xice(iCell)/xicem(iCell)
sfc_emiss(iCell) = 0.98 + (sfc_emiss(iCell)-0.98) * xice(iCell)/xicem(iCell)
endif
@@ -178,12 +181,12 @@
sfc_emibck(iCell) = 0.98
elseif(xland(iCell).lt.1.5 .and. xice(iCell).lt.xice_threshold .and. &
- xicem(iCell).lt.xice_threshold) then
+ xicem(iCell).ge.xice_threshold) then
!sea-ice points turn to water points:
xicem(iCell) = xice(iCell)
xland(iCell) = 2.
- isltyp(iCell) = 16
+ isltyp(iCell) = 14
ivgtyp(iCell) = iswater
vegfra(iCell) = 0.
tmn(iCell) = sst(iCell)
@@ -236,22 +239,25 @@
real(kind=RKIND):: fs, con1, con2, con3, con4, con5, zlan, q2, ts, phi, qn1
real(kind=RKIND):: usw, qo, swo, us, tb, dtc, dtw, alw, dtwo, delt, f1
- real(kind=RKIND),dimension(:),pointer:: tsk,xland
+ real(kind=RKIND),dimension(:),pointer:: sst,tsk,xland
real(kind=RKIND),dimension(:),pointer:: glw,gsw
- real(kind=RKIND),dimension(:),pointer:: hfx,qfx,sstsk
- real(kind=RKIND),dimension(:),pointer:: dtw1,emiss,ust
+ real(kind=RKIND),dimension(:),pointer:: hfx,qfx
+ real(kind=RKIND),dimension(:),pointer:: emiss,ust
+ real(kind=RKIND),dimension(:),pointer:: sstsk,dtc1,dtw1
!---------------------------------------------------------------------------------------------
-!write(0,*)
-!write(0,*) '--- enter subroutine physics_update_sstskin:'
+ write(0,*)
+ write(0,*) '--- enter subroutine physics_update_sstskin:'
nCellsSolve = mesh % nCellsSolve
tsk => sfc_input % skintemp % array
+ sst => sfc_input % sst % array
xland => sfc_input % xland % array
- dtw1 => diag_physics % sstsk_diur % array
sstsk => diag_physics % sstsk % array
+ dtc1 => diag_physics % sstsk_dtc % array
+ dtw1 => diag_physics % sstsk_dtw % array
emiss => diag_physics % sfc_emiss % array
glw => diag_physics % glw % array
gsw => diag_physics % gsw % array
@@ -262,8 +268,14 @@
skinmax = -9999.
skinmin = 9999.
+!first, restore the surface temperature to the sea-surface temperature:
do iCell = 1, nCellsSolve
+ if(xland(iCell) .ge. 1.5) tsk(iCell) = sst(iCell)
+ enddo
+!calculate the skin sea-surface temperature:
+ do iCell = 1, nCellsSolve
+
if(xland(iCell) .ge. 1.5) then
qo = glw(iCell)-emiss(iCell)*stbolt*(sstsk(iCell)**4)-2.5e6*qfx(iCell)-hfx(iCell)
@@ -324,19 +336,20 @@
skinmax = amax1(skinmax,ts-tb)
skinmin = amin1(skinmin,ts-tb)
sstsk(iCell) = ts+273.15 ! convert ts (in C) to sstsk (in K)
+ dtc1(iCell) = dtc ! dtc always in C
dtw1(iCell) = dtw ! dtw always in C
endif
enddo
-!update the skin temperature:
+!update the surface temperature over the oceans:
do iCell = 1, nCellsSolve
if(xland(iCell) .gt. 1.5) tsk(iCell) = sstsk(iCell)
enddo
- write(0,*) 'check skin sst skinmax = ', skinmax, ' skinmin = ', skinmin
-
+ write(0,*) 'check skin sst skinmax = ', skinmax
+ write(0,*) 'check skin sst skinmin = ', skinmin
end subroutine physics_update_sstskin
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_vars.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_vars.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/mpas_atmphys_vars.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -7,6 +7,12 @@
public
save
+!add-ons and modifications to sourcecode:
+!* added the variables sf_surface_physics,alswvisdir_p,alswvisdif_p,alswnirdir_p,alswnirdif_p,
+! swvisdir_p,swvisdif_p,swnirdir_p,and swnirdif_p to upgrade the RRTMG short wave radiation
+! code to WRF version 3.4.1. see definition of each individual variables below.
+! Laura D. Fowler (birch.ucar.edu) / 2013-03-11.
+
!=============================================================================================
!list of physics parameterizations:
!=============================================================================================
@@ -14,6 +20,7 @@
character(len=StrKIND),public:: microp_scheme
character(len=StrKIND),public:: conv_deep_scheme
character(len=StrKIND),public:: conv_shallow_scheme
+ character(len=StrKIND),public:: gwdo_scheme
character(len=StrKIND),public:: lsm_scheme
character(len=StrKIND),public:: pbl_scheme
character(len=StrKIND),public:: radt_cld_scheme
@@ -30,12 +37,14 @@
logical:: l_radtsw !controls call to shortwave radiation parameterization.
logical:: l_conv !controls call to convective parameterization.
logical:: l_camlw !controls when to save local CAM LW abs and ems arrays.
+ logical:: l_diags !controls when to calculate physics diagnostics.
logical:: l_acrain !when .true., limit to accumulated rain is applied.
logical:: l_acradt !when .true., limit to lw and sw radiation is applied.
integer,public:: ids,ide,jds,jde,kds,kde
integer,public:: ims,ime,jms,jme,kms,kme
integer,public:: its,ite,jts,jte,kts,kte
+ integer,public:: iall
integer,public:: n_microp
integer,public:: num_months !number of months [-]
@@ -96,6 +105,17 @@
pres2_p, &!pressure [hPa]
t2_p !temperature [K]
+!... arrays used for calculating the hydrostatic pressure and exner function:
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+ psfc_hyd_p, &!surface pressure [hPa]
+ psfc_hydd_p !"dry" surface pressure [hPa]
+ real(kind=RKIND),dimension(:,:,:),allocatable:: &
+ pres_hyd_p, &!pressure located at theta levels [hPa]
+ pres_hydd_p, &!"dry" pressure located at theta levels [hPa]
+ pres2_hyd_p, &!pressure located at w-velocity levels [hPa]
+ pres2_hydd_p, &!"dry" pressure located at w-velocity levels [hPa]
+ znu_hyd_p !(pres_hyd_p / P0) needed in the Tiedtke convection scheme [hPa]
+
!=============================================================================================
!... variables and arrays related to parameterization of cloud microphysics:
! warm_phase: logical that determines if we want to run warm-phase cloud microphysics only.
@@ -164,6 +184,18 @@
rqrcuten_p, &!
rqscuten_p !
+!... kain fritsch (trigger option) specific arrays:
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+ area_kf_p !as area_p but using nCells instead of nCellsSolve [m2]
+ real(kind=RKIND),dimension(:,:,:),allocatable:: &
+ rqvdynten_havg_p, &!
+ rqvdynten_vavg_p, &!
+ t_kf_p, &!as t_p but using nCells instead of nCellsSolve to compute t_havg_p [K]
+ t_havg_p, &!
+ t_vavg_p, &!
+ t_htrigger_p, &!
+ t_vtrigger_p !
+
!... tiedtke specific arrays:
real(kind=RKIND),dimension(:,:,:),allocatable:: &
znu_p, &!
@@ -184,6 +216,8 @@
real(kind=RKIND),public:: dt_pbl
real(kind=RKIND),dimension(:,:),allocatable:: &
+ ctopo_p, &!correction to topography [-]
+ ctopo2_p, &!correction to topography 2 [-]
hpbl_p !PBL height [m]
real(kind=RKIND),dimension(:,:,:),allocatable:: &
@@ -197,23 +231,57 @@
rqcblten_p, &!
rqiblten_p !
+ real(kind=RKIND),dimension(:,:,:),allocatable:: &
+ kzh_p, &!
+ kzm_p, &!
+ kzq_p !
+
!=============================================================================================
+!... variables and arrays related to parameterization of gravity wave drag over orography:
+!=============================================================================================
+
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+ var2d_p, &!orographic variance (m2)
+ con_p, &!orographic convexity (m2)
+ oa1_p, &!orographic direction asymmetry function (-)
+ oa2_p, &!orographic direction asymmetry function (-)
+ oa3_p, &!orographic direction asymmetry function (-)
+ oa4_p, &!orographic direction asymmetry function (-)
+ ol1_p, &!orographic direction asymmetry function (-)
+ ol2_p, &!orographic direction asymmetry function (-)
+ ol3_p, &!orographic direction asymmetry function (-)
+ ol4_p !orographic direction asymmetry function (-)
+
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+ dx_p !maximum distance between cell centers (m)
+
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+ dusfcg_p, &!vertically-integrated gwdo u-stress (Pa m s-1)
+ dvsfcg_p !vertically-integrated gwdo v -stress (Pa m s-1)
+
+ real(kind=RKIND),dimension(:,:,:),allocatable:: &
+ dtaux3d_p, &!gravity wave drag over orography u-stress (m s-1)
+ dtauy3d_p !gravity wave drag over orography u-stress (m s-1)
+
+!=============================================================================================
!... variables and arrays related to parameterization of surface layer:
!=============================================================================================
real(kind=RKIND),dimension(:,:),allocatable:: &
br_p, &!bulk richardson number [-]
- cd_p, &!
- cda_p, &!
- ck_p, &!
- cka_p, &!
+ cd_p, &!momentum exchange coeff at 10 meters [?]
+ cda_p, &!momentum exchange coeff at the lowest model level [?]
cpm_p, &!
chs_p, &!
chs2_p, &!
+ ck_p, &!enthalpy exchange coeff at 10 meters [?]
+ cka_p, &!enthalpy exchange coeff at the lowest model level [?]
cqs2_p, &!
gz1oz0_p, &!log of z1 over z0 [-]
flhc_p, &!exchange coefficient for heat [-]
flqc_p, &!exchange coefficient for moisture [-]
hfx_p, &!upward heat flux at the surface [W/m2]
+ fh_p, &!integrated stability function for heat [-]
+ fm_p, &!integrated stability function for momentum [-]
lh_p, &!latent heat flux at the surface [W/m2]
mavail_p, &!surface moisture availability [-]
mol_p, &!T* in similarity theory [K]
@@ -230,12 +298,13 @@
th2m_p, &!potential temperature at 2m [K]
u10_p, &!u at 10 m [m/s]
ust_p, &!u* in similarity theory [m/s]
- ustm_p, &!u* in similarity theory without vconv [m/s]
+ ustm_p, &!u* in similarity theory without vconv correction [m/s]
v10_p, &!v at 10 m [m/s]
wspd_p, &!wind speed [m/s]
znt_p, &!time-varying roughness length [m]
zol_p !
+
!=============================================================================================
!... variables and arrays related to parameterization of short-wave radiation:
!=============================================================================================
@@ -257,6 +326,12 @@
swupt_p, &!all-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
swuptc_p !clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+ swvisdir_p, &!visible direct downward flux [W m-2]
+ swvisdif_p, &!visible diffuse downward flux [W m-2]
+ swnirdir_p, &!near-IR direct downward flux [W m-2]
+ swnirdif_p !near-IR diffuse downward flux [W m-2]
+
real(kind=RKIND),dimension(:,:,:),allocatable:: &
swdnflx_p, &!
swdnflxc_p, &!
@@ -270,7 +345,12 @@
!... variables and arrays related to parameterization of long-wave radiation:
!=============================================================================================
+ integer,dimension(:,:),allocatable:: &
+ nlrad_p !number of layers added above the model top [-]
real(kind=RKIND),dimension(:,:),allocatable:: &
+ plrad_p !pressure at model_top [Pa]
+
+ real(kind=RKIND),dimension(:,:),allocatable:: &
glw_p, &!net longwave flux at surface [W m-2]
lwcf_p, &!longwave cloud forcing at top-of-atmosphere [W m-2]
lwdnb_p, &!all-sky downwelling longwave flux at bottom-of-atmosphere [J m-2]
@@ -344,6 +424,11 @@
!=============================================================================================
integer,public:: &
+ sf_surface_physics !used to define the land surface scheme by a number instead of name. It
+ !is only needed in module_ra_rrtmg_sw.F to define the spectral surface
+ !albedos as functions of the land surface scheme.
+
+ integer,public:: &
num_soils !number of soil layers [-]
integer,dimension(:,:),allocatable:: &
@@ -369,7 +454,6 @@
potevp_p, &!potential evaporation [W m-2]
qz0_p, &!specific humidity at znt [kg kg-1]
rainbl_p, &!
- rib_p, &!?
sfcrunoff_p, &!surface runoff [m s-1]
shdmin_p, &!minimum areal fractional coverage of annual green vegetation [-]
shdmax_p, &!maximum areal fractional coverage of annual green vegetation [-]
@@ -385,6 +469,12 @@
vegfra_p, &!vegetation fraction [-]
z0_p !background roughness length [m]
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+ alswvisdir_p, &!direct-beam surface albedo in visible spectrum [-]
+ alswvisdif_p, &!diffuse-beam surface albedo in visible spectrum [-]
+ alswnirdir_p, &!direct-beam surface albedo in near-IR spectrum [-]
+ alswnirdif_p !diffuse-beam surface albedo in near-IR spectrum [-]
+
!=============================================================================================
!.. variables and arrays related to surface characteristics:
!=============================================================================================
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/Makefile
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/Makefile 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/Makefile 2013-04-22 01:31:32 UTC (rev 2783)
@@ -7,6 +7,7 @@
OBJS = \
libmassv.o \
+ module_bl_gwdo.o \
module_bl_ysu.o \
module_cam_shr_kind_mod.o \
module_cam_support.o \
@@ -14,6 +15,7 @@
module_cu_kfeta_wrf3.3.1.o \
module_cu_tiedtke.o \
module_mp_kessler.o \
+ module_mp_radar.o \
module_mp_thompson.o \
module_mp_wsm6.o \
module_ra_cam.o \
@@ -36,11 +38,15 @@
module_cam_shr_kind_mod.o \
../mpas_atmphys_utilities.o
+module_mp_radar.o: \
+ ../mpas_atmphys_utilities.o
+
module_mp_thompson.o: \
../mpas_atmphys_utilities.o
module_mp_wsm6.o: \
- libmassv.o
+ libmassv.o \
+ module_mp_radar.o
module_ra_cam.o: \
module_cam_support.o \
Copied: branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_bl_gwdo.F (from rev 2782, trunk/mpas/src/core_atmos_physics/physics_wrf/module_bl_gwdo.F)
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_bl_gwdo.F (rev 0)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_bl_gwdo.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,743 @@
+! WRf:model_layer:physics
+!
+!
+!
+!
+!
+module module_bl_gwdo
+contains
+!
+!-------------------------------------------------------------------
+!
+ subroutine gwdo(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, &
+ rublten,rvblten, &
+ dtaux3d,dtauy3d,dusfcg,dvsfcg, &
+ var2d,oc12d,oa2d1,oa2d2,oa2d3,oa2d4,ol2d1,ol2d2,ol2d3,ol2d4, &
+ znu,znw,mut,p_top, &
+ cp,g,rd,rv,ep1,pi, &
+ dt,dx,kpbl2d,itimestep, &
+ ids,ide, jds,jde, kds,kde, &
+ ims,ime, jms,jme, kms,kme, &
+ its,ite, jts,jte, kts,kte)
+!-------------------------------------------------------------------
+ implicit none
+!------------------------------------------------------------------------------
+!
+!-- u3d 3d u-velocity interpolated to theta points (m/s)
+!-- v3d 3d v-velocity interpolated to theta points (m/s)
+!-- t3d temperature (k)
+!-- qv3d 3d water vapor mixing ratio (kg/kg)
+!-- p3d 3d pressure (pa)
+!-- p3di 3d pressure (pa) at interface level
+!-- pi3d 3d exner function (dimensionless)
+!-- rublten u tendency due to
+! pbl parameterization (m/s/s)
+!-- rvblten v tendency due to
+!-- cp heat capacity at constant pressure for dry air (j/kg/k)
+!-- g acceleration due to gravity (m/s^2)
+!-- rd gas constant for dry air (j/kg/k)
+!-- z height above sea level (m)
+!-- rv gas constant for water vapor (j/kg/k)
+!-- dt time step (s)
+!-- dx model grid interval (m)
+!-- ep1 constant for virtual temperature (r_v/r_d - 1) (dimensionless)
+!-- ids start index for i in domain
+!-- ide end index for i in domain
+!-- jds start index for j in domain
+!-- jde end index for j in domain
+!-- kds start index for k in domain
+!-- kde end index for k in domain
+!-- ims start index for i in memory
+!-- ime end index for i in memory
+!-- jms start index for j in memory
+!-- jme end index for j in memory
+!-- kms start index for k in memory
+!-- kme end index for k in memory
+!-- its start index for i in tile
+!-- ite end index for i in tile
+!-- jts start index for j in tile
+!-- jte end index for j in tile
+!-- kts start index for k in tile
+!-- kte end index for k in tile
+!-------------------------------------------------------------------
+!
+ integer, intent(in ) :: ids,ide, jds,jde, kds,kde, &
+ ims,ime, jms,jme, kms,kme, &
+ its,ite, jts,jte, kts,kte
+ integer, intent(in ) :: itimestep
+!
+!MPAS specific (Laura D. Fowler 2013-02-12):
+#if defined(non_hydrostatic_core)
+ real, intent(in ) :: dt,cp,g,rd,rv,ep1,pi
+ real, intent(in), dimension(ims:ime,jms:jme):: dx
+#else
+ real, intent(in ) :: dt,dx,cp,g,rd,rv,ep1,pi
+#endif
+!MPAS specific end.
+!
+ real, dimension( ims:ime, kms:kme, jms:jme ) , &
+ intent(in ) :: qv3d, &
+ p3d, &
+ pi3d, &
+ t3d, &
+ z
+ real, dimension( ims:ime, kms:kme, jms:jme ) , &
+ intent(in ) :: p3di
+!
+ real, dimension( ims:ime, kms:kme, jms:jme ) , &
+ intent(inout) :: rublten, &
+ rvblten
+ real, dimension( ims:ime, kms:kme, jms:jme ) , &
+ intent(inout) :: dtaux3d, &
+ dtauy3d
+!
+ real, dimension( ims:ime, kms:kme, jms:jme ) , &
+ intent(in ) :: u3d, &
+ v3d
+!
+ integer, dimension( ims:ime, jms:jme ) , &
+ intent(in ) :: kpbl2d
+ real, dimension( ims:ime, jms:jme ) , &
+ intent(inout ) :: dusfcg, &
+ dvsfcg
+!
+ real, dimension( ims:ime, jms:jme ) , &
+ intent(in ) :: var2d, &
+ oc12d, &
+ oa2d1,oa2d2,oa2d3,oa2d4, &
+ ol2d1,ol2d2,ol2d3,ol2d4
+!
+ real, dimension( ims:ime, jms:jme ) , &
+ optional , &
+ intent(in ) :: mut
+!
+ real, dimension( kms:kme ) , &
+ optional , &
+ intent(in ) :: znu, &
+ znw
+!
+ real, optional, intent(in ) :: p_top
+!
+!local
+!
+ real, dimension( its:ite, kts:kte ) :: delprsi, &
+ pdh
+ real, dimension( its:ite, kts:kte+1 ) :: pdhi
+ real, dimension( its:ite, 4 ) :: oa4, &
+ ol4
+ integer :: i,j,k,kdt
+!
+ do j = jts,jte
+ if(present(mut))then
+! For ARW we will replace p and p8w with dry hydrostatic pressure
+ do k = kts,kte+1
+ do i = its,ite
+ if(k.le.kte)pdh(i,k) = mut(i,j)*znu(k) + p_top
+ pdhi(i,k) = mut(i,j)*znw(k) + p_top
+ enddo
+ enddo
+ else
+ do k = kts,kte+1
+ do i = its,ite
+ if(k.le.kte)pdh(i,k) = p3d(i,k,j)
+ pdhi(i,k) = p3di(i,k,j)
+ enddo
+ enddo
+ endif
+!
+ do k = kts,kte
+ do i = its,ite
+ delprsi(i,k) = pdhi(i,k)-pdhi(i,k+1)
+ enddo
+ enddo
+ do i = its,ite
+ oa4(i,1) = oa2d1(i,j)
+ oa4(i,2) = oa2d2(i,j)
+ oa4(i,3) = oa2d3(i,j)
+ oa4(i,4) = oa2d4(i,j)
+ ol4(i,1) = ol2d1(i,j)
+ ol4(i,2) = ol2d2(i,j)
+ ol4(i,3) = ol2d3(i,j)
+ ol4(i,4) = ol2d4(i,j)
+ enddo
+ call gwdo2d(dudt=rublten(ims,kms,j),dvdt=rvblten(ims,kms,j) &
+ ,dtaux2d=dtaux3d(ims,kms,j),dtauy2d=dtauy3d(ims,kms,j) &
+ ,u1=u3d(ims,kms,j),v1=v3d(ims,kms,j) &
+ ,t1=t3d(ims,kms,j),q1=qv3d(ims,kms,j) &
+ ,prsi=pdhi(its,kts),del=delprsi(its,kts) &
+ ,prsl=pdh(its,kts),prslk=pi3d(ims,kms,j) &
+ ,zl=z(ims,kms,j),rcl=1.0 &
+ ,dusfc=dusfcg(ims,j),dvsfc=dvsfcg(ims,j) &
+ ,var=var2d(ims,j),oc1=oc12d(ims,j) &
+ ,oa4=oa4,ol4=ol4 &
+ ,g=g,cp=cp,rd=rd,rv=rv,fv=ep1,pi=pi &
+!MPAS specific (Laura D. Fowler 2013-02-12):
+#if defined(non_hydrostatic_core)
+ ,dxmeter=dx(ims,j),deltim=dt &
+#else
+ ,dxmeter=dx,deltim=dt &
+#endif
+!MPAS specific end.
+ ,kpbl=kpbl2d(ims,j),kdt=itimestep,lat=j &
+ ,ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde &
+ ,ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme &
+ ,its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte )
+ enddo
+!
+!
+ end subroutine gwdo
+!
+!-------------------------------------------------------------------
+!
+!
+!
+!
+ subroutine gwdo2d(dudt,dvdt,dtaux2d,dtauy2d, &
+ u1,v1,t1,q1, &
+ prsi,del,prsl,prslk,zl,rcl, &
+ var,oc1,oa4,ol4,dusfc,dvsfc, &
+ g,cp,rd,rv,fv,pi,dxmeter,deltim,kpbl,kdt,lat, &
+ ids,ide, jds,jde, kds,kde, &
+ ims,ime, jms,jme, kms,kme, &
+ its,ite, jts,jte, kts,kte)
+!-------------------------------------------------------------------
+!
+! this code handles the time tendencies of u v due to the effect of mountain
+! induced gravity wave drag from sub-grid scale orography. this routine
+! not only treats the traditional upper-level wave breaking due to mountain
+! variance (alpert 1988), but also the enhanced lower-tropospheric wave
+! breaking due to mountain convexity and asymmetry (kim and arakawa 1995).
+! thus, in addition to the terrain height data in a model grid gox,
+! additional 10-2d topographic statistics files are needed, including
+! orographic standard deviation (var), convexity (oc1), asymmetry (oa4)
+! and ol (ol4). these data sets are prepared based on the 30 sec usgs orography
+! hong (1999). the current scheme was implmented as in hong et al.(2008)
+!
+! coded by song-you hong and young-joon kim and implemented by song-you hong
+!
+! references:
+! hong et al. (2008), wea. and forecasting
+! kim and arakawa (1995), j. atmos. sci.
+! alpet et al. (1988), NWP conference.
+! hong (1999), NCEP office note 424.
+!
+! notice : comparible or lower resolution orography files than model resolution
+! are desirable in preprocess (wps) to prevent weakening of the drag
+!-------------------------------------------------------------------
+!
+! input
+! dudt (ims:ime,kms:kme) non-lin tendency for u wind component
+! dvdt (ims:ime,kms:kme) non-lin tendency for v wind component
+! u1(ims:ime,kms:kme) zonal wind / sqrt(rcl) m/sec at t0-dt
+! v1(ims:ime,kms:kme) meridional wind / sqrt(rcl) m/sec at t0-dt
+! t1(ims:ime,kms:kme) temperature deg k at t0-dt
+! q1(ims:ime,kms:kme) specific humidity at t0-dt
+!
+! rcl a scaling factor = reciprocal of square of cos(lat)
+! for mrf gsm. rcl=1 if u1 and v1 are wind components.
+! deltim time step secs
+! del(kts:kte) positive increment of pressure across layer (pa)
+!
+! output
+! dudt, dvdt wind tendency due to gwdo
+!
+!-------------------------------------------------------------------
+ implicit none
+!-------------------------------------------------------------------
+ integer :: kdt,lat,latd,lond, &
+ ids,ide, jds,jde, kds,kde, &
+ ims,ime, jms,jme, kms,kme, &
+ its,ite, jts,jte, kts,kte
+!
+!MPAS specific (Laura D. Fowler 2013-02-12):
+#if defined(non_hydrostatic_core)
+ real :: g,rd,rv,fv,cp,pi,deltim,rcl
+ real, dimension(ims:ime):: dxmeter
+#else
+ real :: g,rd,rv,fv,cp,pi,dxmeter,deltim,rcl
+#endif
+!MPAS specific end.
+
+ real :: dudt(ims:ime,kms:kme),dvdt(ims:ime,kms:kme), &
+ dtaux2d(ims:ime,kms:kme),dtauy2d(ims:ime,kms:kme), &
+ u1(ims:ime,kms:kme),v1(ims:ime,kms:kme), &
+ t1(ims:ime,kms:kme),q1(ims:ime,kms:kme), &
+ zl(ims:ime,kms:kme),prslk(ims:ime,kms:kme)
+ real :: prsl(its:ite,kts:kte),prsi(its:ite,kts:kte+1), &
+ del(its:ite,kts:kte)
+ real :: oa4(its:ite,4),ol4(its:ite,4)
+!
+ integer :: kpbl(ims:ime)
+ real :: var(ims:ime),oc1(ims:ime), &
+ dusfc(ims:ime),dvsfc(ims:ime)
+! critical richardson number for wave breaking : ! larger drag with larger value
+!
+ real,parameter :: ric = 0.25
+!
+ real,parameter :: dw2min = 1.
+ real,parameter :: rimin = -100.
+ real,parameter :: bnv2min = 1.0e-5
+ real,parameter :: efmin = 0.0
+ real,parameter :: efmax = 10.0
+ real,parameter :: xl = 4.0e4
+ real,parameter :: critac = 1.0e-5
+ real,parameter :: gmax = 1.
+ real,parameter :: veleps = 1.0
+ real,parameter :: factop = 0.5
+ real,parameter :: frc = 1.0
+ real,parameter :: ce = 0.8
+ real,parameter :: cg = 0.5
+!
+! local variables
+!
+ integer :: i,k,lcap,lcapp1,nwd,idir,kpblmin,kpblmax, &
+ klcap,kp1,ikount,kk
+!
+!MPAS specific (Laura D. Fowler 2013-02-12):
+#if defined(non_hydrostatic_core)
+ real :: rcs,rclcs,csg,fdir,cs,rcsks, &
+ wdir,ti,rdz,temp,tem2,dw2,shr2,bvf2,rdelks, &
+ wtkbj,coefm,tem,gfobnv,hd,fro,rim,temc,tem1,efact, &
+ temv,dtaux,dtauy
+ real, dimension(its:ite):: cleff
+#else
+ real :: rcs,rclcs,csg,fdir,cleff,cs,rcsks, &
+ wdir,ti,rdz,temp,tem2,dw2,shr2,bvf2,rdelks, &
+ wtkbj,coefm,tem,gfobnv,hd,fro,rim,temc,tem1,efact, &
+ temv,dtaux,dtauy
+#endif
+!
+ logical :: ldrag(its:ite),icrilv(its:ite), &
+ flag(its:ite),kloop1(its:ite)
+!
+ real :: taub(its:ite),taup(its:ite,kts:kte+1), &
+ xn(its:ite),yn(its:ite), &
+ ubar(its:ite),vbar(its:ite), &
+ fr(its:ite),ulow(its:ite), &
+ rulow(its:ite),bnv(its:ite), &
+ oa(its:ite),ol(its:ite), &
+ roll(its:ite),dtfac(its:ite), &
+ brvf(its:ite),xlinv(its:ite), &
+ delks(its:ite),delks1(its:ite), &
+ bnv2(its:ite,kts:kte),usqj(its:ite,kts:kte), &
+ taud(its:ite,kts:kte),ro(its:ite,kts:kte), &
+ vtk(its:ite,kts:kte),vtj(its:ite,kts:kte), &
+ zlowtop(its:ite),velco(its:ite,kts:kte-1)
+!
+ integer :: kbl(its:ite),klowtop(its:ite), &
+ lowlv(its:ite)
+!
+ logical :: iope
+ integer,parameter :: mdir=8
+ integer :: nwdir(mdir)
+ data nwdir/6,7,5,8,2,3,1,4/
+!
+! initialize local variables
+!
+ kbl=0 ; klowtop=0 ; lowlv=0
+!
+!---- constants
+!
+ rcs = sqrt(rcl)
+ cs = 1. / sqrt(rcl)
+ csg = cs * g
+ lcap = kte
+ lcapp1 = lcap + 1
+ fdir = mdir / (2.0*pi)
+!
+!
+!!!!!!! cleff (subgrid mountain scale ) is highly tunable parameter
+!!!!!!! the bigger (smaller) value produce weaker (stronger) wave drag
+!
+!MPAS specific (Laura D. Fowler 2013-02-13):
+#if defined(non_hydrostatic_core)
+ do i = its, ite
+ cleff(i) = max(dxmeter(i),50.e3)
+ enddo
+#else
+ cleff = max(dxmeter,50.e3)
+#endif
+!MPAS specific end.
+!
+! initialize!!
+!
+ dtaux = 0.0
+ dtauy = 0.0
+ do k = kts,kte
+ do i = its,ite
+ usqj(i,k) = 0.0
+ bnv2(i,k) = 0.0
+ vtj(i,k) = 0.0
+ vtk(i,k) = 0.0
+ taup(i,k) = 0.0
+ taud(i,k) = 0.0
+ dtaux2d(i,k)= 0.0
+ dtauy2d(i,k)= 0.0
+ enddo
+ enddo
+ do i = its,ite
+ taup(i,kte+1) = 0.0
+ xlinv(i) = 1.0/xl
+ enddo
+!
+ do k = kts,kte
+ do i = its,ite
+ vtj(i,k) = t1(i,k) * (1.+fv*q1(i,k))
+ vtk(i,k) = vtj(i,k) / prslk(i,k)
+ ro(i,k) = 1./rd * prsl(i,k) / vtj(i,k) ! density kg/m**3
+ enddo
+ enddo
+!
+ do i = its,ite
+ zlowtop(i) = 2. * var(i)
+ enddo
+!
+!--- determine new reference level > 2*var
+!
+ do i = its,ite
+ kloop1(i) = .true.
+ enddo
+ do k = kts+1,kte
+ do i = its,ite
+ if(kloop1(i).and.zl(i,k)-zl(i,1).ge.zlowtop(i)) then
+ klowtop(i) = k+1
+ kloop1(i) = .false.
+ endif
+ enddo
+ enddo
+!
+ kpblmax = 2
+ do i = its,ite
+ kbl(i) = max(2, kpbl(i))
+ kbl(i) = max(kbl(i), klowtop(i))
+ delks(i) = 1.0 / (prsi(i,1) - prsi(i,kbl(i)))
+ ubar (i) = 0.0
+ vbar (i) = 0.0
+ taup(i,1) = 0.0
+ oa(i) = 0.0
+ kpblmax = max(kpblmax,kbl(i))
+ flag(i) = .true.
+ lowlv(i) = 2
+ enddo
+ kpblmax = min(kpblmax+1,kte-1)
+!
+! compute low level averages within pbl
+!
+ do k = kts,kpblmax
+ do i = its,ite
+ if (k.lt.kbl(i)) then
+ rcsks = rcs * del(i,k) * delks(i)
+ ubar(i) = ubar(i) + rcsks * u1(i,k) ! pbl u mean
+ vbar(i) = vbar(i) + rcsks * v1(i,k) ! pbl v mean
+ endif
+ enddo
+ enddo
+!
+! figure out low-level horizontal wind direction
+!
+! nwd 1 2 3 4 5 6 7 8
+! wd w s sw nw e n ne se
+!
+ do i = its,ite
+ wdir = atan2(ubar(i),vbar(i)) + pi
+ idir = mod(nint(fdir*wdir),mdir) + 1
+ nwd = nwdir(idir)
+ oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(i,mod(nwd-1,4)+1)
+ ol(i) = ol4(i,mod(nwd-1,4)+1)
+ enddo
+!
+ kpblmin = kte
+ do i = its,ite
+ kpblmin = min(kpblmin, kbl(i))
+ enddo
+!
+ do i = its,ite
+ if (oa(i).le.0.0) kbl(i) = kpbl(i) + 1
+ enddo
+!
+ do i = its,ite
+ delks(i) = 1.0 / (prsi(i,1) - prsi(i,kbl(i)))
+ delks1(i) = 1.0 / (prsl(i,1) - prsl(i,kbl(i)))
+ enddo
+!
+!--- saving richardson number in usqj for migwdi
+!
+ do k = kts,kte-1
+ do i = its,ite
+ ti = 2.0 / (t1(i,k)+t1(i,k+1))
+ rdz = 1./(zl(i,k+1) - zl(i,k))
+ tem1 = u1(i,k) - u1(i,k+1)
+ tem2 = v1(i,k) - v1(i,k+1)
+ dw2 = rcl*(tem1*tem1 + tem2*tem2)
+ shr2 = max(dw2,dw2min) * rdz * rdz
+ bvf2 = g*(g/cp+rdz*(vtj(i,k+1)-vtj(i,k))) * ti
+ usqj(i,k) = max(bvf2/shr2,rimin)
+ bnv2(i,k) = 2*g*rdz*(vtk(i,k+1)-vtk(i,k))/(vtk(i,k+1)+vtk(i,k))
+ bnv2(i,k) = max( bnv2(i,k), bnv2min )
+ enddo
+ enddo
+!
+!-----initialize arrays
+!
+ do i = its,ite
+ xn(i) = 0.0
+ yn(i) = 0.0
+ ubar (i) = 0.0
+ vbar (i) = 0.0
+ roll (i) = 0.0
+ taub (i) = 0.0
+ ulow (i) = 0.0
+ dtfac(i) = 1.0
+ ldrag(i) = .false.
+ icrilv(i) = .false. ! initialize critical level control vector
+ enddo
+!
+!---- compute low level averages
+!---- (u,v)*cos(lat) use uv=(u1,v1) which is wind at t0-1
+!---- use rcs=1/cos(lat) to get wind field
+!
+ do k = 1,kpblmax
+ do i = its,ite
+ if (k .lt. kbl(i)) then
+ rdelks = del(i,k) * delks(i)
+ rcsks = rcs * rdelks
+ ubar(i) = ubar(i) + rcsks * u1(i,k) ! u mean
+ vbar(i) = vbar(i) + rcsks * v1(i,k) ! v mean
+ roll(i) = roll(i) + rdelks * ro(i,k) ! ro mean
+ endif
+ enddo
+ enddo
+!
+!----compute the "low level" or 1/3 wind magnitude (m/s)
+!
+ do i = its,ite
+ ulow(i) = max(sqrt(ubar(i)*ubar(i) + vbar(i)*vbar(i)), 1.0)
+ rulow(i) = 1./ulow(i)
+ enddo
+!
+ do k = kts,kte-1
+ do i = its,ite
+ velco(i,k) = (0.5*rcs) * ((u1(i,k)+u1(i,k+1)) * ubar(i) &
+ + (v1(i,k)+v1(i,k+1)) * vbar(i))
+ velco(i,k) = velco(i,k) * rulow(i)
+ if ((velco(i,k).lt.veleps) .and. (velco(i,k).gt.0.)) then
+ velco(i,k) = veleps
+ endif
+ enddo
+ enddo
+!
+! no drag when critical level in the base layer
+!
+ do i = its,ite
+ ldrag(i) = velco(i,1).le.0.
+ enddo
+!
+ do k = kts+1,kpblmax-1
+ do i = its,ite
+ if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. velco(i,k).le.0.
+ enddo
+ enddo
+!
+! no drag when bnv2.lt.0
+!
+ do k = kts,kpblmax-1
+ do i = its,ite
+ if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. bnv2(i,k).lt.0.
+ enddo
+ enddo
+!
+!-----the low level weighted average ri is stored in usqj(1,1; im)
+!-----the low level weighted average n**2 is stored in bnv2(1,1; im)
+!---- this is called bnvl2 in phys_gwd_alpert_sub not bnv2
+!---- rdelks (del(k)/delks) vert ave factor so we can * instead of /
+!
+ do i = its,ite
+ wtkbj = (prsl(i,1)-prsl(i,2)) * delks1(i)
+ bnv2(i,1) = wtkbj * bnv2(i,1)
+ usqj(i,1) = wtkbj * usqj(i,1)
+ enddo
+!
+ do k = kts+1,kpblmax-1
+ do i = its,ite
+ if (k .lt. kbl(i)) then
+ rdelks = (prsl(i,k)-prsl(i,k+1)) * delks1(i)
+ bnv2(i,1) = bnv2(i,1) + bnv2(i,k) * rdelks
+ usqj(i,1) = usqj(i,1) + usqj(i,k) * rdelks
+ endif
+ enddo
+ enddo
+!
+ do i = its,ite
+ ldrag(i) = ldrag(i) .or. bnv2(i,1).le.0.0
+ ldrag(i) = ldrag(i) .or. ulow(i).eq.1.0
+ ldrag(i) = ldrag(i) .or. var(i) .le. 0.0
+ enddo
+!
+! ----- set all ri low level values to the low level value
+!
+ do k = kts+1,kpblmax-1
+ do i = its,ite
+ if (k .lt. kbl(i)) usqj(i,k) = usqj(i,1)
+ enddo
+ enddo
+!
+ do i = its,ite
+ if (.not.ldrag(i)) then
+ bnv(i) = sqrt( bnv2(i,1) )
+ fr(i) = bnv(i) * rulow(i) * var(i)
+ xn(i) = ubar(i) * rulow(i)
+ yn(i) = vbar(i) * rulow(i)
+ endif
+ enddo
+!
+! compute the base level stress and store it in taub
+! calculate enhancement factor, number of mountains & aspect
+! ratio const. use simplified relationship between standard
+! deviation & critical hgt
+!
+ do i = its,ite
+ if (.not. ldrag(i)) then
+ efact = (oa(i) + 2.) ** (ce*fr(i)/frc)
+ efact = min( max(efact,efmin), efmax )
+ coefm = (1. + ol(i)) ** (oa(i)+1.)
+!MPAS specific (Laura D. Fowler 2013-02-12):
+#if defined (non_hydrostatic_core)
+ xlinv(i) = coefm / cleff(i)
+#else
+ xlinv(i) = coefm / cleff
+#endif
+ tem = fr(i) * fr(i) * oc1(i)
+ gfobnv = gmax * tem / ((tem + cg)*bnv(i))
+ taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) &
+ * ulow(i) * gfobnv * efact
+ else
+ taub(i) = 0.0
+ xn(i) = 0.0
+ yn(i) = 0.0
+ endif
+ enddo
+!
+! now compute vertical structure of the stress.
+!
+!----set up bottom values of stress
+!
+ do k = kts,kpblmax
+ do i = its,ite
+ if (k .le. kbl(i)) taup(i,k) = taub(i)
+ enddo
+ enddo
+!
+ do k = kpblmin, kte-1 ! vertical level k loop!
+ kp1 = k + 1
+ do i = its,ite
+!
+!-----unstablelayer if ri < ric
+!-----unstable layer if upper air vel comp along surf vel <=0 (crit lay)
+!---- at (u-c)=0. crit layer exists and bit vector should be set (.le.)
+!
+ if (k .ge. kbl(i)) then
+ icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric) &
+ .or. (velco(i,k) .le. 0.0)
+ brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared
+ brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency
+ endif
+ enddo
+!
+ do i = its,ite
+ if (k .ge. kbl(i) .and. (.not. ldrag(i))) then
+ if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0 ) then
+ temv = 1.0 / velco(i,k)
+ tem1 = xlinv(i)*(ro(i,kp1)+ro(i,k))*brvf(i)*velco(i,k)*0.5
+ hd = sqrt(taup(i,k) / tem1)
+ fro = brvf(i) * hd * temv
+!
+! rim is the minimum-richardson number by shutts (1985)
+!
+ tem2 = sqrt(usqj(i,k))
+ tem = 1. + tem2 * fro
+ rim = usqj(i,k) * (1.-fro) / (tem * tem)
+!
+! check stability to employ the 'saturation hypothesis'
+! of lindzen (1981) except at tropospheric downstream regions
+!
+ if (rim .le. ric) then ! saturation hypothesis!
+ if ((oa(i) .le. 0. .or. kp1 .ge. lowlv(i) )) then
+ temc = 2.0 + 1.0 / tem2
+ hd = velco(i,k) * (2.*sqrt(temc)-temc) / brvf(i)
+ taup(i,kp1) = tem1 * hd * hd
+ endif
+ else ! no wavebreaking!
+ taup(i,kp1) = taup(i,k)
+ endif
+ endif
+ endif
+ enddo
+ enddo
+!
+ if(lcap.lt.kte) then
+ do klcap = lcapp1,kte
+ do i = its,ite
+ taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap)
+ enddo
+ enddo
+ endif
+!
+! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy
+!
+ do k = kts,kte
+ do i = its,ite
+ taud(i,k) = 1. * (taup(i,k+1) - taup(i,k)) * csg / del(i,k)
+ enddo
+ enddo
+!
+!------limit de-acceleration (momentum deposition ) at top to 1/2 value
+!------the idea is some stuff must go out the 'top'
+!
+ do klcap = lcap,kte
+ do i = its,ite
+ taud(i,klcap) = taud(i,klcap) * factop
+ enddo
+ enddo
+!
+!------if the gravity wave drag would force a critical line
+!------in the lower ksmm1 layers during the next deltim timestep,
+!------then only apply drag until that critical line is reached.
+!
+ do k = kts,kpblmax-1
+ do i = its,ite
+ if (k .le. kbl(i)) then
+ if(taud(i,k).ne.0.) &
+ dtfac(i) = min(dtfac(i),abs(velco(i,k) &
+ /(deltim*rcs*taud(i,k))))
+ endif
+ enddo
+ enddo
+!
+ do i = its,ite
+ dusfc(i) = 0.
+ dvsfc(i) = 0.
+ enddo
+!
+ do k = kts,kte
+ do i = its,ite
+ taud(i,k) = taud(i,k) * dtfac(i)
+ dtaux = taud(i,k) * xn(i)
+ dtauy = taud(i,k) * yn(i)
+ dtaux2d(i,k) = dtaux
+ dtauy2d(i,k) = dtauy
+ dudt(i,k) = dtaux + dudt(i,k)
+ dvdt(i,k) = dtauy + dvdt(i,k)
+ dusfc(i) = dusfc(i) + dtaux * del(i,k)
+ dvsfc(i) = dvsfc(i) + dtauy * del(i,k)
+ enddo
+ enddo
+!
+ do i = its,ite
+ dusfc(i) = (-1./g*rcs) * dusfc(i)
+ dvsfc(i) = (-1./g*rcs) * dvsfc(i)
+ enddo
+!
+ return
+ end subroutine gwdo2d
+!-------------------------------------------------------------------
+end module module_bl_gwdo
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_bl_ysu.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_bl_ysu.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_bl_ysu.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,4 +1,4 @@
-!WRf:model_layer:physics
+!WRF:model_layer:physics
!
!
!
@@ -19,15 +19,21 @@
dz8w,psfc, &
znu,znw,mut,p_top, &
znt,ust,hpbl,psim,psih, &
- xland,hfx,qfx,gz1oz0,wspd,br, &
+ xland,hfx,qfx,wspd,br, &
dt,kpbl2d, &
exch_h, &
u10,v10, &
+ ctopo,ctopo2, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
!optional
- regime )
+ regime &
+#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
+ !MPAS specific optional arguments for additional diagnostics:
+ ,rho,kzhout,kzmout,kzqout &
+#endif
+ )
!-------------------------------------------------------------------
implicit none
!-------------------------------------------------------------------
@@ -72,7 +78,6 @@
!-- xland land mask (1 for land, 2 for water)
!-- hfx upward heat flux at the surface (w/m^2)
!-- qfx upward moisture flux at the surface (kg/m^2/s)
-!-- gz1oz0 log(z/z0) where z0 is roughness length
!-- wspd wind speed at lowest model level (m/s)
!-- u10 u-wind speed at 10 m (m/s)
!-- v10 v-wind speed at 10 m (m/s)
@@ -115,40 +120,39 @@
!
real, dimension( ims:ime, kms:kme, jms:jme ) , &
intent(in ) :: qv3d, &
- qc3d, &
- qi3d, &
- p3d, &
- pi3d, &
- th3d, &
- t3d, &
- dz8w
+ qc3d, &
+ qi3d, &
+ p3d, &
+ pi3d, &
+ th3d, &
+ t3d, &
+ dz8w
real, dimension( ims:ime, kms:kme, jms:jme ) , &
intent(in ) :: p3di
!
real, dimension( ims:ime, kms:kme, jms:jme ) , &
intent(inout) :: rublten, &
- rvblten, &
- rthblten, &
- rqvblten, &
+ rvblten, &
+ rthblten, &
+ rqvblten, &
rqcblten
!
real, dimension( ims:ime, kms:kme, jms:jme ) , &
intent(inout) :: exch_h
real, dimension( ims:ime, jms:jme ) , &
- intent(in ) :: u10, &
+ intent(inout) :: u10, &
v10
!
real, dimension( ims:ime, jms:jme ) , &
intent(in ) :: xland, &
- hfx, &
+ hfx, &
qfx, &
br, &
psfc
real, dimension( ims:ime, jms:jme ) , &
intent(in ) :: &
psim, &
- psih, &
- gz1oz0
+ psih
real, dimension( ims:ime, jms:jme ) , &
intent(inout) :: znt, &
ust, &
@@ -182,6 +186,10 @@
!
real, optional, intent(in ) :: p_top
!
+ real, dimension( ims:ime, jms:jme ) , &
+ optional , &
+ intent(in ) :: ctopo, &
+ ctopo2
!local
integer :: i,j,k
real, dimension( its:ite, kts:kte*ndiff ) :: rqvbl2dt, &
@@ -193,6 +201,23 @@
dvsfc, &
dtsfc, &
dqsfc
+#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
+!MPAS specific optional arguments for additional diagnostics (Laura Fowler = 2013-03-06):
+ real,intent(in),dimension(ims:ime,kms:kme,jms:jme),optional:: rho
+ real:: rho_d
+ real,intent(out),dimension(ims:ime,kms:kme,jms:jme),optional:: kzhout,kzmout,kzqout
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+ kzhout(i,k,j) = 0.
+ kzmout(i,k,j) = 0.
+ kzqout(i,k,j) = 0.
+ enddo
+ enddo
+ enddo
+!MPAS specific end.
+#endif
+
!
qv2d(:,:) = 0.0
do j = jts,jte
@@ -204,6 +229,26 @@
pdhi(i,k) = mut(i,j)*znw(k) + p_top
enddo
enddo
+ elseif(present(rho)) then
+ 203 format(1x,i4,1x,i2,10(1x,e15.8))
+!For MPAS, we replace the hydrostatic pressures defined at theta and w points by
+!the dry hydrostatic pressures (Laura D. Fowler):
+ k = kte+1
+ do i = its,ite
+ pdhi(i,k) = p3di(i,k,j)
+ enddo
+ do k = kte,kts,-1
+ do i = its,ite
+ rho_d = rho(i,k,j) / (1. + qv3d(i,k,j))
+ if(k.le.kte) pdhi(i,k) = pdhi(i,k+1) + g*rho_d*dz8w(i,k,j)
+ enddo
+ enddo
+ do k = kts,kte
+ do i = its,ite
+ pdh(i,k) = 0.5*(pdhi(i,k) + pdhi(i,k+1))
+ enddo
+ enddo
+!MPAS specific end.
else
do k = kts,kte+1
do i = its,ite
@@ -241,7 +286,15 @@
,dt=dt,rcl=1.0,kpbl1d=kpbl2d(ims,j) &
,exch_hx=exch_h(ims,kms,j) &
,u10=u10(ims,j),v10=v10(ims,j) &
- ,gz1oz0=gz1oz0(ims,j) &
+#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
+!MPAS specific optional arguments for additional diagnostics:
+ ,kzh=kzhout(ims,kms,j) &
+ ,kzm=kzmout(ims,kms,j) &
+ ,kzq=kzqout(ims,kms,j) &
+#endif
+#if ( ! NMM_CORE == 1 )
+ ,ctopo=ctopo(ims,j),ctopo2=ctopo2(ims,j) &
+#endif
,ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde &
,ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme &
,its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte )
@@ -270,12 +323,17 @@
dt,rcl,kpbl1d, &
exch_hx, &
u10,v10, &
- gz1oz0, &
+ ctopo,ctopo2, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
!optional
- regime )
+ regime &
+#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
+ !MPAS specific optional arguments for additional diagnostics:
+ ,kzh,kzm,kzq &
+#endif
+ )
!-------------------------------------------------------------------
implicit none
!-------------------------------------------------------------------
@@ -307,11 +365,24 @@
! pressure-level diffusion, april 2009
! ==> negligible differences
! implicit forcing for momentum with clean up, july 2009
-! ==> prevents model blownup when sfc layer is too low
-! increase of lamda, 30 < 0.1 x del z < 300, feb 2010
+! ==> prevents model blowup when sfc layer is too low
+! incresea of lamda, maximum (30, 0.1 x del z) feb 2010
! ==> prevents model blowup when delz is extremely large
! revised prandtl number at surface, peggy lemone, feb 2010
! ==> increase kh, decrease mixing due to counter-gradient term
+! revised thermal, shin et al. mon. wea. rev. , songyou hong, aug 2011
+! ==> reduce the thermal strength when z1 < 0.1 h
+! revised prandtl number for free convection, dudhia, mar 2012
+! ==> pr0 = 1 + bke (=0.272) when newtral, kh is reduced
+! minimum kzo = 0.01, lo = min (30m,delz), hong, mar 2012
+! ==> weaker mixing when stable, and les resolution in vertical
+! gz1oz0 is removed, and phim phih are ln(z1/z0)-phim,h, hong, mar 2012
+! ==> consider thermal z0 when differs from mechanical z0
+! a bug fix in wscale computation in stable bl, sukanta basu, jun 2012
+! ==> wscale becomes small with height, and less mixing in stable bl
+! ==> ri = max(ri,rimin). limits the richardson number to -100 in
+! unstable layers, following Hong et al. 2006.
+! Laura D. Fowler (2013-04-18).
!
! references:
!
@@ -324,7 +395,8 @@
!-------------------------------------------------------------------
!
real,parameter :: xkzmin = 0.01,xkzmax = 1000.,rimin = -100.
- real,parameter :: rlam = 30.,prmin = 0.25,prmax = 4.
+ real,parameter :: rlam = 150.,prmin = 0.25,prmax = 4.
+! real,parameter :: rlam = 30.,prmin = 0.25,prmax = 4.
real,parameter :: brcr_ub = 0.0,brcr_sb = 0.25,cori = 1.e-4
real,parameter :: afac = 6.8,bfac = 6.8,pfac = 2.0,pfac_q = 2.0
real,parameter :: phifac = 8.,sfcfrac = 0.1
@@ -382,7 +454,7 @@
!
real, dimension( ims:ime ), intent(in ) :: psim, &
psih
- real, dimension( ims:ime ), intent(in ) :: gz1oz0
+
!
real, dimension( ims:ime ), intent(in ) :: psfcpa
integer, dimension( ims:ime ), intent(out ) :: kpbl1d
@@ -390,9 +462,12 @@
real, dimension( ims:ime, kms:kme ) , &
intent(in ) :: ux, &
vx
-!optional
real, dimension( ims:ime ) , &
optional , &
+ intent(in ) :: ctopo, &
+ ctopo2
+ real, dimension( ims:ime ) , &
+ optional , &
intent(inout) :: regime
!
! local vars
@@ -400,29 +475,30 @@
real, dimension( its:ite ) :: hol
real, dimension( its:ite, kts:kte+1 ) :: zq
!
- real, dimension( its:ite, kts:kte ) :: &
+ real, dimension( its:ite, kts:kte ) :: &
thx,thvx, &
del, &
dza, &
dzq, &
+ xkzo, &
za
!
real, dimension( its:ite ) :: &
rhox, &
govrth, &
zl1,thermal, &
- wscale,hgamt, &
- hgamq,brdn, &
- brup,phim, &
- phih, &
+ wscale, &
+ hgamt,hgamq, &
+ brdn,brup, &
+ phim,phih, &
dusfc,dvsfc, &
dtsfc,dqsfc, &
prpbl, &
wspd1
!
real, dimension( its:ite, kts:kte ) :: xkzm,xkzh, &
- f1,f2, &
- r1,r2, &
+ f1,f2, &
+ r1,r2, &
ad,au, &
cu, &
al, &
@@ -433,8 +509,8 @@
real, dimension( ims:ime, kms:kme ) , &
intent(inout) :: exch_hx
!
- real, dimension( ims:ime ) , &
- intent(in ) :: u10, &
+ real, dimension( ims:ime ) , &
+ intent(inout) :: u10, &
v10
real, dimension( its:ite ) :: &
brcr, &
@@ -453,14 +529,15 @@
!
!
real :: dt2,rdt,spdk2,fm,fh,hol1,gamfac,vpert,prnum,prnum0
- real :: xkzo,ss,ri,qmean,tmean,alph,chi,zk,rl2,dk,sri
+ real :: ss,ri,qmean,tmean,alph,chi,zk,rl2,dk,sri
real :: brint,dtodsd,dtodsu,rdz,dsdzt,dsdzq,dsdz2,rlamdz
real :: utend,vtend,ttend,qtend
real :: dtstep,govrthv
real :: cont, conq, conw, conwrc
!
- real, dimension( its:ite, kts:kte ) :: wscalek, &
- xkzml,xkzhl, &
+ real, dimension( its:ite, kts:kte ) :: wscalek
+ real, dimension( its:ite ) :: delta
+ real, dimension( its:ite, kts:kte ) :: xkzml,xkzhl, &
zfacent,entfac
real, dimension( its:ite ) :: ust3, &
wstar3,wstar, &
@@ -469,10 +546,18 @@
bfxpbl, &
hfxpbl,qfxpbl, &
ufxpbl,vfxpbl, &
- delta,dthvx
+ dthvx, &
+ zol1
real :: prnumfac,bfx0,hfx0,qfx0,delb,dux,dvx, &
- dsdzu,dsdzv,wm3,dthx,dqx,wspd10,ross,tem1,dsig,tvcon,conpr,prfac
+ dsdzu,dsdzv,wm3,dthx,dqx,wspd10,ross,tem1,dsig,tvcon,conpr, &
+ prfac,prfac2,phim8z
!
+#if defined (non_hydrostatic_core) || defined(hydrostatic_core)
+!MPAS specific begin (Laura Fowler - 2013-03-01):
+ real,intent(out),dimension(ims:ime,kms:kme),optional::kzh,kzm,kzq
+!MPAS specific end.
+#endif
+
!----------------------------------------------------------------------
!
klpbl = kte
@@ -571,6 +656,20 @@
delta(i) = 0.0
enddo
!
+!MPAS specific begin (Laura Fowler - 2013-03-01): Added initialization of local
+!vertical diffusion coefficients:
+ if(present(kzh) .and. present(kzm) .and. present(kzq)) then
+ do k = kts,kte
+ do i = its,ite
+ xkzh(i,k) = 0.0
+ xkzm(i,k) = 0.0
+ xkzhl(i,k) = 0.0
+ xkzml(i,k) = 0.0
+ enddo
+ enddo
+ endif
+!MPAS specific end.
+!
do k = kts,klpbl
do i = its,ite
wscalek(i,k) = 0.0
@@ -582,6 +681,11 @@
zfac(i,k) = 0.0
enddo
enddo
+ do k = kts,klpbl-1
+ do i = its,ite
+ xkzo(i,k) = ckz*dza(i,k+1)
+ enddo
+ enddo
!
do i = its,ite
dusfc(i) = 0.
@@ -639,16 +743,15 @@
enddo
!
do i = its,ite
- fm = gz1oz0(i)-psim(i)
- fh = gz1oz0(i)-psih(i)
- hol(i) = max(br(i)*fm*fm/fh,rimin)
+ fm = psim(i)
+ fh = psih(i)
+ zol1(i) = max(br(i)*fm*fm/fh,rimin)
if(sfcflg(i))then
- hol(i) = min(hol(i),-zfmin)
+ zol1(i) = min(zol1(i),-zfmin)
else
- hol(i) = max(hol(i),zfmin)
+ zol1(i) = max(zol1(i),zfmin)
endif
- hol1 = hol(i)*hpbl(i)/zl1(i)*sfcfrac
- hol(i) = -hol(i)*hpbl(i)/zl1(i)
+ hol1 = zol1(i)*hpbl(i)/zl1(i)*sfcfrac
if(sfcflg(i))then
phim(i) = (1.-aphi16*hol1)**(-1./4.)
phih(i) = (1.-aphi16*hol1)**(-1./2.)
@@ -678,7 +781,7 @@
hgamt(i) = min(gamfac*hfx(i)/cp,gamcrt)
hgamq(i) = min(gamfac*qfx(i),gamcrq)
vpert = (hgamt(i)+ep1*thx(i,1)*hgamq(i))/bfac*afac
- thermal(i) = thermal(i)+max(vpert,0.)
+ thermal(i) = thermal(i)+max(vpert,0.)*min(za(i,1)/(sfcfrac*hpbl(i)),1.0)
hgamt(i) = max(hgamt(i),0.0)
hgamq(i) = max(hgamq(i),0.0)
brint = -15.9*ust(i)*ust(i)/wspd(i)*wstar3(i)/(wscale(i)**4.)
@@ -844,31 +947,34 @@
do i = its,ite
if(k.lt.kpbl(i)) then
zfac(i,k) = min(max((1.-(zq(i,k+1)-zl1(i))/(hpbl(i)-zl1(i))),zfmin),1.)
- xkzo = ckz*dza(i,k+1)
zfacent(i,k) = (1.-zfac(i,k))**3.
+ wscalek(i,k) = (ust3(i)+phifac*karman*wstar3(i)*(1.-zfac(i,k)))**h1
if(sfcflg(i)) then
- prfac = conpr/phim(i)/(1.+4.*karman*wstar3(i)/ust3(i))
+ prfac = conpr
+ prfac2 = 15.9*wstar3(i)/ust3(i)/(1.+4.*karman*wstar3(i)/ust3(i))
prnumfac = -3.*(max(zq(i,k+1)-sfcfrac*hpbl(i),0.))**2./hpbl(i)**2.
else
prfac = 0.
+ prfac2 = 0.
prnumfac = 0.
+ phim8z = 1.+aphi5*zol1(i)*zq(i,k+1)/zl1(i)
+ wscalek(i,k) = ust(i)/phim8z
+ wscalek(i,k) = max(wscalek(i,k),0.001)
endif
prnum0 = (phih(i)/phim(i)+prfac)
- prnum0 = min(prnum0,prmax)
- prnum0 = max(prnum0,prmin)
- wscalek(i,k) = (ust3(i)+phifac*karman*wstar3(i)*(1.-zfac(i,k)))**h1
- xkzm(i,k) = xkzo+wscalek(i,k)*karman*zq(i,k+1)*zfac(i,k)**pfac
+ prnum0 = max(min(prnum0,prmax),prmin)
+ xkzm(i,k) = wscalek(i,k)*karman*zq(i,k+1)*zfac(i,k)**pfac
prnum = 1. + (prnum0-1.)*exp(prnumfac)
xkzq(i,k) = xkzm(i,k)/prnum*zfac(i,k)**(pfac_q-pfac)
- prnum0 = prnum0/(1.+prfac)
+ prnum0 = prnum0/(1.+prfac2*karman*sfcfrac)
prnum = 1. + (prnum0-1.)*exp(prnumfac)
xkzh(i,k) = xkzm(i,k)/prnum
xkzm(i,k) = min(xkzm(i,k),xkzmax)
- xkzm(i,k) = max(xkzm(i,k),xkzmin)
+ xkzm(i,k) = max(xkzm(i,k),xkzo(i,k))
xkzh(i,k) = min(xkzh(i,k),xkzmax)
- xkzh(i,k) = max(xkzh(i,k),xkzmin)
+ xkzh(i,k) = max(xkzh(i,k),xkzo(i,k))
xkzq(i,k) = min(xkzq(i,k),xkzmax)
- xkzq(i,k) = max(xkzq(i,k),xkzmin)
+ xkzq(i,k) = max(xkzq(i,k),xkzo(i,k))
endif
enddo
enddo
@@ -877,7 +983,6 @@
!
do k = kts,kte-1
do i = its,ite
- xkzo = ckz*dza(i,k+1)
if(k.ge.kpbl(i)) then
ss = ((ux(i,k+1)-ux(i,k))*(ux(i,k+1)-ux(i,k)) &
+(vx(i,k+1)-vx(i,k))*(vx(i,k+1)-vx(i,k))) &
@@ -897,25 +1002,27 @@
endif
zk = karman*zq(i,k+1)
rlamdz = min(max(0.1*dza(i,k+1),rlam),300.)
+ rlamdz = min(dza(i,k+1),rlamdz)
rl2 = (zk*rlamdz/(rlamdz+zk))**2
dk = rl2*sqrt(ss)
+ ri = max(ri,rimin)
if(ri.lt.0.)then
! unstable regime
sri = sqrt(-ri)
- xkzm(i,k) = xkzo+dk*(1+8.*(-ri)/(1+1.746*sri))
- xkzh(i,k) = xkzo+dk*(1+8.*(-ri)/(1+1.286*sri))
+ xkzm(i,k) = dk*(1+8.*(-ri)/(1+1.746*sri))
+ xkzh(i,k) = dk*(1+8.*(-ri)/(1+1.286*sri))
else
! stable regime
- xkzh(i,k) = xkzo+dk/(1+5.*ri)**2
+ xkzh(i,k) = dk/(1+5.*ri)**2
prnum = 1.0+2.1*ri
prnum = min(prnum,prmax)
- xkzm(i,k) = (xkzh(i,k)-xkzo)*prnum+xkzo
+ xkzm(i,k) = xkzh(i,k)*prnum
endif
!
xkzm(i,k) = min(xkzm(i,k),xkzmax)
- xkzm(i,k) = max(xkzm(i,k),xkzmin)
+ xkzm(i,k) = max(xkzm(i,k),xkzo(i,k))
xkzh(i,k) = min(xkzh(i,k),xkzmax)
- xkzh(i,k) = max(xkzh(i,k),xkzmin)
+ xkzh(i,k) = max(xkzh(i,k),xkzo(i,k))
xkzml(i,k) = xkzm(i,k)
xkzhl(i,k) = xkzh(i,k)
endif
@@ -953,7 +1060,7 @@
xkzh(i,k) = -we(i)*dza(i,kpbl(i))*exp(-entfac(i,k))
xkzh(i,k) = sqrt(xkzh(i,k)*xkzhl(i,k))
xkzh(i,k) = min(xkzh(i,k),xkzmax)
- xkzh(i,k) = max(xkzh(i,k),xkzmin)
+ xkzh(i,k) = max(xkzh(i,k),xkzo(i,k))
f1(i,k+1) = thx(i,k+1)-300.
else
f1(i,k+1) = thx(i,k+1)-300.
@@ -989,7 +1096,7 @@
enddo
enddo
!
-! compute tridiagonal matrix elements for moisture, clouds, and tracers
+! compute tridiagonal matrix elements for moisture, clouds, and gases
!
do k = kts,kte
do i = its,ite
@@ -1044,7 +1151,7 @@
xkzq(i,k) = -we(i)*dza(i,kpbl(i))*exp(-entfac(i,k))
xkzq(i,k) = sqrt(xkzq(i,k)*xkzhl(i,k))
xkzq(i,k) = min(xkzq(i,k),xkzmax)
- xkzq(i,k) = max(xkzq(i,k),xkzmin)
+ xkzq(i,k) = max(xkzq(i,k),xkzo(i,k))
f3(i,k+1,1) = qx(i,k+1)
else
f3(i,k+1,1) = qx(i,k+1)
@@ -1086,7 +1193,7 @@
enddo
enddo
!
-! solve tridiagonal problem for moisture, clouds, and tracers
+! solve tridiagonal problem for moisture, clouds, and gases
!
call tridin_ysu(al,ad,cu,r3,au,f3,its,ite,kts,kte,ndiff)
!
@@ -1125,8 +1232,15 @@
enddo
!
do i = its,ite
- ad(i,1) = 1.+ust(i)**2/wspd1(i)*rhox(i)*g/del(i,1)*dt2 &
- *(wspd1(i)/wspd(i))**2
+! paj: ctopo=1 if topo_wind=0 (default)
+! mchen add this line to make sure NMM can still work with YSU PBL
+ if(present(ctopo)) then
+ ad(i,1) = 1.+ctopo(i)*ust(i)**2/wspd1(i)*rhox(i)*g/del(i,1)*dt2 &
+ *(wspd1(i)/wspd(i))**2
+ else
+ ad(i,1) = 1.+ust(i)**2/wspd1(i)*rhox(i)*g/del(i,1)*dt2 &
+ *(wspd1(i)/wspd(i))**2
+ endif
f1(i,1) = ux(i,1)
f2(i,1) = vx(i,1)
enddo
@@ -1149,7 +1263,7 @@
xkzm(i,k) = prpbl(i)*xkzh(i,k)
xkzm(i,k) = sqrt(xkzm(i,k)*xkzml(i,k))
xkzm(i,k) = min(xkzm(i,k),xkzmax)
- xkzm(i,k) = max(xkzm(i,k),xkzmin)
+ xkzm(i,k) = max(xkzm(i,k),xkzo(i,k))
f1(i,k+1) = ux(i,k+1)
f2(i,k+1) = vx(i,k+1)
else
@@ -1192,12 +1306,33 @@
enddo
enddo
!
+! paj: ctopo2=1 if topo_wind=0 (default)
+!
+ do i = its,ite
+ if(present(ctopo).and.present(ctopo2)) then ! mchen for NMM
+ u10(i) = ctopo2(i)*u10(i)+(1-ctopo2(i))*ux(i,1)
+ v10(i) = ctopo2(i)*v10(i)+(1-ctopo2(i))*vx(i,1)
+ endif !mchen
+ enddo
+!
!---- end of vertical diffusion
!
do i = its,ite
kpbl1d(i) = kpbl(i)
enddo
!
+!MPAS specific begin (Laura D. Fowler - 2013-03-01)::
+ if(present(kzh) .and. present(kzm) .and. present(kzq)) then
+ do i = its,ite
+ do k = kts,kte
+ kzh(i,k) = xkzh(i,k)
+ kzm(i,k) = xkzm(i,k)
+ kzq(i,k) = xkzq(i,k)
+ enddo
+ enddo
+ endif
+!MPAS specific end.
+
end subroutine ysu2d
!
subroutine tridi1n(cl,cm,cu,r1,r2,au,f1,f2,its,ite,kts,kte,nt)
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -63,7 +63,7 @@
VTMPC1=RV/RD-1.0, &
VTMPC2=CPV/CPD-1.0, &
CVDIFTS=1.0, &
- CEVAPCU1=1.93E-6*261., &
+ CEVAPCU1=1.93E-6*261.0*0.5/G, & ! Correction from WRFV3.4.1 sourcecode.
CEVAPCU2=1.E3/(38.3*0.293) )
Copied: branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_mp_radar.F (from rev 2782, trunk/mpas/src/core_atmos_physics/physics_wrf/module_mp_radar.F)
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_mp_radar.F (rev 0)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_mp_radar.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,685 @@
+!+---+-----------------------------------------------------------------+
+!..This set of routines facilitates computing radar reflectivity.
+!.. This module is more library code whereas the individual microphysics
+!.. schemes contains specific details needed for the final computation,
+!.. so refer to location within each schemes calling the routine named
+!.. rayleigh_soak_wetgraupel.
+!.. The bulk of this code originated from Ulrich Blahak (Germany) and
+!.. was adapted to WRF by G. Thompson. This version of code is only
+!.. intended for use when Rayleigh scattering principles dominate and
+!.. is not intended for wavelengths in which Mie scattering is a
+!.. significant portion. Therefore, it is well-suited to use with
+!.. 5 or 10 cm wavelength like USA NEXRAD radars.
+!.. This code makes some rather simple assumptions about water
+!.. coating on outside of frozen species (snow/graupel). Fraction of
+!.. meltwater is simply the ratio of mixing ratio below melting level
+!.. divided by mixing ratio at level just above highest T>0C. Also,
+!.. immediately 90% of the melted water exists on the ice's surface
+!.. and 10% is embedded within ice. No water is "shed" at all in these
+!.. assumptions. The code is quite slow because it does the reflectivity
+!.. calculations based on 50 individual size bins of the distributions.
+!+---+-----------------------------------------------------------------+
+
+MODULE module_mp_radar
+
+#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
+ USE mpas_atmphys_utilities
+#else
+ USE module_wrf_error
+#endif
+
+ PUBLIC :: rayleigh_soak_wetgraupel
+ PUBLIC :: radar_init
+ PRIVATE :: m_complex_water_ray
+ PRIVATE :: m_complex_ice_maetzler
+ PRIVATE :: m_complex_maxwellgarnett
+ PRIVATE :: get_m_mix_nested
+ PRIVATE :: get_m_mix
+ PRIVATE :: WGAMMA
+ PRIVATE :: GAMMLN
+
+
+ INTEGER, PARAMETER, PUBLIC:: nrbins = 50
+ DOUBLE PRECISION, DIMENSION(nrbins+1), PUBLIC:: xxDx
+ DOUBLE PRECISION, DIMENSION(nrbins), PUBLIC:: xxDs,xdts,xxDg,xdtg
+ DOUBLE PRECISION, PARAMETER, PUBLIC:: lamda_radar = 0.10 ! in meters
+ DOUBLE PRECISION, PUBLIC:: K_w, PI5, lamda4
+ COMPLEX*16, PUBLIC:: m_w_0, m_i_0
+ DOUBLE PRECISION, DIMENSION(nrbins+1), PUBLIC:: simpson
+ DOUBLE PRECISION, DIMENSION(3), PARAMETER, PUBLIC:: basis = &
+ (/1.d0/3.d0, 4.d0/3.d0, 1.d0/3.d0/)
+ REAL, DIMENSION(4), PUBLIC:: xcre, xcse, xcge, xcrg, xcsg, xcgg
+ REAL, PUBLIC:: xam_r, xbm_r, xmu_r, xobmr
+ REAL, PUBLIC:: xam_s, xbm_s, xmu_s, xoams, xobms, xocms
+ REAL, PUBLIC:: xam_g, xbm_g, xmu_g, xoamg, xobmg, xocmg
+ REAL, PUBLIC:: xorg2, xosg2, xogg2
+
+ INTEGER, PARAMETER, PUBLIC:: slen = 20
+ CHARACTER(len=slen), PUBLIC:: &
+ mixingrulestring_s, matrixstring_s, inclusionstring_s, &
+ hoststring_s, hostmatrixstring_s, hostinclusionstring_s, &
+ mixingrulestring_g, matrixstring_g, inclusionstring_g, &
+ hoststring_g, hostmatrixstring_g, hostinclusionstring_g
+
+!..Single melting snow/graupel particle 90% meltwater on external sfc
+ DOUBLE PRECISION, PARAMETER:: melt_outside_s = 0.9d0
+ DOUBLE PRECISION, PARAMETER:: melt_outside_g = 0.9d0
+
+ CHARACTER*256:: radar_debug
+
+CONTAINS
+
+!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+
+
+ subroutine radar_init
+
+ IMPLICIT NONE
+ INTEGER:: n
+ PI5 = 3.14159*3.14159*3.14159*3.14159*3.14159
+ lamda4 = lamda_radar*lamda_radar*lamda_radar*lamda_radar
+ m_w_0 = m_complex_water_ray (lamda_radar, 0.0d0)
+ m_i_0 = m_complex_ice_maetzler (lamda_radar, 0.0d0)
+ K_w = (ABS( (m_w_0*m_w_0 - 1.0) /(m_w_0*m_w_0 + 2.0) ))**2
+
+ do n = 1, nrbins+1
+ simpson(n) = 0.0d0
+ enddo
+ do n = 1, nrbins-1, 2
+ simpson(n) = simpson(n) + basis(1)
+ simpson(n+1) = simpson(n+1) + basis(2)
+ simpson(n+2) = simpson(n+2) + basis(3)
+ enddo
+
+ do n = 1, slen
+ mixingrulestring_s(n:n) = char(0)
+ matrixstring_s(n:n) = char(0)
+ inclusionstring_s(n:n) = char(0)
+ hoststring_s(n:n) = char(0)
+ hostmatrixstring_s(n:n) = char(0)
+ hostinclusionstring_s(n:n) = char(0)
+ mixingrulestring_g(n:n) = char(0)
+ matrixstring_g(n:n) = char(0)
+ inclusionstring_g(n:n) = char(0)
+ hoststring_g(n:n) = char(0)
+ hostmatrixstring_g(n:n) = char(0)
+ hostinclusionstring_g(n:n) = char(0)
+ enddo
+
+ mixingrulestring_s = 'maxwellgarnett'
+ hoststring_s = 'air'
+ matrixstring_s = 'water'
+ inclusionstring_s = 'spheroidal'
+ hostmatrixstring_s = 'icewater'
+ hostinclusionstring_s = 'spheroidal'
+
+ mixingrulestring_g = 'maxwellgarnett'
+ hoststring_g = 'air'
+ matrixstring_g = 'water'
+ inclusionstring_g = 'spheroidal'
+ hostmatrixstring_g = 'icewater'
+ hostinclusionstring_g = 'spheroidal'
+
+!..Create bins of snow (from 100 microns up to 2 cm).
+ xxDx(1) = 100.D-6
+ xxDx(nrbins+1) = 0.02d0
+ do n = 2, nrbins
+ xxDx(n) = DEXP(DFLOAT(n-1)/DFLOAT(nrbins) &
+ *DLOG(xxDx(nrbins+1)/xxDx(1)) +DLOG(xxDx(1)))
+ enddo
+ do n = 1, nrbins
+ xxDs(n) = DSQRT(xxDx(n)*xxDx(n+1))
+ xdts(n) = xxDx(n+1) - xxDx(n)
+ enddo
+
+!..Create bins of graupel (from 100 microns up to 5 cm).
+ xxDx(1) = 100.D-6
+ xxDx(nrbins+1) = 0.05d0
+ do n = 2, nrbins
+ xxDx(n) = DEXP(DFLOAT(n-1)/DFLOAT(nrbins) &
+ *DLOG(xxDx(nrbins+1)/xxDx(1)) +DLOG(xxDx(1)))
+ enddo
+ do n = 1, nrbins
+ xxDg(n) = DSQRT(xxDx(n)*xxDx(n+1))
+ xdtg(n) = xxDx(n+1) - xxDx(n)
+ enddo
+
+
+!..The calling program must set the m(D) relations and gamma shape
+!.. parameter mu for rain, snow, and graupel. Easily add other types
+!.. based on the template here. For majority of schemes with simpler
+!.. exponential number distribution, mu=0.
+
+ xcre(1) = 1. + xbm_r
+ xcre(2) = 1. + xmu_r
+ xcre(3) = 4. + xmu_r
+ xcre(4) = 7. + xmu_r
+ do n = 1, 4
+ xcrg(n) = WGAMMA(xcre(n))
+ enddo
+ xorg2 = 1./xcrg(2)
+
+ xcse(1) = 1. + xbm_s
+ xcse(2) = 1. + xmu_s
+ xcse(3) = 4. + xmu_s
+ xcse(4) = 7. + xmu_s
+ do n = 1, 4
+ xcsg(n) = WGAMMA(xcse(n))
+ enddo
+ xosg2 = 1./xcsg(2)
+
+ xcge(1) = 1. + xbm_g
+ xcge(2) = 1. + xmu_g
+ xcge(3) = 4. + xmu_g
+ xcge(4) = 7. + xmu_g
+ do n = 1, 4
+ xcgg(n) = WGAMMA(xcge(n))
+ enddo
+ xogg2 = 1./xcgg(2)
+
+ xobmr = 1./xbm_r
+ xoams = 1./xam_s
+ xobms = 1./xbm_s
+ xocms = xoams**xobms
+ xoamg = 1./xam_g
+ xobmg = 1./xbm_g
+ xocmg = xoamg**xobmg
+
+
+ end subroutine radar_init
+
+!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+
+
+ COMPLEX*16 FUNCTION m_complex_water_ray(lambda,T)
+
+! Complex refractive Index of Water as function of Temperature T
+! [deg C] and radar wavelength lambda [m]; valid for
+! lambda in [0.001,1.0] m; T in [-10.0,30.0] deg C
+! after Ray (1972)
+
+ IMPLICIT NONE
+ DOUBLE PRECISION, INTENT(IN):: T,lambda
+ DOUBLE PRECISION:: epsinf,epss,epsr,epsi
+ DOUBLE PRECISION:: alpha,lambdas,sigma,nenner
+ COMPLEX*16, PARAMETER:: i = (0d0,1d0)
+ DOUBLE PRECISION, PARAMETER:: PIx=3.1415926535897932384626434d0
+
+ epsinf = 5.27137d0 + 0.02164740d0 * T - 0.00131198d0 * T*T
+ epss = 78.54d+0 * (1.0 - 4.579d-3 * (T - 25.0) &
+ + 1.190d-5 * (T - 25.0)*(T - 25.0) &
+ - 2.800d-8 * (T - 25.0)*(T - 25.0)*(T - 25.0))
+ alpha = -16.8129d0/(T+273.16) + 0.0609265d0
+ lambdas = 0.00033836d0 * exp(2513.98d0/(T+273.16)) * 1e-2
+
+ nenner = 1.d0+2.d0*(lambdas/lambda)**(1d0-alpha)*sin(alpha*PIx*0.5) &
+ + (lambdas/lambda)**(2d0-2d0*alpha)
+ epsr = epsinf + ((epss-epsinf) * ((lambdas/lambda)**(1d0-alpha) &
+ * sin(alpha*PIx*0.5)+1d0)) / nenner
+ epsi = ((epss-epsinf) * ((lambdas/lambda)**(1d0-alpha) &
+ * cos(alpha*PIx*0.5)+0d0)) / nenner &
+ + lambda*1.25664/1.88496
+
+ m_complex_water_ray = SQRT(CMPLX(epsr,-epsi))
+
+ END FUNCTION m_complex_water_ray
+
+!+---+-----------------------------------------------------------------+
+
+ COMPLEX*16 FUNCTION m_complex_ice_maetzler(lambda,T)
+
+! complex refractive index of ice as function of Temperature T
+! [deg C] and radar wavelength lambda [m]; valid for
+! lambda in [0.0001,30] m; T in [-250.0,0.0] C
+! Original comment from the Matlab-routine of Prof. Maetzler:
+! Function for calculating the relative permittivity of pure ice in
+! the microwave region, according to C. Maetzler, "Microwave
+! properties of ice and snow", in B. Schmitt et al. (eds.) Solar
+! System Ices, Astrophys. and Space Sci. Library, Vol. 227, Kluwer
+! Academic Publishers, Dordrecht, pp. 241-257 (1998). Input:
+! TK = temperature (K), range 20 to 273.15
+! f = frequency in GHz, range 0.01 to 3000
+
+ IMPLICIT NONE
+ DOUBLE PRECISION, INTENT(IN):: T,lambda
+ DOUBLE PRECISION:: f,c,TK,B1,B2,b,deltabeta,betam,beta,theta,alfa
+
+ c = 2.99d8
+ TK = T + 273.16
+ f = c / lambda * 1d-9
+
+ B1 = 0.0207
+ B2 = 1.16d-11
+ b = 335.0d0
+ deltabeta = EXP(-10.02 + 0.0364*(TK-273.16))
+ betam = (B1/TK) * ( EXP(b/TK) / ((EXP(b/TK)-1)**2) ) + B2*f*f
+ beta = betam + deltabeta
+ theta = 300. / TK - 1.
+ alfa = (0.00504d0 + 0.0062d0*theta) * EXP(-22.1d0*theta)
+ m_complex_ice_maetzler = 3.1884 + 9.1e-4*(TK-273.16)
+ m_complex_ice_maetzler = m_complex_ice_maetzler &
+ + CMPLX(0.0d0, (alfa/f + beta*f))
+ m_complex_ice_maetzler = SQRT(CONJG(m_complex_ice_maetzler))
+
+ END FUNCTION m_complex_ice_maetzler
+
+!+---+-----------------------------------------------------------------+
+
+ subroutine rayleigh_soak_wetgraupel (x_g, a_geo, b_geo, fmelt, &
+ meltratio_outside, m_w, m_i, lambda, C_back, &
+ mixingrule,matrix,inclusion, &
+ host,hostmatrix,hostinclusion)
+
+ IMPLICIT NONE
+
+ DOUBLE PRECISION, INTENT(in):: x_g, a_geo, b_geo, fmelt, lambda, &
+ meltratio_outside
+ DOUBLE PRECISION, INTENT(out):: C_back
+ COMPLEX*16, INTENT(in):: m_w, m_i
+ CHARACTER(len=*), INTENT(in):: mixingrule, matrix, inclusion, &
+ host, hostmatrix, hostinclusion
+
+ COMPLEX*16:: m_core, m_air
+ DOUBLE PRECISION:: D_large, D_g, rhog, x_w, xw_a, fm, fmgrenz, &
+ volg, vg, volair, volice, volwater, &
+ meltratio_outside_grenz, mra
+ INTEGER:: error
+ DOUBLE PRECISION, PARAMETER:: PIx=3.1415926535897932384626434d0
+
+! refractive index of air:
+ m_air = (1.0d0,0.0d0)
+
+! Limiting the degree of melting --- for safety:
+ fm = DMAX1(DMIN1(fmelt, 1.0d0), 0.0d0)
+! Limiting the ratio of (melting on outside)/(melting on inside):
+ mra = DMAX1(DMIN1(meltratio_outside, 1.0d0), 0.0d0)
+
+! ! The relative portion of meltwater melting at outside should increase
+! ! from the given input value (between 0 and 1)
+! ! to 1 as the degree of melting approaches 1,
+! ! so that the melting particle "converges" to a water drop.
+! ! Simplest assumption is linear:
+ mra = mra + (1.0d0-mra)*fm
+
+ x_w = x_g * fm
+
+ D_g = a_geo * x_g**b_geo
+
+ if (D_g .ge. 1d-12) then
+
+ vg = PIx/6. * D_g**3
+ rhog = DMAX1(DMIN1(x_g / vg, 900.0d0), 10.0d0)
+ vg = x_g / rhog
+
+ meltratio_outside_grenz = 1.0d0 - rhog / 1000.
+
+ if (mra .le. meltratio_outside_grenz) then
+ !..In this case, it cannot happen that, during melting, all the
+ !.. air inclusions within the ice particle get filled with
+ !.. meltwater. This only happens at the end of all melting.
+ volg = vg * (1.0d0 - mra * fm)
+
+ else
+ !..In this case, at some melting degree fm, all the air
+ !.. inclusions get filled with meltwater.
+ fmgrenz=(900.0-rhog)/(mra*900.0-rhog+900.0*rhog/1000.)
+
+ if (fm .le. fmgrenz) then
+ !.. not all air pockets are filled:
+ volg = (1.0 - mra * fm) * vg
+ else
+ !..all air pockets are filled with meltwater, now the
+ !.. entire ice sceleton melts homogeneously:
+ volg = (x_g - x_w) / 900.0 + x_w / 1000.
+ endif
+
+ endif
+
+ D_large = (6.0 / PIx * volg) ** (1./3.)
+ volice = (x_g - x_w) / (volg * 900.0)
+ volwater = x_w / (1000. * volg)
+ volair = 1.0 - volice - volwater
+
+ !..complex index of refraction for the ice-air-water mixture
+ !.. of the particle:
+ m_core = get_m_mix_nested (m_air, m_i, m_w, volair, volice, &
+ volwater, mixingrule, host, matrix, inclusion, &
+ hostmatrix, hostinclusion, error)
+ if (error .ne. 0) then
+ C_back = 0.0d0
+ return
+ endif
+
+ !..Rayleigh-backscattering coefficient of melting particle:
+ C_back = (ABS((m_core**2-1.0d0)/(m_core**2+2.0d0)))**2 &
+ * PI5 * D_large**6 / lamda4
+
+ else
+ C_back = 0.0d0
+ endif
+
+ end subroutine rayleigh_soak_wetgraupel
+
+!+---+-----------------------------------------------------------------+
+
+ complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, &
+ volice, volwater, mixingrule, host, matrix, &
+ inclusion, hostmatrix, hostinclusion, cumulerror)
+
+ IMPLICIT NONE
+
+ DOUBLE PRECISION, INTENT(in):: volice, volair, volwater
+ COMPLEX*16, INTENT(in):: m_a, m_i, m_w
+ CHARACTER(len=*), INTENT(in):: mixingrule, host, matrix, &
+ inclusion, hostmatrix, hostinclusion
+ INTEGER, INTENT(out):: cumulerror
+
+ DOUBLE PRECISION:: vol1, vol2
+ COMPLEX*16:: mtmp
+ INTEGER:: error
+
+ !..Folded: ( (m1 + m2) + m3), where m1,m2,m3 could each be
+ !.. air, ice, or water
+
+ cumulerror = 0
+ get_m_mix_nested = CMPLX(1.0d0,0.0d0)
+
+ if (host .eq. 'air') then
+
+ if (matrix .eq. 'air') then
+ write(radar_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ cumulerror = cumulerror + 1
+ else
+ vol1 = volice / MAX(volice+volwater,1d-10)
+ vol2 = 1.0d0 - vol1
+ mtmp = get_m_mix (m_a, m_i, m_w, 0.0d0, vol1, vol2, &
+ mixingrule, matrix, inclusion, error)
+ cumulerror = cumulerror + error
+
+ if (hostmatrix .eq. 'air') then
+ get_m_mix_nested = get_m_mix (m_a, mtmp, 2.0*m_a, &
+ volair, (1.0d0-volair), 0.0d0, mixingrule, &
+ hostmatrix, hostinclusion, error)
+ cumulerror = cumulerror + error
+ elseif (hostmatrix .eq. 'icewater') then
+ get_m_mix_nested = get_m_mix (m_a, mtmp, 2.0*m_a, &
+ volair, (1.0d0-volair), 0.0d0, mixingrule, &
+ 'ice', hostinclusion, error)
+ cumulerror = cumulerror + error
+ else
+ write(radar_debug,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', &
+ hostmatrix
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ cumulerror = cumulerror + 1
+ endif
+ endif
+
+ elseif (host .eq. 'ice') then
+
+ if (matrix .eq. 'ice') then
+ write(radar_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ cumulerror = cumulerror + 1
+ else
+ vol1 = volair / MAX(volair+volwater,1d-10)
+ vol2 = 1.0d0 - vol1
+ mtmp = get_m_mix (m_a, m_i, m_w, vol1, 0.0d0, vol2, &
+ mixingrule, matrix, inclusion, error)
+ cumulerror = cumulerror + error
+
+ if (hostmatrix .eq. 'ice') then
+ get_m_mix_nested = get_m_mix (mtmp, m_i, 2.0*m_a, &
+ (1.0d0-volice), volice, 0.0d0, mixingrule, &
+ hostmatrix, hostinclusion, error)
+ cumulerror = cumulerror + error
+ elseif (hostmatrix .eq. 'airwater') then
+ get_m_mix_nested = get_m_mix (mtmp, m_i, 2.0*m_a, &
+ (1.0d0-volice), volice, 0.0d0, mixingrule, &
+ 'air', hostinclusion, error)
+ cumulerror = cumulerror + error
+ else
+ write(radar_debug,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', &
+ hostmatrix
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ cumulerror = cumulerror + 1
+ endif
+ endif
+
+ elseif (host .eq. 'water') then
+
+ if (matrix .eq. 'water') then
+ write(radar_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ cumulerror = cumulerror + 1
+ else
+ vol1 = volair / MAX(volice+volair,1d-10)
+ vol2 = 1.0d0 - vol1
+ mtmp = get_m_mix (m_a, m_i, m_w, vol1, vol2, 0.0d0, &
+ mixingrule, matrix, inclusion, error)
+ cumulerror = cumulerror + error
+
+ if (hostmatrix .eq. 'water') then
+ get_m_mix_nested = get_m_mix (2*m_a, mtmp, m_w, &
+ 0.0d0, (1.0d0-volwater), volwater, mixingrule, &
+ hostmatrix, hostinclusion, error)
+ cumulerror = cumulerror + error
+ elseif (hostmatrix .eq. 'airice') then
+ get_m_mix_nested = get_m_mix (2*m_a, mtmp, m_w, &
+ 0.0d0, (1.0d0-volwater), volwater, mixingrule, &
+ 'ice', hostinclusion, error)
+ cumulerror = cumulerror + error
+ else
+ write(radar_debug,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', &
+ hostmatrix
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ cumulerror = cumulerror + 1
+ endif
+ endif
+
+ elseif (host .eq. 'none') then
+
+ get_m_mix_nested = get_m_mix (m_a, m_i, m_w, &
+ volair, volice, volwater, mixingrule, &
+ matrix, inclusion, error)
+ cumulerror = cumulerror + error
+
+ else
+ write(radar_debug,*) 'GET_M_MIX_NESTED: unknown matrix: ', host
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ cumulerror = cumulerror + 1
+ endif
+
+ IF (cumulerror .ne. 0) THEN
+ write(radar_debug,*) 'GET_M_MIX_NESTED: error encountered'
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ get_m_mix_nested = CMPLX(1.0d0,0.0d0)
+ endif
+
+ end function get_m_mix_nested
+
+!+---+-----------------------------------------------------------------+
+
+ COMPLEX*16 FUNCTION get_m_mix (m_a, m_i, m_w, volair, volice, &
+ volwater, mixingrule, matrix, inclusion, error)
+
+ IMPLICIT NONE
+
+ DOUBLE PRECISION, INTENT(in):: volice, volair, volwater
+ COMPLEX*16, INTENT(in):: m_a, m_i, m_w
+ CHARACTER(len=*), INTENT(in):: mixingrule, matrix, inclusion
+ INTEGER, INTENT(out):: error
+
+ error = 0
+ get_m_mix = CMPLX(1.0d0,0.0d0)
+
+ if (mixingrule .eq. 'maxwellgarnett') then
+ if (matrix .eq. 'ice') then
+ get_m_mix = m_complex_maxwellgarnett(volice, volair, volwater, &
+ m_i, m_a, m_w, inclusion, error)
+ elseif (matrix .eq. 'water') then
+ get_m_mix = m_complex_maxwellgarnett(volwater, volair, volice, &
+ m_w, m_a, m_i, inclusion, error)
+ elseif (matrix .eq. 'air') then
+ get_m_mix = m_complex_maxwellgarnett(volair, volwater, volice, &
+ m_a, m_w, m_i, inclusion, error)
+ else
+ write(radar_debug,*) 'GET_M_MIX: unknown matrix: ', matrix
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ error = 1
+ endif
+
+ else
+ write(radar_debug,*) 'GET_M_MIX: unknown mixingrule: ', mixingrule
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ error = 2
+ endif
+
+ if (error .ne. 0) then
+ write(radar_debug,*) 'GET_M_MIX: error encountered'
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ endif
+
+ END FUNCTION get_m_mix
+
+!+---+-----------------------------------------------------------------+
+
+ COMPLEX*16 FUNCTION m_complex_maxwellgarnett(vol1, vol2, vol3, &
+ m1, m2, m3, inclusion, error)
+
+ IMPLICIT NONE
+
+ COMPLEX*16 :: m1, m2, m3
+ DOUBLE PRECISION :: vol1, vol2, vol3
+ CHARACTER(len=*) :: inclusion
+
+ COMPLEX*16 :: beta2, beta3, m1t, m2t, m3t
+ INTEGER, INTENT(out) :: error
+
+ error = 0
+
+ if (DABS(vol1+vol2+vol3-1.0d0) .gt. 1d-6) then
+ write(radar_debug,*) 'M_COMPLEX_MAXWELLGARNETT: sum of the ', &
+ 'partial volume fractions is not 1...ERROR'
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ m_complex_maxwellgarnett=CMPLX(-999.99d0,-999.99d0)
+ error = 1
+ return
+ endif
+
+ m1t = m1**2
+ m2t = m2**2
+ m3t = m3**2
+
+ if (inclusion .eq. 'spherical') then
+ beta2 = 3.0d0*m1t/(m2t+2.0d0*m1t)
+ beta3 = 3.0d0*m1t/(m3t+2.0d0*m1t)
+ elseif (inclusion .eq. 'spheroidal') then
+ beta2 = 2.0d0*m1t/(m2t-m1t) * (m2t/(m2t-m1t)*LOG(m2t/m1t)-1.0d0)
+ beta3 = 2.0d0*m1t/(m3t-m1t) * (m3t/(m3t-m1t)*LOG(m3t/m1t)-1.0d0)
+ else
+ write(radar_debug,*) 'M_COMPLEX_MAXWELLGARNETT: ', &
+ 'unknown inclusion: ', inclusion
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ call physics_message(radar_debug)
+#else
+ CALL wrf_debug(150, radar_debug)
+#endif
+ m_complex_maxwellgarnett=DCMPLX(-999.99d0,-999.99d0)
+ error = 1
+ return
+ endif
+
+ m_complex_maxwellgarnett = &
+ SQRT(((1.0d0-vol2-vol3)*m1t + vol2*beta2*m2t + vol3*beta3*m3t) / &
+ (1.0d0-vol2-vol3+vol2*beta2+vol3*beta3))
+
+ END FUNCTION m_complex_maxwellgarnett
+
+!+---+-----------------------------------------------------------------+
+ REAL FUNCTION GAMMLN(XX)
+! --- RETURNS THE VALUE LN(GAMMA(XX)) FOR XX > 0.
+ IMPLICIT NONE
+ REAL, INTENT(IN):: XX
+ DOUBLE PRECISION, PARAMETER:: STP = 2.5066282746310005D0
+ DOUBLE PRECISION, DIMENSION(6), PARAMETER:: &
+ COF = (/76.18009172947146D0, -86.50532032941677D0, &
+ 24.01409824083091D0, -1.231739572450155D0, &
+ .1208650973866179D-2, -.5395239384953D-5/)
+ DOUBLE PRECISION:: SER,TMP,X,Y
+ INTEGER:: J
+
+ X=XX
+ Y=X
+ TMP=X+5.5D0
+ TMP=(X+0.5D0)*LOG(TMP)-TMP
+ SER=1.000000000190015D0
+ DO 11 J=1,6
+ Y=Y+1.D0
+ SER=SER+COF(J)/Y
+11 CONTINUE
+ GAMMLN=TMP+LOG(STP*SER/X)
+ END FUNCTION GAMMLN
+! (C) Copr. 1986-92 Numerical Recipes Software 2.02
+!+---+-----------------------------------------------------------------+
+ REAL FUNCTION WGAMMA(y)
+
+ IMPLICIT NONE
+ REAL, INTENT(IN):: y
+
+ WGAMMA = EXP(GAMMLN(y))
+
+ END FUNCTION WGAMMA
+
+!+---+-----------------------------------------------------------------+
+END MODULE module_mp_radar
+!+---+-----------------------------------------------------------------+
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_mp_wsm6.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_mp_wsm6.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_mp_wsm6.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -8,6 +8,13 @@
MODULE module_mp_wsm6
!
+!#if defined(non_hydrostatic_core) || defined(hydrostatic_code)
+! USE mpas_atmphys_utilities
+!#else
+! USE module_utility, ONLY: WRFU_Clock, WRFU_Alarm
+! USE module_domain, ONLY : HISTORY_ALARM, Is_alarm_tstep
+!#endif
+ USE module_mp_radar
!
REAL, PARAMETER, PRIVATE :: dtcldcr = 120. ! maximum time step for minor loops
REAL, PARAMETER, PRIVATE :: n0r = 8.e6 ! intercept parameter rain
@@ -64,6 +71,7 @@
,rain, rainncv &
,snow, snowncv &
,sr &
+ ,refl_10cm, diagflag, do_radar_ref &
,graupel, graupelncv &
,ids,ide, jds,jde, kds,kde &
,ims,ime, jms,jme, kms,kme &
@@ -112,6 +120,16 @@
INTENT(INOUT) :: rain, &
rainncv, &
sr
+
+!+---+-----------------------------------------------------------------+
+#if defined(non_hydrostatic_core) | defined(hydrostatic_core)
+ REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT),optional:: & ! GT
+ refl_10cm
+#else
+ REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & ! GT
+#endif
+!+---+-----------------------------------------------------------------+
+
REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, &
INTENT(INOUT) :: snow, &
snowncv
@@ -123,7 +141,13 @@
REAL, DIMENSION( its:ite , kts:kte, 2 ) :: qci
REAL, DIMENSION( its:ite , kts:kte, 3 ) :: qrs
INTEGER :: i,j,k
-!-------------------------------------------------------------------
+
+!+---+-----------------------------------------------------------------+
+ REAL, DIMENSION(kts:kte):: qv1d, t1d, p1d, qr1d, qs1d, qg1d, dBZ
+ LOGICAL, OPTIONAL, INTENT(IN) :: diagflag
+ INTEGER, OPTIONAL, INTENT(IN) :: do_radar_ref
+!+---+-----------------------------------------------------------------+
+
DO j=jts,jte
DO k=kts,kte
DO i=its,ite
@@ -163,6 +187,29 @@
qg(i,k,j) = qrs(i,k,3)
ENDDO
ENDDO
+
+!+---+-----------------------------------------------------------------+
+ IF ( PRESENT (diagflag) ) THEN
+ if (diagflag .and. do_radar_ref == 1) then
+ DO I=its,ite
+ DO K=kts,kte
+ t1d(k)=th(i,k,j)*pii(i,k,j)
+ p1d(k)=p(i,k,j)
+ qv1d(k)=q(i,k,j)
+ qr1d(k)=qr(i,k,j)
+ qs1d(k)=qs(i,k,j)
+ qg1d(k)=qg(i,k,j)
+ ENDDO
+ call refl10cm_wsm6 (qv1d, qr1d, qs1d, qg1d, &
+ t1d, p1d, dBZ, kts, kte, i, j)
+ do k = kts, kte
+ refl_10cm(i,k,j) = MAX(-35., dBZ(k))
+ enddo
+ ENDDO
+ endif
+ ENDIF
+!+---+-----------------------------------------------------------------+
+
ENDDO
END SUBROUTINE wsm6
!===================================================================
@@ -1489,6 +1536,24 @@
rsloper3max = rsloper2max * rslopermax
rslopes3max = rslopes2max * rslopesmax
rslopeg3max = rslopeg2max * rslopegmax
+
+!+---+-----------------------------------------------------------------+
+!..Set these variables needed for computing radar reflectivity. These
+!.. get used within radar_init to create other variables used in the
+!.. radar module.
+ xam_r = PI*denr/6.
+ xbm_r = 3.
+ xmu_r = 0.
+ xam_s = PI*dens/6.
+ xbm_s = 3.
+ xmu_s = 0.
+ xam_g = PI*deng/6.
+ xbm_g = 3.
+ xmu_g = 0.
+
+ call radar_init
+!+---+-----------------------------------------------------------------+
+
!
END SUBROUTINE wsm6init
!------------------------------------------------------------------------------
@@ -2215,4 +2280,182 @@
enddo i_loop
!
END SUBROUTINE nislfv_rain_plm6
+
+!+---+-----------------------------------------------------------------+
+
+ subroutine refl10cm_wsm6 (qv1d, qr1d, qs1d, qg1d, &
+ t1d, p1d, dBZ, kts, kte, ii, jj)
+
+ IMPLICIT NONE
+
+!..Sub arguments
+ INTEGER, INTENT(IN):: kts, kte, ii, jj
+ REAL, DIMENSION(kts:kte), INTENT(IN):: &
+ qv1d, qr1d, qs1d, qg1d, t1d, p1d
+ REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ
+
+!..Local variables
+ REAL, DIMENSION(kts:kte):: temp, pres, qv, rho
+ REAL, DIMENSION(kts:kte):: rr, rs, rg
+ REAL:: temp_C
+
+ DOUBLE PRECISION, DIMENSION(kts:kte):: ilamr, ilams, ilamg
+ DOUBLE PRECISION, DIMENSION(kts:kte):: N0_r, N0_s, N0_g
+ DOUBLE PRECISION:: lamr, lams, lamg
+ LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg
+
+ REAL, DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel
+ DOUBLE PRECISION:: fmelt_s, fmelt_g
+
+ INTEGER:: i, k, k_0, kbot, n
+ LOGICAL:: melti
+
+ DOUBLE PRECISION:: cback, x, eta, f_d
+ REAL, PARAMETER:: R=287.
+
+!+---+
+
+ do k = kts, kte
+ dBZ(k) = -35.0
+ enddo
+
+!+---+-----------------------------------------------------------------+
+!..Put column of data into local arrays.
+!+---+-----------------------------------------------------------------+
+ do k = kts, kte
+ temp(k) = t1d(k)
+ temp_C = min(-0.001, temp(K)-273.15)
+ qv(k) = MAX(1.E-10, qv1d(k))
+ pres(k) = p1d(k)
+ rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622))
+
+ if (qr1d(k) .gt. 1.E-9) then
+ rr(k) = qr1d(k)*rho(k)
+ N0_r(k) = n0r
+ lamr = (xam_r*xcrg(3)*N0_r(k)/rr(k))**(1./xcre(1))
+ ilamr(k) = 1./lamr
+ L_qr(k) = .true.
+ else
+ rr(k) = 1.E-12
+ L_qr(k) = .false.
+ endif
+
+ if (qs1d(k) .gt. 1.E-9) then
+ rs(k) = qs1d(k)*rho(k)
+ N0_s(k) = min(n0smax, n0s*exp(-alpha*temp_C))
+ lams = (xam_s*xcsg(3)*N0_s(k)/rs(k))**(1./xcse(1))
+ ilams(k) = 1./lams
+ L_qs(k) = .true.
+ else
+ rs(k) = 1.E-12
+ L_qs(k) = .false.
+ endif
+
+ if (qg1d(k) .gt. 1.E-9) then
+ rg(k) = qg1d(k)*rho(k)
+ N0_g(k) = n0g
+ lamg = (xam_g*xcgg(3)*N0_g(k)/rg(k))**(1./xcge(1))
+ ilamg(k) = 1./lamg
+ L_qg(k) = .true.
+ else
+ rg(k) = 1.E-12
+ L_qg(k) = .false.
+ endif
+ enddo
+
+!+---+-----------------------------------------------------------------+
+!..Locate K-level of start of melting (k_0 is level above).
+!+---+-----------------------------------------------------------------+
+ melti = .false.
+ k_0 = kts
+ do k = kte-1, kts, -1
+ if ( (temp(k).gt.273.15) .and. L_qr(k) &
+ .and. (L_qs(k+1).or.L_qg(k+1)) ) then
+ k_0 = MAX(k+1, k_0)
+ melti=.true.
+ goto 195
+ endif
+ enddo
+ 195 continue
+
+!+---+-----------------------------------------------------------------+
+!..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps)
+!.. and non-water-coated snow and graupel when below freezing are
+!.. simple. Integrations of m(D)*m(D)*N(D)*dD.
+!+---+-----------------------------------------------------------------+
+
+ do k = kts, kte
+ ze_rain(k) = 1.e-22
+ ze_snow(k) = 1.e-22
+ ze_graupel(k) = 1.e-22
+ if (L_qr(k)) ze_rain(k) = N0_r(k)*xcrg(4)*ilamr(k)**xcre(4)
+ if (L_qs(k)) ze_snow(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI) &
+ * (xam_s/900.0)*(xam_s/900.0) &
+ * N0_s(k)*xcsg(4)*ilams(k)**xcse(4)
+ if (L_qg(k)) ze_graupel(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI) &
+ * (xam_g/900.0)*(xam_g/900.0) &
+ * N0_g(k)*xcgg(4)*ilamg(k)**xcge(4)
+ enddo
+
+
+!+---+-----------------------------------------------------------------+
+!..Special case of melting ice (snow/graupel) particles. Assume the
+!.. ice is surrounded by the liquid water. Fraction of meltwater is
+!.. extremely simple based on amount found above the melting level.
+!.. Uses code from Uli Blahak (rayleigh_soak_wetgraupel and supporting
+!.. routines).
+!+---+-----------------------------------------------------------------+
+
+ if (melti .and. k_0.ge.kts+1) then
+ do k = k_0-1, kts, -1
+
+!..Reflectivity contributed by melting snow
+ if (L_qs(k) .and. L_qs(k_0) ) then
+ fmelt_s = MAX(0.005d0, MIN(1.0d0-rs(k)/rs(k_0), 0.99d0))
+ eta = 0.d0
+ lams = 1./ilams(k)
+ do n = 1, nrbins
+ x = xam_s * xxDs(n)**xbm_s
+ call rayleigh_soak_wetgraupel (x,DBLE(xocms),DBLE(xobms), &
+ fmelt_s, melt_outside_s, m_w_0, m_i_0, lamda_radar, &
+ CBACK, mixingrulestring_s, matrixstring_s, &
+ inclusionstring_s, hoststring_s, &
+ hostmatrixstring_s, hostinclusionstring_s)
+ f_d = N0_s(k)*xxDs(n)**xmu_s * DEXP(-lams*xxDs(n))
+ eta = eta + f_d * CBACK * simpson(n) * xdts(n)
+ enddo
+ ze_snow(k) = SNGL(lamda4 / (pi5 * K_w) * eta)
+ endif
+
+
+!..Reflectivity contributed by melting graupel
+
+ if (L_qg(k) .and. L_qg(k_0) ) then
+ fmelt_g = MAX(0.005d0, MIN(1.0d0-rg(k)/rg(k_0), 0.99d0))
+ eta = 0.d0
+ lamg = 1./ilamg(k)
+ do n = 1, nrbins
+ x = xam_g * xxDg(n)**xbm_g
+ call rayleigh_soak_wetgraupel (x,DBLE(xocmg),DBLE(xobmg), &
+ fmelt_g, melt_outside_g, m_w_0, m_i_0, lamda_radar, &
+ CBACK, mixingrulestring_g, matrixstring_g, &
+ inclusionstring_g, hoststring_g, &
+ hostmatrixstring_g, hostinclusionstring_g)
+ f_d = N0_g(k)*xxDg(n)**xmu_g * DEXP(-lamg*xxDg(n))
+ eta = eta + f_d * CBACK * simpson(n) * xdtg(n)
+ enddo
+ ze_graupel(k) = SNGL(lamda4 / (pi5 * K_w) * eta)
+ endif
+
+ enddo
+ endif
+
+ do k = kte, kts, -1
+ dBZ(k) = 10.*log10((ze_rain(k)+ze_snow(k)+ze_graupel(k))*1.d18)
+ enddo
+
+
+ end subroutine refl10cm_wsm6
+!+---+-----------------------------------------------------------------+
+
END MODULE module_mp_wsm6
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_ra_rrtmg_sw.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_ra_rrtmg_sw.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_ra_rrtmg_sw.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -8544,8 +8544,14 @@
taucmcl ,ssacmcl ,asmcmcl ,fsfcmcl , &
ciwpmcl ,clwpmcl ,reicmcl ,relqmcl , &
tauaer ,ssaaer ,asmaer ,ecaer , &
- swuflx ,swdflx ,swhr ,swuflxc ,swdflxc ,swhrc)
+ swuflx ,swdflx ,swhr ,swuflxc ,swdflxc ,swhrc, &
+! --------- Add the following four compenants for ssib shortwave down radiation ---!
+! ------------------- by Zhenxin 2011-06-20 --------------------------------!
+ sibvisdir, sibvisdif, sibnirdir, sibnirdif &
+ )
+! ---------------------- End, Zhenxin 2011-06-20 --------------------------------!
+
! ------- Description -------
! This program is the driver for RRTMG_SW, the AER SW radiation model for
@@ -8743,6 +8749,14 @@
! Dimensions: (ncol,nlay+1)
real(kind=rb), intent(out) :: swdflx(:,:) ! Total sky shortwave downward flux (W/m2)
! Dimensions: (ncol,nlay+1)
+ real(kind=rb), intent(out) :: sibvisdir(:,:) ! visible direct downward flux (W/m2)
+ ! Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
+ real(kind=rb), intent(out) :: sibvisdif(:,:) ! visible diffusion downward flux (W/m2)
+ ! Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
+ real(kind=rb), intent(out) :: sibnirdir(:,:) ! Near IR direct downward flux (W/m2)
+ ! Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
+ real(kind=rb), intent(out) :: sibnirdif(:,:) ! Near IR diffusion downward flux (W/m2)
+ ! Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
real(kind=rb), intent(out) :: swhr(:,:) ! Total sky shortwave radiative heating rate (K/d)
! Dimensions: (ncol,nlay)
real(kind=rb), intent(out) :: swuflxc(:,:) ! Clear sky shortwave upward flux (W/m2)
@@ -9070,7 +9084,7 @@
do ib = 1, nbndsw
ztaua(i,ib) = 0._rb
zasya(i,ib) = 0._rb
- zomga(i,ib) = 1._rb
+ zomga(i,ib) = 0._rb
do ia = 1, naerec
ztaua(i,ib) = ztaua(i,ib) + rsrtaua(ib,ia) * ecaer(iplon,i,ia)
zomga(i,ib) = zomga(i,ib) + rsrtaua(ib,ia) * ecaer(iplon,i,ia) * &
@@ -9142,15 +9156,24 @@
swdflx(iplon,i) = zbbfd(i)
uvdflx(i) = zuvfd(i)
nidflx(i) = znifd(i)
+
! Direct/diffuse fluxes
dirdflux(i) = zbbfddir(i)
difdflux(i) = swdflx(iplon,i) - dirdflux(i)
! UV/visible direct/diffuse fluxes
dirdnuv(i) = zuvfddir(i)
difdnuv(i) = zuvfd(i) - dirdnuv(i)
+! ------- Zhenxin add vis/uv downwards dir or dif here --!
+ sibvisdir(iplon,i) = dirdnuv(i)
+ sibvisdif(iplon,i) = difdnuv(i)
+! ----- End of Zhenxin addition ------------!
! Near-IR direct/diffuse fluxes
dirdnir(i) = znifddir(i)
difdnir(i) = znifd(i) - dirdnir(i)
+! ---------Zhenxin add nir downwards dir and dif here --!
+ sibnirdir(iplon,i) = dirdnir(i)
+ sibnirdif(iplon,i) = difdnir(i)
+! -------- End of Zhenxin addition 2011-05 ---------!
enddo
! Total and clear sky net fluxes
@@ -9546,12 +9569,12 @@
MODULE module_ra_rrtmg_sw
#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
-!MPAS specific (Laura D. Fowler):
+!MPAS specific (Laura D. Fowler - 2013-03-11):
use mpas_atmphys_constants,only: cp
#else
use module_model_constants, only : cp
-use module_wrf_error
-!use module_dm
+USE module_wrf_error
+!USE module_dm
#endif
!MPAS specific end.
@@ -9584,7 +9607,19 @@
xland, xice, snow, &
qv3d, qc3d, qr3d, &
qi3d, qs3d, qg3d, &
+ alswvisdir, alswvisdif, & !Zhenxin ssib alb comp (06/20/2011)
+ alswnirdir, alswnirdif, & !Zhenxin ssib alb comp (06/20/2011)
+ swvisdir, swvisdif, & !Zhenxin ssib swr comp (06/20/2011)
+ swnirdir, swnirdif, & !Zhenxin ssib swi comp (06/20/2011)
+ sf_surface_physics, & !Zhenxin
f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, &
+ tauaer300,tauaer400,tauaer600,tauaer999, & ! czhao
+ gaer300,gaer400,gaer600,gaer999, & ! czhao
+ waer300,waer400,waer600,waer999, & ! czhao
+ aer_ra_feedback, &
+!jdfcz progn,prescribe, &
+ progn, &
+ qndrop3d,f_qndrop, & !czhao
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
@@ -9631,6 +9666,24 @@
TSK, &
ALBEDO
!
+!!! ------------------- Zhenxin (2011-06/20) ------------------
+ REAL, DIMENSION( ims:ime, jms:jme ) , &
+ OPTIONAL , &
+ INTENT(IN) :: ALSWVISDIR, & ! ssib albedo of sw and lw
+ ALSWVISDIF, &
+ ALSWNIRDIR, &
+ ALSWNIRDIF
+
+ REAL, DIMENSION( ims:ime, jms:jme ) , &
+ OPTIONAL , &
+ INTENT(OUT) :: SWVISDIR, &
+ SWVISDIF, &
+ SWNIRDIR, &
+ SWNIRDIF ! ssib sw dir and diff rad
+ INTEGER, INTENT(IN) :: sf_surface_physics ! ssib para
+
+! ----------------------- end Zhenxin --------------------------
+!
REAL, INTENT(IN ) :: R,G
!
! Optional
@@ -9644,8 +9697,11 @@
QR3D, &
QI3D, &
QS3D, &
- QG3D
+ QG3D, &
+ QNDROP3D
+ real pi,third,relconst,lwpmin,rhoh2o
+
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
OPTIONAL , &
INTENT(IN ) :: &
@@ -9653,8 +9709,30 @@
F_RAIN_PHY
LOGICAL, OPTIONAL, INTENT(IN) :: &
- F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
+ F_QV,F_QC,F_QR,F_QI,F_QS,F_QG,F_QNDROP
+! Optional
+ REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL , &
+ INTENT(IN ) :: tauaer300,tauaer400,tauaer600,tauaer999, & ! czhao
+ gaer300,gaer400,gaer600,gaer999, & ! czhao
+ waer300,waer400,waer600,waer999 ! czhao
+
+ INTEGER, INTENT(IN ), OPTIONAL :: aer_ra_feedback
+!jdfcz INTEGER, INTENT(IN ), OPTIONAL :: progn,prescribe
+ INTEGER, INTENT(IN ), OPTIONAL :: progn
+
+ !wavelength corresponding to wavenum1 and wavenum2 (cm-1)
+ real, save :: wavemin(nbndsw) ! Min wavelength (um) of 14 intervals
+ data wavemin /3.077,2.500,2.150,1.942,1.626,1.299, &
+ 1.242,0.778,0.625,0.442,0.345,0.263,0.200,3.846/
+ real, save :: wavemax(nbndsw) ! Max wavelength (um) of interval
+ data wavemax/3.846,3.077,2.500,2.150,1.942,1.626, &
+ 1.299,1.242,0.778,0.625,0.442,0.345,0.263,12.195/
+ real wavemid(nbndsw) ! Mid wavelength (um) of interval
+ real, parameter :: thresh=1.e-9
+ real ang,slope
+ character(len=200) :: msg
+
! Top of atmosphere and surface shortwave fluxes (W m-2)
REAL, DIMENSION( ims:ime, jms:jme ), &
OPTIONAL, INTENT(INOUT) :: &
@@ -9663,8 +9741,7 @@
! Layer shortwave fluxes (including extra layer above model top)
! Vertical ordering is from bottom to top (W m-2)
-! REAL, DIMENSION( ims:ime, kms:kme+2, jms:jme ), &
- REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), &
+ REAL, DIMENSION( ims:ime, kms:kme+2, jms:jme ), &
OPTIONAL, INTENT(OUT) :: &
SWUPFLX,SWUPFLXC,SWDNFLX,SWDNFLXC
@@ -9683,7 +9760,8 @@
QR1D, &
QI1D, &
QS1D, &
- QG1D
+ QG1D, &
+ qndrop1d
! Added local arrays for RRTMG
integer :: ncol, &
@@ -9739,7 +9817,11 @@
real, dimension( 1, kts:kte+2 ) :: swuflx, &
swdflx, &
swuflxc, &
- swdflxc
+ swdflxc, &
+ sibvisdir, & ! Zhenxin 2011-06-20
+ sibvisdif, &
+ sibnirdir, &
+ sibnirdif ! Zhenxin 2011-06-20
real, dimension( 1, kts:kte+1 ) :: swhr, &
swhrc
@@ -9822,6 +9904,26 @@
LOGICAL :: predicate
!------------------------------------------------------------------
+#ifdef WRF_CHEM
+ IF ( aer_ra_feedback == 1) then
+ IF ( .NOT. &
+ ( PRESENT(tauaer300) .AND. &
+ PRESENT(tauaer400) .AND. &
+ PRESENT(tauaer600) .AND. &
+ PRESENT(tauaer999) .AND. &
+ PRESENT(gaer300) .AND. &
+ PRESENT(gaer400) .AND. &
+ PRESENT(gaer600) .AND. &
+ PRESENT(gaer999) .AND. &
+ PRESENT(waer300) .AND. &
+ PRESENT(waer400) .AND. &
+ PRESENT(waer600) .AND. &
+ PRESENT(waer999) ) ) THEN
+ CALL wrf_error_fatal &
+ ('Warning: missing fields required for aerosol radiation' )
+ ENDIF
+ ENDIF
+#endif
!-----CALCULATE SHORT WAVE RADIATION
!
@@ -9850,6 +9952,7 @@
! clat(i) = xxlat
coszrs = sin(xxlat) * sin(declin) + cos(xxlat) * cos(declin) * cos(hrang)
coszr(i,j) = coszrs
+
! Set flag to prevent shortwave calculation when sun below horizon
if (coszrs.le.0.0) dorrsw = .false.
! Perform shortwave calculation if sun above horizon
@@ -9867,6 +9970,7 @@
QI1D(K)=0.
QS1D(K)=0.
CLDFRA1D(k)=0.
+ QNDROP1D(k)=0.
ENDDO
DO K=kts,kte
@@ -9908,6 +10012,14 @@
ENDIF
ENDIF
+ IF ( PRESENT(F_QNDROP).AND.PRESENT(QNDROP3D)) THEN
+ IF (F_QNDROP) THEN
+ DO K=kts,kte
+ qndrop1d(K)=qndrop3d(I,K,J)
+ ENDDO
+ ENDIF
+ ENDIF
+
! This logic is tortured because cannot test F_QI unless
! it is present, and order of evaluation of expressions
! is not specified in Fortran
@@ -10053,11 +10165,31 @@
! Set surface albedo for direct and diffuse radiation in UV/visible and
! near-IR spectral regions
+! -------------- Zhenxin 2011-06-20 ----------- !
+
+! ------- 1. Commented by Zhenxin 2011-06-20 for SSiB coupling modified ---- !
+! asdir(ncol) = albedo(i,j)
+! asdif(ncol) = albedo(i,j)
+! aldir(ncol) = albedo(i,j)
+! aldif(ncol) = albedo(i,j)
+! ------- End of Comments ------ !
+
+! ------- 2. New Addiation ------ !
+ IF ( sf_surface_physics .eq. 8 .AND. XLAND(i,j) .LT. 1.5) THEN
+ asdir(ncol) = ALSWVISDIR(I,J)
+ asdif(ncol) = ALSWVISDIF(I,J)
+ aldir(ncol) = ALSWNIRDIR(I,J)
+ aldif(ncol) = ALSWNIRDIF(I,J)
+ ELSE
asdir(ncol) = albedo(i,j)
asdif(ncol) = albedo(i,j)
aldir(ncol) = albedo(i,j)
aldif(ncol) = albedo(i,j)
+ ENDIF
+! ---------- End of Addiation ------!
+! ---------- End of fds_Zhenxin 2011-06-20 --------------!
+
! Define cloud optical properties for radiation (inflgsw = 0)
! This option is not currently active
! Cloud and precipitation paths in g/m2
@@ -10114,12 +10246,59 @@
cliqwp(ncol,k) = gliqwp / max(0.01,cldfrac(ncol,k)) ! In-cloud liquid water path.
end do
+!link the aerosol feedback to cloud -czhao
+ if( PRESENT( progn ) ) then
+ if (progn == 1) then
+!jdfcz if(prescribe==0) then
+
+ pi = 4.*atan(1.0)
+ third=1./3.
+ rhoh2o=1.e3
+ relconst=3/(4.*pi*rhoh2o)
+! minimun liquid water path to calculate rel
+! corresponds to optical depth of 1.e-3 for radius 4 microns.
+ lwpmin=3.e-5
+ do k = kts, kte
+ reliq(ncol,k) = 10.
+ if( PRESENT( F_QNDROP ) ) then
+ if( F_QNDROP ) then
+ if ( qc1d(k)*pdel(ncol,k).gt.lwpmin.and. &
+ qndrop1d(k).gt.1000. ) then
+ reliq(ncol,k)=(relconst*qc1d(k)/qndrop1d(k))**third ! effective radius in m
+! apply scaling from Martin et al., JAS 51, 1830.
+ reliq(ncol,k)=1.1*reliq(ncol,k)
+ reliq(ncol,k)=reliq(ncol,k)*1.e6 ! convert from m to microns
+ reliq(ncol,k)=max(reliq(ncol,k),4.)
+ reliq(ncol,k)=min(reliq(ncol,k),20.)
+ end if
+ end if
+ end if
+ end do
+!jdfcz else ! prescribe
! following Kiehl
- call relcalc(ncol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
+ call relcalc(ncol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
+! write(0,*) 'sw prescribe aerosol',maxval(qndrop3d)
+!jdfcz endif
+ else ! progn
+ call relcalc(ncol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
+ endif
+ else !progn
+ call relcalc(ncol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
+ endif
! following Kristjansson and Mitchell
- call reicalc(ncol, pcols, pver, tlay, reice)
+ call reicalc(ncol, pcols, pver, tlay, reice)
+#if 0
+ if (i==80.and.j==30) then
+#if defined( DM_PARALLEL ) && ! defined( STUBMPI)
+ if( PRESENT( progn ) ) write(0,*) 'aerosol indirect',progn
+ write(0,*)'sw water eff radius',reliq(ncol,10),reliq(ncol,20),reliq(ncol,25)
+ write(0,*)'sw ice eff radius',reice(ncol,10),reice(ncol,20),reice(ncol,25)
+#endif
+ endif
+#endif
+
! Limit upper bound of reice for Fu ice parameterization and convert
! from effective radius to generalized effective size (*1.0315; Fu, 1996)
if (iceflgsw .eq. 3) then
@@ -10172,17 +10351,111 @@
cldfmcl, ciwpmcl, clwpmcl, reicmcl, relqmcl, &
taucmcl, ssacmcl, asmcmcl, fsfcmcl)
-! Aerosol optical depth, single scattering albedo and asymmetry parameter
+!--------------------------------------------------------------------------
+! Aerosol optical depth, single scattering albedo and asymmetry parameter -czhao 03/2010
+!--------------------------------------------------------------------------
! by layer for each RRTMG shortwave band
! No aerosols in top layer above model top (kte+1).
- do nb = 1, nbndsw
- do k = kts, kte+1
- tauaer(ncol,k,nb) = 0.
- ssaaer(ncol,k,nb) = 1.
- asmaer(ncol,k,nb) = 0.
- enddo
- enddo
+!cz do nb = 1, nbndsw
+!cz do k = kts, kte+1
+!cz tauaer(ncol,k,nb) = 0.
+!cz ssaaer(ncol,k,nb) = 1.
+!cz asmaer(ncol,k,nb) = 0.
+!cz enddo
+!cz enddo
+! ... Aerosol effects. Added aerosol feedbacks from Chem , 03/2010 -czhao
+!
+ do nb = 1, nbndsw
+ do k = kts,kte+1
+ tauaer(ncol,k,nb) = 0.
+ ssaaer(ncol,k,nb) = 1.
+ asmaer(ncol,k,nb) = 0.
+ end do
+ end do
+
+#ifdef WRF_CHEM
+ IF ( AER_RA_FEEDBACK == 1) then
+ do nb = 1, nbndsw
+ wavemid(nb)=0.5*(wavemin(nb)+wavemax(nb)) ! um
+ do k = kts,kte !wig
+
+! convert optical properties at 300,400,600, and 999 to conform to the band wavelengths
+! tauaer - use angstrom exponent
+ if(tauaer300(i,k,j).gt.thresh .and. tauaer999(i,k,j).gt.thresh) then
+ ang=alog(tauaer300(i,k,j)/tauaer999(i,k,j))/alog(999./300.)
+ tauaer(ncol,k,nb)=tauaer400(i,k,j)*(0.4/wavemid(nb))**ang
+ !tauaer(ncol,k,nb)=tauaer600(i,k,j)*(0.6/wavemid(nb))**ang
+ if (i==30.and.j==49.and.k==2.and.nb==12) then
+ write(0,*) 'TAU from 600 vs 400 in RRTMG',tauaer600(i,k,j),tauaer400(i,k,j)
+ print*, 'TAU from 600 vs 400 in RRTMG',tauaer600(i,k,j),tauaer400(i,k,j)
+ write(0,*) tauaer600(i,k,j)*(0.6/wavemid(nb))**ang,tauaer400(i,k,j)*(0.4/wavemid(nb))**ang
+ print*, tauaer600(i,k,j)*(0.6/wavemid(nb))**ang,tauaer400(i,k,j)*(0.4/wavemid(nb))**ang
+ endif
+! ssa - linear interpolation; extrapolation
+ slope=(waer600(i,k,j)-waer400(i,k,j))/.2
+ ssaaer(ncol,k,nb) = slope*(wavemid(nb)-.6)+waer600(i,k,j)
+ if(ssaaer(ncol,k,nb).lt.0.4) ssaaer(ncol,k,nb)=0.4
+ if(ssaaer(ncol,k,nb).ge.1.0) ssaaer(ncol,k,nb)=1.0
+! g - linear interpolation;extrapolation
+ slope=(gaer600(i,k,j)-gaer400(i,k,j))/.2
+ asmaer(ncol,k,nb) = slope*(wavemid(nb)-.6)+gaer600(i,k,j) ! notice reversed varaibles
+ if(asmaer(ncol,k,nb).lt.0.5) asmaer(ncol,k,nb)=0.5
+ if(asmaer(ncol,k,nb).ge.1.0) asmaer(ncol,k,nb)=1.0
+ endif
+ end do ! k
+ end do ! nb
+
+!wig beg
+ do nb = 1, nbndsw
+ slope = 0. !use slope as a sum holder
+ do k = kts,kte
+ slope = slope + tauaer(ncol,k,nb)
+ end do
+ if( slope < 0. ) then
+ write(msg,'("ERROR: Negative total optical depth of ",f8.2," at point i,j,nb=",3i5)') slope,i,j,nb
+ call wrf_error_fatal(msg)
+ else if( slope > 6. ) then
+ call wrf_message("-------------------------")
+ write(msg,'("WARNING: Large total sw optical depth of ",f8.2," at point i,j,nb=",3i5)') slope,i,j,nb
+ call wrf_message(msg)
+
+ call wrf_message("Diagnostics 1: k, tauaer300, tauaer400, tauaer600, tauaer999, tauaer")
+ do k=kts,kte
+ write(msg,'(i4,5f8.2)') k, tauaer300(i,k,j), tauaer400(i,k,j), &
+ tauaer600(i,k,j), tauaer999(i,k,j),tauaer(ncol,k,nb)
+ call wrf_message(msg)
+ !czhao set an up-limit here to avoid segmentation fault
+ !from extreme AOD
+ tauaer(ncol,k,nb)=tauaer(ncol,k,nb)*6.0/slope
+ end do
+
+ call wrf_message("Diagnostics 2: k, gaer300, gaer400, gaer600, gaer999")
+ do k=kts,kte
+ write(msg,'(i4,4f8.2)') k, gaer300(i,k,j), gaer400(i,k,j), &
+ gaer600(i,k,j), gaer999(i,k,j)
+ call wrf_message(msg)
+ end do
+
+ call wrf_message("Diagnostics 3: k, waer300, waer400, waer600, waer999")
+ do k=kts,kte
+ write(msg,'(i4,4f8.2)') k, waer300(i,k,j), waer400(i,k,j), &
+ waer600(i,k,j), waer999(i,k,j)
+ call wrf_message(msg)
+ end do
+
+ call wrf_message("Diagnostics 4: k, ssaal, asyal, taual")
+ do k=kts-1,kte
+ write(msg,'(i4,3f8.2)') k, ssaaer(i,k,nb), asmaer(i,k,nb), tauaer(i,k,nb)
+ call wrf_message(msg)
+ end do
+ call wrf_message("-------------------------")
+ endif
+ enddo ! nb
+ endif ! aer_ra_feedback
+#endif
+
+
! Zero array for input of aerosol optical thickness for use with
! ECMWF aerosol types (not used)
do na = 1, naerec
@@ -10203,7 +10476,11 @@
taucmcl ,ssacmcl ,asmcmcl ,fsfcmcl , &
ciwpmcl ,clwpmcl ,reicmcl ,relqmcl , &
tauaer ,ssaaer ,asmaer ,ecaer , &
- swuflx ,swdflx ,swhr ,swuflxc ,swdflxc ,swhrc)
+ swuflx ,swdflx ,swhr ,swuflxc ,swdflxc ,swhrc, &
+! ----- Zhenxin added for ssib coupiling 2011-06-20 --------!
+ sibvisdir, sibvisdif, sibnirdir, sibnirdif &
+ )
+! -------------------- End of addiation by Zhenxin 2011-06-20 ------!
! Output net absorbed shortwave surface flux and shortwave cloud forcing
! at the top of atmosphere (W/m2)
@@ -10220,6 +10497,12 @@
swupb(i,j) = swuflx(1,1)
swupbc(i,j) = swuflxc(1,1)
swdnb(i,j) = swdflx(1,1)
+! Added by Zhenxin for 4 compenants of swdown radiation
+ swvisdir(i,j) = sibvisdir(1,1)
+ swvisdif(i,j) = sibvisdif(1,1)
+ swnirdir(i,j) = sibnirdir(1,1)
+ swnirdif(i,j) = sibnirdif(1,1)
+! Ended, Zhenxin (2011/06/20)
swdnbc(i,j) = swdflxc(1,1)
endif
@@ -10252,6 +10535,10 @@
swupbc(i,j) = 0.
swdnb(i,j) = 0.
swdnbc(i,j) = 0.
+ swvisdir(i,j) = 0. ! Add by Zhenxin (2011/06/20)
+ swvisdif(i,j) = 0.
+ swnirdir(i,j) = 0.
+ swnirdif(i,j) = 0. ! Add by Zhenxin (2011/06/20)
endif
endif
@@ -10264,15 +10551,14 @@
END SUBROUTINE RRTMG_SWRAD
-
-!ldf (12-20-2010): This section of the module is moved to module_physics_rrtmg_swinit.F in
+!ldf (2013-03-11): This section of the module is moved to module_physics_rrtmg_swinit.F in
!./../core_physics to accomodate differences in the mpi calls between WRF and MPAS.I thought
!that it would be cleaner to do this instead of adding a lot of #ifdef statements throughout
!the initialization of the shortwave radiation code. Initialization is handled the same way
!for the longwave radiation code.
#if !(defined(non_hydrostatic_core) || defined(hydrostatic_core))
-
+
!====================================================================
SUBROUTINE rrtmg_swinit( &
allowed_to_read , &
@@ -10325,11 +10611,7 @@
rrtmg_unit = -1
2010 CONTINUE
ENDIF
-!ldf (11-08-2010): changed wrf_dm_bcast_bytes to wrf_dm_bcast_integer to avoid warning at
-!compilation time:
-! CALL wrf_dm_bcast_bytes ( rrtmg_unit , IWORDSIZE )
- CALL wrf_dm_bcast_integer ( rrtmg_unit , IWORDSIZE )
-!ldf end.
+ CALL wrf_dm_bcast_bytes ( rrtmg_unit , IWORDSIZE )
IF ( rrtmg_unit < 0 ) THEN
CALL wrf_error_fatal ( 'module_ra_rrtmg_sw: rrtm_swlookuptable: Can not '// &
'find unused fortran unit to read in lookup table.' )
@@ -11454,6 +11736,6 @@
!------------------------------------------------------------------
#endif
-!ldf end (12-20-2010).
+!ldf end (2013-03-11).
END MODULE module_ra_rrtmg_sw
Modified: branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_sf_sfclay.F
===================================================================
--- branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_sf_sfclay.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_atmos_physics/physics_wrf/module_sf_sfclay.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -14,6 +14,7 @@
SUBROUTINE SFCLAY(U3D,V3D,T3D,QV3D,P3D,dz8w, &
CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
+ FM,FH, &
XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
U10,V10,TH2,T2,Q2, &
GZ1OZ0,WSPD,BR,ISFFLX,DX, &
@@ -23,7 +24,11 @@
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
- ustm,ck,cka,cd,cda,isftcflx,iz0tlnd,areaCell )
+ ustm,ck,cka,cd,cda,isftcflx,iz0tlnd,scm_force_flux &
+#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
+ ,areaCell &
+#endif
+ )
!-------------------------------------------------------------------
IMPLICIT NONE
!-------------------------------------------------------------------
@@ -50,6 +55,8 @@
!-- REGIME flag indicating PBL regime (stable, unstable, etc.)
!-- PSIM similarity stability function for momentum
!-- PSIH similarity stability function for heat
+!-- FM integrated stability function for momentum
+!-- FH integrated stability function for heat
!-- XLAND land mask (1 for land, 2 for water)
!-- HFX upward heat flux at the surface (W/m^2)
!-- QFX upward moisture flux at the surface (kg/m^2/s)
@@ -146,7 +153,7 @@
!
REAL, DIMENSION( ims:ime, jms:jme ) , &
INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
- PSIM,PSIH
+ PSIM,PSIH,FM,FH
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
INTENT(IN ) :: U3D, &
@@ -175,16 +182,18 @@
REAL, INTENT(IN ) :: CP,G,ROVCP,R,XLV,DX
-!MPAS specific (Laura D. Fowler):
-! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ) , &
-! INTENT(OUT) :: ck,cka,cd,cda,ustm
- real, optional, dimension( ims:ime, jms:jme ) , &
- intent(inout) :: ck,cka,cd,cda,ustm
+ REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ) , &
+ INTENT(OUT) :: ck,cka,cd,cda,ustm
+
+ INTEGER, OPTIONAL, INTENT(IN ) :: ISFTCFLX, IZ0TLND
+ INTEGER, OPTIONAL, INTENT(IN ) :: SCM_FORCE_FLUX
+
+#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
+!MPAS specific (Laura D. Fowler - 2013-03-06):
real,intent(in),dimension(ims:ime,jms:jme),optional:: areaCell
!MPAS specific end.
+#endif
- INTEGER, OPTIONAL, INTENT(IN ) :: ISFTCFLX, IZ0TLND
-
! LOCAL VARS
REAL, DIMENSION( its:ite ) :: U1D, &
@@ -218,6 +227,7 @@
CQS2(ims,j),CPM(ims,j),PBLH(ims,j), RMOL(ims,j), &
ZNT(ims,j),UST(ims,j),MAVAIL(ims,j),ZOL(ims,j), &
MOL(ims,j),REGIME(ims,j),PSIM(ims,j),PSIH(ims,j), &
+ FM(ims,j),FH(ims,j), &
XLAND(ims,j),HFX(ims,j),QFX(ims,j),TSK(ims,j), &
U10(ims,j),V10(ims,j),TH2(ims,j),T2(ims,j), &
Q2(ims,j),FLHC(ims,j),FLQC(ims,j),QGH(ims,j), &
@@ -229,26 +239,26 @@
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte &
#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
-!MPAS specific (Laura D. Fowler):
- ,isftcflx,iz0tlnd, &
+!MPAS specific (Laura D. Fowler - 2013-03-06):
+ ,isftcflx,iz0tlnd,scm_force_flux, &
USTM(ims,j),CK(ims,j),CKA(ims,j), &
CD(ims,j),CDA(ims,j),areaCell(ims,j) &
-!#elseif ( EM_CORE == 1 )
-! ,isftcflx,iz0tlnd, &
-! USTM(ims,j),CK(ims,j),CKA(ims,j), &
-! CD(ims,j),CDA(ims,j) &
+#elif ( EM_CORE == 1 )
+ ,isftcflx,iz0tlnd,scm_force_flux, &
+ USTM(ims,j),CK(ims,j),CKA(ims,j), &
+ CD(ims,j),CDA(ims,j) &
#endif
)
ENDDO
-
+
END SUBROUTINE SFCLAY
!-------------------------------------------------------------------
SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, &
CP,G,ROVCP,R,XLV,PSFCPA,CHS,CHS2,CQS2,CPM,PBLH,RMOL, &
- ZNT,UST,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
+ ZNT,UST,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH,FM,FH,&
XLAND,HFX,QFX,TSK, &
U10,V10,TH2,T2,Q2,FLHC,FLQC,QGH, &
QSFC,LH,GZ1OZ0,WSPD,BR,ISFFLX,DX, &
@@ -258,9 +268,14 @@
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
- isftcflx, iz0tlnd, &
- ustm,ck,cka,cd,cda, &
- areaCell)
+ isftcflx, iz0tlnd, scm_force_flux, &
+#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
+!MPAS specific (Laura D. Fowler - 2013-03-06):
+ ustm,ck,cka,cd,cda,areaCell )
+#else
+ ustm,ck,cka,cd,cda )
+#endif
+
!-------------------------------------------------------------------
IMPLICIT NONE
!-------------------------------------------------------------------
@@ -296,7 +311,7 @@
!
REAL, DIMENSION( ims:ime ) , &
INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
- PSIM,PSIH
+ PSIM,PSIH,FM,FH
REAL, DIMENSION( ims:ime ) , &
INTENT(INOUT) :: ZNT, &
@@ -334,11 +349,14 @@
INTENT(OUT) :: ck,cka,cd,cda,ustm
INTEGER, OPTIONAL, INTENT(IN ) :: ISFTCFLX, IZ0TLND
+ INTEGER, OPTIONAL, INTENT(IN ) :: SCM_FORCE_FLUX
-!MPAS specific (Laura D. Fowler): We take into accound the actual size of individual
-!grid-boxes:
+#if defined(non_hydrostatic_core) || defined(hydrostatic_core)
+!MPAS specific (Laura D. Fowler - 2013-03-06):
real,intent(in),dimension(ims:ime),optional:: areaCell
!MPAS specific end.
+#endif
+
! LOCAL VARS
@@ -372,6 +390,7 @@
REAL :: ZL,TSKV,DTHVDZ,DTHVM,VCONV,RZOL,RZOL2,RZOL10,ZOL2,ZOL10
REAL :: DTG,PSIX,DTTHX,PSIX10,PSIT,PSIT2,PSIQ,PSIQ2,PSIQ10
REAL :: FLUXC,VSGD,Z0Q,VISC,RESTAR,CZIL,RESTAR2
+ REAL :: ZW, ZN1, ZN2
!-------------------------------------------------------------------
KL=kte
@@ -511,8 +530,6 @@
else
VSGD = 0.32 * (max(dx/5000.-1.,0.))**.33
endif
-! write(0,201) i,areaCell(i),vsgd
-! 201 format(i8,2(1x,e15.8))
!MPAS specific end.
WSPD(I)=SQRT(WSPD(I)*WSPD(I)+VCONV*VCONV+vsgd*vsgd)
WSPD(I)=AMAX1(WSPD(I),0.1)
@@ -523,7 +540,7 @@
RMOL(I)=-GOVRTH(I)*DTHVDZ*ZA(I)*KARMAN
!jdf
- 260 CONTINUE
+ 260 CONTINUE
!
!-----DIAGNOSE BASIC PARAMETERS FOR THE APPROPRIATED STABILITY CLASS:
@@ -782,20 +799,25 @@
DENOMQ(I)=PSIQ
DENOMQ2(I)=PSIQ2
DENOMT2(I)=PSIT2
+ FM(I)=PSIX
+ FH(I)=PSIT
330 CONTINUE
!
335 CONTINUE
!-----COMPUTE THE SURFACE SENSIBLE AND LATENT HEAT FLUXES:
-
+ IF ( PRESENT(SCM_FORCE_FLUX) ) THEN
+ IF (SCM_FORCE_FLUX.EQ.1) GOTO 350
+ ENDIF
DO i=its,ite
QFX(i)=0.
HFX(i)=0.
ENDDO
+ 350 CONTINUE
IF (ISFFLX.EQ.0) GOTO 410
-!-----OVER WATER, ALTER ROUGHNESS LENGTH (ZNT) ACCORDING TO WIND (UST).
+!-----OVER WATER, ALTER ROUGHNESS LENGTH (ZNT) ACCORDING TO WIND (UST).
DO 360 I=its,ite
IF((XLAND(I)-1.5).GE.0)THEN
@@ -804,8 +826,16 @@
IF ( PRESENT(ISFTCFLX) ) THEN
IF ( ISFTCFLX.NE.0 ) THEN
! ZNT(I)=10.*exp(-9.*UST(I)**(-.3333))
- ZNT(I)=10.*exp(-9.5*UST(I)**(-.3333))
- ZNT(I)=ZNT(I) + 0.11*1.5E-5/AMAX1(UST(I),0.01)
+! ZNT(I)=10.*exp(-9.5*UST(I)**(-.3333))
+! ZNT(I)=ZNT(I) + 0.11*1.5E-5/AMAX1(UST(I),0.01)
+! ZNT(I)=0.011*UST(I)*UST(I)/G+OZO
+! ZNT(I)=MAX(ZNT(I),3.50e-5)
+! AHW 2012:
+ ZW = MIN((UST(I)/1.06)**(0.3),1.0)
+ ZN1 = 0.011*UST(I)*UST(I)/G + OZO
+ ZN2 = 10.*exp(-9.5*UST(I)**(-.3333)) + &
+ 0.11*1.5E-5/AMAX1(UST(I),0.01)
+ ZNT(I)=(1.0-ZW) * ZN1 + ZW * ZN2
ZNT(I)=MIN(ZNT(I),2.85e-3)
ZNT(I)=MAX(ZNT(I),1.27e-7)
ENDIF
@@ -825,13 +855,16 @@
ELSE
FLHC(I)=0.
ENDIF
- 360 CONTINUE
+ 360 CONTINUE
!
-!-----COMPUTE SURFACE MOIST FLUX:
-!
-! IF(IDRY.EQ.1)GOTO 390
-!
+!-----COMPUTE SURFACE MOIST FLUX:
+!
+! IF(IDRY.EQ.1)GOTO 390
+ IF ( PRESENT(SCM_FORCE_FLUX) ) THEN
+ IF (SCM_FORCE_FLUX.EQ.1) GOTO 405
+ ENDIF
+!
DO 370 I=its,ite
QFX(I)=FLQC(I)*(QSFC(I)-QX(I))
QFX(I)=AMAX1(QFX(I),0.)
@@ -855,6 +888,8 @@
HFX(I)=AMAX1(HFX(I),-250.)
ENDIF
400 CONTINUE
+
+ 405 CONTINUE
DO I=its,ite
IF((XLAND(I)-1.5).GE.0)THEN
Deleted: branches/mpas_cdg_advection/src/core_hyd_atmos/Registry
===================================================================
--- branches/mpas_cdg_advection/src/core_hyd_atmos/Registry 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_hyd_atmos/Registry 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,191 +0,0 @@
-%
-% namelist type namelist_record name default_value
-%
-namelist integer sw_model config_test_case 5
-namelist character sw_model config_time_integration SRK3
-namelist real sw_model config_dt 172.8
-namelist character sw_model config_calendar_type 360day
-namelist character sw_model config_start_time 0000-01-01_00:00:00
-namelist character sw_model config_stop_time none
-namelist character sw_model config_run_duration none
-namelist real sw_model config_h_mom_eddy_visc2 0.0
-namelist real sw_model config_h_mom_eddy_visc4 0.0
-namelist real sw_model config_v_mom_eddy_visc2 0.0
-namelist real sw_model config_h_theta_eddy_visc2 0.0
-namelist real sw_model config_h_theta_eddy_visc4 0.0
-namelist real sw_model config_v_theta_eddy_visc2 0.0
-namelist integer sw_model config_number_of_sub_steps 4
-namelist integer sw_model config_theta_adv_order 2
-namelist integer sw_model config_scalar_adv_order 2
-namelist logical sw_model config_positive_definite false
-namelist logical sw_model config_monotonic true
-namelist integer sw_model config_mp_physics 0
-namelist real sw_model config_apvm_upwinding 0.5
-namelist integer sw_model config_num_halos 2
-namelist integer dimensions config_nvertlevels 26
-namelist character io config_input_name grid.nc
-namelist character io config_output_name output.nc
-namelist character io config_restart_name restart.nc
-namelist character io config_output_interval 06:00:00
-namelist integer io config_frames_per_outfile 0
-namelist integer io config_pio_num_iotasks 0
-namelist integer io config_pio_stride 1
-namelist character decomposition config_block_decomp_file_prefix graph.info.part.
-namelist integer decomposition config_number_of_blocks 0
-namelist logical decomposition config_explicit_proc_decomp .false.
-namelist character decomposition config_proc_decomp_file_prefix graph.info.part.
-namelist logical restart config_do_restart false
-namelist character restart config_restart_interval none
-
-%
-% dim type name_in_file name_in_code
-%
-dim nCells nCells
-dim nEdges nEdges
-dim maxEdges maxEdges
-dim maxEdges2 maxEdges2
-dim nVertices nVertices
-dim TWO 2
-dim vertexDegree vertexDegree
-dim FIFTEEN 15
-dim TWENTYONE 21
-dim R3 3
-%dim nVertLevels nVertLevels
-dim nVertLevels namelist:config_nvertlevels
-%dim nTracers nTracers
-dim nVertLevelsP1 nVertLevels+1
-
-%
-% var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class
-%
-var persistent text xtime ( Time ) 2 ro xtime state - -
-
-var persistent real latCell ( nCells ) 0 iro latCell mesh - -
-var persistent real lonCell ( nCells ) 0 iro lonCell mesh - -
-var persistent real xCell ( nCells ) 0 iro xCell mesh - -
-var persistent real yCell ( nCells ) 0 iro yCell mesh - -
-var persistent real zCell ( nCells ) 0 iro zCell mesh - -
-var persistent integer indexToCellID ( nCells ) 0 iro indexToCellID mesh - -
-
-var persistent real latEdge ( nEdges ) 0 iro latEdge mesh - -
-var persistent real lonEdge ( nEdges ) 0 iro lonEdge mesh - -
-var persistent real xEdge ( nEdges ) 0 iro xEdge mesh - -
-var persistent real yEdge ( nEdges ) 0 iro yEdge mesh - -
-var persistent real zEdge ( nEdges ) 0 iro zEdge mesh - -
-var persistent integer indexToEdgeID ( nEdges ) 0 iro indexToEdgeID mesh - -
-
-var persistent real latVertex ( nVertices ) 0 iro latVertex mesh - -
-var persistent real lonVertex ( nVertices ) 0 iro lonVertex mesh - -
-var persistent real xVertex ( nVertices ) 0 iro xVertex mesh - -
-var persistent real yVertex ( nVertices ) 0 iro yVertex mesh - -
-var persistent real zVertex ( nVertices ) 0 iro zVertex mesh - -
-var persistent integer indexToVertexID ( nVertices ) 0 iro indexToVertexID mesh - -
-
-var persistent integer cellsOnEdge ( TWO nEdges ) 0 iro cellsOnEdge mesh - -
-var persistent integer nEdgesOnCell ( nCells ) 0 iro nEdgesOnCell mesh - -
-var persistent integer nEdgesOnEdge ( nEdges ) 0 iro nEdgesOnEdge mesh - -
-var persistent integer edgesOnCell ( maxEdges nCells ) 0 iro edgesOnCell mesh - -
-var persistent integer edgesOnEdge ( maxEdges2 nEdges ) 0 iro edgesOnEdge mesh - -
-
-var persistent real weightsOnEdge ( maxEdges2 nEdges ) 0 iro weightsOnEdge mesh - -
-var persistent real dvEdge ( nEdges ) 0 iro dvEdge mesh - -
-var persistent real dcEdge ( nEdges ) 0 iro dcEdge mesh - -
-var persistent real angleEdge ( nEdges ) 0 iro angleEdge mesh - -
-var persistent real areaCell ( nCells ) 0 iro areaCell mesh - -
-var persistent real areaTriangle ( nVertices ) 0 iro areaTriangle mesh - -
-
-var persistent real edgeNormalVectors ( R3 nEdges ) 0 o edgeNormalVectors mesh - -
-var persistent real localVerticalUnitVectors ( R3 nCells ) 0 o localVerticalUnitVectors mesh - -
-var persistent real cellTangentPlane ( R3 TWO nCells ) 0 o cellTangentPlane mesh - -
-
-var persistent integer cellsOnCell ( maxEdges nCells ) 0 iro cellsOnCell mesh - -
-var persistent integer verticesOnCell ( maxEdges nCells ) 0 iro verticesOnCell mesh - -
-var persistent integer verticesOnEdge ( TWO nEdges ) 0 iro verticesOnEdge mesh - -
-var persistent integer edgesOnVertex ( vertexDegree nVertices ) 0 iro edgesOnVertex mesh - -
-var persistent integer cellsOnVertex ( vertexDegree nVertices ) 0 iro cellsOnVertex mesh - -
-var persistent real kiteAreasOnVertex ( vertexDegree nVertices ) 0 iro kiteAreasOnVertex mesh - -
-var persistent real fEdge ( nEdges ) 0 iro fEdge mesh - -
-var persistent real fVertex ( nVertices ) 0 iro fVertex mesh - -
-var persistent real h_s ( nCells ) 0 iro h_s mesh - -
-
-% description of the vertical grid structure
-var persistent real rdnu ( nVertLevels ) 0 iro rdnu mesh - -
-var persistent real rdnw ( nVertLevels ) 0 iro rdnw mesh - -
-var persistent real fnm ( nVertLevels ) 0 iro fnm mesh - -
-var persistent real fnp ( nVertLevels ) 0 iro fnp mesh - -
-var persistent real dbn ( nVertLevels ) 0 iro dbn mesh - -
-var persistent real dnu ( nVertLevels ) 0 iro dnu mesh - -
-var persistent real dnw ( nVertLevels ) 0 iro dnw mesh - -
-
-% Prognostic variables: read from input, saved in restart, and written to output
-var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
-var persistent real theta ( nVertLevels nCells Time ) 2 iro theta state - -
-var persistent real surface_pressure ( nCells Time ) 2 iro surface_pressure state - -
-var persistent real qv ( nVertLevels nCells Time ) 2 iro qv state scalars moist
-var persistent real qc ( nVertLevels nCells Time ) 2 iro qc state scalars moist
-var persistent real qr ( nVertLevels nCells Time ) 2 iro qr state scalars moist
-%var persistent real tracers ( nTracers nVertLevels nCells Time ) 2 iro state tracers - -
-
-% state variables diagnosed from prognostic state
-var persistent real h ( nVertLevels nCells Time ) 2 ro h state - -
-var persistent real ww ( nVertLevelsP1 nCells Time ) 2 ro ww state - -
-var persistent real w ( nVertLevelsP1 nCells Time ) 2 ro w state - -
-var persistent real pressure ( nVertLevelsP1 nCells Time ) 2 ro pressure state - -
-var persistent real geopotential ( nVertLevelsP1 nCells Time ) 2 ro geopotential state - -
-var persistent real alpha ( nVertLevels nCells Time ) 2 iro alpha state - -
-
-% Diagnostic fields: only written to output
-var persistent real v ( nVertLevels nEdges Time ) 2 o v state - -
-var persistent real divergence ( nVertLevels nCells Time ) 2 o divergence state - -
-var persistent real vorticity ( nVertLevels nVertices Time ) 2 o vorticity state - -
-var persistent real pv_edge ( nVertLevels nEdges Time ) 2 o pv_edge state - -
-var persistent real h_edge ( nVertLevels nEdges Time ) 2 o h_edge state - -
-var persistent real ke ( nVertLevels nCells Time ) 2 o ke state - -
-var persistent real pv_vertex ( nVertLevels nVertices Time ) 2 o pv_vertex state - -
-var persistent real pv_cell ( nVertLevels nCells Time ) 2 o pv_cell state - -
-var persistent real uReconstructX ( nVertLevels nCells Time ) 1 o uReconstructX diag - -
-var persistent real uReconstructY ( nVertLevels nCells Time ) 1 o uReconstructY diag - -
-var persistent real uReconstructZ ( nVertLevels nCells Time ) 1 o uReconstructZ diag - -
-var persistent real uReconstructZonal ( nVertLevels nCells Time ) 1 o uReconstructZonal diag - -
-var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 1 o uReconstructMeridional diag - -
-
-% Tendency variables
-var persistent real tend_h ( nVertLevels nCells Time ) 1 - h tend - -
-var persistent real tend_u ( nVertLevels nEdges Time ) 1 - u tend - -
-var persistent real tend_vh ( nVertLevels nEdges Time ) 1 - vh tend - -
-var persistent real tend_theta ( nVertLevels nCells Time ) 1 - theta tend - -
-var persistent real tend_qv ( nVertLevels nCells Time ) 1 - qv tend scalars moist
-var persistent real tend_qc ( nVertLevels nCells Time ) 1 - qc tend scalars moist
-var persistent real tend_qr ( nVertLevels nCells Time ) 1 - qr tend scalars moist
-
-% Other diagnostic variables: neither read nor written to any files
-var persistent real vh ( nVertLevels nEdges Time ) 2 - vh state - -
-var persistent real circulation ( nVertLevels nVertices Time ) 2 - circulation state - -
-var persistent real gradPVt ( nVertLevels nEdges Time ) 2 - gradPVt state - -
-var persistent real gradPVn ( nVertLevels nEdges Time ) 2 - gradPVn state - -
-
-var persistent real uhAvg ( nVertLevels nEdges ) 0 - uhAvg mesh - -
-var persistent real wwAvg ( nVertLevelsP1 nCells ) 0 - wwAvg mesh - -
-var persistent real qtot ( nVertLevels nCells ) 0 - qtot mesh - -
-var persistent real cqu ( nVertLevels nEdges ) 0 - cqu mesh - -
-var persistent real h_diabatic ( nVertLevels nCells ) 0 - h_diabatic mesh - -
-var persistent real dpsdt ( nCells ) 0 - dpsdt mesh - -
-
-var persistent real u_old ( nVertLevels nEdges ) 0 - u_old mesh - -
-var persistent real ww_old ( nVertLevelsP1 nCells ) 0 - ww_old mesh - -
-var persistent real theta_old ( nVertLevels nCells ) 0 - theta_old mesh - -
-var persistent real h_edge_old ( nVertLevels nEdges ) 0 - h_edge_old mesh - -
-var persistent real h_old ( nVertLevels nCells ) 0 - h_old mesh - -
-var persistent real pressure_old ( nVertLevelsP1 nCells ) 0 - pressure_old mesh - -
-var persistent real qv_old ( nVertLevels nCells ) 0 - qv_old mesh scalars_old moist_old
-var persistent real qc_old ( nVertLevels nCells ) 0 - qc_old mesh scalars_old moist_old
-var persistent real qr_old ( nVertLevels nCells ) 0 - qr_old mesh scalars_old moist_old
-%var persistent real tracers_old ( nTracers nVertLevels nCells ) 0 - tracers_old mesh - -
-
-% Space needed for advection
-var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 o deriv_two mesh - -
-var persistent integer advCells ( TWENTYONE nCells ) 0 - advCells mesh - -
-
-% Arrays required for reconstruction of velocity field
-var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 - coeffs_reconstruct mesh - -
-
Copied: branches/mpas_cdg_advection/src/core_hyd_atmos/Registry.xml (from rev 2782, trunk/mpas/src/core_hyd_atmos/Registry.xml)
===================================================================
--- branches/mpas_cdg_advection/src/core_hyd_atmos/Registry.xml (rev 0)
+++ branches/mpas_cdg_advection/src/core_hyd_atmos/Registry.xml 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,179 @@
+<?xml version="1.0"?>
+<registry model="mpas" core="hyd_atmos" version="0.0.0">
+ <dims>
+ <dim name="nCells"/>
+ <dim name="nEdges"/>
+ <dim name="maxEdges"/>
+ <dim name="maxEdges2"/>
+ <dim name="nVertices"/>
+ <dim name="TWO" definition="2"/>
+ <dim name="vertexDegree"/>
+ <dim name="FIFTEEN" definition="15"/>
+ <dim name="TWENTYONE" definition="21"/>
+ <dim name="R3" definition="3"/>
+ <dim name="nVertLevels" definition="namelist:config_nvertlevels"/>
+ <dim name="nVertLevelsP1" definition="nVertLevels+1"/>
+ </dims>
+ <nml_record name="sw_model">
+ <nml_option name="config_test_case" type="integer" default_value="5"/>
+ <nml_option name="config_time_integration" type="character" default_value="SRK3"/>
+ <nml_option name="config_dt" type="real" default_value="172.8"/>
+ <nml_option name="config_calendar_type" type="character" default_value="360day"/>
+ <nml_option name="config_start_time" type="character" default_value="0000-01-01_00:00:00"/>
+ <nml_option name="config_stop_time" type="character" default_value="none"/>
+ <nml_option name="config_run_duration" type="character" default_value="none"/>
+ <nml_option name="config_h_mom_eddy_visc2" type="real" default_value="0.0"/>
+ <nml_option name="config_h_mom_eddy_visc4" type="real" default_value="0.0"/>
+ <nml_option name="config_v_mom_eddy_visc2" type="real" default_value="0.0"/>
+ <nml_option name="config_h_theta_eddy_visc2" type="real" default_value="0.0"/>
+ <nml_option name="config_h_theta_eddy_visc4" type="real" default_value="0.0"/>
+ <nml_option name="config_v_theta_eddy_visc2" type="real" default_value="0.0"/>
+ <nml_option name="config_number_of_sub_steps" type="integer" default_value="4"/>
+ <nml_option name="config_theta_adv_order" type="integer" default_value="2"/>
+ <nml_option name="config_scalar_adv_order" type="integer" default_value="2"/>
+ <nml_option name="config_positive_definite" type="logical" default_value="false"/>
+ <nml_option name="config_monotonic" type="logical" default_value="true"/>
+ <nml_option name="config_mp_physics" type="integer" default_value="0"/>
+ <nml_option name="config_apvm_upwinding" type="real" default_value="0.5"/>
+ <nml_option name="config_num_halos" type="integer" default_value="2"/>
+ </nml_record>
+ <nml_record name="dimensions">
+ <nml_option name="config_nvertlevels" type="integer" default_value="26"/>
+ </nml_record>
+ <nml_record name="io">
+ <nml_option name="config_input_name" type="character" default_value="grid.nc"/>
+ <nml_option name="config_output_name" type="character" default_value="output.nc"/>
+ <nml_option name="config_restart_name" type="character" default_value="restart.nc"/>
+ <nml_option name="config_output_interval" type="character" default_value="06:00:00"/>
+ <nml_option name="config_frames_per_outfile" type="integer" default_value="0"/>
+ <nml_option name="config_pio_num_iotasks" type="integer" default_value="0"/>
+ <nml_option name="config_pio_stride" type="integer" default_value="1"/>
+ </nml_record>
+ <nml_record name="decomposition">
+ <nml_option name="config_block_decomp_file_prefix" type="character" default_value="graph.info.part."/>
+ <nml_option name="config_number_of_blocks" type="integer" default_value="0"/>
+ <nml_option name="config_explicit_proc_decomp" type="logical" default_value=".false."/>
+ <nml_option name="config_proc_decomp_file_prefix" type="character" default_value="graph.info.part."/>
+ </nml_record>
+ <nml_record name="restart">
+ <nml_option name="config_do_restart" type="logical" default_value="false"/>
+ <nml_option name="config_restart_interval" type="character" default_value="none"/>
+ </nml_record>
+ <var_struct name="state" time_levs="2">
+ <var_array name="scalars" type="real" dimensions="nVertLevels nCells Time">
+ <var name="qv" array_group="moist" streams="iro"/>
+ <var name="qc" array_group="moist" streams="iro"/>
+ <var name="qr" array_group="moist" streams="iro"/>
+ </var_array>
+ <var name="xtime" type="text" dimensions="Time" streams="ro"/>
+ <var name="u" type="real" dimensions="nVertLevels nEdges Time" streams="iro"/>
+ <var name="theta" type="real" dimensions="nVertLevels nCells Time" streams="iro"/>
+ <var name="surface_pressure" type="real" dimensions="nCells Time" streams="iro"/>
+ <var name="h" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="ww" type="real" dimensions="nVertLevelsP1 nCells Time" streams="ro"/>
+ <var name="w" type="real" dimensions="nVertLevelsP1 nCells Time" streams="ro"/>
+ <var name="pressure" type="real" dimensions="nVertLevelsP1 nCells Time" streams="ro"/>
+ <var name="geopotential" type="real" dimensions="nVertLevelsP1 nCells Time" streams="ro"/>
+ <var name="alpha" type="real" dimensions="nVertLevels nCells Time" streams="iro"/>
+ <var name="v" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="divergence" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="vorticity" type="real" dimensions="nVertLevels nVertices Time" streams="o"/>
+ <var name="pv_edge" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="h_edge" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="ke" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="pv_vertex" type="real" dimensions="nVertLevels nVertices Time" streams="o"/>
+ <var name="pv_cell" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="vh" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="circulation" type="real" dimensions="nVertLevels nVertices Time"/>
+ <var name="gradPVt" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="gradPVn" type="real" dimensions="nVertLevels nEdges Time"/>
+ </var_struct>
+ <var_struct name="mesh" time_levs="0">
+ <var_array name="scalars_old" type="real" dimensions="nVertLevels nCells">
+ <var name="qv_old" array_group="moist_old"/>
+ <var name="qc_old" array_group="moist_old"/>
+ <var name="qr_old" array_group="moist_old"/>
+ </var_array>
+ <var name="latCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="lonCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="xCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="yCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="zCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="indexToCellID" type="integer" dimensions="nCells" streams="iro"/>
+ <var name="latEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="lonEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="xEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="yEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="zEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="indexToEdgeID" type="integer" dimensions="nEdges" streams="iro"/>
+ <var name="latVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="lonVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="xVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="yVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="zVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="indexToVertexID" type="integer" dimensions="nVertices" streams="iro"/>
+ <var name="cellsOnEdge" type="integer" dimensions="TWO nEdges" streams="iro"/>
+ <var name="nEdgesOnCell" type="integer" dimensions="nCells" streams="iro"/>
+ <var name="nEdgesOnEdge" type="integer" dimensions="nEdges" streams="iro"/>
+ <var name="edgesOnCell" type="integer" dimensions="maxEdges nCells" streams="iro"/>
+ <var name="edgesOnEdge" type="integer" dimensions="maxEdges2 nEdges" streams="iro"/>
+ <var name="weightsOnEdge" type="real" dimensions="maxEdges2 nEdges" streams="iro"/>
+ <var name="dvEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="dcEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="angleEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="areaCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="areaTriangle" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="edgeNormalVectors" type="real" dimensions="R3 nEdges" streams="o"/>
+ <var name="localVerticalUnitVectors" type="real" dimensions="R3 nCells" streams="o"/>
+ <var name="cellTangentPlane" type="real" dimensions="R3 TWO nCells" streams="o"/>
+ <var name="cellsOnCell" type="integer" dimensions="maxEdges nCells" streams="iro"/>
+ <var name="verticesOnCell" type="integer" dimensions="maxEdges nCells" streams="iro"/>
+ <var name="verticesOnEdge" type="integer" dimensions="TWO nEdges" streams="iro"/>
+ <var name="edgesOnVertex" type="integer" dimensions="vertexDegree nVertices" streams="iro"/>
+ <var name="cellsOnVertex" type="integer" dimensions="vertexDegree nVertices" streams="iro"/>
+ <var name="kiteAreasOnVertex" type="real" dimensions="vertexDegree nVertices" streams="iro"/>
+ <var name="fEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="fVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="h_s" type="real" dimensions="nCells" streams="iro"/>
+ <var name="rdnu" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="rdnw" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="fnm" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="fnp" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="dbn" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="dnu" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="dnw" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="uhAvg" type="real" dimensions="nVertLevels nEdges"/>
+ <var name="wwAvg" type="real" dimensions="nVertLevelsP1 nCells"/>
+ <var name="qtot" type="real" dimensions="nVertLevels nCells"/>
+ <var name="cqu" type="real" dimensions="nVertLevels nEdges"/>
+ <var name="h_diabatic" type="real" dimensions="nVertLevels nCells"/>
+ <var name="dpsdt" type="real" dimensions="nCells"/>
+ <var name="u_old" type="real" dimensions="nVertLevels nEdges"/>
+ <var name="ww_old" type="real" dimensions="nVertLevelsP1 nCells"/>
+ <var name="theta_old" type="real" dimensions="nVertLevels nCells"/>
+ <var name="h_edge_old" type="real" dimensions="nVertLevels nEdges"/>
+ <var name="h_old" type="real" dimensions="nVertLevels nCells"/>
+ <var name="pressure_old" type="real" dimensions="nVertLevelsP1 nCells"/>
+ <var name="deriv_two" type="real" dimensions="FIFTEEN TWO nEdges" streams="o"/>
+ <var name="advCells" type="integer" dimensions="TWENTYONE nCells"/>
+ <var name="coeffs_reconstruct" type="real" dimensions="R3 maxEdges nCells"/>
+ </var_struct>
+ <var_struct name="diag" time_levs="1">
+ <var name="uReconstructX" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructY" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructZ" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructZonal" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructMeridional" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ </var_struct>
+ <var_struct name="tend" time_levs="1">
+ <var_array name="scalars" type="real" dimensions="nVertLevels nCells Time">
+ <var name="tend_qv" array_group="moist" name_in_code="qv"/>
+ <var name="tend_qc" array_group="moist" name_in_code="qc"/>
+ <var name="tend_qr" array_group="moist" name_in_code="qr"/>
+ </var_array>
+ <var name="tend_h" type="real" dimensions="nVertLevels nCells Time" name_in_code="h"/>
+ <var name="tend_u" type="real" dimensions="nVertLevels nEdges Time" name_in_code="u"/>
+ <var name="tend_vh" type="real" dimensions="nVertLevels nEdges Time" name_in_code="vh"/>
+ <var name="tend_theta" type="real" dimensions="nVertLevels nCells Time" name_in_code="theta"/>
+ </var_struct>
+</registry>
Modified: branches/mpas_cdg_advection/src/core_init_nhyd_atmos/Makefile
===================================================================
--- branches/mpas_cdg_advection/src/core_init_nhyd_atmos/Makefile 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_init_nhyd_atmos/Makefile 2013-04-22 01:31:32 UTC (rev 2783)
@@ -8,6 +8,8 @@
mpas_init_atm_bitarray.o \
mpas_init_atm_queue.o \
mpas_init_atm_hinterp.o \
+ mpas_init_atm_static.o \
+ mpas_init_atm_surface.o \
read_geogrid.o \
mpas_atmphys_date_time.o \
mpas_atmphys_initialize_real.o \
@@ -18,8 +20,15 @@
core_hyd: $(OBJS)
ar -ru libdycore.a $(OBJS)
-mpas_init_atm_test_cases.o: mpas_atm_advection.o mpas_init_atm_read_met.o read_geogrid.o mpas_init_atm_llxy.o mpas_init_atm_hinterp.o \
- mpas_atmphys_initialize_real.o
+mpas_init_atm_test_cases.o: \
+ read_geogrid.o \
+ mpas_atm_advection.o \
+ mpas_init_atm_read_met.o \
+ mpas_init_atm_llxy.o \
+ mpas_init_atm_hinterp.o \
+ mpas_init_atm_static.o \
+ mpas_init_atm_surface.o \
+ mpas_atmphys_initialize_real.o
mpas_init_atm_hinterp.o: mpas_init_atm_queue.o mpas_init_atm_bitarray.o
@@ -33,10 +42,19 @@
mpas_init_atm_mpas_core.o: mpas_advection.o mpas_init_atm_test_cases.o
+mpas_init_atm_static.o: \
+ mpas_atm_advection.o \
+ mpas_init_atm_hinterp.o \
+ mpas_init_atm_llxy.o \
+ mpas_atmphys_utilities.o
+
+mpas_init_atm_surface.o: \
+ mpas_init_atm_hinterp.o \
+ mpas_init_atm_llxy.o \
+ mpas_init_atm_read_met.o
+
mpas_atmphys_initialize_real.o: \
- mpas_init_atm_hinterp.o \
- mpas_init_atm_llxy.o \
- mpas_init_atm_read_met.o \
+ mpas_init_atm_surface.o \
mpas_atmphys_date_time.o \
mpas_atmphys_utilities.o
Deleted: branches/mpas_cdg_advection/src/core_init_nhyd_atmos/Registry
===================================================================
--- branches/mpas_cdg_advection/src/core_init_nhyd_atmos/Registry 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_init_nhyd_atmos/Registry 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,256 +0,0 @@
-%
-% namelist type namelist_record name default_value
-%
-namelist integer nhyd_model config_test_case 7
-namelist character nhyd_model config_calendar_type gregorian
-namelist character nhyd_model config_start_time none
-namelist character nhyd_model config_stop_time none
-namelist integer nhyd_model config_theta_adv_order 3
-namelist real nhyd_model config_coef_3rd_order 0.25
-namelist integer nhyd_model config_num_halos 2
-namelist character dcmip config_dcmip_case 2-0-0
-namelist real dcmip config_planet_scale 1.0
-namelist real dcmip config_rotation_rate_scale 1.0
-namelist integer dimensions config_nvertlevels 26
-namelist integer dimensions config_nsoillevels 4
-namelist integer dimensions config_nfglevels 27
-namelist integer dimensions config_nfgsoillevels 4
-namelist integer dimensions config_months 12
-namelist character data_sources config_geog_data_path /mmm/users/wrfhelp/WPS_GEOG/
-namelist character data_sources config_met_prefix FILE
-namelist character data_sources config_sfc_prefix FILE
-namelist integer data_sources config_fg_interval 21600
-namelist real vertical_grid config_ztop 28000.0
-namelist integer vertical_grid config_nsmterrain 2
-namelist logical vertical_grid config_smooth_surfaces false
-namelist logical preproc_stages config_static_interp true
-namelist logical preproc_stages config_vertical_grid true
-namelist logical preproc_stages config_met_interp true
-namelist logical preproc_stages config_input_sst false
-namelist logical preproc_stages config_frac_seaice false
-namelist character io config_input_name grid.nc
-namelist character io config_sfc_update_name sfc_update.nc
-namelist character io config_output_name init.nc
-namelist character io config_restart_name restart.nc
-namelist integer io config_frames_per_outfile 0
-namelist integer io config_pio_num_iotasks 0
-namelist integer io config_pio_stride 1
-namelist character decomposition config_block_decomp_file_prefix graph.info.part.
-namelist integer decomposition config_number_of_blocks 0
-namelist logical decomposition config_explicit_proc_decomp .false.
-namelist character decomposition config_proc_decomp_file_prefix graph.info.part.
-namelist integer restart config_restart_interval 0
-namelist logical restart config_do_restart false
-namelist real restart config_restart_time 172800.0
-
-
-%
-% dim type name_in_file name_in_code
-%
-dim nCells nCells
-dim nEdges nEdges
-dim maxEdges maxEdges
-dim maxEdges2 maxEdges2
-dim nVertices nVertices
-dim TWO 2
-dim THREE 3
-dim vertexDegree vertexDegree
-dim FIFTEEN 15
-dim TWENTYONE 21
-dim R3 3
-dim nVertLevels namelist:config_nvertlevels
-dim nSoilLevels namelist:config_nsoillevels
-dim nFGLevels namelist:config_nfglevels
-dim nFGSoilLevels namelist:config_nfgsoillevels
-dim nVertLevelsP1 nVertLevels+1
-dim nMonths namelist:config_months
-
-%
-% var type name_in_file ( dims ) iro- name_in_code super-array array_class
-%
-var persistent text xtime ( Time ) 2 so xtime state - -
-
-% horizontal grid structure
-
-var persistent real latCell ( nCells ) 0 io latCell mesh - -
-var persistent real lonCell ( nCells ) 0 io lonCell mesh - -
-var persistent real xCell ( nCells ) 0 io xCell mesh - -
-var persistent real yCell ( nCells ) 0 io yCell mesh - -
-var persistent real zCell ( nCells ) 0 io zCell mesh - -
-var persistent integer indexToCellID ( nCells ) 0 io indexToCellID mesh - -
-
-var persistent real latEdge ( nEdges ) 0 io latEdge mesh - -
-var persistent real lonEdge ( nEdges ) 0 io lonEdge mesh - -
-var persistent real xEdge ( nEdges ) 0 io xEdge mesh - -
-var persistent real yEdge ( nEdges ) 0 io yEdge mesh - -
-var persistent real zEdge ( nEdges ) 0 io zEdge mesh - -
-var persistent integer indexToEdgeID ( nEdges ) 0 io indexToEdgeID mesh - -
-
-var persistent real latVertex ( nVertices ) 0 io latVertex mesh - -
-var persistent real lonVertex ( nVertices ) 0 io lonVertex mesh - -
-var persistent real xVertex ( nVertices ) 0 io xVertex mesh - -
-var persistent real yVertex ( nVertices ) 0 io yVertex mesh - -
-var persistent real zVertex ( nVertices ) 0 io zVertex mesh - -
-var persistent integer indexToVertexID ( nVertices ) 0 io indexToVertexID mesh - -
-
-var persistent integer cellsOnEdge ( TWO nEdges ) 0 io cellsOnEdge mesh - -
-var persistent integer nEdgesOnCell ( nCells ) 0 io nEdgesOnCell mesh - -
-var persistent integer nEdgesOnEdge ( nEdges ) 0 io nEdgesOnEdge mesh - -
-var persistent integer edgesOnCell ( maxEdges nCells ) 0 io edgesOnCell mesh - -
-var persistent integer edgesOnEdge ( maxEdges2 nEdges ) 0 io edgesOnEdge mesh - -
-
-var persistent real weightsOnEdge ( maxEdges2 nEdges ) 0 io weightsOnEdge mesh - -
-var persistent real dvEdge ( nEdges ) 0 io dvEdge mesh - -
-var persistent real dcEdge ( nEdges ) 0 io dcEdge mesh - -
-var persistent real angleEdge ( nEdges ) 0 io angleEdge mesh - -
-var persistent real areaCell ( nCells ) 0 io areaCell mesh - -
-var persistent real areaTriangle ( nVertices ) 0 io areaTriangle mesh - -
-
-var persistent real edgeNormalVectors ( R3 nEdges ) 0 io edgeNormalVectors mesh - -
-var persistent real localVerticalUnitVectors ( R3 nCells ) 0 io localVerticalUnitVectors mesh - -
-var persistent real cellTangentPlane ( R3 TWO nCells ) 0 io cellTangentPlane mesh - -
-
-var persistent integer cellsOnCell ( maxEdges nCells ) 0 io cellsOnCell mesh - -
-var persistent integer verticesOnCell ( maxEdges nCells ) 0 io verticesOnCell mesh - -
-var persistent integer verticesOnEdge ( TWO nEdges ) 0 io verticesOnEdge mesh - -
-var persistent integer edgesOnVertex ( vertexDegree nVertices ) 0 io edgesOnVertex mesh - -
-var persistent integer cellsOnVertex ( vertexDegree nVertices ) 0 io cellsOnVertex mesh - -
-var persistent real kiteAreasOnVertex ( vertexDegree nVertices ) 0 io kiteAreasOnVertex mesh - -
-var persistent real fEdge ( nEdges ) 0 io fEdge mesh - -
-var persistent real fVertex ( nVertices ) 0 io fVertex mesh - -
-
-var persistent real meshDensity ( nCells ) 0 iro meshDensity mesh - -
-
-% some solver scalar coefficients
-
-% coefficients for vertical extrapolation to the surface
-var persistent real cf1 ( ) 0 io cf1 mesh - -
-var persistent real cf2 ( ) 0 io cf2 mesh - -
-var persistent real cf3 ( ) 0 io cf3 mesh - -
-
-% static terrestrial fields
-var persistent real ter ( nCells ) 0 io ter mesh - -
-var persistent integer landmask ( nCells ) 0 io landmask mesh - -
-var persistent integer ivgtyp ( nCells ) 0 io lu_index mesh - -
-var persistent integer isltyp ( nCells ) 0 io soilcat_top mesh - -
-var persistent integer soilcat_bot ( nCells ) 0 io soilcat_bot mesh - -
-var persistent real snoalb ( nCells ) 0 io snoalb mesh - -
-var persistent real soiltemp ( nCells ) 0 io soiltemp mesh - -
-var persistent real greenfrac ( nMonths nCells ) 0 io greenfrac mesh - -
-var persistent real shdmin ( nCells ) 0 io shdmin mesh - -
-var persistent real shdmax ( nCells ) 0 io shdmax mesh - -
-var persistent real albedo12m ( nMonths nCells ) 0 io albedo12m mesh - -
-
-% description of the vertical grid structure
-
-var persistent real hx ( nVertLevelsP1 nCells ) 0 io hx mesh - -
-var persistent real zgrid ( nVertLevelsP1 nCells ) 0 io zgrid mesh - -
-var persistent real rdzw ( nVertLevels ) 0 io rdzw mesh - -
-var persistent real dzu ( nVertLevels ) 0 io dzu mesh - -
-var persistent real rdzu ( nVertLevels ) 0 io rdzu mesh - -
-var persistent real fzm ( nVertLevels ) 0 io fzm mesh - -
-var persistent real fzp ( nVertLevels ) 0 io fzp mesh - -
-var persistent real zx ( nVertLevelsP1 nEdges ) 0 io zx mesh - -
-var persistent real zz ( nVertLevelsP1 nCells ) 0 io zz mesh - -
-var persistent real zb ( nVertLevelsP1 TWO nEdges ) 0 io zb mesh - -
-var persistent real zb3 ( nVertLevelsP1 TWO nEdges ) 0 io zb3 mesh - -
-
-% W-Rayleigh-damping coefficient
-
-var persistent real dss ( nVertLevels nCells ) 0 io dss mesh - -
-
-% Horizontally interpolated from first-guess data
-var persistent real u_fg ( nFGLevels nEdges Time ) 1 - u fg - -
-var persistent real v_fg ( nFGLevels nEdges Time ) 1 - v fg - -
-var persistent real t_fg ( nFGLevels nCells Time ) 1 - t fg - -
-var persistent real p_fg ( nFGLevels nCells Time ) 1 - p fg - -
-var persistent real z_fg ( nFGLevels nCells Time ) 1 - z fg - -
-var persistent real rh_fg ( nFGLevels nCells Time ) 1 - rh fg - -
-var persistent real soilz_fg ( nCells Time ) 1 io soilz fg - -
-var persistent real psfc_fg ( nCells Time ) 1 - psfc fg - -
-var persistent real pmsl_fg ( nCells Time ) 1 - pmsl fg - -
-
-% Horizontally interpolated from first-guess data
-var persistent real dz_fg ( nFGSoilLevels nCells Time ) 1 io dz_fg fg - -
-var persistent real dzs_fg ( nFGSoilLevels nCells Time ) 1 io dzs_fg fg - -
-var persistent real zs_fg ( nFGSoilLevels nCells Time ) 1 io zs_fg fg - -
-var persistent real st_fg ( nFGSoilLevels nCells Time ) 1 io st_fg fg - -
-var persistent real sm_fg ( nFGSoilLevels nCells Time ) 1 io sm_fg fg - -
-
-% Horizontally interpolated from first-guess data
-% and should be read in by model
-var persistent real dz ( nSoilLevels nCells Time ) 1 io dz fg - -
-var persistent real dzs ( nSoilLevels nCells Time ) 1 io dzs fg - -
-var persistent real zs ( nSoilLevels nCells Time ) 1 io zs fg - -
-var persistent real sh2o ( nSoilLevels nCells Time ) 1 io sh2o fg - -
-var persistent real smois ( nSoilLevels nCells Time ) 1 io smois fg - -
-var persistent real tslb ( nSoilLevels nCells Time ) 1 io tslb fg - -
-var persistent real smcrel ( nSoilLevels nCells Time ) 1 io smcrel fg - -
-var persistent real tmn ( nCells Time ) 1 io tmn fg - -
-var persistent real skintemp ( nCells Time ) 1 io skintemp fg - -
-var persistent real sst ( nCells Time ) 1 iso sst fg - -
-var persistent real snow ( nCells Time ) 1 io snow fg - -
-var persistent real snowc ( nCells Time ) 1 io snowc fg - -
-var persistent real snowh ( nCells Time ) 1 io snowh fg - -
-var persistent real xice ( nCells Time ) 1 iso xice fg - -
-var persistent real seaice ( nCells Time ) 1 io seaice fg - -
-var persistent real gfs_z ( nVertLevels nCells Time ) 1 - gfs_z fg - -
-var persistent real vegfra ( nCells Time ) 1 io vegfra fg - -
-var persistent real sfc_albbck ( nCells Time ) 1 io sfc_albbck fg - -
-var persistent real xland ( nCells Time ) 1 io xland fg - -
-
-% Prognostic variables: read from input, saved in restart, and written to output
-var persistent real u ( nVertLevels nEdges Time ) 2 o u state - -
-var persistent real w ( nVertLevelsP1 nCells Time ) 2 o w state - -
-var persistent real rho_zz ( nVertLevels nCells Time ) 2 o rho_zz state - -
-var persistent real theta_m ( nVertLevels nCells Time ) 2 o theta_m state - -
-var persistent real qv ( nVertLevels nCells Time ) 2 o qv state scalars moist
-var persistent real qc ( nVertLevels nCells Time ) 2 o qc state scalars moist
-var persistent real qr ( nVertLevels nCells Time ) 2 o qr state scalars moist
-
-% state variables diagnosed from prognostic state
-var persistent real pressure_p ( nVertLevels nCells Time ) 1 - pressure_p diag - -
-
-var persistent real u_init ( nVertLevels ) 0 io u_init mesh - -
-var persistent real t_init ( nVertLevels nCells ) 0 io t_init mesh - -
-var persistent real qv_init ( nVertLevels ) 0 io qv_init mesh - -
-
-% Diagnostic fields: only written to output
-var persistent real rho ( nVertLevels nCells Time ) 1 o rho diag - -
-var persistent real theta ( nVertLevels nCells Time ) 1 o theta diag - -
-var persistent real v ( nVertLevels nEdges Time ) 1 o v diag - -
-var persistent real uReconstructX ( nVertLevels nCells Time ) 1 o uReconstructX diag - -
-var persistent real uReconstructY ( nVertLevels nCells Time ) 1 o uReconstructY diag - -
-var persistent real uReconstructZ ( nVertLevels nCells Time ) 1 o uReconstructZ diag - -
-var persistent real uReconstructZonal ( nVertLevels nCells Time ) 1 o uReconstructZonal diag - -
-var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 1 o uReconstructMeridional diag - -
-
-var persistent real exner ( nVertLevels nCells Time ) 1 - exner diag - -
-var persistent real exner_base ( nVertLevels nCells Time ) 1 io exner_base diag - -
-var persistent real rtheta_base ( nVertLevels nCells Time ) 1 - rtheta_base diag - -
-var persistent real pressure ( nVertLevels nCells Time ) 1 - pressure diag - -
-var persistent real pressure_base ( nVertLevels nCells Time ) 1 io pressure_base diag - -
-var persistent real rho_base ( nVertLevels nCells Time ) 1 io rho_base diag - -
-var persistent real theta_base ( nVertLevels nCells Time ) 1 io theta_base diag - -
-
-var persistent real cqw ( nVertLevels nCells Time ) 1 - cqw diag - -
-
-var persistent real surface_pressure ( nCells Time ) 1 io surface_pressure diag - -
-
-% coupled variables needed by the solver, but not output...
-var persistent real ru ( nVertLevels nEdges Time ) 1 - ru diag - -
-var persistent real rw ( nVertLevelsP1 nCells Time ) 1 - rw diag - -
-var persistent real rtheta_p ( nVertLevels nCells Time ) 1 - rtheta_p diag - -
-var persistent real rho_p ( nVertLevels nCells Time ) 1 - rho_p diag - -
-
-% Space needed for advection
-var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 io deriv_two mesh - -
-var persistent integer advCells ( TWENTYONE nCells ) 0 io advCells mesh - -
-
-% Space needed for deformation calculation weights
-var persistent real defc_a ( maxEdges nCells ) 0 io defc_a mesh - -
-var persistent real defc_b ( maxEdges nCells ) 0 io defc_b mesh - -
-
-% Arrays required for reconstruction of velocity field
-var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 io coeffs_reconstruct mesh - -
-
Copied: branches/mpas_cdg_advection/src/core_init_nhyd_atmos/Registry.xml (from rev 2782, trunk/mpas/src/core_init_nhyd_atmos/Registry.xml)
===================================================================
--- branches/mpas_cdg_advection/src/core_init_nhyd_atmos/Registry.xml (rev 0)
+++ branches/mpas_cdg_advection/src/core_init_nhyd_atmos/Registry.xml 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,297 @@
+<?xml version="1.0"?>
+<registry model="mpas" core="init_nhyd_atmos" version="0.0.0">
+
+<!-- **************************************************************************************** -->
+<!-- ************************************** Dimensions ************************************** -->
+<!-- **************************************************************************************** -->
+
+ <dims>
+ <dim name="nCells"/>
+ <dim name="nEdges"/>
+ <dim name="maxEdges"/>
+ <dim name="maxEdges2"/>
+ <dim name="nVertices"/>
+ <dim name="TWO" definition="2"/>
+ <dim name="THREE" definition="3"/>
+ <dim name="vertexDegree"/>
+ <dim name="FIFTEEN" definition="15"/>
+ <dim name="TWENTYONE" definition="21"/>
+ <dim name="R3" definition="3"/>
+ <dim name="nVertLevels" definition="namelist:config_nvertlevels"/>
+ <dim name="nSoilLevels" definition="namelist:config_nsoillevels"/>
+ <dim name="nFGLevels" definition="namelist:config_nfglevels"/>
+ <dim name="nFGSoilLevels" definition="namelist:config_nfgsoillevels"/>
+ <dim name="nVertLevelsP1" definition="nVertLevels+1"/>
+ <dim name="nMonths" definition="namelist:config_months"/>
+ </dims>
+
+
+<!-- **************************************************************************************** -->
+<!-- ************************************** Namelists *************************************** -->
+<!-- **************************************************************************************** -->
+
+ <nml_record name="nhyd_model">
+ <nml_option name="config_test_case" type="integer" default_value="7"/>
+ <nml_option name="config_calendar_type" type="character" default_value="gregorian"/>
+ <nml_option name="config_start_time" type="character" default_value="none"/>
+ <nml_option name="config_stop_time" type="character" default_value="none"/>
+ <nml_option name="config_theta_adv_order" type="integer" default_value="3"/>
+ <nml_option name="config_coef_3rd_order" type="real" default_value="0.25"/>
+ <nml_option name="config_num_halos" type="integer" default_value="2"/>
+ </nml_record>
+
+ <nml_record name="dcmip">
+ <nml_option name="config_dcmip_case" type="character" default_value="2-0-0"/>
+ <nml_option name="config_planet_scale" type="real" default_value="1.0"/>
+ <nml_option name="config_rotation_rate_scale" type="real" default_value="1.0"/>
+ </nml_record>
+
+ <nml_record name="dimensions">
+ <nml_option name="config_nvertlevels" type="integer" default_value="26"/>
+ <nml_option name="config_nsoillevels" type="integer" default_value="4"/>
+ <nml_option name="config_nfglevels" type="integer" default_value="27"/>
+ <nml_option name="config_nfgsoillevels" type="integer" default_value="4"/>
+ <nml_option name="config_months" type="integer" default_value="12"/>
+ </nml_record>
+
+ <nml_record name="data_sources">
+ <nml_option name="config_geog_data_path" type="character" default_value="/mmm/users/wrfhelp/WPS_GEOG/"/>
+ <nml_option name="config_met_prefix" type="character" default_value="FILE"/>
+ <nml_option name="config_sfc_prefix" type="character" default_value="FILE"/>
+ <nml_option name="config_fg_interval" type="integer" default_value="21600"/>
+ </nml_record>
+
+ <nml_record name="vertical_grid">
+ <nml_option name="config_ztop" type="real" default_value="28000.0"/>
+ <nml_option name="config_nsmterrain" type="integer" default_value="2"/>
+ <nml_option name="config_smooth_surfaces" type="logical" default_value="false"/>
+ </nml_record>
+
+ <nml_record name="preproc_stages">
+ <nml_option name="config_static_interp" type="logical" default_value="true"/>
+ <nml_option name="config_vertical_grid" type="logical" default_value="true"/>
+ <nml_option name="config_met_interp" type="logical" default_value="true"/>
+ <nml_option name="config_input_sst" type="logical" default_value="false"/>
+ <nml_option name="config_frac_seaice" type="logical" default_value="false"/>
+ </nml_record>
+
+ <nml_record name="io">
+ <nml_option name="config_input_name" type="character" default_value="grid.nc"/>
+ <nml_option name="config_sfc_update_name" type="character" default_value="sfc_update.nc"/>
+ <nml_option name="config_output_name" type="character" default_value="init.nc"/>
+ <nml_option name="config_restart_name" type="character" default_value="restart.nc"/>
+ <nml_option name="config_frames_per_outfile" type="integer" default_value="0"/>
+ <nml_option name="config_pio_num_iotasks" type="integer" default_value="0"/>
+ <nml_option name="config_pio_stride" type="integer" default_value="1"/>
+ </nml_record>
+
+ <nml_record name="decomposition">
+ <nml_option name="config_block_decomp_file_prefix" type="character" default_value="graph.info.part."/>
+ <nml_option name="config_number_of_blocks" type="integer" default_value="0"/>
+ <nml_option name="config_explicit_proc_decomp" type="logical" default_value=".false."/>
+ <nml_option name="config_proc_decomp_file_prefix" type="character" default_value="graph.info.part."/>
+ </nml_record>
+
+ <nml_record name="restart">
+ <nml_option name="config_restart_interval" type="integer" default_value="0"/>
+ <nml_option name="config_do_restart" type="logical" default_value="false"/>
+ <nml_option name="config_restart_time" type="real" default_value="172800.0"/>
+ </nml_record>
+
+
+<!-- **************************************************************************************** -->
+<!-- ************************************** Variables *************************************** -->
+<!-- **************************************************************************************** -->
+
+ <var_struct name="mesh" time_levs="0">
+ <var name="latCell" type="real" dimensions="nCells" streams="io"/>
+ <var name="lonCell" type="real" dimensions="nCells" streams="io"/>
+ <var name="xCell" type="real" dimensions="nCells" streams="io"/>
+ <var name="yCell" type="real" dimensions="nCells" streams="io"/>
+ <var name="zCell" type="real" dimensions="nCells" streams="io"/>
+ <var name="indexToCellID" type="integer" dimensions="nCells" streams="io"/>
+ <var name="latEdge" type="real" dimensions="nEdges" streams="io"/>
+ <var name="lonEdge" type="real" dimensions="nEdges" streams="io"/>
+ <var name="xEdge" type="real" dimensions="nEdges" streams="io"/>
+ <var name="yEdge" type="real" dimensions="nEdges" streams="io"/>
+ <var name="zEdge" type="real" dimensions="nEdges" streams="io"/>
+ <var name="indexToEdgeID" type="integer" dimensions="nEdges" streams="io"/>
+ <var name="latVertex" type="real" dimensions="nVertices" streams="io"/>
+ <var name="lonVertex" type="real" dimensions="nVertices" streams="io"/>
+ <var name="xVertex" type="real" dimensions="nVertices" streams="io"/>
+ <var name="yVertex" type="real" dimensions="nVertices" streams="io"/>
+ <var name="zVertex" type="real" dimensions="nVertices" streams="io"/>
+ <var name="indexToVertexID" type="integer" dimensions="nVertices" streams="io"/>
+ <var name="cellsOnEdge" type="integer" dimensions="TWO nEdges" streams="io"/>
+ <var name="nEdgesOnCell" type="integer" dimensions="nCells" streams="io"/>
+ <var name="nEdgesOnEdge" type="integer" dimensions="nEdges" streams="io"/>
+ <var name="edgesOnCell" type="integer" dimensions="maxEdges nCells" streams="io"/>
+ <var name="edgesOnEdge" type="integer" dimensions="maxEdges2 nEdges" streams="io"/>
+ <var name="weightsOnEdge" type="real" dimensions="maxEdges2 nEdges" streams="io"/>
+ <var name="dvEdge" type="real" dimensions="nEdges" streams="io"/>
+ <var name="dcEdge" type="real" dimensions="nEdges" streams="io"/>
+ <var name="angleEdge" type="real" dimensions="nEdges" streams="io"/>
+ <var name="areaCell" type="real" dimensions="nCells" streams="io"/>
+ <var name="areaTriangle" type="real" dimensions="nVertices" streams="io"/>
+ <var name="edgeNormalVectors" type="real" dimensions="R3 nEdges" streams="io"/>
+ <var name="localVerticalUnitVectors" type="real" dimensions="R3 nCells" streams="io"/>
+ <var name="cellTangentPlane" type="real" dimensions="R3 TWO nCells" streams="io"/>
+ <var name="cellsOnCell" type="integer" dimensions="maxEdges nCells" streams="io"/>
+ <var name="verticesOnCell" type="integer" dimensions="maxEdges nCells" streams="io"/>
+ <var name="verticesOnEdge" type="integer" dimensions="TWO nEdges" streams="io"/>
+ <var name="edgesOnVertex" type="integer" dimensions="vertexDegree nVertices" streams="io"/>
+ <var name="cellsOnVertex" type="integer" dimensions="vertexDegree nVertices" streams="io"/>
+ <var name="kiteAreasOnVertex" type="real" dimensions="vertexDegree nVertices" streams="io"/>
+ <var name="fEdge" type="real" dimensions="nEdges" streams="io"/>
+ <var name="fVertex" type="real" dimensions="nVertices" streams="io"/>
+ <var name="meshDensity" type="real" dimensions="nCells" streams="iro"/>
+
+ <!-- coefficients for vertical extrapolation to the surface -->
+ <var name="cf1" type="real" dimensions="" streams="io"/>
+ <var name="cf2" type="real" dimensions="" streams="io"/>
+ <var name="cf3" type="real" dimensions="" streams="io"/>
+
+ <!-- static terrestrial fields -->
+ <var name="ter" type="real" dimensions="nCells" streams="io"/>
+ <var name="landmask" type="integer" dimensions="nCells" streams="io"/>
+ <var name="ivgtyp" name_in_code="lu_index" type="integer" dimensions="nCells" streams="io"/>
+ <var name="isltyp" name_in_code="soilcat_top" type="integer" dimensions="nCells" streams="io"/>
+ <var name="soilcat_bot" type="integer" dimensions="nCells" streams="io"/>
+ <var name="snoalb" type="real" dimensions="nCells" streams="io"/>
+ <var name="soiltemp" type="real" dimensions="nCells" streams="io"/>
+ <var name="greenfrac" type="real" dimensions="nMonths nCells" streams="io"/>
+ <var name="shdmin" type="real" dimensions="nCells" streams="io"/>
+ <var name="shdmax" type="real" dimensions="nCells" streams="io"/>
+ <var name="albedo12m" type="real" dimensions="nMonths nCells" streams="io"/>
+
+ <!-- GWDO fields -->
+ <var name="varsso" type="real" dimensions="nCells" streams="io"/>
+ <var name="var2d" type="real" dimensions="nCells" streams="io"/>
+ <var name="con" type="real" dimensions="nCells" streams="io"/>
+ <var name="oa1" type="real" dimensions="nCells" streams="io"/>
+ <var name="oa2" type="real" dimensions="nCells" streams="io"/>
+ <var name="oa3" type="real" dimensions="nCells" streams="io"/>
+ <var name="oa4" type="real" dimensions="nCells" streams="io"/>
+ <var name="ol1" type="real" dimensions="nCells" streams="io"/>
+ <var name="ol2" type="real" dimensions="nCells" streams="io"/>
+ <var name="ol3" type="real" dimensions="nCells" streams="io"/>
+ <var name="ol4" type="real" dimensions="nCells" streams="io"/>
+
+ <!-- description of the vertical grid structure -->
+ <var name="hx" type="real" dimensions="nVertLevelsP1 nCells" streams="io"/>
+ <var name="zgrid" type="real" dimensions="nVertLevelsP1 nCells" streams="io"/>
+ <var name="rdzw" type="real" dimensions="nVertLevels" streams="io"/>
+ <var name="dzu" type="real" dimensions="nVertLevels" streams="io"/>
+ <var name="rdzu" type="real" dimensions="nVertLevels" streams="io"/>
+ <var name="fzm" type="real" dimensions="nVertLevels" streams="io"/>
+ <var name="fzp" type="real" dimensions="nVertLevels" streams="io"/>
+ <var name="zx" type="real" dimensions="nVertLevelsP1 nEdges" streams="io"/>
+ <var name="zz" type="real" dimensions="nVertLevelsP1 nCells" streams="io"/>
+ <var name="zb" type="real" dimensions="nVertLevelsP1 TWO nEdges" streams="io"/>
+ <var name="zb3" type="real" dimensions="nVertLevelsP1 TWO nEdges" streams="io"/>
+
+ <!-- W-Rayleigh damping coefficient -->
+ <var name="dss" type="real" dimensions="nVertLevels nCells" streams="io"/>
+
+ <var name="u_init" type="real" dimensions="nVertLevels" streams="io"/>
+ <var name="t_init" type="real" dimensions="nVertLevels nCells" streams="io"/>
+ <var name="qv_init" type="real" dimensions="nVertLevels" streams="io"/>
+
+ <!-- variables needed for advection -->
+ <var name="deriv_two" type="real" dimensions="FIFTEEN TWO nEdges" streams="io"/>
+ <var name="advCells" type="integer" dimensions="TWENTYONE nCells" streams="io"/>
+
+ <!-- deformation calculation weights -->
+ <var name="defc_a" type="real" dimensions="maxEdges nCells" streams="io"/>
+ <var name="defc_b" type="real" dimensions="maxEdges nCells" streams="io"/>
+
+ <!-- arrays required for reconstruction of velocity field -->
+ <var name="coeffs_reconstruct" type="real" dimensions="R3 maxEdges nCells" streams="io"/>
+ </var_struct>
+
+ <var_struct name="state" time_levs="2">
+ <var name="xtime" type="text" dimensions="Time" streams="so"/>
+ <var name="u" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="w" type="real" dimensions="nVertLevelsP1 nCells Time" streams="o"/>
+ <var name="rho_zz" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="theta_m" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+
+ <var_array name="scalars" type="real" dimensions="nVertLevels nCells Time">
+ <var name="qv" array_group="moist" streams="o"/>
+ <var name="qc" array_group="moist" streams="o"/>
+ <var name="qr" array_group="moist" streams="o"/>
+ </var_array>
+ </var_struct>
+
+ <var_struct name="fg" time_levs="1">
+
+ <!-- horizontally interpolated from first-guess data -->
+ <var name="u_fg" name_in_code="u" type="real" dimensions="nFGLevels nEdges Time"/>
+ <var name="v_fg" name_in_code="v" type="real" dimensions="nFGLevels nEdges Time"/>
+ <var name="t_fg" name_in_code="t" type="real" dimensions="nFGLevels nCells Time" streams="o"/>
+ <var name="p_fg" name_in_code="p" type="real" dimensions="nFGLevels nCells Time" streams="o"/>
+ <var name="z_fg" name_in_code="z" type="real" dimensions="nFGLevels nCells Time" streams="o"/>
+ <var name="rh_fg" name_in_code="rh" type="real" dimensions="nFGLevels nCells Time" streams="o"/>
+ <var name="soilz_fg" name_in_code="soilz" type="real" dimensions="nCells Time" streams="io"/>
+ <var name="psfc_fg" name_in_code="psfc" type="real" dimensions="nCells Time"/>
+ <var name="pmsl_fg" name_in_code="pmsl" type="real" dimensions="nCells Time"/>
+ <var name="dz_fg" type="real" dimensions="nFGSoilLevels nCells Time" streams="io"/>
+ <var name="dzs_fg" type="real" dimensions="nFGSoilLevels nCells Time" streams="io"/>
+ <var name="zs_fg" type="real" dimensions="nFGSoilLevels nCells Time" streams="io"/>
+ <var name="st_fg" type="real" dimensions="nFGSoilLevels nCells Time" streams="io"/>
+ <var name="sm_fg" type="real" dimensions="nFGSoilLevels nCells Time" streams="io"/>
+
+ <!-- horizontally interpolated from first-guess data, and should be read in by model -->
+ <var name="dz" type="real" dimensions="nSoilLevels nCells Time" streams="io"/>
+ <var name="dzs" type="real" dimensions="nSoilLevels nCells Time" streams="io"/>
+ <var name="zs" type="real" dimensions="nSoilLevels nCells Time" streams="io"/>
+ <var name="sh2o" type="real" dimensions="nSoilLevels nCells Time" streams="io"/>
+ <var name="smois" type="real" dimensions="nSoilLevels nCells Time" streams="io"/>
+ <var name="tslb" type="real" dimensions="nSoilLevels nCells Time" streams="io"/>
+ <var name="smcrel" type="real" dimensions="nSoilLevels nCells Time" streams="io"/>
+ <var name="tmn" type="real" dimensions="nCells Time" streams="io"/>
+ <var name="skintemp" type="real" dimensions="nCells Time" streams="io"/>
+ <var name="sst" type="real" dimensions="nCells Time" streams="iso"/>
+ <var name="snow" type="real" dimensions="nCells Time" streams="io"/>
+ <var name="snowc" type="real" dimensions="nCells Time" streams="io"/>
+ <var name="snowh" type="real" dimensions="nCells Time" streams="io"/>
+ <var name="xice" type="real" dimensions="nCells Time" streams="iso"/>
+ <var name="seaice" type="real" dimensions="nCells Time" streams="io"/>
+ <var name="gfs_z" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="vegfra" type="real" dimensions="nCells Time" streams="io"/>
+ <var name="sfc_albbck" type="real" dimensions="nCells Time" streams="io"/>
+ <var name="xland" type="real" dimensions="nCells Time" streams="io"/>
+ </var_struct>
+
+ <var_struct name="diag" time_levs="1">
+ <var name="pressure_p" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="rho" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="theta" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="v" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="rh" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructX" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructY" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructZ" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructZonal" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructMeridional" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="exner" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="exner_base" type="real" dimensions="nVertLevels nCells Time" streams="io"/>
+ <var name="rtheta_base" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="pressure" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="pressure_base" type="real" dimensions="nVertLevels nCells Time" streams="io"/>
+ <var name="rho_base" type="real" dimensions="nVertLevels nCells Time" streams="io"/>
+ <var name="theta_base" type="real" dimensions="nVertLevels nCells Time" streams="io"/>
+ <var name="cqw" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="surface_pressure" type="real" dimensions="nCells Time" streams="io"/>
+
+ <!-- coupled variables needed by the solver, but not output -->
+ <var name="ru" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="rw" type="real" dimensions="nVertLevelsP1 nCells Time"/>
+ <var name="rtheta_p" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="rho_p" type="real" dimensions="nVertLevels nCells Time"/>
+ </var_struct>
+
+ <var_struct name="diag_physics" time_levs="1">
+ <var name="precipw" type="real" dimensions="nCells Time" streams="o"/>
+ </var_struct>
+</registry>
Modified: branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_llxy.F
===================================================================
--- branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_llxy.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_llxy.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1669,7 +1669,7 @@
TYPE (proj_info), INTENT(IN) :: proj
! Local variables
- INTEGER :: ii,imt,jj,jmt,k,krows,ncol,nrow,iri
+ INTEGER :: ii,imt,jj,jmt,ncol,nrow
REAL(KIND=HIGH) :: dphd,dlmd !Grid increments, degrees
REAL(KIND=HIGH) :: glatd !Geographic latitude, positive north
REAL(KIND=HIGH) :: glond !Geographic longitude, positive west
@@ -1839,8 +1839,8 @@
TYPE (proj_info), INTENT(IN) :: proj
! Local variables
- INTEGER :: ih,jh
- INTEGER :: midcol,midrow,ncol,iadd1,iadd2,imt,jh2,knrow,krem,kv,nrow
+ INTEGER :: jh
+ INTEGER :: midcol,midrow
REAL (KIND=RKIND) :: i_work, j_work
REAL (KIND=RKIND) :: dphd,dlmd !Grid increments, degrees
REAL(KIND=HIGH) :: arg1,arg2,d2r,fctr,glatr,glatd,glond,pi, &
Copied: branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_static.F (from rev 2782, trunk/mpas/src/core_init_nhyd_atmos/mpas_init_atm_static.F)
===================================================================
--- branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_static.F (rev 0)
+++ branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_static.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,1891 @@
+!==================================================================================================
+ module mpas_init_atm_static
+!==================================================================================================
+ use atm_advection
+ use mpas_configure
+ use mpas_dmpar
+ use init_atm_hinterp
+ use init_atm_llxy
+
+ use mpas_atmphys_utilities
+
+ implicit none
+ private
+ public:: init_atm_static, &
+ init_atm_static_orogwd, &
+ init_atm_check_read_error, &
+ nearest_cell, &
+ sphere_distance
+
+ contains
+
+!==================================================================================================
+ subroutine init_atm_static(mesh)
+!==================================================================================================
+
+!inout arguments:
+ type(mesh_type),intent(inout):: mesh
+
+!local variables:
+ type(proj_info):: proj
+ type(dm_info),pointer :: dminfo
+
+ character(len=StrKIND):: fname
+
+ integer:: nx,ny,nz
+ integer:: endian,isigned,istatus,wordsize
+ integer:: i,j,k
+ integer:: iCell,iPoint,iTileStart,iTileEnd,jTileStart,jTileEnd
+ integer,dimension(5) :: interp_list
+ integer,dimension(:),allocatable :: nhs
+ integer,dimension(:,:),allocatable:: ncat
+
+ real(kind=4):: scalefactor
+ real(kind=4),dimension(:,:,:),allocatable:: rarray
+
+ real(kind=RKIND):: r_earth
+ real(kind=RKIND):: lat,lon,x,y
+ real(kind=RKIND):: lat_pt,lon_pt
+ real(kind=RKIND),dimension(:,:),allocatable :: soiltemp_1deg
+ real(kind=RKIND),dimension(:,:),allocatable :: maxsnowalb
+ real(kind=RKIND),dimension(:,:,:),allocatable:: vegfra
+
+!--------------------------------------------------------------------------------------------------
+ write(0,*)
+ write(0,*) '--- enter subroutine init_atm_static:'
+
+!
+! Scale all distances and areas from a unit sphere to one with radius sphere_radius
+!
+
+ r_earth = mesh % sphere_radius
+
+ mesh % xCell % array = mesh % xCell % array * r_earth
+ mesh % yCell % array = mesh % yCell % array * r_earth
+ mesh % zCell % array = mesh % zCell % array * r_earth
+ mesh % xVertex % array = mesh % xVertex % array * r_earth
+ mesh % yVertex % array = mesh % yVertex % array * r_earth
+ mesh % zVertex % array = mesh % zVertex % array * r_earth
+ mesh % xEdge % array = mesh % xEdge % array * r_earth
+ mesh % yEdge % array = mesh % yEdge % array * r_earth
+ mesh % zEdge % array = mesh % zEdge % array * r_earth
+ mesh % dvEdge % array = mesh % dvEdge % array * r_earth
+ mesh % dcEdge % array = mesh % dcEdge % array * r_earth
+ mesh % areaCell % array = mesh % areaCell % array * r_earth**2.0
+ mesh % areaTriangle % array = mesh % areaTriangle % array * r_earth**2.0
+ mesh % kiteAreasOnVertex % array = mesh % kiteAreasOnVertex % array * r_earth**2.0
+
+ call atm_initialize_advection_rk(mesh)
+ call atm_initialize_deformation_weights(mesh)
+
+!
+! Interpolate HGT
+!
+!nx = 126
+!ny = 126
+ nx = 1206
+ ny = 1206
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 1.0
+ allocate(rarray(nx,ny,nz))
+ allocate(nhs(mesh%nCells))
+ nhs(:) = 0
+ mesh%ter%array(:) = 0.0
+
+ do jTileStart = 1,20401,ny-6
+ jTileEnd = jTileStart + ny - 1 - 6
+
+ do iTileStart=1,42001,nx-6
+ iTileEnd = iTileStart + nx - 1 - 6
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ 'topo_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus, fname, dminfo)
+
+ iPoint = 1
+ do j=4,ny-3
+ do i=4,nx-3
+ lat_pt = -89.99583 + (jTileStart + j - 5) * 0.0083333333
+ lon_pt = -179.99583 + (iTileStart + i - 5) * 0.0083333333
+ lat_pt = lat_pt * PI / 180.0
+ lon_pt = lon_pt * PI / 180.0
+
+ iPoint = nearest_cell(lat_pt,lon_pt,iPoint,mesh%nCells,mesh%maxEdges, &
+ mesh%nEdgesOnCell%array,mesh%cellsOnCell%array, &
+ mesh%latCell%array,mesh%lonCell%array)
+ mesh%ter%array(iPoint) = mesh%ter%array(iPoint) + rarray(i,j,1)
+ nhs(iPoint) = nhs(iPoint) + 1
+ end do
+ end do
+
+ end do
+ end do
+
+ do iCell = 1,mesh%nCells
+ mesh%ter%array(iCell) = mesh%ter%array(iCell) / real(nhs(iCell))
+ end do
+ deallocate(rarray)
+ deallocate(nhs)
+ write(0,*) '--- end interpolate TER'
+
+
+!
+! Interpolate LU_INDEX
+!
+ nx = 1200
+ ny = 1200
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 1
+ scalefactor = 1.0
+ allocate(rarray(nx,ny,nz))
+ allocate(ncat(24,mesh%nCells))
+ ncat(:,:) = 0
+ mesh%lu_index%array(:) = 0.0
+
+ do jTileStart = 1,20401,ny
+ jTileEnd = jTileStart + ny - 1
+
+ do iTileStart = 1,42001,nx
+ iTileEnd = iTileStart + nx - 1
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ '/landuse_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus, fname, dminfo)
+
+ iPoint = 1
+ do j=1,ny
+ do i=1,nx
+ lat_pt = -89.99583 + (jTileStart + j - 2) * 0.0083333333
+ lon_pt = -179.99583 + (iTileStart + i - 2) * 0.0083333333
+ lat_pt = lat_pt * PI / 180.0
+ lon_pt = lon_pt * PI / 180.0
+
+ iPoint = nearest_cell(lat_pt,lon_pt,iPoint,mesh%nCells,mesh%maxEdges, &
+ mesh%nEdgesOnCell%array,mesh%cellsOnCell%array, &
+ mesh%latCell%array,mesh%lonCell%array)
+ ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
+ end do
+ end do
+
+ end do
+ end do
+
+ do iCell = 1,mesh%nCells
+ mesh%lu_index%array(iCell) = 1
+ do i = 2,24
+ if(ncat(i,iCell) > ncat(mesh%lu_index%array(iCell),iCell)) then
+ mesh%lu_index%array(iCell) = i
+ end if
+ end do
+ end do
+ deallocate(rarray)
+ deallocate(ncat)
+ write(0,*) '--- end interpolate LU_INDEX'
+
+
+!
+! Interpolate SOILCAT_TOP
+!
+ nx = 1200
+ ny = 1200
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 1
+ scalefactor = 1.0
+ allocate(rarray(nx,ny,nz))
+ allocate(ncat(16,mesh%nCells))
+ ncat(:,:) = 0
+ mesh%soilcat_top%array(:) = 0.0
+
+ do jTileStart = 1,20401,ny
+ jTileEnd = jTileStart + ny - 1
+
+ do iTileStart = 1,42001,nx
+ iTileEnd = iTileStart + nx - 1
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ '/soiltype_top_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus, fname, dminfo)
+
+ iPoint = 1
+ do j=1,ny
+ do i=1,nx
+ lat_pt = -89.99583 + (jTileStart + j - 2) * 0.0083333333
+ lon_pt = -179.99583 + (iTileStart + i - 2) * 0.0083333333
+ lat_pt = lat_pt * PI / 180.0
+ lon_pt = lon_pt * PI / 180.0
+
+ iPoint = nearest_cell(lat_pt,lon_pt,iPoint,mesh%nCells,mesh%maxEdges, &
+ mesh%nEdgesOnCell%array,mesh%cellsOnCell%array, &
+ mesh%latCell%array,mesh%lonCell%array)
+ ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
+ end do
+ end do
+
+ end do
+ end do
+
+ do iCell = 1,mesh%nCells
+ mesh%soilcat_top%array(iCell) = 1
+ do i = 2,16
+ if(ncat(i,iCell) > ncat(mesh%soilcat_top%array(iCell),iCell)) then
+ mesh%soilcat_top%array(iCell) = i
+ end if
+ end do
+ end do
+ deallocate(rarray)
+ deallocate(ncat)
+ write(0,*) '--- end interpolate SOILCAT_TOP'
+
+
+!
+! Interpolate SOILCAT_BOT
+!
+ nx = 1200
+ ny = 1200
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 1
+ scalefactor = 1.0
+ allocate(rarray(nx,ny,nz))
+ allocate(ncat(16,mesh%nCells))
+ ncat(:,:) = 0
+ mesh%soilcat_bot%array(:) = 0.0
+
+ do jTileStart = 1,20401,ny
+ jTileEnd = jTileStart + ny - 1
+
+ do iTileStart = 1,42001,nx
+ iTileEnd = iTileStart + nx - 1
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ '/soiltype_bot_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus, fname, dminfo)
+
+ iPoint = 1
+ do j=1,ny
+ do i=1,nx
+ lat_pt = -89.99583 + (jTileStart + j - 2) * 0.0083333333
+ lon_pt = -179.99583 + (iTileStart + i - 2) * 0.0083333333
+ lat_pt = lat_pt * PI / 180.0
+ lon_pt = lon_pt * PI / 180.0
+
+ iPoint = nearest_cell(lat_pt,lon_pt,iPoint,mesh%nCells,mesh%maxEdges, &
+ mesh%nEdgesOnCell%array,mesh%cellsOnCell%array, &
+ mesh%latCell%array,mesh%lonCell%array)
+ ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
+ end do
+ end do
+
+ end do
+ end do
+
+ do iCell =1, mesh%nCells
+ mesh%soilcat_bot%array(iCell) = 1
+ do i = 2,16
+ if(ncat(i,iCell) > ncat(mesh%soilcat_bot%array(iCell),iCell)) then
+ mesh%soilcat_bot%array(iCell) = i
+ end if
+ end do
+ end do
+ deallocate(rarray)
+ deallocate(ncat)
+ write(0,*) '--- end interpolate SOILCAT_BOT'
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! KLUDGE TO FIX SOIL TYPE OVER ANTARCTICA
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ where (mesh%lu_index%array == 24) mesh%soilcat_top%array = 16
+ where (mesh%lu_index%array == 24) mesh%soilcat_bot%array = 16
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! CORRECT INCONSISTENT SOIL AND LAND USE DATA
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ do iCell = 1,mesh%nCells
+ if (mesh%lu_index%array(iCell) == 16 .or. &
+ mesh%soilcat_top%array(iCell) == 14 .or. &
+ mesh%soilcat_bot%array(iCell) == 14) then
+ if (mesh%lu_index%array(iCell) /= 16) then
+ write(0,*) 'Turning lu_index into water at ', iCell
+ mesh%lu_index%array(iCell) = 16
+ end if
+ if (mesh%soilcat_top%array(iCell) /= 14) then
+ write(0,*) 'Turning soilcat_top into water at ', iCell
+ mesh%soilcat_top%array(iCell) = 14
+ end if
+ if (mesh%soilcat_bot%array(iCell) /= 14) then
+ write(0,*) 'Turning soilcat_bot into water at ', iCell
+ mesh%soilcat_bot%array(iCell) = 14
+ end if
+ end if
+ end do
+
+
+!
+! Derive LANDMASK
+!
+ mesh%landmask%array(:) = 0
+ do iCell=1, mesh%nCells
+ if (mesh%lu_index%array(iCell) /= 16) mesh%landmask%array(iCell) = 1
+ end do
+ write(0,*) '--- end interpolate LANDMASK'
+
+
+!
+! Interpolate SOILTEMP:
+!
+ nx = 186
+ ny = 186
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.01
+ allocate(rarray(nx,ny,nz))
+ allocate(soiltemp_1deg(-2:363,-2:183))
+ mesh%soiltemp%array(:) = 0.0
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = 1.0_RKIND, &
+ loninc = 1.0_RKIND, &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = -89.5_RKIND, &
+ lon1 = -179.5_RKIND)
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ 'soiltemp_1deg/',1,'-',180,'.',1,'-',180
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned, endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus, fname, dminfo)
+ soiltemp_1deg(-2:180,-2:183) = rarray(1:183,1:186,1)
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ 'soiltemp_1deg/',181,'-',360,'.',1,'-',180
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname, len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ soiltemp_1deg(181:363,-2:183) = rarray(4:186,1:186,1)
+
+ interp_list(1) = FOUR_POINT
+ interp_list(2) = W_AVERAGE4
+ interp_list(3) = W_AVERAGE16
+ interp_list(4) = SEARCH
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+
+ if(mesh%landmask%array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ if(x < 0.5) then
+ lon = lon + 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ else if (x >= 360.5) then
+ lon = lon - 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ end if
+ if (y < 1.0) y = 1.0
+ if (y > 179.0) y = 179.0
+ mesh%soiltemp%array(iCell) = interp_sequence(x,y,1,soiltemp_1deg,-2,363,-2,183, &
+ 1,1,0.0_RKIND,interp_list,1)
+ else
+ mesh%soiltemp%array(iCell) = 0.0
+ end if
+
+ end do
+ deallocate(rarray)
+ deallocate(soiltemp_1deg)
+ write(0,*) '--- end interpolate SOILTEMP'
+
+
+!
+! Interpolate SNOALB
+!
+ nx = 186
+ ny = 186
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 1
+ scalefactor = 1.0
+ allocate(rarray(nx,ny,nz))
+ allocate(maxsnowalb(-2:363,-2:183))
+ mesh%snoalb%array(:) = 0.0
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = 1.0_RKIND, &
+ loninc = 1.0_RKIND, &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = -89.5_RKIND, &
+ lon1 = -179.5_RKIND)
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ 'maxsnowalb/',1,'-',180,'.',1,'-',180
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ maxsnowalb(-2:180,-2:183) = rarray(1:183,1:186,1)
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ 'maxsnowalb/',181,'-',360,'.',1,'-',180
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus, fname, dminfo)
+ maxsnowalb(181:363,-2:183) = rarray(4:186,1:186,1)
+
+ interp_list(1) = FOUR_POINT
+ interp_list(2) = W_AVERAGE4
+ interp_list(3) = W_AVERAGE16
+ interp_list(4) = SEARCH
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+
+ if(mesh%landmask%array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ if(x < 0.5) then
+ lon = lon + 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ else if (x >= 360.5) then
+ lon = lon - 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ end if
+ if (y < 1.0) y = 1.0
+ if (y > 179.0) y = 179.0
+ mesh%snoalb%array(iCell) = interp_sequence(x,y,1,maxsnowalb,-2,363,-2,183, &
+ 1,1,0.0_RKIND,interp_list,1)
+ else
+ mesh%snoalb%array(iCell) = 0.0
+ end if
+
+ end do
+ mesh%snoalb%array(:) = mesh%snoalb%array(:) / 100.0
+ deallocate(rarray)
+ deallocate(maxsnowalb)
+ write(0,*) '--- end interpolate SNOALB'
+
+
+!
+! Interpolate GREENFRAC
+!
+ nx = 1256
+ ny = 1256
+ nz = 12
+ isigned = 0
+ endian = 0
+ wordsize = 1
+ scalefactor = 1.0
+ allocate(rarray(nx,ny,nz))
+ allocate(vegfra(-2:2503,-2:1253,12))
+ mesh%greenfrac%array(:,:) = 0.0
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = 0.144_RKIND, &
+ loninc = 0.144_RKIND, &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = -89.928_RKIND, &
+ lon1 = -179.928_RKIND)
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ 'greenfrac/',1,'-',1250,'.',1,'-',1250
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ vegfra(-2:1250,-2:1253,1:12) = rarray(1:1253,1:1256,1:12)
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ 'greenfrac/',1251,'-',2500,'.',1,'-',1250
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ vegfra(1251:2503,-2:1253,1:12) = rarray(4:1256,1:1256,1:12)
+
+ do iCell = 1,mesh%nCells
+
+ if (mesh%landmask%array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ if(x < 0.5) then
+ lon = lon + 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ else if(x >= 2500.5) then
+ lon = lon - 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ end if
+ if (y < 1.0) y = 1.0
+ if (y > 1249.0) y = 1249.0
+ do k = 1,12
+ mesh%greenfrac%array(k,iCell) = interp_sequence(x,y,k,vegfra,-2,2503,-2,1253, &
+ 1,12,-1.e30_RKIND,interp_list,1)
+ end do
+ else
+ mesh%greenfrac%array(:,iCell) = 0.0
+ end if
+ mesh%shdmin%array(iCell) = minval(mesh%greenfrac%array(:,iCell))
+ mesh%shdmax%array(iCell) = maxval(mesh%greenfrac%array(:,iCell))
+
+ end do
+ deallocate(rarray)
+ deallocate(vegfra)
+ write(0,*) '--- end interpolate GREENFRAC'
+
+
+!
+! Interpolate ALBEDO12M
+!
+ nx = 1256
+ ny = 1256
+ nz = 12
+ isigned = 0
+ endian = 0
+ wordsize = 1
+ scalefactor = 1.0
+ allocate(rarray(nx,ny,nz))
+ allocate(vegfra(-2:2503,-2:1253,12))
+ mesh%albedo12m%array(:,:) = 0.0
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = 0.144_RKIND, &
+ loninc = 0.144_RKIND, &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = -89.928_RKIND, &
+ lon1 = -179.928_RKIND)
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ 'albedo_ncep/',1,'-',1250,'.',1,'-',1250
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor, wordsize, istatus)
+ call init_atm_check_read_error(istatus,fname, dminfo)
+ vegfra(-2:1250,-2:1253,1:12) = rarray(1:1253,1:1256,1:12)
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)// &
+ 'albedo_ncep/',1251,'-',2500,'.',1,'-',1250
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ vegfra(1251:2503,-2:1253,1:12) = rarray(4:1256,1:1256,1:12)
+
+ do iCell = 1,mesh%nCells
+
+ if (mesh%landmask%array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ if(x < 0.5) then
+ lon = lon + 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ else if(x >= 2500.5) then
+ lon = lon - 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ end if
+ if (y < 1.0) y = 1.0
+ if (y > 1249.0) y = 1249.0
+ do k = 1,12
+ mesh%albedo12m%array(k,iCell) = interp_sequence(x,y,k,vegfra,-2,2503,-2,1253, &
+ 1,12,0.0_RKIND,interp_list,1)
+ end do
+ else
+ mesh%albedo12m%array(:,iCell) = 8.0
+ end if
+ end do
+ deallocate(rarray)
+ deallocate(vegfra)
+ write(0,*) '--- end interpolate ALBEDO12M'
+
+
+ end subroutine init_atm_static
+
+!==================================================================================================
+ subroutine init_atm_static_orogwd(mesh)
+!==================================================================================================
+
+!inout arguments:
+ type(mesh_type),intent(inout):: mesh
+
+!local variables:
+ type(proj_info):: proj
+ type(dm_info),pointer :: dminfo
+
+ character(len=StrKIND):: mess
+ character(len=StrKIND):: fname
+ character(len=StrKIND):: dir_gwdo
+
+ integer:: nx,ny,nz
+ integer:: endian,isigned,istatus,wordsize
+ integer:: i,j
+ integer:: iCell,iPoint,iTileStart,iTileEnd,jTileStart,jTileEnd
+ integer,dimension(5) :: interp_list
+ integer,dimension(:),allocatable:: nhs
+
+ real(kind=4):: scalefactor
+ real(kind=4),dimension(:,:,:),allocatable:: rarray
+
+ real(kind=RKIND):: lat,lon,x,y
+ real(kind=RKIND):: lat_pt,lon_pt
+ real(kind=RKIND):: dx,dy,known_lat,known_lon,known_x,known_y
+ real(kind=RKIND):: minMeshD,maxMeshD
+ real(kind=RKIND):: mindcEdge,maxdcEdge
+ real(kind=RKIND),dimension(:,:),allocatable:: xarray
+
+!--------------------------------------------------------------------------------------------------
+ write(0,*)
+ write(0,*) '--- enter subroutine init_atm_static_orogwd:'
+
+!goto 100
+!
+! Interpolate VARSSO:
+ mesh%varsso%array(:) = 0.0_RKIND
+ nx = 600
+ ny = 600
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 4
+ scalefactor = 1.0
+
+ dx = 0.00833333
+ dy = 0.00833333
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -59.99583
+ known_lon = -179.99583
+
+ allocate(rarray(nx,ny,nz))
+ allocate(nhs(mesh%nCells))
+ nhs(:) = 0
+ rarray(:,:,:) = 0._RKIND
+ do jTileStart = 1,13801,ny
+ jTileEnd = jTileStart + ny - 1
+
+ do iTileStart = 1,42601,nx
+ iTileEnd = iTileStart + nx -1
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'varsso/', &
+ iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
+ write(0,*) trim(fname)
+
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+
+ iPoint = 1
+ do j = 1,ny
+ do i = 1,nx
+ lat_pt = known_lat + (jTileStart + j - 2) * dy
+ lon_pt = known_lon + (iTileStart + i - 2) * dx
+ lat_pt = lat_pt * PI / 180.0
+ lon_pt = lon_pt * PI / 180.0
+
+ iPoint = nearest_cell(lat_pt,lon_pt,iPoint,mesh%nCells,mesh%maxEdges, &
+ mesh%nEdgesOnCell%array,mesh%cellsOnCell%array, &
+ mesh%latCell%array,mesh%lonCell%array)
+ mesh%varsso%array(iPoint) = mesh%varsso%array(iPoint) + rarray(i,j,1)
+ nhs(iPoint) = nhs(iPoint) + 1
+ enddo
+ enddo
+
+ enddo
+ enddo
+
+ do iCell = 1,mesh%nCells
+ if(nhs(iCell) .gt. 0) &
+ mesh%varsso%array(iCell) = mesh%varsso%array(iCell) / real(nhs(iCell))
+ enddo
+ deallocate(rarray)
+ deallocate(nhs)
+ write(0,*) '--- end interpolate VARSSO'
+
+! 100 continue
+!... statistic fields needed for the parameterization of gravity wavwe drag over orography. The
+!input directory depends on the mesh resolution, and the mesh must be a uniform mesh.
+ minMeshD = minval(mesh%meshDensity%array(1:mesh%nCells))
+ maxMeshD = maxval(mesh%meshDensity%array(1:mesh%nCells))
+ mindcEdge = minval(mesh%dcEdge%array(1:mesh%nEdges))
+ maxdcEdge = maxval(mesh%dcEdge%array(1:mesh%nEdges))
+
+ write(0,*)
+ write(0,*) 'BEGIN INTERPOLATION OF STATISTICAL FIELDS FOR GRAVITY WAVE DRAG OVER OROGRAPHY'
+ write(0,*) 'min MeshD =', minMeshD
+ write(0,*) 'max MeshD =', maxMeshD
+ write(0,*) 'min dcEdge =', mindcEdge
+ write(0,*) 'max dcEdge =', maxdcEdge
+
+ dir_gwdo = ' '
+ if(minMeshD == 1.0_RKIND .and. maxMeshD == 1.0_RKIND) then
+ !... uniform 10242 mesh:
+ if(mindcEdge .ge. 200000._RKIND .and. maxdcEdge .lt. 260000._RKIND) then
+ dir_gwdo = 'orogwd_2deg'
+ elseif(mindcEdge .ge. 90000._RKIND .and. maxdcEdge .lt. 150000_RKIND) then
+ dir_gwdo = 'orogwd_1deg'
+ elseif(mindcEdge .ge. 40000._RKIND .and. maxdcEdge .lt. 70000._RKIND) then
+ dir_gwdo = 'orogwd_30m'
+ else
+ write(0,*)
+! write(mess,*) 'GWDO: Interpolation not available. The initialization will abort'
+! call physics_error_fatal(mess)
+ write(mess,*) 'GWDO: Interpolation not available. Set config_gwdo_scheme = .false.'
+ return
+ endif
+ else
+ write(0,*)
+! write(mess,*) 'GWDO: The input mesh must be a uniform mesh. The initialization will abort'
+! call physics_error_fatal(mess)
+ write(mess,*) 'GWDO: The input mesh must be a uniform mesh. Set config_gwdo_scheme = .false.'
+ return
+ endif
+ write(0,*) 'dir_gwdo = ', trim(dir_gwdo)
+ write(0,*)
+
+!
+! Interpolate CON:
+!
+ mesh%con%array(:) = 0.0_RKIND
+
+ con_select: select case(dir_gwdo)
+ case("orogwd_2deg")
+ nx = 180
+ ny = 90
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.025
+ dx = 2.0
+ dy = 2.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.0
+ known_lon = 1.0
+ case("orogwd_1deg")
+ nx = 360
+ ny = 180
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.025
+ dx = 1.0
+ dy = 1.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.5
+ known_lon = 0.5
+ case("orogwd_30m")
+ nx = 720
+ ny = 360
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.025
+ dx = 0.5
+ dy = 0.5
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.75
+ known_lon = 0.25
+ case("orogwd_10m")
+ nx = 2160
+ ny = 1080
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.025
+ dx = 0.16666667
+ dy = 0.16666667
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.916667
+ known_lon = 0.0833333
+ case default
+ end select con_select
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
+ trim(config_geog_data_path)//trim(dir_gwdo)//'/con/',1,'-',nx,'.',1,'-',ny
+ write(0,*) trim(fname)
+
+ allocate(xarray(nx,ny))
+ allocate(rarray(nx,ny,nz))
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = dy, &
+ loninc = dx, &
+ knowni = known_x, &
+ knownj = known_y, &
+ lat1 = known_lat, &
+ lon1 = known_lon)
+
+ interp_list(1) = AVERAGE4
+ interp_list(2) = AVERAGE4
+ interp_list(3) = AVERAGE4
+ interp_list(4) = AVERAGE4
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+ if(mesh % landmask % array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ mesh % con % array(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
+ 0.0_RKIND,interp_list,1)
+ endif
+ enddo
+ deallocate(rarray)
+ deallocate(xarray)
+ write(0,*) '--- end interpolate CON'
+
+!
+! Interpolate OA1:
+!
+ mesh%oa1%array(:) = 0.0_RKIND
+
+ oa1_select: select case(dir_gwdo)
+ case("orogwd_2deg")
+ nx = 180
+ ny = 90
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 2.0
+ dy = 2.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.0
+ known_lon = 1.0
+ case("orogwd_1deg")
+ nx = 360
+ ny = 180
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 1.0
+ dy = 1.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.5
+ known_lon = 0.5
+ case("orogwd_30m")
+ nx = 720
+ ny = 360
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.5
+ dy = 0.5
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.75
+ known_lon = 0.25
+ case("orogwd_10m")
+ nx = 2160
+ ny = 1080
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.16666667
+ dy = 0.16666667
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.916667
+ known_lon = 0.0833333
+ case default
+ end select oa1_select
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
+ trim(config_geog_data_path)//trim(dir_gwdo)//'/oa1/',1,'-',nx,'.',1,'-',ny
+ write(0,*) trim(fname)
+
+ allocate(xarray(nx,ny))
+ allocate(rarray(nx,ny,nz))
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = dy, &
+ loninc = dx, &
+ knowni = known_x, &
+ knownj = known_y, &
+ lat1 = known_lat, &
+ lon1 = known_lon)
+
+ interp_list(1) = AVERAGE4
+ interp_list(2) = AVERAGE4
+ interp_list(3) = AVERAGE4
+ interp_list(4) = AVERAGE4
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+ if(mesh % landmask % array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ mesh % oa1 % array(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
+ 0.0_RKIND,interp_list,1)
+ endif
+ enddo
+ deallocate(rarray)
+ deallocate(xarray)
+ write(0,*) '--- end interpolate OA1'
+
+!
+! Interpolate OA2:
+ mesh%oa2%array(:) = 0.0_RKIND
+
+ oa2_select: select case(dir_gwdo)
+ case("orogwd_2deg")
+ nx = 180
+ ny = 90
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 2.0
+ dy = 2.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.0
+ known_lon = 1.0
+ case("orogwd_1deg")
+ nx = 360
+ ny = 180
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 1.0
+ dy = 1.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.5
+ known_lon = 0.5
+ case("orogwd_30m")
+ nx = 720
+ ny = 360
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.5
+ dy = 0.5
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.75
+ known_lon = 0.25
+ case("orogwd_10m")
+ nx = 2160
+ ny = 1080
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.16666667
+ dy = 0.16666667
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.916667
+ known_lon = 0.0833333
+ case default
+ end select oa2_select
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
+ trim(config_geog_data_path)//trim(dir_gwdo)//'/oa2/',1,'-',nx,'.',1,'-',ny
+ write(0,*) trim(fname)
+
+ allocate(xarray(nx,ny))
+ allocate(rarray(nx,ny,nz))
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = dy, &
+ loninc = dx, &
+ knowni = known_x, &
+ knownj = known_y, &
+ lat1 = known_lat, &
+ lon1 = known_lon)
+
+ interp_list(1) = AVERAGE4
+ interp_list(2) = AVERAGE4
+ interp_list(3) = AVERAGE4
+ interp_list(4) = AVERAGE4
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+ if(mesh % landmask % array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ mesh % oa2 % array(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
+ 0.0_RKIND,interp_list,1)
+ endif
+ enddo
+ deallocate(rarray)
+ deallocate(xarray)
+ write(0,*) '--- end interpolate OA2'
+
+!
+! Interpolate OA3:
+!
+ mesh%oa3%array(:) = 0.0_RKIND
+
+ oa3_select: select case(dir_gwdo)
+ case("orogwd_2deg")
+ nx = 180
+ ny = 90
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 2.0
+ dy = 2.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.0
+ known_lon = 1.0
+ case("orogwd_1deg")
+ nx = 360
+ ny = 180
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 1.0
+ dy = 1.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.5
+ known_lon = 0.5
+ case("orogwd_30m")
+ nx = 720
+ ny = 360
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.5
+ dy = 0.5
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.75
+ known_lon = 0.25
+ case("orogwd_10m")
+ nx = 2160
+ ny = 1080
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.16666667
+ dy = 0.16666667
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.916667
+ known_lon = 0.0833333
+ case default
+ end select oa3_select
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
+ trim(config_geog_data_path)//trim(dir_gwdo)//'/oa3/',1,'-',nx,'.',1,'-',ny
+ write(0,*) trim(fname)
+
+ allocate(xarray(nx,ny))
+ allocate(rarray(nx,ny,nz))
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = dy, &
+ loninc = dx, &
+ knowni = known_x, &
+ knownj = known_y, &
+ lat1 = known_lat, &
+ lon1 = known_lon)
+
+ interp_list(1) = AVERAGE4
+ interp_list(2) = AVERAGE4
+ interp_list(3) = AVERAGE4
+ interp_list(4) = AVERAGE4
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+ if(mesh % landmask % array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ mesh % oa3 % array(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
+ 0.0_RKIND,interp_list,1)
+ endif
+ enddo
+ deallocate(rarray)
+ deallocate(xarray)
+ write(0,*) '--- end interpolate OA3'
+
+!
+! Interpolate OA4:
+!
+ mesh%oa4%array(:) = 0.0_RKIND
+
+ oa4_select: select case(dir_gwdo)
+ case("orogwd_2deg")
+ nx = 180
+ ny = 90
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 2.0
+ dy = 2.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.0
+ known_lon = 1.0
+ case("orogwd_1deg")
+ nx = 360
+ ny = 180
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 1.0
+ dy = 1.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.5
+ known_lon = 0.5
+ case("orogwd_30m")
+ nx = 720
+ ny = 360
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.5
+ dy = 0.5
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.75
+ known_lon = 0.25
+ case("orogwd_10m")
+ nx = 2160
+ ny = 1080
+ nz = 1
+ isigned = 1
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.16666667
+ dy = 0.16666667
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.916667
+ known_lon = 0.0833333
+ case default
+ end select oa4_select
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
+ trim(config_geog_data_path)//trim(dir_gwdo)//'/oa4/',1,'-',nx,'.',1,'-',ny
+ write(0,*) trim(fname)
+
+ allocate(xarray(nx,ny))
+ allocate(rarray(nx,ny,nz))
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = dy, &
+ loninc = dx, &
+ knowni = known_x, &
+ knownj = known_y, &
+ lat1 = known_lat, &
+ lon1 = known_lon)
+
+ interp_list(1) = AVERAGE4
+ interp_list(2) = AVERAGE4
+ interp_list(3) = AVERAGE4
+ interp_list(4) = AVERAGE4
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+ if(mesh % landmask % array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ mesh % oa4 % array(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
+ 0.0_RKIND,interp_list,1)
+ endif
+ enddo
+ deallocate(rarray)
+ deallocate(xarray)
+ write(0,*) '--- end interpolate OA4'
+
+!
+! Interpolate OL1:
+!
+ mesh%ol1%array(:) = 0.0_RKIND
+
+ ol1_select: select case(dir_gwdo)
+ case("orogwd_2deg")
+ nx = 180
+ ny = 90
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 2.0
+ dy = 2.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.0
+ known_lon = 1.0
+ case("orogwd_1deg")
+ nx = 360
+ ny = 180
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 1.0
+ dy = 1.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.5
+ known_lon = 0.5
+ case("orogwd_30m")
+ nx = 720
+ ny = 360
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.5
+ dy = 0.5
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.75
+ known_lon = 0.25
+ case("orogwd_10m")
+ nx = 2160
+ ny = 1080
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.16666667
+ dy = 0.16666667
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.916667
+ known_lon = 0.0833333
+ case default
+ end select ol1_select
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
+ trim(config_geog_data_path)//trim(dir_gwdo)//'/ol1/',1,'-',nx,'.',1,'-',ny
+ write(0,*) trim(fname)
+
+ allocate(xarray(nx,ny))
+ allocate(rarray(nx,ny,nz))
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = dy, &
+ loninc = dx, &
+ knowni = known_x, &
+ knownj = known_y, &
+ lat1 = known_lat, &
+ lon1 = known_lon)
+
+ interp_list(1) = AVERAGE4
+ interp_list(2) = AVERAGE4
+ interp_list(3) = AVERAGE4
+ interp_list(4) = AVERAGE4
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+ if(mesh % landmask % array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ mesh % ol1 % array(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
+ 0.0_RKIND,interp_list,1)
+ endif
+ enddo
+ deallocate(rarray)
+ deallocate(xarray)
+ write(0,*) '--- end interpolate OL1'
+
+!
+! Interpolate OL2:
+!
+ mesh%ol2%array(:) = 0.0_RKIND
+
+ ol2_select: select case(dir_gwdo)
+ case("orogwd_2deg")
+ nx = 180
+ ny = 90
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 2.0
+ dy = 2.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.0
+ known_lon = 1.0
+ case("orogwd_1deg")
+ nx = 360
+ ny = 180
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 1.0
+ dy = 1.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.5
+ known_lon = 0.5
+ case("orogwd_30m")
+ nx = 720
+ ny = 360
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.5
+ dy = 0.5
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.75
+ known_lon = 0.25
+ case("orogwd_10m")
+ nx = 2160
+ ny = 1080
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.16666667
+ dy = 0.16666667
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.916667
+ known_lon = 0.0833333
+ case default
+ end select ol2_select
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
+ trim(config_geog_data_path)//trim(dir_gwdo)//'/ol2/',1,'-',nx,'.',1,'-',ny
+ write(0,*) trim(fname)
+
+ allocate(xarray(nx,ny))
+ allocate(rarray(nx,ny,nz))
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = dy, &
+ loninc = dx, &
+ knowni = known_x, &
+ knownj = known_y, &
+ lat1 = known_lat, &
+ lon1 = known_lon)
+
+ interp_list(1) = AVERAGE4
+ interp_list(2) = AVERAGE4
+ interp_list(3) = AVERAGE4
+ interp_list(4) = AVERAGE4
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+ if(mesh % landmask % array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ mesh % ol2 % array(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
+ 0.0_RKIND,interp_list,1)
+ endif
+ enddo
+ deallocate(rarray)
+ deallocate(xarray)
+ write(0,*) '--- end interpolate OL2'
+
+!
+! Interpolate OL3:
+!
+ mesh%ol3%array(:) = 0.0_RKIND
+
+ ol3_select: select case(dir_gwdo)
+ case("orogwd_2deg")
+ nx = 180
+ ny = 90
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 2.0
+ dy = 2.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.0
+ known_lon = 1.0
+ case("orogwd_1deg")
+ nx = 360
+ ny = 180
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 1.0
+ dy = 1.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.5
+ known_lon = 0.5
+ case("orogwd_30m")
+ nx = 720
+ ny = 360
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.5
+ dy = 0.5
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.75
+ known_lon = 0.25
+ case("orogwd_10m")
+ nx = 2160
+ ny = 1080
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.16666667
+ dy = 0.16666667
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.916667
+ known_lon = 0.0833333
+ case default
+ end select ol3_select
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
+ trim(config_geog_data_path)//trim(dir_gwdo)//'/ol3/',1,'-',nx,'.',1,'-',ny
+ write(0,*) trim(fname)
+
+ allocate(xarray(nx,ny))
+ allocate(rarray(nx,ny,nz))
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = dy, &
+ loninc = dx, &
+ knowni = known_x, &
+ knownj = known_y, &
+ lat1 = known_lat, &
+ lon1 = known_lon)
+
+ interp_list(1) = AVERAGE4
+ interp_list(2) = AVERAGE4
+ interp_list(3) = AVERAGE4
+ interp_list(4) = AVERAGE4
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+ if(mesh % landmask % array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ mesh % ol3 % array(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
+ 0.0_RKIND,interp_list,1)
+ endif
+ enddo
+ deallocate(rarray)
+ deallocate(xarray)
+ write(0,*) '--- end interpolate OL3'
+
+!
+! Interpolate OL4:
+!
+ mesh%ol4%array(:) = 0.0_RKIND
+
+ ol4_select: select case(dir_gwdo)
+ case("orogwd_2deg")
+ nx = 180
+ ny = 90
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 2.0
+ dy = 2.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.0
+ known_lon = 1.0
+ case("orogwd_1deg")
+ nx = 360
+ ny = 180
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 1.0
+ dy = 1.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.5
+ known_lon = 0.5
+ case("orogwd_30m")
+ nx = 720
+ ny = 360
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.5
+ dy = 0.5
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.75
+ known_lon = 0.25
+ case("orogwd_10m")
+ nx = 2160
+ ny = 1080
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.0001
+ dx = 0.16666667
+ dy = 0.16666667
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.916667
+ known_lon = 0.0833333
+ case default
+ end select ol4_select
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
+ trim(config_geog_data_path)//trim(dir_gwdo)//'/ol4/',1,'-',nx,'.',1,'-',ny
+ write(0,*) trim(fname)
+
+ allocate(xarray(nx,ny))
+ allocate(rarray(nx,ny,nz))
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = dy, &
+ loninc = dx, &
+ knowni = known_x, &
+ knownj = known_y, &
+ lat1 = known_lat, &
+ lon1 = known_lon)
+
+ interp_list(1) = AVERAGE4
+ interp_list(2) = AVERAGE4
+ interp_list(3) = AVERAGE4
+ interp_list(4) = AVERAGE4
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+ if(mesh % landmask % array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ mesh % ol4 % array(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
+ 0.0_RKIND,interp_list,1)
+ endif
+ enddo
+ deallocate(rarray)
+ deallocate(xarray)
+ write(0,*) '--- end interpolate OL4'
+
+!
+! Interpolate VAR2D:
+!
+ mesh%var2d%array(:) = 0.0_RKIND
+
+ var2d_select: select case(dir_gwdo)
+ case("orogwd_2deg")
+ nx = 180
+ ny = 90
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 4
+ scalefactor = 0.02
+ dx = 2.0
+ dy = 2.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.0
+ known_lon = 1.0
+ case("orogwd_1deg")
+ nx = 360
+ ny = 180
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 4
+ scalefactor = 0.02
+ dx = 1.0
+ dy = 1.0
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.5
+ known_lon = 0.5
+ case("orogwd_30m")
+ nx = 720
+ ny = 360
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 4
+ scalefactor = 0.02
+ dx = 0.5
+ dy = 0.5
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.75
+ known_lon = 0.25
+ case("orogwd_10m")
+ nx = 2160
+ ny = 1080
+ nz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.02
+ dx = 0.16666667
+ dy = 0.16666667
+ known_x = 1.0
+ known_y = 1.0
+ known_lat = -89.916667
+ known_lon = 0.0833333
+ case default
+ end select var2d_select
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
+ trim(config_geog_data_path)//trim(dir_gwdo)//'/var/',1,'-',nx,'.',1,'-',ny
+ write(0,*) trim(fname)
+
+
+ allocate(xarray(nx,ny))
+ allocate(rarray(nx,ny,nz))
+ call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ scalefactor,wordsize,istatus)
+ call init_atm_check_read_error(istatus,fname,dminfo)
+ xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = dy, &
+ loninc = dx, &
+ knowni = known_x, &
+ knownj = known_y, &
+ lat1 = known_lat, &
+ lon1 = known_lon)
+
+ interp_list(1) = AVERAGE4
+ interp_list(2) = AVERAGE4
+ interp_list(3) = AVERAGE4
+ interp_list(4) = AVERAGE4
+ interp_list(5) = 0
+
+ do iCell = 1,mesh%nCells
+ if(mesh % landmask % array(iCell) == 1) then
+ lat = mesh % latCell % array(iCell) * DEG_PER_RAD
+ lon = mesh % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ mesh % var2d % array(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
+ 0.0_RKIND,interp_list,1)
+ endif
+ enddo
+ deallocate(rarray)
+ deallocate(xarray)
+ write(0,*) '--- end interpolate VAR2D'
+
+ end subroutine init_atm_static_orogwd
+
+!==================================================================================================
+ subroutine init_atm_check_read_error(istatus, fname, dminfo)
+!==================================================================================================
+ implicit none
+
+ integer, intent(in) :: istatus
+ character (len=*), intent(in) :: fname
+ type (dm_info), intent(in) :: dminfo
+
+ if (istatus /= 0) then
+ write(0,*) 'ERROR: Could not read file '//trim(fname)
+ call mpas_dmpar_abort(dminfo)
+ end if
+
+ end subroutine init_atm_check_read_error
+
+!==================================================================================================
+ integer function nearest_cell(target_lat, target_lon, start_cell, nCells, maxEdges, &
+ nEdgesOnCell, cellsOnCell, latCell, lonCell)
+!==================================================================================================
+ implicit none
+
+ real (kind=RKIND), intent(in) :: target_lat, target_lon
+ integer, intent(in) :: start_cell
+ integer, intent(in) :: nCells, maxEdges
+ integer, dimension(nCells), intent(in) :: nEdgesOnCell
+ integer, dimension(maxEdges,nCells), intent(in) :: cellsOnCell
+ real (kind=RKIND), dimension(nCells), intent(in) :: latCell, lonCell
+
+ integer :: i
+ integer :: iCell
+ integer :: current_cell
+ real (kind=RKIND) :: current_distance, d
+ real (kind=RKIND) :: nearest_distance
+
+ nearest_cell = start_cell
+ current_cell = -1
+
+ do while (nearest_cell /= current_cell)
+ current_cell = nearest_cell
+ current_distance = sphere_distance(latCell(current_cell), lonCell(current_cell), target_lat, &
+ target_lon, 1.0_RKIND)
+ nearest_cell = current_cell
+ nearest_distance = current_distance
+ do i = 1, nEdgesOnCell(current_cell)
+ iCell = cellsOnCell(i,current_cell)
+ if (iCell <= nCells) then
+ d = sphere_distance(latCell(iCell), lonCell(iCell), target_lat, target_lon, 1.0_RKIND)
+ if (d < nearest_distance) then
+ nearest_cell = iCell
+ nearest_distance = d
+ end if
+ end if
+ end do
+ end do
+
+ end function nearest_cell
+
+!==================================================================================================
+ real (kind=RKIND) function sphere_distance(lat1, lon1, lat2, lon2, radius)
+
+!Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
+!sphere with given radius.
+!==================================================================================================
+ implicit none
+
+ real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
+ real (kind=RKIND) :: arg1
+
+ arg1 = sqrt( sin(0.5*(lat2-lat1))**2 + &
+ cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
+ sphere_distance = 2.*radius*asin(arg1)
+
+ end function sphere_distance
+
+!==================================================================================================
+ end module mpas_init_atm_static
+!==================================================================================================
Copied: branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_surface.F (from rev 2782, trunk/mpas/src/core_init_nhyd_atmos/mpas_init_atm_surface.F)
===================================================================
--- branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_surface.F (rev 0)
+++ branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_surface.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,315 @@
+!==================================================================================================
+ module mpas_init_atm_surface
+ use mpas_configure
+ use mpas_grid_types
+ use mpas_io_output
+ use mpas_timekeeping
+ use mpas_timer
+
+ use init_atm_hinterp
+ use init_atm_llxy
+ use init_atm_read_met
+
+ implicit none
+ private
+ public:: init_atm_test_case_sfc,interp_sfc_to_MPAS
+
+ contains
+
+!==================================================================================================
+ subroutine init_atm_test_case_sfc(domain,dminfo,mesh,fg,state)
+!==================================================================================================
+
+!input arguments:
+ type(domain_type), intent(inout):: domain
+ type(dm_info), intent(in) :: dminfo
+ type(mesh_type), intent(inout) :: mesh
+ type(fg_type), intent(inout) :: fg
+ type (state_type), intent(inout):: state
+
+!local variables:
+ type(MPAS_Clock_type) :: fg_clock
+ type(MPAS_Time_type) :: start_time,stop_time,curr_time
+ type(MPAS_TimeInterval_type):: fg_interval
+
+ type(io_output_object):: sfc_update_obj
+
+ character(len=StrKIND) :: timeString
+
+!==================================================================================================
+
+!set up clock to step through all intermediate file dates to be processed:
+ call mpas_set_time(start_time, dateTimeString=trim(config_start_time))
+ call mpas_set_time(stop_time, dateTimeString=trim(config_stop_time))
+ call mpas_set_timeInterval(fg_interval, S=config_fg_interval)
+ call mpas_create_clock(fg_clock, start_time, fg_interval, stopTime=stop_time)
+
+!initialize the output file
+ sfc_update_obj % time = 1
+ sfc_update_obj % filename = trim(config_sfc_update_name)
+
+ call mpas_output_state_init(sfc_update_obj, domain, "SFC")
+
+!loop over all times:
+ curr_time = mpas_get_clock_time(fg_clock, MPAS_NOW)
+
+ do while (curr_time <= stop_time)
+ call mpas_get_time(curr_time, dateTimeString=timeString)
+! write(0,*) 'Processing ',trim(config_sfc_prefix)//':'//timeString(1:13)
+
+ !read the sea-surface temperature and sea-ice data from the surface file, and interpolate the
+ !data to the MPAS grid:
+ call interp_sfc_to_MPAS(timeString(1:13),mesh,fg,dminfo)
+
+ !write the interpolated SST/SKINTEMP field as a new time slice in the MPAS output file:
+ call mpas_output_state_for_domain(sfc_update_obj, domain, sfc_update_obj % time)
+ sfc_update_obj % time = sfc_update_obj % time + 1
+
+ call mpas_advance_clock(fg_clock)
+ curr_time = mpas_get_clock_time(fg_clock, MPAS_NOW)
+
+ call mpas_get_time(curr_time, dateTimeString=timeString)
+ state % xtime % scalar = timeString
+
+ enddo
+
+ call mpas_output_state_finalize(sfc_update_obj, dminfo)
+
+ end subroutine init_atm_test_case_sfc
+
+!==================================================================================================
+ subroutine interp_sfc_to_MPAS(timeString,mesh,fg,dminfo)
+!==================================================================================================
+
+!input arguments:
+ character(len=*),intent(in):: timeString
+ type(mesh_type), intent(in):: mesh
+ type(dm_info),intent(in) :: dminfo
+
+!inout arguments:
+ type(fg_type), intent(inout):: fg
+
+!local variables:
+ type(met_data) :: field !real*4 meteorological data.
+
+ integer:: istatus
+ integer:: masked
+ integer,dimension(5):: interp_list
+ integer,dimension(:),pointer:: mask_array
+
+ real(kind=RKIND):: fillval,maskval,msgval
+ real(kind=RKIND),dimension(:,:),allocatable:: maskslab
+
+ real(kind=RKIND), dimension(:), pointer:: destField1d
+
+!==================================================================================================
+ mask_array => mesh % landmask % array
+
+!open intermediate file:
+ call read_met_init(trim(config_sfc_prefix),.false.,timeString,istatus)
+ if(istatus /= 0) then
+ write(0,*) 'Error reading ',trim(config_sfc_prefix)//':'//timeString(1:13)
+ call mpas_dmpar_abort(dminfo)
+ else
+ write(0,*) 'Processing file ',trim(config_sfc_prefix)//':'//timeString(1:13)
+ endif
+
+!scan through all fields in the file, looking for the LANDSEA field:
+ call read_next_met_field(field,istatus)
+ do while (istatus == 0)
+ if(index(field % field, 'LANDSEA') /= 0) then
+ if(.not.allocated(maskslab)) allocate(maskslab(-2:field % nx+3, field % ny))
+ maskslab(1:field % nx, 1:field % ny) = field % slab(1:field % nx, 1:field % ny)
+ maskslab(0, 1:field % ny) = field % slab(field % nx, 1:field % ny)
+ maskslab(-1, 1:field % ny) = field % slab(field % nx-1, 1:field % ny)
+ maskslab(-2, 1:field % ny) = field % slab(field % nx-2, 1:field % ny)
+ maskslab(field % nx+1, 1:field % ny) = field % slab(1, 1:field % ny)
+ maskslab(field % nx+2, 1:field % ny) = field % slab(2, 1:field % ny)
+ maskslab(field % nx+3, 1:field % ny) = field % slab(3, 1:field % ny)
+! write(0,*) 'minval, maxval of LANDSEA = ', minval(maskslab), maxval(maskslab)
+ endif
+ deallocate(field % slab)
+ call read_next_met_field(field,istatus)
+ enddo
+ call read_met_close()
+
+!read sea-surface temperatures and seaice data. open intermediate file:
+ call read_met_init(trim(config_sfc_prefix),.false.,timeString(1:13),istatus)
+ if(istatus /= 0) then
+ write(0,*) 'Error reading ',trim(config_sfc_prefix)//':'//timeString(1:13)
+ call mpas_dmpar_abort(dminfo)
+ endif
+
+!scan through all fields in the file, looking for the SST,SKINTEMP, or SEAICE field:
+ call read_next_met_field(field,istatus)
+ do while (istatus == 0)
+
+ !sea-surface data:
+ if(index(field % field, 'SKINTEMP') /= 0 .or. index(field % field, 'SST') /= 0) then
+! write(0,*) '... Processing SST:'
+ fg % sst % array(1:mesh%nCells) = 0.0_RKIND
+ destField1d => fg % sst % array
+
+ !interpolation to the MPAS grid:
+ interp_list(1) = FOUR_POINT
+ interp_list(2) = SEARCH
+ interp_list(3) = 0
+ interp_list(4) = SEARCH
+ interp_list(5) = 0
+ msgval = -1.0e30_RKIND !missing value
+ masked = -1
+ maskval = -1.0_RKIND
+ fillval = 0.0_RKIND
+ call interp_to_MPAS(mesh,field,destField1d,interp_list,msgval,masked,maskval,fillval, &
+ maskslab,mask_array)
+
+ !field%slab was allocated in the subroutine read_next_met_field
+ deallocate(field%slab)
+
+ !sea-ice data:
+ elseif(index(field % field, 'SEAICE') /= 0) then
+! write(0,*) '... Processing SEAICE:'
+ fg % xice % array(1:mesh%nCells) = 0.0_RKIND
+ destField1d => fg % xice % array
+
+ !interpolation to the MPAS grid:
+ !interp_list(1) = SIXTEEN_POINT
+ interp_list(1) = FOUR_POINT
+ interp_list(2) = FOUR_POINT
+ interp_list(3) = W_AVERAGE4
+ interp_list(4) = SEARCH
+ interp_list(5) = 0
+ msgval = -1.0e30_RKIND !missing value
+ masked = 1
+ maskval = 1.0_RKIND
+ fillval = 0.0_RKIND
+ call interp_to_MPAS(mesh,field,destField1d,interp_list,msgval,masked,maskval,fillval, &
+ maskslab,mask_array)
+
+ !field%slab was allocated in the subroutine read_next_met_field
+ deallocate(field%slab)
+
+ else
+ deallocate(field%slab)
+
+ endif
+
+ call read_next_met_field(field,istatus)
+ enddo
+
+!close intermediate file:
+ call read_met_close()
+ if(allocated(maskslab)) deallocate(maskslab)
+
+!freeze really cold oceans:
+ where(fg%sst%array.lt.271.0_RKIND .and. mesh%landmask%array.eq.0) fg%xice%array = 1.0_RKIND
+
+!limit XICE to values between 0 and 1. Although the input meteorological field is between 0. and 1.
+!interpolation to the MPAS grid can yield values of XiCE less than 0. and greater than 1.:
+ where (fg%xice%array < 0._RKIND) fg%xice%array = 0._RKIND
+ where (fg%xice%array > 1._RKIND) fg%xice%array = 1._RKIND
+
+ end subroutine interp_sfc_to_MPAS
+
+!==================================================================================================
+ subroutine interp_to_MPAS(mesh,field,destField1d,interp_list,msgval,masked,maskval,fillval, &
+ maskslab,mask_array)
+!==================================================================================================
+
+!input arguments:
+ type(mesh_type),intent(in):: mesh
+ type(met_data),intent(in) :: field !real*4 meteorological data.
+
+ integer,intent(in):: masked
+ integer,dimension(5),intent(in):: interp_list
+ integer,dimension(:),intent(in),pointer:: mask_array
+
+ real(kind=RKIND),intent(in):: fillval,maskval,msgval
+ real(kind=RKIND),intent(in),dimension(*):: maskslab
+
+!inout arguments:
+ real(kind=RKIND),intent(inout),dimension(:),pointer:: destField1d
+
+!local variables:
+ type(proj_info):: proj
+ integer:: i,nInterpPoints
+ real(kind=RKIND):: lat,lon,x,y
+ real(kind=RKIND),dimension(:,:),allocatable:: rslab
+
+ real(kind=RKIND),dimension(:),pointer:: latPoints,lonPoints
+
+!--------------------------------------------------------------------------------------------------
+
+ call map_init(proj)
+ if(field % iproj == PROJ_LATLON) then
+ call map_set(PROJ_LATLON, proj, &
+ latinc = real(field % deltalat,RKIND), &
+ loninc = real(field % deltalon,RKIND), &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
+! write(0,*) '--- The projection is PROJ_LATLON.'
+ elseif(field % iproj == PROJ_GAUSS) then
+ call map_set(PROJ_GAUSS, proj, &
+ nlat = nint(field % deltalat), &
+ loninc = real(field % deltalon,RKIND), &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
+! write(0,*) '--- The projection is PROJ_GAUSS.'
+ elseif(field % iproj == PROJ_PS) then
+ call map_set(PROJ_PS, proj, &
+ dx = real(field % dx,RKIND), &
+ truelat1 = real(field % truelat1,RKIND), &
+ stdlon = real(field % xlonc,RKIND), &
+ knowni = real(field % nx / 2.0,RKIND), &
+ knownj = real(field % ny / 2.0,RKIND), &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
+! write(0,*) '--- The projection is PROJ_PS.'
+ endif
+
+ nInterpPoints = mesh % nCells
+ latPoints => mesh % latCell % array
+ lonPoints => mesh % lonCell % array
+
+ allocate(rslab(-2:field % nx+3, field % ny))
+ rslab(1:field % nx, 1:field % ny) = field % slab(1:field % nx, 1:field % ny)
+ rslab( 0, 1:field % ny) = field % slab(field % nx , 1:field % ny)
+ rslab(-1, 1:field % ny) = field % slab(field % nx-1, 1:field % ny)
+ rslab(-2, 1:field % ny) = field % slab(field % nx-2, 1:field % ny)
+ rslab(field % nx+1, 1:field % ny) = field % slab(1, 1:field % ny)
+ rslab(field % nx+2, 1:field % ny) = field % slab(2, 1:field % ny)
+ rslab(field % nx+3, 1:field % ny) = field % slab(3, 1:field % ny)
+
+ do i = 1,nInterpPoints
+ if(mask_array(i) /= masked) then
+ lat = latPoints(i) * DEG_PER_RAD
+ lon = lonPoints(i) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ if(y < 0.5) then
+ y = 1.0
+ elseif(y >= real(field%ny)+0.5) then
+ y = real(field % ny)
+ endif
+ if(x < 0.5) then
+ lon = lon + 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ elseif (x >= real(field%nx)+0.5) then
+ lon = lon - 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ endif
+ destField1d(i) = interp_sequence(x,y,1,rslab,-2,field%nx+3,1,field%ny,1,1, &
+ msgval,interp_list,1,maskval=maskval,mask_array=maskslab)
+ else
+ destField1d(i) = fillval
+ endif
+ enddo
+ deallocate(rslab)
+
+ end subroutine interp_to_MPAS
+
+!==================================================================================================
+ end module mpas_init_atm_surface
+!==================================================================================================
+
Modified: branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F
===================================================================
--- branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -10,6 +10,8 @@
use mpas_RBF_interpolation
use mpas_vector_reconstruction
use mpas_timer
+ use mpas_init_atm_static
+ use mpas_init_atm_surface
! Added only clause to keep xlf90 from getting confused from the overloaded abs intrinsic in mpas_timekeeping
use mpas_timekeeping !, only: MPAS_Time_type, MPAS_TimeInterval_type, MPAS_Clock_type, &
@@ -104,20 +106,25 @@
write(0,*) ' real-data GFS test case '
block_ptr => domain % blocklist
do while (associated(block_ptr))
+ if (config_static_interp) then
+ call init_atm_static(block_ptr % mesh)
+ call init_atm_static_orogwd(block_ptr % mesh)
+ endif
call init_atm_test_case_gfs(block_ptr % mesh, block_ptr % fg, &
block_ptr % state % time_levs(1) % state, block_ptr % diag, &
- config_test_case)
- if (config_met_interp) call physics_initialize_real(block_ptr % mesh, block_ptr % fg)
+ block_ptr % diag_physics, config_test_case)
+ if (config_met_interp) call physics_initialize_real(block_ptr % mesh, block_ptr % fg, domain % dminfo)
+
block_ptr => block_ptr % next
end do
else if (config_test_case == 8 ) then
- write(0,*) ' real-data surface (SST) update test case '
+ write(0,*) 'real-data surface (SST) update test case '
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call init_atm_test_case_sfc(domain, domain % dminfo, block_ptr % mesh, block_ptr % fg, block_ptr % state % time_levs(1) % state, &
- block_ptr % diag, config_test_case, block_ptr % parinfo)
+ ! Defined in mpas_init_atm_surface.F
+ call init_atm_test_case_sfc(domain, domain % dminfo, block_ptr % mesh,block_ptr % fg, block_ptr % state % time_levs(1) % state)
block_ptr => block_ptr % next
end do
@@ -2231,7 +2238,7 @@
end subroutine init_atm_test_case_mtn_wave
- subroutine init_atm_test_case_gfs(grid, fg, state, diag, test_case)
+ subroutine init_atm_test_case_gfs(grid, fg, state, diag, diag_physics, test_case)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Real-data test case using GFS data
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2247,6 +2254,7 @@
type (fg_type), intent(inout) :: fg
type (state_type), intent(inout) :: state
type (diag_type), intent(inout) :: diag
+ type (diag_physics_type), intent(inout):: diag_physics
integer, intent(in) :: test_case
type (block_type), pointer :: block
@@ -2291,10 +2299,9 @@
!This is temporary variable here. It just need when calculate tangential velocity v.
integer :: eoe, j
- integer, dimension(:), pointer :: nEdgesOnEdge, nEdgesOnCell
+ integer, dimension(:), pointer :: nEdgesOnCell
integer, dimension(:,:), pointer :: edgesOnEdge, cellsOnEdge, edgesOnCell, cellsOnCell
real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, AreaCell
- real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge
real (kind=RKIND), dimension(:,:), pointer :: v
real (kind=RKIND), dimension(:,:), pointer :: sorted_arr
@@ -2302,7 +2309,7 @@
type (field1DReal), target :: tempFieldTarget
real(kind=RKIND), dimension(:), pointer :: hs, hs1
- real(kind=RKIND) :: hm, zh, dzmin, dzmina, dzmina_global, dzminf, sm
+ real(kind=RKIND) :: hm, hm_global, zh, dzmin, dzmina, dzmina_global, dzminf, sm
integer :: nsmterrain, kz, sfc_k
logical :: hybrid, smooth
@@ -2310,19 +2317,10 @@
real (kind=RKIND) :: p_check
! For interpolating terrain and land use
- integer :: nx, ny, nzz, iPoint, subx, suby
- integer :: isigned, endian, wordsize, istatus
- integer :: iTileStart, iTileEnd
- integer :: jTileStart, jTileEnd
- integer, allocatable, dimension(:) :: nhs
- integer, allocatable, dimension(:,:) :: ncat
- real (kind=4) :: scalefactor ! NB: this should be a single-precision real
- real (kind=RKIND) :: lat_pt, lon_pt, lon_pt_o
- real (kind=4), allocatable, dimension(:,:,:) :: rarray ! NB: this should be a single-precision real array
+ integer :: nx, ny
+ integer :: istatus
+
real (kind=RKIND), allocatable, dimension(:,:) :: rslab, maskslab
- real (kind=RKIND), allocatable, dimension(:,:) :: maxsnowalb
- real (kind=RKIND), allocatable, dimension(:,:) :: soiltemp_1deg
- real (kind=RKIND), allocatable, dimension(:,:,:) :: vegfra
integer, dimension(:), pointer :: mask_array
integer, dimension(grid % nEdges), target :: edge_mask
character (len=StrKIND) :: fname
@@ -2364,8 +2362,6 @@
parinfo => block % parinfo
dminfo => block % domain % dminfo
- weightsOnEdge => grid % weightsOnEdge % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
nEdgesOnCell => grid % nEdgesOnCell % array
edgesOnEdge => grid % edgesOnEdge % array
edgesOnCell => grid % edgesOnCell % array
@@ -2421,622 +2417,9 @@
omega_e = omega
p0 = 1.e+05
- interp_list(1) = FOUR_POINT
- interp_list(2) = SEARCH
- interp_list(3) = 0
-
-
- !
- ! Scale all distances and areas from a unit sphere to one with radius sphere_radius
- !
-
- if (config_static_interp) then
-
- grid % xCell % array = grid % xCell % array * r_earth
- grid % yCell % array = grid % yCell % array * r_earth
- grid % zCell % array = grid % zCell % array * r_earth
- grid % xVertex % array = grid % xVertex % array * r_earth
- grid % yVertex % array = grid % yVertex % array * r_earth
- grid % zVertex % array = grid % zVertex % array * r_earth
- grid % xEdge % array = grid % xEdge % array * r_earth
- grid % yEdge % array = grid % yEdge % array * r_earth
- grid % zEdge % array = grid % zEdge % array * r_earth
- grid % dvEdge % array = grid % dvEdge % array * r_earth
- grid % dcEdge % array = grid % dcEdge % array * r_earth
- grid % areaCell % array = grid % areaCell % array * r_earth**2.0
- grid % areaTriangle % array = grid % areaTriangle % array * r_earth**2.0
- grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * r_earth**2.0
-
scalars(:,:,:) = 0.
- call atm_initialize_advection_rk(grid)
- call atm_initialize_deformation_weights(grid)
-
-
- !
- ! Interpolate HGT
- !
-! nx = 126
-! ny = 126
- nx = 1206
- ny = 1206
- nzz = 1
- isigned = 1
- endian = 0
- wordsize = 2
- scalefactor = 1.0
- allocate(rarray(nx,ny,nzz))
- allocate(nhs(grid % nCells))
- nhs(:) = 0
- ter(:) = 0.0
-
- do jTileStart=1,20401,ny-6
-! do jTileStart=1,961,ny-6
- jTileEnd = jTileStart + ny - 1 - 6
- do iTileStart=1,42001,nx-6
-! do iTileStart=1,2041,nx-6
- iTileEnd = iTileStart + nx - 1 - 6
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'topo_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
-! write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'topo_10m/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
-write(0,*) trim(fname)
-
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- iPoint = 1
- do j=4,ny-3
- do i=4,nx-3
- lat_pt = -89.99583 + (jTileStart + j - 5) * 0.0083333333
- lon_pt = -179.99583 + (iTileStart + i - 5) * 0.0083333333
-! lat_pt = -89.91667 + (jTileStart + j - 5) * 0.166667
-! lon_pt = -179.91667 + (iTileStart + i - 5) * 0.166667
- lat_pt = lat_pt * pii / 180.0
- lon_pt = lon_pt * pii / 180.0
-
- iPoint = nearest_cell(lat_pt, lon_pt, &
- iPoint, &
- grid % nCells, grid % maxEdges, grid % nEdgesOnCell % array, grid % cellsOnCell % array, &
- grid % latCell % array, grid % lonCell % array)
-
- ter(iPoint) = ter(iPoint) + rarray(i,j,1)
- nhs(iPoint) = nhs(iPoint) + 1
-
- end do
- end do
-
- end do
- end do
-
- do iCell=1, grid % nCells
- ter(iCell) = ter(iCell) / real(nhs(iCell))
- end do
-
- deallocate(rarray)
- deallocate(nhs)
-
-
- !
- ! Interpolate LU_INDEX
- !
- nx = 1200
- ny = 1200
- nzz = 1
- isigned = 1
- endian = 0
- wordsize = 1
- scalefactor = 1.0
- allocate(rarray(nx,ny,nzz))
- allocate(ncat(24,grid % nCells))
- ncat(:,:) = 0
- grid % lu_index % array(:) = 0.0
-
- do jTileStart=1,20401,ny
- jTileEnd = jTileStart + ny - 1
- do iTileStart=1,42001,nx
- iTileEnd = iTileStart + nx - 1
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'/landuse_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
-write(0,*) trim(fname)
-
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- iPoint = 1
- do j=1,ny
- do i=1,nx
- lat_pt = -89.99583 + (jTileStart + j - 2) * 0.0083333333
- lon_pt = -179.99583 + (iTileStart + i - 2) * 0.0083333333
- lat_pt = lat_pt * pii / 180.0
- lon_pt = lon_pt * pii / 180.0
-
- iPoint = nearest_cell(lat_pt, lon_pt, &
- iPoint, &
- grid % nCells, grid % maxEdges, grid % nEdgesOnCell % array, grid % cellsOnCell % array, &
- grid % latCell % array, grid % lonCell % array)
-
- ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
-
- end do
- end do
-
- end do
- end do
-
- do iCell=1, grid % nCells
- grid % lu_index % array(iCell) = 1
- do i=2,24
- if (ncat(i,iCell) > ncat(grid % lu_index % array(iCell),iCell)) then
- grid % lu_index % array(iCell) = i
- end if
- end do
- end do
-
- deallocate(rarray)
- deallocate(ncat)
-
-
- !
- ! Interpolate SOILCAT_TOP
- !
- nx = 1200
- ny = 1200
- nzz = 1
- isigned = 1
- endian = 0
- wordsize = 1
- scalefactor = 1.0
- allocate(rarray(nx,ny,nzz))
- allocate(ncat(16,grid % nCells))
- ncat(:,:) = 0
- grid % soilcat_top % array(:) = 0.0
-
- do jTileStart=1,20401,ny
- jTileEnd = jTileStart + ny - 1
- do iTileStart=1,42001,nx
- iTileEnd = iTileStart + nx - 1
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'/soiltype_top_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
-write(0,*) trim(fname)
-
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- iPoint = 1
- do j=1,ny
- do i=1,nx
- lat_pt = -89.99583 + (jTileStart + j - 2) * 0.0083333333
- lon_pt = -179.99583 + (iTileStart + i - 2) * 0.0083333333
- lat_pt = lat_pt * pii / 180.0
- lon_pt = lon_pt * pii / 180.0
-
- iPoint = nearest_cell(lat_pt, lon_pt, &
- iPoint, &
- grid % nCells, grid % maxEdges, grid % nEdgesOnCell % array, grid % cellsOnCell % array, &
- grid % latCell % array, grid % lonCell % array)
-
- ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
-
- end do
- end do
-
- end do
- end do
-
- do iCell=1, grid % nCells
- grid % soilcat_top % array(iCell) = 1
- do i=2,16
- if (ncat(i,iCell) > ncat(grid % soilcat_top % array(iCell),iCell)) then
- grid % soilcat_top % array(iCell) = i
- end if
- end do
- end do
-
- deallocate(rarray)
- deallocate(ncat)
-
-
- !
- ! Interpolate SOILCAT_BOT
- !
- nx = 1200
- ny = 1200
- nzz = 1
- isigned = 1
- endian = 0
- wordsize = 1
- scalefactor = 1.0
- allocate(rarray(nx,ny,nzz))
- allocate(ncat(16,grid % nCells))
- ncat(:,:) = 0
- grid % soilcat_bot % array(:) = 0.0
-
- do jTileStart=1,20401,ny
- jTileEnd = jTileStart + ny - 1
- do iTileStart=1,42001,nx
- iTileEnd = iTileStart + nx - 1
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'/soiltype_bot_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
-write(0,*) trim(fname)
-
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- iPoint = 1
- do j=1,ny
- do i=1,nx
- lat_pt = -89.99583 + (jTileStart + j - 2) * 0.0083333333
- lon_pt = -179.99583 + (iTileStart + i - 2) * 0.0083333333
- lat_pt = lat_pt * pii / 180.0
- lon_pt = lon_pt * pii / 180.0
-
- iPoint = nearest_cell(lat_pt, lon_pt, &
- iPoint, &
- grid % nCells, grid % maxEdges, grid % nEdgesOnCell % array, grid % cellsOnCell % array, &
- grid % latCell % array, grid % lonCell % array)
-
- ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
-
- end do
- end do
-
- end do
- end do
-
- do iCell=1, grid % nCells
- grid % soilcat_bot % array(iCell) = 1
- do i=2,16
- if (ncat(i,iCell) > ncat(grid % soilcat_bot % array(iCell),iCell)) then
- grid % soilcat_bot % array(iCell) = i
- end if
- end do
- end do
-
- deallocate(rarray)
- deallocate(ncat)
-
-
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! KLUDGE TO FIX SOIL TYPE OVER ANTARCTICA
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- where (grid % lu_index % array == 24) grid % soilcat_top % array = 16
- where (grid % lu_index % array == 24) grid % soilcat_bot % array = 16
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! CORRECT INCONSISTENT SOIL AND LAND USE DATA
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- do iCell = 1,grid % nCells
- if (grid % lu_index % array(iCell) == 16 .or. &
- grid % soilcat_top % array(iCell) == 14 .or. &
- grid % soilcat_bot % array(iCell) == 14) then
- if (grid % lu_index % array(iCell) /= 16) then
- write(0,*) 'Turning lu_index into water at ', iCell
- grid % lu_index % array(iCell) = 16
- end if
- if (grid % soilcat_top % array(iCell) /= 14) then
- write(0,*) 'Turning soilcat_top into water at ', iCell
- grid % soilcat_top % array(iCell) = 14
- end if
- if (grid % soilcat_bot % array(iCell) /= 14) then
- write(0,*) 'Turning soilcat_bot into water at ', iCell
- grid % soilcat_bot % array(iCell) = 14
- end if
- end if
- end do
-
-
- !
- ! Derive LANDMASK
- !
- grid % landmask % array(:) = 0
- do iCell=1, grid % nCells
- if (grid % lu_index % array(iCell) /= 16) grid % landmask % array(iCell) = 1
- end do
-
-
- !
- ! Interpolate SOILTEMP:
- !
- nx = 186
- ny = 186
- nzz = 1
- isigned = 0
- endian = 0
- wordsize = 2
- scalefactor = 0.01
- allocate(rarray(nx,ny,nzz))
- allocate(soiltemp_1deg(360,180))
- grid % soiltemp % array(:) = 0.0
-
- call map_set(PROJ_LATLON, proj, &
- latinc = 1.0_RKIND, &
- loninc = 1.0_RKIND, &
- knowni = 1.0_RKIND, &
- knownj = 1.0_RKIND, &
- lat1 = -89.5_RKIND, &
- lon1 = -179.5_RKIND)
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'soiltemp_1deg/',1,'-',180,'.',1,'-',180
-write(0,*) trim(fname)
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- soiltemp_1deg(1:180,1:180) = rarray(4:183,4:183,1)
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'soiltemp_1deg/',181,'-',360,'.',1,'-',180
-write(0,*) trim(fname)
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- soiltemp_1deg(181:360,1:180) = rarray(4:183,4:183,1)
-
- interp_list(1) = FOUR_POINT
- interp_list(2) = W_AVERAGE4
- interp_list(3) = W_AVERAGE16
- interp_list(4) = SEARCH
- interp_list(5) = 0
-
- do iCell=1,grid%nCells
-
- if (grid % landmask % array(iCell) == 1) then
- lat = grid % latCell % array(iCell)*DEG_PER_RAD
- lon = grid % lonCell % array(iCell)*DEG_PER_RAD
- call latlon_to_ij(proj, lat, lon, x, y)
- if (x < 0.5) then
- lon = lon + 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- else if (x >= 360.5) then
- lon = lon - 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- end if
-if (y < 1.0) y = 1.0
-if (y > 179.0) y = 179.0
-! grid % soiltemp % array(iCell) = interp_sequence(x, y, 1, soiltemp_1deg, 1, 360, 1, 180, 1, 1, -1.e30_RKIND, interp_list, 1)
- grid % soiltemp % array(iCell) = interp_sequence(x, y, 1, soiltemp_1deg, 1, 360, 1, 180, 1, 1, 0.0_RKIND, interp_list, 1)
- else
- grid % soiltemp % array(iCell) = 0.0
- end if
-
- end do
-
- deallocate(rarray)
- deallocate(soiltemp_1deg)
-
-
- !
- ! Interpolate SNOALB
- !
- nx = 186
- ny = 186
- nzz = 1
- isigned = 0
- endian = 0
- wordsize = 1
- scalefactor = 1.0
- allocate(rarray(nx,ny,nzz))
- allocate(maxsnowalb(360,180))
- grid % snoalb % array(:) = 0.0
-
- call map_set(PROJ_LATLON, proj, &
- latinc = 1.0_RKIND, &
- loninc = 1.0_RKIND, &
- knowni = 1.0_RKIND, &
- knownj = 1.0_RKIND, &
- lat1 = -89.5_RKIND, &
- lon1 = -179.5_RKIND)
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'maxsnowalb/',1,'-',180,'.',1,'-',180
-write(0,*) trim(fname)
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- maxsnowalb(1:180,1:180) = rarray(4:183,4:183,1)
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'maxsnowalb/',181,'-',360,'.',1,'-',180
-write(0,*) trim(fname)
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- maxsnowalb(181:360,1:180) = rarray(4:183,4:183,1)
-
- interp_list(1) = FOUR_POINT
- interp_list(2) = W_AVERAGE4
- interp_list(3) = W_AVERAGE16
- interp_list(4) = SEARCH
- interp_list(5) = 0
-
- do iCell=1,grid%nCells
-
- if (grid % landmask % array(iCell) == 1) then
- lat = grid % latCell % array(iCell)*DEG_PER_RAD
- lon = grid % lonCell % array(iCell)*DEG_PER_RAD
- call latlon_to_ij(proj, lat, lon, x, y)
- if (x < 0.5) then
- lon = lon + 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- else if (x >= 360.5) then
- lon = lon - 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- end if
-if (y < 1.0) y = 1.0
-if (y > 179.0) y = 179.0
-! grid % snoalb % array(iCell) = interp_sequence(x, y, 1, maxsnowalb, 1, 360, 1, 180, 1, 1, -1.e30_RKIND, interp_list, 1)
- grid % snoalb % array(iCell) = interp_sequence(x, y, 1, maxsnowalb, 1, 360, 1, 180, 1, 1, 0.0_RKIND, interp_list, 1)
- else
- grid % snoalb % array(iCell) = 0.0
- end if
-
- end do
-
- grid % snoalb % array(:) = grid % snoalb % array(:) / 100.0
-
- deallocate(rarray)
- deallocate(maxsnowalb)
-
-
- !
- ! Interpolate GREENFRAC
- !
- nx = 1256
- ny = 1256
- nzz = 12
- isigned = 0
- endian = 0
- wordsize = 1
- scalefactor = 1.0
- allocate(rarray(nx,ny,nzz))
- allocate(vegfra(2500,1250,12))
-! grid % vegfra % array(:) = 0.0
- grid % greenfrac % array(:,:) = 0.0
-
- call map_set(PROJ_LATLON, proj, &
- latinc = 0.144_RKIND, &
- loninc = 0.144_RKIND, &
- knowni = 1.0_RKIND, &
- knownj = 1.0_RKIND, &
- lat1 = -89.928_RKIND, &
- lon1 = -179.928_RKIND)
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'greenfrac/',1,'-',1250,'.',1,'-',1250
-write(0,*) trim(fname)
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- vegfra(1:1250,1:1250,1:12) = rarray(4:1253,4:1253,1:12)
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'greenfrac/',1251,'-',2500,'.',1,'-',1250
-write(0,*) trim(fname)
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- vegfra(1251:2500,1:1250,1:12) = rarray(4:1253,4:1253,1:12)
-
- do iCell=1,grid%nCells
- if (grid % landmask % array(iCell) == 1) then
- lat = grid % latCell % array(iCell)*DEG_PER_RAD
- lon = grid % lonCell % array(iCell)*DEG_PER_RAD
- call latlon_to_ij(proj, lat, lon, x, y)
- if (x < 0.5) then
- lon = lon + 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- else if (x >= 2500.5) then
- lon = lon - 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- end if
-if (y < 1.0) y = 1.0
-if (y > 1249.0) y = 1249.0
- do k=1,12
- grid % greenfrac % array(k,iCell) = interp_sequence(x, y, k, vegfra, 1, 2500, 1, 1250, 1, 12, -1.e30_RKIND, interp_list, 1)
- end do
- else
- grid % greenfrac % array(:,iCell) = 0.0
- end if
- grid % shdmin % array(iCell) = minval(grid % greenfrac % array(:,iCell))
- grid % shdmax % array(iCell) = maxval(grid % greenfrac % array(:,iCell))
-
- end do
-
- deallocate(rarray)
- deallocate(vegfra)
-
-
- !
- ! Interpolate ALBEDO12M
- !
- nx = 1256
- ny = 1256
- nzz = 12
- isigned = 0
- endian = 0
- wordsize = 1
- scalefactor = 1.0
- allocate(rarray(nx,ny,nzz))
- allocate(vegfra(2500,1250,12))
- grid % albedo12m % array(:,:) = 0.0
-
- call map_set(PROJ_LATLON, proj, &
- latinc = 0.144_RKIND, &
- loninc = 0.144_RKIND, &
- knowni = 1.0_RKIND, &
- knownj = 1.0_RKIND, &
- lat1 = -89.928_RKIND, &
- lon1 = -179.928_RKIND)
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'albedo_ncep/',1,'-',1250,'.',1,'-',1250
-write(0,*) trim(fname)
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- vegfra(1:1250,1:1250,1:12) = rarray(4:1253,4:1253,1:12)
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'albedo_ncep/',1251,'-',2500,'.',1,'-',1250
-write(0,*) trim(fname)
- call read_geogrid(fname, len_trim(fname), &
- rarray, &
- nx, ny, nzz, &
- isigned, endian, scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus, fname, dminfo)
-
- vegfra(1251:2500,1:1250,1:12) = rarray(4:1253,4:1253,1:12)
-
- do iCell=1,grid%nCells
- if (grid % landmask % array(iCell) == 1) then
- lat = grid % latCell % array(iCell)*DEG_PER_RAD
- lon = grid % lonCell % array(iCell)*DEG_PER_RAD
- call latlon_to_ij(proj, lat, lon, x, y)
- if (x < 0.5) then
- lon = lon + 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- else if (x >= 2500.5) then
- lon = lon - 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- end if
-if (y < 1.0) y = 1.0
-if (y > 1249.0) y = 1249.0
- do k=1,12
- grid % albedo12m % array(k,iCell) = interp_sequence(x, y, k, vegfra, 1, 2500, 1, 1250, 1, 12, 0.0_RKIND, interp_list, 1)
- end do
- else
- grid % albedo12m % array(:,iCell) = 8.0
- end if
- end do
-
- deallocate(rarray)
- deallocate(vegfra)
-
-
- end if ! config_static_interp
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! BEGIN ADOPT GFS TERRAIN HEIGHT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3120,22 +2503,27 @@
do iCell=1,grid%nCells
hs(iCell) = 0.
- do j = 1,nEdgesOnCell(iCell)
- hs(iCell) = hs(iCell) + dvEdge(edgesOnCell(j,iCell)) &
- / dcEdge(edgesOnCell(j,iCell)) &
- * (ter(cellsOnCell(j,iCell))-ter(iCell))
- end do
- hs(iCell) = ter(iCell) + 0.25*hs(iCell)
+ if(ter(iCell) .ne. 0.) then
+ do j = 1,nEdgesOnCell(iCell)
+ hs(iCell) = hs(iCell) + dvEdge(edgesOnCell(j,iCell)) &
+ / dcEdge(edgesOnCell(j,iCell)) &
+ * (ter(cellsOnCell(j,iCell))-ter(iCell))
+ end do
+ endif
+ hs(iCell) = ter(iCell) + 0.125*hs(iCell)
end do
do iCell=1,grid %nCells
ter(iCell) = 0.
- do j = 1,nEdgesOnCell(iCell)
- ter(iCell) = ter(iCell) + dvEdge(edgesOnCell(j,iCell)) &
- / dcEdge(edgesOnCell(j,iCell)) &
- * (hs(cellsOnCell(j,iCell))-hs(iCell))
- end do
- ter(iCell) = hs(iCell) - 0.25*ter(iCell)
+ if(hs(iCell) .ne. 0.) then
+ do j = 1,nEdgesOnCell(iCell)
+ ter(iCell) = ter(iCell) + dvEdge(edgesOnCell(j,iCell)) &
+ / dcEdge(edgesOnCell(j,iCell)) &
+ * (hs(cellsOnCell(j,iCell))-hs(iCell))
+ end do
+ endif
+! ter(iCell) = hs(iCell) - 0.25*ter(iCell)
+ ter(iCell) = hs(iCell) - 0.125*ter(iCell)
end do
! note that ther variable ter used throughout this section is a pointer to grid % ter % array, here we are passing ter's parent field
@@ -3147,7 +2535,9 @@
hx(:,iCell) = ter(iCell)
end do
- hm = maxval(ter(:))
+ hm = maxval(ter(1:nCellsSolve))
+ call mpas_dmpar_max_real(dminfo, hm, hm_global)
+ hm = hm_global
write(0,*) "max ter = ", hm
! Metrics for hybrid coordinate and vertical stretching
@@ -3243,7 +2633,7 @@
if (smooth) then
- dzmin = 0.3
+ dzmin = 0.5
do k=2,kz-1
hx(k,:) = hx(k-1,:)
@@ -3251,9 +2641,9 @@
! dzmin = max(0.5_RKIND,1.-.5*zw(k)/hm)
- sm = .05*min(0.5_RKIND*zw(k)/hm,1.0_RKIND)
+ sm = .02*min(0.5_RKIND*zw(k)/hm,1.0_RKIND)
- do i=1,50
+ do i=1,30
do iCell=1,grid % nCells
hs1(iCell) = 0.
do j = 1,nEdgesOnCell(iCell)
@@ -3287,7 +2677,7 @@
call mpas_dmpar_exch_halo_field(tempField)
! dzmina = minval(hs(:)-hx(k-1,:))
- dzmina = minval(zw(k)+ah(k)*hs(1:grid%nCellsSolve)-zw(k-1)-ah(k-1)*hx(k-1,1:grid%nCellsSolve))
+ dzmina = minval(zw(k)+ah(k)*hs(1:nCellsSolve)-zw(k-1)-ah(k-1)*hx(k-1,1:nCellsSolve))
call mpas_dmpar_min_real(dminfo, dzmina, dzmina_global)
! write(0,*) ' k,i, dzmina, dzmin, zw(k)-zw(k-1) ', k,i, dzmina, dzmin, zw(k)-zw(k-1)
if (dzmina_global >= dzmin*(zw(k)-zw(k-1))) then
@@ -3428,7 +2818,7 @@
do while (istatus == 0)
if (index(field % field, 'LANDSEA') /= 0) then
- allocate(maskslab(-3:field % nx+3, field % ny))
+ allocate(maskslab(-2:field % nx+3, field % ny))
maskslab(1:field % nx, 1:field % ny) = field % slab(1:field % nx, 1:field % ny)
maskslab(0, 1:field % ny) = field % slab(field % nx, 1:field % ny)
maskslab(-1, 1:field % ny) = field % slab(field % nx-1, 1:field % ny)
@@ -3849,7 +3239,8 @@
else if (index(field % field, 'SEAICE') /= 0) then
write(0,*) 'Interpolating SEAICE'
- interp_list(1) = SIXTEEN_POINT
+ !interp_list(1) = SIXTEEN_POINT
+ interp_list(1) = FOUR_POINT
interp_list(2) = FOUR_POINT
interp_list(3) = W_AVERAGE4
interp_list(4) = SEARCH
@@ -3873,7 +3264,7 @@
ndims = 1
end if
- allocate(rslab(-3:field % nx+3, field % ny))
+ allocate(rslab(-2:field % nx+3, field % ny))
rslab(1:field % nx, 1:field % ny) = field % slab(1:field % nx, 1:field % ny)
rslab(0, 1:field % ny) = field % slab(field % nx, 1:field % ny)
rslab(-1, 1:field % ny) = field % slab(field % nx-1, 1:field % ny)
@@ -3892,9 +3283,9 @@
call latlon_to_ij(proj, lat, lon, x, y)
end if
if (ndims == 1) then
- destField1d(i) = interp_sequence(x, y, 1, rslab, -3, field % nx + 3, 1, field % ny, 1, 1, msgval, interp_list, 1, maskval=maskval, mask_array=maskslab)
+ destField1d(i) = interp_sequence(x, y, 1, rslab, -2, field % nx + 3, 1, field % ny, 1, 1, msgval, interp_list, 1, maskval=maskval, mask_array=maskslab)
else if (ndims == 2) then
- destField2d(k,i) = interp_sequence(x, y, 1, rslab, -3, field % nx + 3, 1, field % ny, 1, 1, msgval, interp_list, 1, maskval=maskval, mask_array=maskslab)
+ destField2d(k,i) = interp_sequence(x, y, 1, rslab, -2, field % nx + 3, 1, field % ny, 1, 1, msgval, interp_list, 1, maskval=maskval, mask_array=maskslab)
end if
else
if (ndims == 1) then
@@ -4050,28 +3441,17 @@
! Freeze really cold ocean
where (fg % sst % array < 271.0 .and. grid % landmask % array == 0) fg % xice % array = 1.0
+ ! Limit XICE to values between 0 and 1. Although the input meteorological field is between 0.
+ ! and 1., interpolation to the MPAS grid can yield values of XiCE less than 0. and greater
+ ! than 1.:
+ where (fg % xice % array < 0._RKIND) fg % xice % array = 0._RKIND
+ where (fg % xice % array > 1._RKIND) fg % xice % array = 1._RKIND
+
! Set SEAICE (0/1 flag) based on XICE (fractional ice coverage)
fg % seaice % array(:) = 0.0
where (fg % xice % array >= 0.5) fg % seaice % array = 1.0
- !
- ! For now, hard-wire soil layer depths and thicknesses
- !
-
- !LDF begin:
- !fg % dzs % array(1,:) = 0.10
- !fg % dzs % array(2,:) = 0.30
- !fg % dzs % array(3,:) = 0.60
- !fg % dzs % array(4,:) = 1.00
-
- !fg % dz % array(1,:) = 0.05
- !fg % dz % array(2,:) = 0.25
- !fg % dz % array(3,:) = 0.70
- !fg % dz % array(4,:) = 1.50
- !LDF end.
-
-
!
! Compute normal wind component and store in fg%u
!
@@ -4101,7 +3481,9 @@
call mpas_quicksort(config_nfglevels, sorted_arr)
do k=1,grid%nVertLevels
target_z = 0.5 * (grid % zgrid % array(k,iCell) + grid % zgrid % array(k+1,iCell))
- state % theta_m % array(k,iCell) = vertical_interp(target_z, config_nfglevels, sorted_arr, order=1, extrap=1)
+! state % theta_m % array(k,iCell) = vertical_interp(target_z, config_nfglevels, sorted_arr, order=1, extrap=1)
+ state % theta_m % array(k,iCell) = vertical_interp(target_z, config_nfglevels-1, &
+ sorted_arr(:,1:config_nfglevels-1), order=1, extrap=1)
end do
@@ -4116,7 +3498,10 @@
call mpas_quicksort(config_nfglevels, sorted_arr)
do k=1,grid%nVertLevels
target_z = 0.5 * (grid % zgrid % array(k,iCell) + grid % zgrid % array(k+1,iCell))
- state % scalars % array(state % index_qv,k,iCell) = vertical_interp(target_z, config_nfglevels, sorted_arr, order=1, extrap=0)
+! state % scalars % array(state % index_qv,k,iCell) = vertical_interp(target_z, config_nfglevels, sorted_arr, order=1, extrap=0)
+ state % scalars % array(state % index_qv,k,iCell) = vertical_interp(target_z, config_nfglevels-1, &
+ sorted_arr(:,1:config_nfglevels-1), order=1, extrap=1)
+ diag % rh % array(k,iCell) = state % scalars % array(state % index_qv,k,iCell)
end do
@@ -4131,7 +3516,9 @@
call mpas_quicksort(config_nfglevels, sorted_arr)
do k=1,grid%nVertLevels
target_z = 0.5 * (grid % zgrid % array(k,iCell) + grid % zgrid % array(k+1,iCell))
- fg % gfs_z % array(k,iCell) = vertical_interp(target_z, config_nfglevels, sorted_arr, order=1, extrap=1)
+! fg % gfs_z % array(k,iCell) = vertical_interp(target_z, config_nfglevels, sorted_arr, order=1, extrap=1)
+ fg % gfs_z % array(k,iCell) = vertical_interp(target_z, config_nfglevels-1, &
+ sorted_arr(:,1:config_nfglevels-1), order=1, extrap=1)
end do
@@ -4149,7 +3536,9 @@
call mpas_quicksort(config_nfglevels, sorted_arr)
do k=1,grid%nVertLevels
target_z = 0.5 * (grid % zgrid % array(k,iCell) + grid % zgrid % array(k+1,iCell))
- diag % pressure % array(k,iCell) = exp(vertical_interp(target_z, config_nfglevels, sorted_arr, order=1, extrap=1))
+! diag % pressure % array(k,iCell) = exp(vertical_interp(target_z, config_nfglevels, sorted_arr, order=1, extrap=1))
+ diag % pressure % array(k,iCell) = exp(vertical_interp(target_z, config_nfglevels-1, &
+ sorted_arr(:,1:config_nfglevels-1), order=1, extrap=1))
end do
@@ -4186,7 +3575,9 @@
call mpas_quicksort(config_nfglevels, sorted_arr)
do k=1,grid%nVertLevels
target_z = 0.25 * (grid % zgrid % array(k,cellsOnEdge(1,iEdge)) + grid % zgrid % array(k+1,cellsOnEdge(1,iEdge)) + grid % zgrid % array(k,cellsOnEdge(2,iEdge)) + grid % zgrid % array(k+1,cellsOnEdge(2,iEdge)))
- state % u % array(k,iEdge) = vertical_interp(target_z, config_nfglevels, sorted_arr, order=1, extrap=0)
+! state % u % array(k,iEdge) = vertical_interp(target_z, config_nfglevels, sorted_arr, order=1, extrap=0)
+ state % u % array(k,iEdge) = vertical_interp(target_z, config_nfglevels-1, &
+ sorted_arr(:,1:config_nfglevels-1), order=1, extrap=1)
end do
end do
@@ -4243,8 +3634,8 @@
! QV
es = 6.112 * exp((17.27*(state % theta_m % array(k,iCell) - 273.16))/(state % theta_m % array(k,iCell) - 35.86))
- rs = 0.622 * es / (diag % pressure % array(k,iCell) - es)
- scalars(state % index_qv,k,iCell) = rs * scalars(state % index_qv,k,iCell)
+ rs = 0.622 * es * 100. / (diag % pressure % array(k,iCell) - es * 100.)
+ scalars(state % index_qv,k,iCell) = 0.01 * rs * scalars(state % index_qv,k,iCell)
! PI
p(k,iCell) = (diag % pressure % array(k,iCell) / p0) ** (rgas / cp)
@@ -4261,6 +3652,17 @@
!
+ ! Calculation of the initial precipitable water:
+ !
+ do iCell = 1,grid%nCells
+ diag_physics%precipw%array(iCell) = 0.0
+ do k = 1,grid%nVertLevels
+ diag_physics%precipw%array(iCell) = diag_physics%precipw%array(iCell) &
+ + rho_zz(k,iCell)*scalars(state%index_qv,k,iCell)*(zgrid(k+1,iCell)-zgrid(k,iCell))
+ enddo
+ enddo
+
+ !
! Reference state based on a dry isothermal atmosphere
!
do iCell=1,grid % nCells
@@ -4387,242 +3789,6 @@
end subroutine init_atm_test_case_gfs
- subroutine init_atm_test_case_sfc(domain, dminfo, grid, fg, state, diag, test_case, parinfo)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Real-data test case using SST data
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- use mpas_dmpar
- use mpas_io_output
- use init_atm_read_met
- use init_atm_llxy
- use init_atm_hinterp
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
- type (dm_info), intent(in) :: dminfo
- type (mesh_type), intent(inout) :: grid
- type (fg_type), intent(inout) :: fg
- type (state_type), intent(inout) :: state
- type (diag_type), intent(inout) :: diag
- integer, intent(in) :: test_case
- type (parallel_info), pointer :: parinfo
-
- integer :: istatus
- integer :: iCell, i, j
- type (met_data) :: field
- type (proj_info) :: proj
- real (kind=RKIND) :: lat, lon, x, y
- integer, dimension(5) :: interp_list
- real (kind=RKIND), allocatable, dimension(:,:) :: slab_r8
- type (io_output_object) :: sfc_update_obj
- type (MPAS_Clock_type) :: fg_clock
- type (MPAS_Time_type) :: start_time, stop_time, curr_time
- type (MPAS_TimeInterval_type) :: fg_interval
- character (len=StrKIND) :: timeString
-
-
- ! Set interpolation sequence to be used for SST/SKINTEMP field
- interp_list(1) = FOUR_POINT
- interp_list(2) = SEARCH
- interp_list(3) = 0
-
-
- ! Set up clock to step through all intermediate file dates to be processed
- call mpas_set_time(start_time, dateTimeString=trim(config_start_time))
- call mpas_set_time(stop_time, dateTimeString=trim(config_stop_time))
- call mpas_set_timeInterval(fg_interval, S=config_fg_interval)
-
- call mpas_create_clock(fg_clock, start_time, fg_interval, stopTime=stop_time)
-
-
- ! Initialize the output file
- sfc_update_obj % time = 1
- sfc_update_obj % filename = trim(config_sfc_update_name)
-
- call mpas_output_state_init(sfc_update_obj, domain, "SFC")
-
- ! Loop over all times, interpolating the SST/SKINTEMP field from each intermediate file
- curr_time = mpas_get_clock_time(fg_clock, MPAS_NOW)
- do while (curr_time <= stop_time)
- call mpas_get_time(curr_time, dateTimeString=timeString)
- write(0,*) 'Processing ',trim(config_sfc_prefix)//':'//timeString(1:13)
-
- ! Open intermediate file
- call read_met_init(trim(config_sfc_prefix), .false., timeString(1:13), istatus)
- if (istatus /= 0) then
- write(0,*) 'Error reading ',trim(config_sfc_prefix)//':'//timeString(1:13)
- exit
- end if
-
- ! Scan through all fields in the file, looking for the SST or SKINTEMP field
- call read_next_met_field(field, istatus)
- do while (istatus == 0)
-
- !initialization of sea-surface temperature (SST) and sea-ice fraction (XICE) arrays,
- !prior to reading the input data:
- fg % sst % array (1:grid%nCells) = 0.0
- fg % xice % array (1:grid%nCells) = 0.0
-
- if (index(field % field, 'SKINTEMP') /= 0 .or. index(field % field, 'SST') /= 0) then
-
- ! Interpolation routines use real(kind=RKIND), so copy from default real array
- allocate(slab_r8(field % nx, field % ny))
- do j=1,field % ny
- do i=1,field % nx
- slab_r8(i,j) = field % slab(i,j)
- end do
- end do
-
- !
- ! Set up map projection
- !
- call map_init(proj)
-
- if (field % iproj == PROJ_LATLON) then
- call map_set(PROJ_LATLON, proj, &
- latinc = real(field % deltalat,RKIND), &
- loninc = real(field % deltalon,RKIND), &
- knowni = 1.0_RKIND, &
- knownj = 1.0_RKIND, &
- lat1 = real(field % startlat,RKIND), &
- lon1 = real(field % startlon,RKIND))
- else if (field % iproj == PROJ_GAUSS) then
- call map_set(PROJ_GAUSS, proj, &
- nlat = nint(field % deltalat), &
- loninc = real(field % deltalon,RKIND), &
- lat1 = real(field % startlat,RKIND), &
- lon1 = real(field % startlon,RKIND))
-! nxmax = nint(360.0 / field % deltalon), &
- else if (field % iproj == PROJ_PS) then
- call map_set(PROJ_PS, proj, &
- dx = real(field % dx,RKIND), &
- truelat1 = real(field % truelat1,RKIND), &
- stdlon = real(field % xlonc,RKIND), &
- knowni = real(field % nx / 2.0,RKIND), &
- knownj = real(field % ny / 2.0,RKIND), &
- lat1 = real(field % startlat,RKIND), &
- lon1 = real(field % startlon,RKIND))
- end if
-
- ! Interpolate SST/SKINTEMP field to each MPAS grid cell
- do iCell=1,grid % nCells
- lat = grid % latCell % array(iCell) * DEG_PER_RAD
- lon = grid % lonCell % array(iCell) * DEG_PER_RAD
- call latlon_to_ij(proj, lat, lon, x, y)
- if (y < 0.5) then
- y = 1.0
- else if (y >= real(field%ny)+0.5) then
- y = real(field % ny)
- end if
- if (x < 0.5) then
- lon = lon + 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- else if (x >= real(field%nx)+0.5) then
- lon = lon - 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- end if
- fg % sst % array(iCell) = interp_sequence(x, y, 1, slab_r8, 1, field % nx, 1, field % ny, 1, 1, -1.e30_RKIND, interp_list, 1)
- end do
-
- deallocate(slab_r8)
- deallocate(field % slab)
-
- else if (index(field % field, 'SEAICE') /= 0) then
-
- ! Interpolation routines use real(kind=RKIND), so copy from default real array
- allocate(slab_r8(field % nx, field % ny))
- do j=1,field % ny
- do i=1,field % nx
- slab_r8(i,j) = field % slab(i,j)
- end do
- end do
-
- !
- ! Set up map projection
- !
- call map_init(proj)
-
- if (field % iproj == PROJ_LATLON) then
- call map_set(PROJ_LATLON, proj, &
- latinc = real(field % deltalat,RKIND), &
- loninc = real(field % deltalon,RKIND), &
- knowni = 1.0_RKIND, &
- knownj = 1.0_RKIND, &
- lat1 = real(field % startlat,RKIND), &
- lon1 = real(field % startlon,RKIND))
- else if (field % iproj == PROJ_GAUSS) then
- call map_set(PROJ_GAUSS, proj, &
- nlat = nint(field % deltalat), &
- loninc = real(field % deltalon,RKIND), &
- lat1 = real(field % startlat,RKIND), &
- lon1 = real(field % startlon,RKIND))
-! nxmax = nint(360.0 / field % deltalon), &
- else if (field % iproj == PROJ_PS) then
- call map_set(PROJ_PS, proj, &
- dx = real(field % dx,RKIND), &
- truelat1 = real(field % truelat1,RKIND), &
- stdlon = real(field % xlonc,RKIND), &
- knowni = real(field % nx / 2.0,RKIND), &
- knownj = real(field % ny / 2.0,RKIND), &
- lat1 = real(field % startlat,RKIND), &
- lon1 = real(field % startlon,RKIND))
- end if
-
- ! Interpolate SEAICE/SKINTEMP field to each MPAS grid cell
- do iCell=1,grid % nCells
- lat = grid % latCell % array(iCell) * DEG_PER_RAD
- lon = grid % lonCell % array(iCell) * DEG_PER_RAD
- call latlon_to_ij(proj, lat, lon, x, y)
- if (y < 0.5) then
- y = 1.0
- else if (y >= real(field%ny)+0.5) then
- y = real(field % ny)
- end if
- if (x < 0.5) then
- lon = lon + 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- else if (x >= real(field%nx)+0.5) then
- lon = lon - 360.0
- call latlon_to_ij(proj, lat, lon, x, y)
- end if
- fg % xice % array(iCell) = interp_sequence(x, y, 1, slab_r8, 1, field % nx, 1, field % ny, 1, 1, -1.e30_RKIND, interp_list, 1)
- if (fg % xice % array(iCell) == -1.e30_RKIND) fg % xice % array(iCell) = 0.0_RKIND
-
- end do
-
- deallocate(slab_r8)
- deallocate(field % slab)
-
- else
-
- deallocate(field % slab)
- end if
-
- call read_next_met_field(field, istatus)
- end do
-
- ! Close intermediate file
- call read_met_close()
-
- ! Write the interpolated SST/SKINTEMP field as a new time slice in the MPAS output file
- call mpas_output_state_for_domain(sfc_update_obj, domain, sfc_update_obj % time)
- sfc_update_obj % time = sfc_update_obj % time + 1
-
- call mpas_advance_clock(fg_clock)
- curr_time = mpas_get_clock_time(fg_clock, MPAS_NOW)
-
- call mpas_get_time(curr_time, dateTimeString=timeString)
- state % xtime % scalar = timeString
-
- end do
-
- call mpas_output_state_finalize(sfc_update_obj, dminfo)
-
- end subroutine init_atm_test_case_sfc
-
-
!--------------------- TEST CASE 9 -----------------------------------------------
@@ -6200,48 +5366,6 @@
end subroutine init_atm_test_case_resting_atmosphere
- integer function nearest_cell(target_lat, target_lon, &
- start_cell, &
- nCells, maxEdges, nEdgesOnCell, cellsOnCell, latCell, lonCell)
-
- implicit none
-
- real (kind=RKIND), intent(in) :: target_lat, target_lon
- integer, intent(in) :: start_cell
- integer, intent(in) :: nCells, maxEdges
- integer, dimension(nCells), intent(in) :: nEdgesOnCell
- integer, dimension(maxEdges,nCells), intent(in) :: cellsOnCell
- real (kind=RKIND), dimension(nCells), intent(in) :: latCell, lonCell
-
- integer :: i
- integer :: iCell
- integer :: current_cell
- real (kind=RKIND) :: current_distance, d
- real (kind=RKIND) :: nearest_distance
-
- nearest_cell = start_cell
- current_cell = -1
-
- do while (nearest_cell /= current_cell)
- current_cell = nearest_cell
- current_distance = sphere_distance(latCell(current_cell), lonCell(current_cell), target_lat, target_lon, 1.0_RKIND)
- nearest_cell = current_cell
- nearest_distance = current_distance
- do i = 1, nEdgesOnCell(current_cell)
- iCell = cellsOnCell(i,current_cell)
- if (iCell <= nCells) then
- d = sphere_distance(latCell(iCell), lonCell(iCell), target_lat, target_lon, 1.0_RKIND)
- if (d < nearest_distance) then
- nearest_cell = iCell
- nearest_distance = d
- end if
- end if
- end do
- end do
-
- end function nearest_cell
-
-
integer function nearest_edge(target_lat, target_lon, &
start_edge, &
nCells, nEdges, maxEdges, nEdgesOnCell, edgesOnCell, cellsOnEdge, latCell, lonCell, latEdge, lonEdge)
@@ -6325,7 +5449,7 @@
if (present(extrap)) then
extrap_type = extrap
else
- interp_order = 1
+ extrap_type = 1
end if
if (present(surface_val)) then
@@ -6383,44 +5507,8 @@
end function vertical_interp
- subroutine init_atm_check_read_error(istatus, fname, dminfo)
-
- implicit none
-
- integer, intent(in) :: istatus
- character (len=*), intent(in) :: fname
- type (dm_info), intent(in) :: dminfo
-
- if (istatus /= 0) then
- write(0,*) 'ERROR: Could not read file '//trim(fname)
- call mpas_dmpar_abort(dminfo)
- end if
-
- end subroutine init_atm_check_read_error
-
-
!----------------------------------------------------------------------------------------------------------
- real (kind=RKIND) function sphere_distance(lat1, lon1, lat2, lon2, radius)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
- ! sphere with given radius.
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
-
- real (kind=RKIND) :: arg1
-
- arg1 = sqrt( sin(0.5*(lat2-lat1))**2 + &
- cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
- sphere_distance = 2.*radius*asin(arg1)
-
- end function sphere_distance
-
-!--------------------------------------------------------------------
-
real (kind=RKIND) function env_qv( z, temperature, pressure, rh_max )
implicit none
Modified: branches/mpas_cdg_advection/src/core_nhyd_atmos/Makefile
===================================================================
--- branches/mpas_cdg_advection/src/core_nhyd_atmos/Makefile 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_nhyd_atmos/Makefile 2013-04-22 01:31:32 UTC (rev 2783)
@@ -5,7 +5,8 @@
OBJS = mpas_atm_mpas_core.o \
mpas_atm_time_integration.o \
- mpas_atm_advection.o
+ mpas_atm_advection.o \
+ mpas_atm_interp_diagnostics.o
all: physcore core_hyd
@@ -22,7 +23,7 @@
mpas_atm_advection.o:
-mpas_atm_mpas_core.o: mpas_atm_advection.o mpas_atm_time_integration.o
+mpas_atm_mpas_core.o: mpas_atm_advection.o mpas_atm_time_integration.o mpas_atm_interp_diagnostics.o
clean:
( cd ../core_atmos_physics; make clean )
Deleted: branches/mpas_cdg_advection/src/core_nhyd_atmos/Registry
===================================================================
--- branches/mpas_cdg_advection/src/core_nhyd_atmos/Registry 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_nhyd_atmos/Registry 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,877 +0,0 @@
-%
-% namelist type namelist_record name default_value
-%
-namelist character nhyd_model config_time_integration SRK3
-namelist real nhyd_model config_dt 600.0
-namelist character nhyd_model config_calendar_type gregorian
-namelist character nhyd_model config_start_time 0000-01-01_00:00:00
-namelist character nhyd_model config_stop_time none
-namelist character nhyd_model config_run_duration none
-namelist character nhyd_model config_sfc_update_interval none
-namelist character nhyd_model config_horiz_mixing 2d_smagorinsky
-namelist real nhyd_model config_h_mom_eddy_visc2 0.0
-namelist real nhyd_model config_h_mom_eddy_visc4 0.0
-namelist real nhyd_model config_v_mom_eddy_visc2 0.0
-namelist real nhyd_model config_h_theta_eddy_visc2 0.0
-namelist real nhyd_model config_h_theta_eddy_visc4 0.0
-namelist real nhyd_model config_v_theta_eddy_visc2 0.0
-namelist integer nhyd_model config_number_of_sub_steps 4
-namelist integer nhyd_model config_w_adv_order 3
-namelist integer nhyd_model config_theta_adv_order 3
-namelist integer nhyd_model config_scalar_adv_order 3
-namelist integer nhyd_model config_u_vadv_order 3
-namelist integer nhyd_model config_w_vadv_order 3
-namelist integer nhyd_model config_theta_vadv_order 3
-namelist integer nhyd_model config_scalar_vadv_order 3
-namelist real nhyd_model config_coef_3rd_order 0.25
-namelist logical nhyd_model config_scalar_advection true
-namelist logical nhyd_model config_positive_definite false
-namelist logical nhyd_model config_monotonic true
-namelist logical nhyd_model config_mix_full true
-namelist real nhyd_model config_len_disp 120000.0
-namelist real nhyd_model config_epssm 0.1
-namelist real nhyd_model config_smdiv 0.1
-namelist logical nhyd_model config_newpx false
-namelist real nhyd_model config_apvm_upwinding 0.5
-namelist logical nhyd_model config_h_ScaleWithMesh false
-namelist integer nhyd_model config_num_halos 2
-namelist real damping config_zd 22000.0
-namelist real damping config_xnutr 0.0
-namelist character io config_input_name init.nc
-namelist character io config_sfc_update_name sfc_update.nc
-namelist character io config_output_name output.nc
-namelist character io config_restart_name restart.nc
-namelist character io config_output_interval 06:00:00
-namelist integer io config_frames_per_outfile 0
-namelist integer io config_pio_num_iotasks 0
-namelist integer io config_pio_stride 1
-namelist character decomposition config_block_decomp_file_prefix graph.info.part.
-namelist integer decomposition config_number_of_blocks 0
-namelist logical decomposition config_explicit_proc_decomp .false.
-namelist character decomposition config_proc_decomp_file_prefix graph.info.part.
-namelist logical restart config_do_restart false
-namelist logical restart config_do_DAcycling false
-namelist character restart config_restart_interval none
-
-%
-% dim type name_in_file name_in_code
-%
-dim nCells nCells
-dim nEdges nEdges
-dim maxEdges maxEdges
-dim maxEdges2 maxEdges2
-dim nVertices nVertices
-dim TWO 2
-dim THREE 3
-dim vertexDegree vertexDegree
-dim FIFTEEN 15
-dim TWENTYONE 21
-dim R3 3
-dim nVertLevels nVertLevels
-dim nVertLevelsP1 nVertLevels+1
-
-%
-% var type name_in_file ( dims ) iro- name_in_code super-array array_class
-%
-var persistent text xtime ( Time ) 2 iro xtime state - -
-
-% horizontal grid structure
-
-var persistent real latCell ( nCells ) 0 iro latCell mesh - -
-var persistent real lonCell ( nCells ) 0 iro lonCell mesh - -
-var persistent real xCell ( nCells ) 0 iro xCell mesh - -
-var persistent real yCell ( nCells ) 0 iro yCell mesh - -
-var persistent real zCell ( nCells ) 0 iro zCell mesh - -
-var persistent integer indexToCellID ( nCells ) 0 iro indexToCellID mesh - -
-
-var persistent real latEdge ( nEdges ) 0 iro latEdge mesh - -
-var persistent real lonEdge ( nEdges ) 0 iro lonEdge mesh - -
-var persistent real xEdge ( nEdges ) 0 iro xEdge mesh - -
-var persistent real yEdge ( nEdges ) 0 iro yEdge mesh - -
-var persistent real zEdge ( nEdges ) 0 iro zEdge mesh - -
-var persistent integer indexToEdgeID ( nEdges ) 0 iro indexToEdgeID mesh - -
-
-var persistent real latVertex ( nVertices ) 0 iro latVertex mesh - -
-var persistent real lonVertex ( nVertices ) 0 iro lonVertex mesh - -
-var persistent real xVertex ( nVertices ) 0 iro xVertex mesh - -
-var persistent real yVertex ( nVertices ) 0 iro yVertex mesh - -
-var persistent real zVertex ( nVertices ) 0 iro zVertex mesh - -
-var persistent integer indexToVertexID ( nVertices ) 0 iro indexToVertexID mesh - -
-
-var persistent integer cellsOnEdge ( TWO nEdges ) 0 iro cellsOnEdge mesh - -
-var persistent integer nEdgesOnCell ( nCells ) 0 iro nEdgesOnCell mesh - -
-var persistent integer nEdgesOnEdge ( nEdges ) 0 iro nEdgesOnEdge mesh - -
-var persistent integer edgesOnCell ( maxEdges nCells ) 0 iro edgesOnCell mesh - -
-var persistent integer edgesOnEdge ( maxEdges2 nEdges ) 0 iro edgesOnEdge mesh - -
-
-var persistent real weightsOnEdge ( maxEdges2 nEdges ) 0 iro weightsOnEdge mesh - -
-var persistent real dvEdge ( nEdges ) 0 iro dvEdge mesh - -
-var persistent real dcEdge ( nEdges ) 0 iro dcEdge mesh - -
-var persistent real angleEdge ( nEdges ) 0 iro angleEdge mesh - -
-var persistent real areaCell ( nCells ) 0 iro areaCell mesh - -
-var persistent real areaTriangle ( nVertices ) 0 iro areaTriangle mesh - -
-
-var persistent real edgeNormalVectors ( R3 nEdges ) 0 iro edgeNormalVectors mesh - -
-var persistent real localVerticalUnitVectors ( R3 nCells ) 0 iro localVerticalUnitVectors mesh - -
-var persistent real cellTangentPlane ( R3 TWO nCells ) 0 iro cellTangentPlane mesh - -
-
-var persistent integer cellsOnCell ( maxEdges nCells ) 0 iro cellsOnCell mesh - -
-var persistent integer verticesOnCell ( maxEdges nCells ) 0 iro verticesOnCell mesh - -
-var persistent integer verticesOnEdge ( TWO nEdges ) 0 iro verticesOnEdge mesh - -
-var persistent integer edgesOnVertex ( vertexDegree nVertices ) 0 iro edgesOnVertex mesh - -
-var persistent integer cellsOnVertex ( vertexDegree nVertices ) 0 iro cellsOnVertex mesh - -
-var persistent real kiteAreasOnVertex ( vertexDegree nVertices ) 0 iro kiteAreasOnVertex mesh - -
-var persistent real fEdge ( nEdges ) 0 iro fEdge mesh - -
-var persistent real fVertex ( nVertices ) 0 iro fVertex mesh - -
-
-var persistent real meshDensity ( nCells ) 0 iro meshDensity mesh - -
-var persistent real meshScalingDel2 ( nEdges ) 0 ro meshScalingDel2 mesh - -
-var persistent real meshScalingDel4 ( nEdges ) 0 ro meshScalingDel4 mesh - -
-
-% some solver scalar coefficients
-
-% coefficients for vertical extrapolation to the surface
-var persistent real cf1 ( ) 0 iro cf1 mesh - -
-var persistent real cf2 ( ) 0 iro cf2 mesh - -
-var persistent real cf3 ( ) 0 iro cf3 mesh - -
-
-var persistent real cpr ( THREE nEdges ) 0 ro cpr mesh - -
-var persistent real cpl ( THREE nEdges ) 0 ro cpl mesh - -
-
-% description of the vertical grid structure
-
-var persistent real hx ( nVertLevelsP1 nCells ) 0 iro hx mesh - -
-var persistent real zgrid ( nVertLevelsP1 nCells ) 0 iro zgrid mesh - -
-var persistent real rdzw ( nVertLevels ) 0 iro rdzw mesh - -
-var persistent real dzu ( nVertLevels ) 0 iro dzu mesh - -
-var persistent real rdzu ( nVertLevels ) 0 iro rdzu mesh - -
-var persistent real fzm ( nVertLevels ) 0 iro fzm mesh - -
-var persistent real fzp ( nVertLevels ) 0 iro fzp mesh - -
-var persistent real zx ( nVertLevelsP1 nEdges ) 0 iro zx mesh - -
-var persistent real zz ( nVertLevelsP1 nCells ) 0 iro zz mesh - -
-var persistent real zb ( nVertLevelsP1 TWO nEdges ) 0 iro zb mesh - -
-var persistent real zb3 ( nVertLevelsP1 TWO nEdges ) 0 iro zb3 mesh - -
-var persistent real pzm ( nVertLevels nCells ) 0 r pzm mesh - -
-var persistent real pzp ( nVertLevels nCells ) 0 r pzp mesh - -
-
-% coefficients for the vertical tridiagonal solve
-% Note: these could be local but...
-
-var persistent real cofrz ( nVertLevels Time ) 1 - cofrz diag - -
-var persistent real cofwr ( nVertLevels nCells Time ) 1 - cofwr diag - -
-var persistent real cofwz ( nVertLevels nCells Time ) 1 - cofwz diag - -
-var persistent real coftz ( nVertLevelsP1 nCells Time ) 1 - coftz diag - -
-var persistent real cofwt ( nVertLevels nCells Time ) 1 - cofwt diag - -
-var persistent real a_tri ( nVertLevels nCells Time ) 1 - a_tri diag - -
-var persistent real alpha_tri ( nVertLevels nCells Time ) 1 - alpha_tri diag - -
-var persistent real gamma_tri ( nVertLevels nCells Time ) 1 - gamma_tri diag - -
-
-% W-Rayleigh-damping coefficient
-
-var persistent real dss ( nVertLevels nCells ) 0 iro dss mesh - -
-
-% Prognostic variables: read from input, saved in restart, and written to output
-var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
-var persistent real w ( nVertLevelsP1 nCells Time ) 2 iro w state - -
-var persistent real rho_zz ( nVertLevels nCells Time ) 2 r rho_zz state - -
-var persistent real theta_m ( nVertLevels nCells Time ) 2 r theta_m state - -
-var persistent real qv ( nVertLevels nCells Time ) 2 iro qv state scalars moist
-var persistent real qc ( nVertLevels nCells Time ) 2 iro qc state scalars moist
-var persistent real qr ( nVertLevels nCells Time ) 2 iro qr state scalars moist
-var persistent real qi ( nVertLevels nCells Time ) 2 iro qi state scalars moist
-var persistent real qs ( nVertLevels nCells Time ) 2 iro qs state scalars moist
-var persistent real qg ( nVertLevels nCells Time ) 2 iro qg state scalars moist
-var persistent real qnr ( nVertLevels nCells Time ) 2 iro qnr state scalars number
-var persistent real qni ( nVertLevels nCells Time ) 2 iro qni state scalars number
-
-% Tendency variables
-var persistent real tend_u ( nVertLevels nEdges Time ) 1 o u tend - -
-var persistent real tend_w ( nVertLevelsP1 nCells Time ) 1 o w tend - -
-var persistent real tend_rho ( nVertLevels nCells Time ) 1 o rho_zz tend - -
-var persistent real tend_theta ( nVertLevels nCells Time ) 1 o theta_m tend - -
-var persistent real tend_qv ( nVertLevels nCells Time ) 1 o qv tend scalars moist
-var persistent real tend_qc ( nVertLevels nCells Time ) 1 o qc tend scalars moist
-var persistent real tend_qr ( nVertLevels nCells Time ) 1 o qr tend scalars moist
-var persistent real tend_qi ( nVertLevels nCells Time ) 1 o qi tend scalars moist
-var persistent real tend_qs ( nVertLevels nCells Time ) 1 o qs tend scalars moist
-var persistent real tend_qg ( nVertLevels nCells Time ) 1 o qg tend scalars moist
-var persistent real tend_qnr ( nVertLevels nCells Time ) 1 o qnr tend scalars number
-var persistent real tend_qni ( nVertLevels nCells Time ) 1 o qni tend scalars number
-var persistent real rt_diabatic_tend ( nVertLevels nCells Time ) 1 r rt_diabatic_tend tend - -
-
-var persistent real euler_tend_u ( nVertLevels nEdges Time ) 1 - u_euler tend - -
-var persistent real euler_tend_w ( nVertLevelsP1 nCells Time ) 1 - w_euler tend - -
-var persistent real euler_tend_theta ( nVertLevels nCells Time ) 1 - theta_euler tend - -
-
-% state variables diagnosed from prognostic state
-var persistent real pressure_p ( nVertLevels nCells Time ) 1 ro pressure_p diag - -
-
-var persistent real u_init ( nVertLevels ) 0 iro u_init mesh - -
-var persistent real t_init ( nVertLevels nCells ) 0 iro t_init mesh - -
-var persistent real qv_init ( nVertLevels ) 0 iro qv_init mesh - -
-
-% Diagnostic fields: only written to output
-% NOTE: added the "r" option to rho,theta,uReconstructZonal,and uReconstructMeridional for use of the
-% non-hydrostatic dynamical core in a data assimilation framework. NOTE that the "r" option is not
-% needed for those 4 variables to get bit for bit restart capabilities, otherwise.
-var persistent real rho ( nVertLevels nCells Time ) 1 iro rho diag - -
-var persistent real theta ( nVertLevels nCells Time ) 1 iro theta diag - -
-var persistent real rh ( nVertLevels nCells Time ) 1 iro rh diag - -
-var persistent real v ( nVertLevels nEdges Time ) 1 o v diag - -
-var persistent real divergence ( nVertLevels nCells Time ) 1 o divergence diag - -
-var persistent real vorticity ( nVertLevels nVertices Time ) 1 o vorticity diag - -
-var persistent real pv_edge ( nVertLevels nEdges Time ) 1 o pv_edge diag - -
-var persistent real rho_edge ( nVertLevels nEdges Time ) 1 o rho_edge diag - -
-var persistent real ke ( nVertLevels nCells Time ) 1 o ke diag - -
-var persistent real pv_vertex ( nVertLevels nVertices Time ) 1 o pv_vertex diag - -
-var persistent real pv_cell ( nVertLevels nCells Time ) 1 o pv_cell diag - -
-var persistent real uReconstructX ( nVertLevels nCells Time ) 1 o uReconstructX diag - -
-var persistent real uReconstructY ( nVertLevels nCells Time ) 1 o uReconstructY diag - -
-var persistent real uReconstructZ ( nVertLevels nCells Time ) 1 o uReconstructZ diag - -
-var persistent real uReconstructZonal ( nVertLevels nCells Time ) 1 ro uReconstructZonal diag - -
-var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 1 ro uReconstructMeridional diag - -
-
-% Other diagnostic variables: neither read nor written to any files
-var persistent real rv ( nVertLevels nEdges Time ) 1 r rv diag - -
-var persistent real circulation ( nVertLevels nVertices Time ) 1 r circulation diag - -
-var persistent real gradPVt ( nVertLevels nEdges Time ) 1 - gradPVt diag - -
-var persistent real gradPVn ( nVertLevels nEdges Time ) 1 - gradPVn diag - -
-var persistent real h_divergence ( nVertLevels nCells Time ) 1 o h_divergence diag - -
-
-var persistent real exner ( nVertLevels nCells Time ) 1 ro exner diag - -
-var persistent real exner_base ( nVertLevels nCells Time ) 1 iro exner_base diag - -
-var persistent real rtheta_base ( nVertLevels nCells Time ) 1 r rtheta_base diag - -
-var persistent real pressure_base ( nVertLevels nCells Time ) 1 iro pressure_base diag - -
-var persistent real rho_base ( nVertLevels nCells Time ) 1 iro rho_base diag - -
-var persistent real theta_base ( nVertLevels nCells Time ) 1 iro theta_base diag - -
-
-
-var persistent real ruAvg ( nVertLevels nEdges Time ) 1 - ruAvg diag - -
-var persistent real wwAvg ( nVertLevelsP1 nCells Time ) 1 - wwAvg diag - -
-var persistent real cqu ( nVertLevels nEdges Time ) 1 - cqu diag - -
-var persistent real cqw ( nVertLevels nCells Time ) 1 - cqw diag - -
-
-% coupled variables needed by the solver, but not output...
-
-var persistent real ru ( nVertLevels nEdges Time ) 1 r ru diag - -
-var persistent real ru_p ( nVertLevels nEdges Time ) 1 r ru_p diag - -
-var persistent real ru_save ( nVertLevels nEdges Time ) 1 - ru_save diag - -
-
-
-var persistent real rw ( nVertLevelsP1 nCells Time ) 1 r rw diag - -
-var persistent real rw_p ( nVertLevelsP1 nCells Time ) 1 r rw_p diag - -
-var persistent real rw_save ( nVertLevelsP1 nCells Time ) 1 - rw_save diag - -
-
-var persistent real rtheta_p ( nVertLevels nCells Time ) 1 r rtheta_p diag - -
-var persistent real rtheta_pp ( nVertLevels nCells Time ) 1 - rtheta_pp diag - -
-var persistent real rtheta_p_save ( nVertLevels nCells Time ) 1 - rtheta_p_save diag - -
-var persistent real rtheta_pp_old ( nVertLevels nCells Time ) 1 - rtheta_pp_old diag - -
-
-var persistent real rho_p ( nVertLevels nCells Time ) 1 r rho_p diag - -
-var persistent real rho_pp ( nVertLevels nCells Time ) 1 - rho_pp diag - -
-var persistent real rho_p_save ( nVertLevels nCells Time ) 1 - rho_p_save diag - -
-
-% Space needed for advection
-var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 ir deriv_two mesh - -
-var persistent integer advCells ( TWENTYONE nCells ) 0 ir advCells mesh - -
-var persistent real adv_coefs ( FIFTEEN nEdges ) 0 - adv_coefs mesh - -
-var persistent real adv_coefs_3rd ( FIFTEEN nEdges ) 0 - adv_coefs_3rd mesh - -
-var persistent integer advCellsForEdge ( FIFTEEN nEdges ) 0 - advCellsForEdge mesh - -
-var persistent integer nAdvCellsForEdge ( nEdges ) 0 - nAdvCellsForEdge mesh - -
-
-
-% Space needed for deformation calculation weights
-var persistent real defc_a ( maxEdges nCells ) 0 iro defc_a mesh - -
-var persistent real defc_b ( maxEdges nCells ) 0 iro defc_b mesh - -
-var persistent real kdiff ( nVertLevels nCells Time ) 1 - kdiff diag - -
-
-% Arrays required for reconstruction of velocity field
-var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 iro coeffs_reconstruct mesh - -
-
-% ADDED DECLARATIONS MADE BY LDF:
-var persistent real surface_pressure ( nCells Time ) 1 iro surface_pressure diag - -
-var persistent real surface_temperature ( nCells Time ) 1 o surface_temperature diag - -
-
-%==================================================================================================
-% DECLARATIONS OF ALL PHYSICS VARIABLES (will need to be moved to a Physics Registry shared by the
-% hydrostatic and non-hydrostatic dynamical cores):
-%==================================================================================================
-
-%... NAMELIST VARIABLES ADDED FOR INITIALIZATION OF SURFACE CHARACTERISTICS:
-namelist character physics input_landuse_data USGS
-namelist character physics input_soil_data STAS
-namelist integer physics input_soil_temperature_lag 140
-namelist integer physics num_soil_layers 4
-namelist integer physics months 12
-
-%... NAMELIST VARIABLE NEEDED FOR THE TIME MANAGER:
-dim nMonths namelist:months
-
-%... DIMENSION NEEDED FOR NUMBER OF SOIL LAYERS:
-dim nSoilLevels namelist:num_soil_layers
-
-%... DIMENSION NEEDED FOR UPDATING THE DEEP SOIL TEMPERATURE:
-dim nLags namelist:input_soil_temperature_lag
-
-%... DIMENSION NEEDED FOR OZONE AND AEROSOLS CONCENTRATIONS IN THE CAM LONGWAVE AND SHORTWAVE
-%... RADIATION PARAMETERIZATIONS.
-% noznlev : number of CAM radiation input ozone levels.
-% naerlev : number of CAM radiation input aerosol levels.
-
-namelist integer physics noznlev 59
-namelist integer physics naerlev 29
-namelist integer physics camdim1 4
-dim nOznLevels namelist:noznlev
-dim nAerLevels namelist:naerlev
-dim cam_dim1 namelist:camdim1
-
-%... DIMENSION NEEDED FOR LONGWAVE AND SHORTWAVE RADIATION FLUXES TO INCLUDE AN ADDITIONAL LAYER
-%... BETWEEN THE TOP OF THE MODEL AND THE TOP OF THE ATMOSPHERE
-dim nVertLevelsP2 nVertLevels+2
-
-%... NAMELIST VARIABLES ADDED FOR PHYSICS CONFIGURATION:
-namelist logical physics config_frac_seaice false
-namelist logical physics config_sfc_albedo false
-namelist logical physics config_sfc_snowalbedo false
-namelist logical physics config_sst_update false
-namelist logical physics config_sstdiurn_update false
-namelist logical physics config_deepsoiltemp_update false
-
-namelist integer physics config_n_physics 1
-namelist integer physics config_n_microp 1
-namelist integer physics config_n_conv 1
-namelist integer physics config_n_pbl 1
-namelist integer physics config_n_lsm 1
-namelist integer physics config_n_eddy 1
-namelist integer physics config_n_radt_lw 1
-namelist integer physics config_n_radt_sw 1
-
-namelist character physics config_radtlw_interval none
-namelist character physics config_radtsw_interval none
-namelist character physics config_conv_interval none
-namelist character physics config_pbl_interval none
-namelist character physics config_camrad_abs_update 06:00:00
-namelist character physics config_greeness_update 24:00:00
-namelist character physics config_bucket_update none
-
-namelist character physics config_microp_scheme off
-namelist character physics config_conv_shallow_scheme off
-namelist character physics config_conv_deep_scheme off
-namelist character physics config_eddy_scheme off
-namelist character physics config_lsm_scheme off
-namelist character physics config_pbl_scheme off
-namelist character physics config_radt_cld_scheme off
-namelist character physics config_radt_lw_scheme off
-namelist character physics config_radt_sw_scheme off
-namelist character physics config_sfclayer_scheme off
-
-namelist real physics config_bucket_radt 0.0_RKIND
-namelist real physics config_bucket_rainc 0.0_RKIND
-namelist real physics config_bucket_rainnc 0.0_RKIND
-
-var persistent real east ( R3 nCells ) 0 r east mesh - -
-var persistent real north ( R3 nCells ) 0 r north mesh - -
-
-%--------------------------------------------------------------------------------------------------
-%... ARRAYS AND VARIABLES FOR UPDATING THE DEEP SOIL TEMPERATURE:
-%--------------------------------------------------------------------------------------------------
-
-% nsteps_accum: number of accumulated time-step in a day.
-% ndays_accum : number of accumulated days in a year.
-% tlag : daily mean surface temperature of prior days [K]
-% tday_accum : accumulated daily surface temperature for current day [K]
-% tyear_mean : annual mean surface temperature [K]
-% tyear_accum : accumulated yearly surface temperature for current year [K]
-
-var persistent real nsteps_accum ( nCells Time ) 1 r nsteps_accum diag_physics - -
-var persistent real ndays_accum ( nCells Time ) 1 r ndays_accum diag_physics - -
-
-var persistent real tlag ( nLags nCells Time ) 1 r tlag diag_physics - -
-var persistent real tday_accum ( nCells Time ) 1 r tday_accum diag_physics - -
-var persistent real tyear_mean ( nCells Time ) 1 r tyear_mean diag_physics - -
-var persistent real tyear_accum ( nCells Time ) 1 r tyear_accum diag_physics - -
-
-%--------------------------------------------------------------------------------------------------
-%... PARAMETERIZATION OF CLOUD MICROPHYSICS:
-%--------------------------------------------------------------------------------------------------
-% i_rainnc : counter related to how often rainnc is being reset relative to its bucket value (-)
-% rainnc : accumulated total time-step grid-scale precipitation (mm)
-% rainncv : time-step total grid-scale precipitation (mm)
-% snownc : accumulated grid-scale precipitation of snow (mm)
-% snowncv : time-step grid-scale precipitation of snow (mm)
-% graupelnc : accumulated grid-scale precipitation of graupel (mm)
-% graupelncv: time-step grid-scale precipitation of graupel (mm)
-% sr : time-step ratio of frozen versus total grid-scale precipitation (-)
-
-var persistent integer i_rainnc ( nCells Time ) 1 ro i_rainnc diag_physics - -
-var persistent real sr ( nCells Time ) 1 ro sr diag_physics - -
-var persistent real rainncv ( nCells Time ) 1 ro rainncv diag_physics - -
-var persistent real snowncv ( nCells Time ) 1 o snowncv diag_physics - -
-var persistent real graupelncv ( nCells Time ) 1 o graupelncv diag_physics - -
-
-var persistent real rainnc ( nCells Time ) 1 ro rainnc diag_physics - -
-var persistent real snownc ( nCells Time ) 1 ro snownc diag_physics - -
-var persistent real graupelnc ( nCells Time ) 1 ro graupelnc diag_physics - -
-
-var persistent real qsat ( nVertLevels nCells Time ) 1 o qsat diag_physics - -
-var persistent real relhum ( nVertLevels nCells Time ) 1 o relhum diag_physics - -
-
-%--------------------------------------------------------------------------------------------------
-%... PARAMETERIZATION OF CONVECTION:
-%--------------------------------------------------------------------------------------------------
-% i_rainc : counter related to how often rainc is begin reset relative to its bucket value (-)
-% cuprec : convective precipitation rate (mm/s)
-% rainc : accumulated time-step convective precipitation (mm)
-% raincv : time-step convective precipitation (mm)
-% rthcuten : tendency of potential temperature due to cumulus convection (K s-1)
-% rqvcuten : tendency of water vapor mixing ratio due to cumulus convection (kg/kg s-1)
-% rqccuten : tendency of cloud water mixing ratio due to cumulus convection (kg/kg s-1)
-% rqicuten : tendency of cloud ice mixing ratio due to cumulus convection (kg/kg s-1)
-
-var persistent integer i_rainc ( nCells Time ) 1 ro i_rainc diag_physics - -
-var persistent real cuprec ( nCells Time ) 1 ro cuprec diag_physics - -
-var persistent real rainc ( nCells Time ) 1 ro rainc diag_physics - -
-var persistent real raincv ( nCells Time ) 1 ro raincv diag_physics - -
-
-var persistent real rthcuten ( nVertLevels nCells Time ) 1 ro rthcuten tend_physics - -
-var persistent real rqvcuten ( nVertLevels nCells Time ) 1 ro rqvcuten tend_physics - -
-var persistent real rqccuten ( nVertLevels nCells Time ) 1 ro rqccuten tend_physics - -
-var persistent real rqicuten ( nVertLevels nCells Time ) 1 ro rqicuten tend_physics - -
-
-%... KAIN_FRITSCH:
-% cubot : lowest level of convection (-)
-% cutop : highest level of convection (-)
-% nca : relaxation time for KF parameterization of convection (s)
-% wavg0 : average vertical velocity (KF scheme only) (m s-1)
-% rqrcuten : tendency of rain mixing ratio due to cumulus convection (kg/kg s-1)
-% rqscuten : tendency of snow mixing ratio due to cumulus convection (kg/kg s-1)
-
-var persistent real nca ( nCells Time ) 1 ro nca diag_physics - -
-var persistent real cubot ( nCells Time ) 1 ro cubot diag_physics - -
-var persistent real cutop ( nCells Time ) 1 ro cutop diag_physics - -
-var persistent real w0avg ( nVertLevels nCells Time ) 1 ro w0avg diag_physics - -
-var persistent real rqrcuten ( nVertLevels nCells Time ) 1 ro rqrcuten tend_physics - -
-var persistent real rqscuten ( nVertLevels nCells Time ) 1 ro rqscuten tend_physics - -
-
-%... TIEDTKE:
-% rucuten : tendency of zonal wind due to cumulus convection (m/s-1)
-% rvcuten : tendency of meridional wind due to cumulus convection (m/s-1)
-% rqvdynten : tendency of water vapor due to horizontal and vertical advections (kg/kg/s-1)
-
-var persistent real rqvdynten ( nVertLevels nCells Time ) 1 ro rqvdynten tend_physics - -
-var persistent real rucuten ( nVertLevels nCells Time ) 1 ro rucuten tend_physics - -
-var persistent real rvcuten ( nVertLevels nCells Time ) 1 ro rvcuten tend_physics - -
-
-%--------------------------------------------------------------------------------------------------
-%... PARAMETERIZATION OF PLANETARY BOUNDARY LAYER PROCESSES:
-%--------------------------------------------------------------------------------------------------
-
-% kpbl : index of PBL top (-)
-% hpbl : PBL height (m)
-% exch_h : exchange coefficient (-)
-% rublten : tendency of zonal wind due to pbl processes (m s-1)
-% rvblten : tendency of meridional wind due to pbl processes (m s-1)
-% rthblten : tendency of potential temperature due to pbl processes (K s-1)
-% rqvblten : tendency of water vapor mixing ratio due to pbl processes (kg/kg s-1)
-% rqcblten : tendency of cloud water mixing ratio due to pbl processes (kg/kg s-1)
-% rqiblten : tendency of cloud ice mixing ratio due to pbl processes (kg/kg s-1)
-
-var persistent integer kpbl ( nCells Time ) 1 ro kpbl diag_physics - -
-var persistent real hpbl ( nCells Time ) 1 ro hpbl diag_physics - -
-var persistent real exch_h ( nVertLevels nCells Time ) 1 o exch_h diag_physics - -
-
-% TENDENCIES:
-var persistent real rublten ( nVertLevels nCells Time ) 1 ro rublten tend_physics - -
-var persistent real rvblten ( nVertLevels nCells Time ) 1 ro rvblten tend_physics - -
-var persistent real rthblten ( nVertLevels nCells Time ) 1 ro rthblten tend_physics - -
-var persistent real rqvblten ( nVertLevels nCells Time ) 1 ro rqvblten tend_physics - -
-var persistent real rqcblten ( nVertLevels nCells Time ) 1 ro rqcblten tend_physics - -
-var persistent real rqiblten ( nVertLevels nCells Time ) 1 ro rqiblten tend_physics - -
-
-%--------------------------------------------------------------------------------------------------
-%... PARAMETERIZATION OF SURFACE LAYER PROCESSES:
-%--------------------------------------------------------------------------------------------------
-
-% br :bulk richardson number [-]
-% cd :drag coefficient at 10m [-]
-% cda :drag coefficient at lowest model level [-]
-% chs :???
-% chs2 :???
-% cqs2 :???
-% ck :enthalpy exchange coefficient at 10 m [-]
-% cka :enthalpy exchange coefficient at lowest model level [-]
-% cpm :???
-% flhc :exchange coefficient for heat [-]
-% flqc :exchange coefficient for moisture [-]
-% gz1oz0 :log of z1 over z0 [-]
-% hfx :upward heat flux at the surface [W/m2/s]
-% lh :latent heat flux at the surface [W/m2]
-% mavail :surface moisture availability [-]
-% mol :T* in similarity theory [K]
-% psih :similarity theory for heat [-]
-% psim :similarity theory for momentum [-]
-% qfx :upward moisture flux at the surface [kg/m2/s]
-% qgh :???
-% qsfc :specific humidity at lower boundary [kg/kg]
-% regime :flag indicating PBL regime (stable_p,unstable_p,etc...) [-]
-% rmol :1 / Monin Ob length [-]
-% ust :u* in similarity theory [m/s]
-% ustm :u* in similarity theory without vconv [m/s]
-% zol :z/L height over Monin-Obukhov length [-]
-% znt :time-varying roughness length [m]
-% wspd :wind speed [m/s]
-% DIAGNOSTICS:
-% q2 :specific humidity at 2m [kg/kg]
-% u10 :u at 10 m [m/s]
-% v10 :v at 10 m [m/s]
-% t2m :temperature at 2m [K]
-% th2m :potential temperature at 2m [K]
-
-var persistent real hfx ( nCells Time ) 1 ro hfx diag_physics - -
-var persistent real mavail ( nCells Time ) 1 ro mavail diag_physics - -
-var persistent real mol ( nCells Time ) 1 ro mol diag_physics - -
-var persistent real qfx ( nCells Time ) 1 ro qfx diag_physics - -
-var persistent real qsfc ( nCells Time ) 1 ro qsfc diag_physics - -
-var persistent real ust ( nCells Time ) 1 ro ust diag_physics - -
-var persistent real ustm ( nCells Time ) 1 ro ustm diag_physics - -
-var persistent real zol ( nCells Time ) 1 ro zol diag_physics - -
-var persistent real znt ( nCells Time ) 1 ro znt diag_physics - -
-
-var persistent real br ( nCells Time ) 1 ro br diag_physics - -
-var persistent real cd ( nCells Time ) 1 ro cd diag_physics - -
-var persistent real cda ( nCells Time ) 1 ro cda diag_physics - -
-var persistent real chs ( nCells Time ) 1 ro chs diag_physics - -
-var persistent real chs2 ( nCells Time ) 1 ro chs2 diag_physics - -
-var persistent real cqs2 ( nCells Time ) 1 ro cqs2 diag_physics - -
-var persistent real ck ( nCells Time ) 1 ro ck diag_physics - -
-var persistent real cka ( nCells Time ) 1 ro cka diag_physics - -
-var persistent real cpm ( nCells Time ) 1 ro cpm diag_physics - -
-var persistent real flhc ( nCells Time ) 1 ro flhc diag_physics - -
-var persistent real flqc ( nCells Time ) 1 ro flqc diag_physics - -
-var persistent real gz1oz0 ( nCells Time ) 1 ro gz1oz0 diag_physics - -
-var persistent real lh ( nCells Time ) 1 ro lh diag_physics - -
-var persistent real psim ( nCells Time ) 1 ro psim diag_physics - -
-var persistent real psih ( nCells Time ) 1 ro psih diag_physics - -
-var persistent real qgh ( nCells Time ) 1 ro qgh diag_physics - -
-var persistent real regime ( nCells Time ) 1 ro regime diag_physics - -
-var persistent real rmol ( nCells Time ) 1 ro rmol diag_physics - -
-var persistent real wspd ( nCells Time ) 1 ro wspd diag_physics - -
-% DIAGNOSTICS:
-var persistent real u10 ( nCells Time ) 1 ro u10 diag_physics - -
-var persistent real v10 ( nCells Time ) 1 ro v10 diag_physics - -
-var persistent real q2 ( nCells Time ) 1 ro q2 diag_physics - -
-var persistent real t2m ( nCells Time ) 1 ro t2m diag_physics - -
-var persistent real th2m ( nCells Time ) 1 ro th2m diag_physics - -
-
-%--------------------------------------------------------------------------------------------------
-%... PARAMETERIZATION OF SHORTWAVE RADIATION:
-%--------------------------------------------------------------------------------------------------
-% coszr :cosine of the solar zenith angle [-]
-% gsw :net shortwave flux at surface [W m-2]
-% swcf :shortwave cloud forcing at top-of-atmosphere [W m-2]
-% swdnb :all-sky downwelling shortwave flux at bottom-of-atmosphere [W m-2]
-% swdnbc :clear-sky downwelling shortwave flux at bottom-of-atmosphere [W m-2]
-% swdnt :all-sky downwelling shortwave flux at top-of-atmosphere [W m-2]
-% swdntc :clear-sky downwelling shortwave flux at top-of-atmosphere [W m-2]
-% swupb :all-sky upwelling shortwave flux at bottom-of-atmosphere [W m-2]
-% swupbc :clear-sky upwelling shortwave flux at bottom-of-atmosphere [W m-2]
-% swupt :all-sky upwelling shortwave flux at top-of-atmosphere [W m-2]
-% swuptc :clear-sky upwelling shortwave flux at top-of-atmosphere [W m-2]
-% acswdnb :accumulated all-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2]
-% acswdnbc :accumulated clear-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2]
-% acswdnt :accumulated all-sky downwelling shortwave flux at top-of-atmosphere [J m-2]
-% acswdntc :accumulated clear-sky downwelling shortwave flux at top-of-atmosphere [J m-2]
-% acswupb :accumulated all-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2]
-% acswupbc :accumulated clear-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2]
-% acswupt :accumulated all-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
-% acswuptc :accumulated clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
-% swdnflx :
-% swdnflxc :
-% swupflx :
-% swupflxc :
-% rthratensw:uncoupled theta tendency due to shortwave radiation [K s-1]
-
-% i_acswdnb : counter related to how often swdnb is begin reset relative to its bucket value (-)
-% i_acswdnbc: counter related to how often swdnbc is begin reset relative to its bucket value (-)
-% i_acswdnt : counter related to how often swdnt is begin reset relative to its bucket value (-)
-% i_acswdntc: counter related to how often swdntc is begin reset relative to its bucket value (-)
-% i_acswupb : counter related to how often swupb is begin reset relative to its bucket value (-)
-% i_acswupbc: counter related to how often swupbc is begin reset relative to its bucket value (-)
-% i_acswupt : counter related to how often swupt is begin reset relative to its bucket value (-)
-% i_acswuptc: counter related to how often swuptc is begin reset relative to its bucket value (-)
-
-var persistent integer i_acswdnb ( nCells Time ) 1 ro i_acswdnb diag_physics - -
-var persistent integer i_acswdnbc ( nCells Time ) 1 ro i_acswdnbc diag_physics - -
-var persistent integer i_acswdnt ( nCells Time ) 1 ro i_acswdnt diag_physics - -
-var persistent integer i_acswdntc ( nCells Time ) 1 ro i_acswdntc diag_physics - -
-var persistent integer i_acswupb ( nCells Time ) 1 ro i_acswupb diag_physics - -
-var persistent integer i_acswupbc ( nCells Time ) 1 ro i_acswupbc diag_physics - -
-var persistent integer i_acswupt ( nCells Time ) 1 ro i_acswupt diag_physics - -
-var persistent integer i_acswuptc ( nCells Time ) 1 ro i_acswuptc diag_physics - -
-
-var persistent real coszr ( nCells Time ) 1 o coszr diag_physics - -
-var persistent real swcf ( nCells Time ) 1 o swcf diag_physics - -
-var persistent real swdnb ( nCells Time ) 1 o swdnb diag_physics - -
-var persistent real swdnbc ( nCells Time ) 1 o swdnbc diag_physics - -
-var persistent real swdnt ( nCells Time ) 1 o swdnt diag_physics - -
-var persistent real swdntc ( nCells Time ) 1 o swdntc diag_physics - -
-var persistent real swupb ( nCells Time ) 1 o swupb diag_physics - -
-var persistent real swupbc ( nCells Time ) 1 o swupbc diag_physics - -
-var persistent real swupt ( nCells Time ) 1 o swupt diag_physics - -
-var persistent real swuptc ( nCells Time ) 1 o swuptc diag_physics - -
-var persistent real acswdnb ( nCells Time ) 1 ro acswdnb diag_physics - -
-var persistent real acswdnbc ( nCells Time ) 1 ro acswdnbc diag_physics - -
-var persistent real acswdnt ( nCells Time ) 1 ro acswdnt diag_physics - -
-var persistent real acswdntc ( nCells Time ) 1 ro acswdntc diag_physics - -
-var persistent real acswupb ( nCells Time ) 1 ro acswupb diag_physics - -
-var persistent real acswupbc ( nCells Time ) 1 ro acswupbc diag_physics - -
-var persistent real acswupt ( nCells Time ) 1 ro acswupt diag_physics - -
-var persistent real acswuptc ( nCells Time ) 1 ro acswuptc diag_physics - -
-var persistent real gsw ( nCells Time ) 1 ro gsw diag_physics - -
-
-var persistent real rthratensw ( nVertLevels nCells Time ) 1 ro rthratensw tend_physics - -
-
-%... RRTMG SW ONLY:
-var persistent real swdnflx ( nVertLevelsP2 nCells Time ) 1 o swdnflx diag_physics - -
-var persistent real swdnflxc ( nVertLevelsP2 nCells Time ) 1 o swdnflxc diag_physics - -
-var persistent real swupflx ( nVertLevelsP2 nCells Time ) 1 o swupflx diag_physics - -
-var persistent real swupflxc ( nVertLevelsP2 nCells Time ) 1 o swupflxc diag_physics - -
-
-%--------------------------------------------------------------------------------------------------
-%... PARAMETERIZATION OF LONGWAVE RADIATION:
-%--------------------------------------------------------------------------------------------------
-
-% note: glw is the same diagnostic as lwdnb and is used in the land-surface scheme for the calcula-
-% tion of the surface budget. glw is always an output argument to the subroutine rrtmg_lwrad.
-% in contrast,lwdnb is an optional ouput argument to the subroutine rrtmg_lwrad depending on
-% the presence of lwupt (or not).
-
-% glw :all-sky downwelling longwave flux at bottom-of-atmosphere [W m-2]
-% lwcf :longwave cloud forcing at top-of-atmosphere [W m-2]
-% lwdnb :all-sky downwelling longwave flux at bottom-of-atmosphere [W m-2]
-% lwdnbc :clear-sky downwelling longwave flux at bottom-of-atmosphere [W m-2]
-% lwdnt :all-sky downwelling longwave flux at top-of-atmosphere [W m-2]
-% lwdntc :clear-sky downwelling longwave flux at top-of-atmosphere [W m-2]
-% lwupb :all-sky upwelling longwave flux at bottom-of-atmosphere [W m-2]
-% lwupbc :clear-sky upwelling longwave flux at bottom-of-atmosphere [W m-2]
-% lwupt :all-sky upwelling longwave flux at top-of-atmosphere [W m-2]
-% lwuptc :clear-sky upwelling longwave flux at top-of-atmosphere [W m-2]
-% aclwdnb :accumulated all-sky downwelling longwave flux at bottom-of-atmosphere [J m-2]
-% aclwdnbc :accumulated clear-sky downwelling longwave flux at bottom-of-atmosphere [J m-2]
-% aclwdnt :accumulated all-sky downwelling longwave flux at top-of-atmosphere [J m-2]
-% aclwdntc :accumulated clear-sky downwelling longwave flux at top-of-atmosphere [J m-2]
-% aclwupb :accumulated all-sky upwelling longwave flux at bottom-of-atmosphere [J m-2]
-% aclwupbc :accumulated clear-sky upwelling longwave flux at bottom-of-atmosphere [J m-2]
-% aclwupt :accumulated all-sky upwelling longwave flux at top-of-atmosphere [J m-2]
-% aclwuptc :accumulated clear-sky upwelling longwave flux at top-of-atmosphere [J m-2]
-% lwdnflx :
-% lwdnflxc :
-% lwupflx :
-% lwupflxc :
-% olrtoa :outgoing longwave radiation at top-of-the-atmosphere [W m-2]
-% rthratenlw:uncoupled theta tendency due to longwave radiation [K s-1]
-
-% i_aclwdnb : counter related to how often lwdnb is begin reset relative to its bucket value (-)
-% i_aclwdnbc: counter related to how often lwdnbc is begin reset relative to its bucket value (-)
-% i_aclwdnt : counter related to how often lwdnt is begin reset relative to its bucket value (-)
-% i_aclwdntc: counter related to how often lwdntc is begin reset relative to its bucket value (-)
-% i_aclwupb : counter related to how often lwupb is begin reset relative to its bucket value (-)
-% i_aclwupbc: counter related to how often lwupbc is begin reset relative to its bucket value (-)
-% i_aclwupt : counter related to how often lwupt is begin reset relative to its bucket value (-)
-% i_aclwuptc: counter related to how often lwuptc is begin reset relative to its bucket value (-)
-
-var persistent integer i_aclwdnb ( nCells Time ) 1 ro i_aclwdnb diag_physics - -
-var persistent integer i_aclwdnbc ( nCells Time ) 1 ro i_aclwdnbc diag_physics - -
-var persistent integer i_aclwdnt ( nCells Time ) 1 ro i_aclwdnt diag_physics - -
-var persistent integer i_aclwdntc ( nCells Time ) 1 ro i_aclwdntc diag_physics - -
-var persistent integer i_aclwupb ( nCells Time ) 1 ro i_aclwupb diag_physics - -
-var persistent integer i_aclwupbc ( nCells Time ) 1 ro i_aclwupbc diag_physics - -
-var persistent integer i_aclwupt ( nCells Time ) 1 ro i_aclwupt diag_physics - -
-var persistent integer i_aclwuptc ( nCells Time ) 1 ro i_aclwuptc diag_physics - -
-
-var persistent real lwcf ( nCells Time ) 1 o lwcf diag_physics - -
-var persistent real lwdnb ( nCells Time ) 1 o lwdnb diag_physics - -
-var persistent real lwdnbc ( nCells Time ) 1 o lwdnbc diag_physics - -
-var persistent real lwdnt ( nCells Time ) 1 o lwdnt diag_physics - -
-var persistent real lwdntc ( nCells Time ) 1 o lwdntc diag_physics - -
-var persistent real lwupb ( nCells Time ) 1 o lwupb diag_physics - -
-var persistent real lwupbc ( nCells Time ) 1 o lwupbc diag_physics - -
-var persistent real lwupt ( nCells Time ) 1 o lwupt diag_physics - -
-var persistent real lwuptc ( nCells Time ) 1 o lwuptc diag_physics - -
-var persistent real aclwdnb ( nCells Time ) 1 ro aclwdnb diag_physics - -
-var persistent real aclwdnbc ( nCells Time ) 1 ro aclwdnbc diag_physics - -
-var persistent real aclwdnt ( nCells Time ) 1 ro aclwdnt diag_physics - -
-var persistent real aclwdntc ( nCells Time ) 1 ro aclwdntc diag_physics - -
-var persistent real aclwupb ( nCells Time ) 1 ro aclwupb diag_physics - -
-var persistent real aclwupbc ( nCells Time ) 1 ro aclwupbc diag_physics - -
-var persistent real aclwupt ( nCells Time ) 1 ro aclwupt diag_physics - -
-var persistent real aclwuptc ( nCells Time ) 1 ro aclwuptc diag_physics - -
-var persistent real olrtoa ( nCells Time ) 1 o olrtoa diag_physics - -
-var persistent real glw ( nCells Time ) 1 ro glw diag_physics - -
-
-var persistent real rthratenlw ( nVertLevels nCells Time ) 1 ro rthratenlw tend_physics - -
-
-%... RRTMG LW ONLY:
-%var persistent real lwdnflx ( nVertLevelsP2 nCells Time ) 1 o lwdnflx diag_physics - -
-%var persistent real lwdnflxc ( nVertLevelsP2 nCells Time ) 1 o lwdnflxc diag_physics - -
-%var persistent real lwupflx ( nVertLevelsP2 nCells Time ) 1 o lwupflx diag_physics - -
-%var persistent real lwupflxc ( nVertLevelsP2 nCells Time ) 1 o lwupflxc diag_physics - -
-
-%--------------------------------------------------------------------------------------------------
-%... ADDITIONAL "RADIATION" ARRAYS NEEDED ONLY IN THE "CAM" LW AND SW RADIATION CODES:
-%--------------------------------------------------------------------------------------------------
-
-%INFRARED ABSORPTION:
-var persistent real absnxt ( nVertLevels cam_dim1 nCells Time ) 1 - absnxt diag_physics - -
-var persistent real abstot ( nVertLevelsP1 nVertLevelsP1 nCells Time ) 1 - abstot diag_physics - -
-var persistent real emstot ( nVertLevelsP1 nCells Time ) 1 - emstot diag_physics - -
-%var persistent real absnxt ( nVertLevels cam_dim1 nCells Time ) 1 r absnxt diag_physics - -
-%var persistent real abstot ( nVertLevelsP1 nVertLevelsP1 nCells Time ) 1 r abstot diag_physics - -
-%var persistent real emstot ( nVertLevelsP1 nCells Time ) 1 r emstot diag_physics - -
-
-% OZONE:
-var persistent real pin ( nOznLevels nCells ) 0 - pin mesh - -
-var persistent real ozmixm ( nMonths nOznLevels nCells ) 0 - ozmixm mesh - -
-
-% AEROSOLS:
-var persistent real m_hybi ( nAerLevels nCells ) 0 - m_hybi mesh - -
-
-var persistent real m_ps ( nCells Time ) 2 - m_ps state - -
-%var persistent real dummy ( nAerLevels nCells Time ) 2 - dummy state aerosols aer_cam
-var persistent real sul ( nAerLevels nCells Time ) 2 - sul state aerosols aer_cam
-var persistent real sslt ( nAerLevels nCells Time ) 2 - sslt state aerosols aer_cam
-var persistent real dust1 ( nAerLevels nCells Time ) 2 - dust1 state aerosols aer_cam
-var persistent real dust2 ( nAerLevels nCells Time ) 2 - dust2 state aerosols aer_cam
-var persistent real dust3 ( nAerLevels nCells Time ) 2 - dust3 state aerosols aer_cam
-var persistent real dust4 ( nAerLevels nCells Time ) 2 - dust4 state aerosols aer_cam
-var persistent real ocpho ( nAerLevels nCells Time ) 2 - ocpho state aerosols aer_cam
-var persistent real bcpho ( nAerLevels nCells Time ) 2 - bcpho state aerosols aer_cam
-var persistent real ocphi ( nAerLevels nCells Time ) 2 - ocphi state aerosols aer_cam
-var persistent real bcphi ( nAerLevels nCells Time ) 2 - bcphi state aerosols aer_cam
-var persistent real bg ( nAerLevels nCells Time ) 2 - bg state aerosols aer_cam
-var persistent real volc ( nAerLevels nCells Time ) 2 - volc state aerosols aer_cam
-
-%--------------------------------------------------------------------------------------------------
-%... PARAMERIZATION OF CLOUDINESS:
-%--------------------------------------------------------------------------------------------------
-
-% cldfrac :cloud fraction [-]
-
-var persistent real cldfrac ( nVertLevels nCells Time ) 1 o cldfrac diag_physics - -
-
-%--------------------------------------------------------------------------------------------------
-%... PARAMETERIZATION OF LAND-SURFACE SCHEME:
-%--------------------------------------------------------------------------------------------------
-
-% acsnom :accumulated melted snow [kg m-2]
-% acsnow :accumulated snow [kg m-2]
-% canwat :canopy water [kg m-2]
-% chklowq :surface saturation flag [-]
-% grdflx :ground heat flux [W m-2]
-% lai :leaf area index [-]
-% noahres :residual of the noah land-surface scheme energy budget [W m-2]
-% potevp :potential evaporation [W m-2]
-% qz0 :specific humidity at znt [kg kg-1]
-% rib :??
-% sfc_albedo :surface albedo [-]
-% sfc_embck :background emissivity [-]
-% sfc_emiss :surface emissivity [-]
-% sfcrunoff :surface runoff [m s-1]
-% smstav :moisture availability [-]
-% smstot :total moisture [m3 m-3]
-% snopcx :snow phase change heat flux [W m-2]
-% snotime :??
-% sstsk : skin sea-surface temperature [K]
-% sstsk_diur : skin sea-surface temperature difference [K]
-% thc :thermal inertia [Cal cm-1 K-1 s-0.5]
-% udrunoff :sub-surface runoff [m s-1]
-% xicem :ice mask from previous time-step [-]
-% z0 :background roughness length [m]
-% zs :depth of centers of soil layers [m]
-
-var persistent real acsnom ( nCells Time ) 1 ro acsnom diag_physics - -
-var persistent real acsnow ( nCells Time ) 1 ro acsnow diag_physics - -
-var persistent real canwat ( nCells Time ) 1 ro canwat diag_physics - -
-var persistent real chklowq ( nCells Time ) 1 ro chklowq diag_physics - -
-var persistent real grdflx ( nCells Time ) 1 ro grdflx diag_physics - -
-var persistent real lai ( nCells Time ) 1 ro lai diag_physics - -
-var persistent real noahres ( nCells Time ) 1 ro noahres diag_physics - -
-var persistent real potevp ( nCells Time ) 1 ro potevp diag_physics - -
-var persistent real qz0 ( nCells Time ) 1 ro qz0 diag_physics - -
-var persistent real rib ( nCells Time ) 1 ro rib diag_physics - -
-var persistent real sfc_albedo ( nCells Time ) 1 ro sfc_albedo diag_physics - -
-var persistent real sfc_emiss ( nCells Time ) 1 ro sfc_emiss diag_physics - -
-var persistent real sfc_emibck ( nCells Time ) 1 ro sfc_emibck diag_physics - -
-var persistent real sfcrunoff ( nCells Time ) 1 ro sfcrunoff diag_physics - -
-var persistent real smstav ( nCells Time ) 1 ro smstav diag_physics - -
-var persistent real smstot ( nCells Time ) 1 ro smstot diag_physics - -
-var persistent real snopcx ( nCells Time ) 1 ro snopcx diag_physics - -
-var persistent real snotime ( nCells Time ) 1 ro snotime diag_physics - -
-var persistent real sstsk ( nCells Time ) 1 ro sstsk diag_physics - -
-var persistent real sstsk_diur ( nCells Time ) 1 ro sstsk_diur diag_physics - -
-var persistent real thc ( nCells Time ) 1 ro thc diag_physics - -
-var persistent real udrunoff ( nCells Time ) 1 ro udrunoff diag_physics - -
-var persistent real xicem ( nCells Time ) 1 ro xicem diag_physics - -
-var persistent real z0 ( nCells Time ) 1 ro z0 diag_physics - -
-var persistent real zs ( nCells Time ) 1 ro zs diag_physics - -
-
-%--------------------------------------------------------------------------------------------------
-%... SURFACE CHARACTERISTICS THAT NEED TO BE READ FROM GRID.NC:
-%--------------------------------------------------------------------------------------------------
-
-% albedo12m :monthly climatological albedo [-]
-% greenfrac :monthly climatological greeness fraction [-]
-% isltyp :dominant soil category [-]
-% ivgtyp :dominant vegetation category [-]
-% landmask :=0 for ocean;=1 for land [-]
-% sfc_albbck :background albedo [-]
-% shdmin :minimum areal fractional coverage of annual green vegetation [-]
-% shdmax :maximum areal fractional coverage of annual green vegetation [-]
-% skintemp :skin temperature [K]
-% snoalb :annual max snow albedo [-]
-% snow :snow water equivalent [kg m-2]
-% sst :sea-surface temperature [K]
-% snowc :flag indicating snow coverage (1 for snow cover) [-]
-% snowh :physical snow depth [m]
-% ter :terrain height [-]
-% tmn :soil temperature at lower boundary [K]
-% vegfra :vegetation fraction [-]
-% seaice :sea-ice mask (=1 when xice is greater than 0; =0 otherwise) [-]
-% xice :fractional sea-ice coverage [-]
-% xland :land mask (1 for land; 2 for water) [-]
-
-% dzs :thickness of soil layers [m]
-% smcrel :soil moisture threshold below which transpiration begins to stress [-]
-% sh2o :soil liquid water [m3 m-3]
-% smois :soil moisture [m3 m-3]
-% tslb :soil temperature [K]
-
-var persistent integer isltyp ( nCells ) 0 iro isltyp sfc_input - -
-var persistent integer ivgtyp ( nCells ) 0 iro ivgtyp sfc_input - -
-var persistent integer landmask ( nCells ) 0 iro landmask sfc_input - -
-var persistent real shdmin ( nCells ) 0 iro shdmin sfc_input - -
-var persistent real shdmax ( nCells ) 0 iro shdmax sfc_input - -
-var persistent real snoalb ( nCells ) 0 iro snoalb sfc_input - -
-var persistent real ter ( nCells ) 0 io ter sfc_input - -
-var persistent real albedo12m ( nMonths nCells ) 0 iro albedo12m sfc_input - -
-var persistent real greenfrac ( nMonths nCells ) 0 iro greenfrac sfc_input - -
-
-var persistent real sfc_albbck ( nCells Time ) 1 iro sfc_albbck sfc_input - -
-var persistent real skintemp ( nCells Time ) 1 iro skintemp sfc_input - -
-var persistent real snow ( nCells Time ) 1 iro snow sfc_input - -
-var persistent real snowc ( nCells Time ) 1 iro snowc sfc_input - -
-var persistent real snowh ( nCells Time ) 1 iro snowh sfc_input - -
-var persistent real sst ( nCells Time ) 1 isro sst sfc_input - -
-var persistent real tmn ( nCells Time ) 1 iro tmn sfc_input - -
-var persistent real vegfra ( nCells Time ) 1 iro vegfra sfc_input - -
-var persistent real seaice ( nCells Time ) 1 iro seaice sfc_input - -
-var persistent real xice ( nCells Time ) 1 isro xice sfc_input - -
-var persistent real xland ( nCells Time ) 1 iro xland sfc_input - -
-
-var persistent real dzs ( nSoilLevels nCells Time ) 1 iro dzs sfc_input - -
-var persistent real smcrel ( nSoilLevels nCells Time ) 1 ro smcrel sfc_input - -
-var persistent real sh2o ( nSoilLevels nCells Time ) 1 iro sh2o sfc_input - -
-var persistent real smois ( nSoilLevels nCells Time ) 1 iro smois sfc_input - -
-var persistent real tslb ( nSoilLevels nCells Time ) 1 iro tslb sfc_input - -
-
-%==================================================================================================
Copied: branches/mpas_cdg_advection/src/core_nhyd_atmos/Registry.xml (from rev 2782, trunk/mpas/src/core_nhyd_atmos/Registry.xml)
===================================================================
--- branches/mpas_cdg_advection/src/core_nhyd_atmos/Registry.xml (rev 0)
+++ branches/mpas_cdg_advection/src/core_nhyd_atmos/Registry.xml 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,1005 @@
+<?xml version="1.0"?>
+<registry model="mpas" core="nhyd_atmos" version="0.0.0">
+
+<!-- **************************************************************************************** -->
+<!-- ************************************** Dimensions ************************************** -->
+<!-- **************************************************************************************** -->
+
+ <dims>
+ <dim name="nCells"/>
+ <dim name="nEdges"/>
+ <dim name="maxEdges"/>
+ <dim name="maxEdges2"/>
+ <dim name="nVertices"/>
+ <dim name="TWO" definition="2"/>
+ <dim name="THREE" definition="3"/>
+ <dim name="vertexDegree"/>
+ <dim name="FIFTEEN" definition="15"/>
+ <dim name="TWENTYONE" definition="21"/>
+ <dim name="R3" definition="3"/>
+ <dim name="nVertLevels"/>
+ <dim name="nVertLevelsP1" definition="nVertLevels+1"/>
+ <dim name="nMonths" definition="namelist:months"/>
+ <dim name="nSoilLevels" definition="namelist:num_soil_layers"/>
+ <dim name="nLags" definition="namelist:input_soil_temperature_lag"/>
+ <dim name="nOznLevels" definition="namelist:noznlev"/>
+ <dim name="nAerLevels" definition="namelist:naerlev"/>
+ <dim name="cam_dim1" definition="namelist:camdim1"/>
+ <dim name="nVertLevelsP2" definition="nVertLevels+2"/>
+ </dims>
+
+
+<!-- **************************************************************************************** -->
+<!-- ************************************** Namelists *************************************** -->
+<!-- **************************************************************************************** -->
+
+ <nml_record name="nhyd_model">
+ <nml_option name="config_time_integration" type="character" default_value="SRK3"/>
+ <nml_option name="config_dt" type="real" default_value="600.0"/>
+ <nml_option name="config_calendar_type" type="character" default_value="gregorian"/>
+ <nml_option name="config_start_time" type="character" default_value="0000-01-01_00:00:00"/>
+ <nml_option name="config_stop_time" type="character" default_value="none"/>
+ <nml_option name="config_run_duration" type="character" default_value="none"/>
+ <nml_option name="config_sfc_update_interval" type="character" default_value="none"/>
+ <nml_option name="config_horiz_mixing" type="character" default_value="2d_smagorinsky"/>
+ <nml_option name="config_h_mom_eddy_visc2" type="real" default_value="0.0"/>
+ <nml_option name="config_h_mom_eddy_visc4" type="real" default_value="0.0"/>
+ <nml_option name="config_v_mom_eddy_visc2" type="real" default_value="0.0"/>
+ <nml_option name="config_h_theta_eddy_visc2" type="real" default_value="0.0"/>
+ <nml_option name="config_h_theta_eddy_visc4" type="real" default_value="0.0"/>
+ <nml_option name="config_v_theta_eddy_visc2" type="real" default_value="0.0"/>
+ <nml_option name="config_visc4_2dsmag" type="real" default_value="0.0"/>
+ <nml_option name="config_del4u_div_factor" type="real" default_value="1.0"/>
+ <nml_option name="config_number_of_sub_steps" type="integer" default_value="4"/>
+ <nml_option name="config_w_adv_order" type="integer" default_value="3"/>
+ <nml_option name="config_theta_adv_order" type="integer" default_value="3"/>
+ <nml_option name="config_scalar_adv_order" type="integer" default_value="3"/>
+ <nml_option name="config_u_vadv_order" type="integer" default_value="3"/>
+ <nml_option name="config_w_vadv_order" type="integer" default_value="3"/>
+ <nml_option name="config_theta_vadv_order" type="integer" default_value="3"/>
+ <nml_option name="config_scalar_vadv_order" type="integer" default_value="3"/>
+ <nml_option name="config_coef_3rd_order" type="real" default_value="0.25"/>
+ <nml_option name="config_scalar_advection" type="logical" default_value="true"/>
+ <nml_option name="config_positive_definite" type="logical" default_value="false"/>
+ <nml_option name="config_monotonic" type="logical" default_value="true"/>
+ <nml_option name="config_mix_full" type="logical" default_value="true"/>
+ <nml_option name="config_len_disp" type="real" default_value="120000.0"/>
+ <nml_option name="config_epssm" type="real" default_value="0.1"/>
+ <nml_option name="config_smdiv" type="real" default_value="0.1"/>
+ <nml_option name="config_newpx" type="logical" default_value="false"/>
+ <nml_option name="config_apvm_upwinding" type="real" default_value="0.5"/>
+ <nml_option name="config_h_ScaleWithMesh" type="logical" default_value="true"/>
+ <nml_option name="config_num_halos" type="integer" default_value="2"/>
+ </nml_record>
+
+ <nml_record name="damping">
+ <nml_option name="config_zd" type="real" default_value="22000.0"/>
+ <nml_option name="config_xnutr" type="real" default_value="0.0"/>
+ </nml_record>
+
+ <nml_record name="io">
+ <nml_option name="config_input_name" type="character" default_value="init.nc"/>
+ <nml_option name="config_sfc_update_name" type="character" default_value="sfc_update.nc"/>
+ <nml_option name="config_output_name" type="character" default_value="output.nc"/>
+ <nml_option name="config_restart_name" type="character" default_value="restart.nc"/>
+ <nml_option name="config_output_interval" type="character" default_value="06:00:00"/>
+ <nml_option name="config_frames_per_outfile" type="integer" default_value="0"/>
+ <nml_option name="config_pio_num_iotasks" type="integer" default_value="0"/>
+ <nml_option name="config_pio_stride" type="integer" default_value="1"/>
+ <nml_option name="config_pio_format" type="character" default_value="pnetcdf"/>
+ </nml_record>
+
+ <nml_record name="decomposition">
+ <nml_option name="config_block_decomp_file_prefix" type="character" default_value="graph.info.part."/>
+ <nml_option name="config_number_of_blocks" type="integer" default_value="0"/>
+ <nml_option name="config_explicit_proc_decomp" type="logical" default_value="false"/>
+ <nml_option name="config_proc_decomp_file_prefix" type="character" default_value="graph.info.part."/>
+ </nml_record>
+
+ <nml_record name="restart">
+ <nml_option name="config_do_restart" type="logical" default_value="false"/>
+ <nml_option name="config_do_DAcycling" type="logical" default_value="false"/>
+ <nml_option name="config_restart_interval" type="character" default_value="none"/>
+ </nml_record>
+
+
+<!-- **************************************************************************************** -->
+<!-- ************************************** Variables *************************************** -->
+<!-- **************************************************************************************** -->
+
+ <var_struct name="mesh" time_levs="0">
+
+ <!-- horizontal grid structure -->
+ <var name="latCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="lonCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="xCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="yCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="zCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="indexToCellID" type="integer" dimensions="nCells" streams="iro"/>
+ <var name="latEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="lonEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="xEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="yEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="zEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="indexToEdgeID" type="integer" dimensions="nEdges" streams="iro"/>
+ <var name="latVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="lonVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="xVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="yVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="zVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="indexToVertexID" type="integer" dimensions="nVertices" streams="iro"/>
+ <var name="cellsOnEdge" type="integer" dimensions="TWO nEdges" streams="iro"/>
+ <var name="nEdgesOnCell" type="integer" dimensions="nCells" streams="iro"/>
+ <var name="nEdgesOnEdge" type="integer" dimensions="nEdges" streams="iro"/>
+ <var name="edgesOnCell" type="integer" dimensions="maxEdges nCells" streams="iro"/>
+ <var name="edgesOnEdge" type="integer" dimensions="maxEdges2 nEdges" streams="iro"/>
+ <var name="weightsOnEdge" type="real" dimensions="maxEdges2 nEdges" streams="iro"/>
+ <var name="dvEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="dcEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="angleEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="areaCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="areaTriangle" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="edgeNormalVectors" type="real" dimensions="R3 nEdges" streams="iro"/>
+ <var name="localVerticalUnitVectors" type="real" dimensions="R3 nCells" streams="iro"/>
+ <var name="cellTangentPlane" type="real" dimensions="R3 TWO nCells" streams="iro"/>
+ <var name="cellsOnCell" type="integer" dimensions="maxEdges nCells" streams="iro"/>
+ <var name="verticesOnCell" type="integer" dimensions="maxEdges nCells" streams="iro"/>
+ <var name="verticesOnEdge" type="integer" dimensions="TWO nEdges" streams="iro"/>
+ <var name="edgesOnVertex" type="integer" dimensions="vertexDegree nVertices" streams="iro"/>
+ <var name="cellsOnVertex" type="integer" dimensions="vertexDegree nVertices" streams="iro"/>
+ <var name="kiteAreasOnVertex" type="real" dimensions="vertexDegree nVertices" streams="iro"/>
+ <var name="fEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="fVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="meshDensity" type="real" dimensions="nCells" streams="iro"/>
+ <var name="meshScalingDel2" type="real" dimensions="nEdges" streams="ro"/>
+ <var name="meshScalingDel4" type="real" dimensions="nEdges" streams="ro"/>
+
+ <!-- coefficients for vertical extrapolation to the surface -->
+ <var name="cf1" type="real" dimensions="" streams="iro"/>
+ <var name="cf2" type="real" dimensions="" streams="iro"/>
+ <var name="cf3" type="real" dimensions="" streams="iro"/>
+
+ <!-- coefficients used by "newpx" horizontal pressure gradient option -->
+ <var name="cpr" type="real" dimensions="THREE nEdges" streams="ro"/>
+ <var name="cpl" type="real" dimensions="THREE nEdges" streams="ro"/>
+
+ <!-- description of the vertical grid structure -->
+ <var name="hx" type="real" dimensions="nVertLevelsP1 nCells" streams="iro"/>
+ <var name="zgrid" type="real" dimensions="nVertLevelsP1 nCells" streams="iro"/>
+ <var name="rdzw" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="dzu" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="rdzu" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="fzm" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="fzp" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="zx" type="real" dimensions="nVertLevelsP1 nEdges" streams="iro"/>
+ <var name="zz" type="real" dimensions="nVertLevelsP1 nCells" streams="iro"/>
+ <var name="zb" type="real" dimensions="nVertLevelsP1 TWO nEdges" streams="iro"/>
+ <var name="zb3" type="real" dimensions="nVertLevelsP1 TWO nEdges" streams="iro"/>
+ <var name="pzm" type="real" dimensions="nVertLevels nCells" streams="r"/>
+ <var name="pzp" type="real" dimensions="nVertLevels nCells" streams="r"/>
+
+ <!-- W-Rayleigh damping coefficients -->
+ <var name="dss" type="real" dimensions="nVertLevels nCells" streams="iro"/>
+
+ <var name="u_init" type="real" dimensions="nVertLevels" streams="iro"/>
+ <var name="t_init" type="real" dimensions="nVertLevels nCells" streams="iro"/>
+ <var name="qv_init" type="real" dimensions="nVertLevels" streams="iro"/>
+
+ <!-- Space needed for advection -->
+ <var name="deriv_two" type="real" dimensions="FIFTEEN TWO nEdges" streams="ir"/>
+ <var name="advCells" type="integer" dimensions="TWENTYONE nCells" streams="ir"/>
+ <var name="adv_coefs" type="real" dimensions="FIFTEEN nEdges"/>
+ <var name="adv_coefs_3rd" type="real" dimensions="FIFTEEN nEdges"/>
+ <var name="advCellsForEdge" type="integer" dimensions="FIFTEEN nEdges"/>
+ <var name="nAdvCellsForEdge" type="integer" dimensions="nEdges"/>
+
+ <!-- Space needed for deformation calculation weights -->
+ <var name="defc_a" type="real" dimensions="maxEdges nCells" streams="iro"/>
+ <var name="defc_b" type="real" dimensions="maxEdges nCells" streams="iro"/>
+
+ <!-- Arrays required for reconstruction of velocity field -->
+ <var name="coeffs_reconstruct" type="real" dimensions="R3 maxEdges nCells" streams="iro"/>
+ <var name="east" type="real" dimensions="R3 nCells" streams="r"/>
+ <var name="north" type="real" dimensions="R3 nCells" streams="r"/>
+
+ <!-- Arrays needed only in the CAM LW and SW radiation codes: Ozone -->
+ <var name="pin" type="real" dimensions="nOznLevels nCells"/>
+ <var name="ozmixm" type="real" dimensions="nMonths nOznLevels nCells"/>
+
+ <!-- Arrays needed only in the CAM LW and SW radiation codes: Aerosols -->
+ <var name="m_hybi" type="real" dimensions="nAerLevels nCells"/>
+ </var_struct>
+
+ <var_struct name="state" time_levs="2">
+
+ <var name="xtime" type="text" dimensions="Time" streams="iro"/>
+
+ <!-- Prognostic variables: read from input, saved in restart, and written to output -->
+ <var name="u" type="real" dimensions="nVertLevels nEdges Time" streams="iro"/>
+ <var name="w" type="real" dimensions="nVertLevelsP1 nCells Time" streams="iro"/>
+ <var name="rho_zz" type="real" dimensions="nVertLevels nCells Time" streams="r"/>
+ <var name="theta_m" type="real" dimensions="nVertLevels nCells Time" streams="r"/>
+ <var name="m_ps" type="real" dimensions="nCells Time"/>
+ <var_array name="scalars" type="real" dimensions="nVertLevels nCells Time">
+ <var name="qv" array_group="moist" streams="iro"/>
+ <var name="qc" array_group="moist" streams="iro"/>
+ <var name="qr" array_group="moist" streams="iro"/>
+ <var name="qi" array_group="moist" streams="iro"/>
+ <var name="qs" array_group="moist" streams="iro"/>
+ <var name="qg" array_group="moist" streams="iro"/>
+ <var name="qnr" array_group="number" streams="iro"/>
+ <var name="qni" array_group="number" streams="iro"/>
+ </var_array>
+
+ <var_array name="aerosols" type="real" dimensions="nAerLevels nCells Time">
+ <var name="sul" array_group="aer_cam"/>
+ <var name="sslt" array_group="aer_cam"/>
+ <var name="dust1" array_group="aer_cam"/>
+ <var name="dust2" array_group="aer_cam"/>
+ <var name="dust3" array_group="aer_cam"/>
+ <var name="dust4" array_group="aer_cam"/>
+ <var name="ocpho" array_group="aer_cam"/>
+ <var name="bcpho" array_group="aer_cam"/>
+ <var name="ocphi" array_group="aer_cam"/>
+ <var name="bcphi" array_group="aer_cam"/>
+ <var name="bg" array_group="aer_cam"/>
+ <var name="volc" array_group="aer_cam"/>
+ </var_array>
+ </var_struct>
+
+ <var_struct name="diag" time_levs="1">
+
+ <!-- coefficients for the vertical tridiagonal solve -->
+ <!-- Note: these could be local but... -->
+ <var name="cofrz" type="real" dimensions="nVertLevels Time"/>
+ <var name="cofwr" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="cofwz" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="coftz" type="real" dimensions="nVertLevelsP1 nCells Time"/>
+ <var name="cofwt" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="a_tri" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="alpha_tri" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="gamma_tri" type="real" dimensions="nVertLevels nCells Time"/>
+
+ <!-- state variables diagnosed from prognostic state -->
+ <var name="pressure_p" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+
+ <!-- Diagnostic fields: only written to output -->
+ <!-- NOTE: added the "r" option to rho,theta,uReconstructZonal,and uReconstructMeridional for use of the -->
+ <!-- non-hydrostatic dynamical core in a data assimilation framework. NOTE that the "r" option is not -->
+ <!-- needed for those 4 variables to get bit for bit restart capabilities, otherwise. -->
+ <var name="rho" type="real" dimensions="nVertLevels nCells Time" streams="iro"/>
+ <var name="theta" type="real" dimensions="nVertLevels nCells Time" streams="iro"/>
+ <var name="rh" type="real" dimensions="nVertLevels nCells Time" streams="iro"/>
+ <var name="v" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="divergence" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="vorticity" type="real" dimensions="nVertLevels nVertices Time" streams="o"/>
+ <var name="pv_edge" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="rho_edge" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="ke" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="pv_vertex" type="real" dimensions="nVertLevels nVertices Time" streams="o"/>
+ <var name="pv_cell" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+
+ <!-- reconstructed horizontal velocity vectors at cell centers -->
+ <var name="uReconstructX" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructY" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructZ" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructZonal" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="uReconstructMeridional" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+
+ <!-- Other diagnostic variables -->
+ <var name="rv" type="real" dimensions="nVertLevels nEdges Time" streams="r"/>
+ <var name="circulation" type="real" dimensions="nVertLevels nVertices Time" streams="r"/>
+ <var name="gradPVt" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="gradPVn" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="h_divergence" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+
+ <var name="exner" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="exner_base" type="real" dimensions="nVertLevels nCells Time" streams="iro"/>
+ <var name="rtheta_base" type="real" dimensions="nVertLevels nCells Time" streams="r"/>
+ <var name="pressure_base" type="real" dimensions="nVertLevels nCells Time" streams="iro"/>
+ <var name="rho_base" type="real" dimensions="nVertLevels nCells Time" streams="iro"/>
+ <var name="theta_base" type="real" dimensions="nVertLevels nCells Time" streams="iro"/>
+
+ <var name="ruAvg" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="wwAvg" type="real" dimensions="nVertLevelsP1 nCells Time"/>
+ <var name="cqu" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="cqw" type="real" dimensions="nVertLevels nCells Time"/>
+
+ <!-- coupled variables needed by solver, but not output -->
+ <var name="ru" type="real" dimensions="nVertLevels nEdges Time" streams="r"/>
+ <var name="ru_p" type="real" dimensions="nVertLevels nEdges Time" streams="r"/>
+ <var name="ru_save" type="real" dimensions="nVertLevels nEdges Time"/>
+
+ <var name="rw" type="real" dimensions="nVertLevelsP1 nCells Time" streams="r"/>
+ <var name="rw_p" type="real" dimensions="nVertLevelsP1 nCells Time" streams="r"/>
+ <var name="rw_save" type="real" dimensions="nVertLevelsP1 nCells Time"/>
+
+ <var name="rtheta_p" type="real" dimensions="nVertLevels nCells Time" streams="r"/>
+ <var name="rtheta_pp" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="rtheta_p_save" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="rtheta_pp_old" type="real" dimensions="nVertLevels nCells Time"/>
+
+ <var name="rho_p" type="real" dimensions="nVertLevels nCells Time" streams="r"/>
+ <var name="rho_pp" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="rho_p_save" type="real" dimensions="nVertLevels nCells Time"/>
+
+ <var name="kdiff" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+
+ <var name="surface_pressure" type="real" dimensions="nCells Time" streams="iro"/>
+
+ <var name="temperature_200hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="temperature_500hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="temperature_850hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="height_200hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="height_500hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="height_850hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="uzonal_200hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="uzonal_500hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="uzonal_850hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="umeridional_200hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="umeridional_500hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="umeridional_850hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="w_200hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="w_500hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="w_850hPa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="vorticity_200hPa" type="real" dimensions="nVertices Time" streams="o"/>
+ <var name="vorticity_500hPa" type="real" dimensions="nVertices Time" streams="o"/>
+ <var name="vorticity_850hPa" type="real" dimensions="nVertices Time" streams="o"/>
+ </var_struct>
+
+ <var_struct name="tend" time_levs="1">
+
+
+ <!-- tendencies for prognostic variables -->
+ <var name="tend_u" name_in_code="u" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="tend_w" name_in_code="w" type="real" dimensions="nVertLevelsP1 nCells Time" streams="o"/>
+ <var name="tend_rho" name_in_code="rho_zz" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="tend_theta" name_in_code="theta_m" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="rt_diabatic_tend" type="real" dimensions="nVertLevels nCells Time" streams="r"/>
+ <var name="euler_tend_u" name_in_code="u_euler" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="euler_tend_w" name_in_code="w_euler" type="real" dimensions="nVertLevelsP1 nCells Time"/>
+ <var name="euler_tend_theta" name_in_code="theta_euler" type="real" dimensions="nVertLevels nCells Time"/>
+
+ <!-- scalar tendencies -->
+ <var_array name="scalars" type="real" dimensions="nVertLevels nCells Time">
+ <var name="tend_qv" name_in_code="qv" array_group="moist" streams="o"/>
+ <var name="tend_qc" name_in_code="qc" array_group="moist" streams="o"/>
+ <var name="tend_qr" name_in_code="qr" array_group="moist" streams="o"/>
+ <var name="tend_qi" name_in_code="qi" array_group="moist" streams="o"/>
+ <var name="tend_qs" name_in_code="qs" array_group="moist" streams="o"/>
+ <var name="tend_qg" name_in_code="qg" array_group="moist" streams="o"/>
+ <var name="tend_qnr" name_in_code="qnr" array_group="number" streams="o"/>
+ <var name="tend_qni" name_in_code="qni" array_group="number" streams="o"/>
+ </var_array>
+ </var_struct>
+
+
+
+<!-- ================================================================================================== -->
+<!-- DECLARATIONS OF ALL PHYSICS VARIABLES (will need to be moved to a Physics Registry shared by the -->
+<!-- hydrostatic and non-hydrostatic dynamical cores): -->
+<!-- ================================================================================================== -->
+
+
+ <nml_record name="physics">
+ <!-- NAMELIST VARIABLES ADDED FOR INITIALIZATION OF SURFACE CHARACTERISTICS: -->
+ <nml_option name="input_landuse_data" type="character" default_value="USGS"/>
+ <nml_option name="input_soil_data" type="character" default_value="STAS"/>
+ <nml_option name="input_soil_temperature_lag" type="integer" default_value="140"/>
+ <nml_option name="num_soil_layers" type="integer" default_value="4"/>
+ <nml_option name="months" type="integer" default_value="12"/>
+
+ <!-- ... DIMENSION NEEDED FOR OZONE AND AEROSOLS CONCENTRATIONS IN THE CAM LONGWAVE AND SHORTWAVE -->
+ <!-- ... RADIATION PARAMETERIZATIONS. -->
+ <nml_option name="noznlev" type="integer" default_value="59"/>
+ <nml_option name="naerlev" type="integer" default_value="29"/>
+ <nml_option name="camdim1" type="integer" default_value="4"/>
+
+ <!-- NAMELIST VARIABLES ADDED FOR PHYSICS CONFIGURATION: -->
+ <nml_option name="config_frac_seaice" type="logical" default_value="false"/>
+ <nml_option name="config_sfc_albedo" type="logical" default_value="false"/>
+ <nml_option name="config_sfc_snowalbedo" type="logical" default_value="false"/>
+ <nml_option name="config_sst_update" type="logical" default_value="false"/>
+ <nml_option name="config_sstdiurn_update" type="logical" default_value="false"/>
+ <nml_option name="config_deepsoiltemp_update" type="logical" default_value="false"/>
+
+ <nml_option name="config_n_physics" type="integer" default_value="1"/>
+ <nml_option name="config_n_microp" type="integer" default_value="1"/>
+ <nml_option name="config_n_conv" type="integer" default_value="1"/>
+ <nml_option name="config_n_pbl" type="integer" default_value="1"/>
+ <nml_option name="config_n_lsm" type="integer" default_value="1"/>
+ <nml_option name="config_n_eddy" type="integer" default_value="1"/>
+ <nml_option name="config_n_radt_lw" type="integer" default_value="1"/>
+ <nml_option name="config_n_radt_sw" type="integer" default_value="1"/>
+
+ <nml_option name="config_radtlw_interval" type="character" default_value="none"/>
+ <nml_option name="config_radtsw_interval" type="character" default_value="none"/>
+ <nml_option name="config_conv_interval" type="character" default_value="none"/>
+ <nml_option name="config_pbl_interval" type="character" default_value="none"/>
+ <nml_option name="config_camrad_abs_update" type="character" default_value="06:00:00"/>
+ <nml_option name="config_greeness_update" type="character" default_value="24:00:00"/>
+ <nml_option name="config_bucket_update" type="character" default_value="none"/>
+
+ <nml_option name="config_microp_scheme" type="character" default_value="off"/>
+ <nml_option name="config_conv_shallow_scheme" type="character" default_value="off"/>
+ <nml_option name="config_conv_deep_scheme" type="character" default_value="off"/>
+ <nml_option name="config_eddy_scheme" type="character" default_value="off"/>
+ <nml_option name="config_lsm_scheme" type="character" default_value="off"/>
+ <nml_option name="config_pbl_scheme" type="character" default_value="off"/>
+ <nml_option name="config_gwdo_scheme" type="character" default_value="off"/>
+ <nml_option name="config_radt_cld_scheme" type="character" default_value="off"/>
+ <nml_option name="config_radt_lw_scheme" type="character" default_value="off"/>
+ <nml_option name="config_radt_sw_scheme" type="character" default_value="off"/>
+ <nml_option name="config_sfclayer_scheme" type="character" default_value="off"/>
+
+ <nml_option name="config_bucket_radt" type="real" default_value="0.0_RKIND"/>
+ <nml_option name="config_bucket_rainc" type="real" default_value="0.0_RKIND"/>
+ <nml_option name="config_bucket_rainnc" type="real" default_value="0.0_RKIND"/>
+ </nml_record>
+
+ <var_struct name="diag_physics" time_levs="1">
+
+ <!-- ================================================================================================= -->
+ <!-- ... ARRAYS AND VARIABLES FOR UPDATING THE DEEP SOIL TEMPERATURE: -->
+ <!-- ================================================================================================= -->
+ <!-- nsteps_accum: number of accumulated time-step in a day. -->
+ <!-- ndays_accum : number of accumulated days in a year. -->
+ <!-- tlag : daily mean surface temperature of prior days [K] -->
+ <!-- tday_accum : accumulated daily surface temperature for current day [K] -->
+ <!-- tyear_mean : annual mean surface temperature [K] -->
+ <!-- tyear_accum : accumulated yearly surface temperature for current year [K] -->
+
+ <var name="nsteps_accum" type="real" dimensions="nCells Time" streams="r"/>
+ <var name="ndays_accum" type="real" dimensions="nCells Time" streams="r"/>
+
+ <var name="tlag" type="real" dimensions="nLags nCells Time" streams="r"/>
+ <var name="tday_accum" type="real" dimensions="nCells Time" streams="r"/>
+ <var name="tyear_mean" type="real" dimensions="nCells Time" streams="r"/>
+ <var name="tyear_accum" type="real" dimensions="nCells Time" streams="r"/>
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... PARAMETERIZATION OF CLOUD MICROPHYSICS: -->
+ <!-- ================================================================================================== -->
+ <!-- i_rainnc : counter related to how often rainnc is being reset relative to its bucket value (-) -->
+ <!-- rainnc : accumulated total time-step grid-scale precipitation (mm) -->
+ <!-- rainncv : time-step total grid-scale precipitation (mm) -->
+ <!-- snownc : accumulated grid-scale precipitation of snow (mm) -->
+ <!-- snowncv : time-step grid-scale precipitation of snow (mm) -->
+ <!-- graupelnc : accumulated grid-scale precipitation of graupel (mm) -->
+ <!-- graupelncv: time-step grid-scale precipitation of graupel (mm) -->
+ <!-- sr : time-step ratio of frozen versus total grid-scale precipitation (-) -->
+ <!-- precipw : precipitable water (kg/m2) -->
+ <!-- refl10cm_max: maximum column reflectivity (dBz) -->
+
+ <var name="refl10cm_max" type="real" dimensions="nCells Time" streams="ro"/>
+
+ <var name="i_rainnc" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="sr" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="rainncv" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="snowncv" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="graupelncv" type="real" dimensions="nCells Time" streams="o"/>
+
+ <var name="rainnc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="snownc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="graupelnc" type="real" dimensions="nCells Time" streams="ro"/>
+
+ <var name="precipw" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="qsat" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="relhum" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+
+ <!-- ================================================================================================== -->
+ <!-- ... PARAMETERIZATION OF CONVECTION: -->
+ <!-- ================================================================================================== -->
+ <!-- i_rainc : counter related to how often rainc is begin reset relative to its bucket value (-) -->
+ <!-- cuprec : convective precipitation rate (mm/s) -->
+ <!-- rainc : accumulated time-step convective precipitation (mm) -->
+ <!-- raincv : time-step convective precipitation (mm) -->
+
+ <var name="i_rainc" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="cuprec" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="rainc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="raincv" type="real" dimensions="nCells Time" streams="ro"/>
+
+ <!-- ... KAIN_FRITSCH: -->
+ <!-- cubot : lowest level of convection (-) -->
+ <!-- cutop : highest level of convection (-) -->
+ <!-- nca : relaxation time for KF parameterization of convection (s) -->
+ <!-- wavg0 : average vertical velocity (KF scheme only) (m s-1) -->
+
+ <var name="nca" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="cubot" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="cutop" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="w0avg" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... PARAMETERIZATION OF PLANETARY BOUNDARY LAYER PROCESSES: -->
+ <!-- ================================================================================================== -->
+ <!-- kpbl : index of PBL top (-) -->
+ <!-- hpbl : PBL height (m) -->
+ <!-- exch_h : exchange coefficient (-) -->
+
+ <var name="kpbl" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="hpbl" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="exch_h" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+
+ <!-- TEMPORARY: -->
+ <var name="kzh" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="kzm" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="kzq" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... PARAMETERIZATION OF SURFACE LAYER PROCESSES: -->
+ <!-- ================================================================================================== -->
+ <!-- br :bulk richardson number [-] -->
+ <!-- cd :drag coefficient at 10m [-] -->
+ <!-- cda :drag coefficient at lowest model level [-] -->
+ <!-- chs :??? -->
+ <!-- chs2 :??? -->
+ <!-- cqs2 :??? -->
+ <!-- ck :enthalpy exchange coefficient at 10 m [-] -->
+ <!-- cka :enthalpy exchange coefficient at lowest model level [-] -->
+ <!-- cpm :??? -->
+ <!-- flhc :exchange coefficient for heat [-] -->
+ <!-- flqc :exchange coefficient for moisture [-] -->
+ <!-- gz1oz0 :log of z1 over z0 [-] -->
+ <!-- hfx :upward heat flux at the surface [W/m2/s] -->
+ <!-- lh :latent heat flux at the surface [W/m2] -->
+ <!-- mavail :surface moisture availability [-] -->
+ <!-- mol :T* in similarity theory [K] -->
+ <!-- psih :similarity theory for heat [-] -->
+ <!-- psim :similarity theory for momentum [-] -->
+ <!-- qfx :upward moisture flux at the surface [kg/m2/s] -->
+ <!-- qgh :??? -->
+ <!-- qsfc :specific humidity at lower boundary [kg/kg] -->
+ <!-- regime :flag indicating PBL regime (stable_p,unstable_p,etc...) [-] -->
+ <!-- rmol :1 / Monin Ob length [-] -->
+ <!-- ust :u* in similarity theory [m/s] -->
+ <!-- ustm :u* in similarity theory without vconv [m/s] -->
+ <!-- zol :z/L height over Monin-Obukhov length [-] -->
+ <!-- znt :time-varying roughness length [m] -->
+ <!-- wspd :wind speed [m/s] -->
+ <!-- fh :integrated function for heat [-] -->
+ <!-- fm :integrated function for momentum [-] -->
+ <!-- DIAGNOSTICS: -->
+ <!-- q2 :specific humidity at 2m [kg/kg] -->
+ <!-- u10 :u at 10 m [m/s] -->
+ <!-- v10 :v at 10 m [m/s] -->
+ <!-- t2m :temperature at 2m [K] -->
+ <!-- th2m :potential temperature at 2m [K] -->
+
+ <var name="hfx" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="mavail" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="mol" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="qfx" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="qsfc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="ust" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="ustm" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="zol" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="znt" type="real" dimensions="nCells Time" streams="ro"/>
+
+ <var name="br" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="cd" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="cda" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="chs" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="chs2" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="cqs2" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="ck" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="cka" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="cpm" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="flhc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="flqc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="gz1oz0" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="lh" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="psim" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="psih" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="qgh" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="regime" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="rmol" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="wspd" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="fh" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="fm" type="real" dimensions="nCells Time" streams="ro"/>
+
+ <!-- DIAGNOSTICS: -->
+ <var name="u10" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="v10" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="q2" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="t2m" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="th2m" type="real" dimensions="nCells Time" streams="ro"/>
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... PARAMETERIZATION OF GRAVITY WAVE DRAG OVER OROGRAPHY: -->
+ <!-- ================================================================================================== -->
+
+ <!-- dusfcg : vertically-integrated gravity wave drag over orography u-stress (Pa m s-1) -->
+ <!-- dvsfcg : vertically-integrated gravity wave drag over orography v-stress (Pa m s-1) -->
+ <!-- dtaux3d : gravity wave drag over orography u-stress (m s-1) -->
+ <!-- dtauy3d : gravity wave drag over orography v-stress (m s-1) -->
+
+ <var name="dusfcg" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="dvsfcg" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="dtaux3d" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="dtauy3d" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+
+ <var name="rubldiff" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rvbldiff" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... PARAMETERIZATION OF SHORTWAVE RADIATION: -->
+ <!-- ================================================================================================== -->
+ <!-- coszr :cosine of the solar zenith angle [-] -->
+ <!-- gsw :net shortwave flux at surface [W m-2] -->
+ <!-- swcf :shortwave cloud forcing at top-of-atmosphere [W m-2] -->
+ <!-- swdnb :all-sky downwelling shortwave flux at bottom-of-atmosphere [W m-2] -->
+ <!-- swdnbc :clear-sky downwelling shortwave flux at bottom-of-atmosphere [W m-2] -->
+ <!-- swdnt :all-sky downwelling shortwave flux at top-of-atmosphere [W m-2] -->
+ <!-- swdntc :clear-sky downwelling shortwave flux at top-of-atmosphere [W m-2] -->
+ <!-- swupb :all-sky upwelling shortwave flux at bottom-of-atmosphere [W m-2] -->
+ <!-- swupbc :clear-sky upwelling shortwave flux at bottom-of-atmosphere [W m-2] -->
+ <!-- swupt :all-sky upwelling shortwave flux at top-of-atmosphere [W m-2] -->
+ <!-- swuptc :clear-sky upwelling shortwave flux at top-of-atmosphere [W m-2] -->
+ <!-- acswdnb :accumulated all-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2] -->
+ <!-- acswdnbc :accumulated clear-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2] -->
+ <!-- acswdnt :accumulated all-sky downwelling shortwave flux at top-of-atmosphere [J m-2] -->
+ <!-- acswdntc :accumulated clear-sky downwelling shortwave flux at top-of-atmosphere [J m-2] -->
+ <!-- acswupb :accumulated all-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2] -->
+ <!-- acswupbc :accumulated clear-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2] -->
+ <!-- acswupt :accumulated all-sky upwelling shortwave flux at top-of-atmosphere [J m-2] -->
+ <!-- acswuptc :accumulated clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2] -->
+ <!-- swdnflx : -->
+ <!-- swdnflxc : -->
+ <!-- swupflx : -->
+ <!-- swupflxc : -->
+
+ <!-- i_acswdnb : counter related to how often swdnb is begin reset relative to its bucket value (-) -->
+ <!-- i_acswdnbc: counter related to how often swdnbc is begin reset relative to its bucket value (-) -->
+ <!-- i_acswdnt : counter related to how often swdnt is begin reset relative to its bucket value (-) -->
+ <!-- i_acswdntc: counter related to how often swdntc is begin reset relative to its bucket value (-) -->
+ <!-- i_acswupb : counter related to how often swupb is begin reset relative to its bucket value (-) -->
+ <!-- i_acswupbc: counter related to how often swupbc is begin reset relative to its bucket value (-) -->
+ <!-- i_acswupt : counter related to how often swupt is begin reset relative to its bucket value (-) -->
+ <!-- i_acswuptc: counter related to how often swuptc is begin reset relative to its bucket value (-) -->
+
+ <var name="i_acswdnb" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_acswdnbc" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_acswdnt" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_acswdntc" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_acswupb" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_acswupbc" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_acswupt" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_acswuptc" type="integer" dimensions="nCells Time" streams="ro"/>
+
+ <var name="coszr" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="swcf" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="swdnb" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="swdnbc" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="swdnt" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="swdntc" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="swupb" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="swupbc" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="swupt" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="swuptc" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="acswdnb" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="acswdnbc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="acswdnt" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="acswdntc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="acswupb" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="acswupbc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="acswupt" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="acswuptc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="gsw" type="real" dimensions="nCells Time" streams="ro"/>
+
+ <!-- RRTMG SW ONLY: -->
+ <var name="swdnflx" type="real" dimensions="nVertLevelsP2 nCells Time" streams="o"/>
+ <var name="swdnflxc" type="real" dimensions="nVertLevelsP2 nCells Time" streams="o"/>
+ <var name="swupflx" type="real" dimensions="nVertLevelsP2 nCells Time" streams="o"/>
+ <var name="swupflxc" type="real" dimensions="nVertLevelsP2 nCells Time" streams="o"/>
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... PARAMETERIZATION OF LONGWAVE RADIATION: -->
+ <!-- ================================================================================================== -->
+
+ <!-- note: glw is the same diagnostic as lwdnb and is used in the land-surface scheme for the calcula- -->
+ <!-- tion of the surface budget. glw is always an output argument to the subroutine rrtmg_lwrad. -->
+ <!-- in contrast,lwdnb is an optional ouput argument to the subroutine rrtmg_lwrad depending on -->
+ <!-- the presence of lwupt (or not). -->
+
+ <!-- nlrad :number of layers added above the model-top in the RRTMG lw radiation code [-] -->
+ <!-- plrad :pressure at model-top [Pa] -->
+ <!-- glw :all-sky downwelling longwave flux at bottom-of-atmosphere [W m-2] -->
+ <!-- lwcf :longwave cloud forcing at top-of-atmosphere [W m-2] -->
+ <!-- lwdnb :all-sky downwelling longwave flux at bottom-of-atmosphere [W m-2] -->
+ <!-- lwdnbc :clear-sky downwelling longwave flux at bottom-of-atmosphere [W m-2] -->
+ <!-- lwdnt :all-sky downwelling longwave flux at top-of-atmosphere [W m-2] -->
+ <!-- lwdntc :clear-sky downwelling longwave flux at top-of-atmosphere [W m-2] -->
+ <!-- lwupb :all-sky upwelling longwave flux at bottom-of-atmosphere [W m-2] -->
+ <!-- lwupbc :clear-sky upwelling longwave flux at bottom-of-atmosphere [W m-2] -->
+ <!-- lwupt :all-sky upwelling longwave flux at top-of-atmosphere [W m-2] -->
+ <!-- lwuptc :clear-sky upwelling longwave flux at top-of-atmosphere [W m-2] -->
+ <!-- aclwdnb :accumulated all-sky downwelling longwave flux at bottom-of-atmosphere [J m-2] -->
+ <!-- aclwdnbc :accumulated clear-sky downwelling longwave flux at bottom-of-atmosphere [J m-2] -->
+ <!-- aclwdnt :accumulated all-sky downwelling longwave flux at top-of-atmosphere [J m-2] -->
+ <!-- aclwdntc :accumulated clear-sky downwelling longwave flux at top-of-atmosphere [J m-2] -->
+ <!-- aclwupb :accumulated all-sky upwelling longwave flux at bottom-of-atmosphere [J m-2] -->
+ <!-- aclwupbc :accumulated clear-sky upwelling longwave flux at bottom-of-atmosphere [J m-2] -->
+ <!-- aclwupt :accumulated all-sky upwelling longwave flux at top-of-atmosphere [J m-2] -->
+ <!-- aclwuptc :accumulated clear-sky upwelling longwave flux at top-of-atmosphere [J m-2] -->
+ <!-- lwdnflx : -->
+ <!-- lwdnflxc : -->
+ <!-- lwupflx : -->
+ <!-- lwupflxc : -->
+ <!-- olrtoa :outgoing longwave radiation at top-of-the-atmosphere [W m-2] -->
+
+ <!-- i_aclwdnb : counter related to how often lwdnb is begin reset relative to its bucket value (-) -->
+ <!-- i_aclwdnbc: counter related to how often lwdnbc is begin reset relative to its bucket value (-) -->
+ <!-- i_aclwdnt : counter related to how often lwdnt is begin reset relative to its bucket value (-) -->
+ <!-- i_aclwdntc: counter related to how often lwdntc is begin reset relative to its bucket value (-) -->
+ <!-- i_aclwupb : counter related to how often lwupb is begin reset relative to its bucket value (-) -->
+ <!-- i_aclwupbc: counter related to how often lwupbc is begin reset relative to its bucket value (-) -->
+ <!-- i_aclwupt : counter related to how often lwupt is begin reset relative to its bucket value (-) -->
+ <!-- i_aclwuptc: counter related to how often lwuptc is begin reset relative to its bucket value (-) -->
+
+ <var name="nlrad" type="integer" dimensions="nCells Time" streams="o" />
+ <var name="plrad" type="real" dimensions="nCells Time" streams="o" />
+
+ <var name="i_aclwdnb" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_aclwdnbc" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_aclwdnt" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_aclwdntc" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_aclwupb" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_aclwupbc" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_aclwupt" type="integer" dimensions="nCells Time" streams="ro"/>
+ <var name="i_aclwuptc" type="integer" dimensions="nCells Time" streams="ro"/>
+
+ <var name="lwcf" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="lwdnb" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="lwdnbc" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="lwdnt" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="lwdntc" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="lwupb" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="lwupbc" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="lwupt" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="lwuptc" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="aclwdnb" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="aclwdnbc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="aclwdnt" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="aclwdntc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="aclwupb" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="aclwupbc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="aclwupt" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="aclwuptc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="olrtoa" type="real" dimensions="nCells Time" streams="o"/>
+ <var name="glw" type="real" dimensions="nCells Time" streams="ro"/>
+
+ <!-- ... RRTMG LW ONLY: -->
+ <!-- var name="lwdnflx" type="real" dimensions="nVertLevelsP2 nCells Time" streams="o" -->
+ <!-- var name="lwdnflxc" type="real" dimensions="nVertLevelsP2 nCells Time" streams="o" -->
+ <!-- var name="lwupflx" type="real" dimensions="nVertLevelsP2 nCells Time" streams="o" -->
+ <!-- var name="lwupflxc" type="real" dimensions="nVertLevelsP2 nCells Time" streams="o" -->
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... ADDITIONAL "RADIATION" ARRAYS NEEDED ONLY IN THE "CAM" LW AND SW RADIATION CODES: -->
+ <!-- ================================================================================================== -->
+
+ <!-- INFRARED ABSORPTION: -->
+ <var name="absnxt" type="real" dimensions="nVertLevels cam_dim1 nCells Time"/>
+ <var name="abstot" type="real" dimensions="nVertLevelsP1 nVertLevelsP1 nCells Time"/>
+ <var name="emstot" type="real" dimensions="nVertLevelsP1 nCells Time"/>
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... PARAMERIZATION OF CLOUDINESS: -->
+ <!-- ================================================================================================== -->
+ <var name="cldfrac" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... PARAMETERIZATION OF LAND-SURFACE SCHEME: -->
+ <!-- ================================================================================================== -->
+
+ <!-- acsnom :accumulated melted snow [kg m-2] -->
+ <!-- acsnow :accumulated snow [kg m-2] -->
+ <!-- canwat :canopy water [kg m-2] -->
+ <!-- chklowq :surface saturation flag [-] -->
+ <!-- grdflx :ground heat flux [W m-2] -->
+ <!-- lai :leaf area index [-] -->
+ <!-- noahres :residual of the noah land-surface scheme energy budget [W m-2] -->
+ <!-- potevp :potential evaporation [W m-2] -->
+ <!-- qz0 :specific humidity at znt [kg kg-1] -->
+ <!-- sfc_albedo :surface albedo [-] -->
+ <!-- sfc_embck :background emissivity [-] -->
+ <!-- sfc_emiss :surface emissivity [-] -->
+ <!-- sfcrunoff :surface runoff [m s-1] -->
+ <!-- smstav :moisture availability [-] -->
+ <!-- smstot :total moisture [m3 m-3] -->
+ <!-- snopcx :snow phase change heat flux [W m-2] -->
+ <!-- snotime :?? -->
+ <!-- sstsk : skin sea-surface temperature [K] -->
+ <!-- sstsk_dtc : skin sea-surface temperature cooling [K] -->
+ <!-- sstsk_dtw : skin sea-surface temperature warming [K] -->
+ <!-- thc :thermal inertia [Cal cm-1 K-1 s-0.5] -->
+ <!-- udrunoff :sub-surface runoff [m s-1] -->
+ <!-- xicem :ice mask from previous time-step [-] -->
+ <!-- z0 :background roughness length [m] -->
+ <!-- zs :depth of centers of soil layers [m] -->
+
+ <var name="acsnom" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="acsnow" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="canwat" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="chklowq" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="grdflx" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="lai" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="noahres" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="potevp" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="qz0" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="sfc_albedo" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="sfc_emiss" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="sfc_emibck" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="sfcrunoff" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="smstav" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="smstot" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="snopcx" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="snotime" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="sstsk" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="sstsk_dtc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="sstsk_dtw" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="thc" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="udrunoff" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="xicem" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="z0" type="real" dimensions="nCells Time" streams="ro"/>
+ <var name="zs" type="real" dimensions="nCells Time" streams="ro"/>
+ </var_struct>
+
+ <var_struct name="tend_physics" time_levs="1">
+
+ <!-- ================================================================================================== -->
+ <!-- TENDENCIES FROM PARAMETERIZATION OF CONVECTION: -->
+ <!-- ================================================================================================== -->
+ <!-- rthcuten : tendency of potential temperature due to cumulus convection (K s-1) -->
+ <!-- rqvcuten : tendency of water vapor mixing ratio due to cumulus convection (kg/kg s-1) -->
+ <!-- rqccuten : tendency of cloud water mixing ratio due to cumulus convection (kg/kg s-1) -->
+ <!-- rqicuten : tendency of cloud ice mixing ratio due to cumulus convection (kg/kg s-1) -->
+
+ <var name="rthcuten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rqvcuten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rqccuten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rqicuten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+
+ <!-- KAIN_FRITSCH -->
+ <!-- rqrcuten : tendency of rain mixing ratio due to cumulus convection (kg/kg s-1) -->
+ <!-- rqscuten : tendency of snow mixing ratio due to cumulus convection (kg/kg s-1) -->
+
+ <var name="rqrcuten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rqscuten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+
+ <!-- TIEDTKE -->
+ <!-- rucuten : tendency of zonal wind due to cumulus convection (m/s-1) -->
+ <!-- rvcuten : tendency of meridional wind due to cumulus convection (m/s-1) -->
+ <!-- rqvdynten : tendency of water vapor due to horizontal and vertical advections (kg/kg/s-1) -->
+ <var name="rqvdynten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rucuten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rvcuten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... TENDENCIES FROM PARAMETERIZATION OF PLANETARY BOUNDARY LAYER PROCESSES: -->
+ <!-- ================================================================================================== -->
+ <!-- rublten : tendency of zonal wind due to pbl processes (m s-1) -->
+ <!-- rvblten : tendency of meridional wind due to pbl processes (m s-1) -->
+ <!-- rthblten : tendency of potential temperature due to pbl processes (K s-1) -->
+ <!-- rqvblten : tendency of water vapor mixing ratio due to pbl processes (kg/kg s-1) -->
+ <!-- rqcblten : tendency of cloud water mixing ratio due to pbl processes (kg/kg s-1) -->
+ <!-- rqiblten : tendency of cloud ice mixing ratio due to pbl processes (kg/kg s-1) -->
+
+ <var name="rublten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rvblten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rthblten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rqvblten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rqcblten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rqiblten" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+
+
+ <!-- ================================================================================================== -->
+ <!-- ... TENDENCIES FROM PARAMETERIZATION OF LONGWAVE RADIATION: -->
+ <!-- ================================================================================================== -->
+ <!-- rthratensw:uncoupled theta tendency due to shortwave radiation [K s-1] -->
+ <!-- rthratenlw:uncoupled theta tendency due to longwave radiation [K s-1] -->
+
+ <var name="rthratensw" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ <var name="rthratenlw" type="real" dimensions="nVertLevels nCells Time" streams="ro"/>
+ </var_struct>
+
+ <var_struct name="sfc_input" time_levs="0">
+
+ <!-- ================================================================================================== -->
+ <!-- ... SURFACE CHARACTERISTICS THAT NEED TO BE READ FROM GRID.NC: -->
+ <!-- ================================================================================================== -->
+
+ <!-- albedo12m :monthly climatological albedo [-] -->
+ <!-- greenfrac :monthly climatological greeness fraction [-] -->
+ <!-- isltyp :dominant soil category [-] -->
+ <!-- ivgtyp :dominant vegetation category [-] -->
+ <!-- landmask :=0 for ocean;=1 for land [-] -->
+ <!-- sfc_albbck :background albedo [-] -->
+ <!-- shdmin :minimum areal fractional coverage of annual green vegetation [-] -->
+ <!-- shdmax :maximum areal fractional coverage of annual green vegetation [-] -->
+ <!-- skintemp :skin temperature [K] -->
+ <!-- snoalb :annual max snow albedo [-] -->
+ <!-- snow :snow water equivalent [kg m-2] -->
+ <!-- sst :sea-surface temperature [K] -->
+ <!-- snowc :flag indicating snow coverage (1 for snow cover) [-] -->
+ <!-- snowh :physical snow depth [m] -->
+ <!-- ter :terrain height [-] -->
+ <!-- tmn :soil temperature at lower boundary [K] -->
+ <!-- vegfra :vegetation fraction [-] -->
+ <!-- seaice :sea-ice mask (=1 when xice is greater than 0; =0 otherwise) [-] -->
+ <!-- xice :fractional sea-ice coverage [-] -->
+ <!-- xland :land mask (1 for land; 2 for water) [-] -->
+
+ <!-- dzs :thickness of soil layers [m] -->
+ <!-- smcrel :soil moisture threshold below which transpiration begins to stress [-] -->
+ <!-- sh2o :soil liquid water [m3 m-3] -->
+ <!-- smois :soil moisture [m3 m-3] -->
+ <!-- tslb :soil temperature [K] -->
+
+ <var name="isltyp" type="integer" dimensions="nCells" streams="iro"/>
+ <var name="ivgtyp" type="integer" dimensions="nCells" streams="iro"/>
+ <var name="landmask" type="integer" dimensions="nCells" streams="iro"/>
+ <var name="shdmin" type="real" dimensions="nCells" streams="iro"/>
+ <var name="shdmax" type="real" dimensions="nCells" streams="iro"/>
+ <var name="snoalb" type="real" dimensions="nCells" streams="iro"/>
+ <var name="ter" type="real" dimensions="nCells" streams="io"/>
+ <var name="albedo12m" type="real" dimensions="nMonths nCells" streams="iro"/>
+ <var name="greenfrac" type="real" dimensions="nMonths nCells" streams="iro"/>
+
+ <var name="sfc_albbck" type="real" dimensions="nCells Time" streams="iro"/>
+ <var name="skintemp" type="real" dimensions="nCells Time" streams="iro"/>
+ <var name="snow" type="real" dimensions="nCells Time" streams="iro"/>
+ <var name="snowc" type="real" dimensions="nCells Time" streams="iro"/>
+ <var name="snowh" type="real" dimensions="nCells Time" streams="iro"/>
+ <var name="sst" type="real" dimensions="nCells Time" streams="isro"/>
+ <var name="tmn" type="real" dimensions="nCells Time" streams="iro"/>
+ <var name="vegfra" type="real" dimensions="nCells Time" streams="iro"/>
+ <var name="seaice" type="real" dimensions="nCells Time" streams="iro"/>
+ <var name="xice" type="real" dimensions="nCells Time" streams="isro"/>
+ <var name="xland" type="real" dimensions="nCells Time" streams="iro"/>
+
+ <var name="dzs" type="real" dimensions="nSoilLevels nCells Time" streams="iro"/>
+ <var name="smcrel" type="real" dimensions="nSoilLevels nCells Time" streams="ro"/>
+ <var name="sh2o" type="real" dimensions="nSoilLevels nCells Time" streams="iro"/>
+ <var name="smois" type="real" dimensions="nSoilLevels nCells Time" streams="iro"/>
+ <var name="tslb" type="real" dimensions="nSoilLevels nCells Time" streams="iro"/>
+
+ <!-- ================================================================================================== -->
+ <!-- ... PARAMETERIZATION OF GRAVITY WAVE DRAG OVER OROGRAPHY: -->
+ <!-- ================================================================================================== -->
+
+ <!-- var2d : orographic variance (m2) -->
+ <!-- con : orographic convexity (m2) -->
+ <!-- oa1 : orographic direction asymmetry function (-) -->
+ <!-- oa2 : orographic direction asymmetry function (-) -->
+ <!-- oa3 : orographic direction asymmetry function (-) -->
+ <!-- oa4 : orographic direction asymmetry function (-) -->
+ <!-- ol1 : orographic direction asymmetry function (-) -->
+ <!-- ol2 : orographic direction asymmetry function (-) -->
+ <!-- ol3 : orographic direction asymmetry function (-) -->
+ <!-- ol4 : orographic direction asymmetry function (-) -->
+
+ <var name="var2d" type="real" dimensions="nCells" streams="iro"/>
+ <var name="con" type="real" dimensions="nCells" streams="iro"/>
+ <var name="oa1" type="real" dimensions="nCells" streams="iro"/>
+ <var name="oa2" type="real" dimensions="nCells" streams="iro"/>
+ <var name="oa3" type="real" dimensions="nCells" streams="iro"/>
+ <var name="oa4" type="real" dimensions="nCells" streams="iro"/>
+ <var name="ol1" type="real" dimensions="nCells" streams="iro"/>
+ <var name="ol2" type="real" dimensions="nCells" streams="iro"/>
+ <var name="ol3" type="real" dimensions="nCells" streams="iro"/>
+ <var name="ol4" type="real" dimensions="nCells" streams="iro"/>
+ </var_struct>
+</registry>
Modified: branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_advection.F
===================================================================
--- branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_advection.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_advection.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -26,43 +26,33 @@
! local variables
real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
- real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
real (kind=RKIND), dimension(grid % nCells) :: theta_abs
real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
- real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
- real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
+ real (kind=RKIND) :: xec, yec, zec
+ real (kind=RKIND) :: thetae_tmp
real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
- integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
+ integer :: i, j, k, ip1, ip2, n
integer :: iCell, iEdge
real (kind=RKIND) :: pii
- real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
- real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
- real (kind=RKIND) :: angv1, angv2, dl1, dl2
- real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp
+ real (kind=RKIND), dimension(25) :: xp, yp
real (kind=RKIND) :: amatrix(25,25), bmatrix(25,25), wmatrix(25,25)
real (kind=RKIND) :: length_scale
- integer :: ma,na, cell_add, mw, nn
+ integer :: ma,na, cell_add, mw
integer, dimension(25) :: cell_list
+ logical :: add_the_cell, do_the_cell
+ real (kind=RKIND) :: cos2t, costsint, sin2t
+ real (kind=RKIND), dimension(grid%maxEdges) :: angle_2d
- integer :: cell1, cell2
integer, parameter :: polynomial_order = 2
-! logical, parameter :: debug = .true.
logical, parameter :: debug = .false.
-! logical, parameter :: least_squares = .false.
logical, parameter :: least_squares = .true.
- logical :: add_the_cell, do_the_cell
-
logical, parameter :: reset_poly = .true.
- real (kind=RKIND) :: rcell, cos2t, costsint, sin2t
- real (kind=RKIND), dimension(grid%maxEdges) :: angle_2d
-!---
-
pii = 2.*asin(1.0)
advCells => grid % advCells % array
@@ -119,7 +109,7 @@
theta_abs(iCell) = pii/2. - sphere_angle( xc(1), yc(1), zc(1), &
xc(2), yc(2), zc(2), &
0.0_RKIND, 0.0_RKIND, 1.0_RKIND )
-
+
! angles from cell center to neighbor centers (thetav)
do i=1,n-1
@@ -130,7 +120,7 @@
thetav(i) = sphere_angle( xc(1), yc(1), zc(1), &
xc(i+1), yc(i+1), zc(i+1), &
xc(ip2), yc(ip2), zc(ip2) )
-
+
dl_sphere(i) = grid%sphere_radius*arc_length( xc(1), yc(1), zc(1), &
xc(i+1), yc(i+1), zc(i+1) )
end do
@@ -159,10 +149,10 @@
iEdge = grid % EdgesOnCell % array(i,iCell)
if ( iCell .ne. grid % CellsOnEdge % array(1,iEdge)) &
angle_2d(i) = angle_2d(i) - pii
+
+! xp(i) = grid % xCell % array(cell_list(i)) - grid % xCell % array(iCell)
+! yp(i) = grid % yCell % array(cell_list(i)) - grid % yCell % array(iCell)
-! xp(i) = grid % xCell % array(cell_list(i)) - grid % xCell % array(iCell)
-! yp(i) = grid % yCell % array(cell_list(i)) - grid % yCell % array(iCell)
-
xp(i) = grid % dcEdge % array(grid % EdgesOnCell % array(i,iCell)) * cos(angle_2d(i))
yp(i) = grid % dcEdge % array(grid % EdgesOnCell % array(i,iCell)) * sin(angle_2d(i))
@@ -205,20 +195,20 @@
amatrix(i,1) = 1.
amatrix(i,2) = xp(i-1)
amatrix(i,3) = yp(i-1)
-
+
amatrix(i,4) = xp(i-1)**2
amatrix(i,5) = xp(i-1) * yp(i-1)
amatrix(i,6) = yp(i-1)**2
-
+
amatrix(i,7) = xp(i-1)**3
amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
amatrix(i,10) = yp(i-1)**3
+
+ wmatrix(i,i) = 1.
- wmatrix(i,i) = 1.
-
end do
-
+
else
na = 15
ma = ma+1
@@ -229,16 +219,16 @@
amatrix(i,1) = 1.
amatrix(i,2) = xp(i-1)
amatrix(i,3) = yp(i-1)
-
+
amatrix(i,4) = xp(i-1)**2
amatrix(i,5) = xp(i-1) * yp(i-1)
amatrix(i,6) = yp(i-1)**2
-
+
amatrix(i,7) = xp(i-1)**3
amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
amatrix(i,10) = yp(i-1)**3
-
+
amatrix(i,11) = xp(i-1)**4
amatrix(i,12) = yp(i-1) * (xp(i-1)**3)
amatrix(i,13) = (xp(i-1)**2)*(yp(i-1)**2)
@@ -248,11 +238,11 @@
wmatrix(i,i) = 1.
end do
-
+
do i=1,mw
wmatrix(i,i) = 1.
end do
-
+
end if
call poly_fit_2( amatrix, bmatrix, wmatrix, ma, na, 25 )
@@ -363,7 +353,6 @@
if (debug) stop
-
! write(0,*) ' check for deriv2 coefficients, iEdge 4 '
!
! iEdge = 4
@@ -400,9 +389,7 @@
real (kind=RKIND) :: a, b, c ! Side lengths of spherical triangle ABC
real (kind=RKIND) :: ABx, ABy, ABz ! The components of the vector AB
- real (kind=RKIND) :: mAB ! The magnitude of AB
real (kind=RKIND) :: ACx, ACy, ACz ! The components of the vector AC
- real (kind=RKIND) :: mAC ! The magnitude of AC
real (kind=RKIND) :: Dx ! The i-components of the cross product AB x AC
real (kind=RKIND) :: Dy ! The j-components of the cross product AB x AC
@@ -571,16 +558,15 @@
real (kind=RKIND), dimension(n,m) :: b
real (kind=RKIND), dimension(m,m) :: w,wt,h
real (kind=RKIND), dimension(n,m) :: at, ath
- real (kind=RKIND), dimension(n,n) :: ata, ata_inv, atha, atha_inv
+ real (kind=RKIND), dimension(n,n) :: ata, atha, atha_inv
+! real (kind=RKIND), dimension(n,n) :: ata_inv
integer, dimension(n) :: indx
- integer :: i,j
if ( (ne<n) .or. (ne<m) ) then
write(6,*) ' error in poly_fit_2 inversion ',m,n,ne
stop
end if
-! a(1:m,1:n) = a_in(1:n,1:m)
a(1:m,1:n) = a_in(1:m,1:n)
w(1:m,1:m) = weights_in(1:m,1:m)
b_out(:,:) = 0.
@@ -615,134 +601,133 @@
end subroutine poly_fit_2
-! Updated 10/24/2001.
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!! Program 4.4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! !
-! Please Note: !
-! !
-! (1) This computer program is written by Tao Pang in conjunction with !
-! his book, "An Introduction to Computational Physics," published !
-! by Cambridge University Press in 1997. !
-! !
-! (2) No warranties, express or implied, are made for this program. !
-! !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-SUBROUTINE MIGS (A,N,X,INDX)
-!
-! Subroutine to invert matrix A(N,N) with the inverse stored
-! in X(N,N) in the output. Copyright (c) Tao Pang 2001.
-!
- IMPLICIT NONE
- INTEGER, INTENT (IN) :: N
- INTEGER :: I,J,K
- INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
- REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
- REAL (kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
- REAL (kind=RKIND), DIMENSION (N,N) :: B
-!
- DO I = 1, N
- DO J = 1, N
- B(I,J) = 0.0
- END DO
- END DO
- DO I = 1, N
- B(I,I) = 1.0
- END DO
-!
- CALL ELGS (A,N,INDX)
-!
- DO I = 1, N-1
- DO J = I+1, N
- DO K = 1, N
- B(INDX(J),K) = B(INDX(J),K)-A(INDX(J),I)*B(INDX(I),K)
- END DO
- END DO
- END DO
-!
- DO I = 1, N
- X(N,I) = B(INDX(N),I)/A(INDX(N),N)
- DO J = N-1, 1, -1
- X(J,I) = B(INDX(J),I)
- DO K = J+1, N
- X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
- END DO
- X(J,I) = X(J,I)/A(INDX(J),J)
- END DO
- END DO
-END SUBROUTINE MIGS
+ ! Updated 10/24/2001.
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!! Program 4.4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! !
+ ! Please Note: !
+ ! !
+ ! (1) This computer program is written by Tao Pang in conjunction with !
+ ! his book, "An Introduction to Computational Physics," published !
+ ! by Cambridge University Press in 1997. !
+ ! !
+ ! (2) No warranties, express or implied, are made for this program. !
+ ! !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ SUBROUTINE MIGS (A,N,X,INDX)
+ !
+ ! Subroutine to invert matrix A(N,N) with the inverse stored
+ ! in X(N,N) in the output. Copyright (c) Tao Pang 2001.
+ !
+ IMPLICIT NONE
+ INTEGER, INTENT (IN) :: N
+ INTEGER :: I,J,K
+ INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
+ REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
+ REAL (kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
+ REAL (kind=RKIND), DIMENSION (N,N) :: B
+ !
+ DO I = 1, N
+ DO J = 1, N
+ B(I,J) = 0.0
+ END DO
+ END DO
+ DO I = 1, N
+ B(I,I) = 1.0
+ END DO
+ !
+ CALL ELGS (A,N,INDX)
+ !
+ DO I = 1, N-1
+ DO J = I+1, N
+ DO K = 1, N
+ B(INDX(J),K) = B(INDX(J),K)-A(INDX(J),I)*B(INDX(I),K)
+ END DO
+ END DO
+ END DO
+ !
+ DO I = 1, N
+ X(N,I) = B(INDX(N),I)/A(INDX(N),N)
+ DO J = N-1, 1, -1
+ X(J,I) = B(INDX(J),I)
+ DO K = J+1, N
+ X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
+ END DO
+ X(J,I) = X(J,I)/A(INDX(J),J)
+ END DO
+ END DO
+ END SUBROUTINE MIGS
-SUBROUTINE ELGS (A,N,INDX)
-!
-! Subroutine to perform the partial-pivoting Gaussian elimination.
-! A(N,N) is the original matrix in the input and transformed matrix
-! plus the pivoting element ratios below the diagonal in the output.
-! INDX(N) records the pivoting order. Copyright (c) Tao Pang 2001.
-!
- IMPLICIT NONE
- INTEGER, INTENT (IN) :: N
- INTEGER :: I,J,K,ITMP
- INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
- REAL (kind=RKIND) :: C1,PI,PI1,PJ
- REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
- REAL (kind=RKIND), DIMENSION (N) :: C
-!
-! Initialize the index
-!
- DO I = 1, N
- INDX(I) = I
- END DO
-!
-! Find the rescaling factors, one from each row
-!
- DO I = 1, N
- C1= 0.0
- DO J = 1, N
- C1 = MAX(C1,ABS(A(I,J)))
- END DO
- C(I) = C1
- END DO
-!
-! Search the pivoting (largest) element from each column
-!
- DO J = 1, N-1
- PI1 = 0.0
- DO I = J, N
- PI = ABS(A(INDX(I),J))/C(INDX(I))
- IF (PI.GT.PI1) THEN
- PI1 = PI
- K = I
- ENDIF
- END DO
-!
-! Interchange the rows via INDX(N) to record pivoting order
-!
- ITMP = INDX(J)
- INDX(J) = INDX(K)
- INDX(K) = ITMP
- DO I = J+1, N
- PJ = A(INDX(I),J)/A(INDX(J),J)
-!
-! Record pivoting ratios below the diagonal
-!
- A(INDX(I),J) = PJ
-!
-! Modify other elements accordingly
-!
- DO K = J+1, N
- A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
- END DO
- END DO
- END DO
-!
-END SUBROUTINE ELGS
+ SUBROUTINE ELGS (A,N,INDX)
+ !
+ ! Subroutine to perform the partial-pivoting Gaussian elimination.
+ ! A(N,N) is the original matrix in the input and transformed matrix
+ ! plus the pivoting element ratios below the diagonal in the output.
+ ! INDX(N) records the pivoting order. Copyright (c) Tao Pang 2001.
+ !
+ IMPLICIT NONE
+ INTEGER, INTENT (IN) :: N
+ INTEGER :: I,J,K,ITMP
+ INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
+ REAL (kind=RKIND) :: C1,PI,PI1,PJ
+ REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
+ REAL (kind=RKIND), DIMENSION (N) :: C
+ !
+ ! Initialize the index
+ !
+ DO I = 1, N
+ INDX(I) = I
+ END DO
+ !
+ ! Find the rescaling factors, one from each row
+ !
+ DO I = 1, N
+ C1= 0.0
+ DO J = 1, N
+ C1 = MAX(C1,ABS(A(I,J)))
+ END DO
+ C(I) = C1
+ END DO
+ !
+ ! Search the pivoting (largest) element from each column
+ !
+ DO J = 1, N-1
+ PI1 = 0.0
+ DO I = J, N
+ PI = ABS(A(INDX(I),J))/C(INDX(I))
+ IF (PI.GT.PI1) THEN
+ PI1 = PI
+ K = I
+ ENDIF
+ END DO
+ !
+ ! Interchange the rows via INDX(N) to record pivoting order
+ !
+ ITMP = INDX(J)
+ INDX(J) = INDX(K)
+ INDX(K) = ITMP
+ DO I = J+1, N
+ PJ = A(INDX(I),J)/A(INDX(J),J)
+ !
+ ! Record pivoting ratios below the diagonal
+ !
+ A(INDX(I),J) = PJ
+ !
+ ! Modify other elements accordingly
+ !
+ DO K = J+1, N
+ A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
+ END DO
+ END DO
+ END DO
+ !
+ END SUBROUTINE ELGS
+
-!-------------------------------------------------------------
-
subroutine atm_initialize_deformation_weights( grid )
!
@@ -758,30 +743,22 @@
! local variables
- real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
- real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
real (kind=RKIND), dimension(grid % nCells) :: theta_abs
real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
- real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
- real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
- real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
- integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
- integer :: iCell, iEdge
+ real (kind=RKIND) :: dl
+ integer :: i, ip1, ip2, n
+ integer :: iCell
real (kind=RKIND) :: pii
- real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
- real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
- real (kind=RKIND) :: angv1, angv2, dl1, dl2
- real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp, xpt, ypt
+ real (kind=RKIND), dimension(25) :: xp, yp
real (kind=RKIND) :: length_scale
- integer :: ma,na, cell_add, mw, nn
integer, dimension(25) :: cell_list
- integer :: cell1, cell2, iv
+ integer :: iv
logical :: do_the_cell
- real (kind=RKIND) :: area_cell, sint2, cost2, sint_cost, sumw1, sumw2, xptt, area_cellt
+ real (kind=RKIND) :: area_cell, sint2, cost2, sint_cost, area_cellt
logical, parameter :: debug = .false.
Copied: branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_interp_diagnostics.F (from rev 2782, trunk/mpas/src/core_nhyd_atmos/mpas_atm_interp_diagnostics.F)
===================================================================
--- branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_interp_diagnostics.F (rev 0)
+++ branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_interp_diagnostics.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,383 @@
+!==================================================================================================
+ module mpas_atm_interp_diagnostics
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_constants
+
+ implicit none
+ private
+ public:: interp_diagnostics
+
+ contains
+
+!==================================================================================================
+ subroutine interp_diagnostics(mesh,state,diag)
+!==================================================================================================
+
+!input arguments:
+ type(mesh_type),intent(in) :: mesh
+ type(state_type),intent(in):: state
+
+!inout arguments:
+ type(diag_type),intent(inout):: diag
+
+!local variables:
+ integer:: iCell,iVert,iVertD,k,kk
+ integer:: nCells,nVertLevels,nVertLevelsP1,nVertices,VertexDegree
+ integer,dimension(:,:),pointer:: cellsOnVertex
+
+ real(kind=RKIND),dimension(:),pointer:: areaTriangle
+ real(kind=RKIND),dimension(:,:),pointer:: kiteAreasOnVertex
+
+ real(kind=RKIND),dimension(:,:),pointer:: exner,height
+ real(kind=RKIND),dimension(:,:),pointer:: pressure_b,pressure_p
+ real(kind=RKIND),dimension(:,:),pointer:: qvapor,theta_m,vorticity
+ real(kind=RKIND),dimension(:,:),pointer:: umeridional,uzonal,vvel
+
+ real(kind=RKIND),dimension(:,:),allocatable:: pressure,pressureCp1,pressure2,pressure_v,temperature
+
+!local interpolated fields:
+ integer:: nIntP
+ real(kind=RKIND):: w1,w2,z0,z1,z2
+ real(kind=RKIND),dimension(:,:),allocatable:: field_in,press_in
+ real(kind=RKIND),dimension(:,:),allocatable:: field_interp,press_interp
+
+!--------------------------------------------------------------------------------------------------
+
+ write(0,*)
+ write(0,*) '--- enter subroutine interp_diagnostics:'
+
+ nCells = mesh % nCells
+ nVertLevels = mesh % nVertLevels
+!nVertLevelsP1 = mesh % nVertLevelsP1
+ nVertices = mesh % nVertices
+ VertexDegree = mesh % vertexDegree
+ nVertLevelsP1 = nVertLevels + 1
+
+ cellsOnVertex => mesh % cellsOnVertex % array
+ areaTriangle => mesh % areaTriangle % array
+ kiteAreasOnVertex => mesh % kiteAreasOnVertex % array
+
+ height => mesh % zgrid % array
+ vvel => state % w % array
+ theta_m => state % theta_m % array
+ qvapor => state % scalars % array(state%index_qv,:,:)
+
+ exner => diag % exner % array
+ pressure_b => diag % pressure_base % array
+ pressure_p => diag % pressure_p % array
+ vorticity => diag % vorticity % array
+ umeridional => diag % uReconstructMeridional % array
+ uzonal => diag % uReconstructZonal % array
+
+ if(.not.allocated(pressure) ) allocate(pressure(nVertLevels,nCells) )
+ if(.not.allocated(pressureCp1) ) allocate(pressureCp1(nVertLevels,nCells+1) )
+ if(.not.allocated(pressure2) ) allocate(pressure2(nVertLevelsP1,nCells) )
+ if(.not.allocated(pressure_v) ) allocate(pressure_v(nVertLevels,nVertices) )
+ if(.not.allocated(temperature) ) allocate(temperature(nVertLevels,nCells) )
+
+!calculation of total pressure at cell centers (at mass points):
+ do iCell = 1, nCells
+ do k = 1, nVertLevels
+ pressure(k,iCell) = (pressure_p(k,iCell) + pressure_b(k,iCell)) / 100._RKIND
+ pressureCp1(k,iCell) = pressure(k,iCell)
+ enddo
+ enddo
+ do iCell = nCells+1, nCells+1
+ do k = 1, nVertLevels
+ pressureCp1(k,iCell) = (pressure_p(k,iCell) + pressure_b(k,iCell)) / 100._RKIND
+ enddo
+ enddo
+
+!calculation of total pressure at cell centers (at vertical velocity points):
+ k = nVertLevelsP1
+ do iCell = 1, nCells
+ z0 = height(k,iCell)
+ z1 = 0.5*(height(k,iCell)+height(k-1,iCell))
+ z2 = 0.5*(height(k-1,iCell)+height(k-2,iCell))
+ w1 = (z0-z2)/(z1-z2)
+ w2 = 1.-w1
+ !use log of pressure to avoid occurrences of negative top-of-the-model pressure.
+ pressure2(k,iCell) = exp(w1*log(pressure(k-1,iCell))+w2*log(pressure(k-2,iCell)))
+ enddo
+ do k = 2, nVertLevels
+ do iCell = 1, nCells
+ w1 = (height(k,iCell)-height(k-1,iCell)) / (height(k+1,iCell)-height(k-1,iCell))
+ w2 = (height(k+1,iCell)-height(k,iCell)) / (height(k+1,iCell)-height(k-1,iCell))
+ pressure2(k,iCell) = w1*pressure(k,iCell) + w2*pressure(k-1,iCell)
+ enddo
+ enddo
+ k = 1
+ do iCell = 1, nCells
+ z0 = height(k,iCell)
+ z1 = 0.5*(height(k,iCell)+height(k+1,iCell))
+ z2 = 0.5*(height(k+1,iCell)+height(k+2,iCell))
+ w1 = (z0-z2)/(z1-z2)
+ w2 = 1.-w1
+ pressure2(k,iCell) = w1*pressure(k,iCell)+w2*pressure(k+1,iCell)
+ enddo
+
+!calculation of total pressure at cell vertices (at mass points):
+ do iVert = 1, nVertices
+ pressure_v(:,iVert) = 0._RKIND
+
+ do k = 1, nVertLevels
+ do iVertD = 1, vertexDegree
+ pressure_v(k,iVert) = pressure_v(k,iVert) &
+ + kiteAreasOnVertex(iVertD,iVert)*pressureCp1(k,cellsOnVertex(iVertD,iVert))
+ enddo
+ pressure_v(k,iVert) = pressure_v(k,iVert) / areaTriangle(iVert)
+ enddo
+ enddo
+
+!calculation of temperature at cell centers:
+ do iCell = 1,nCells
+ do k = 1,nVertLevels
+ temperature(k,iCell) = (theta_m(k,iCell)/(1._RKIND+rvord*qvapor(k,iCell)))*exner(k,iCell)
+ enddo
+ enddo
+
+!interpolation to fixed pressure levels for fields located at cells centers and at mass points:
+ nIntP = 3
+ if(.not.allocated(field_interp)) allocate(field_interp(nCells,nIntP) )
+ if(.not.allocated(press_interp)) allocate(press_interp(nCells,nIntP) )
+ do iCell = 1, nCells
+ press_interp(iCell,1) = 200.0_RKIND
+ press_interp(iCell,2) = 500.0_RKIND
+ press_interp(iCell,3) = 850.0_RKIND
+ enddo
+
+ if(.not.allocated(press_in)) allocate(press_in(nCells,nVertLevels))
+ do iCell = 1, nCells
+ do k = 1, nVertLevels
+ kk = nVertLevels+1-k
+ press_in(iCell,kk) = pressure(k,iCell)
+ enddo
+ enddo
+
+ if(.not.allocated(field_in)) allocate(field_in(nCells,nVertLevels))
+!... temperature:
+ do iCell = 1, nCells
+ do k = 1, nVertLevels
+ kk = nVertLevels+1-k
+ field_in(iCell,kk) = temperature(k,iCell)
+ enddo
+ enddo
+ call interp_tofixed_pressure(nCells,nVertLevels,nIntP,press_in,field_in,press_interp,field_interp)
+ diag % temperature_200hPa % array(1:nCells) = field_interp(1:nCells,1)
+ diag % temperature_500hPa % array(1:nCells) = field_interp(1:nCells,2)
+ diag % temperature_850hPa % array(1:nCells) = field_interp(1:nCells,3)
+ write(0,*) '--- end interpolate temperature:'
+
+!... u zonal wind:
+ do iCell = 1, nCells
+ do k = 1, nVertLevels
+ kk = nVertLevels+1-k
+ field_in(iCell,kk) = uzonal(k,iCell)
+ enddo
+ enddo
+ call interp_tofixed_pressure(nCells,nVertLevels,nIntP,press_in,field_in,press_interp,field_interp)
+ diag % uzonal_200hPa % array(1:nCells) = field_interp(1:nCells,1)
+ diag % uzonal_500hPa % array(1:nCells) = field_interp(1:nCells,2)
+ diag % uzonal_850hPa % array(1:nCells) = field_interp(1:nCells,3)
+ write(0,*) '--- end interpolate zonal wind:'
+
+!... u meridional wind:
+ do iCell = 1, nCells
+ do k = 1, nVertLevels
+ kk = nVertLevels+1-k
+ field_in(iCell,kk) = umeridional(k,iCell)
+ enddo
+ enddo
+ call interp_tofixed_pressure(nCells,nVertLevels,nIntP,press_in,field_in,press_interp,field_interp)
+ diag % umeridional_200hPa % array(1:nCells) = field_interp(1:nCells,1)
+ diag % umeridional_500hPa % array(1:nCells) = field_interp(1:nCells,2)
+ diag % umeridional_850hPa % array(1:nCells) = field_interp(1:nCells,3)
+ write(0,*) '--- end interpolate meridional wind:'
+
+ if(allocated(field_in)) deallocate(field_in)
+ if(allocated(press_in)) deallocate(press_in)
+
+!interpolation to fixed pressure levels for fields located at cells centers and at vertical
+!velocity points:
+ if(.not.allocated(press_in)) allocate(press_in(nCells,nVertLevelsP1))
+ do iCell = 1, nCells
+ do k = 1, nVertLevelsP1
+ kk = nVertLevelsP1+1-k
+ press_in(iCell,kk) = pressure2(k,iCell)
+ enddo
+ enddo
+
+ if(.not.allocated(field_in)) allocate(field_in(nCells,nVertLevelsP1))
+ !... height:
+ do iCell = 1, nCells
+ do k = 1, nVertLevelsP1
+ kk = nVertLevelsP1+1-k
+ field_in(iCell,kk) = height(k,iCell)
+ enddo
+ enddo
+ call interp_tofixed_pressure(nCells,nVertLevelsP1,nIntP,press_in,field_in,press_interp,field_interp)
+ diag % height_200hPa % array(1:nCells) = field_interp(1:nCells,1)
+ diag % height_500hPa % array(1:nCells) = field_interp(1:nCells,2)
+ diag % height_850hPa % array(1:nCells) = field_interp(1:nCells,3)
+ write(0,*) '--- end interpolate height:'
+
+!... vertical velocity
+ do iCell = 1, nCells
+ do k = 1, nVertLevelsP1
+ kk = nVertLevelsP1+1-k
+ field_in(iCell,kk) = vvel(k,iCell)
+ enddo
+ enddo
+ call interp_tofixed_pressure(nCells,nVertLevelsP1,nIntP,press_in,field_in,press_interp,field_interp)
+ diag % w_200hPa % array(1:nCells) = field_interp(1:nCells,1)
+ diag % w_500hPa % array(1:nCells) = field_interp(1:nCells,2)
+ diag % w_850hPa % array(1:nCells) = field_interp(1:nCells,3)
+ write(0,*) '--- end interpolate vertical velocity:'
+
+ if(allocated(field_interp)) deallocate(field_interp)
+ if(allocated(press_interp)) deallocate(press_interp)
+
+!interpolation to fixed pressure levels for fields located at cell vertices and at mass points:
+ nIntP = 3
+ if(.not.allocated(field_interp)) allocate(field_interp(nVertices,nIntP) )
+ if(.not.allocated(press_interp)) allocate(press_interp(nVertices,nIntP) )
+ do iVert = 1, nVertices
+ press_interp(iVert,1) = 200.0_RKIND
+ press_interp(iVert,2) = 500.0_RKIND
+ press_interp(iVert,3) = 850.0_RKIND
+ enddo
+
+ if(allocated(field_in)) deallocate(field_in)
+ if(allocated(press_in)) deallocate(press_in)
+
+ if(.not.allocated(press_in)) allocate(press_in(nVertices,nVertLevels))
+ do iVert = 1, nVertices
+ do k = 1, nVertLevels
+ kk = nVertLevels+1-k
+ press_in(iVert,kk) = pressure_v(k,iVert)
+ enddo
+ enddo
+
+ if(.not.allocated(field_in)) allocate(field_in(nVertices,nVertLevels))
+!... relative vorticity:
+ do iVert = 1, nVertices
+ do k = 1, nVertLevels
+ kk = nVertLevels+1-k
+ field_in(iVert,kk) = vorticity(k,iVert)
+ enddo
+ enddo
+ call interp_tofixed_pressure(nVertices,nVertLevels,nIntP,press_in,field_in,press_interp,field_interp)
+ diag % vorticity_200hPa % array(1:nVertices) = field_interp(1:nVertices,1)
+ diag % vorticity_500hPa % array(1:nVertices) = field_interp(1:nVertices,2)
+ diag % vorticity_850hPa % array(1:nVertices) = field_interp(1:nVertices,3)
+ write(0,*) '--- end interpolate relative vorticity:'
+
+ if(allocated(field_interp)) deallocate(field_interp)
+ if(allocated(press_interp)) deallocate(press_interp)
+ if(allocated(pressure) ) deallocate(pressure )
+ if(allocated(pressureCp1) ) deallocate(pressureCp1 )
+ if(allocated(pressure2) ) deallocate(pressure2 )
+ if(allocated(pressure_v) ) deallocate(pressure_v )
+ if(allocated(temperature) ) deallocate(temperature )
+
+!formats:
+! 201 format(i5,4(1x,e15.8))
+
+ end subroutine interp_diagnostics
+
+!==================================================================================================
+ subroutine interp_tofixed_pressure(ncol,nlev_in,nlev_out,pres_in,field_in,pres_out,field_out)
+!==================================================================================================
+
+!input arguments:
+ integer,intent(in):: ncol,nlev_in,nlev_out
+
+ real(kind=RKIND),intent(in),dimension(ncol,nlev_in) :: pres_in,field_in
+ real(kind=RKIND),intent(in),dimension(ncol,nlev_out):: pres_out
+
+!output arguments:
+ real(kind=RKIND),intent(out),dimension(ncol,nlev_out):: field_out
+
+!local variables:
+! integer:: i1,i2,icol,k,kk
+ integer:: icol,k,kk
+ integer:: kkstart,kount
+ integer,dimension(ncol):: kupper
+
+ real(kind=RKIND):: dpl,dpu
+
+!--------------------------------------------------------------------------------------------------
+
+!formats:
+! 201 format(i5,8(1x,e15.8))
+
+!write(0,*)
+!write(0,*) '--- enter subroutine interp_tofixed_pressure:'
+!write(0,*) '... ncol = ',ncol
+!write(0,*) '... nlev_in = ',nlev_in
+!write(0,*) '... nlev_out = ',nlev_out
+!i1=1 ; i2=ncol
+!do k = 1, nlev_in
+! write(0,201) k,pres_in(i1,k),field_in(i1,k),pres_in(i2,k),field_in(i2,k)
+!enddo
+!write(0,*)
+
+ do icol = 1, ncol
+ kupper(icol) = 1
+ enddo
+
+ do k = 1, nlev_out
+
+ kkstart = nlev_in
+ do icol = 1, ncol
+ kkstart = min0(kkstart,kupper(icol))
+ enddo
+ kount = 0
+
+ do kk = kkstart, nlev_in-1
+ do icol = 1, ncol
+ if(pres_out(icol,k).gt.pres_in(icol,kk).and.pres_out(icol,k).le.pres_in(icol,kk+1)) then
+ kupper(icol) = kk
+ kount = kount + 1
+! write(0,201) kupper(icol),pres_out(icol,k),pres_in(icol,kk),pres_in(icol,kk+1)
+ endif
+ enddo
+
+ if(kount.eq.ncol) then
+ do icol = 1, ncol
+ dpu = pres_out(icol,k) - pres_in(icol,kupper(icol))
+ dpl = pres_in(icol,kupper(icol)+1) - pres_out(icol,k)
+ field_out(icol,k) = (field_in(icol,kupper(icol))*dpl &
+ + field_in(icol,kupper(icol)+1)*dpu)/(dpl + dpu)
+ end do
+ goto 35
+ end if
+ enddo
+
+ do icol = 1, ncol
+ if(pres_out(icol,k) .lt. pres_in(icol,1)) then
+ field_out(icol,k) = field_in(icol,1)*pres_out(icol,k)/pres_in(icol,1)
+ elseif(pres_out(icol,k) .gt. pres_in(icol,nlev_in)) then
+ field_out(icol,k) = field_in(icol,nlev_in)
+ else
+ dpu = pres_out(icol,k) - pres_in(icol,kupper(icol))
+ dpl = pres_in(icol,kupper(icol)+1) - pres_out(icol,k)
+ field_out(icol,k) = (field_in(icol,kupper(icol))*dpl &
+ + field_in(icol,kupper(icol)+1)*dpu)/(dpl + dpu)
+ endif
+ enddo
+
+ 35 continue
+! write(0,201) kupper(i1),pres_out(i1,k),pres_in(i1,kupper(i1)),pres_in(i1,kupper(i1)+1), &
+! field_out(i1,k),field_in(i1,kupper(i1)),field_in(i1,kupper(i1)+1)
+! write(0,201) kupper(i2),pres_out(i2,k),pres_in(i2,kupper(i2)),pres_in(i2,kupper(i2)+1), &
+! field_out(i2,k),field_in(i2,kupper(i2)),field_in(i2,kupper(i2)+1)
+
+ enddo
+
+ end subroutine interp_tofixed_pressure
+
+!==================================================================================================
+ end module mpas_atm_interp_diagnostics
+!==================================================================================================
Modified: branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_mpas_core.F
===================================================================
--- branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_mpas_core.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_mpas_core.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -29,16 +29,13 @@
real (kind=RKIND) :: dt
type (block_type), pointer :: block
- type (field1DChar) :: xtime
- type (MPAS_Time_type) :: startTime, sliceTime
- type (MPAS_TimeInterval_type) :: timeDiff, minTimeDiff
character(len=StrKIND) :: timeStamp
integer :: i
integer :: ierr
if (.not. config_do_restart) then
- ! Code that was previously handled by atm_setup_test_case()
+ ! Code that was previously in atm_setup_test_case()
block => domain % blocklist
do while (associated(block))
@@ -83,9 +80,9 @@
!
! We need to decide which time slice to read from the surface file - read the most recent time slice that falls before or on the start time
!
- sfc_update_obj % time = MPAS_seekStream(sfc_update_obj % io_stream, trim(config_start_time), MPAS_STREAM_LATEST_BEFORE, timeStamp, ierr)
+ sfc_update_obj % time = MPAS_seekStream(sfc_update_obj % io_stream, trim(startTimeStamp), MPAS_STREAM_LATEST_BEFORE, timeStamp, ierr)
if (ierr == MPAS_IO_ERR) then
- write(0,*) 'Error: surface update file '//trim(sfc_update_obj % filename)//' did not contain any times at or before '//trim(config_start_time)
+ write(0,*) 'Error: surface update file '//trim(sfc_update_obj % filename)//' did not contain any times at or before '//trim(startTimeStamp)
call mpas_dmpar_abort(domain % dminfo)
end if
@@ -108,7 +105,14 @@
type (MPAS_TimeInterval_type) :: runDuration, timeStep, alarmTimeStep
integer :: ierr
- call mpas_set_time(curr_time=startTime, dateTimeString=config_start_time, ierr=ierr)
+ if(trim(config_start_time) == 'file') then
+ open(22,file='restart_timestamp',form='formatted',status='old')
+ read(22,*) startTimeStamp
+ close(22)
+ else
+ startTimeStamp = config_start_time
+ end if
+ call mpas_set_time(curr_time=startTime, dateTimeString=startTimeStamp, ierr=ierr)
call mpas_set_timeInterval(timeStep, dt=dt, ierr=ierr)
if (trim(config_run_duration) /= "none") then
@@ -340,8 +344,6 @@
type (domain_type), intent(inout) :: domain
type (io_output_object), intent(inout) :: output_obj
- integer :: i, j, k
- integer :: eoe
type (block_type), pointer :: block_ptr
block_ptr => domain % blocklist
@@ -376,6 +378,8 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use mpas_grid_types
+ use mpas_constants
+ use mpas_atm_interp_diagnostics
implicit none
@@ -383,15 +387,16 @@
type (diag_type), intent(inout) :: diag
type (mesh_type), intent(in) :: grid
- integer :: i, eoe
integer :: iCell, k
do iCell=1,grid%nCells
do k=1,grid%nVertLevels
- diag % theta % array(k,iCell) = state % theta_m % array(k,iCell) / (1.0 + 1.61 * state % scalars % array(state % index_qv,k,iCell))
+ diag % theta % array(k,iCell) = state % theta_m % array(k,iCell) / (1._RKIND + rvord * state % scalars % array(state % index_qv,k,iCell))
diag % rho % array(k,iCell) = state % rho_zz % array(k,iCell) * grid % zz % array(k,iCell)
end do
end do
+
+ call interp_diagnostics(grid,state,diag)
end subroutine atm_compute_output_diagnostics
@@ -407,6 +412,7 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use mpas_grid_types
+ use mpas_constants
implicit none
@@ -414,12 +420,11 @@
type (diag_type), intent(inout) :: diag
type (mesh_type), intent(in) :: grid
- integer :: i, eoe
integer :: iCell, k
do iCell=1,grid%nCells
do k=1,grid%nVertLevels
- diag % theta % array(k,iCell) = state % theta_m % array(k,iCell) / (1.0 + 1.61 * state % scalars % array(state % index_qv,k,iCell))
+ diag % theta % array(k,iCell) = state % theta_m % array(k,iCell) / (1._RKIND + rvord * state % scalars % array(state % index_qv,k,iCell))
diag % rho % array(k,iCell) = state % rho_zz % array(k,iCell) * grid % zz % array(k,iCell)
end do
end do
Modified: branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_time_integration.F
===================================================================
--- branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_time_integration.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_nhyd_atmos/mpas_atm_time_integration.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -68,12 +68,13 @@
! Advance model state forward in time by the specified time step using
! time-split RK3 scheme
!
- ! Hydrostatic (primitive eqns.) solver
+ ! Nonhydrostatic atmospheric solver
!
! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:))
- ! plus grid meta-data
+ ! plus grid meta-data and some diagnostics of state.
! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains
- ! model state advanced forward in time by dt seconds
+ ! model state advanced forward in time by dt seconds,
+ ! and some diagnostics in diag
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
implicit none
@@ -95,9 +96,8 @@
! logical, parameter :: debug = .true.
logical, parameter :: debug_mass_conservation = .true.
- integer :: index_qc
- real (kind=RKIND) :: domain_mass, scalar_mass, scalar_min, scalar_max
- real (kind=RKIND) :: global_domain_mass, global_scalar_mass, global_scalar_min, global_scalar_max
+ real (kind=RKIND) :: scalar_min, scalar_max
+ real (kind=RKIND) :: global_scalar_min, global_scalar_max
!
@@ -119,14 +119,6 @@
if(debug) write(0,*) ' copy step in rk solver '
-! WCS-parallel: it appears we have chosen to update all edges of nCellsSolve (to cut down on communications on acoustic steps).
-! Do our communications patterns and loops (specifically in compute_dyn_tend) reflect this? Or do they assume we are only updating
-! the so-called owned edges?
-
-
-
-! WCS-parallel: first three and rtheta_p arise from scalar transport and microphysics update (OK). Others come from where?
-
! theta_m
call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(1) % state % theta_m)
@@ -142,71 +134,71 @@
block => domain % blocklist
do while (associated(block))
- ! We are setting values in the halo here, so no communications are needed.
- ! Alternatively, we could just set owned cells and edge values and communicate after this block loop.
call atm_rk_integration_setup( block % state % time_levs(2) % state, block % state % time_levs(1) % state, block % diag )
block => block % next
end do
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! BEGIN RK loop
+ ! BEGIN Runge-Kutta loop
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
do rk_step = 1, 3 ! Runge-Kutta loop
if(debug) write(0,*) ' rk substep ', rk_step
- block => domain % blocklist
- do while (associated(block))
- ! The coefficients are set for owned cells (cqw) and for all edges of owned cells,
- ! thus no communications should be needed after this call.
- ! We could consider combining this and the next block loop.
- call atm_compute_moist_coefficients( block % state % time_levs(2) % state, block % diag, block % mesh )
- block => block % next
- end do
+ block => domain % blocklist
+ do while (associated(block))
+ ! The coefficients are set for owned cells (cqw) and for all edges of owned cells,
+ call atm_compute_moist_coefficients( block % state % time_levs(2) % state, block % diag, block % mesh )
+ block => block % next
+ end do
- if (debug) write(0,*) ' compute_dyn_tend '
- block => domain % blocklist
- do while (associated(block))
- call atm_compute_dyn_tend( block % tend, block % state % time_levs(2) % state, block % diag, block % mesh, rk_step )
- block => block % next
- end do
- if (debug) write(0,*) ' finished compute_dyn_tend '
+ if (debug) write(0,*) ' compute_dyn_tend '
+ block => domain % blocklist
+ do while (associated(block))
+ call atm_compute_dyn_tend( block % tend, block % state % time_levs(2) % state, block % diag, block % mesh, rk_step, dt )
+ block => block % next
+ end do
+ if (debug) write(0,*) ' finished compute_dyn_tend '
-
#ifdef DO_PHYSICS
- if (debug) write(0,*) ' add physics tendencies '
- block => domain % blocklist
- do while (associated(block))
- call physics_addtend( block % mesh, &
- block % state % time_levs(1) % state, &
- block % diag, &
- block % tend, &
- block % tend_physics, &
- block % state % time_levs(2) % state % rho_zz % array(:,:), &
- block % diag % rho_edge % array(:,:) )
- block => block % next
- end do
- if (debug) write(0,*) ' finished add physics tendencies '
+ if (debug) write(0,*) ' add physics tendencies '
+ block => domain % blocklist
+ do while (associated(block))
+ call physics_addtend( block % mesh, &
+ block % state % time_levs(1) % state, &
+ block % diag, &
+ block % tend, &
+ block % tend_physics, &
+ block % state % time_levs(2) % state % rho_zz % array(:,:), &
+ block % diag % rho_edge % array(:,:), &
+ rk_step )
+ block => block % next
+ end do
+ if (debug) write(0,*) ' finished add physics tendencies '
#endif
-!***********************************
-! we will need to communicate the momentum tendencies here - we want tendencies for all edges of owned cells
-! because we are solving for all edges of owned cells
-!***********************************
+ !***********************************
+ ! need tendencies at all edges of owned cells -
+ ! we are solving for all edges of owned cells to minimize communications
+ ! during the acoustic substeps
+ !***********************************
! tend_u
call mpas_dmpar_exch_halo_field(domain % blocklist % tend % u, (/ 1 /))
block => domain % blocklist
do while (associated(block))
- call atm_set_smlstep_pert_variables( block % state % time_levs(1) % state, block % state % time_levs(2) % state, &
- block % tend, block % diag, block % mesh )
+ call atm_set_smlstep_pert_variables( block % tend, block % diag, block % mesh )
call atm_compute_vert_imp_coefs( block % state % time_levs(2) % state, block % mesh, block % diag, rk_sub_timestep(rk_step) )
block => block % next
end do
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! begin acoustic steps loop
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
do small_step = 1, number_sub_steps(rk_step)
if(debug) write(0,*) ' acoustic step ',small_step
@@ -220,42 +212,24 @@
if(debug) write(0,*) ' acoustic step complete '
- ! will need communications here for rtheta_pp
+! rtheta_pp
+! This is the only communications needed during the acoustic steps because we solve for u on all edges of owned cells
-! WCS-parallel: is this a candidate for a smaller stencil? we need only communicate cells that share edges with owned cells.
-
-! rtheta_pp
call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rtheta_pp, (/ 1 /))
- end do ! end of small stimestep loop
+ end do ! end of acoustic steps loop
- ! will need communications here for rho_pp
-
-! WCS-parallel: is communication of rw_p and rho_pp because of limiter (pd or mono scheme?),
-! or is it needed for the large-step variable recovery (to get decoupled variables)?
-! seems like only rho_pp needed...
-!
-! or, do we need ru and u in the halo for diagnostics that are computed later in compute_solve_diagnostics?
-!
-! rho_pp might be candidate for smaller stencil (same stencil as rtheta_pp above).
-
-! MGD seems necessary
-! rw_p
!CR: SMALLER STENCIL?: call mpas_dmpar_exch_halo_field(block % diag % rw_p, (/ 1 /))
call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rw_p)
-! MGD seems necessary
-! ru_p
!CR: SMALLER STENCIL?: call mpas_dmpar_exch_halo_field(block % diag % ru_p, (/ 2 /))
call mpas_dmpar_exch_halo_field(domain % blocklist % diag % ru_p)
-! rho_pp
call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rho_pp)
! the second layer of halo cells must be exchanged before calling atm_recover_large_step_variables
call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rtheta_pp, (/ 2 /))
-
block => domain % blocklist
do while (associated(block))
call atm_recover_large_step_variables( block % state % time_levs(2) % state, &
@@ -264,12 +238,12 @@
block => block % next
end do
-! ************ advection of moist variables here...
-
! u
!CR: SMALLER STENCIL?: call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % u, (/ 3 /))
call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % u)
+ ! scalar advection: RK3 scheme of Skamarock and Gassmann (2011).
+ ! PD or monotonicity constraints applied only on the final Runge-Kutta substep.
if (config_scalar_advection) then
@@ -278,7 +252,7 @@
!
! Note: The advance_scalars_mono routine can be used without limiting, and thus, encompasses
! the functionality of the advance_scalars routine; however, it is noticeably slower,
- ! so we keep the advance_scalars routine as well
+ ! so we use the advance_scalars routine for the first two RK substeps.
!
if (rk_step < 3 .or. (.not. config_monotonic .and. .not. config_positive_definite)) then
call atm_advance_scalars( block % tend, &
@@ -290,35 +264,17 @@
call atm_advance_scalars_mono( block % tend, &
block % state % time_levs(1) % state, block % state % time_levs(2) % state, &
block % diag, block % mesh, &
- rk_timestep(rk_step), rk_step, 3 )
+ rk_timestep(rk_step))
end if
block => block % next
end do
-! For now, we do scalar halo updates later on...
-! block => domain % blocklist
-! do while (associated(block))
-! call mpas_dmpar_exch_halo_field3d_real(domain % dminfo, block % tend % scalars % array(:,:,:), &
-! block % tend % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
-! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-! call mpas_dmpar_exch_halo_field3d_real(domain % dminfo, block % state % time_levs(2) % state % scalars % array(:,:,:), &
-! block % state % time_levs(2) % state % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
-! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-! block => block % next
-! end do
-
else
write(0,*) ' no scalar advection '
end if
-! WCS-parallel: seems like we already use u and w (and other state variables) as if they were already correctly set in the halo,
-! but they are not (at least to the outer edges - see communications below? or are those communications redundent?).
-! Perhaps we should communicate u, w, theta_m, rho_zz, etc after recover_large_step_variables),
-! cover it with the scalar communications, and then compute solve_diagnostics. I do not think we need to communicate the stuff we compute
-! in compute_solve_diagnostics if we compute it out in the halo (and I think we do - the halos should be large enough).
-
block => domain % blocklist
do while (associated(block))
call atm_compute_solve_diagnostics( dt, block % state % time_levs(2) % state, block % diag, block % mesh )
@@ -327,11 +283,6 @@
if(debug) write(0,*) ' diagnostics complete '
-
- ! need communications here to fill out u, w, theta_m, p, and pp, scalars, etc
- ! so that they are available for next RK step or the first rk substep of the next timestep
-
-!MGD seems necessary
! w
call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % w)
@@ -341,30 +292,29 @@
! rho_edge
call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rho_edge)
-! **** this will always be needed - perhaps we can cover this with compute_solve_diagnostics
-
! scalars
- if(rk_step < 3) then
+ if (rk_step < 3) then
call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % scalars)
end if
- end do ! rk_step loop
+ end do ! rk_step loop
!... compute full velocity vectors at cell centers:
block => domain % blocklist
- do while (associated(block))
- call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array, &
- block % diag % uReconstructX % array, &
- block % diag % uReconstructY % array, &
- block % diag % uReconstructZ % array, &
- block % diag % uReconstructZonal % array, &
- block % diag % uReconstructMeridional % array &
- )
- block => block % next
- end do
+ do while (associated(block))
+ call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array, &
+ block % diag % uReconstructX % array, &
+ block % diag % uReconstructY % array, &
+ block % diag % uReconstructZ % array, &
+ block % diag % uReconstructZonal % array, &
+ block % diag % uReconstructMeridional % array &
+ )
+ block => block % next
+ end do
!... call to parameterizations of cloud microphysics. calculation of the tendency of water vapor to horizontal and
!... vertical advection needed for the Tiedtke parameterization of convection.
+
#ifdef DO_PHYSICS
block => domain % blocklist
do while(associated(block))
@@ -372,21 +322,21 @@
!NOTE: The calculation of the tendency due to horizontal and vertical advection for the water vapor mixing ratio
!requires that the subroutine atm_advance_scalars_mono was called on the third Runge Kutta step, so that a halo
!update for the scalars at time_levs(1) is applied. A halo update for the scalars at time_levs(2) is done above.
- if(config_monotonic) then
+ if (config_monotonic) then
block % tend_physics % rqvdynten % array(:,:) = &
( block % state % time_levs(2) % state % scalars % array(block % state % time_levs(2) % state % index_qv,:,:) &
- block % state % time_levs(1) % state % scalars % array(block % state % time_levs(1) % state % index_qv,:,:) ) &
/ config_dt
else
block % tend_physics % rqvdynten % array(:,:) = 0._RKIND
- endif
+ end if
!simply set to zero negative mixing ratios of different water species (for now):
where ( block % state % time_levs(2) % state % scalars % array(:,:,:) .lt. 0.) &
block % state % time_levs(2) % state % scalars % array(:,:,:) = 0.
!call microphysics schemes:
- if(config_microp_scheme .ne. 'off') &
+ if (config_microp_scheme .ne. 'off') &
call microphysics_driver ( block % state % time_levs(2) % state, block % diag, block % diag_physics, &
block % tend, block % mesh, itimestep )
@@ -394,88 +344,84 @@
end do
#endif
+ 102 format(' global min, max scalar',i4,2(1x,e17.10))
+ write(0,*)
+ block => domain % blocklist
+ do while (associated(block))
+ scalar_min = 0.
+ scalar_max = 0.
+ do iCell = 1, block % mesh % nCellsSolve
+ do k = 1, block % mesh % nVertLevels
+ scalar_min = min(scalar_min, block % state % time_levs(2) % state % w % array(k,iCell))
+ scalar_max = max(scalar_max, block % state % time_levs(2) % state % w % array(k,iCell))
+ end do
+ end do
+ call mpas_dmpar_min_real(domain%dminfo, scalar_min, global_scalar_min)
+ call mpas_dmpar_max_real(domain%dminfo, scalar_max, global_scalar_max)
+ write(0,*) 'global min, max w ',global_scalar_min, global_scalar_max
-! if(debug) then
- 101 format(' local min, max scalar',i4,2(1x,e17.10))
- 102 format(' global min, max scalar',i4,2(1x,e17.10))
- write(0,*)
- block => domain % blocklist
- do while (associated(block))
- scalar_min = 0.
- scalar_max = 0.
- do iCell = 1, block % mesh % nCellsSolve
- do k = 1, block % mesh % nVertLevels
- scalar_min = min(scalar_min, block % state % time_levs(2) % state % w % array(k,iCell))
- scalar_max = max(scalar_max, block % state % time_levs(2) % state % w % array(k,iCell))
- enddo
- enddo
- call mpas_dmpar_min_real(domain%dminfo, scalar_min, global_scalar_min)
- call mpas_dmpar_max_real(domain%dminfo, scalar_max, global_scalar_max)
-! write(0,*) 'local min, max w ',scalar_min, scalar_max
- write(0,*) 'global min, max w ',global_scalar_min, global_scalar_max
+ scalar_min = 0.
+ scalar_max = 0.
+ do iEdge = 1, block % mesh % nEdgesSolve
+ do k = 1, block % mesh % nVertLevels
+ scalar_min = min(scalar_min, block % state % time_levs(2) % state % u % array(k,iEdge))
+ scalar_max = max(scalar_max, block % state % time_levs(2) % state % u % array(k,iEdge))
+ end do
+ end do
+ call mpas_dmpar_min_real(domain%dminfo, scalar_min, global_scalar_min)
+ call mpas_dmpar_max_real(domain%dminfo, scalar_max, global_scalar_max)
+ write(0,*) 'global min, max u ',global_scalar_min, global_scalar_max
- scalar_min = 0.
- scalar_max = 0.
- do iEdge = 1, block % mesh % nEdgesSolve
- do k = 1, block % mesh % nVertLevels
- scalar_min = min(scalar_min, block % state % time_levs(2) % state % u % array(k,iEdge))
- scalar_max = max(scalar_max, block % state % time_levs(2) % state % u % array(k,iEdge))
- enddo
- enddo
- call mpas_dmpar_min_real(domain%dminfo, scalar_min, global_scalar_min)
- call mpas_dmpar_max_real(domain%dminfo, scalar_max, global_scalar_max)
-! write(0,*) 'local min, max u ',scalar_min, scalar_max
- write(0,*) 'global min, max u ',global_scalar_min, global_scalar_max
+ do iScalar = 1, block % state % time_levs(2) % state % num_scalars
+ scalar_min = 0.
+ scalar_max = 0.
+ do iCell = 1, block % mesh % nCellsSolve
+ do k = 1, block % mesh % nVertLevels
+ scalar_min = min(scalar_min, block % state % time_levs(2) % state % scalars % array(iScalar,k,iCell))
+ scalar_max = max(scalar_max, block % state % time_levs(2) % state % scalars % array(iScalar,k,iCell))
+ end do
+ end do
+ call mpas_dmpar_min_real(domain%dminfo, scalar_min, global_scalar_min)
+ call mpas_dmpar_max_real(domain%dminfo, scalar_max, global_scalar_max)
+ write(0,102) iScalar,global_scalar_min,global_scalar_max
+ end do
- do iScalar = 1, block % state % time_levs(2) % state % num_scalars
- scalar_min = 0.
- scalar_max = 0.
- do iCell = 1, block % mesh % nCellsSolve
- do k = 1, block % mesh % nVertLevels
- scalar_min = min(scalar_min, block % state % time_levs(2) % state % scalars % array(iScalar,k,iCell))
- scalar_max = max(scalar_max, block % state % time_levs(2) % state % scalars % array(iScalar,k,iCell))
- enddo
- enddo
- call mpas_dmpar_min_real(domain%dminfo, scalar_min, global_scalar_min)
- call mpas_dmpar_max_real(domain%dminfo, scalar_max, global_scalar_max)
-! write(0,101) iScalar,scalar_min,scalar_max
- write(0,102) iScalar,global_scalar_min,global_scalar_max
- end do
- block => block % next
+ block => block % next
+ end do
- end do
-! end if
-
-
end subroutine atm_srk3
!---
subroutine atm_rk_integration_setup( s_old, s_new, diag )
- implicit none
- type (state_type) :: s_new, s_old
- type (diag_type) :: diag
- integer :: iCell, k
+ implicit none
- diag % ru_save % array = diag % ru % array
- diag % rw_save % array = diag % rw % array
- diag % rtheta_p_save % array = diag % rtheta_p % array
- diag % rho_p_save % array = diag % rho_p % array
+ type (state_type) :: s_new, s_old
+ type (diag_type) :: diag
- s_old % u % array = s_new % u % array
- s_old % w % array = s_new % w % array
- s_old % theta_m % array = s_new % theta_m % array
- s_old % rho_zz % array = s_new % rho_zz % array
- s_old % scalars % array = s_new % scalars % array
+ diag % ru_save % array = diag % ru % array
+ diag % rw_save % array = diag % rw % array
+ diag % rtheta_p_save % array = diag % rtheta_p % array
+ diag % rho_p_save % array = diag % rho_p % array
+ s_old % u % array = s_new % u % array
+ s_old % w % array = s_new % w % array
+ s_old % theta_m % array = s_new % theta_m % array
+ s_old % rho_zz % array = s_new % rho_zz % array
+ s_old % scalars % array = s_new % scalars % array
+
end subroutine atm_rk_integration_setup
!-----
subroutine atm_compute_moist_coefficients( state, diag, grid )
+ ! the moist coefficients cqu and cqw serve to transform the inverse dry density (1/rho_d)
+ ! into the inverse full (moist) density (1/rho_m).
+
implicit none
+
type (state_type) :: state
type (diag_type) :: diag
type (mesh_type) :: grid
@@ -483,35 +429,38 @@
integer :: iEdge, iCell, k, cell1, cell2, iq
integer :: nCells, nEdges, nVertLevels, nCellsSolve
real (kind=RKIND) :: qtot
+ integer, dimension(:,:), pointer :: cellsOnEdge
nCells = grid % nCells
nEdges = grid % nEdges
nVertLevels = grid % nVertLevels
nCellsSolve = grid % nCellsSolve
- do iCell = 1, nCellsSolve
- do k = 2, nVertLevels
+ cellsOnEdge => grid % cellsOnEdge % array
+
+ do iCell = 1, nCellsSolve
+ do k = 2, nVertLevels
qtot = 0.
do iq = state % moist_start, state % moist_end
- qtot = qtot + 0.5 * (state % scalars % array (iq, k, iCell) + state % scalars % array (iq, k-1, iCell))
+ qtot = qtot + 0.5 * (state % scalars % array (iq, k, iCell) + state % scalars % array (iq, k-1, iCell))
end do
diag % cqw % array(k,iCell) = 1./(1.+qtot)
- end do
- end do
+ end do
+ end do
- do iEdge = 1, nEdges
- cell1 = grid % cellsOnEdge % array(1,iEdge)
- cell2 = grid % cellsOnEdge % array(2,iEdge)
- if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
do k = 1, nVertLevels
- qtot = 0.
- do iq = state % moist_start, state % moist_end
- qtot = qtot + 0.5 * ( state % scalars % array (iq, k, cell1) + state % scalars % array (iq, k, cell2) )
- end do
- diag % cqu % array(k,iEdge) = 1./( 1. + qtot)
+ qtot = 0.
+ do iq = state % moist_start, state % moist_end
+ qtot = qtot + 0.5 * ( state % scalars % array (iq, k, cell1) + state % scalars % array (iq, k, cell2) )
+ end do
+ diag % cqu % array(k,iEdge) = 1./( 1. + qtot)
end do
- end if
- end do
+ end if
+ end do
end subroutine atm_compute_moist_coefficients
@@ -529,13 +478,14 @@
implicit none
- type (state_type), intent(in) :: s
- type (mesh_type), intent(in) :: grid
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(in) :: grid
type (diag_type), intent(inout) :: diag
- real (kind=RKIND), intent(in) :: dts
+ real (kind=RKIND), intent(in) :: dts
- integer :: i, k, iq
+ integer :: iCell, k, iq
+
integer :: nCells, nVertLevels, nCellsSolve
real (kind=RKIND), dimension(:,:), pointer :: zz, cqw, p, t, rb, rtb, pb, rt
real (kind=RKIND), dimension(:,:), pointer :: cofwr, cofwz, coftz, cofwt, a_tri, alpha_tri, gamma_tri
@@ -549,8 +499,6 @@
nCells = grid % nCells
nCellsSolve = grid % nCellsSolve
nVertLevels = grid % nVertLevels
-! epssm = grid % epssm ! this should come in through the namelist ******************
-! epssm = 0.1
epssm = config_epssm
rdzu => grid % rdzu % array
@@ -585,53 +533,53 @@
cofrz(k) = dtseps*rdzw(k)
end do
- do i = 1, nCellsSolve ! we only need to do cells we are solving for, not halo cells
+ do iCell = 1, nCellsSolve ! we only need to do cells we are solving for, not halo cells
- do k=2,nVertLevels
- cofwr(k,i) =.5*dtseps*gravity*(fzm(k)*zz(k,i)+fzp(k)*zz(k-1,i))
- end do
- coftz(1,i) = 0.0
- do k=2,nVertLevels
- cofwz(k,i) = dtseps*c2*(fzm(k)*zz(k,i)+fzp(k)*zz(k-1,i)) &
- *rdzu(k)*cqw(k,i)*(fzm(k)*p (k,i)+fzp(k)*p (k-1,i))
- coftz(k,i) = dtseps* (fzm(k)*t (k,i)+fzp(k)*t (k-1,i))
- end do
- coftz(nVertLevels+1,i) = 0.0
- do k=1,nVertLevels
+ do k=2,nVertLevels
+ cofwr(k,iCell) =.5*dtseps*gravity*(fzm(k)*zz(k,iCell)+fzp(k)*zz(k-1,iCell))
+ end do
+ coftz(1,iCell) = 0.0
+ do k=2,nVertLevels
+ cofwz(k,iCell) = dtseps*c2*(fzm(k)*zz(k,iCell)+fzp(k)*zz(k-1,iCell)) &
+ *rdzu(k)*cqw(k,iCell)*(fzm(k)*p (k,iCell)+fzp(k)*p (k-1,iCell))
+ coftz(k,iCell) = dtseps* (fzm(k)*t (k,iCell)+fzp(k)*t (k-1,iCell))
+ end do
+ coftz(nVertLevels+1,iCell) = 0.0
+ do k=1,nVertLevels
- qtot = 0.
- do iq = s % moist_start, s % moist_end
- qtot = qtot + s % scalars % array (iq, k, i)
- end do
+ qtot = 0.
+ do iq = s % moist_start, s % moist_end
+ qtot = qtot + s % scalars % array (iq, k, iCell)
+ end do
- cofwt(k,i) = .5*dtseps*rcv*zz(k,i)*gravity*rb(k,i)/(1.+qtot) &
- *p(k,i)/((rtb(k,i)+rt(k,i))*pb(k,i))
- end do
+ cofwt(k,iCell) = .5*dtseps*rcv*zz(k,iCell)*gravity*rb(k,iCell)/(1.+qtot) &
+ *p(k,iCell)/((rtb(k,iCell)+rt(k,iCell))*pb(k,iCell))
+ end do
- a_tri(1,i) = 0. ! note, this value is never used
- b_tri(1) = 1. ! note, this value is never used
- c_tri(1) = 0. ! note, this value is never used
- gamma_tri(1,i) = 0.
- alpha_tri(1,i) = 0. ! note, this value is never used
+ a_tri(1,iCell) = 0. ! note, this value is never used
+ b_tri(1) = 1. ! note, this value is never used
+ c_tri(1) = 0. ! note, this value is never used
+ gamma_tri(1,iCell) = 0.
+ alpha_tri(1,iCell) = 0. ! note, this value is never used
- do k=2,nVertLevels
- a_tri(k,i) = -cofwz(k ,i)* coftz(k-1,i)*rdzw(k-1)*zz(k-1,i) &
- +cofwr(k ,i)* cofrz(k-1 ) &
- -cofwt(k-1,i)* coftz(k-1,i)*rdzw(k-1)
- b_tri(k) = 1. &
- +cofwz(k ,i)*(coftz(k ,i)*rdzw(k )*zz(k ,i) &
- +coftz(k ,i)*rdzw(k-1)*zz(k-1,i)) &
- -coftz(k ,i)*(cofwt(k ,i)*rdzw(k ) &
- -cofwt(k-1,i)*rdzw(k-1)) &
- +cofwr(k, i)*(cofrz(k )-cofrz(k-1))
- c_tri(k) = -cofwz(k ,i)* coftz(k+1,i)*rdzw(k )*zz(k ,i) &
- -cofwr(k ,i)* cofrz(k ) &
- +cofwt(k ,i)* coftz(k+1,i)*rdzw(k )
- end do
- do k=2,nVertLevels
- alpha_tri(k,i) = 1./(b_tri(k)-a_tri(k,i)*gamma_tri(k-1,i))
- gamma_tri(k,i) = c_tri(k)*alpha_tri(k,i)
- end do
+ do k=2,nVertLevels
+ a_tri(k,iCell) = -cofwz(k ,iCell)* coftz(k-1,iCell)*rdzw(k-1)*zz(k-1,iCell) &
+ +cofwr(k ,iCell)* cofrz(k-1 ) &
+ -cofwt(k-1,iCell)* coftz(k-1,iCell)*rdzw(k-1)
+ b_tri(k) = 1. &
+ +cofwz(k ,iCell)*(coftz(k ,iCell)*rdzw(k )*zz(k ,iCell) &
+ +coftz(k ,iCell)*rdzw(k-1)*zz(k-1,iCell)) &
+ -coftz(k ,iCell)*(cofwt(k ,iCell)*rdzw(k ) &
+ -cofwt(k-1,iCell)*rdzw(k-1)) &
+ +cofwr(k, iCell)*(cofrz(k )-cofrz(k-1))
+ c_tri(k) = -cofwz(k ,iCell)* coftz(k+1,iCell)*rdzw(k )*zz(k ,iCell) &
+ -cofwr(k ,iCell)* cofrz(k ) &
+ +cofwt(k ,iCell)* coftz(k+1,iCell)*rdzw(k )
+ end do
+ do k=2,nVertLevels
+ alpha_tri(k,iCell) = 1./(b_tri(k)-a_tri(k,iCell)*gamma_tri(k-1,iCell))
+ gamma_tri(k,iCell) = c_tri(k)*alpha_tri(k,iCell)
+ end do
end do ! loop over cells
@@ -639,51 +587,69 @@
!------------------------
- subroutine atm_set_smlstep_pert_variables( s_old, s_new, tend, diag, grid )
+ subroutine atm_set_smlstep_pert_variables( tend, diag, grid )
+ ! following Klemp et al MWR 2007, we use preturbation variables
+ ! in the acoustic-step integration. This routine computes those
+ ! perturbation variables. state variables are reconstituted after
+ ! the acousstic steps in subroutine atm_recover_large_step_variables
+
+
implicit none
- type (state_type) :: s_new, s_old
+
type (tend_type) :: tend
type (diag_type) :: diag
type (mesh_type) :: grid
- !SHP-w
+
integer :: iCell, iEdge, k, cell1, cell2, coef_3rd_order
+ integer :: nCellsSolve, nCells, nVertLevels, nEdges
integer, dimension(:,:), pointer :: cellsOnEdge
real (kind=RKIND), dimension(:), pointer :: fzm, fzp, dvEdge, areaCell
real (kind=RKIND) :: flux
- !SHP-w
+
coef_3rd_order = config_coef_3rd_order
- if(config_theta_adv_order /=3) coef_3rd_order = 0
+ if (config_theta_adv_order /=3) coef_3rd_order = 0
- !SHP-w
+ nCellsSolve = grid % nCellsSolve
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nVertLevels = grid % nVertLevels
+
fzm => grid % fzm % array
fzp => grid % fzp % array
dvEdge => grid % dvEdge % array
areaCell => grid % areaCell % array
cellsOnEdge => grid % cellsOnEdge % array
+ ! set the acoustic step perturbation variables by subtracting the RK timestep variables
+ ! from their at the previous RK substep.
+
diag % rho_pp % array = diag % rho_p_save % array - diag % rho_p % array
-
diag % ru_p % array = diag % ru_save % array - diag % ru % array
diag % rtheta_pp % array = diag % rtheta_p_save % array - diag % rtheta_p % array
diag % rtheta_pp_old % array = diag % rtheta_pp % array
diag % rw_p % array = diag % rw_save % array - diag % rw % array
- do iCell = 1, grid % nCellsSolve
- do k = 2, grid % nVertLevels
- tend % w % array(k,iCell) = ( fzm(k) * grid % zz % array(k ,iCell) + &
- fzp(k) * grid % zz % array(k-1,iCell) ) &
- * tend % w % array(k,iCell)
+ ! we solve for omega instead of w (see Klemp et al MWR 2007),
+ ! so here we change the w_p tendency to an omega_p tendency
+
+ do iCell = 1, nCellsSolve
+ do k = 2, nVertLevels
+ tend % w % array(k,iCell) = ( fzm(k) * grid % zz % array(k ,iCell) + &
+ fzp(k) * grid % zz % array(k-1,iCell) ) &
+ * tend % w % array(k,iCell)
end do
end do
- do iEdge = 1,grid % nEdges
+ ! here we need to compute the omega tendency in a manner consistent with our diagnosis of omega.
+ ! this requires us to use the same flux divergence as is used in the theta eqn - see Klemp et al MWR 2003.
+ do iEdge = 1, nEdges
+
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- !SHP-w
- do k = 2, grid%nVertLevels
+ do k = 2, nVertLevels
flux = fzm(k) * tend % u % array(k,iEdge) + fzp(k) * tend % u % array(k-1,iEdge)
tend % w % array(k,cell2) = tend % w % array(k,cell2) &
+ (grid % zb % array(k,2,iEdge) + coef_3rd_order*sign(1.0_RKIND,tend % u % array(k,iEdge))*grid %zb3 % array(k,2,iEdge))*flux &
@@ -695,6 +661,8 @@
end do
+ ! ruAvg and wwAvg will store the mass fluxes averaged over the acoustic steps for the subsequent scalar transport.
+
diag % ruAvg % array = 0.
diag % wwAvg % array = 0.
@@ -704,6 +672,12 @@
subroutine atm_advance_acoustic_step( s, diag, tend, grid, dts )
+ ! This subroutine performs the entire acoustic step update, following Klemp et al MWR 2007,
+ ! using forward-backward vertically implicit integration.
+ ! The gravity-waves are included in the acoustic-step integration.
+ ! The input state variables that are updated are ru_p, rw_p (note that this is (rho*omega)_p here),
+ ! rtheta_p, and rho_pp. The time averaged mass flux is accumulated in ruAvg and wwAvg
+
implicit none
type (state_type) :: s
@@ -712,15 +686,17 @@
type (mesh_type) :: grid
real (kind=RKIND), intent(in) :: dts
- real (kind=RKIND), dimension(:,:), pointer :: rho_zz, theta_m, ru_p, rw_p, rtheta_pp, &
- rtheta_pp_old, zz, exner, cqu, ruAvg, &
- wwAvg, rho_pp, cofwt, coftz, zx, &
- a_tri, alpha_tri, gamma_tri, dss, &
- tend_ru, tend_rho, tend_rt, tend_rw, &
+
+ real (kind=RKIND), dimension(:,:), pointer :: rho_zz, theta_m, ru_p, rw_p, rtheta_pp, &
+ rtheta_pp_old, zz, exner, cqu, ruAvg, &
+ wwAvg, rho_pp, cofwt, coftz, zx, &
+ a_tri, alpha_tri, gamma_tri, dss, &
+ tend_ru, tend_rho, tend_rt, tend_rw, &
zgrid, cofwr, cofwz, w, h_divergence
real (kind=RKIND), dimension(:), pointer :: fzm, fzp, rdzw, dcEdge, AreaCell, cofrz, dvEdge
real (kind=RKIND), dimension(:,:), pointer :: cpr, cpl, pzp, pzm
+ integer, dimension(:,:), pointer :: cellsOnEdge
real (kind=RKIND) :: smdiv, c2, rcv
real (kind=RKIND), dimension( grid % nVertLevels ) :: du
@@ -728,7 +704,7 @@
real (kind=RKIND), dimension( grid % nVertLevels, grid % nCells+1 ) :: ts, rs
integer :: cell1, cell2, iEdge, iCell, k
- real (kind=RKIND) :: pgrad, flux1, flux2, flux, resm, epssm
+ real (kind=RKIND) :: pgrad, flux, resm, epssm
real (kind=RKIND) :: cf1, cf2, cf3, pr, pl
integer :: kr, kl
@@ -736,13 +712,11 @@
integer :: nEdges, nCells, nCellsSolve, nVertLevels
logical, parameter :: debug = .false.
-! logical, parameter :: debug = .true.
logical, parameter :: debug1 = .false.
- real (kind=RKIND) :: wmax
- integer :: iwmax, kwmax
logical :: newpx
!--
+ cellsOnEdge => grid % cellsOnEdge % array
rho_zz => s % rho_zz % array
theta_m => s % theta_m % array
@@ -786,8 +760,6 @@
dvEdge => grid % dvEdge % array
AreaCell => grid % AreaCell % array
-! might these be pointers instead? **************************
-
nEdges = grid % nEdges
nCells = grid % nCells
nCellsSolve = grid % nCellsSolve
@@ -801,6 +773,8 @@
cpl => grid % cpl % array
newpx = config_newpx
+ ! epssm is the offcentering coefficient for the vertically implicit integration.
+ ! smdiv is the 3D divergence-damping coefficient.
epssm = config_epssm
smdiv = config_smdiv
@@ -811,18 +785,27 @@
ts = 0.
rs = 0.
- ! acoustic step divergence damping - forward weight rtheta_pp
+ ! acoustic step divergence damping - forward weight rtheta_pp - see Klemp et al MWR 2007
rtheta_pp_old = rtheta_pp + smdiv*(rtheta_pp - rtheta_pp_old)
- if(debug) write(0,*) ' updating ru_p '
+ if (debug) write(0,*) ' updating ru_p '
+ ! forward-backward acoustic step integration.
+ ! begin by updating the horizontal velocity u,
+ ! and accumulating the contribution from the updated u to the other tendencies.
+
+ ! we are looping over all edges, but only computing on edges of owned cells. This will include updates of
+ ! all owned edges plus some edges that are owned by other blocks. We perform these redundant computations
+ ! so that we do not have to communicate updates of u to update the cell variables (rho, w, and theta).
+
do iEdge = 1, nEdges
- cell1 = grid % cellsOnEdge % array (1,iEdge)
- cell2 = grid % cellsOnEdge % array (2,iEdge)
- ! update edge for block-owned cells
- if (cell1 <= grid % nCellsSolve .or. cell2 <= grid % nCellsSolve ) then
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ ! update edges for block-owned cells
+ if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve ) then
+
if (newpx) then
k = 1
@@ -857,13 +840,6 @@
else
k = 1
-! dpzx(k) = .5*zx(k,iEdge)*(cf1*(zz(k ,cell2)*rtheta_pp_old(k ,cell2) &
-! +zz(k ,cell1)*rtheta_pp_old(k ,cell1)) &
-! +cf2*(zz(k+1,cell2)*rtheta_pp_old(k+1,cell2) &
-! +zz(k+1,cell1)*rtheta_pp_old(k+1,cell1)) &
-! +cf3*(zz(k+2,cell2)*rtheta_pp_old(k+2,cell2) &
-! +zz(k+2,cell1)*rtheta_pp_old(k+2,cell1)))
-
dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
*(pzm(k,cell2)*(zz(k+1,cell2)*rtheta_pp_old(k+1,cell2) &
-zz(k ,cell2)*rtheta_pp_old(k ,cell2)) &
@@ -874,11 +850,7 @@
+pzp(k,cell1)*(zz(k+2,cell1)*rtheta_pp_old(k+2,cell1) &
-zz(k ,cell1)*rtheta_pp_old(k ,cell1)))
- do k=2,grid % nVertLevels-1
-! dpzx(k)=.5*zx(k,iEdge)*(fzm(k)*(zz(k ,cell2)*rtheta_pp_old(k ,cell2) &
-! +zz(k ,cell1)*rtheta_pp_old(k ,cell1)) &
-! +fzp(k)*(zz(k-1,cell2)*rtheta_pp_old(k-1,cell2) &
-! +zz(k-1,cell1)*rtheta_pp_old(k-1,cell1)))
+ do k=2,nVertLevels-1
dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
*(pzp(k,cell2)*(zz(k+1,cell2)*rtheta_pp_old(k+1,cell2) &
-zz(k ,cell2)*rtheta_pp_old(k ,cell2)) &
@@ -890,38 +862,30 @@
-zz(k-1,cell1)*rtheta_pp_old(k-1,cell1)))
end do
- k=grid % nVertLevels
+ k = nVertLevels
dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
*(pzm(k,cell2)*(zz(k ,cell2)*rtheta_pp_old(k ,cell2) &
-zz(k-1,cell2)*rtheta_pp_old(k-1,cell2)) &
+pzm(k,cell1)*(zz(k ,cell1)*rtheta_pp_old(k ,cell1) &
-zz(k-1,cell1)*rtheta_pp_old(k-1,cell1)))
-! dpzx(nVertLevels + 1) = 0.
-
do k=1,nVertLevels
-! pgrad = (rtheta_pp_old(k,cell2)-rtheta_pp_old(k,cell1))/dcEdge(iEdge) &
-! - rdzw(k)*(dpzx(k+1)-dpzx(k))
pgrad = ((rtheta_pp_old(k,cell2)*zz(k,cell2) &
-rtheta_pp_old(k,cell1)*zz(k,cell1))/dcEdge(iEdge) &
-dpzx(k))/(.5*(zz(k,cell2)+zz(k,cell1)))
pgrad = 0.5*c2*(exner(k,cell1)+exner(k,cell2))*pgrad
du(k) = dts*(tend_ru(k,iEdge) - cqu(k,iEdge) * pgrad)
-! + (0.05/6.)*dcEdge(iEdge)*(h_divergence(k,cell2)-h_divergence(k,cell1))
end do
end if
do k=1,nVertLevels
+
+ ! full update of ru_p
+
ru_p(k,iEdge) = ru_p(k,iEdge) + du(k)
- if(debug) then
- if(iEdge == 3750) then
- write(0,*) ' k, pgrad, tend_ru ',k,pgrad,tend_ru(k,3750)
- end if
- end if
+ ! add horizontal fluxes using updated ru_p into density update, rtheta update and w update
-! need to add horizontal fluxes into density update, rtheta update and w update
-
flux = dts*dvEdge(iEdge)*ru_p(k,iEdge)
rs(k,cell1) = rs(k,cell1)-flux/AreaCell(cell1)
rs(k,cell2) = rs(k,cell2)+flux/AreaCell(cell2)
@@ -929,67 +893,82 @@
flux = flux*0.5*(theta_m(k,cell2)+theta_m(k,cell1))
ts(k,cell1) = ts(k,cell1)-flux/AreaCell(cell1)
ts(k,cell2) = ts(k,cell2)+flux/AreaCell(cell2)
-
+
+ ! accumulate ru_p for use later in scalar transport
+
ruAvg(k,iEdge) = ruAvg(k,iEdge) + ru_p(k,iEdge)
end do
- end if ! end test for block-owned cells
+ end if ! end test for block-owned cells
end do ! end loop over edges
! saving rtheta_pp before update for use in divergence damping in next acoustic step
+
rtheta_pp_old(:,:) = rtheta_pp(:,:)
+ ! vertically implicit acoustic and gravity wave integration.
+ ! this follows Klemp et al MWR 2007, with the addition of an implicit Rayleigh damping of w
+ ! serves as a gravity-wave absorbing layer, from Klemp et al 2008.
+
do iCell = 1, nCellsSolve
- do k=1, nVertLevels
- rs(k,iCell) = rho_pp(k,iCell) + dts*tend_rho(k,iCell) + rs(k,iCell) &
- - cofrz(k)*resm*(rw_p(k+1,iCell)-rw_p(k,iCell))
- ts(k,iCell) = rtheta_pp(k,iCell) + dts*tend_rt(k,iCell) + ts(k,iCell) &
- - resm*rdzw(k)*(coftz(k+1,iCell)*rw_p(k+1,iCell) &
- -coftz(k,iCell)*rw_p(k,iCell))
- enddo
+ do k=1, nVertLevels
+ rs(k,iCell) = rho_pp(k,iCell) + dts*tend_rho(k,iCell) + rs(k,iCell) &
+ - cofrz(k)*resm*(rw_p(k+1,iCell)-rw_p(k,iCell))
+ ts(k,iCell) = rtheta_pp(k,iCell) + dts*tend_rt(k,iCell) + ts(k,iCell) &
+ - resm*rdzw(k)*(coftz(k+1,iCell)*rw_p(k+1,iCell) &
+ -coftz(k,iCell)*rw_p(k,iCell))
+ end do
- do k=2, nVertLevels
+ do k=2, nVertLevels
- wwavg(k,iCell) = wwavg(k,iCell) + 0.5*(1.-epssm)*rw_p(k,iCell)
+ wwavg(k,iCell) = wwavg(k,iCell) + 0.5*(1.-epssm)*rw_p(k,iCell)
- rw_p(k,iCell) = rw_p(k,iCell) + dts*tend_rw(k,iCell) &
- - cofwz(k,iCell)*((zz(k ,iCell)*ts (k ,iCell) &
- -zz(k-1,iCell)*ts (k-1,iCell)) &
- +resm*(zz(k ,iCell)*rtheta_pp(k ,iCell) &
- -zz(k-1,iCell)*rtheta_pp(k-1,iCell))) &
- - cofwr(k,iCell)*((rs (k,iCell)+rs (k-1,iCell)) &
- +resm*(rho_pp(k,iCell)+rho_pp(k-1,iCell))) &
- + cofwt(k ,iCell)*(ts (k ,iCell)+resm*rtheta_pp(k ,iCell)) &
- + cofwt(k-1,iCell)*(ts (k-1,iCell)+resm*rtheta_pp(k-1,iCell))
- enddo
+ rw_p(k,iCell) = rw_p(k,iCell) + dts*tend_rw(k,iCell) &
+ - cofwz(k,iCell)*((zz(k ,iCell)*ts (k ,iCell) &
+ -zz(k-1,iCell)*ts (k-1,iCell)) &
+ +resm*(zz(k ,iCell)*rtheta_pp(k ,iCell) &
+ -zz(k-1,iCell)*rtheta_pp(k-1,iCell))) &
+ - cofwr(k,iCell)*((rs (k,iCell)+rs (k-1,iCell)) &
+ +resm*(rho_pp(k,iCell)+rho_pp(k-1,iCell))) &
+ + cofwt(k ,iCell)*(ts (k ,iCell)+resm*rtheta_pp(k ,iCell)) &
+ + cofwt(k-1,iCell)*(ts (k-1,iCell)+resm*rtheta_pp(k-1,iCell))
+ end do
- do k=2,nVertLevels
- rw_p(k,iCell) = (rw_p(k,iCell)-a_tri(k,iCell)*rw_p(k-1,iCell))*alpha_tri(k,iCell)
- end do
+ ! tridiagonal solve sweeping up and then down the column
- do k=nVertLevels,1,-1
- rw_p(k,iCell) = rw_p(k,iCell) - gamma_tri(k,iCell)*rw_p(k+1,iCell)
- end do
+ do k=2,nVertLevels
+ rw_p(k,iCell) = (rw_p(k,iCell)-a_tri(k,iCell)*rw_p(k-1,iCell))*alpha_tri(k,iCell)
+ end do
- do k=2,nVertLevels
- rw_p(k,iCell) = (rw_p(k,iCell)-dts*dss(k,iCell)* &
- (fzm(k)*zz (k,iCell)+fzp(k)*zz (k-1,iCell)) &
- *(fzm(k)*rho_zz(k,iCell)+fzp(k)*rho_zz(k-1,iCell)) &
- *w(k,iCell) )/(1.+dts*dss(k,iCell))
+ do k=nVertLevels,1,-1
+ rw_p(k,iCell) = rw_p(k,iCell) - gamma_tri(k,iCell)*rw_p(k+1,iCell)
+ end do
- wwAvg(k,iCell) = wwAvg(k,iCell) + 0.5*(1.+epssm)*rw_p(k,iCell)
+ ! the implicit Rayleigh damping on w (gravity-wave absorbing)
- end do
+ do k=2,nVertLevels
+ rw_p(k,iCell) = (rw_p(k,iCell)-dts*dss(k,iCell)* &
+ (fzm(k)*zz (k,iCell)+fzp(k)*zz (k-1,iCell)) &
+ *(fzm(k)*rho_zz(k,iCell)+fzp(k)*rho_zz(k-1,iCell)) &
+ *w(k,iCell) )/(1.+dts*dss(k,iCell))
+
+ ! accumulate (rho*omega)' for use later in scalar transport
- do k=1,nVertLevels
- rho_pp(k,iCell) = rs(k,iCell) - cofrz(k) *(rw_p(k+1,iCell)-rw_p(k ,iCell))
- rtheta_pp(k,iCell) = ts(k,iCell) - rdzw(k)*(coftz(k+1,iCell)*rw_p(k+1,iCell) &
- -coftz(k ,iCell)*rw_p(k ,iCell))
- end do
+ wwAvg(k,iCell) = wwAvg(k,iCell) + 0.5*(1.+epssm)*rw_p(k,iCell)
+
+ end do
+ ! update rho_pp and theta_pp given updated rw_p
+
+ do k=1,nVertLevels
+ rho_pp(k,iCell) = rs(k,iCell) - cofrz(k) *(rw_p(k+1,iCell)-rw_p(k ,iCell))
+ rtheta_pp(k,iCell) = ts(k,iCell) - rdzw(k)*(coftz(k+1,iCell)*rw_p(k+1,iCell) &
+ -coftz(k ,iCell)*rw_p(k ,iCell))
+ end do
+
end do ! end of loop over cells
end subroutine atm_advance_acoustic_step
@@ -998,7 +977,13 @@
subroutine atm_recover_large_step_variables( s, diag, tend, grid, dt, ns, rk_step )
+ ! reconstitute state variables from acoustic-step perturbation variables
+ ! after the acoustic steps. The perturbation variables were originally set in
+ ! subroutine atm_set_smlstep_pert_variables prior to their acoustic-steps update.
+ ! we are also computing a few other state-derived variables here.
+
implicit none
+
type (state_type) :: s
type (diag_type) :: diag
type (tend_type) :: tend
@@ -1006,12 +991,13 @@
integer, intent(in) :: ns, rk_step
real (kind=RKIND), intent(in) :: dt
+
real (kind=RKIND), dimension(:,:), pointer :: wwAvg, rw_save, w, rw, rw_p, rtheta_p, rtheta_pp, &
rtheta_p_save, rt_diabatic_tend, rho_p, rho_p_save, &
rho_pp, rho_zz, rho_base, ruAvg, ru_save, ru_p, u, ru, &
exner, exner_base, rtheta_base, pressure_p, &
zz, theta_m, pressure_b, qvapor
- real (kind=RKIND), dimension(:), pointer :: fzm, fzp, dvEdge, AreaCell
+ real (kind=RKIND), dimension(:), pointer :: fzm, fzp, dvEdge, areaCell
real (kind=RKIND), dimension(:,:,:), pointer :: zb, zb3
integer, dimension(:,:), pointer :: cellsOnEdge
@@ -1019,86 +1005,79 @@
integer :: nVertLevels, nCells, nCellsSolve, nEdges, nEdgesSolve
real (kind=RKIND) :: rcv, p0, cf1, cf2, cf3, flux, coef_3rd_order
-! logical, parameter :: debug=.true.
logical, parameter :: debug=.false.
-!---
- wwAvg => diag % wwAvg % array
- rw_save => diag % rw_save % array
- rw => diag % rw % array
- rw_p => diag % rw_p % array
- w => s % w % array
- rtheta_p => diag % rtheta_p % array
- rtheta_p_save => diag % rtheta_p_save % array
- rtheta_pp => diag % rtheta_pp % array
- rtheta_base => diag % rtheta_base % array
- rt_diabatic_tend => tend % rt_diabatic_tend % array
- theta_m => s % theta_m % array
- qvapor => s % scalars % array(s%index_qv,:,:)
+ wwAvg => diag % wwAvg % array
+ rw_save => diag % rw_save % array
+ rw => diag % rw % array
+ rw_p => diag % rw_p % array
+ w => s % w % array
- rho_zz => s % rho_zz % array
- rho_p => diag % rho_p % array
- rho_p_save => diag % rho_p_save % array
- rho_pp => diag % rho_pp % array
- rho_base => diag % rho_base % array
+ rtheta_p => diag % rtheta_p % array
+ rtheta_p_save => diag % rtheta_p_save % array
+ rtheta_pp => diag % rtheta_pp % array
+ rtheta_base => diag % rtheta_base % array
+ rt_diabatic_tend => tend % rt_diabatic_tend % array
+ theta_m => s % theta_m % array
+ qvapor => s % scalars % array(s%index_qv,:,:)
- ruAvg => diag % ruAvg % array
- ru_save => diag % ru_save % array
- ru_p => diag % ru_p % array
- ru => diag % ru % array
- u => s % u % array
+ rho_zz => s % rho_zz % array
+ rho_p => diag % rho_p % array
+ rho_p_save => diag % rho_p_save % array
+ rho_pp => diag % rho_pp % array
+ rho_base => diag % rho_base % array
- exner => diag % exner % array
- exner_base => diag % exner_base % array
+ ruAvg => diag % ruAvg % array
+ ru_save => diag % ru_save % array
+ ru_p => diag % ru_p % array
+ ru => diag % ru % array
+ u => s % u % array
- pressure_p => diag % pressure_p % array
- pressure_b => diag % pressure_base % array
+ exner => diag % exner % array
+ exner_base => diag % exner_base % array
- zz => grid % zz % array
- zb => grid % zb % array
- zb3 => grid % zb3 % array
- fzm => grid % fzm % array
- fzp => grid % fzp % array
- dvEdge => grid % dvEdge % array
- AreaCell => grid % AreaCell % array
- CellsOnEdge => grid % CellsOnEdge % array
+ pressure_p => diag % pressure_p % array
+ pressure_b => diag % pressure_base % array
- nVertLevels = grid % nVertLevels
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- nEdges = grid % nEdges
- nEdgesSolve = grid % nEdgesSolve
+ zz => grid % zz % array
+ zb => grid % zb % array
+ zb3 => grid % zb3 % array
+ fzm => grid % fzm % array
+ fzp => grid % fzp % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ cellsOnEdge => grid % cellsOnEdge % array
- rcv = rgas/(cp-rgas)
- p0 = 1.e+05 ! this should come from somewhere else...
+ nVertLevels = grid % nVertLevels
+ nCells = grid % nCells
+ nCellsSolve = grid % nCellsSolve
+ nEdges = grid % nEdges
+ nEdgesSolve = grid % nEdgesSolve
- cf1 = grid % cf1 % scalar
- cf2 = grid % cf2 % scalar
- cf3 = grid % cf3 % scalar
- coef_3rd_order = config_coef_3rd_order
- if(config_theta_adv_order /=3) coef_3rd_order = 0
+ rcv = rgas/(cp-rgas)
+ p0 = 1.e+05 ! this should come from somewhere else...
+ cf1 = grid % cf1 % scalar
+ cf2 = grid % cf2 % scalar
+ cf3 = grid % cf3 % scalar
+ coef_3rd_order = config_coef_3rd_order
+ if (config_theta_adv_order /=3) coef_3rd_order = 0
+
! compute new density everywhere so we can compute u from ru.
! we will also need it to compute theta_m below
do iCell = 1, nCells
- do k = 1, nVertLevels
+ do k = 1, nVertLevels
- rho_p(k,iCell) = rho_p(k,iCell) + rho_pp(k,iCell)
+ rho_p(k,iCell) = rho_p(k,iCell) + rho_pp(k,iCell)
- rho_zz(k,iCell) = rho_p(k,iCell) + rho_base(k,iCell)
- end do
+ rho_zz(k,iCell) = rho_p(k,iCell) + rho_base(k,iCell)
+ end do
- ! recover owned-cell values in block
-
-! if( iCell <= nCellsSolve ) then ! If using this test, more halo exchanges will be needed
-! WCS-parallel: OK
-
-
- w(1,iCell) = 0.
- do k = 2, nVertLevels
+ w(1,iCell) = 0.
+ do k = 2, nVertLevels
wwAvg(k,iCell) = rw(k,iCell) + (wwAvg(k,iCell) / float(ns))
rw(k,iCell) = rw(k,iCell) + rw_p(k,iCell)
@@ -1107,27 +1086,27 @@
! pick up part of diagnosed w from omega
w(k,iCell) = rw(k,iCell)/( (fzm(k)*zz (k,iCell)+fzp(k)*zz (k-1,iCell)) &
*(fzm(k)*rho_zz(k,iCell)+fzp(k)*rho_zz(k-1,iCell)) )
- end do
- w(nVertLevels+1,iCell) = 0.
+ end do
+ w(nVertLevels+1,iCell) = 0.
- if(rk_step == 3) then
+ if (rk_step == 3) then
do k = 1, nVertLevels
rtheta_p(k,iCell) = rtheta_p(k,iCell) + rtheta_pp(k,iCell) &
- dt * rho_zz(k,iCell) * rt_diabatic_tend(k,iCell)
end do
- else
+ else
do k = 1, nVertLevels
rtheta_p(k,iCell) = rtheta_p(k,iCell) + rtheta_pp(k,iCell)
end do
- end if
+ end if
- do k = 1, nVertLevels
+ do k = 1, nVertLevels
theta_m(k,iCell) = (rtheta_p(k,iCell) + rtheta_base(k,iCell))/rho_zz(k,iCell)
exner(k,iCell) = (zz(k,iCell)*(rgas/p0)*(rtheta_p(k,iCell)+rtheta_base(k,iCell)))**rcv
- ! pressure below is perturbation pressure
+ ! pressure_p is perturbation pressure
pressure_p(k,iCell) = zz(k,iCell) * rgas * (exner(k,iCell)*rtheta_p(k,iCell)+rtheta_base(k,iCell) &
* (exner(k,iCell)-exner_base(k,iCell)))
- end do
+ end do
end do
@@ -1137,45 +1116,35 @@
do iEdge = 1, nEdges
- cell1 = CellsOnEdge(1,iEdge)
- cell2 = CellsOnEdge(2,iEdge)
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
-! if( cell1 <= nCellsSolve .or. cell2 <= nCellsSolve ) then ! If using this test, more halo exchanges will be needed,
- ! though we can avoid division by zero, e.g., by rho_zz(:,cell2)
- do k = 1, nVertLevels
-
-
-! WCS-parallel: we could pick this up in the last acoustic step (ruAvg) because we solve for all edges of owned cells
-
+ do k = 1, nVertLevels
ruAvg(k,iEdge) = ru(k,iEdge) + (ruAvg(k,iEdge) / float(ns))
-
ru(k,iEdge) = ru(k,iEdge) + ru_p(k,iEdge)
-
u(k,iEdge) = 2.*ru(k,iEdge)/(rho_zz(k,cell1)+rho_zz(k,cell2))
- enddo
+ end do
+ ! finish recovering w from (rho*omega)_p. as when we formed (rho*omega)_p from u and w, we need
+ ! to use the same flux-divergence operator as is used for the horizontal theta transport
+ ! (See Klemp et al 2003).
-! WCS-parallel: we likely only need this for owned cells
+ flux = cf1*ru(1,iEdge) + cf2*ru(2,iEdge) + cf3*ru(3,iEdge)
+ w(1,cell2) = w(1,cell2) - (zb(1,2,iEdge) + sign(1.0_RKIND,flux)*coef_3rd_order*zb3(1,2,iEdge)) &
+ *flux/(cf1*rho_zz(1,cell2)+cf2*rho_zz(2,cell2)+cf3*rho_zz(3,cell2))
+ w(1,cell1) = w(1,cell1) + (zb(1,1,iEdge) + sign(1.0_RKIND,flux)*coef_3rd_order*zb3(1,1,iEdge)) &
+ *flux/(cf1*rho_zz(1,cell1)+cf2*rho_zz(2,cell1)+cf3*rho_zz(3,cell1))
- !SHP-mtn
- flux = cf1*ru(1,iEdge) + cf2*ru(2,iEdge) + cf3*ru(3,iEdge)
- w(1,cell2) = w(1,cell2) - (zb(1,2,iEdge) + sign(1.0_RKIND,flux)*coef_3rd_order*zb3(1,2,iEdge)) &
- *flux/(cf1*rho_zz(1,cell2)+cf2*rho_zz(2,cell2)+cf3*rho_zz(3,cell2))
- w(1,cell1) = w(1,cell1) + (zb(1,1,iEdge) + sign(1.0_RKIND,flux)*coef_3rd_order*zb3(1,1,iEdge)) &
- *flux/(cf1*rho_zz(1,cell1)+cf2*rho_zz(2,cell1)+cf3*rho_zz(3,cell1))
-
- do k = 2, nVertLevels
+ do k = 2, nVertLevels
flux = (fzm(k)*ru(k,iEdge)+fzp(k)*ru(k-1,iEdge))
w(k,cell2) = w(k,cell2) - (zb(k,2,iEdge)+sign(1.0_RKIND,flux)*coef_3rd_order*zb3(k,2,iEdge)) &
*flux/(fzm(k)*rho_zz(k,cell2)+fzp(k)*rho_zz(k-1,cell2))
w(k,cell1) = w(k,cell1) + (zb(k,1,iEdge)+sign(1.0_RKIND,flux)*coef_3rd_order*zb3(k,1,iEdge)) &
*flux/(fzm(k)*rho_zz(k,cell1)+fzp(k)*rho_zz(k-1,cell1))
- enddo
+ end do
-! end if
+ end do
- enddo
-
end subroutine atm_recover_large_step_variables
!---------------------------------------------------------------------------------------
@@ -1183,10 +1152,21 @@
subroutine atm_advance_scalars( tend, s_old, s_new, diag, grid, dt)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
- ! Input: s - current model state
+ ! Integrate scalar equations - explicit transport plus other tendencies
+ !
+ ! Input: s - current model state,
+ ! including tendencies from sources other than resolved transport.
! grid - grid metadata
!
- ! Output: tend - computed scalar tendencies
+ ! input scalars in state are uncoupled (i.e. not mulitplied by density)
+ !
+ ! Output: updated uncoupled scalars (scalars in s_new).
+ ! Note: scalar tendencies are also modified by this routine.
+ !
+ ! This routine DOES NOT apply any positive definite or monotonic renormalizations.
+ !
+ ! The transport scheme is from Skamarock and Gassmann MWR 2011.
+ !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
implicit none
@@ -1199,8 +1179,7 @@
real (kind=RKIND) :: dt
integer :: i, iCell, iEdge, k, iScalar, cell1, cell2
- real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2, scalar_weight
- real (kind=RKIND) :: scalar_weight_cell1, scalar_weight_cell2
+ real (kind=RKIND) :: scalar_weight
real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
@@ -1213,15 +1192,13 @@
real (kind=RKIND), dimension(:,:), pointer :: adv_coefs, adv_coefs_3rd
real (kind=RKIND), dimension( s_old % num_scalars, grid % nVertLevels ) :: flux_arr
- real (kind=RKIND), dimension( s_old % num_scalars, grid % nVertLevels ) :: d2fdx2_cell1_arr, d2fdx2_cell2_arr
-
real (kind=RKIND), dimension( s_old % num_scalars, grid % nVertLevels + 1 ) :: wdtn
- integer :: nVertLevels
+ integer :: nCellsSolve, nEdges, nVertLevels
real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw, meshScalingDel2, meshScalingDel4
real (kind=RKIND) :: coef_3rd_order
- real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2, scalar_turb_flux, z1,z2,z3,z4,zm,z0,zp
+ real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2
real (kind=RKIND) :: flux3, flux4
real (kind=RKIND) :: q_im2, q_im1, q_i, q_ip1, ua, coef3
@@ -1262,6 +1239,8 @@
adv_coefs => grid % adv_coefs % array
adv_coefs_3rd => grid % adv_coefs_3rd % array
+ nCellsSolve = grid % nCellsSolve
+ nEdges = grid % nEdges
nVertLevels = grid % nVertLevels
h_theta_eddy_visc2 = config_h_theta_eddy_visc2
@@ -1276,138 +1255,159 @@
#endif
!
- ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts form scalar_old
+ ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts from scalar_old
!
- !
! horizontal flux divergence, accumulate in scalar_tend
- do iEdge=1,grid%nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- if (cell1 <= grid%nCellsSolve .or. cell2 <= grid%nCellsSolve) then ! only for owned cells
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then ! only for owned cells
- flux_arr(:,:) = 0.
- do i=1,nAdvCellsForEdge(iEdge)
- iCell = advCellsForEdge(i,iEdge)
- do k=1,grid % nVertLevels
- scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(i,iEdge)
- do iScalar=1,s_old % num_scalars
+ ! flux_arr stores the value of the scalar at the edge.
+ ! a better name perhaps would be scalarEdge
+
+ flux_arr(:,:) = 0.
+ do i=1,nAdvCellsForEdge(iEdge)
+ iCell = advCellsForEdge(i,iEdge)
+ do k=1,nVertLevels
+ scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(i,iEdge)
+ do iScalar=1,s_old % num_scalars
flux_arr(iScalar,k) = flux_arr(iScalar,k) + scalar_weight* scalar_new(iScalar,k,iCell)
- end do
- end do
+ end do
end do
+ end do
- do k=1,grid % nVertLevels
- do iScalar=1,s_old % num_scalars
- scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) &
- - uhAvg(k,iEdge)*flux_arr(iScalar,k)/areaCell(cell1)
- scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) &
- + uhAvg(k,iEdge)*flux_arr(iScalar,k)/areaCell(cell2)
- end do
- end do
+ ! here we add the horizontal flux divergence into the scalar tendency.
+ ! note that the scalar tendency is modified.
- end if
- end do
+ do k=1,nVertLevels
+ do iScalar=1,s_old % num_scalars
+ scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) &
+ - uhAvg(k,iEdge)*flux_arr(iScalar,k)/areaCell(cell1)
+ scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) &
+ + uhAvg(k,iEdge)*flux_arr(iScalar,k)/areaCell(cell2)
+ end do
+ end do
+ end if
+ end do
+
!
- ! vertical flux divergence
+ ! vertical flux divergence and update of the scalars
!
! zero fluxes at top and bottom
- wdtn(:,1) = 0.
- wdtn(:,grid % nVertLevels+1) = 0.
+ wdtn(:,1) = 0.
+ wdtn(:,nVertLevels+1) = 0.
- if (config_scalar_vadv_order == 2) then
+ if (config_scalar_vadv_order == 2) then
- do iCell=1,grid % nCellsSolve
- do k = 2, nVertLevels
- do iScalar=1,s_old % num_scalars
+ do iCell=1,nCellsSolve
+ do k = 2, nVertLevels
+ do iScalar=1,s_old % num_scalars
wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
- end do
- end do
- do k=1,grid % nVertLevels ! Could be nVertLevelsSolve?
- do iScalar=1,s_old % num_scalars
+ end do
+ end do
+ do k=1,nVertLevels
+ do iScalar=1,s_old % num_scalars
scalar_new(iScalar,k,iCell) = ( scalar_old(iScalar,k,iCell)*h_old(k,iCell) &
+ dt*( scalar_tend(iScalar,k,iCell) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) )/h_new(k,iCell)
- end do
- end do
- end do
+ end do
+ end do
+ end do
- else if ( config_scalar_vadv_order == 3 ) then
+ else if ( config_scalar_vadv_order == 3 ) then
- do iCell=1,grid % nCellsSolve
+ do iCell=1,nCellsSolve
- k = 2
- do iScalar=1,s_old % num_scalars
+ k = 2
+ do iScalar=1,s_old % num_scalars
wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
- enddo
+ end do
- do k=3,nVertLevels-1
+ do k=3,nVertLevels-1
do iScalar=1,s_old % num_scalars
- wdtn(iScalar,k) = flux3( scalar_new(iScalar,k-2,iCell),scalar_new(iScalar,k-1,iCell), &
- scalar_new(iScalar,k ,iCell),scalar_new(iScalar,k+1,iCell), &
- wwAvg(k,iCell), coef_3rd_order )
+ wdtn(iScalar,k) = flux3( scalar_new(iScalar,k-2,iCell),scalar_new(iScalar,k-1,iCell), &
+ scalar_new(iScalar,k ,iCell),scalar_new(iScalar,k+1,iCell), &
+ wwAvg(k,iCell), coef_3rd_order )
end do
- end do
- k = nVertLevels
- do iScalar=1,s_old % num_scalars
+ end do
+ k = nVertLevels
+ do iScalar=1,s_old % num_scalars
wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
- enddo
+ end do
- do k=1,grid % nVertLevels ! Could be nVertLevelsSolve?
- do iScalar=1,s_old % num_scalars
+ do k=1,nVertLevels
+ do iScalar=1,s_old % num_scalars
scalar_new(iScalar,k,iCell) = ( scalar_old(iScalar,k,iCell)*h_old(k,iCell) &
+ dt*( scalar_tend(iScalar,k,iCell) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) )/h_new(k,iCell)
- end do
- end do
+ end do
+ end do
- end do
+ end do
- else if ( config_scalar_vadv_order == 4 ) then
+ else if ( config_scalar_vadv_order == 4 ) then
- do iCell=1,grid % nCellsSolve
+ do iCell=1,nCellsSolve
- k = 2
- do iScalar=1,s_old % num_scalars
+ k = 2
+ do iScalar=1,s_old % num_scalars
wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
- enddo
- do k=3,nVertLevels-1
+ end do
+ do k=3,nVertLevels-1
do iScalar=1,s_old % num_scalars
- wdtn(iScalar,k) = flux4( scalar_new(iScalar,k-2,iCell),scalar_new(iScalar,k-1,iCell), &
- scalar_new(iScalar,k ,iCell),scalar_new(iScalar,k+1,iCell), wwAvg(k,iCell) )
+ wdtn(iScalar,k) = flux4( scalar_new(iScalar,k-2,iCell),scalar_new(iScalar,k-1,iCell), &
+ scalar_new(iScalar,k ,iCell),scalar_new(iScalar,k+1,iCell), wwAvg(k,iCell) )
end do
- end do
- k = nVertLevels
- do iScalar=1,s_old % num_scalars
+ end do
+ k = nVertLevels
+ do iScalar=1,s_old % num_scalars
wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
- enddo
+ end do
- do k=1,grid % nVertLevels ! Could be nVertLevelsSolve?
- do iScalar=1,s_old % num_scalars
+ do k=1,nVertLevels
+ do iScalar=1,s_old % num_scalars
scalar_new(iScalar,k,iCell) = ( scalar_old(iScalar,k,iCell)*h_old(k,iCell) &
+ dt*( scalar_tend(iScalar,k,iCell) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) )/h_new(k,iCell)
- end do
- end do
+ end do
+ end do
- end do
+ end do
- else
+ else
- write(0,*) ' bad value for config_scalar_vadv_order - ', config_scalar_vadv_order
+ write(0,*) ' bad value for config_scalar_vadv_order - ', config_scalar_vadv_order
- end if
+ end if
end subroutine atm_advance_scalars
!---------------------------
- subroutine atm_advance_scalars_mono(tend, s_old, s_new, diag, grid, dt, rk_step, rk_order)
+ subroutine atm_advance_scalars_mono(tend, s_old, s_new, diag, grid, dt)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
- ! Input: s - current model state
+ ! Integrate scalar equations - transport plus other tendencies
+ !
+ ! Input: s - current model state,
+ ! including tendencies from sources other than resolved transport.
! grid - grid metadata
!
+ ! input scalars in state are uncoupled (i.e. not mulitplied by density)
+ !
+ ! Output: updated uncoupled scalars (scalars in s_new).
+ ! Note: scalar tendencies are also modified by this routine.
+ !
+ ! This routine DOES apply positive definite or monotonic renormalizations.
+ !
+ ! The transport scheme is from Skamarock and Gassmann MWR 2011.
+ !
+ ! The positive-definite or monotonic renormalization is from Zalesak JCP 1979
+ ! as used in the RK3 scheme as described in Wang et al MWR 2009
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
implicit none
type (tend_type),intent(in) :: tend
@@ -1416,12 +1416,10 @@
type (diag_type),intent(in) :: diag
type (mesh_type),intent(in) :: grid
real (kind=RKIND),intent(in) :: dt
- integer, intent(in) :: rk_step, rk_order
type (block_type), pointer :: block
integer :: i, iCell, iEdge, k, iScalar, cell1, cell2
- real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2, scalar_weight
- real (kind=RKIND) :: scalar_weight_cell1, scalar_weight_cell2
+ real (kind=RKIND) :: flux, scalar_weight
real (kind=RKIND), dimension(:,:,:), pointer :: scalar_tend
real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
@@ -1433,22 +1431,25 @@
integer, dimension(:), pointer :: nAdvCellsForEdge
real (kind=RKIND), dimension(:,:), pointer :: adv_coefs, adv_coefs_3rd
- type (field2DReal), pointer :: tempField
- type (field2DReal), target :: tempFieldTarget
+ type (field3DReal), pointer :: tempField
+ type (field3DReal), target :: tempFieldTarget
real (kind=RKIND), dimension( grid % nVertLevels, grid % nCells ) :: scalar_old, scalar_new
- real (kind=RKIND), dimension( grid % nVertLevels, grid % nCells ) :: s_max, s_min, s_update
- real (kind=RKIND), dimension( grid % nVertLevels, grid % nCells ), target :: scale_in, scale_out
+ real (kind=RKIND), dimension( grid % nVertLevels, grid % nCells ) :: s_max, s_min
+ real (kind=RKIND), dimension( 2, grid % nVertLevels, grid % nCells ), target :: scale_arr
+ integer, parameter :: SCALE_IN = 1, SCALE_OUT = 2
+
real (kind=RKIND), dimension( grid % nVertLevels, grid % nEdges ) :: flux_arr
real (kind=RKIND), dimension( grid % nVertLevels + 1, grid % nCells ) :: wdtn
- integer :: nVertLevels, isc, num_scalars, icellmax, kmax
+ integer :: nCells, nCellsSolve, nEdges, nVertLevels, num_scalars, icellmax, kmax
real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw, meshScalingDel2, meshScalingDel4
+ integer, dimension(:), pointer :: nEdgesOnCell
real (kind=RKIND) :: coef_3rd_order
- real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2, scalar_turb_flux, z1,z2,z3,z4,zm,z0,zp
+ real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2
real (kind=RKIND) :: flux3, flux4, flux_upwind
real (kind=RKIND) :: q_im2, q_im1, q_i, q_ip1, ua, coef3, scmin,scmax
@@ -1487,11 +1488,15 @@
meshScalingDel2 => grid % meshScalingDel2 % array
meshScalingDel4 => grid % meshScalingDel4 % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
nAdvCellsForEdge => grid % nAdvCellsForEdge % array
advCellsForEdge => grid % advCellsForEdge % array
adv_coefs => grid % adv_coefs % array
adv_coefs_3rd => grid % adv_coefs_3rd % array
+ nCells = grid % nCells
+ nCellsSolve = grid % nCellsSolve
+ nEdges = grid % nEdges
nVertLevels = grid % nVertLevels
h_theta_eddy_visc2 = config_h_theta_eddy_visc2
@@ -1505,13 +1510,13 @@
scalar_tend = 0. ! testing purposes - we have no sources or sinks
#endif
- !
- ! Update scalars for physics (i.e., what is in scalar_tend)
- ! we should probably move this to another routine called before mono advection ****
- !
+ ! for positive-definite or monotonic option, we first update scalars using the tendency from sources other than
+ ! the resolved transport (these should constitute a positive definite update).
+ ! Note, however, that we enforce positive-definiteness in this update.
+ ! The transport will maintain this positive definite solution and optionally, shape preservation (monotonicity).
- do iCell = 1,grid%nCellsSolve
- do k = 1, grid%nVertLevels
+ do iCell = 1, nCellsSolve
+ do k = 1, nVertLevels
do iScalar = 1,s_old%num_scalars
s_old % scalars % array(iScalar,k,iCell) = s_old % scalars % array(iScalar,k,iCell)+dt*scalar_tend(iScalar,k,iCell) / h_old(k,iCell)
scalar_tend(iScalar,k,iCell) = 0.
@@ -1532,34 +1537,36 @@
num_scalars = 1
do iScalar = 1, s_old % num_scalars
- write(0,*) ' mono transport for scalar ',iScalar
+ write(0,*) ' mono transport for scalar ',iScalar
- do iCell = 1, grid%nCells
- do k=1, grid%nVertLevels
- scalar_old(k,iCell) = s_old % scalars % array(iScalar,k,iCell)
- scalar_new(k,iCell) = s_new % scalars % array(iScalar,k,iCell)
- end do
- end do
+ do iCell = 1, nCells
+ do k = 1, nVertLevels
+ scalar_old(k,iCell) = s_old % scalars % array(iScalar,k,iCell)
+ scalar_new(k,iCell) = s_new % scalars % array(iScalar,k,iCell)
+ end do
+ end do
- scmin = scalar_old(1,1)
- scmax = scalar_old(1,1)
- do iCell = 1, grid%nCells
- do k=1, grid%nVertLevels
- scmin = min(scmin,scalar_old(k,iCell))
- scmax = max(scmax,scalar_old(k,iCell))
- enddo
- enddo
- write(0,*) ' scmin, scmin old in ',scmin,scmax
+ if (debug_print) then
+ scmin = scalar_old(1,1)
+ scmax = scalar_old(1,1)
+ do iCell = 1, nCells
+ do k=1, nVertLevels
+ scmin = min(scmin,scalar_old(k,iCell))
+ scmax = max(scmax,scalar_old(k,iCell))
+ end do
+ end do
+ write(0,*) ' scmin, scmin old in ',scmin,scmax
- scmin = scalar_new(1,1)
- scmax = scalar_new(1,1)
- do iCell = 1, grid%nCells
- do k=1, grid%nVertLevels
- scmin = min(scmin,scalar_new(k,iCell))
- scmax = max(scmax,scalar_new(k,iCell))
- enddo
- enddo
- write(0,*) ' scmin, scmin new in ',scmin,scmax
+ scmin = scalar_new(1,1)
+ scmax = scalar_new(1,1)
+ do iCell = 1, nCells
+ do k=1, nVertLevels
+ scmin = min(scmin,scalar_new(k,iCell))
+ scmax = max(scmax,scalar_new(k,iCell))
+ end do
+ end do
+ write(0,*) ' scmin, scmin new in ',scmin,scmax
+ end if
!
@@ -1567,42 +1574,42 @@
!
- do iCell=1,grid % nCellsSolve
+ do iCell=1,nCellsSolve
- ! zero flux at top and bottom
- wdtn(1,iCell) = 0.
- wdtn(grid % nVertLevels+1,iCell) = 0.
+ ! zero flux at top and bottom
+ wdtn(1,iCell) = 0.
+ wdtn(grid % nVertLevels+1,iCell) = 0.
- k = 1
- s_max(k,iCell) = max(scalar_old(1,iCell),scalar_old(2,iCell))
- s_min(k,iCell) = min(scalar_old(1,iCell),scalar_old(2,iCell))
+ k = 1
+ s_max(k,iCell) = max(scalar_old(1,iCell),scalar_old(2,iCell))
+ s_min(k,iCell) = min(scalar_old(1,iCell),scalar_old(2,iCell))
- k = 2
- wdtn(k,iCell) = wwAvg(k,iCell)*(fnm(k)*scalar_new(k,iCell)+fnp(k)*scalar_new(k-1,iCell))
- s_max(k,iCell) = max(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell))
- s_min(k,iCell) = min(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell))
+ k = 2
+ wdtn(k,iCell) = wwAvg(k,iCell)*(fnm(k)*scalar_new(k,iCell)+fnp(k)*scalar_new(k-1,iCell))
+ s_max(k,iCell) = max(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell))
+ s_min(k,iCell) = min(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell))
- do k=3,nVertLevels-1
- wdtn(k,iCell) = flux3( scalar_new(k-2,iCell),scalar_new(k-1,iCell), &
- scalar_new(k ,iCell),scalar_new(k+1,iCell), &
- wwAvg(k,iCell), coef_3rd_order )
- s_max(k,iCell) = max(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell))
- s_min(k,iCell) = min(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell))
- end do
+ do k=3,nVertLevels-1
+ wdtn(k,iCell) = flux3( scalar_new(k-2,iCell),scalar_new(k-1,iCell), &
+ scalar_new(k ,iCell),scalar_new(k+1,iCell), &
+ wwAvg(k,iCell), coef_3rd_order )
+ s_max(k,iCell) = max(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell))
+ s_min(k,iCell) = min(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell))
+ end do
- k = nVertLevels
- wdtn(k,iCell) = wwAvg(k,iCell)*(fnm(k)*scalar_new(k,iCell)+fnp(k)*scalar_new(k-1,iCell))
- s_max(k,iCell) = max(scalar_old(k,iCell),scalar_old(k-1,iCell))
- s_min(k,iCell) = min(scalar_old(k,iCell),scalar_old(k-1,iCell))
+ k = nVertLevels
+ wdtn(k,iCell) = wwAvg(k,iCell)*(fnm(k)*scalar_new(k,iCell)+fnp(k)*scalar_new(k-1,iCell))
+ s_max(k,iCell) = max(scalar_old(k,iCell),scalar_old(k-1,iCell))
+ s_min(k,iCell) = min(scalar_old(k,iCell),scalar_old(k-1,iCell))
! pull s_min and s_max from the (horizontal) surrounding cells
- do i=1, grid % nEdgesOnCell % array(iCell)
- do k=1, grid % nVertLevels
- s_max(k,iCell) = max(s_max(k,iCell),scalar_old(k, grid % CellsOnCell % array(i,iCell)))
- s_min(k,iCell) = min(s_min(k,iCell),scalar_old(k, grid % CellsOnCell % array(i,iCell)))
- end do
- end do
+ do i=1, nEdgesOnCell(iCell)
+ do k=1, grid % nVertLevels
+ s_max(k,iCell) = max(s_max(k,iCell),scalar_old(k, grid % CellsOnCell % array(i,iCell)))
+ s_min(k,iCell) = min(s_min(k,iCell),scalar_old(k, grid % CellsOnCell % array(i,iCell)))
+ end do
+ end do
end do
@@ -1610,203 +1617,204 @@
! horizontal flux divergence
flux_arr(:,:) = 0.
- do iEdge=1,grid%nEdges
+ do iEdge=1,nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- if (cell1 <= grid%nCellsSolve .or. cell2 <= grid%nCellsSolve) then ! only for owned cells
+ if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then ! only for owned cells
do i=1,nAdvCellsForEdge(iEdge)
- iCell = advCellsForEdge(i,iEdge)
- do k=1,grid % nVertLevels
- scalar_weight = uhAvg(k,iEdge)*(adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(i,iEdge))
- flux_arr(k,iEdge) = flux_arr(k,iEdge) + scalar_weight* scalar_new(k,iCell)
- end do
+ iCell = advCellsForEdge(i,iEdge)
+ do k=1,nVertLevels
+ scalar_weight = uhAvg(k,iEdge)*(adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(i,iEdge))
+ flux_arr(k,iEdge) = flux_arr(k,iEdge) + scalar_weight* scalar_new(k,iCell)
+ end do
end do
end if
- end do
+ end do
! vertical flux divergence for upwind update, we will put upwind update into scalar_new, and put factor of dt in fluxes
- do iCell = 1, grid % nCellsSolve
+ do iCell = 1, nCellsSolve
k = 1
scalar_new(k,iCell) = scalar_old(k,iCell)*h_old(k,iCell)
do k = 2, nVertLevels
- scalar_new(k,iCell) = scalar_old(k,iCell)*h_old(k,iCell)
- flux_upwind = dt*(max(0.0_RKIND,wwAvg(k,iCell))*scalar_old(k-1,iCell) + min(0.0_RKIND,wwAvg(k,iCell))*scalar_old(k,iCell))
- scalar_new(k-1,iCell) = scalar_new(k-1,iCell) - flux_upwind*rdnw(k-1)
- scalar_new(k ,iCell) = scalar_new(k ,iCell) + flux_upwind*rdnw(k)
- wdtn(k,iCell) = dt*wdtn(k,iCell) - flux_upwind
+ scalar_new(k,iCell) = scalar_old(k,iCell)*h_old(k,iCell)
+ flux_upwind = dt*(max(0.0_RKIND,wwAvg(k,iCell))*scalar_old(k-1,iCell) + min(0.0_RKIND,wwAvg(k,iCell))*scalar_old(k,iCell))
+ scalar_new(k-1,iCell) = scalar_new(k-1,iCell) - flux_upwind*rdnw(k-1)
+ scalar_new(k ,iCell) = scalar_new(k ,iCell) + flux_upwind*rdnw(k)
+ wdtn(k,iCell) = dt*wdtn(k,iCell) - flux_upwind
end do
-! scale_in(:,:) and scale_out(:,:) are used here to store the incoming and outgoing perturbation flux
+! scale_arr(SCALE_IN,:,:) and scale_arr(SCALE_OUT:,:) are used here to store the incoming and outgoing perturbation flux
! contributions to the update: first the vertical flux component, then the horizontal
do k=1,nVertLevels
- scale_in (k,iCell) = - rdnw(k)*(min(0.0_RKIND,wdtn(k+1,iCell))-max(0.0_RKIND,wdtn(k,iCell)))
- scale_out(k,iCell) = - rdnw(k)*(max(0.0_RKIND,wdtn(k+1,iCell))-min(0.0_RKIND,wdtn(k,iCell)))
+ scale_arr(SCALE_IN, k,iCell) = - rdnw(k)*(min(0.0_RKIND,wdtn(k+1,iCell))-max(0.0_RKIND,wdtn(k,iCell)))
+ scale_arr(SCALE_OUT,k,iCell) = - rdnw(k)*(max(0.0_RKIND,wdtn(k+1,iCell))-min(0.0_RKIND,wdtn(k,iCell)))
end do
- end do
+ end do
! horizontal flux divergence for upwind update
! upwind flux computation
- do iEdge=1,grid%nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- if (cell1 <= grid%nCellsSolve .or. cell2 <= grid%nCellsSolve) then ! only for owned cells
- do k=1,grid % nVertLevels
- flux_upwind = grid % dvEdge % array(iEdge) * dt * &
- (max(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell1) + min(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell2))
- flux_arr(k,iEdge) = dt*flux_arr(k,iEdge) - flux_upwind
- scalar_new(k,cell1) = scalar_new(k,cell1) - flux_upwind / areaCell(cell1)
- scalar_new(k,cell2) = scalar_new(k,cell2) + flux_upwind / areaCell(cell2)
-
- scale_out(k,cell1) = scale_out(k,cell1) - max(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell1)
- scale_in (k,cell1) = scale_in (k,cell1) - min(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell1)
- scale_out(k,cell2) = scale_out(k,cell2) + min(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell2)
- scale_in (k,cell2) = scale_in (k,cell2) + max(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell2)
-
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then ! only for owned cells
+ do k=1, nVertLevels
+ flux_upwind = grid % dvEdge % array(iEdge) * dt * &
+ (max(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell1) + min(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell2))
+ flux_arr(k,iEdge) = dt*flux_arr(k,iEdge) - flux_upwind
+ scalar_new(k,cell1) = scalar_new(k,cell1) - flux_upwind / areaCell(cell1)
+ scalar_new(k,cell2) = scalar_new(k,cell2) + flux_upwind / areaCell(cell2)
+
+ scale_arr(SCALE_OUT,k,cell1) = scale_arr(SCALE_OUT,k,cell1) - max(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell1)
+ scale_arr(SCALE_IN, k,cell1) = scale_arr(SCALE_IN, k,cell1) - min(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell1)
+ scale_arr(SCALE_OUT,k,cell2) = scale_arr(SCALE_OUT,k,cell2) + min(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell2)
+ scale_arr(SCALE_IN, k,cell2) = scale_arr(SCALE_IN, k,cell2) + max(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell2)
+
end do
- end if
- end do
+ end if
+ end do
! next, the limiter
- do iCell = 1, grid % nCellsSolve
+ do iCell = 1, nCellsSolve
do k = 1, nVertLevels
- s_min_update = (scalar_new(k,iCell)+scale_out(k,iCell))/h_new(k,iCell)
- s_max_update = (scalar_new(k,iCell)+scale_in (k,iCell))/h_new(k,iCell)
+ s_min_update = (scalar_new(k,iCell)+scale_arr(SCALE_OUT,k,iCell))/h_new(k,iCell)
+ s_max_update = (scalar_new(k,iCell)+scale_arr(SCALE_IN,k,iCell))/h_new(k,iCell)
s_upwind = scalar_new(k,iCell)/h_new(k,iCell)
scale_factor = (s_max(k,iCell)-s_upwind)/(s_max_update-s_upwind+eps)
- scale_in(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
+ scale_arr(SCALE_IN,k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
scale_factor = (s_upwind-s_min(k,iCell))/(s_upwind-s_min_update+eps)
- scale_out(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
+ scale_arr(SCALE_OUT,k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
end do
- end do
+ end do
!
-! communicate scale factors here
+! communicate scale factors here.
+! communicate only first halo row in these next two exchanges
!
-!
-! WCS_halo_opt_2 - communicate only first halo row in these next two exchanges
-!
- tempField => tempFieldTarget
+ tempField => tempFieldTarget
- tempField % block => block
- tempField % dimSizes(1) = grid % nVertLevels
- tempField % dimSizes(2) = grid % nCells
- tempField % sendList => block % parinfo % cellsToSend
- tempField % recvList => block % parinfo % cellsToRecv
- tempField % copyList => block % parinfo % cellsToCopy
- tempField % prev => null()
- tempField % next => null()
+ tempField % block => block
+ tempField % dimSizes(1) = 2
+ tempField % dimSizes(2) = grid % nVertLevels
+ tempField % dimSizes(3) = grid % nCells
+ tempField % sendList => block % parinfo % cellsToSend
+ tempField % recvList => block % parinfo % cellsToRecv
+ tempField % copyList => block % parinfo % cellsToCopy
+ tempField % prev => null()
+ tempField % next => null()
- tempField % array => scale_in
- call mpas_dmpar_exch_halo_field(tempField, (/ 1 /))
+ tempField % array => scale_arr
+ call mpas_dmpar_exch_halo_field(tempField, (/ 1 /))
- tempField % array => scale_out
- call mpas_dmpar_exch_halo_field(tempField, (/ 1 /))
-
!
! rescale the fluxes
!
- do iEdge = 1, grid % nEdges
- cell1 = grid % cellsOnEdge % array(1,iEdge)
- cell2 = grid % cellsOnEdge % array(2,iEdge)
- if (cell1 <= grid%nCellsSolve .or. cell2 <= grid%nCellsSolve) then
- do k = 1, nVertLevels
- flux = flux_arr(k,iEdge)
- flux = max(0.0_RKIND,flux) * min(scale_out(k,cell1), scale_in(k,cell2)) &
- + min(0.0_RKIND,flux) * min(scale_in(k,cell1), scale_out(k,cell2))
- flux_arr(k,iEdge) = flux
- end do
- end if
- end do
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
+ do k = 1, nVertLevels
+ flux = flux_arr(k,iEdge)
+ flux = max(0.0_RKIND,flux) * min(scale_arr(SCALE_OUT,k,cell1), scale_arr(SCALE_IN, k,cell2)) &
+ + min(0.0_RKIND,flux) * min(scale_arr(SCALE_IN, k,cell1), scale_arr(SCALE_OUT,k,cell2))
+ flux_arr(k,iEdge) = flux
+ end do
+ end if
+ end do
! rescale the vertical flux
- do iCell=1,grid % nCells
- do k = 2, nVertLevels
- flux = wdtn(k,iCell)
- flux = max(0.0_RKIND,flux) * min(scale_out(k-1,iCell), scale_in(k ,iCell)) &
- + min(0.0_RKIND,flux) * min(scale_out(k ,iCell), scale_in(k-1,iCell))
- wdtn(k,iCell) = flux
- end do
+ do iCell=1,nCells
+ do k = 2, nVertLevels
+ flux = wdtn(k,iCell)
+ flux = max(0.0_RKIND,flux) * min(scale_arr(SCALE_OUT,k-1,iCell), scale_arr(SCALE_IN,k ,iCell)) &
+ + min(0.0_RKIND,flux) * min(scale_arr(SCALE_OUT,k ,iCell), scale_arr(SCALE_IN,k-1,iCell))
+ wdtn(k,iCell) = flux
end do
+ end do
!
! do the scalar update now that we have the fluxes
!
- do iEdge=1,grid%nEdges
+ do iEdge=1,nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- if (cell1 <= grid%nCellsSolve .or. cell2 <= grid%nCellsSolve) then ! only for owned cells
- do k=1,grid % nVertLevels
+ if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then ! only for owned cells
+ do k=1,nVertLevels
scalar_new(k,cell1) = scalar_new(k,cell1) - flux_arr(k,iEdge)/areaCell(cell1)
scalar_new(k,cell2) = scalar_new(k,cell2) + flux_arr(k,iEdge)/areaCell(cell2)
end do
end if
end do
- do iCell=1,grid % nCellsSolve
- do k=1,grid % nVertLevels
+ do iCell=1,nCellsSolve
+ do k=1,nVertLevels
scalar_new(k,iCell) = ( scalar_new(k,iCell) &
+ (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/h_new(k,iCell)
- end do
- end do
+ end do
+ end do
- if(debug_print) then
+ if(debug_print) then
- scmin = scalar_new(1,1)
- scmax = scalar_new(1,1)
- do iCell = 1, grid%nCellsSolve
- do k=1, grid%nVertLevels
- scmax = max(scmax,scalar_new(k,iCell))
- scmin = min(scmin,scalar_new(k,iCell))
- if(s_max(k,iCell) < scalar_new(k,iCell)) then
- write(32,*) ' over - k,iCell,s_min,s_max,scalar_new ',k,iCell,s_min(k,iCell),s_max(k,iCell),scalar_new(k,iCell)
- end if
- if(s_min(k,iCell) > scalar_new(k,iCell)) then
- write(32,*) ' under - k,iCell,s_min,s_max,scalar_new ',k,iCell,s_min(k,iCell),s_max(k,iCell),scalar_new(k,iCell)
- end if
- enddo
- enddo
- write(0,*) ' scmin, scmax new out ',scmin,scmax
- write(0,*) ' icell_min, k_min ',icellmax, kmax
+ scmin = scalar_new(1,1)
+ scmax = scalar_new(1,1)
+ do iCell = 1, nCellsSolve
+ do k=1, nVertLevels
+ scmax = max(scmax,scalar_new(k,iCell))
+ scmin = min(scmin,scalar_new(k,iCell))
+ if (s_max(k,iCell) < scalar_new(k,iCell)) then
+ write(32,*) ' over - k,iCell,s_min,s_max,scalar_new ',k,iCell,s_min(k,iCell),s_max(k,iCell),scalar_new(k,iCell)
+ end if
+ if (s_min(k,iCell) > scalar_new(k,iCell)) then
+ write(32,*) ' under - k,iCell,s_min,s_max,scalar_new ',k,iCell,s_min(k,iCell),s_max(k,iCell),scalar_new(k,iCell)
+ end if
+ end do
+ end do
+ write(0,*) ' scmin, scmax new out ',scmin,scmax
+ write(0,*) ' icell_min, k_min ',icellmax, kmax
- end if
+ end if
- do iCell = 1, grid%nCells
- do k=1, grid%nVertLevels
- s_new % scalars % array(iScalar,k,iCell) = max(0.0_RKIND,scalar_new(k,iCell))
- end do
- end do
+ ! the update should be positive definite. but roundoff can sometimes leave small negative values
+ ! hence the enforcement of PD in the copy back to the model state.
+ do iCell = 1, nCells
+ do k=1, nVertLevels
+ s_new % scalars % array(iScalar,k,iCell) = max(0.0_RKIND,scalar_new(k,iCell))
+ end do
+ end do
+
end do ! loop over scalars
end subroutine atm_advance_scalars_mono
!----
- subroutine atm_compute_dyn_tend(tend, s, diag, grid, rk_step)
+ subroutine atm_compute_dyn_tend(tend, s, diag, grid, rk_step, dt)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Compute height and normal wind tendencies, as well as diagnostic variables
!
! Input: s - current model state
! grid - grid metadata
+ ! diag - some grid diagnostics
!
- ! Output: tend - computed diagnostics (parallel velocities, v; mass fluxes, rv;
- ! circulation; vorticity; and kinetic energy, ke) and the
- ! tendencies for height (h) and u (u)
+ ! Output: tend - tendencies: tend_u, tend_w, tend_theta and tend_rho
+ ! these are all coupled-variable tendencies.
+ ! various other quantities in diag: Smagorinsky eddy viscosity
+ !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
implicit none
@@ -1816,18 +1824,20 @@
type (diag_type), intent(in) :: diag
type (mesh_type), intent(in) :: grid
integer, intent(in) :: rk_step
+ real (kind=RKIND), intent(in) :: dt
+
logical, parameter :: rk_diffusion = .false.
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, iq
- real (kind=RKIND) :: flux, vorticity_abs, rho_vertex, workpv, upstream_bias
+ real (kind=RKIND) :: flux, workpv
- integer :: nCells, nEdges, nVertices, nVertLevels, nCellsSolve
+ integer :: nCells, nEdges, nVertices, nVertLevels, nCellsSolve, nEdgesSolve
real (kind=RKIND) :: h_mom_eddy_visc2, v_mom_eddy_visc2, h_mom_eddy_visc4
real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2, h_theta_eddy_visc4
real (kind=RKIND) :: u_diffusion
- real (kind=RKIND), dimension(:), pointer :: fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, meshScalingDel2, meshScalingDel4
- real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge, kiteAreasOnVertex, zgrid, rho_edge, rho_zz, ru, u, v, tend_u, &
+ real (kind=RKIND), dimension(:), pointer :: fEdge, dvEdge, dcEdge, areaCell, areaTriangle, meshScalingDel2, meshScalingDel4
+ real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge, zgrid, rho_edge, rho_zz, ru, u, v, tend_u, &
circulation, divergence, vorticity, ke, pv_edge, theta_m, rw, tend_rho, &
rt_diabatic_tend, tend_theta, tend_w, w, cqw, rb, rr, pp, pressure_b, zz, zx, cqu, &
h_divergence, kdiff
@@ -1835,13 +1845,13 @@
real (kind=RKIND), dimension(:,:), pointer :: tend_u_euler, tend_w_euler, tend_theta_euler
real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
- integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
+ integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge, edgesOnCell, edgesOnEdge
integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
real (kind=RKIND), dimension( grid % nVertLevels + 1 ) :: wduz, wdwz, wdtz, dpzx
real (kind=RKIND), dimension( grid % nVertLevels ) :: u_mix, ru_edge_w, q
- real (kind=RKIND) :: theta_edge, theta_turb_flux, z1, z2, z3, z4, zm, z0, zp, r
- real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2, pgrad
+ real (kind=RKIND) :: theta_turb_flux, z1, z2, z3, z4, zm, z0, zp, r
+ real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
integer, dimension(:,:), pointer :: advCellsForEdge
integer, dimension(:), pointer :: nAdvCellsForEdge
@@ -1854,16 +1864,15 @@
real (kind=RKIND), dimension(:,:), pointer :: cpr, cpl, pzp, pzm
integer :: kr, kl
- real (kind=RKIND), allocatable, dimension(:,:) :: rv, divergence_ru, qtot
+ real (kind=RKIND), allocatable, dimension(:,:) :: divergence_ru, qtot
real (kind=RKIND), allocatable, dimension(:,:) :: delsq_theta, delsq_divergence
real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
real (kind=RKIND) :: cf1, cf2, cf3, pr, pl
+ real (kind=RKIND) :: prandtl_inv
-! logical, parameter :: debug = .true.
logical, parameter :: debug = .false.
- !SHP-curvature
logical, parameter :: curvature = .true.
real (kind=RKIND) :: r_earth
real (kind=RKIND), dimension(:,:), pointer :: ur_cell, vr_cell
@@ -1889,7 +1898,6 @@
!-----------
- !SHP-curvature
r_earth = grid % sphere_radius
ur_cell => diag % uReconstructZonal % array
vr_cell => diag % uReconstructMeridional % array
@@ -1972,32 +1980,36 @@
nVertLevels = grid % nVertLevels
nVertices = grid % nVertices
nCellsSolve = grid % nCellsSolve
+ nEdgesSolve = grid % nEdgesSolve
h_mom_eddy_visc2 = config_h_mom_eddy_visc2
- h_mom_eddy_visc4 = config_h_mom_eddy_visc4
+! h_mom_eddy_visc4 = config_h_mom_eddy_visc4
v_mom_eddy_visc2 = config_v_mom_eddy_visc2
h_theta_eddy_visc2 = config_h_theta_eddy_visc2
- h_theta_eddy_visc4 = config_h_theta_eddy_visc4
+! h_theta_eddy_visc4 = config_h_theta_eddy_visc4
v_theta_eddy_visc2 = config_v_theta_eddy_visc2
+ nEdgesOnCell => grid % nEdgesOnCell % array
nAdvCellsForEdge => grid % nAdvCellsForEdge % array
advCellsForEdge => grid % advCellsForEdge % array
adv_coefs => grid % adv_coefs % array
adv_coefs_3rd => grid % adv_coefs_3rd % array
- !
- ! Compute u (normal) velocity tendency for each edge (cell face)
- !
+ prandtl_inv = 1.0_RKIND/prandtl
write(0,*) ' rk_step in compute_dyn_tend ',rk_step
delsq_horiz_mixing = .false.
if (config_horiz_mixing == "2d_smagorinsky" .and. (rk_step == 1 .or. rk_diffusion)) then
+
+ ! Smagorinsky eddy viscosity, based on horizontal deformation (in this case on model coordinate surfaces).
+ ! The integration coefficients were precomputed and stored in defc_a and defc_b
+
do iCell = 1, nCells
d_diag(:) = 0.
d_off_diag(:) = 0.
- do iEdge = 1, grid % nEdgesOnCell % array (iCell)
+ do iEdge = 1, nEdgesOnCell(iCell)
do k=1, nVertLevels
d_diag(k) = d_diag(k) + defc_a(iEdge,iCell)*u(k,EdgesOnCell(iEdge,iCell)) &
- defc_b(iEdge,iCell)*v(k,EdgesOnCell(iEdge,iCell))
@@ -2006,12 +2018,24 @@
end do
end do
do k=1, nVertLevels
+ ! here is the Smagorinsky formulation,
+ ! followed by imposition of an upper bound on the eddy viscosity
kdiff(k,iCell) = (c_s * config_len_disp)**2 * sqrt(d_diag(k)**2 + d_off_diag(k)**2)
+ kdiff(k,iCell) = min(kdiff(k,iCell),(0.01*config_len_disp**2)/dt)
end do
end do
+!ldf (2012-10-10):
+ h_mom_eddy_visc4 = config_visc4_2dsmag * config_len_disp**3
+ h_theta_eddy_visc4 = h_mom_eddy_visc4
delsq_horiz_mixing = .true.
+ write(0,*) '... config_visc4_2dsmag = ', config_visc4_2dsmag
+ write(0,*) '... h_mom_eddy_visc4 = ', h_mom_eddy_visc4
+ write(0,*) '... h_theta_eddy_visc4 = ', h_theta_eddy_visc4
else if ( config_horiz_mixing == "2d_fixed") then
+ h_mom_eddy_visc4 = config_h_mom_eddy_visc4
+ h_theta_eddy_visc4 = config_h_theta_eddy_visc4
delsq_horiz_mixing = .true.
+!ldf (2012-10-10):
end if
tend_u(:,:) = 0.0
@@ -2020,157 +2044,162 @@
cf2 = grid % cf2 % scalar
cf3 = grid % cf3 % scalar
- ! tendency for density
- ! divergence_ru may calculated in the diagnostic subroutine - it is temporary
+ ! tendency for density.
+ ! accumulate total water here for later use in w tendency calculation.
+
allocate(divergence_ru(nVertLevels, nCells+1))
allocate(qtot(nVertLevels, nCells+1))
divergence_ru(:,:) = 0.0
h_divergence(:,:) = 0.
- do iEdge=1,grid % nEdges
+
+ ! accumulate horizontal mass-flux
+
+ do iEdge=1,nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k=1,nVertLevels
- flux = ru(k,iEdge)*dvEdge(iEdge)
- divergence_ru(k,cell1) = divergence_ru(k,cell1) + flux
- divergence_ru(k,cell2) = divergence_ru(k,cell2) - flux
+ flux = ru(k,iEdge)*dvEdge(iEdge)
+ divergence_ru(k,cell1) = divergence_ru(k,cell1) + flux
+ divergence_ru(k,cell2) = divergence_ru(k,cell2) - flux
end do
end do
qtot(:,:)=0.
+
+ ! compute horiontal mass-flux divergence, add vertical mass flux divergence to complete tend_rho
+
do iCell = 1,nCells
- r = 1.0 / areaCell(iCell)
- do k = 1,nVertLevels
- divergence_ru(k,iCell) = divergence_ru(k,iCell) * r
- h_divergence(k,iCell) = divergence_ru(k,iCell)
- tend_rho(k,iCell) = -divergence_ru(k,iCell)-rdzw(k)*(rw(k+1,iCell)-rw(k,iCell))
+ r = 1.0 / areaCell(iCell)
+ do k = 1,nVertLevels
+ divergence_ru(k,iCell) = divergence_ru(k,iCell) * r
+ h_divergence(k,iCell) = divergence_ru(k,iCell)
+ tend_rho(k,iCell) = -divergence_ru(k,iCell)-rdzw(k)*(rw(k+1,iCell)-rw(k,iCell))
- do iq = s % moist_start, s % moist_end
- qtot(k,iCell) = qtot(k,iCell) + s % scalars % array (iq, k, iCell)
- end do
+ do iq = s % moist_start, s % moist_end
+ qtot(k,iCell) = qtot(k,iCell) + s % scalars % array (iq, k, iCell)
+ end do
- end do
+ end do
end do
-!**** u dyn tend
+ !
+ ! Compute u (normal) velocity tendency for each edge (cell face)
+ !
- do iEdge=1,grid % nEdgesSolve
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
+ do iEdge=1,nEdgesSolve
- if(newpx) then
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
- k = 1
- pr = cpr(k,iEdge)*pp(k,cell2)+cpr(k+1,iEdge)*pp(k+1,cell2)+cpr(k+2,iEdge)*pp(k+2,cell2)
- pl = cpl(k,iEdge)*pp(k,cell1)+cpl(k+1,iEdge)*pp(k+1,cell1)+cpl(k+2,iEdge)*pp(k+2,cell1)
- tend_u(k,iEdge) = - cqu(k,iEdge)*2./(zz(k,cell1)+zz(k,cell2))*(pr-pl)/dcEdge(iEdge)
+ ! horizontal pressure gradient
- do k=2,nVertLevels
+ if (newpx) then
- kr = min(nVertLevels,k+ nint(.5-sign(0.5_RKIND,zx(k,iEdge)+zx(k+1,iEdge))))
- kl = min(nVertLevels,2*k+1-kr)
+ k = 1
+ pr = cpr(k,iEdge)*pp(k,cell2)+cpr(k+1,iEdge)*pp(k+1,cell2)+cpr(k+2,iEdge)*pp(k+2,cell2)
+ pl = cpl(k,iEdge)*pp(k,cell1)+cpl(k+1,iEdge)*pp(k+1,cell1)+cpl(k+2,iEdge)*pp(k+2,cell1)
+ tend_u(k,iEdge) = - cqu(k,iEdge)*2./(zz(k,cell1)+zz(k,cell2))*(pr-pl)/dcEdge(iEdge)
- pr = pp(k,cell2)+.5*(zgrid(k ,cell1)+zgrid(k +1,cell1)-zgrid(k ,cell2)-zgrid(k +1,cell2)) &
- /(zgrid(kr+1,cell2)-zgrid(kr-1,cell2))*( pp(kr,cell2)-pp (kr-1,cell2))
- pl = pp(k,cell1)+.5*(zgrid(k ,cell2)+zgrid(k +1,cell2)-zgrid(k ,cell1)-zgrid(k +1,cell1)) &
- /(zgrid(kl+1,cell1)-zgrid(kl-1,cell1))*( pp(kl,cell1)-pp (kl-1,cell1))
- tend_u(k,iEdge) = - cqu(k,iEdge)*2./(zz(k,cell1)+zz(k,cell2))*(pr-pl)/dcEdge(iEdge)
+ do k=2,nVertLevels
- end do
+ kr = min(nVertLevels,k+ nint(.5-sign(0.5_RKIND,zx(k,iEdge)+zx(k+1,iEdge))))
+ kl = min(nVertLevels,2*k+1-kr)
- else
- k = 1
-!! dpzx(k) = .5*zx(k,iEdge)*(cf1*(pp(k ,cell2)+pp(k ,cell1)) &
-!! +cf2*(pp(k+1,cell2)+pp(k+1,cell1)) &
-!! +cf3*(pp(k+2,cell2)+pp(k+2,cell1)))
+ pr = pp(k,cell2)+.5*(zgrid(k ,cell1)+zgrid(k +1,cell1)-zgrid(k ,cell2)-zgrid(k +1,cell2)) &
+ /(zgrid(kr+1,cell2)-zgrid(kr-1,cell2))*( pp(kr,cell2)-pp (kr-1,cell2))
+ pl = pp(k,cell1)+.5*(zgrid(k ,cell2)+zgrid(k +1,cell2)-zgrid(k ,cell1)-zgrid(k +1,cell1)) &
+ /(zgrid(kl+1,cell1)-zgrid(kl-1,cell1))*( pp(kl,cell1)-pp (kl-1,cell1))
+ tend_u(k,iEdge) = - cqu(k,iEdge)*2./(zz(k,cell1)+zz(k,cell2))*(pr-pl)/dcEdge(iEdge)
- dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
- *(pzm(k,cell2)*(pp(k+1,cell2)-pp(k,cell2)) &
- +pzm(k,cell1)*(pp(k+1,cell1)-pp(k,cell1)) &
- +pzp(k,cell2)*(pp(k+2,cell2)-pp(k,cell2)) &
- +pzp(k,cell1)*(pp(k+2,cell1)-pp(k,cell1)))
-
- do k = 2, nVertLevels-1
+ end do
-!! dpzx(k) = .5*zx(k,iEdge)*(fzm(k)*(pp(k ,cell2)+pp(k ,cell1)) &
-!! +fzp(k)*(pp(k-1,cell2)+pp(k-1,cell1)))
+ else
+ k = 1
- dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
- *(pzp(k,cell2)*(pp(k+1,cell2)-pp(k ,cell2)) &
- +pzm(k,cell2)*(pp(k ,cell2)-pp(k-1,cell2)) &
- +pzp(k,cell1)*(pp(k+1,cell1)-pp(k ,cell1)) &
- +pzm(k,cell1)*(pp(k ,cell1)-pp(k-1,cell1)))
+ dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
+ *(pzm(k,cell2)*(pp(k+1,cell2)-pp(k,cell2)) &
+ +pzm(k,cell1)*(pp(k+1,cell1)-pp(k,cell1)) &
+ +pzp(k,cell2)*(pp(k+2,cell2)-pp(k,cell2)) &
+ +pzp(k,cell1)*(pp(k+2,cell1)-pp(k,cell1)))
+
+ do k = 2, nVertLevels-1
- end do
-
- k = nVertLevels
dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
- *(pzm(k,cell2)*(pp(k ,cell2)-pp(k-1,cell2)) &
+ *(pzp(k,cell2)*(pp(k+1,cell2)-pp(k ,cell2)) &
+ +pzm(k,cell2)*(pp(k ,cell2)-pp(k-1,cell2)) &
+ +pzp(k,cell1)*(pp(k+1,cell1)-pp(k ,cell1)) &
+pzm(k,cell1)*(pp(k ,cell1)-pp(k-1,cell1)))
-!! dpzx(nVertLevels+1) = 0.
+ end do
- do k=1,nVertLevels
+ k = nVertLevels
+ dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
+ *(pzm(k,cell2)*(pp(k ,cell2)-pp(k-1,cell2)) &
+ +pzm(k,cell1)*(pp(k ,cell1)-pp(k-1,cell1)))
-!! tend_u(k,iEdge) = - cqu(k,iEdge)*( (pp(k,cell2)/zz(k,cell2) - pp(k,cell1)/zz(k,cell1)) &
-!! / dcEdge(iEdge) - rdzw(k)*(dpzx(k+1)-dpzx(k)) )
+ do k=1,nVertLevels
- tend_u(k,iEdge) = - cqu(k,iEdge)*((pp(k,cell2)-pp(k,cell1))/dcEdge(iEdge) &
- - dpzx(k) ) / (.5*(zz(k,cell2)+zz(k,cell1)))
- end do
+ tend_u(k,iEdge) = - cqu(k,iEdge)*((pp(k,cell2)-pp(k,cell1))/dcEdge(iEdge) &
+ - dpzx(k) ) / (.5*(zz(k,cell2)+zz(k,cell1)))
+ end do
- end if
+ end if
- wduz(1) = 0.
- k = 2
- wduz(k) = 0.5*( rw(k,cell1)+rw(k,cell2) )*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))
- do k=3,nVertLevels-1
- wduz(k) = flux3( u(k-2,iEdge),u(k-1,iEdge),u(k,iEdge),u(k+1,iEdge),0.5*(rw(k,cell1)+rw(k,cell2)), 1.0_RKIND )
- end do
- k = nVertLevels
- wduz(k) = 0.5*( rw(k,cell1)+rw(k,cell2) )*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))
+ ! vertical transport of u
- wduz(nVertLevels+1) = 0.
+ wduz(1) = 0.
+ k = 2
+ wduz(k) = 0.5*( rw(k,cell1)+rw(k,cell2) )*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))
+ do k=3,nVertLevels-1
+ wduz(k) = flux3( u(k-2,iEdge),u(k-1,iEdge),u(k,iEdge),u(k+1,iEdge),0.5*(rw(k,cell1)+rw(k,cell2)), 1.0_RKIND )
+ end do
+ k = nVertLevels
+ wduz(k) = 0.5*( rw(k,cell1)+rw(k,cell2) )*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))
+ wduz(nVertLevels+1) = 0.
+
+ do k=1,nVertLevels
+ tend_u(k,iEdge) = tend_u(k,iEdge) - rdzw(k)*(wduz(k+1)-wduz(k))
+ end do
+
+ ! Next, nonlinear Coriolis term (q) following Ringler et al JCP 2009
+
+ q(:) = 0.0
+ do j = 1,nEdgesOnEdge(iEdge)
+ eoe = edgesOnEdge(j,iEdge)
do k=1,nVertLevels
-! tend_u(k,iEdge) = - cqu(k,iEdge)*( (pp(k,cell2)/zz(k,cell2) - pp(k,cell1)/zz(k,cell1)) &
-! / dcEdge(iEdge) - rdzw(k)*(dpzx(k+1)-dpzx(k)) )
- tend_u(k,iEdge) = tend_u(k,iEdge) - rdzw(k)*(wduz(k+1)-wduz(k))
+ workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
+ q(k) = q(k) + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * rho_edge(k,eoe)
end do
+ end do
- q(:) = 0.0
- do j = 1,nEdgesOnEdge(iEdge)
- eoe = edgesOnEdge(j,iEdge)
- do k=1,nVertLevels
- workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
- q(k) = q(k) + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * rho_edge(k,eoe)
- end do
- end do
+ do k=1,nVertLevels
- do k=1,nVertLevels
- tend_u(k,iEdge) = tend_u(k,iEdge) + rho_edge(k,iEdge)* (q(k) - (ke(k,cell2) - ke(k,cell1)) &
- / dcEdge(iEdge)) &
- - u(k,iEdge)*0.5*(divergence_ru(k,cell1)+divergence_ru(k,cell2))
- !SHP-curvature
- if (curvature) then
+ ! horizontal ke gradient and vorticity terms in the vector invariant formulation
+ ! of the horizontal momentum equation
+ tend_u(k,iEdge) = tend_u(k,iEdge) + rho_edge(k,iEdge)* (q(k) - (ke(k,cell2) - ke(k,cell1)) &
+ / dcEdge(iEdge)) &
+ - u(k,iEdge)*0.5*(divergence_ru(k,cell1)+divergence_ru(k,cell2))
+ if (curvature) then
+
+ ! curvature terms for the sphere
+
tend_u(k,iEdge) = tend_u(k,iEdge) &
- 2.*omega*cos(grid % angleEdge % array(iEdge))*cos(grid % latEdge % array(iEdge)) &
*rho_edge(k,iEdge)*.25*(w(k,cell1)+w(k+1,cell1)+w(k,cell2)+w(k+1,cell2)) &
- u(k,iEdge)*.25*(w(k+1,cell1)+w(k,cell1)+w(k,cell2)+w(k+1,cell2)) &
*rho_edge(k,iEdge)/r_earth
- !old-err.
- !tend_u(k,iEdge) = tend_u(k,iEdge) &
- ! - 2.*omega_e*cos(grid % angleEdge % array(iEdge))*cos(grid % latEdge % array(iEdge)) &
- ! *.25*(rw(k,cell1)+rw(k+1,cell1)+rw(k,cell2)+rw(k+1,cell2)) &
- ! - u(k,iEdge)*.25*(rw(k+1,cell1)+rw(k,cell1)+rw(k,cell2)+rw(k+1,cell2))/r_earth
- end if
- end do
+ end if
end do
+ end do
deallocate(divergence_ru)
!
! horizontal mixing for u
+ ! mixing terms are integrated using forward-Euler, so this tendency is only computed in the
+ ! first Runge-Kutta substep and saved for use in later RK substeps 2 and 3.
!
if (rk_step == 1 .or. rk_diffusion) then
@@ -2179,57 +2208,63 @@
if (delsq_horiz_mixing) then
- if (h_mom_eddy_visc2 > 0.0) then
- do iEdge=1,grid % nEdgesSolve
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- vertex1 = verticesOnEdge(1,iEdge)
- vertex2 = verticesOnEdge(2,iEdge)
+ if ((h_mom_eddy_visc2 > 0.0) .and. (config_horiz_mixing == "2d_fixed")) then
+ do iEdge=1, nEdgesSolve
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ vertex1 = verticesOnEdge(1,iEdge)
+ vertex2 = verticesOnEdge(2,iEdge)
+
+ do k=1,nVertLevels
- do k=1,nVertLevels
+ !
+ ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
+ ! only valid for h_mom_eddy_visc2 == constant
+ !
+ ! Note that we impose a lower bound on the edge length used in the derivative of the vorticity;
+ ! this is done to avoid an overly stringent stability constraint for small edge lengths that can
+ ! occur on some variable-resolution meshes.
+ !
+ u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
+ -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / max(dvEdge(iEdge),0.25*dcEdge(iEdge))
+ u_diffusion = rho_edge(k,iEdge)*h_mom_eddy_visc2 * u_diffusion
+ u_diffusion = u_diffusion * meshScalingDel2(iEdge)
- !
- ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
- ! only valid for h_mom_eddy_visc2 == constant
- !
- u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
- -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
- u_diffusion = rho_edge(k,iEdge)*h_mom_eddy_visc2 * u_diffusion
- u_diffusion = u_diffusion * meshScalingDel2(iEdge)
-
-! tend_u(k,iEdge) = tend_u(k,iEdge) + u_diffusion
- tend_u_euler(k,iEdge) = tend_u_euler(k,iEdge) + u_diffusion
- end do
- end do
+ tend_u_euler(k,iEdge) = tend_u_euler(k,iEdge) + u_diffusion
+ end do
+ end do
- else if ( config_horiz_mixing == "2d_smagorinsky") then
+ else if ( config_horiz_mixing == "2d_smagorinsky") then
- do iEdge=1,grid % nEdgesSolve
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- vertex1 = verticesOnEdge(1,iEdge)
- vertex2 = verticesOnEdge(2,iEdge)
+ do iEdge=1, nEdgesSolve
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ vertex1 = verticesOnEdge(1,iEdge)
+ vertex2 = verticesOnEdge(2,iEdge)
+
+ do k=1,nVertLevels
+ !
+ ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
+ ! only valid for h_mom_eddy_visc2 == constant
+ !
+ u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
+ -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / max(dvEdge(iEdge),0.25*dcEdge(iEdge))
+ u_diffusion = rho_edge(k,iEdge)* 0.5*(kdiff(k,cell1)+kdiff(k,cell2)) * u_diffusion
+ u_diffusion = u_diffusion * meshScalingDel2(iEdge)
+
+ tend_u_euler(k,iEdge) = tend_u_euler(k,iEdge) + u_diffusion
+ end do
+ end do
+ end if
- do k=1,nVertLevels
- !
- ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="gray">abla vorticity
- ! only valid for h_mom_eddy_visc2 == constant
- !
- u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
- -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
- u_diffusion = rho_edge(k,iEdge)* 0.5*(kdiff(k,cell1)+kdiff(k,cell2)) * u_diffusion
- u_diffusion = u_diffusion * meshScalingDel2(iEdge)
+ end if ! delsq_horiz_mixing for u
-! tend_u(k,iEdge) = tend_u(k,iEdge) + u_diffusion
- tend_u_euler(k,iEdge) = tend_u_euler(k,iEdge) + u_diffusion
- end do
- end do
- end if
+ if ((h_mom_eddy_visc4 > 0.0 .and. config_horiz_mixing == "2d_fixed") .or. &
+ (h_mom_eddy_visc4 > 0.0 .and. config_horiz_mixing == "2d_smagorinsky")) then
- end if ! delsq_horiz_mixing for u
+ ! del^4 horizontal filter. We compute this as del^2 ( del^2 (u) ).
+ ! First, storage to hold the result from the first del^2 computation.
- if ( h_mom_eddy_visc4 > 0.0 ) then
-
allocate(delsq_divergence(nVertLevels, nCells+1))
allocate(delsq_u(nVertLevels, nEdges+1))
allocate(delsq_circulation(nVertLevels, nVertices+1))
@@ -2237,7 +2272,7 @@
delsq_u(:,:) = 0.0
- do iEdge=1,grid % nEdges
+ do iEdge=1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
vertex1 = verticesOnEdge(1,iEdge)
@@ -2258,10 +2293,10 @@
delsq_circulation(:,:) = 0.0
do iEdge=1,nEdges
- do k=1,nVertLevels
- delsq_circulation(k,verticesOnEdge(1,iEdge)) = delsq_circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * delsq_u(k,iEdge)
- delsq_circulation(k,verticesOnEdge(2,iEdge)) = delsq_circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * delsq_u(k,iEdge)
- end do
+ do k=1,nVertLevels
+ delsq_circulation(k,verticesOnEdge(1,iEdge)) = delsq_circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * delsq_u(k,iEdge)
+ delsq_circulation(k,verticesOnEdge(2,iEdge)) = delsq_circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * delsq_u(k,iEdge)
+ end do
end do
do iVertex=1,nVertices
r = 1.0 / areaTriangle(iVertex)
@@ -2274,10 +2309,10 @@
do iEdge=1,nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- do k=1,nVertLevels
- delsq_divergence(k,cell1) = delsq_divergence(k,cell1) + delsq_u(k,iEdge)*dvEdge(iEdge)
- delsq_divergence(k,cell2) = delsq_divergence(k,cell2) - delsq_u(k,iEdge)*dvEdge(iEdge)
- end do
+ do k=1,nVertLevels
+ delsq_divergence(k,cell1) = delsq_divergence(k,cell1) + delsq_u(k,iEdge)*dvEdge(iEdge)
+ delsq_divergence(k,cell2) = delsq_divergence(k,cell2) - delsq_u(k,iEdge)*dvEdge(iEdge)
+ end do
end do
do iCell = 1,nCells
r = 1.0 / areaCell(iCell)
@@ -2286,7 +2321,7 @@
end do
end do
- do iEdge=1,grid % nEdgesSolve
+ do iEdge=1,nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
vertex1 = verticesOnEdge(1,iEdge)
@@ -2298,11 +2333,14 @@
! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="gray">abla vorticity
! only valid for h_mom_eddy_visc4 == constant
!
- u_diffusion = rho_edge(k,iEdge) * ( ( delsq_divergence(k,cell2) - delsq_divergence(k,cell1) ) / dcEdge(iEdge) &
+ ! Here, we scale the diffusion on the divergence part a factor of config_del4u_div_factor
+ ! relative to the rotational part. The stability constraint on the divergence component is much less
+ ! stringent than the rotational part, and this flexibility may be useful.
+ !
+ u_diffusion = rho_edge(k,iEdge) * ( config_del4u_div_factor * ( delsq_divergence(k,cell2) - delsq_divergence(k,cell1) ) / dcEdge(iEdge) &
-( delsq_vorticity(k,vertex2) - delsq_vorticity(k,vertex1) ) / max(dvEdge(iEdge), 0.25*dcEdge(iEdge)) &
)
-! tend_u(k,iEdge) = tend_u(k,iEdge) - h_mom_eddy_visc4 * u_diffusion
u_diffusion = u_diffusion * meshScalingDel4(iEdge)
tend_u_euler(k,iEdge) = tend_u_euler(k,iEdge) - h_mom_eddy_visc4 * u_diffusion
end do
@@ -2316,71 +2354,65 @@
end if
!
- ! vertical mixing for u - 2nd order
+ ! vertical mixing for u - 2nd order filter in physical (z) space
!
if ( v_mom_eddy_visc2 > 0.0 ) then
if (config_mix_full) then
- do iEdge=1,grid % nEdgesSolve
+ do iEdge=1,nEdgesSolve
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
- do k=2,nVertLevels-1
+ do k=2,nVertLevels-1
- z1 = 0.5*(zgrid(k-1,cell1)+zgrid(k-1,cell2))
- z2 = 0.5*(zgrid(k ,cell1)+zgrid(k ,cell2))
- z3 = 0.5*(zgrid(k+1,cell1)+zgrid(k+1,cell2))
- z4 = 0.5*(zgrid(k+2,cell1)+zgrid(k+2,cell2))
+ z1 = 0.5*(zgrid(k-1,cell1)+zgrid(k-1,cell2))
+ z2 = 0.5*(zgrid(k ,cell1)+zgrid(k ,cell2))
+ z3 = 0.5*(zgrid(k+1,cell1)+zgrid(k+1,cell2))
+ z4 = 0.5*(zgrid(k+2,cell1)+zgrid(k+2,cell2))
- zm = 0.5*(z1+z2)
- z0 = 0.5*(z2+z3)
- zp = 0.5*(z3+z4)
+ zm = 0.5*(z1+z2)
+ z0 = 0.5*(z2+z3)
+ zp = 0.5*(z3+z4)
-! tend_u(k,iEdge) = tend_u(k,iEdge) + rho_edge(k,iEdge) * v_mom_eddy_visc2*( &
-! (u(k+1,iEdge)-u(k ,iEdge))/(zp-z0) &
-! -(u(k ,iEdge)-u(k-1,iEdge))/(z0-zm) )/(0.5*(zp-zm))
- tend_u_euler(k,iEdge) = tend_u_euler(k,iEdge) + rho_edge(k,iEdge) * v_mom_eddy_visc2*( &
- (u(k+1,iEdge)-u(k ,iEdge))/(zp-z0) &
- -(u(k ,iEdge)-u(k-1,iEdge))/(z0-zm) )/(0.5*(zp-zm))
+ tend_u_euler(k,iEdge) = tend_u_euler(k,iEdge) + rho_edge(k,iEdge) * v_mom_eddy_visc2*( &
+ (u(k+1,iEdge)-u(k ,iEdge))/(zp-z0) &
+ -(u(k ,iEdge)-u(k-1,iEdge))/(z0-zm) )/(0.5*(zp-zm))
+ end do
end do
- end do
else ! idealized cases where we mix on the perturbation from the initial 1-D state
- do iEdge=1,grid % nEdgesSolve
+ do iEdge=1,nEdgesSolve
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
- do k=1,nVertLevels
+ do k=1,nVertLevels
#ifdef ROTATED_GRID
- u_mix(k) = u(k,iEdge) - grid % u_init % array(k) * sin( grid % angleEdge % array(iEdge) )
+ u_mix(k) = u(k,iEdge) - grid % u_init % array(k) * sin( grid % angleEdge % array(iEdge) )
#else
- u_mix(k) = u(k,iEdge) - grid % u_init % array(k) * cos( grid % angleEdge % array(iEdge) )
+ u_mix(k) = u(k,iEdge) - grid % u_init % array(k) * cos( grid % angleEdge % array(iEdge) )
#endif
- end do
+ end do
- do k=2,nVertLevels-1
+ do k=2,nVertLevels-1
- z1 = 0.5*(zgrid(k-1,cell1)+zgrid(k-1,cell2))
- z2 = 0.5*(zgrid(k ,cell1)+zgrid(k ,cell2))
- z3 = 0.5*(zgrid(k+1,cell1)+zgrid(k+1,cell2))
- z4 = 0.5*(zgrid(k+2,cell1)+zgrid(k+2,cell2))
+ z1 = 0.5*(zgrid(k-1,cell1)+zgrid(k-1,cell2))
+ z2 = 0.5*(zgrid(k ,cell1)+zgrid(k ,cell2))
+ z3 = 0.5*(zgrid(k+1,cell1)+zgrid(k+1,cell2))
+ z4 = 0.5*(zgrid(k+2,cell1)+zgrid(k+2,cell2))
- zm = 0.5*(z1+z2)
- z0 = 0.5*(z2+z3)
- zp = 0.5*(z3+z4)
+ zm = 0.5*(z1+z2)
+ z0 = 0.5*(z2+z3)
+ zp = 0.5*(z3+z4)
- tend_u_euler(k,iEdge) = tend_u_euler(k,iEdge) + rho_edge(k,iEdge) * v_mom_eddy_visc2*( &
- (u_mix(k+1)-u_mix(k ))/(zp-z0) &
- -(u_mix(k )-u_mix(k-1))/(z0-zm) )/(0.5*(zp-zm))
-! tend_u(k,iEdge) = tend_u(k,iEdge) + rho_edge(k,iEdge) * v_mom_eddy_visc2*( &
-! (u_mix(k+1)-u_mix(k ))/(zp-z0) &
-! -(u_mix(k )-u_mix(k-1))/(z0-zm) )/(0.5*(zp-zm))
+ tend_u_euler(k,iEdge) = tend_u_euler(k,iEdge) + rho_edge(k,iEdge) * v_mom_eddy_visc2*( &
+ (u_mix(k+1)-u_mix(k ))/(zp-z0) &
+ -(u_mix(k )-u_mix(k-1))/(z0-zm) )/(0.5*(zp-zm))
+ end do
end do
- end do
end if
@@ -2390,7 +2422,7 @@
! add in mixing for u
- do iEdge=1,grid % nEdgesSolve
+ do iEdge=1,nEdgesSolve
do k=1,nVertLevels
tend_u(k,iEdge) = tend_u(k,iEdge) + tend_u_euler(k,iEdge)
end do
@@ -2410,7 +2442,7 @@
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
- do k=2,grid % nVertLevels
+ do k=2,nVertLevels
flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge) ) &
*(w(k,cell1) + w(k,cell2))*0.5
tend_w(k,cell1) = tend_w(k,cell1) - flux
@@ -2426,53 +2458,27 @@
cell2 = cellsOnEdge(2,iEdge)
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
- do k=2,grid % nVertLevels
- ru_edge_w(k) = fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge)
+ do k=2,nVertLevels
+ ru_edge_w(k) = fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge)
end do
flux_arr(:) = 0.
+
+ ! flux_arr stores the value of w at the cell edge used in the horizontal transport
+
do i=1,nAdvCellsForEdge(iEdge)
- iCell = advCellsForEdge(i,iEdge)
- do k=2,grid % nVertLevels
- scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,ru_edge_w(k))*adv_coefs_3rd(i,iEdge)
- flux_arr(k) = flux_arr(k) + scalar_weight* w(k,iCell)
- end do
+ iCell = advCellsForEdge(i,iEdge)
+ do k=2,nVertLevels
+ scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,ru_edge_w(k))*adv_coefs_3rd(i,iEdge)
+ flux_arr(k) = flux_arr(k) + scalar_weight* w(k,iCell)
+ end do
end do
- do k=1,grid % nVertLevels
+ do k=1,nVertLevels
tend_w(k,cell1) = tend_w(k,cell1) - ru_edge_w(k)*flux_arr(k)
tend_w(k,cell2) = tend_w(k,cell2) + ru_edge_w(k)*flux_arr(k)
end do
-! do k=2,grid % nVertLevels
-!
-! d2fdx2_cell1 = deriv_two(1,1,iEdge) * w(k,cell1)
-! d2fdx2_cell2 = deriv_two(1,2,iEdge) * w(k,cell2)
-! do i=1, grid % nEdgesOnCell % array (cell1)
-! if ( grid % CellsOnCell % array (i,cell1) <= grid%nCells) &
-! d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * w(k,grid % CellsOnCell % array (i,cell1))
-! end do
-! do i=1, grid % nEdgesOnCell % array (cell2)
-! if ( grid % CellsOnCell % array (i,cell2) <= grid%nCells) &
-! d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * w(k,grid % CellsOnCell % array (i,cell2))
-! end do
-!
-! 3rd order stencil
-! if( u(k,iEdge)+u(k-1,iEdge) > 0) then
-! flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge))*( &
-! 0.5*(w(k,cell1) + w(k,cell2)) &
-! -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
-! else
-! flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge))*( &
-! 0.5*(w(k,cell1) + w(k,cell2)) &
-! -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
-! end if
-!
-! tend_w(k,cell1) = tend_w(k,cell1) - flux
-! tend_w(k,cell2) = tend_w(k,cell2) + flux
-!
-! end do
-
end if
end do
@@ -2483,16 +2489,16 @@
cell2 = cellsOnEdge(2,iEdge)
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
- do k=2,grid % nVertLevels
+ do k=2,nVertLevels
d2fdx2_cell1 = deriv_two(1,1,iEdge) * w(k,cell1)
d2fdx2_cell2 = deriv_two(1,2,iEdge) * w(k,cell2)
- do i=1, grid % nEdgesOnCell % array (cell1)
- if ( grid % CellsOnCell % array (i,cell1) <= grid%nCells) &
+ do i=1, nEdgesOnCell(cell1)
+ if ( grid % CellsOnCell % array (i,cell1) <= nCells) &
d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * w(k,grid % CellsOnCell % array (i,cell1))
end do
- do i=1, grid % nEdgesOnCell % array (cell2)
- if ( grid % CellsOnCell % array (i,cell2) <= grid%nCells) &
+ do i=1, nEdgesOnCell(cell2)
+ if ( grid % CellsOnCell % array (i,cell2) <= nCells) &
d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * w(k,grid % CellsOnCell % array (i,cell2))
end do
@@ -2509,10 +2515,9 @@
end do
end if
- !SHP-curvature
if (curvature) then
- do iCell = 1, grid % nCellsSolve
+ do iCell = 1, nCellsSolve
do k=2,nVertLevels
tend_w(k,iCell) = tend_w(k,iCell) + (rho_zz(k,iCell)*fzm(k)+rho_zz(k-1,iCell)*fzp(k))* &
( (fzm(k)*ur_cell(k,iCell)+fzp(k)*ur_cell(k-1,iCell))**2. &
@@ -2521,12 +2526,6 @@
*(fzm(k)*ur_cell(k,iCell)+fzp(k)*ur_cell(k-1,iCell)) &
*(rho_zz(k,iCell)*fzm(k)+rho_zz(k-1,iCell)*fzp(k))
- !old_err.
- !tend_w(k,iCell) = tend_w(k,iCell) &
- ! + rho_zz(k,iCell)*( (fzm(k)*ur_cell(k,iCell)+fzp(k)*ur_cell(k-1,iCell))**2. &
- ! +(fzm(k)*vr_cell(k,iCell)+fzp(k)*vr_cell(k-1,iCell))**2. )/r_earth &
- ! + 2.*omega_e*cos(grid % latCell % array(iCell))*rho_zz(k,iCell) &
- ! *(fzm(k)*ur_cell(k,iCell)+fzp(k)*ur_cell(k-1,iCell))
end do
end do
@@ -2537,108 +2536,106 @@
! but here we can also code in hyperdiffusion if we wish (2nd order at present)
!
- ! Note: we are using quite a bit of the theta code here - could be combined later???
-
if (rk_step == 1 .or. rk_diffusion) then
- tend_w_euler = 0.
+ tend_w_euler = 0.
- if (delsq_horiz_mixing) then
+ if (delsq_horiz_mixing) then
- if (h_mom_eddy_visc2 > 0.0) then
+ if ((h_mom_eddy_visc2 > 0.0) .and. (config_horiz_mixing == "2d_fixed")) then
- do iEdge=1,grid % nEdges
- cell1 = grid % cellsOnEdge % array(1,iEdge)
- cell2 = grid % cellsOnEdge % array(2,iEdge)
- if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
- do k=2,grid % nVertLevels
- theta_turb_flux = h_mom_eddy_visc2*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
- theta_turb_flux = theta_turb_flux * meshScalingDel2(iEdge)
- flux = 0.5*dvEdge (iEdge) * (rho_edge(k,iEdge)+rho_edge(k-1,iEdge)) * theta_turb_flux
-! tend_w(k,cell1) = tend_w(k,cell1) + flux
-! tend_w(k,cell2) = tend_w(k,cell2) - flux
- tend_w_euler(k,cell1) = tend_w_euler(k,cell1) + flux/areaCell(cell1)
- tend_w_euler(k,cell2) = tend_w_euler(k,cell2) - flux/areaCell(cell2)
+ ! horizontal flux divergence of the gradient (i.e. del^2)
+ ! note, for w, even though we use theta_* local scratch variables
+ do k=2,nVertLevels
+ theta_turb_flux = h_mom_eddy_visc2*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
+ theta_turb_flux = theta_turb_flux * meshScalingDel2(iEdge)
+ flux = 0.5*dvEdge (iEdge) * (rho_edge(k,iEdge)+rho_edge(k-1,iEdge)) * theta_turb_flux
+ tend_w_euler(k,cell1) = tend_w_euler(k,cell1) + flux/areaCell(cell1)
+ tend_w_euler(k,cell2) = tend_w_euler(k,cell2) - flux/areaCell(cell2)
+ end do
+
+ end if
end do
- end if
- end do
- else if (config_horiz_mixing == "2d_smagorinsky") then
+ else if (config_horiz_mixing == "2d_smagorinsky") then
- do iEdge=1,grid % nEdges
- cell1 = grid % cellsOnEdge % array(1,iEdge)
- cell2 = grid % cellsOnEdge % array(2,iEdge)
- if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
+
+ do k=2,nVertLevels
+ theta_turb_flux = 0.25*(kdiff(k,cell1)+kdiff(k,cell2)+kdiff(k-1,cell1)+kdiff(k,cell2)) &
+ *(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
+ theta_turb_flux = theta_turb_flux * meshScalingDel2(iEdge)
+ flux = 0.5*dvEdge (iEdge) * (rho_edge(k,iEdge)+rho_edge(k-1,iEdge)) * theta_turb_flux
+ tend_w_euler(k,cell1) = tend_w_euler(k,cell1) + flux/areaCell(cell1)
+ tend_w_euler(k,cell2) = tend_w_euler(k,cell2) - flux/areaCell(cell2)
+ end do
- do k=2,grid % nVertLevels
-! theta_turb_flux = h_mom_eddy_visc2*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
- theta_turb_flux = 0.25*(kdiff(k,cell1)+kdiff(k,cell2)+kdiff(k-1,cell1)+kdiff(k,cell2)) &
- *(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
- theta_turb_flux = theta_turb_flux * meshScalingDel2(iEdge)
- flux = 0.5*dvEdge (iEdge) * (rho_edge(k,iEdge)+rho_edge(k-1,iEdge)) * theta_turb_flux
-! tend_w(k,cell1) = tend_w(k,cell1) + flux
-! tend_w(k,cell2) = tend_w(k,cell2) - flux
- tend_w_euler(k,cell1) = tend_w_euler(k,cell1) + flux/areaCell(cell1)
- tend_w_euler(k,cell2) = tend_w_euler(k,cell2) - flux/areaCell(cell2)
+ end if
end do
+ end if
+ end if ! delsq_horiz_mixing
- end if
- end do
- end if
-
- end if
+ if ((h_mom_eddy_visc4 > 0.0 .and. config_horiz_mixing == "2d_fixed") .or. &
+ (h_mom_eddy_visc4 > 0.0 .and. config_horiz_mixing == "2d_smagorinsky")) then
- if ( h_mom_eddy_visc4 > 0.0 ) then
- allocate(delsq_theta(nVertLevels, nCells+1))
+ ! del^4 horizontal filter. We compute this as del^2 ( del^2 (u) ).
+ !
+ ! First, storage to hold the result from the first del^2 computation.
+ ! we copied code from the theta mixing, hence the theta* names.
- delsq_theta(:,:) = 0.
+ allocate(delsq_theta(nVertLevels, nCells+1))
- do iEdge=1,grid % nEdges
- cell1 = grid % cellsOnEdge % array(1,iEdge)
- cell2 = grid % cellsOnEdge % array(2,iEdge)
- do k=2,grid % nVertLevels
- delsq_theta(k,cell1) = delsq_theta(k,cell1) + dvEdge(iEdge)*0.5*(rho_edge(k,iEdge)+rho_edge(k-1,iEdge))*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
- delsq_theta(k,cell2) = delsq_theta(k,cell2) - dvEdge(iEdge)*0.5*(rho_edge(k,iEdge)+rho_edge(k-1,iEdge))*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
+ delsq_theta(:,:) = 0.
+
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k=2,nVertLevels
+ delsq_theta(k,cell1) = delsq_theta(k,cell1) + dvEdge(iEdge)*0.5*(rho_edge(k,iEdge)+rho_edge(k-1,iEdge))*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
+ delsq_theta(k,cell2) = delsq_theta(k,cell2) - dvEdge(iEdge)*0.5*(rho_edge(k,iEdge)+rho_edge(k-1,iEdge))*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
+ end do
end do
- end do
- do iCell = 1, nCells
- r = 1.0 / areaCell(iCell)
- do k=2,nVertLevels
- delsq_theta(k,iCell) = delsq_theta(k,iCell) * r
+ do iCell = 1, nCells
+ r = 1.0 / areaCell(iCell)
+ do k=2,nVertLevels
+ delsq_theta(k,iCell) = delsq_theta(k,iCell) * r
+ end do
end do
- end do
- do iEdge=1,grid % nEdges
- cell1 = grid % cellsOnEdge % array(1,iEdge)
- cell2 = grid % cellsOnEdge % array(2,iEdge)
- if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
- do k=2,grid % nVertLevels
- theta_turb_flux = h_mom_eddy_visc4*(delsq_theta(k,cell2) - delsq_theta(k,cell1))/dcEdge(iEdge)
- theta_turb_flux = theta_turb_flux * meshScalingDel4(iEdge)
- flux = dvEdge (iEdge) * theta_turb_flux
+ do k=2,nVertLevels
+ theta_turb_flux = h_mom_eddy_visc4*(delsq_theta(k,cell2) - delsq_theta(k,cell1))/dcEdge(iEdge)
+ theta_turb_flux = theta_turb_flux * meshScalingDel4(iEdge)
+ flux = dvEdge (iEdge) * theta_turb_flux
+ tend_w_euler(k,cell1) = tend_w_euler(k,cell1) - flux/areaCell(cell1)
+ tend_w_euler(k,cell2) = tend_w_euler(k,cell2) + flux/areaCell(cell2)
+ end do
-! tend_w(k,cell1) = tend_w(k,cell1) - flux
-! tend_w(k,cell2) = tend_w(k,cell2) + flux
- tend_w_euler(k,cell1) = tend_w_euler(k,cell1) - flux/areaCell(cell1)
- tend_w_euler(k,cell2) = tend_w_euler(k,cell2) + flux/areaCell(cell2)
- end do
+ end if
+ end do
- end if
- end do
+ deallocate(delsq_theta)
- deallocate(delsq_theta)
+ end if
- end if
-
end if ! horizontal mixing for w computed in first rk_step
!
! vertical advection, pressure gradient and buoyancy for w
- ! Note: we are also dividing through by the cell area after the horizontal flux divergence
!
do iCell = 1, nCells
@@ -2674,10 +2671,11 @@
wdwz(nVertLevels+1) = 0.
+ ! Note: next we are also dividing through by the cell area after the horizontal flux divergence
+
do k=2,nVertLevels
tend_w(k,iCell) = tend_w(k,iCell)/areaCell(iCell) -rdzu(k)*(wdwz(k+1)-wdwz(k)) &
-!SHP-buoy
- cqw(k,iCell)*( rdzu(k)*(pp(k,iCell)-pp(k-1,iCell)) &
+ gravity* &
( fzm(k)*(rb(k,iCell)*(qtot(k,iCell)) + &
@@ -2693,24 +2691,24 @@
if (rk_step == 1 .or. rk_diffusion) then
- if ( v_mom_eddy_visc2 > 0.0 ) then
+ if ( v_mom_eddy_visc2 > 0.0 ) then
- do iCell = 1, grid % nCellsSolve
+ do iCell = 1, nCellsSolve
do k=2,nVertLevels
tend_w_euler(k,iCell) = tend_w_euler(k,iCell) + v_mom_eddy_visc2*0.5*(rho_zz(k,iCell)+rho_zz(k-1,iCell))*( &
(w(k+1,iCell)-w(k ,iCell))*rdzw(k) &
-(w(k ,iCell)-w(k-1,iCell))*rdzw(k-1) )*rdzu(k)
end do
- end do
+ end do
- end if
+ end if
end if ! mixing term computed first rk_step
! add in mixing terms for w
- do iCell = 1, grid % nCellsSolve
+ do iCell = 1, nCellsSolve
do k=2,nVertLevels
tend_w(k,iCell) = tend_w(k,iCell) + tend_w_euler(k,iCell)
end do
@@ -2732,7 +2730,7 @@
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
- do k=1,grid % nVertLevels
+ do k=1,nVertLevels
flux = dvEdge(iEdge) * ru(k,iEdge) * ( 0.5*(theta_m(k,cell1) + theta_m(k,cell2)) )
tend_theta(k,cell1) = tend_theta(k,cell1) - flux
tend_theta(k,cell2) = tend_theta(k,cell2) + flux
@@ -2749,51 +2747,18 @@
flux_arr(:) = 0.
do i=1,nAdvCellsForEdge(iEdge)
- iCell = advCellsForEdge(i,iEdge)
- do k=1,grid % nVertLevels
- scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,ru(k,iEdge))*adv_coefs_3rd(i,iEdge)
- flux_arr(k) = flux_arr(k) + scalar_weight* theta_m(k,iCell)
- end do
+ iCell = advCellsForEdge(i,iEdge)
+ do k=1,nVertLevels
+ scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,ru(k,iEdge))*adv_coefs_3rd(i,iEdge)
+ flux_arr(k) = flux_arr(k) + scalar_weight* theta_m(k,iCell)
+ end do
end do
- do k=1,grid % nVertLevels
+ do k=1,nVertLevels
tend_theta(k,cell1) = tend_theta(k,cell1) - ru(k,iEdge)*flux_arr(k)
tend_theta(k,cell2) = tend_theta(k,cell2) + ru(k,iEdge)*flux_arr(k)
end do
-
-! do k=1,grid % nVertLevels
-!
-! d2fdx2_cell1 = deriv_two(1,1,iEdge) * theta_m(k,cell1)
-! d2fdx2_cell2 = deriv_two(1,2,iEdge) * theta_m(k,cell2)
-! do i=1, grid % nEdgesOnCell % array (cell1)
-! if ( grid % CellsOnCell % array (i,cell1) <= grid%nCells) &
-! d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta_m(k,grid % CellsOnCell % array (i,cell1))
-! end do
-! do i=1, grid % nEdgesOnCell % array (cell2)
-! if ( grid % CellsOnCell % array (i,cell2) <= grid%nCells) &
-! d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta_m(k,grid % CellsOnCell % array (i,cell2))
-! end do
-!
-! 3rd order stencil
-!
-! if( u(k,iEdge) > 0) then
-! flux = dvEdge(iEdge) * ru(k,iEdge) * ( &
-! 0.5*(theta_m(k,cell1) + theta_m(k,cell2)) &
-! -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
-! -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-! else
-! flux = dvEdge(iEdge) * ru(k,iEdge) * ( &
-! 0.5*(theta_m(k,cell1) + theta_m(k,cell2)) &
-! -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
-! +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-! end if
-!
-! tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-! tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-!
-! end do
-
end if
end do
@@ -2802,19 +2767,19 @@
do iEdge=1,nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- if (cell1 <= grid%nCells .and. cell2 <= grid%nCells) then
+ if (cell1 <= nCells .and. cell2 <= nCells) then
- do k=1,grid % nVertLevels
+ do k=1,nVertLevels
d2fdx2_cell1 = deriv_two(1,1,iEdge) * theta_m(k,cell1)
d2fdx2_cell2 = deriv_two(1,2,iEdge) * theta_m(k,cell2)
- do i=1, grid % nEdgesOnCell % array (cell1)
+ do i=1, nEdgesOnCell(cell1)
if ( grid % CellsOnCell % array (i,cell1) <= grid%nCells) &
- d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta_m(k,grid % CellsOnCell % array (i,cell1))
+ d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta_m(k,grid % CellsOnCell % array (i,cell1))
end do
- do i=1, grid % nEdgesOnCell % array (cell2)
+ do i=1, nEdgesOnCell(cell2)
if ( grid % CellsOnCell % array (i,cell2) <= grid%nCells) &
- d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta_m(k,grid % CellsOnCell % array (i,cell2))
+ d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta_m(k,grid % CellsOnCell % array (i,cell2))
end do
flux = dvEdge(iEdge) * ru(k,iEdge) * ( &
@@ -2840,19 +2805,17 @@
tend_theta_euler = 0.
if (delsq_horiz_mixing) then
- if ( h_theta_eddy_visc2 > 0.0 ) then
+ if ( (h_theta_eddy_visc2 > 0.0) .and. (config_horiz_mixing == "2d_fixed") ) then
- do iEdge=1,grid % nEdges
- cell1 = grid % cellsOnEdge % array(1,iEdge)
- cell2 = grid % cellsOnEdge % array(2,iEdge)
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
- do k=1,grid % nVertLevels
- theta_turb_flux = h_theta_eddy_visc2*prandtl*(theta_m(k,cell2) - theta_m(k,cell1))/dcEdge(iEdge)
+ do k=1,nVertLevels
+ theta_turb_flux = h_theta_eddy_visc2*prandtl_inv*(theta_m(k,cell2) - theta_m(k,cell1))/dcEdge(iEdge)
theta_turb_flux = theta_turb_flux * meshScalingDel2(iEdge)
flux = dvEdge (iEdge) * rho_edge(k,iEdge) * theta_turb_flux
-! tend_theta(k,cell1) = tend_theta(k,cell1) + flux
-! tend_theta(k,cell2) = tend_theta(k,cell2) - flux
tend_theta_euler(k,cell1) = tend_theta_euler(k,cell1) + flux/areaCell(cell1)
tend_theta_euler(k,cell2) = tend_theta_euler(k,cell2) - flux/areaCell(cell2)
end do
@@ -2862,18 +2825,16 @@
else if ( ( config_horiz_mixing == "2d_smagorinsky") ) then
- do iEdge=1,grid % nEdges
- cell1 = grid % cellsOnEdge % array(1,iEdge)
- cell2 = grid % cellsOnEdge % array(2,iEdge)
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
- do k=1,grid % nVertLevels
- theta_turb_flux = 0.5*(kdiff(k,cell1)+kdiff(k,cell2))*prandtl &
+ do k=1,nVertLevels
+ theta_turb_flux = 0.5*(kdiff(k,cell1)+kdiff(k,cell2))*prandtl_inv &
*(theta_m(k,cell2) - theta_m(k,cell1))/dcEdge(iEdge)
theta_turb_flux = theta_turb_flux * meshScalingDel2(iEdge)
flux = dvEdge (iEdge) * rho_edge(k,iEdge) * theta_turb_flux
-! tend_theta(k,cell1) = tend_theta(k,cell1) + flux
-! tend_theta(k,cell2) = tend_theta(k,cell2) - flux
tend_theta_euler(k,cell1) = tend_theta_euler(k,cell1) + flux/areaCell(cell1)
tend_theta_euler(k,cell2) = tend_theta_euler(k,cell2) - flux/areaCell(cell2)
end do
@@ -2884,16 +2845,17 @@
end if
- if ( h_theta_eddy_visc4 > 0.0 ) then
+ if ((h_theta_eddy_visc4 > 0.0 .and. config_horiz_mixing == "2d_fixed") .or. &
+ (h_theta_eddy_visc4 > 0.0 .and. config_horiz_mixing == "2d_smagorinsky")) then
allocate(delsq_theta(nVertLevels, nCells+1))
delsq_theta(:,:) = 0.
- do iEdge=1,grid % nEdges
- cell1 = grid % cellsOnEdge % array(1,iEdge)
- cell2 = grid % cellsOnEdge % array(2,iEdge)
- do k=1,grid % nVertLevels
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k=1,nVertLevels
delsq_theta(k,cell1) = delsq_theta(k,cell1) + dvEdge(iEdge)*rho_edge(k,iEdge)*(theta_m(k,cell2) - theta_m(k,cell1))/dcEdge(iEdge)
delsq_theta(k,cell2) = delsq_theta(k,cell2) - dvEdge(iEdge)*rho_edge(k,iEdge)*(theta_m(k,cell2) - theta_m(k,cell1))/dcEdge(iEdge)
end do
@@ -2906,18 +2868,15 @@
end do
end do
- do iEdge=1,grid % nEdges
- cell1 = grid % cellsOnEdge % array(1,iEdge)
- cell2 = grid % cellsOnEdge % array(2,iEdge)
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
- do k=1,grid % nVertLevels
- theta_turb_flux = h_theta_eddy_visc4*prandtl*(delsq_theta(k,cell2) - delsq_theta(k,cell1))/dcEdge(iEdge)
+ do k=1,nVertLevels
+ theta_turb_flux = h_theta_eddy_visc4*prandtl_inv*(delsq_theta(k,cell2) - delsq_theta(k,cell1))/dcEdge(iEdge)
theta_turb_flux = theta_turb_flux * meshScalingDel4(iEdge)
flux = dvEdge (iEdge) * theta_turb_flux
-
-! tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-! tend_theta(k,cell2) = tend_theta(k,cell2) + flux
tend_theta_euler(k,cell1) = tend_theta_euler(k,cell1) - flux/areaCell(cell1)
tend_theta_euler(k,cell2) = tend_theta_euler(k,cell2) + flux/areaCell(cell2)
end do
@@ -2985,47 +2944,41 @@
if (config_mix_full) then
- do iCell = 1, grid % nCellsSolve
- do k=2,nVertLevels-1
- z1 = zgrid(k-1,iCell)
- z2 = zgrid(k ,iCell)
- z3 = zgrid(k+1,iCell)
- z4 = zgrid(k+2,iCell)
+ do iCell = 1, nCellsSolve
+ do k=2,nVertLevels-1
+ z1 = zgrid(k-1,iCell)
+ z2 = zgrid(k ,iCell)
+ z3 = zgrid(k+1,iCell)
+ z4 = zgrid(k+2,iCell)
- zm = 0.5*(z1+z2)
- z0 = 0.5*(z2+z3)
- zp = 0.5*(z3+z4)
+ zm = 0.5*(z1+z2)
+ z0 = 0.5*(z2+z3)
+ zp = 0.5*(z3+z4)
-! tend_theta(k,iCell) = tend_theta(k,iCell) + v_theta_eddy_visc2*prandtl*rho_zz(k,iCell)*(&
-! (theta_m(k+1,iCell)-theta_m(k ,iCell))/(zp-z0) &
-! -(theta_m(k ,iCell)-theta_m(k-1,iCell))/(z0-zm) )/(0.5*(zp-zm))
- tend_theta_euler(k,iCell) = tend_theta_euler(k,iCell) + v_theta_eddy_visc2*prandtl*rho_zz(k,iCell)*(&
- (theta_m(k+1,iCell)-theta_m(k ,iCell))/(zp-z0) &
- -(theta_m(k ,iCell)-theta_m(k-1,iCell))/(z0-zm) )/(0.5*(zp-zm))
+ tend_theta_euler(k,iCell) = tend_theta_euler(k,iCell) + v_theta_eddy_visc2*prandtl_inv*rho_zz(k,iCell)*(&
+ (theta_m(k+1,iCell)-theta_m(k ,iCell))/(zp-z0) &
+ -(theta_m(k ,iCell)-theta_m(k-1,iCell))/(z0-zm) )/(0.5*(zp-zm))
+ end do
end do
- end do
else ! idealized cases where we mix on the perturbation from the initial 1-D state
- do iCell = 1, grid % nCellsSolve
- do k=2,nVertLevels-1
- z1 = zgrid(k-1,iCell)
- z2 = zgrid(k ,iCell)
- z3 = zgrid(k+1,iCell)
- z4 = zgrid(k+2,iCell)
+ do iCell = 1, nCellsSolve
+ do k=2,nVertLevels-1
+ z1 = zgrid(k-1,iCell)
+ z2 = zgrid(k ,iCell)
+ z3 = zgrid(k+1,iCell)
+ z4 = zgrid(k+2,iCell)
- zm = 0.5*(z1+z2)
- z0 = 0.5*(z2+z3)
- zp = 0.5*(z3+z4)
+ zm = 0.5*(z1+z2)
+ z0 = 0.5*(z2+z3)
+ zp = 0.5*(z3+z4)
-! tend_theta(k,iCell) = tend_theta(k,iCell) + v_theta_eddy_visc2*prandtl*rho_zz(k,iCell)*(&
-! ((theta_m(k+1,iCell)-t_init(k+1,iCell))-(theta_m(k ,iCell)-t_init(k,iCell)))/(zp-z0) &
-! -((theta_m(k ,iCell)-t_init(k,iCell))-(theta_m(k-1,iCell)-t_init(k-1,iCell)))/(z0-zm) )/(0.5*(zp-zm))
- tend_theta_euler(k,iCell) = tend_theta_euler(k,iCell) + v_theta_eddy_visc2*prandtl*rho_zz(k,iCell)*(&
- ((theta_m(k+1,iCell)-t_init(k+1,iCell))-(theta_m(k ,iCell)-t_init(k,iCell)))/(zp-z0) &
- -((theta_m(k ,iCell)-t_init(k,iCell))-(theta_m(k-1,iCell)-t_init(k-1,iCell)))/(z0-zm) )/(0.5*(zp-zm))
+ tend_theta_euler(k,iCell) = tend_theta_euler(k,iCell) + v_theta_eddy_visc2*prandtl_inv*rho_zz(k,iCell)*(&
+ ((theta_m(k+1,iCell)-t_init(k+1,iCell))-(theta_m(k ,iCell)-t_init(k,iCell)))/(zp-z0) &
+ -((theta_m(k ,iCell)-t_init(k,iCell))-(theta_m(k-1,iCell)-t_init(k-1,iCell)))/(z0-zm) )/(0.5*(zp-zm))
+ end do
end do
- end do
end if
@@ -3033,7 +2986,7 @@
end if ! compute theta mixing on first rk_step
- do iCell = 1, grid % nCellsSolve
+ do iCell = 1, nCellsSolve
do k=1,nVertLevels
tend_theta(k,iCell) = tend_theta(k,iCell) + tend_theta_euler(k,iCell)
end do
@@ -3047,9 +3000,9 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Compute diagnostic fields used in the tendency computations
!
- ! Input: grid - grid metadata
+ ! Input: state (s), grid - grid metadata
!
- ! Output: s - computed diagnostics
+ ! Output: diag - computed diagnostics
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
implicit none
@@ -3060,18 +3013,17 @@
type (mesh_type), intent(in) :: grid
- integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
- real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, r
+ integer :: iEdge, iCell, iVertex, k, cell1, cell2, eoe, i
+ real (kind=RKIND) :: h_vertex, r
- integer :: nCells, nEdges, nVertices, nVertLevels
+ integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree
real (kind=RKIND), dimension(:), pointer :: fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
- real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &
+ real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, &
circulation, vorticity, ke, pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, &
divergence
integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
- !WCS-instability
logical, parameter :: hollingsworth=.true.
real (kind=RKIND), allocatable, dimension(:,:) :: ke_vertex
real (kind=RKIND) :: ke_fact
@@ -3109,10 +3061,11 @@
fVertex => grid % fVertex % array
fEdge => grid % fEdge % array
- nCells = grid % nCells
- nEdges = grid % nEdges
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+ vertexDegree = grid % vertexDegree
!
! Compute height on cell edges at velocity locations
@@ -3164,7 +3117,7 @@
!
- ! Compute kinetic energy in each cell
+ ! Compute kinetic energy in each cell (Ringler et al JCP 2009)
!
ke(:,:) = 0.0
do iCell=1,nCells
@@ -3179,52 +3132,49 @@
end do
end do
- !WCS-instability
- ! Compute ke at cell vertices - AG's new KE construction, part 1
- ! *** approximation here because we don't have inner triangle areas
- !
if (hollingsworth) then
- allocate (ke_vertex(nVertLevels,nVertices))
- do iVertex=1,nVertices
- do k=1,nVertLevels
-! ke_vertex(k,iVertex) = ( subTriangleAreasOnVertex(1,iVertex)*u(k,EdgesOnVertex(1,iVertex))**2.0 &
-! + subTriangleAreasOnVertex(2,iVertex)*u(k,EdgesOnVertex(2,iVertex))**2.0 &
-! + subTriangleAreasOnVertex(3,iVertex)*u(k,EdgesOnVertex(3,iVertex))**2.0 &
-! ) / AreaTriangle(iVertex)
- ke_vertex(k,iVertex) = ( dcEdge(EdgesOnVertex(1,iVertex))*dvEdge(EdgesOnVertex(1,iVertex))*u(k,EdgesOnVertex(1,iVertex))**2.0 &
- +dcEdge(EdgesOnVertex(2,iVertex))*dvEdge(EdgesOnVertex(2,iVertex))*u(k,EdgesOnVertex(2,iVertex))**2.0 &
- +dcEdge(EdgesOnVertex(3,iVertex))*dvEdge(EdgesOnVertex(3,iVertex))*u(k,EdgesOnVertex(3,iVertex))**2.0 &
- ) * 0.25 / AreaTriangle(iVertex)
+ ! Compute ke at cell vertices - AG's new KE construction, part 1
+ ! *** approximation here because we don't have inner triangle areas
+ !
+ allocate (ke_vertex(nVertLevels,nVertices))
+ do iVertex=1,nVertices
+ do k=1,nVertLevels
+
+ ke_vertex(k,iVertex) = ( dcEdge(EdgesOnVertex(1,iVertex))*dvEdge(EdgesOnVertex(1,iVertex))*u(k,EdgesOnVertex(1,iVertex))**2.0 &
+ +dcEdge(EdgesOnVertex(2,iVertex))*dvEdge(EdgesOnVertex(2,iVertex))*u(k,EdgesOnVertex(2,iVertex))**2.0 &
+ +dcEdge(EdgesOnVertex(3,iVertex))*dvEdge(EdgesOnVertex(3,iVertex))*u(k,EdgesOnVertex(3,iVertex))**2.0 &
+ ) * 0.25 / AreaTriangle(iVertex)
+
+ end do
end do
- end do
- ! adjust ke at cell vertices - AG's new KE construction, part 2
- !
+ ! adjust ke at cell vertices - AG's new KE construction, part 2
+ !
- ke_fact = 1.0 - .375
+ ke_fact = 1.0 - .375
- do iCell=1,nCells
- do k=1,nVertLevels
- ke(k,iCell) = ke_fact*ke(k,iCell)
+ do iCell=1,nCells
+ do k=1,nVertLevels
+ ke(k,iCell) = ke_fact*ke(k,iCell)
+ end do
end do
- end do
- do iVertex = 1, nVertices
- do i=1,grid % vertexDegree
- iCell = cellsOnVertex(i,iVertex)
- do k = 1,nVertLevels
- ke(k,iCell) = ke(k,iCell) + (1.-ke_fact)*kiteAreasOnVertex(i, iVertex) * ke_vertex(k, iVertex) / areaCell(iCell)
- end do
- end do
- end do
- deallocate (ke_vertex)
+ do iVertex = 1, nVertices
+ do i=1,vertexDegree
+ iCell = cellsOnVertex(i,iVertex)
+ do k = 1,nVertLevels
+ ke(k,iCell) = ke(k,iCell) + (1.-ke_fact)*kiteAreasOnVertex(i, iVertex) * ke_vertex(k, iVertex) / areaCell(iCell)
+ end do
+ end do
+ end do
+ deallocate (ke_vertex)
+
end if
- !END of WCS-instability
!
- ! Compute v (tangential) velocities
+ ! Compute v (tangential) velocities following Thuburn et al JCP 2009
!
v(:,:) = 0.0
do iEdge = 1,nEdges
@@ -3244,7 +3194,7 @@
do iVertex = 1,nVertices
do k=1,nVertLevels
h_vertex = 0.0
- do i=1,grid % vertexDegree
+ do i=1,vertexDegree
h_vertex = h_vertex + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
end do
h_vertex = h_vertex / areaTriangle(iVertex)
@@ -3260,7 +3210,7 @@
!
pv_edge(:,:) = 0.0
do iVertex = 1,nVertices
- do i=1,grid % vertexDegree
+ do i=1,vertexDegree
iEdge = edgesOnVertex(i,iVertex)
do k=1,nVertLevels
pv_edge(k,iEdge) = pv_edge(k,iEdge) + 0.5 * pv_vertex(k,iVertex)
@@ -3274,7 +3224,7 @@
!
pv_cell(:,:) = 0.0
do iVertex = 1, nVertices
- do i=1,grid % vertexDegree
+ do i=1,vertexDegree
iCell = cellsOnVertex(i,iVertex)
do k = 1,nVertLevels
pv_cell(k,iCell) = pv_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) / areaCell(iCell)
@@ -3285,44 +3235,44 @@
if (config_apvm_upwinding > 0.0) then
- !
- ! Modify PV edge with upstream bias.
- !
- ! Compute gradient of PV in the tangent direction
- ! ( this computes gradPVt at all edges bounding real cells )
- !
- do iEdge = 1,nEdges
- do k = 1,nVertLevels
- gradPVt(k,iEdge) = (pv_vertex(k,verticesOnEdge(2,iEdge)) - pv_vertex(k,verticesOnEdge(1,iEdge))) / &
- dvEdge(iEdge)
+ !
+ ! Modify PV edge with upstream bias.
+ !
+ ! Compute gradient of PV in the tangent direction
+ ! ( this computes gradPVt at all edges bounding real cells )
+ !
+ do iEdge = 1,nEdges
+ do k = 1,nVertLevels
+ gradPVt(k,iEdge) = (pv_vertex(k,verticesOnEdge(2,iEdge)) - pv_vertex(k,verticesOnEdge(1,iEdge))) / &
+ dvEdge(iEdge)
+ end do
end do
- end do
- !
- ! Compute gradient of PV in normal direction
- ! (tdr: 2009-10-02: this is not correct because the pv_cell in the halo is not correct)
- !
- gradPVn(:,:) = 0.0
- do iEdge = 1,nEdges
- do k = 1,nVertLevels
- gradPVn(k,iEdge) = (pv_cell(k,cellsOnEdge(2,iEdge)) - pv_cell(k,cellsOnEdge(1,iEdge))) / &
- dcEdge(iEdge)
+ !
+ ! Compute gradient of PV in normal direction
+ ! (tdr: 2009-10-02: this is not correct because the pv_cell in the halo is not correct)
+ !
+ gradPVn(:,:) = 0.0
+ do iEdge = 1,nEdges
+ do k = 1,nVertLevels
+ gradPVn(k,iEdge) = (pv_cell(k,cellsOnEdge(2,iEdge)) - pv_cell(k,cellsOnEdge(1,iEdge))) / &
+ dcEdge(iEdge)
+ end do
end do
- end do
- do iEdge = 1,nEdges
- do k = 1,nVertLevels
- pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * v(k,iEdge) * dt * gradPVt(k,iEdge)
+ do iEdge = 1,nEdges
+ do k = 1,nVertLevels
+ pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * v(k,iEdge) * dt * gradPVt(k,iEdge)
+ end do
end do
- end do
- ! Modify PV edge with upstream bias.
- !
- do iEdge = 1,nEdges
- do k = 1,nVertLevels
- pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * u(k,iEdge) *dt * gradPVn(k,iEdge)
+ ! Modify PV edge with upstream bias.
+ !
+ do iEdge = 1,nEdges
+ do k = 1,nVertLevels
+ pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * u(k,iEdge) *dt * gradPVn(k,iEdge)
+ end do
end do
- end do
end if ! apvm upwinding
@@ -3339,64 +3289,56 @@
type (diag_type), intent(inout) :: diag
type (mesh_type), intent(inout) :: grid
- !SHP-w
- integer :: k,iCell,iEdge,i,iCell1,iCell2, cell1, cell2, coef_3rd_order
+ integer :: k,iCell,iEdge,iCell1,iCell2, cell1, cell2, coef_3rd_order
+ integer :: nCells, nEdges, nVertLevels
real (kind=RKIND) :: p0, rcv, flux
+ integer, dimension(:,:), pointer :: cellsOnEdge
- !SHP-w
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nVertLevels = grid % nVertLevels
+
+ cellsOnEdge => grid % cellsOnEdge % array
+
coef_3rd_order = config_coef_3rd_order
if(config_theta_adv_order /=3) coef_3rd_order = 0
rcv = rgas / (cp-rgas)
p0 = 1.e5 ! this should come from somewhere else...
- do iCell=1,grid%nCells
- do k=1,grid%nVertLevels
- state % theta_m % array(k,iCell) = diag % theta % array(k,iCell) * (1.0 + 1.61 * state % scalars % array(state % index_qv,k,iCell))
+ do iCell=1,nCells
+ do k=1,nVertLevels
+ state % theta_m % array(k,iCell) = diag % theta % array(k,iCell) * (1._RKIND + rvord * state % scalars % array(state % index_qv,k,iCell))
state % rho_zz % array(k,iCell) = diag % rho % array(k,iCell) / grid % zz % array(k,iCell)
end do
end do
- do iEdge = 1, grid % nEdges
- iCell1 = grid % cellsOnEdge % array(1,iEdge)
- iCell2 = grid % cellsOnEdge % array(2,iEdge)
- do k=1,grid % nVertLevels
+ do iEdge = 1, nEdges
+ iCell1 = cellsOnEdge(1,iEdge)
+ iCell2 = cellsOnEdge(2,iEdge)
+ do k=1,nVertLevels
diag % ru % array(k,iEdge) = 0.5 * state % u % array(k,iEdge) * (state % rho_zz % array(k,iCell1) + state % rho_zz % array(k,iCell2))
end do
end do
-! ! Compute w from rho_zz and rw
-! do iCell=1,grid%nCells
-! diag % rw % array(1,iCell) = 0.
-! diag % rw % array(grid%nVertLevels+1,iCell) = 0.
-! do k=2,grid%nVertLevels
-! diag % rw % array(k,iCell) = state % w % array(k,iCell) &
-! * (grid % fzp % array(k) * state % rho_zz % array(k-1,iCell) + grid % fzm % array(k) * state % rho_zz % array(k,iCell))
-! end do
-! end do
-
-
-! WCS bug fix 20110916
-
! Compute rw (i.e. rho_zz * omega) from rho_zz, w, and ru.
! We are reversing the procedure we use in subroutine atm_recover_large_step_variables.
! first, the piece that depends on w.
- do iCell=1,grid%nCells
+ do iCell=1,nCells
diag % rw % array(1,iCell) = 0.
diag % rw % array(grid%nVertLevels+1,iCell) = 0.
- do k=2,grid%nVertLevels
+ do k=2,nVertLevels
diag % rw % array(k,iCell) = state % w % array(k,iCell) &
* (grid % fzp % array(k) * state % rho_zz % array(k-1,iCell) + grid % fzm % array(k) * state % rho_zz % array(k,iCell)) &
* (grid % fzp % array(k) * grid % zz % array(k-1,iCell) + grid % fzm % array(k) * grid % zz % array(k,iCell))
end do
end do
- !SHP-w
! next, the piece that depends on ru
- do iEdge=1,grid%nEdges
- cell1 = grid % CellsOnEdge % array(1,iEdge)
- cell2 = grid % CellsOnEdge % array(2,iEdge)
- do k = 2, grid % nVertLevels
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k = 2, nVertLevels
flux = (grid % fzm % array(k) * diag % ru % array(k,iEdge)+grid % fzp % array(k) * diag % ru % array(k-1,iEdge))
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
+ (grid % zb % array(k,2,iEdge) + coef_3rd_order * sign(1.0_RKIND,flux) * grid % zb3 % array(k,2,iEdge))*flux &
@@ -3404,38 +3346,36 @@
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- (grid % zb % array(k,1,iEdge) + coef_3rd_order * sign(1.0_RKIND,flux) * grid % zb3 % array(k,1,iEdge))*flux &
* (grid % fzp % array(k) * grid % zz % array(k-1,cell1) + grid % fzm % array(k) * grid % zz % array(k,cell1))
- end do
+ end do
end do
-! end WCS bug fix
-
- do iCell = 1, grid % nCells
- do k=1,grid % nVertLevels
+ do iCell = 1, nCells
+ do k=1,nVertLevels
diag % rho_p % array(k,iCell) = state % rho_zz % array(k,iCell) - diag % rho_base % array(k,iCell)
end do
end do
- do iCell = 1, grid % nCells
- do k=1,grid % nVertLevels
+ do iCell = 1, nCells
+ do k=1,nVertLevels
diag % rtheta_base % array(k,iCell) = diag % theta_base % array(k,iCell) * diag % rho_base % array(k,iCell)
end do
end do
- do iCell = 1, grid % nCells
- do k=1,grid % nVertLevels
+ do iCell = 1, nCells
+ do k=1,nVertLevels
diag % rtheta_p % array(k,iCell) = state % theta_m % array(k,iCell) * diag % rho_p % array(k,iCell) &
+ diag % rho_base % array(k,iCell) * (state % theta_m % array(k,iCell) - diag % theta_base % array(k,iCell))
end do
end do
- do iCell=1,grid % nCells
- do k=1,grid % nVertLevels
+ do iCell=1,nCells
+ do k=1,nVertLevels
diag % exner % array(k,iCell) = (grid % zz % array(k,iCell) * (rgas/p0) * (diag % rtheta_p % array(k,iCell) + diag % rtheta_base % array(k,iCell)))**rcv
end do
end do
- do iCell=1,grid % nCells
- do k=1,grid % nVertLevels
+ do iCell=1,nCells
+ do k=1,nVertLevels
diag % pressure_p % array(k,iCell) = grid % zz % array(k,iCell) * rgas &
* ( diag % exner % array(k,iCell) * diag % rtheta_p % array(k,iCell) &
+ diag % rtheta_base % array(k,iCell) * (diag % exner % array(k,iCell) - diag % exner_base % array(k,iCell)) &
Index: branches/mpas_cdg_advection/src/core_ocean
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean 2013-04-22 01:31:32 UTC (rev 2783)
Property changes on: branches/mpas_cdg_advection/src/core_ocean
___________________________________________________________________
Modified: svn:mergeinfo
## -1,9 +1,11 ##
/branches/atmos_physics/src/core_ocean:1672-1846
/branches/cam_mpas_nh/src/core_ocean:1260-1270
+/branches/history_attribute/src/core_ocean:2698-2745
/branches/ocean_projects/ale_split_exp/src/core_ocean:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean:1387-1428
/branches/ocean_projects/cesm_coupling/src/core_ocean:2147-2344
+/branches/ocean_projects/comment_cleanup/src/core_ocean:2626-2630
/branches/ocean_projects/diagnostics_revision/src/core_ocean:2439-2462
/branches/ocean_projects/explicit_vmix_removal/src/core_ocean:2486-2490
/branches/ocean_projects/gmvar/src/core_ocean:1214-1514,1517-1738
## -21,6 +23,7 ##
/branches/ocean_projects/sea_level_pressure/src/core_ocean:2488-2528
/branches/ocean_projects/split_explicit_mrp/src/core_ocean:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean:1044-1097
+/branches/ocean_projects/variable_name_change/src/core_ocean:2689-2767
/branches/ocean_projects/vert_adv_mrp/src/core_ocean:704-745
/branches/ocean_projects/vol_cons_RK_imp_mix/src/core_ocean:1965-1992
/branches/ocean_projects/zstar_restart_new/src/core_ocean:1762-1770
## -31,6 +34,8 ##
/branches/omp_blocks/multiple_blocks/src/core_ocean:1803-2084
/branches/omp_blocks/openmp_test/src/core_ocean:2107-2144
/branches/omp_blocks/openmp_test/src/core_ocean_elements:2161-2201
+/branches/scratch_indication/src/core_ocean:2555-2656
/branches/source_renaming/src/core_ocean:1082-1113
/branches/time_manager/src/core_ocean:924-962
-/trunk/mpas/src/core_ocean:2390-2599
+/branches/xml_registry/src/core_ocean:2610-2662
+/trunk/mpas/src/core_ocean:2390-2782
\ No newline at end of property
Modified: branches/mpas_cdg_advection/src/core_ocean/Makefile
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/Makefile 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/Makefile 2013-04-22 01:31:32 UTC (rev 2783)
@@ -15,21 +15,6 @@
mpas_ocn_vel_forcing_windstress.o \
mpas_ocn_vel_forcing_rayleigh.o \
mpas_ocn_vel_pressure_grad.o \
- mpas_ocn_tracer_vadv.o \
- mpas_ocn_tracer_vadv_spline.o \
- mpas_ocn_tracer_vadv_spline2.o \
- mpas_ocn_tracer_vadv_spline3.o \
- mpas_ocn_tracer_vadv_stencil.o \
- mpas_ocn_tracer_vadv_stencil2.o \
- mpas_ocn_tracer_vadv_stencil3.o \
- mpas_ocn_tracer_vadv_stencil4.o \
- mpas_ocn_tracer_hadv.o \
- mpas_ocn_tracer_hadv2.o \
- mpas_ocn_tracer_hadv3.o \
- mpas_ocn_tracer_hadv4.o \
- mpas_ocn_tracer_hmix.o \
- mpas_ocn_tracer_hmix_del2.o \
- mpas_ocn_tracer_hmix_del4.o \
mpas_ocn_vmix.o \
mpas_ocn_vmix_coefs_const.o \
mpas_ocn_vmix_coefs_rich.o \
@@ -37,6 +22,9 @@
mpas_ocn_restoring.o \
mpas_ocn_tendency.o \
mpas_ocn_diagnostics.o \
+ mpas_ocn_tracer_hmix.o \
+ mpas_ocn_tracer_hmix_del2.o \
+ mpas_ocn_tracer_hmix_del4.o \
mpas_ocn_tracer_advection.o \
mpas_ocn_tracer_advection_std.o \
mpas_ocn_tracer_advection_std_hadv.o \
@@ -104,30 +92,6 @@
mpas_ocn_vel_coriolis.o:
-mpas_ocn_tracer_hadv.o: mpas_ocn_tracer_hadv2.o mpas_ocn_tracer_hadv3.o mpas_ocn_tracer_hadv4.o
-
-mpas_ocn_tracer_hadv2.o:
-
-mpas_ocn_tracer_hadv3.o:
-
-mpas_ocn_tracer_hadv4.o:
-
-mpas_ocn_tracer_vadv.o: mpas_ocn_tracer_vadv_spline.o mpas_ocn_tracer_vadv_stencil.o
-
-mpas_ocn_tracer_vadv_spline.o: mpas_ocn_tracer_vadv_spline2.o mpas_ocn_tracer_vadv_spline3.o
-
-mpas_ocn_tracer_vadv_spline2.o:
-
-mpas_ocn_tracer_vadv_spline3.o:
-
-mpas_ocn_tracer_vadv_stencil.o: mpas_ocn_tracer_vadv_stencil2.o mpas_ocn_tracer_vadv_stencil3.o mpas_ocn_tracer_vadv_stencil4.o
-
-mpas_ocn_tracer_vadv_stencil2.o:
-
-mpas_ocn_tracer_vadv_stencil3.o:
-
-mpas_ocn_tracer_vadv_stencil4.o:
-
mpas_ocn_tracer_hmix.o: mpas_ocn_tracer_hmix_del2.o mpas_ocn_tracer_hmix_del4.o
mpas_ocn_tracer_hmix_del2.o:
@@ -183,18 +147,6 @@
mpas_ocn_vel_forcing.o \
mpas_ocn_vel_forcing_windstress.o \
mpas_ocn_vel_pressure_grad.o \
- mpas_ocn_tracer_vadv.o \
- mpas_ocn_tracer_vadv_spline.o \
- mpas_ocn_tracer_vadv_spline2.o \
- mpas_ocn_tracer_vadv_spline3.o \
- mpas_ocn_tracer_vadv_stencil.o \
- mpas_ocn_tracer_vadv_stencil2.o \
- mpas_ocn_tracer_vadv_stencil3.o \
- mpas_ocn_tracer_vadv_stencil4.o \
- mpas_ocn_tracer_hadv.o \
- mpas_ocn_tracer_hadv2.o \
- mpas_ocn_tracer_hadv3.o \
- mpas_ocn_tracer_hadv4.o \
mpas_ocn_tracer_hmix.o \
mpas_ocn_tracer_hmix_del2.o \
mpas_ocn_tracer_hmix_del4.o \
Copied: branches/mpas_cdg_advection/src/core_ocean/Registry.xml (from rev 2782, trunk/mpas/src/core_ocean/Registry.xml)
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/Registry.xml (rev 0)
+++ branches/mpas_cdg_advection/src/core_ocean/Registry.xml 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,1071 @@
+<?xml version="1.0"?>
+<registry model="mpas" core="ocean" version="0.0.0">
+ <dims>
+ <dim name="nCells" units="unitless"
+ description="The number of polygons in the primary grid."
+ />
+ <dim name="nEdges" units="unitless"
+ description="The number of edge midpoints in either the primary or dual grid."
+ />
+ <dim name="maxEdges" units="unitless"
+ description="The largest number of edges any polygon within the grid has."
+ />
+ <dim name="maxEdges2" units="unitless"
+ description="Two times the largest number of edges any polygon within the grid has."
+ />
+ <dim name="nAdvectionCells" definition="maxEdges2+0" units="unitless"
+ description="The largest number of advection cells for any edge."
+ />
+ <dim name="nVertices" units="unitless"
+ description="The total number of cells in the dual grid. Also the number of corners in the primary grid."
+ />
+ <dim name="TWO" definition="2" units="unitless"
+ description="The number two as a dimension."
+ />
+ <dim name="R3" definition="3" units="unitless"
+ description="The number three as a dimension."
+ />
+ <dim name="FIFTEEN" definition="15" units="unitless"
+ description="The number 15 as a dimension."
+ />
+ <dim name="TWENTYONE" definition="21" units="unitless"
+ description="The number 21 as a dimension."
+ />
+ <dim name="vertexDegree" units="unitless"
+ description="The number of cells or edges touching each vertex."
+ />
+ <dim name="nVertLevels" units="unitless"
+ description="The number of levels in the vertical direction. All vertical levels share the same horizontal locations."
+ />
+ <dim name="nVertLevelsP1" definition="nVertLevels+1" units="unitless"
+ description="The number of interfaces in the vertical direction."
+ />
+ <dim name="nMonths" units="unitless"
+ description="The number of forcing slices in the monthly forcing fields. {\bf \color{red} Deprecated. Should be removed.}"
+ />
+ </dims>
+ <nml_record name="time_management">
+ <nml_option name="config_do_restart" type="logical" default_value=".false." units="unitless"
+ description="Determines if the initial conditions should be read from a restart file, or an input file."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_start_time" type="character" default_value="'0000-01-01_00:00:00'" units="unitless"
+ description="Timestamp describing the initial time of the simulation. If it is set to 'file', the initial time is read from restart_timestamp."
+ possible_values="'YYYY-MM-DD_HH:MM:SS' or 'file'"
+ />
+ <nml_option name="config_stop_time" type="character" default_value="'none'" units="unitless"
+ description="Timestamp descriping the final time of the simulation. If it is set to 'none' the final time is determined from config_start_time and config_run_duration."
+ possible_values="'YYYY-MM-DD_HH:MM:SS' or 'none'"
+ />
+ <nml_option name="config_run_duration" type="character" default_value="'0_06:00:00'" units="unitless"
+ description="Timestamp describing the length of the simulation. If it is set to 'none' the duraction is determined from config_start_time and config_stop_time. config_run_duration overrides inconsistent values of config_stop_time."
+ possible_values="'DDDD_HH:MM:SS' or 'none'"
+ />
+ <nml_option name="config_calendar_type" type="character" default_value="'360day'" units="unitless"
+ description="Selection of the type of calendar that should be used in the simulation."
+ possible_values="'gregorian', 'gregorian_noleap', or '360day'"
+ />
+ </nml_record>
+ <nml_record name="io">
+ <nml_option name="config_input_name" type="character" default_value="'grid.nc'" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_output_name" type="character" default_value="'output.nc'" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_restart_name" type="character" default_value="'restart.nc'" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_restart_interval" type="character" default_value="'0_06:00:00'" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_output_interval" type="character" default_value="'0_06:00:00'" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_stats_interval" type="character" default_value="'0_01:00:00'" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_write_stats_on_startup" type="logical" default_value=".true." units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_write_output_on_startup" type="logical" default_value=".true." units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_frames_per_outfile" type="integer" default_value="1000" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_pio_num_iotasks" type="integer" default_value="0" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_pio_stride" type="integer" default_value="1" units=""
+ description=""
+ possible_values=""
+ />
+ </nml_record>
+ <nml_record name="time_integration">
+ <nml_option name="config_dt" type="real" default_value="3000.0" units="s"
+ description="Length of model time-step."
+ possible_values="Any positive real value, but limited by CFL condition."
+ />
+ <nml_option name="config_time_integrator" type="character" default_value="'split_explicit'" units="unitless"
+ description="Time integration method."
+ possible_values="'split_explicit', 'RK4', 'unsplit_explicit'"
+ />
+ </nml_record>
+ <nml_record name="grid">
+ <nml_option name="config_num_halos" type="integer" default_value="3" units="unitless"
+ description="Determines the number of halo cells extending from a blocks owned cells (Called the 0-Halo). The default of 3 is the minimum that can be used with monotonic advection."
+ possible_values="Any positive interger value."
+ />
+ <nml_option name="config_vert_coord_movement" type="character" default_value="'uniform_stretching'" units="unitless"
+ description="Determines the vertical coordinate movement type. 'uniform_stretching' distrubtes SSH perturbations through all vertical levels, 'fixed' places them all in the top level, 'user_specified' allows the input file to determine the distribution, and 'isopycnal' causes levels to be pure isopycnal."
+ possible_values="'uniform_stretching', 'fixed', 'user_specified', 'isopycnal'"
+ />
+ <nml_option name="config_alter_ICs_for_pbcs" type="character" default_value="'zlevel_pbcs_off'" units="unitless"
+ description="Determines the method of alteration for partial bottom cells. 'zlevel_pbcs_on' alters the initial conditions for partial bottom cells, 'zlevel_pbcs_off' alters the initial conditions to have full cells everwhere, and 'off' does nothing to the initial conditions."
+ possible_values="'zlevel_pbcs_on', 'zlevel_pbcs_off', 'off'"
+ />
+ <nml_option name="config_min_pbc_fraction" type="real" default_value="0.10" units="unitless"
+ description="Determines the minimum fraction of a cell altering the initial conditions can create."
+ possible_values="Any real between 0 and 1."
+ />
+ <nml_option name="config_check_ssh_consistency" type="logical" default_value=".true." units=""
+ description="Enables a check to determine if the SSH is consistent across relevant variables."
+ possible_values=""
+ />
+ </nml_record>
+ <nml_record name="decomposition">
+ <nml_option name="config_block_decomp_file_prefix" type="character" default_value="'graph.info.part.'" units="unitless"
+ description="Defines the prefix for the block decomposition file. Can include a path. The number of blocks is appended to the end of the prefix at run-time."
+ possible_values="Any path/prefix to a block decomposition file."
+ />
+ <nml_option name="config_number_of_blocks" type="integer" default_value="0" units="unitless"
+ description="Determines the number of blocks a simulation should be run with. If it is set to 0, the number of blocks is the same as the number of MPI tasks at run-time."
+ possible_values="Any integer $>=$ 0."
+ />
+ <nml_option name="config_explicit_proc_decomp" type="logical" default_value=".false." units="unitless"
+ description="Determines if an explicit processor decomposition should be used. This is only useful if multiple blocks per processor are used."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_proc_decomp_file_prefix" type="character" default_value="'graph.info.part.'" units="unitless"
+ description="Defines the prefix for the processor decomposition file. This file is only read if config_explicit_proc_decomp is .true. The number of processors is appended to the end of the prefix at run-time."
+ possible_values="Any path/prefix to a processor decomposition file."
+ />
+ </nml_record>
+ <nml_record name="hmix">
+ <nml_option name="config_hmix_ScaleWithMesh" type="logical" default_value=".false." units="unitless"
+ description="If false, del2 and del4 coefficients are constant throughout the mesh (equivalent to setting $\rho_m=1$ throughout the mesh). If true, these coefficients scale as mesh density to the -3/4 power."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_visc_vorticity_term" type="logical" default_value=".true." units="unitless"
+ description="{\color{red} TO BE DELETED}"
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_apvm_scale_factor" type="real" default_value="0.0" units="unitless"
+ description="Anticipated potential vorticity (APV) method scale factor, $c_{apv}$. When zero, APV is off."
+ possible_values="Any non-negative number, typically between zero and one."
+ />
+ </nml_record>
+ <nml_record name="hmix_del2">
+ <nml_option name="config_use_mom_del2" type="logical" default_value=".false." units="unitless"
+ description="If true, Laplacian horizontal mixing is used on the momentum equation."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_use_tracer_del2" type="logical" default_value=".false." units="unitless"
+ description="If true, Laplacian horizontal mixing is used on the tracer equation."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_mom_del2" type="real" default_value="0.0" units="m^2 s^{-1}"
+ description="Horizonal viscosity, $</font>
<font color="gray">u_h$."
+ possible_values="any positive real"
+ />
+ <nml_option name="config_tracer_del2" type="real" default_value="0.0" units="m^2 s^{-1}"
+ description="Horizonal diffusion, $\kappa_h$."
+ possible_values="any positive real"
+ />
+ <nml_option name="config_vorticity_del2_scale" type="real" default_value="1.0" units="unitless"
+ description="{\color{red} TO BE DELETED}"
+ possible_values=""
+ />
+ </nml_record>
+ <nml_record name="hmix_del4">
+ <nml_option name="config_use_mom_del4" type="logical" default_value=".true." units="unitless"
+ description="If true, biharmonic horizontal mixing is used on the momentum equation."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_use_tracer_del4" type="logical" default_value=".false." units="unitless"
+ description="If true, biharmonic horizontal mixing is used on the tracer equation."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_mom_del4" type="real" default_value="5.0e13" units="m^4 s^{-1}"
+ description="Coefficient for horizontal biharmonic operator on momentum."
+ possible_values="any positive real"
+ />
+ <nml_option name="config_tracer_del4" type="real" default_value="0.0" units="m^4 s^{-1}"
+ description="Coefficient for horizontal biharmonic operator on tracers."
+ possible_values="any positive real"
+ />
+ <nml_option name="config_vorticity_del4_scale" type="real" default_value="1.0" units=""
+ description="{\color{red} TO BE DELETED}"
+ possible_values=""
+ />
+ </nml_record>
+ <nml_record name="hmix_Leith">
+ <nml_option name="config_use_Leith_del2" type="logical" default_value=".false." units="unitless"
+ description="If true, the Leith enstrophy-cascade closure is turned on"
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_Leith_parameter" type="real" default_value="1.0" units="non-dimensional"
+ description="Non-dimensional Leith closure parameter"
+ possible_values="any positive real"
+ />
+ <nml_option name="config_Leith_dx" type="real" default_value="15000.0" units="m"
+ description="Characteristic length scale, usually the smallest dx in the mesh"
+ possible_values="any positive real"
+ />
+ <nml_option name="config_Leith_visc2_max" type="real" default_value="2.5e3" units="m^2 s^{-1}"
+ description="Upper bound on the allowable value of Leith-computed viscosity"
+ possible_values="any positive real"
+ />
+ </nml_record>
+ <nml_record name="standard_GM">
+ <nml_option name="config_h_kappa" type="real" default_value="0.0" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_h_kappa_q" type="real" default_value="0.0" units=""
+ description=""
+ possible_values=""
+ />
+ </nml_record>
+ <nml_record name="Rayleigh_damping">
+ <nml_option name="config_Rayleigh_friction" type="logical" default_value=".false." units="unitless"
+ description="If true, Rayleigh friction is included in the momentum equation."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_Rayleigh_damping_coeff" type="real" default_value="0.0" units="s^{-1}"
+ description="Inverse-time coefficient for the Rayleigh damping term, $c_R$."
+ possible_values="Any positive real value."
+ />
+ </nml_record>
+ <nml_record name="vmix">
+ <nml_option name="config_convective_visc" type="real" default_value="1.0" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_convective_diff" type="real" default_value="1.0" units=""
+ description=""
+ possible_values=""
+ />
+ </nml_record>
+ <nml_record name="vmix_const">
+ <nml_option name="config_use_const_visc" type="logical" default_value=".false." units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_use_const_diff" type="logical" default_value=".false." units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_vert_visc" type="real" default_value="2.5e-4" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_vert_diff" type="real" default_value="2.5e-5" units=""
+ description=""
+ possible_values=""
+ />
+ </nml_record>
+ <nml_record name="vmix_rich">
+ <nml_option name="config_use_rich_visc" type="logical" default_value=".true." units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_use_rich_diff" type="logical" default_value=".true." units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_bkrd_vert_visc" type="real" default_value="1.0e-4" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_bkrd_vert_diff" type="real" default_value="1.0e-5" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_rich_mix" type="real" default_value="0.005" units=""
+ description=""
+ possible_values=""
+ />
+ </nml_record>
+ <nml_record name="vmix_tanh">
+ <nml_option name="config_use_tanh_visc" type="logical" default_value=".false." units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_use_tanh_diff" type="logical" default_value=".false." units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_max_visc_tanh" type="real" default_value="2.5e-1" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_min_visc_tanh" type="real" default_value="1.0e-4" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_max_diff_tanh" type="real" default_value="2.5e-2" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_min_diff_tanh" type="real" default_value="1.0e-5" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_zMid_tanh" type="real" default_value="-100" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_zWidth_tanh" type="real" default_value="100" units=""
+ description=""
+ possible_values=""
+ />
+ </nml_record>
+ <nml_record name="forcing">
+ <nml_option name="config_use_monthly_forcing" type="logical" default_value=".false." units="unitless"
+ description="Controls time frequency of forcing. If false, a constant forcing is used, provided by the input fields normalVelocityForcing, temperatureRestore, and salinityRestore. If true, forcing is interpolated between monthly fields given by windStressMonthly, temperatureRestoreMonthly, and salinityRestoreMonthly."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_restoreTS" type="logical" default_value=".false." units="unitless"
+ description="If true, the restoring term is activated in the tracer equation for temperature and salinity."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_restoreT_timescale" type="real" default_value="90.0" units="days"
+ description="Restoring timescale for temperature, $\tau_r.$"
+ possible_values="any positive real value, but typically between 30 and 90 days."
+ />
+ <nml_option name="config_restoreS_timescale" type="real" default_value="90.0" units="days"
+ description="Restoring timescale for salinity, $\tau_r$."
+ possible_values="any positive real value, but typically between 30 and 90 days."
+ />
+ </nml_record>
+ <nml_record name="advection">
+ <nml_option name="config_vert_tracer_adv" type="character" default_value="'stencil'" units="unitless"
+ description="Method for interpolating tracer values from layer centers to layer edges"
+ possible_values="'spline' and 'stencil'"
+ />
+ <nml_option name="config_vert_tracer_adv_order" type="integer" default_value="3" units="unitless"
+ description="Order of polynomial used for tracer reconstruction at layer edges"
+ possible_values="2, 3 and 4"
+ />
+ <nml_option name="config_horiz_tracer_adv_order" type="integer" default_value="3" units="unitless"
+ description="Order of polynomial used for tracer reconstruction at cell edges"
+ possible_values="2, 3 and 4"
+ />
+ <nml_option name="config_coef_3rd_order" type="real" default_value="0.25" units="non-dimensional"
+ description="Reconstruction of 3rd-order reconstruction to blend with 4th-order reconstuction"
+ possible_values="any real between 0 and 1"
+ />
+ <nml_option name="config_monotonic" type="logical" default_value=".true." units="unitless"
+ description="If .true. then fluxes are limited to produce a monotonic advection scheme"
+ possible_values=".true. and .false."
+ />
+ </nml_record>
+ <nml_record name="bottom_drag">
+ <nml_option name="config_bottom_drag_coeff" type="real" default_value="1.0e-3" units="unitless"
+ description="Dimensionless bottom drag coefficient, $c_{drag}$."
+ possible_values="any positive real, typically 1.0e-3"
+ />
+ </nml_record>
+ <nml_record name="pressure_gradient">
+ <nml_option name="config_pressure_gradient_type" type="character" default_value="'pressure_and_zmid'" units="unitless"
+ description="Form of pressure gradient terms in momentum equation. For most applications, the gradient of pressure and layer mid-depth are appropriate. For isopycnal coordinates, one may use the gradient of the Montgomery potential."
+ possible_values="'pressure_and_zmid' or 'MontgomeryPotential'"
+ />
+ <nml_option name="config_density0" type="real" default_value="1014.65" units="kg m^{-3}"
+ description="Density used as a coefficient of the pressure gradient terms, $\rho_0$. This is a constant due to the Boussinesq approximation."
+ possible_values="any positive real, but typically 1000-1035"
+ />
+ </nml_record>
+ <nml_record name="eos">
+ <nml_option name="config_eos_type" type="character" default_value="'jm'" units="unitless"
+ description="Character string to choose EOS formulation"
+ possible_values="Jackett McDougall EOS = 'jm' and Linear EOS = 'linear'"
+ />
+ </nml_record>
+ <nml_record name="eos_linear">
+ <nml_option name="config_eos_linear_alpha" type="real" default_value="2.55e-1" units="kg m^{-3} C^{-1}"
+ description="Linear thermal expansion coefficient"
+ possible_values="any positive real"
+ />
+ <nml_option name="config_eos_linear_beta" type="real" default_value="7.64e-1" units="kg m^{-3} PSU^{-1}"
+ description="Linear haline contraction coefficient"
+ possible_values="any positive real"
+ />
+ <nml_option name="config_eos_linear_Tref" type="real" default_value="19.0" units="C"
+ description="Reference temperature"
+ possible_values="any real"
+ />
+ <nml_option name="config_eos_linear_Sref" type="real" default_value="35.0" units="PSU"
+ description="Reference salinity"
+ possible_values="any real"
+ />
+ <nml_option name="config_eos_linear_densityref" type="real" default_value="1025.022" units="kg m^{-3}"
+ description="Reference density, i.e. density when T=Tref and S=Sref"
+ possible_values="any positive real"
+ />
+ </nml_record>
+ <nml_record name="split_explicit_ts">
+ <nml_option name="config_n_ts_iter" type="integer" default_value="2" units="unitless"
+ description="number of large iterations over stages 1-3"
+ possible_values="any positive integer, but typically 1, 2, or 3"
+ />
+ <nml_option name="config_n_bcl_iter_beg" type="integer" default_value="1" units="unitless"
+ description="number of iterations of stage 1 (baroclinic solve) on the first split-explicit iteration"
+ possible_values="any positive integer, but typically 1, 2, or 3"
+ />
+ <nml_option name="config_n_bcl_iter_mid" type="integer" default_value="2" units="unitless"
+ description="number of iterations of stage 1 (baroclinic solve) on any split-explicit iterations between first and last"
+ possible_values="any positive integer, but typically 1, 2, or 3"
+ />
+ <nml_option name="config_n_bcl_iter_end" type="integer" default_value="2" units="unitless"
+ description="number of iterations of stage 1 (baroclinic solve) on the last split-explicit iteration"
+ possible_values="any positive integer, but typically 1, 2, or 3"
+ />
+ <nml_option name="config_n_btr_subcycles" type="integer" default_value="20" units="unitless"
+ description="number of barotropic subcycles in stage 2"
+ possible_values="any positive integer, typically between 10 and 100"
+ />
+ <nml_option name="config_n_btr_cor_iter" type="integer" default_value="2" units="unitless"
+ description="number of iterations of the velocity corrector step in stage 2"
+ possible_values="any positive integer, but typically 1, 2, or 3"
+ />
+ <nml_option name="config_vel_correction" type="logical" default_value=".true." units="unitless"
+ description="If true, the velocity correction term is included in the horizontal advection of thickness and tracers"
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_btr_subcycle_loop_factor" type="integer" default_value="2" units="unitless"
+ description="Barotropic subcycles proceed from $t$ to $t+n\Delta t$, where $n$ is this configuration option."
+ possible_values="Any positive integer, but typically 1 or 2"
+ />
+ <nml_option name="config_btr_gam1_velWt1" type="real" default_value="0.5" units="unitless"
+ description="Weighting of velocity in the SSH predictor step in stage 2. When zero, previous subcycle time is used; when one, new subcycle time is used."
+ possible_values="between 0 and 1"
+ />
+ <nml_option name="config_btr_gam2_SSHWt1" type="real" default_value="1.0" units="unitless"
+ description="Weighting of SSH in the velocity corrector step in stage 2. When zero, previous subcycle time is used; when one, new subcycle time is used."
+ possible_values="between 0 and 1"
+ />
+ <nml_option name="config_btr_gam3_velWt2" type="real" default_value="1.0" units="unitless"
+ description="Weighting of velocity in the SSH corrector step in stage 2. When zero, previous subcycle time is used; when one, new subcycle time is used."
+ possible_values="between 0 and 1"
+ />
+ <nml_option name="config_btr_solve_SSH2" type="logical" default_value=".false." units="unitless"
+ description="If true, execute the SSH corrector step in stage 2"
+ possible_values=".true. or .false."
+ />
+ </nml_record>
+ <nml_record name="debug">
+ <nml_option name="config_check_zlevel_consistency" type="logical" default_value=".false." units="unitless"
+ description="Enables a run-time check for consistency for a zlevel grid. Ensures relevant variables correctly define the bottom of the ocean."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_filter_btr_mode" type="logical" default_value=".false." units="unitless"
+ description="Enables filtering of the barotropic mode."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_prescribe_velocity" type="logical" default_value=".false." units="unitless"
+ description="Enables a prescribed velocity field. This velocity field is read on input, and remains constant through a simulation."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_prescribe_thickness" type="logical" default_value=".false." units="unitless"
+ description="Enables a prescribed thickness field. This thickness field is read on input, and remains constant through a simulation."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_include_KE_vertex" type="logical" default_value=".false." units="unitless"
+ description=""
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_check_tracer_monotonicity" type="logical" default_value=".false." units="unitless"
+ description="Enables a change on tracer monotonicity at the end of the monotonic advection routine. Only used if config_monotonic is set to .true."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_thick_all_tend" type="logical" default_value=".false." units="unitless"
+ description="Disables all tendencies on the thickness field."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_thick_hadv" type="logical" default_value=".false." units="unitless"
+ description="Disable tendencies on the thickness field from horizontal advection."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_thick_vadv" type="logical" default_value=".false." units="unitless"
+ description="Disables tendencies on the thickness field from vertical advection."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_vel_all_tend" type="logical" default_value=".false." units="unitless"
+ description="Disables all tendencies on the velocity field."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_vel_coriolis" type="logical" default_value=".false." units="unitless"
+ description="Diables tendencies on the velocity field from the Coriolis force."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_vel_pgrad" type="logical" default_value=".false." units="unitless"
+ description="Disables tendencies on the velocity field from the horizontal pressure gradient."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_vel_hmix" type="logical" default_value=".false." units="unitless"
+ description="Disables tendencies on the velocity field from horizontal mixing."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_vel_windstress" type="logical" default_value=".false." units="unitless"
+ description="Disables tendencies on the velocity field from horizontal wind stress."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_vel_vmix" type="logical" default_value=".false." units="unitless"
+ description="Disables tendencies on the velocity field from vertical mixing."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_vel_vadv" type="logical" default_value=".false." units="unitless"
+ description="Disables tendencies on the velocity field from vertical advection."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_tr_all_tend" type="logical" default_value=".false." units="unitless"
+ description="Disables all tendencies on tracer fields."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_tr_adv" type="logical" default_value=".false." units="unitless"
+ description="Disables tendencies on tracer fields from advection, both horizontal and vertical."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_tr_hmix" type="logical" default_value=".false." units="unitless"
+ description="Disables tendencies on tracer fields from horizontal mixing."
+ possible_values=".true. or .false."
+ />
+ <nml_option name="config_disable_tr_vmix" type="logical" default_value=".false." units="unitless"
+ description="Disables tendencies on tracer fields from vertical mixing."
+ possible_values=".true. or .false."
+ />
+ </nml_record>
+ <var_struct name="state" time_levs="2">
+ <var_array name="tracers" type="real" dimensions="nVertLevels nCells Time">
+ <var name="temperature" array_group="dynamics" streams="iro" units="degrees Celsius"
+ description="potential temperature"
+ />
+ <var name="salinity" array_group="dynamics" streams="iro" units="grams salt per kilogram seawater"
+ description="salinity"
+ />
+ <var name="tracer1" array_group="testing" streams="iro" units="unitless"
+ description="A tracer with value 1.0 to test conservation. {\color{red} REMOVE THIS VARIABLE}"
+ />
+ </var_array>
+ <var name="xtime" type="text" dimensions="Time" streams="ro" units="unitless"
+ description="model time, with format 'YYYY-MM-DD_HH:MM:SS'"
+ />
+ <var name="normalVelocity" type="real" dimensions="nVertLevels nEdges Time" streams="ir" units="m s^{-1}"
+ description="horizonal velocity, normal component to an edge"
+ />
+ <var name="layerThickness" type="real" dimensions="nVertLevels nCells Time" streams="iro" units="m"
+ description="layer thickness"
+ />
+ <var name="density" type="real" dimensions="nVertLevels nCells Time" streams="iro" units="kg m^{-3}"
+ description="density"
+ />
+ <var name="normalBarotropicVelocity" type="real" dimensions="nEdges Time" streams="r" units="m s^{-1}"
+ description="barotropic velocity, used in split-explicit time-stepping"
+ />
+ <var name="ssh" type="real" dimensions="nCells Time" streams="o" units="m"
+ description="sea surface height"
+ />
+ <var name="normalBarotropicVelocitySubcycle" type="real" dimensions="nEdges Time" units="m s^{-1}"
+ description="barotropic velocity, used in subcycling in stage 2 of split-explicit time-stepping"
+ />
+ <var name="sshSubcycle" type="real" dimensions="nCells Time" units="m"
+ description="sea surface height, used in subcycling in stage 2 of split-explicit time-stepping"
+ />
+ <var name="barotropicThicknessFlux" type="real" dimensions="nEdges Time" units="m^2 s^{-1}"
+ description="Barotropic thickness flux at each edge, used to advance sea surface height in each subcycle of stage 2 of the split-explicit algorithm."
+ />
+ <var name="barotropicForcing" type="real" dimensions="nEdges Time" units="m s^{-2}"
+ description="Barotropic tendency computed from the baroclinic equations in stage 1 of the split-explicit algorithm."
+ />
+ <var name="normalBaroclinicVelocity" type="real" dimensions="nVertLevels nEdges Time" units="m s^{-1}"
+ description="baroclinic velocity, used in split-explicit time-stepping"
+ />
+ <var name="zMid" type="real" dimensions="nVertLevels nCells Time" units="m"
+ description="z-coordinate of the mid-depth of the layer"
+ />
+ <var name="tangentialVelocity" type="real" dimensions="nVertLevels nEdges Time" units="m s^{-1}"
+ description="horizontal velocity, tangential to an edge"
+ />
+ <var name="uTransport" type="real" dimensions="nVertLevels nEdges Time" units="m s^{-1}"
+ description="horizontal velocity used to transport mass and tracers"
+ />
+ <var name="uBolusGM" type="real" dimensions="nVertLevels nEdges Time" units=""
+ description=""
+ />
+ <var name="uBolusGMX" type="real" dimensions="nVertLevels nEdges Time" units=""
+ description=""
+ />
+ <var name="uBolusGMY" type="real" dimensions="nVertLevels nEdges Time" units=""
+ description=""
+ />
+ <var name="uBolusGMZ" type="real" dimensions="nVertLevels nEdges Time" units=""
+ description=""
+ />
+ <var name="uBolusGMZonal" type="real" dimensions="nVertLevels nEdges Time" streams="o" units=""
+ description=""
+ />
+ <var name="uBolusGMMeridional" type="real" dimensions="nVertLevels nEdges Time" streams="o" units=""
+ description=""
+ />
+ <var name="hEddyFlux" type="real" dimensions="nVertLevels nEdges Time" units=""
+ description=""
+ />
+ <var name="h_kappa" type="real" dimensions="nVertLevels nEdges Time" units=""
+ description=""
+ />
+ <var name="h_kappa_q" type="real" dimensions="nVertLevels nEdges Time" units=""
+ description=""
+ />
+ <var name="divergence" type="real" dimensions="nVertLevels nCells Time" streams="o" units="s^{-1}"
+ description="divergence of horizonal velocity"
+ />
+ <var name="relativeVorticity" type="real" dimensions="nVertLevels nVertices Time" streams="o" units="s^{-1}"
+ description="curl of horizontal velocity"
+ />
+ <var name="potentialVorticityEdge" type="real" dimensions="nVertLevels nEdges Time" units="s^{-1}"
+ description="vorticity averaged from vertices to edges"
+ />
+ <var name="potentialVorticityVertex" type="real" dimensions="nVertLevels nVertices Time" units="s^{-1}"
+ description="curl of horizontal velocity defined at vertices"
+ />
+ <var name="potentialVorticityCell" type="real" dimensions="nVertLevels nCells Time" streams="o" units="s^{-1}"
+ description="curl of horizontal velocity defined at cell centers"
+ />
+ <var name="layerThicknessEdge" type="real" dimensions="nVertLevels nEdges Time" units="m"
+ description="layer thickness averaged from cell center to edges"
+ />
+ <var name="layerThicknessVertex" type="real" dimensions="nVertLevels nVertices Time" units="m"
+ description="layer thickness averaged from cell center to vertices"
+ />
+ <var name="kineticEnergy" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m^2 s^{-2}"
+ description="kinetic energy of horizonal velocity"
+ />
+ <var name="kineticEnergyVertex" type="real" dimensions="nVertLevels nVertices Time" streams="o" units="m^2 s^{-2}"
+ description="kinetic energy of horizonal velocity defined at vertices"
+ />
+ <var name="kineticEnergyVertexOnCells" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m^2 s^{-2}"
+ description="kinetic energy of horizonal velocity defined at vertices"
+ />
+ <var name="kineticEnergyEdge" type="real" dimensions="nVertLevels nEdges Time" units="m^2 s^{-2}"
+ description="kinetic energy of horizonal velocity defined at edges"
+ />
+ <var name="normalVelocityX" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+ description="component of horizontal velocity in the x-direction (cartesian)"
+ />
+ <var name="normalVelocityY" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+ description="component of horizontal velocity in the y-direction (cartesian)"
+ />
+ <var name="normalVelocityZ" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+ description="component of horizontal velocity in the z-direction (cartesian)"
+ />
+ <var name="normalVelocityZonal" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="component of horizontal velocity in the eastward direction"
+ />
+ <var name="normalVelocityMeridional" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="component of horizontal velocity in the northward"
+ />
+ <var name="normalVelocityForcingReconstructX" type="real" dimensions="nVertLevels nCells Time" units="N m^{-2}"
+ description="wind stress in the x-direction (cartesian)"
+ />
+ <var name="normalVelocityForcingReconstructY" type="real" dimensions="nVertLevels nCells Time" units="N m^{-2}"
+ description="wind stress in the y-direction (cartesian)"
+ />
+ <var name="normalVelocityForcingReconstructZ" type="real" dimensions="nVertLevels nCells Time" units="N m^{-2}"
+ description="wind stress in the z-direction (cartesian)"
+ />
+ <var name="normalVelocityForcingReconstructZonal" type="real" dimensions="nVertLevels nCells Time" streams="o" units="N m^{-2}"
+ description="wind stress in the eastward direction"
+ />
+ <var name="normalVelocityForcingReconstructMeridional" type="real" dimensions="nVertLevels nCells Time" streams="o" units="N m^{-2}"
+ description="wind stress in the northward direction"
+ />
+ <var name="montgomeryPotential" type="real" dimensions="nVertLevels nCells Time" units="m^2 s^{-2}"
+ description="Montgomery potential, may be used as the pressure for isopycnal coordinates."
+ />
+ <var name="pressure" type="real" dimensions="nVertLevels nCells Time" units="N m^{-2}"
+ description="pressure used in the momentum equation"
+ />
+ <var name="vertTransportVelocityTop" type="real" dimensions="nVertLevelsP1 nCells Time" units="m s^{-1}"
+ description="vertical transport through the layer interface at the top of the cell"
+ />
+ <var name="vertVelocityTop" type="real" dimensions="nVertLevelsP1 nCells Time" units="m s^{-1}"
+ description="vertical velocity defined at center (horizonally) and top (vertically) of cell"
+ />
+ <var name="displacedDensity" type="real" dimensions="nVertLevels nCells Time" units="kg m^{-3}"
+ description="potential density displaced to the mid-depth of top layer"
+ />
+ <var name="BruntVaisalaFreqTop" type="real" dimensions="nVertLevels nCells Time" streams="o" units="s^{-2}"
+ description="Brunt Vaisala frequency defined at the center (horizontally) and top (vertically) of cell"
+ />
+ <var name="viscosity" type="real" dimensions="nVertLevels nEdges Time" streams="o" units="m^2 s^{-1}"
+ description="horizontal viscosity"
+ />
+ <var name="vh" type="real" dimensions="nVertLevels nEdges Time" units="m^2 s^{-1}"
+ description="thickness flux in the tangent direction (from vertex1 to vertex2)"
+ />
+ <var name="circulation" type="real" dimensions="nVertLevels nVertices Time" units="m^2 s^{-1}"
+ description="area-integrated vorticity"
+ />
+ <var name="gradVor_t" type="real" dimensions="nVertLevels nEdges Time" units="s^{-1} m^{-1}"
+ description="gradient of vorticity in the tangent direction (from vertex1 to vertex2)"
+ />
+ <var name="gradVor_n" type="real" dimensions="nVertLevels nEdges Time" units="s^{-1} m^{-1}"
+ description="gradient of vorticity in the normal direction (from cell1 to cell2)"
+ />
+ <var name="areaCellGlobal" type="real" dimensions="Time" streams="o" units="m^2"
+ description="sum of the areaCell variable over the full domain, used to normalize global statistics"
+ />
+ <var name="areaEdgeGlobal" type="real" dimensions="Time" streams="o" units="m^2"
+ description="sum of the areaEdge variable over the full domain, used to normalize global statistics"
+ />
+ <var name="areaTriangleGlobal" type="real" dimensions="Time" streams="o" units="m^2"
+ description="sum of the areaTriangle variable over the full domain, used to normalize global statistics"
+ />
+ <var name="volumeCellGlobal" type="real" dimensions="Time" streams="o" units="m^3"
+ description="sum of the volumeCell variable over the full domain, used to normalize global statistics"
+ />
+ <var name="volumeEdgeGlobal" type="real" dimensions="Time" streams="o" units="m^3"
+ description="sum of the volumeEdge variable over the full domain, used to normalize global statistics"
+ />
+ <var name="CFLNumberGlobal" type="real" dimensions="Time" streams="o" units="unitless"
+ description="maximum CFL number over the full domain"
+ />
+ <var name="nAverage" type="real" dimensions="Time" streams="o" units="unitless"
+ description="number of timesteps in time-averaged variables"
+ />
+ <var name="avgSsh" type="real" dimensions="nCells Time" streams="o" units="m"
+ description="time-averaged sea surface height"
+ />
+ <var name="varSsh" type="real" dimensions="nCells Time" streams="o" units="m"
+ description="variance of sea surface height"
+ />
+ <var name="avgNormalVelocityZonal" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="time-averaged velocity in the eastward direction"
+ />
+ <var name="avgNormalVelocityMeridional" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="time-averaged velocity in the northward direction"
+ />
+ <var name="varNormalVelocityZonal" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="variance of velocity in the eastward direction"
+ />
+ <var name="varNormalVelocityMeridional" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="variance of velocity in the northward direction"
+ />
+ <var name="avgNormalVelocity" type="real" dimensions="nVertLevels nEdges Time" streams="o" units="m s^{-1}"
+ description="time-averaged velocity, normal to cell edge"
+ />
+ <var name="varNormalVelocity" type="real" dimensions="nVertLevels nEdges Time" streams="o" units="m s^{-1}"
+ description="variance of velocity, normal to cell edge"
+ />
+ <var name="avgVertVelocityTop" type="real" dimensions="nVertLevelsP1 nCells Time" streams="o" units="m s^{-1}"
+ description="time-averaged vertical velocity at top of cell"
+ />
+ </var_struct>
+ <var_struct name="mesh" time_levs="0">
+ <var name="latCell" type="real" dimensions="nCells" streams="iro" units="radians"
+ description="Latitude location of cell centers in radians."
+ />
+ <var name="lonCell" type="real" dimensions="nCells" streams="iro" units="radians"
+ description="Longitude location of cell centers in radians."
+ />
+ <var name="xCell" type="real" dimensions="nCells" streams="iro" units="unitless"
+ description="X Coordinate in cartesian space of cell centers."
+ />
+ <var name="yCell" type="real" dimensions="nCells" streams="iro" units="unitless"
+ description="Y Coordinate in cartesian space of cell centers."
+ />
+ <var name="zCell" type="real" dimensions="nCells" streams="iro" units="unitless"
+ description="Z Coordinate in cartesian space of cell centers."
+ />
+ <var name="indexToCellID" type="integer" dimensions="nCells" streams="iro" units="unitless"
+ description="List of global cell IDs."
+ />
+ <var name="latEdge" type="real" dimensions="nEdges" streams="iro" units="radians"
+ description="Latitude location of edge midpoints in radians."
+ />
+ <var name="lonEdge" type="real" dimensions="nEdges" streams="iro" units="radians"
+ description="Longitude location of edge midpoints in radians."
+ />
+ <var name="xEdge" type="real" dimensions="nEdges" streams="iro" units="unitless"
+ description="X Coordinate in cartesian space of edge midpoints."
+ />
+ <var name="yEdge" type="real" dimensions="nEdges" streams="iro" units="unitless"
+ description="Y Coordinate in cartesian space of edge midpoints."
+ />
+ <var name="zEdge" type="real" dimensions="nEdges" streams="iro" units="unitless"
+ description="Z Coordinate in cartesian space of edge midpoints."
+ />
+ <var name="indexToEdgeID" type="integer" dimensions="nEdges" streams="iro" units="unitless"
+ description="List of global edge IDs."
+ />
+ <var name="latVertex" type="real" dimensions="nVertices" streams="iro" units="radians"
+ description="Latitude location of vertices in radians."
+ />
+ <var name="lonVertex" type="real" dimensions="nVertices" streams="iro" units="radians"
+ description="Longitude location of vertices in radians."
+ />
+ <var name="xVertex" type="real" dimensions="nVertices" streams="iro" units="unitless"
+ description="X Coordinate in cartesian space of vertices."
+ />
+ <var name="yVertex" type="real" dimensions="nVertices" streams="iro" units="unitless"
+ description="Y Coordinate in cartesian space of vertices."
+ />
+ <var name="zVertex" type="real" dimensions="nVertices" streams="iro" units="unitless"
+ description="Z Coordinate in cartesian space of vertices."
+ />
+ <var name="indexToVertexID" type="integer" dimensions="nVertices" streams="iro" units="unitless"
+ description="List of global vertex IDs."
+ />
+ <var name="meshDensity" type="real" dimensions="nCells" streams="iro" units="unitless"
+ description="Value of density function used to generate a particular mesh at cell centers."
+ />
+ <var name="meshScalingDel2" type="real" dimensions="nEdges" streams="ro" units="unitless"
+ description="Coefficient to Laplacian mixing terms in momentum and tracer equations, so that viscosity and diffusion scale with mesh."
+ />
+ <var name="meshScalingDel4" type="real" dimensions="nEdges" streams="ro" units="unitless"
+ description="Coefficient to biharmonic mixing terms in momentum and tracer equations, so that biharmonic viscosity and diffusion coefficients scale with mesh."
+ />
+ <var name="meshScaling" type="real" dimensions="nEdges" streams="ro" units="unitless"
+ description="Coefficient used for mesh scaling, such as the Leith parameter."
+ />
+ <var name="cellsOnEdge" type="integer" dimensions="TWO nEdges" streams="iro" units="unitless"
+ description="List of cells that straddle each edge."
+ />
+ <var name="nEdgesOnCell" type="integer" dimensions="nCells" streams="iro" units="unitless"
+ description="Number of edges that border each cell."
+ />
+ <var name="nEdgesOnEdge" type="integer" dimensions="nEdges" streams="iro" units="unitless"
+ description="Number of edges that surround each of the cells that straddle each edge. These edges are used to reconstruct the tangential velocities."
+ />
+ <var name="edgesOnCell" type="integer" dimensions="maxEdges nCells" streams="iro" units="unitless"
+ description="List of edges that border each cell."
+ />
+ <var name="edgesOnEdge" type="integer" dimensions="maxEdges2 nEdges" streams="iro" units="unitless"
+ description="List of edges that border each of the cells that straddle each edge."
+ />
+ <var name="weightsOnEdge" type="real" dimensions="maxEdges2 nEdges" streams="iro" units="unitless"
+ description="Reconstruction weights associated with each of the edgesOnEdge."
+ />
+ <var name="dvEdge" type="real" dimensions="nEdges" streams="iro" units="m"
+ description="Length of each edge, computed as the distance between verticesOnEdge."
+ />
+ <var name="dcEdge" type="real" dimensions="nEdges" streams="iro" units="m"
+ description="Length of each edge, computed as the distance between cellsOnEdge."
+ />
+ <var name="angleEdge" type="real" dimensions="nEdges" streams="iro" units="radians"
+ description="Angle the edge normal makes with local eastward direction."
+ />
+ <var name="areaCell" type="real" dimensions="nCells" streams="iro" units="m^2"
+ description="Area of each cell in the primary grid."
+ />
+ <var name="areaTriangle" type="real" dimensions="nVertices" streams="iro" units="m^2"
+ description="Area of each cell (triangle) in the dual grid."
+ />
+ <var name="edgeNormalVectors" type="real" dimensions="R3 nEdges" streams="o" units="unitless"
+ description="Normal vector defined at an edge."
+ />
+ <var name="localVerticalUnitVectors" type="real" dimensions="R3 nCells" streams="o" units="unitless"
+ description="Unit surface normal vectors defined at cell centers."
+ />
+ <var name="cellTangentPlane" type="real" dimensions="R3 TWO nCells" streams="o" units="unitless"
+ description="The two vectors that define a tangent plane at a cell center."
+ />
+ <var name="cellsOnCell" type="integer" dimensions="maxEdges nCells" streams="iro" units="unitless"
+ description="List of cells that neighbor each cell."
+ />
+ <var name="verticesOnCell" type="integer" dimensions="maxEdges nCells" streams="iro" units="unitless"
+ description="List of vertices that border each cell."
+ />
+ <var name="verticesOnEdge" type="integer" dimensions="TWO nEdges" streams="iro" units="unitless"
+ description="List of vertices that straddle each edge."
+ />
+ <var name="edgesOnVertex" type="integer" dimensions="vertexDegree nVertices" streams="iro" units="unitless"
+ description="List of edges that share a vertex as an endpoint."
+ />
+ <var name="cellsOnVertex" type="integer" dimensions="vertexDegree nVertices" streams="iro" units="unitless"
+ description="List of cells that share a vertex."
+ />
+ <var name="kiteAreasOnVertex" type="real" dimensions="vertexDegree nVertices" streams="iro" units="m^2"
+ description="Area of the portions of each dual cell that are part of each cellsOnVertex."
+ />
+ <var name="fEdge" type="real" dimensions="nEdges" streams="iro" units="s^{-1}"
+ description="Coriolis parameter at edges."
+ />
+ <var name="fVertex" type="real" dimensions="nVertices" streams="iro" units="s^{-1}"
+ description="Coriolis parameter at vertices."
+ />
+ <var name="bottomDepth" type="real" dimensions="nCells" streams="iro" units="m"
+ description="Depth of the bottom of the ocean. Given as a positive distance from sea level."
+ />
+ <var name="deriv_two" type="real" dimensions="maxEdges2 TWO nEdges" units="m^{-2}"
+ description="Value of the second derivative of the polynomial used for reconstruction of cell center quantities at edges."
+ />
+ <var name="adv_coefs" type="real" dimensions="nAdvectionCells nEdges" units="m"
+ description="Weighting coefficients used for reconstruction of cell center quantities at edges. Used in advection routines."
+ />
+ <var name="adv_coefs_2nd" type="real" dimensions="nAdvectionCells nEdges" units="m"
+ description="Weighting coefficients used for reconstruction of cell center quantities at edges. Used in advection routines."
+ />
+ <var name="adv_coefs_3rd" type="real" dimensions="nAdvectionCells nEdges" units="m"
+ description="Wegihting coefficients used for reconstruction of cell center quantities at edges. Used in advection routines."
+ />
+ <var name="advCellsForEdge" type="integer" dimensions="nAdvectionCells nEdges" units="unitless"
+ description="List of cells used to reconstruct a cell quantity at an edge. Used in advection routines."
+ />
+ <var name="nAdvCellsForEdge" type="integer" dimensions="nEdges" units="unitless"
+ description="Number of cells used in reconstruction of cell center quantities at an edge. Used in advection routines."
+ />
+ <var name="highOrderAdvectionMask" type="integer" dimensions="nVertLevels nEdges" units="unitless"
+ description="Mask for high order advection. Values are 1 if high order is used, and 0 if not."
+ />
+ <var name="lowOrderAdvectionMask" type="integer" dimensions="nVertLevels nEdges" units="unitless"
+ description="Mask for low order advection. Values are 1 if low order is used, and 0 if not."
+ />
+ <var name="defc_a" type="real" dimensions="maxEdges nCells" units="m^{-1}"
+ description="Variable used with advection setup to compute advection coefficients. Deformation weight coefficients."
+ />
+ <var name="defc_b" type="real" dimensions="maxEdges nCells" units="m^{-1}"
+ description="Variable used with advection setup to compute advection coefficients. Deformation weight coefficients."
+ />
+ <var name="kdiff" type="real" dimensions="nVertLevels nCells Time" units=""
+ description="{\color{red} TO BE REMOVED}"
+ />
+ <var name="coeffs_reconstruct" type="real" dimensions="R3 maxEdges nCells" units="unitless"
+ description="Coefficients to reconstruct velocity vectors at cells centers."
+ />
+ <var name="maxLevelCell" type="integer" dimensions="nCells" streams="iro" units="unitless"
+ description="Index to the last active ocean cell in each column."
+ />
+ <var name="maxLevelEdgeTop" type="integer" dimensions="nEdges" units="unitless"
+ description="Index to the last edge in a column with active ocean cells on both sides of it."
+ />
+ <var name="maxLevelEdgeBot" type="integer" dimensions="nEdges" units="unitless"
+ description="Index to the last edge in a column with at least one active ocean cell on either side of it."
+ />
+ <var name="maxLevelVertexTop" type="integer" dimensions="nVertices" units="unitless"
+ description="Index to the last vertex in a column with all active cells around it."
+ />
+ <var name="maxLevelVertexBot" type="integer" dimensions="nVertices" units="unitless"
+ description="Index to the last vertex in a column with at least one active ocean cell around it."
+ />
+ <var name="refBottomDepth" type="real" dimensions="nVertLevels" streams="iro" units="m"
+ description="Reference depth of ocean for each vertical level. Used in 'z-level' type runs."
+ />
+ <var name="refBottomDepthTopOfCell" type="real" dimensions="nVertLevelsP1" units="m"
+ description="Reference depth of ocean for each vertical interface. Used in 'z-level' type runs."
+ />
+ <var name="hZLevel" type="real" dimensions="nVertLevels" streams="iro" units="m"
+ description="{\color{red} TO BE REMOVED}"
+ />
+ <var name="vertCoordMovementWeights" type="real" dimensions="nVertLevels" streams="iro" units="unitless"
+ description="Weights used for distribution of sea surface heigh purturbations through multiple vertical levels."
+ />
+ <var name="boundaryEdge" type="integer" dimensions="nVertLevels nEdges" units="unitless"
+ description="Mask for determining boundary edges. A boundary edge has only one active ocean cell neighboring it."
+ />
+ <var name="boundaryVertex" type="integer" dimensions="nVertLevels nVertices" units="unitless"
+ description="Mask for determining boundary vertices. A boundary vertex has at least one inactive cell neighboring it."
+ />
+ <var name="boundaryCell" type="integer" dimensions="nVertLevels nCells" units="unitless"
+ description="Mask for determining boundary cells. A boundary cell has at least one inactive cell neighboring it."
+ />
+ <var name="edgeMask" type="integer" dimensions="nVertLevels nEdges" streams="o" units="unitless"
+ description="Mask on edges that determines if computations should be done on edge."
+ />
+ <var name="vertexMask" type="integer" dimensions="nVertLevels nVertices" streams="o" units="unitless"
+ description="Mask on vertices that determines if computations should be done on vertice."
+ />
+ <var name="cellMask" type="integer" dimensions="nVertLevels nCells" streams="o" units="unitless"
+ description="Mask on cells that determines if computations should be done on cell."
+ />
+ <var name="normalVelocityForcing" type="real" dimensions="nVertLevels nEdges" streams="ir" units="N m^{-2}"
+ description="Velocity forcing field. Defines a forcing at an edge."
+ />
+ <var name="temperatureRestore" type="real" dimensions="nCells" streams="ir" units="^\circ C"
+ description="Temperature restoring field, for restoring temperature at the surface."
+ />
+ <var name="salinityRestore" type="real" dimensions="nCells" streams="ir" units="PSU"
+ description="Salinity restoring field, for restoring salinity at the surface."
+ />
+ <var name="windStressMonthly" type="real" dimensions="nMonths nEdges" streams="ir" units="N m^{-2}"
+ description="Monthly wind stress field, defined at the surface for use in monthly forcing."
+ />
+ <var name="temperatureRestoreMonthly" type="real" dimensions="nMonths nCells" streams="ir" units="^\circ C"
+ description="Monthly temperature restorying field, defined at the surface for use in monthly forcing."
+ />
+ <var name="salinityRestoreMonthly" type="real" dimensions="nMonths nCells" streams="ir" units="PSU"
+ description="Monthly salinity resotring field, defined at the surface, for use in monthly forcing."
+ />
+ <var name="edgeSignOnCell" type="integer" dimensions="maxEdges nCells" units="unitless"
+ description="Sign of edge contributions to a cell for each edge on cell. Used for bit-reproducible loops. Represents directionality of vector connecting cells."
+ />
+ <var name="edgeSignOnVertex" type="integer" dimensions="maxEdges nVertices" units="unitless"
+ description="Sign of edge contributions to a vertex for each edge on vertex. Used for bit-reproducible loops. Represents directionality of vector connecting vertices."
+ />
+ <var name="kiteIndexOnCell" type="integer" dimensions="maxEdges nCells" units="unitless"
+ description="Index of kite in dual grid, based on verticesOnCell."
+ />
+ <var name="seaSurfacePressure" type="real" dimensions="nCells Time" streams="ir" units="Pa"
+ description="Pressure defined at the sea surface."
+ />
+ </var_struct>
+ <var_struct name="tend" time_levs="1">
+ <var_array name="tracers" type="real" dimensions="nVertLevels nCells Time">
+ <var name="tend_temperature" array_group="dynamics" units="K s^{-1}" name_in_code="temperature"
+ description="time tendency of potential temperature"
+ />
+ <var name="tend_salinity" array_group="dynamics" units="PSU s^{-1}" name_in_code="salinity"
+ description="time tendency of salinity measured as change in practical salinity units per second"
+ />
+ <var name="tend_tracer1" array_group="testing" units="tracer s^{-1}" name_in_code="tracer1"
+ description="time tendency of an arbitary tracer"
+ />
+ </var_array>
+ <var name="tend_normalVelocity" type="real" dimensions="nVertLevels nEdges Time" units="m s^{-2}" name_in_code="normalVelocity"
+ description="time tendency of normal component of velocity"
+ />
+ <var name="tend_layerThickness" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}" name_in_code="layerThickness"
+ description="time tendency of layer thickness"
+ />
+ <var name="tend_ssh" type="real" dimensions="nCells Time" units="m s^{-1}" name_in_code="ssh"
+ description="time tendency of sea-surface height"
+ />
+ </var_struct>
+ <var_struct name="diagnostics" time_levs="1">
+ <var name="RiTopOfCell" type="real" dimensions="nVertLevelsP1 nCells Time" units="nondimensional"
+ description="gradient Richardson number defined at the center (horizontally) and top (vertically)"
+ />
+ <var name="RiTopOfEdge" type="real" dimensions="nVertLevelsP1 nEdges Time" units="nondimensional"
+ description="gradient Richardson number defined at the edge (horizontally) and top (vertically)"
+ />
+ <var name="vertViscTopOfEdge" type="real" dimensions="nVertLevelsP1 nEdges Time" units="m^2 s^{-1}"
+ description="vertical viscosity defined at the edge (horizontally) and top (vertically)"
+ />
+ <var name="vertDiffTopOfCell" type="real" dimensions="nVertLevelsP1 nCells Time" units="m^2 s^{-1}"
+ description="vertical diffusion defined at the edge (horizontally) and top (vertically)"
+ />
+ </var_struct>
+</registry>
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_diagnostics.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_diagnostics.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_diagnostics.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -8,7 +8,7 @@
!> \version SVN:$Id:$
!> \details
!> This module contains the routines for computing
-!> diagnostic variables, and other quantities such as wTop.
+!> diagnostic variables, and other quantities such as vertTransportVelocityTop.
!
!-----------------------------------------------------------------------
@@ -41,10 +41,10 @@
!--------------------------------------------------------------------
public :: ocn_diagnostic_solve, &
- ocn_wtop, &
+ ocn_vert_transport_velocity_top, &
ocn_fuperp, &
- ocn_filter_btr_mode_u, &
- ocn_filter_btr_mode_tend_u, &
+ ocn_filter_btr_mode_vel, &
+ ocn_filter_btr_mode_tend_vel, &
ocn_diagnostics_init
!--------------------------------------------------------------------
@@ -92,42 +92,42 @@
verticesOnCell, edgeSignOnVertex, edgeSignOnCell, edgesOnCell
real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2, coef_3rd_order, r_tmp, &
- invAreaCell1, invAreaCell2, invAreaTri1, invAreaTri2, invLength, h_vertex, coef
+ invAreaCell1, invAreaCell2, invAreaTri1, invAreaTri2, invLength, layerThicknessVertex, coef
real (kind=RKIND), dimension(:), allocatable:: pTop, div_hu
real (kind=RKIND), dimension(:), pointer :: &
bottomDepth, fVertex, dvEdge, dcEdge, areaCell, areaTriangle, ssh, seaSurfacePressure
real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure,&
- circulation, vorticity, ke, ke_edge, MontPot, wTop, zMid, &
- Vor_edge, Vor_vertex, Vor_cell, gradVor_n, gradVor_t, divergence, &
- rho, rhoDisplaced, temperature, salinity, kev, kevc, uBolusGM, uTransport, &
+ weightsOnEdge, kiteAreasOnVertex, layerThicknessEdge, layerThickness, normalVelocity, tangentialVelocity, pressure,&
+ circulation, relativeVorticity, kineticEnergy, kineticEnergyEdge, montgomeryPotential, vertTransportVelocityTop, zMid, &
+ potentialVorticityEdge, potentialVorticityVertex, potentialVorticityCell, gradVor_n, gradVor_t, divergence, &
+ density, displacedDensity, temperature, salinity, kineticEnergyVertex, kineticEnergyVertexOnCells, uBolusGM, uTransport, &
vertVelocityTop, BruntVaisalaFreqTop
real (kind=RKIND), dimension(:,:,:), pointer :: tracers, deriv_two
character :: c1*6
- h => s % h % array
- u => s % u % array
+ layerThickness => s % layerThickness % array
+ normalVelocity => s % normalVelocity % array
uTransport => s % uTransport % array
uBolusGM => s % uBolusGM % array
- v => s % v % array
- h_edge => s % h_edge % array
+ tangentialVelocity => s % tangentialVelocity % array
+ layerThicknessEdge => s % layerThicknessEdge % array
circulation => s % circulation % array
- vorticity => s % vorticity % array
+ relativeVorticity => s % relativeVorticity % array
divergence => s % divergence % array
- ke => s % ke % array
- kev => s % kev % array
- kevc => s % kevc % array
- ke_edge => s % ke_edge % array
- Vor_edge => s % Vor_edge % array
- Vor_vertex => s % Vor_vertex % array
- Vor_cell => s % Vor_cell % array
+ kineticEnergy => s % kineticEnergy % array
+ kineticEnergyVertex => s % kineticEnergyVertex % array
+ kineticEnergyVertexOnCells => s % kineticEnergyVertexOnCells % array
+ kineticEnergyEdge => s % kineticEnergyEdge % array
+ potentialVorticityEdge => s % potentialVorticityEdge % array
+ potentialVorticityVertex => s % potentialVorticityVertex % array
+ potentialVorticityCell => s % potentialVorticityCell % array
gradVor_n => s % gradVor_n % array
gradVor_t => s % gradVor_t % array
- rho => s % rho % array
- rhoDisplaced=> s % rhoDisplaced % array
- MontPot => s % MontPot % array
+ density => s % density % array
+ displacedDensity=> s % displacedDensity % array
+ montgomeryPotential => s % montgomeryPotential % array
pressure => s % pressure % array
zMid => s % zMid % array
ssh => s % ssh % array
@@ -174,20 +174,18 @@
!
! Compute height on cell edges at velocity locations
- ! Namelist options control the order of accuracy of the reconstructed h_edge value
+ ! Namelist options control the order of accuracy of the reconstructed layerThicknessEdge value
!
- ! mrp 101115 note: in order to include flux boundary conditions, we will need to
- ! assign h_edge for maxLevelEdgeTop:maxLevelEdgeBot in the following section
- ! initialize h_edge to avoid divide by zero and NaN problems.
- h_edge = -1.0e34
+ ! initialize layerThicknessEdge to avoid divide by zero and NaN problems.
+ layerThicknessEdge = -1.0e34
coef_3rd_order = config_coef_3rd_order
do iEdge=1,nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k=1,maxLevelEdgeTop(iEdge)
- h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
+ layerThicknessEdge(k,iEdge) = 0.5 * (layerThickness(k,cell1) + layerThickness(k,cell2))
end do
end do
@@ -195,26 +193,26 @@
! set the velocity and height at dummy address
! used -1e34 so error clearly occurs if these values are used.
!
- u(:,nEdges+1) = -1e34
- h(:,nCells+1) = -1e34
+ normalVelocity(:,nEdges+1) = -1e34
+ layerThickness(:,nCells+1) = -1e34
tracers(s % index_temperature,:,nCells+1) = -1e34
tracers(s % index_salinity,:,nCells+1) = -1e34
circulation(:,:) = 0.0
- vorticity(:,:) = 0.0
+ relativeVorticity(:,:) = 0.0
divergence(:,:) = 0.0
vertVelocityTop(:,:)=0.0
- ke(:,:) = 0.0
- v(:,:) = 0.0
+ kineticEnergy(:,:) = 0.0
+ tangentialVelocity(:,:) = 0.0
do iVertex = 1, nVertices
invAreaTri1 = 1.0 / areaTriangle(iVertex)
do i = 1, vertexDegree
iEdge = edgesOnVertex(i, iVertex)
do k = 1, maxLevelVertexBot(iVertex)
- r_tmp = dcEdge(iEdge) * u(k, iEdge)
+ r_tmp = dcEdge(iEdge) * normalVelocity(k, iEdge)
circulation(k, iVertex) = circulation(k, iVertex) + edgeSignOnVertex(i, iVertex) * r_tmp
- vorticity(k, iVertex) = vorticity(k, iVertex) + edgeSignOnVertex(i, iVertex) * r_tmp * invAreaTri1
+ relativeVorticity(k, iVertex) = relativeVorticity(k, iVertex) + edgeSignOnVertex(i, iVertex) * r_tmp * invAreaTri1
end do
end do
end do
@@ -226,11 +224,11 @@
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
do k = 1, maxLevelCell(iCell)
- r_tmp = dvEdge(iEdge) * u(k, iEdge) * invAreaCell1
+ r_tmp = dvEdge(iEdge) * normalVelocity(k, iEdge) * invAreaCell1
divergence(k, iCell) = divergence(k, iCell) - edgeSignOnCell(i, iCell) * r_tmp
- div_hu(k) = div_hu(k) - h_edge(k, iEdge) * edgeSignOnCell(i, iCell) * r_tmp
- ke(k, iCell) = ke(k, iCell) + 0.25 * r_tmp * dcEdge(iEdge) * u(k,iEdge)
+ div_hu(k) = div_hu(k) - layerThicknessEdge(k, iEdge) * edgeSignOnCell(i, iCell) * r_tmp
+ kineticEnergy(k, iCell) = kineticEnergy(k, iCell) + 0.25 * r_tmp * dcEdge(iEdge) * normalVelocity(k,iEdge)
end do
end do
! Vertical velocity at bottom (maxLevelCell(iCell)+1) is zero, initialized above.
@@ -244,25 +242,22 @@
! Compute v (tangential) velocities
do i=1,nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(i,iEdge)
- ! mrp 101115 note: in order to include flux boundary conditions,
- ! the following loop may need to change to maxLevelEdgeBot
do k = 1,maxLevelEdgeTop(iEdge)
- v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe)
+ tangentialVelocity(k,iEdge) = tangentialVelocity(k,iEdge) + weightsOnEdge(i,iEdge) * normalVelocity(k, eoe)
end do
end do
-
end do
!
! Compute kinetic energy in each vertex
!
- kev(:,:) = 0.0; kevc(:,:) = 0.0
+ kineticEnergyVertex(:,:) = 0.0; kineticEnergyVertexOnCells(:,:) = 0.0
do iVertex = 1, nVertices*ke_vertex_flag
do i = 1, vertexDegree
iEdge = edgesOnVertex(i, iVertex)
r_tmp = dcEdge(iEdge) * dvEdge(iEdge) * 0.25 / areaTriangle(iVertex)
do k = 1, nVertLevels
- kev(k, iVertex) = kev(k, iVertex) + r_tmp * u(k, iEdge)**2
+ kineticEnergyVertex(k, iVertex) = kineticEnergyVertex(k, iVertex) + r_tmp * normalVelocity(k, iEdge)**2
end do
end do
end do
@@ -273,57 +268,55 @@
j = kiteIndexOnCell(i, iCell)
iVertex = verticesOnCell(i, iCell)
do k = 1, nVertLevels
- kevc(k, iCell) = kevc(k, iCell) + kiteAreasOnVertex(j, iVertex) * kev(k, iVertex) * invAreaCell1
+ kineticEnergyVertexOnCells(k, iCell) = kineticEnergyVertexOnCells(k, iCell) + kiteAreasOnVertex(j, iVertex) * kineticEnergyVertex(k, iVertex) * invAreaCell1
end do
end do
end do
!
- ! Compute kinetic energy in each cell by blending ke and kevc
+ ! Compute kinetic energy in each cell by blending kineticEnergy and kineticEnergyVertexOnCells
!
do iCell=1,nCells*ke_vertex_flag
do k=1,nVertLevels
- ke(k,iCell) = 5.0/8.0*ke(k,iCell) + 3.0/8.0*kevc(k,iCell)
+ kineticEnergy(k,iCell) = 5.0/8.0*kineticEnergy(k,iCell) + 3.0/8.0*kineticEnergyVertexOnCells(k,iCell)
end do
end do
!
- ! Compute ke on cell edges at velocity locations for quadratic bottom drag.
+ ! Compute kineticEnergy on cell edges at velocity locations for quadratic bottom drag.
!
- ! mrp 101025 efficiency note: we could get rid of ke_edge completely by
- ! using sqrt(u(k,iEdge)**2 + v(k,iEdge)**2) in its place elsewhere.
do iEdge=1,nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k=1,maxLevelEdgeTop(iEdge)
- ke_edge(k,iEdge) = 0.5 * (ke(k,cell1) + ke(k,cell2))
+ kineticEnergyEdge(k,iEdge) = 0.5 * (kineticEnergy(k,cell1) + kineticEnergy(k,cell2))
end do
end do
!
! Compute height at vertices, pv at vertices, and average pv to edge locations
- ! ( this computes Vor_vertex at all vertices bounding real cells and distance-1 ghost cells )
+ ! ( this computes potentialVorticityVertex at all vertices bounding real cells and distance-1 ghost cells )
!
do iVertex = 1,nVertices
invAreaTri1 = 1.0 / areaTriangle(iVertex)
do k=1,maxLevelVertexBot(iVertex)
- h_vertex = 0.0
+ layerThicknessVertex = 0.0
do i=1,vertexDegree
- h_vertex = h_vertex + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
+ layerThicknessVertex = layerThicknessVertex + layerThickness(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
end do
- h_vertex = h_vertex * invAreaTri1
+ layerThicknessVertex = layerThicknessVertex * invAreaTri1
- Vor_vertex(k,iVertex) = (fCoef*fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
+ potentialVorticityVertex(k,iVertex) = (fCoef*fVertex(iVertex) + relativeVorticity(k,iVertex)) / layerThicknessVertex
end do
end do
- Vor_cell(:,:) = 0.0
- Vor_edge(:,:) = 0.0
+ potentialVorticityCell(:,:) = 0.0
+ potentialVorticityEdge(:,:) = 0.0
do iEdge = 1, nEdges
vertex1 = verticesOnEdge(1, iEdge)
vertex2 = verticesOnEdge(2, iEdge)
do k = 1, maxLevelEdgeBot(iEdge)
- Vor_edge(k, iEdge) = 0.5 * (Vor_vertex(k, vertex1) + Vor_vertex(k, vertex2))
+ potentialVorticityEdge(k, iEdge) = 0.5 * (potentialVorticityVertex(k, vertex1) + potentialVorticityVertex(k, vertex2))
end do
end do
@@ -334,7 +327,7 @@
j = kiteIndexOnCell(i, iCell)
iVertex = verticesOnCell(i, iCell)
do k = 1, maxLevelCell(iCell)
- Vor_cell(k, iCell) = Vor_cell(k, iCell) + kiteAreasOnVertex(j, iVertex) * Vor_vertex(k, iVertex) * invAreaCell1
+ potentialVorticityCell(k, iCell) = potentialVorticityCell(k, iCell) + kiteAreasOnVertex(j, iVertex) * potentialVorticityVertex(k, iVertex) * invAreaCell1
end do
end do
end do
@@ -349,14 +342,14 @@
! Compute gradient of PV in normal direction
! ( this computes gradVor_n for all edges bounding real cells )
do k=1,maxLevelEdgeTop(iEdge)
- gradVor_n(k,iEdge) = (Vor_cell(k,cell2) - Vor_cell(k,cell1)) * invLength
+ gradVor_n(k,iEdge) = (potentialVorticityCell(k,cell2) - potentialVorticityCell(k,cell1)) * invLength
enddo
invLength = 1.0 / dvEdge(iEdge)
! Compute gradient of PV in the tangent direction
! ( this computes gradVor_t at all edges bounding real cells and distance-1 ghost cells )
do k = 1,maxLevelEdgeBot(iEdge)
- gradVor_t(k,iEdge) = (Vor_vertex(k,vertex2) - Vor_vertex(k,vertex1)) * invLength
+ gradVor_t(k,iEdge) = (potentialVorticityVertex(k,vertex2) - potentialVorticityVertex(k,vertex1)) * invLength
enddo
enddo
@@ -366,9 +359,9 @@
!
do iEdge = 1,nEdges
do k = 1,maxLevelEdgeBot(iEdge)
- Vor_edge(k,iEdge) = Vor_edge(k,iEdge) &
- - config_apvm_scale_factor * dt* ( u(k,iEdge) * gradVor_n(k,iEdge) &
- + v(k,iEdge) * gradVor_t(k,iEdge) )
+ potentialVorticityEdge(k,iEdge) = potentialVorticityEdge(k,iEdge) &
+ - config_apvm_scale_factor * dt* ( normalVelocity(k,iEdge) * gradVor_n(k,iEdge) &
+ + tangentialVelocity(k,iEdge) * gradVor_t(k,iEdge) )
enddo
enddo
@@ -381,19 +374,18 @@
call mpas_timer_start("equation of state", .false., diagEOSTimer)
! compute in-place density
- call ocn_equation_of_state_rho(s, grid, 0, 'relative', err)
+ call ocn_equation_of_state_density(s, grid, 0, 'relative', err)
- ! compute rhoDisplaced, the potential density referenced to the top layer
- call ocn_equation_of_state_rho(s, grid, 1, 'relative', err)
+ ! compute displacedDensity, the potential density referenced to the top layer
+ call ocn_equation_of_state_density(s, grid, 1, 'relative', err)
call mpas_timer_stop("equation of state", diagEOSTimer)
endif
!
! Pressure
- ! This section must be after computing rho
+ ! This section must be after computing density
!
- ! dwj: 10/25/2011 - Need to explore isopycnal vs zlevel flags
if (config_pressure_gradient_type.eq.'MontgomeryPotential') then
! For Isopycnal model.
@@ -407,15 +399,15 @@
! For isopycnal mode, p is the Montgomery Potential.
! At top layer it is g*SSH, where SSH may be off by a
! constant (ie, bottomDepth can be relative to top or bottom)
- MontPot(1,iCell) = gravity &
- * (bottomDepth(iCell) + sum(h(1:nVertLevels,iCell)))
+ montgomeryPotential(1,iCell) = gravity &
+ * (bottomDepth(iCell) + sum(layerThickness(1:nVertLevels,iCell)))
do k=2,nVertLevels
- pTop(k) = pTop(k-1) + rho(k-1,iCell)*gravity* h(k-1,iCell)
+ pTop(k) = pTop(k-1) + density(k-1,iCell)*gravity* layerThickness(k-1,iCell)
- ! from delta M = p delta / rho
- MontPot(k,iCell) = MontPot(k-1,iCell) &
- + pTop(k)*(1.0/rho(k,iCell) - 1.0/rho(k-1,iCell))
+ ! from delta M = p delta / density
+ montgomeryPotential(k,iCell) = montgomeryPotential(k-1,iCell) &
+ + pTop(k)*(1.0/density(k,iCell) - 1.0/density(k-1,iCell))
end do
end do
@@ -427,26 +419,26 @@
! Pressure for generalized coordinates.
! Pressure at top surface may be due to atmospheric pressure
! or an ice-shelf depression.
- pressure(1,iCell) = seaSurfacePressure(iCell) + rho(1,iCell)*gravity &
- * 0.5*h(1,iCell)
+ pressure(1,iCell) = seaSurfacePressure(iCell) + density(1,iCell)*gravity &
+ * 0.5*layerThickness(1,iCell)
do k=2,maxLevelCell(iCell)
pressure(k,iCell) = pressure(k-1,iCell) &
- + 0.5*gravity*( rho(k-1,iCell)*h(k-1,iCell) &
- + rho(k ,iCell)*h(k ,iCell))
+ + 0.5*gravity*( density(k-1,iCell)*layerThickness(k-1,iCell) &
+ + density(k ,iCell)*layerThickness(k ,iCell))
end do
! Compute zMid, the z-coordinate of the middle of the layer.
- ! This is used for the rho g grad z momentum term.
+ ! This is used for the density g grad z momentum term.
! Note the negative sign, since bottomDepth is positive
! and z-coordinates are negative below the surface.
k = maxLevelCell(iCell)
- zMid(k:nVertLevels,iCell) = -bottomDepth(iCell) + 0.5*h(k,iCell)
+ zMid(k:nVertLevels,iCell) = -bottomDepth(iCell) + 0.5*layerThickness(k,iCell)
do k=maxLevelCell(iCell)-1, 1, -1
zMid(k,iCell) = zMid(k+1,iCell) &
- + 0.5*( h(k+1,iCell) &
- + h(k ,iCell))
+ + 0.5*( layerThickness(k+1,iCell) &
+ + layerThickness(k ,iCell))
end do
end do
@@ -456,11 +448,11 @@
!
! Brunt-Vaisala frequency
!
- coef = -gravity/config_rho0
+ coef = -gravity/config_density0
do iCell=1,nCells
BruntVaisalaFreqTop(1,iCell) = 0.0
do k=2,maxLevelCell(iCell)
- BruntVaisalaFreqTop(k,iCell) = coef * (rhoDisplaced(k-1,iCell) - rhoDisplaced(k,iCell)) &
+ BruntVaisalaFreqTop(k,iCell) = coef * (displacedDensity(k-1,iCell) - displacedDensity(k,iCell)) &
/ (zMid(k-1,iCell) - zMid(k,iCell))
end do
end do
@@ -474,7 +466,7 @@
! Note the negative sign, since bottomDepth is positive
! and z-coordinates are negative below the surface.
- ssh(iCell) = - bottomDepth(iCell) + sum(h(1:maxLevelCell(iCell),iCell))
+ ssh(iCell) = - bottomDepth(iCell) + sum(layerThickness(1:maxLevelCell(iCell),iCell))
end do
@@ -484,7 +476,6 @@
if (config_h_kappa .GE. epsilon(0D0)) then
call ocn_gm_compute_uBolus(s,grid)
else
- ! mrp efficiency note: if uBolusGM is guaranteed to be zero, this can be removed.
uBolusGM = 0.0
end if
@@ -492,7 +483,7 @@
!***********************************************************************
!
-! routine ocn_wtop
+! routine ocn_vert_transport_velocity_top
!
!> \brief Computes vertical transport
!> \author Mark Petersen
@@ -503,7 +494,7 @@
!> cell.
!
!-----------------------------------------------------------------------
- subroutine ocn_wtop(grid,h,h_edge,u,wTop, err)!{{{
+ subroutine ocn_vert_transport_velocity_top(grid,layerThickness,layerThicknessEdge,normalVelocity,vertTransportVelocityTop, err)!{{{
!-----------------------------------------------------------------
!
@@ -515,13 +506,13 @@
grid !< Input: grid information
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness
+ layerThickness !< Input: thickness
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: h interpolated to an edge
+ layerThicknessEdge !< Input: layerThickness interpolated to an edge
real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: transport
+ normalVelocity !< Input: transport
!-----------------------------------------------------------------
!
@@ -530,7 +521,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(out) :: &
- wTop !< Output: vertical transport at top of cell
+ vertTransportVelocityTop !< Output: vertical transport at top of cell
integer, intent(out) :: err !< Output: error flag
@@ -541,7 +532,7 @@
!-----------------------------------------------------------------
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
- real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, rho0Inv, hSum, invAreaCell
+ real (kind=RKIND) :: flux, layerThicknessVertex, workpv, density0Inv, thicknessSum, invAreaCell
integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree
@@ -577,7 +568,7 @@
if (config_vert_coord_movement.eq.'isopycnal') then
! set vertical transport to zero in isopycnal case
- wTop=0.0
+ vertTransportVelocityTop=0.0
return
end if
@@ -591,39 +582,39 @@
do iCell=1,nCells
div_hu(:) = 0.0
div_hu_btr = 0.0
- hSum = 0.0
+ thicknessSum = 0.0
invAreaCell = 1.0 / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
do k = 1, maxLevelEdgeBot(iEdge)
- flux = h_edge(k, iEdge) * u(k, iEdge) * dvEdge(iEdge) * edgeSignOnCell(i, iCell) * invAreaCell
+ flux = layerThicknessEdge(k, iEdge) * normalVelocity(k, iEdge) * dvEdge(iEdge) * edgeSignOnCell(i, iCell) * invAreaCell
div_hu(k) = div_hu(k) - flux
div_hu_btr = div_hu_btr - flux
end do
end do
do k = 1, maxLevelCell(iCell)
- h_tend_col(k) = - vertCoordMovementWeights(k) * h(k, iCell) * div_hu_btr
- hSum = hSum + vertCoordMovementWeights(k) * h(k, iCell)
+ h_tend_col(k) = - vertCoordMovementWeights(k) * layerThickness(k, iCell) * div_hu_btr
+ thicknessSum = thicknessSum + vertCoordMovementWeights(k) * layerThickness(k, iCell)
end do
- if(hSum > 0.0) then
- h_tend_col = h_tend_col / hSum
+ if(thicknessSum > 0.0) then
+ h_tend_col = h_tend_col / thicknessSum
end if
! Vertical transport through layer interface at top and bottom is zero.
- wTop(1,iCell) = 0.0
- wTop(maxLevelCell(iCell)+1,iCell) = 0.0
+ vertTransportVelocityTop(1,iCell) = 0.0
+ vertTransportVelocityTop(maxLevelCell(iCell)+1,iCell) = 0.0
do k=maxLevelCell(iCell),2,-1
- wTop(k,iCell) = wTop(k+1,iCell) - div_hu(k) - h_tend_col(k)
+ vertTransportVelocityTop(k,iCell) = vertTransportVelocityTop(k+1,iCell) - div_hu(k) - h_tend_col(k)
end do
end do
deallocate(div_hu, h_tend_col)
- end subroutine ocn_wtop!}}}
+ end subroutine ocn_vert_transport_velocity_top!}}}
!***********************************************************************
!
@@ -644,13 +635,10 @@
type (state_type), intent(inout) :: s !< Input/Output: State information
type (mesh_type), intent(in) :: grid !< Input: Grid information
-! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
-! Some of these variables can be removed, but at a later time.
integer :: iEdge, cell1, cell2, eoe, i, j, k
-
integer :: nEdgesSolve
real (kind=RKIND), dimension(:), pointer :: fEdge
- real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge, u, uBcl
+ real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge, normalVelocity, normalBaroclinicVelocity
type (dm_info) :: dminfo
integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnEdge
@@ -658,8 +646,8 @@
call mpas_timer_start("ocn_fuperp")
- u => s % u % array
- uBcl => s % uBcl % array
+ normalVelocity => s % normalVelocity % array
+ normalBaroclinicVelocity => s % normalBaroclinicVelocity % array
weightsOnEdge => grid % weightsOnEdge % array
fEdge => grid % fEdge % array
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
@@ -672,7 +660,7 @@
nEdgesSolve = grid % nEdgesSolve
!
- ! Put f*uBcl^{perp} in u as a work variable
+ ! Put f*normalBaroclinicVelocity^{perp} in u as a work variable
!
do iEdge=1,nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
@@ -680,10 +668,10 @@
do k=1,maxLevelEdgeTop(iEdge)
- u(k,iEdge) = 0.0
+ normalVelocity(k,iEdge) = 0.0
do j = 1,nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(j,iEdge)
- u(k,iEdge) = u(k,iEdge) + weightsOnEdge(j,iEdge) * uBcl(k,eoe) * fEdge(eoe)
+ normalVelocity(k,iEdge) = normalVelocity(k,iEdge) + weightsOnEdge(j,iEdge) * normalBaroclinicVelocity(k,eoe) * fEdge(eoe)
end do
end do
end do
@@ -694,7 +682,7 @@
!***********************************************************************
!
-! routine ocn_filter_btr_mode_u
+! routine ocn_filter_btr_mode_vel
!
!> \brief filters barotropic mode out of the velocity variable.
!> \author Mark Petersen
@@ -704,60 +692,60 @@
!> This routine filters barotropic mode out of the velocity variable.
!
!-----------------------------------------------------------------------
- subroutine ocn_filter_btr_mode_u(s, grid)!{{{
+ subroutine ocn_filter_btr_mode_vel(s, grid)!{{{
implicit none
type (state_type), intent(inout) :: s
type (mesh_type), intent(in) :: grid
integer :: iEdge, k, nEdges
- real (kind=RKIND) :: vertSum, uhSum, hSum
- real (kind=RKIND), dimension(:,:), pointer :: h_edge, u
+ real (kind=RKIND) :: vertSum, normalThicknessFluxSum, thicknessSum
+ real (kind=RKIND), dimension(:,:), pointer :: layerThicknessEdge, normalVelocity
integer, dimension(:), pointer :: maxLevelEdgeTop
- call mpas_timer_start("ocn_filter_btr_mode_u")
+ call mpas_timer_start("ocn_filter_btr_mode_vel")
- u => s % u % array
- h_edge => s % h_edge % array
+ normalVelocity => s % normalVelocity % array
+ layerThicknessEdge => s % layerThicknessEdge % array
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
nEdges = grid % nEdges
do iEdge=1,nEdges
- ! hSum is initialized outside the loop because on land boundaries
- ! maxLevelEdgeTop=0, but I want to initialize hSum with a
+ ! thicknessSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
! nonzero value to avoid a NaN.
- uhSum = h_edge(1,iEdge) * u(1,iEdge)
- hSum = h_edge(1,iEdge)
+ normalThicknessFluxSum = layerThicknessEdge(1,iEdge) * normalVelocity(1,iEdge)
+ thicknessSum = layerThicknessEdge(1,iEdge)
do k=2,maxLevelEdgeTop(iEdge)
- uhSum = uhSum + h_edge(k,iEdge) * u(k,iEdge)
- hSum = hSum + h_edge(k,iEdge)
+ normalThicknessFluxSum = normalThicknessFluxSum + layerThicknessEdge(k,iEdge) * normalVelocity(k,iEdge)
+ thicknessSum = thicknessSum + layerThicknessEdge(k,iEdge)
enddo
- vertSum = uhSum/hSum
+ vertSum = normalThicknessFluxSum/thicknessSum
do k=1,maxLevelEdgeTop(iEdge)
- u(k,iEdge) = u(k,iEdge) - vertSum
+ normalVelocity(k,iEdge) = normalVelocity(k,iEdge) - vertSum
enddo
enddo ! iEdge
- call mpas_timer_stop("ocn_filter_btr_mode_u")
+ call mpas_timer_stop("ocn_filter_btr_mode_vel")
- end subroutine ocn_filter_btr_mode_u!}}}
+ end subroutine ocn_filter_btr_mode_vel!}}}
!***********************************************************************
!
-! routine ocn_filter_btr_mode_tend_u
+! routine ocn_filter_btr_mode_tend_vel
!
-!> \brief ocn_filters barotropic mode out of the u tendency
+!> \brief ocn_filters barotropic mode out of the velocity tendency
!> \author Mark Petersen
!> \date 23 September 2011
!> \version SVN:$Id$
!> \details
-!> This routine filters barotropic mode out of the u tendency.
+!> This routine filters barotropic mode out of the velocity tendency.
!
!-----------------------------------------------------------------------
- subroutine ocn_filter_btr_mode_tend_u(tend, s, grid)!{{{
+ subroutine ocn_filter_btr_mode_tend_vel(tend, s, grid)!{{{
implicit none
type (tend_type), intent(inout) :: tend
@@ -765,40 +753,40 @@
type (mesh_type), intent(in) :: grid
integer :: iEdge, k, nEdges
- real (kind=RKIND) :: vertSum, uhSum, hSum
- real (kind=RKIND), dimension(:,:), pointer :: h_edge, tend_u
+ real (kind=RKIND) :: vertSum, normalThicknessFluxSum, thicknessSum
+ real (kind=RKIND), dimension(:,:), pointer :: layerThicknessEdge, tend_normalVelocity
integer, dimension(:), pointer :: maxLevelEdgeTop
- call mpas_timer_start("ocn_filter_btr_mode_tend_u")
+ call mpas_timer_start("ocn_filter_btr_mode_tend_vel")
- tend_u => tend % u % array
- h_edge => s % h_edge % array
+ tend_normalVelocity => tend % normalVelocity % array
+ layerThicknessEdge => s % layerThicknessEdge % array
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
nEdges = grid % nEdges
do iEdge=1,nEdges
- ! hSum is initialized outside the loop because on land boundaries
- ! maxLevelEdgeTop=0, but I want to initialize hSum with a
+ ! thicknessSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
! nonzero value to avoid a NaN.
- uhSum = h_edge(1,iEdge) * tend_u(1,iEdge)
- hSum = h_edge(1,iEdge)
+ normalThicknessFluxSum = layerThicknessEdge(1,iEdge) * tend_normalVelocity(1,iEdge)
+ thicknessSum = layerThicknessEdge(1,iEdge)
do k=2,maxLevelEdgeTop(iEdge)
- uhSum = uhSum + h_edge(k,iEdge) * tend_u(k,iEdge)
- hSum = hSum + h_edge(k,iEdge)
+ normalThicknessFluxSum = normalThicknessFluxSum + layerThicknessEdge(k,iEdge) * tend_normalVelocity(k,iEdge)
+ thicknessSum = thicknessSum + layerThicknessEdge(k,iEdge)
enddo
- vertSum = uhSum/hSum
+ vertSum = normalThicknessFluxSum/thicknessSum
do k=1,maxLevelEdgeTop(iEdge)
- tend_u(k,iEdge) = tend_u(k,iEdge) - vertSum
+ tend_normalVelocity(k,iEdge) = tend_normalVelocity(k,iEdge) - vertSum
enddo
enddo ! iEdge
- call mpas_timer_stop("ocn_filter_btr_mode_tend_u")
+ call mpas_timer_stop("ocn_filter_btr_mode_tend_vel")
- end subroutine ocn_filter_btr_mode_tend_u!}}}
+ end subroutine ocn_filter_btr_mode_tend_vel!}}}
!***********************************************************************
!
@@ -827,15 +815,13 @@
endif
if (trim(config_time_integrator) == 'RK4') then
- ! for RK4, PV is really PV = (eta+f)/h
+ ! For RK4, PV includes f: PV = (eta+f)/h.
fCoef = 1
elseif (trim(config_time_integrator) == 'split_explicit' &
.or.trim(config_time_integrator) == 'unsplit_explicit') then
- ! for split explicit, PV is eta/h because f is added separately to the momentum forcing.
- ! mrp temp, new should be:
+ ! For split explicit, PV is eta/h because the Coriolis term
+ ! is added separately to the momentum tendencies.
fCoef = 0
- ! old, for testing:
- ! fCoef = 1
end if
end subroutine ocn_diagnostics_init!}}}
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_equation_of_state.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_equation_of_state.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_equation_of_state.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -36,7 +36,7 @@
!
!--------------------------------------------------------------------
- public :: ocn_equation_of_state_rho, &
+ public :: ocn_equation_of_state_density, &
ocn_equation_of_state_init
!--------------------------------------------------------------------
@@ -66,7 +66,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_equation_of_state_rho(s, grid, k_displaced, displacement_type, err)!{{{
+ subroutine ocn_equation_of_state_density(s, grid, k_displaced, displacement_type, err)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This module contains routines necessary for computing the density
! from model temperature and salinity using an equation of state.
@@ -75,11 +75,11 @@
! s - state: tracers
! k_displaced
!
- ! If k_displaced==0, state % rho is returned with no displacement
+ ! If k_displaced==0, state % density is returned with no displacement
!
- ! If k_displaced~=0,the state % rhoDisplaced is returned, and is for
+ ! If k_displaced~=0,the state % displacedDensity is returned, and is for
! a parcel adiabatically displaced from its original level to level
- ! k_displaced. When using the linear EOS, state % rhoDisplaced is
+ ! k_displaced. When using the linear EOS, state % displacedDensity is
! still filled, but depth (i.e. pressure) does not modify the output.
!
! Output: s - state: computed density
@@ -93,7 +93,7 @@
character(len=*), intent(in) :: displacement_type
integer, dimension(:), pointer :: maxLevelCell
- real (kind=RKIND), dimension(:,:), pointer :: rho
+ real (kind=RKIND), dimension(:,:), pointer :: density
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
integer :: nCells, iCell, k, indexT, indexS
type (dm_info) :: dminfo
@@ -106,24 +106,24 @@
indexT = s % index_temperature
indexS = s % index_salinity
- ! Choose to fill the array rho or rhoDisplaced
+ ! Choose to fill the array density or displacedDensity
if (k_displaced == 0) then
- rho => s % rho % array
+ density => s % density % array
else
- rho => s % rhoDisplaced % array
+ density => s % displacedDensity % array
endif
if (linearEos) then
- call ocn_equation_of_state_linear_rho(grid, indexT, indexS, tracers, rho, err)
+ call ocn_equation_of_state_linear_density(grid, indexT, indexS, tracers, density, err)
elseif (jmEos) then
- call ocn_equation_of_state_jm_rho(grid, k_displaced, displacement_type, indexT, indexS, tracers, rho, err)
+ call ocn_equation_of_state_jm_density(grid, k_displaced, displacement_type, indexT, indexS, tracers, density, err)
endif
- end subroutine ocn_equation_of_state_rho!}}}
+ end subroutine ocn_equation_of_state_density!}}}
!***********************************************************************
!
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_equation_of_state_jm.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_equation_of_state_jm.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_equation_of_state_jm.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -34,7 +34,7 @@
!
!--------------------------------------------------------------------
- public :: ocn_equation_of_state_jm_rho, &
+ public :: ocn_equation_of_state_jm_density, &
ocn_equation_of_state_jm_init
!--------------------------------------------------------------------
@@ -49,7 +49,7 @@
!***********************************************************************
!
-! routine ocn_equation_of_state_jm_rho
+! routine ocn_equation_of_state_jm_density
!
!> \brief Calls JM equation of state
!> \author Doug Jacobsen
@@ -60,7 +60,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_equation_of_state_jm_rho(grid, k_displaced, displacement_type, indexT, indexS, tracers, rho, err)!{{{
+ subroutine ocn_equation_of_state_jm_density(grid, k_displaced, displacement_type, indexT, indexS, tracers, density, err)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This module contains routines necessary for computing the density
! from model temperature and salinity using an equation of state.
@@ -98,7 +98,7 @@
real (kind=RKIND), dimension(:), pointer :: &
refBottomDepth, pRefEOS
real (kind=RKIND), dimension(:,:), intent(inout) :: &
- rho
+ density
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
integer, dimension(:), pointer :: maxLevelCell
@@ -106,7 +106,7 @@
real (kind=RKIND) :: &
TQ,SQ, &! adjusted T,S
BULK_MOD, &! Bulk modulus
- RHO_S, &! density at the surface
+ density_S, &! density at the surface
DRDT0, &! d(density)/d(temperature), for surface
DRDS0, &! d(density)/d(salinity ), for surface
DKDT, &! d(bulk modulus)/d(pot. temp.)
@@ -280,7 +280,7 @@
(uns1t2 + uns1t3*TQ + uns1t4*T2)*T2
WORK2 = SQR*(unsqt0 + unsqt1*TQ + unsqt2*T2)
- RHO_S = unt1*TQ + (unt2 + unt3*TQ + (unt4 + unt5*TQ)*T2)*T2 &
+ density_S = unt1*TQ + (unt2 + unt3*TQ + (unt4 + unt5*TQ)*T2)*T2 &
+ (uns2t0*SQ + WORK1 + WORK2)*SQ
!***
@@ -304,13 +304,13 @@
DENOMK = 1.0/(BULK_MOD - p(k))
- rho(k,iCell) = (unt0 + RHO_S)*BULK_MOD*DENOMK
+ density(k,iCell) = (unt0 + density_S)*BULK_MOD*DENOMK
end do
end do
deallocate(pRefEOS,p,p2)
- end subroutine ocn_equation_of_state_jm_rho!}}}
+ end subroutine ocn_equation_of_state_jm_density!}}}
!***********************************************************************
!
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_equation_of_state_linear.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_equation_of_state_linear.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_equation_of_state_linear.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -33,7 +33,7 @@
!
!--------------------------------------------------------------------
- public :: ocn_equation_of_state_linear_rho, &
+ public :: ocn_equation_of_state_linear_density, &
ocn_equation_of_state_linear_init
!--------------------------------------------------------------------
@@ -48,7 +48,7 @@
!***********************************************************************
!
-! routine ocn_equation_of_state_linear_rho
+! routine ocn_equation_of_state_linear_density
!
!> \brief Calls equation of state
!> \author Doug Jacobsen
@@ -59,7 +59,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_equation_of_state_linear_rho(grid, indexT, indexS, tracers, rho, err)!{{{
+ subroutine ocn_equation_of_state_linear_density(grid, indexT, indexS, tracers, density, err)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This module contains routines necessary for computing the density
! from model temperature and salinity using an equation of state.
@@ -67,8 +67,8 @@
! Input: grid - grid metadata
! s - state: tracers
! k_displaced
- ! If k_displaced<=0, state % rho is returned with no displaced
- ! If k_displaced>0,the state % rhoDisplaced is returned, and is for
+ ! If k_displaced<=0, state % density is returned with no displaced
+ ! If k_displaced>0,the state % densityDisplaced is returned, and is for
! a parcel adiabatically displaced from its original level to level
! k_displaced. This does not effect the linear EOS.
!
@@ -77,7 +77,7 @@
implicit none
type (mesh_type), intent(in) :: grid
- real (kind=RKIND), dimension(:,:), intent(inout) :: rho
+ real (kind=RKIND), dimension(:,:), intent(inout) :: density
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
integer, intent(in) :: indexT, indexS
integer, intent(out) :: err
@@ -94,13 +94,13 @@
do iCell=1,nCells
do k=1,maxLevelCell(iCell)
! Linear equation of state
- rho(k,iCell) = config_eos_linear_rhoref &
+ density(k,iCell) = config_eos_linear_densityref &
- config_eos_linear_alpha * (tracers(indexT,k,iCell)-config_eos_linear_Tref) &
+ config_eos_linear_beta * (tracers(indexS,k,iCell)-config_eos_linear_Sref)
end do
end do
- end subroutine ocn_equation_of_state_linear_rho!}}}
+ end subroutine ocn_equation_of_state_linear_density!}}}
!***********************************************************************
!
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_global_diagnostics.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_global_diagnostics.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_global_diagnostics.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -24,7 +24,7 @@
! timeIndex is the current time step counter
! dt is the duration of each time step
- ! Sums of variables at vertices are not weighted by thickness (since h is not known at
+ ! Sums of variables at vertices are not weighted by thickness (since layerThickness is not known at
! vertices as it is at cell centers and at edges).
implicit none
@@ -46,8 +46,8 @@
real (kind=RKIND) :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal, localCFL, localSum, areaCellGlobal, areaEdgeGlobal, areaTriangleGlobal
real (kind=RKIND), dimension(:), pointer :: areaCell, dcEdge, dvEdge, areaTriangle, areaEdge
- real (kind=RKIND), dimension(:,:), pointer :: h, u, v, h_edge, vorticity, ke, Vor_edge, Vor_vertex, &
- Vor_cell, gradVor_n, gradVor_t, pressure, MontPot, wTop, rho, tracerTemp
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, normalVelocity, tangentialVelocity, layerThicknessEdge, relativeVorticity, kineticEnergy, potentialVorticityEdge, potentialVorticityVertex, &
+ potentialVorticityCell, gradVor_n, gradVor_t, pressure, montgomeryPotential, vertTransportVelocityTop, density, tracerTemp
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
real (kind=RKIND), dimension(kMaxVariables) :: sums, mins, maxes, averages, verticalSumMins, verticalSumMaxes, reductions
@@ -85,27 +85,27 @@
allocate(areaEdge(1:nEdgesSolve))
areaEdge = dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve)
- h => state % h % array
- u => state % u % array
- rho => state % rho % array
+ layerThickness => state % layerThickness % array
+ normalVelocity => state % normalVelocity % array
+ density => state % density % array
tracers => state % tracers % array
- v => state % v % array
- wTop => state % wTop % array
- h_edge => state % h_edge % array
- vorticity => state % vorticity % array
- ke => state % ke % array
- Vor_edge => state % Vor_edge % array
- Vor_vertex => state % Vor_vertex % array
- Vor_cell => state % Vor_cell % array
+ tangentialVelocity => state % tangentialVelocity % array
+ vertTransportVelocityTop => state % vertTransportVelocityTop % array
+ layerThicknessEdge => state % layerThicknessEdge % array
+ relativeVorticity => state % relativeVorticity % array
+ kineticEnergy => state % kineticEnergy % array
+ potentialVorticityEdge => state % potentialVorticityEdge % array
+ potentialVorticityVertex => state % potentialVorticityVertex % array
+ potentialVorticityCell => state % potentialVorticityCell % array
gradVor_n => state % gradVor_n % array
gradVor_t => state % gradVor_t % array
- MontPot => state % MontPot % array
+ montgomeryPotential => state % montgomeryPotential % array
pressure => state % pressure % array
variableIndex = 0
- ! h
+ ! layerThickness
variableIndex = variableIndex + 1
- call ocn_compute_field_area_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
+ call ocn_compute_field_area_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -113,10 +113,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! u
+ ! normalVelocity
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- u(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), layerThicknessEdge(:,1:nEdgesSolve), &
+ normalVelocity(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -124,10 +124,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! v
+ ! tangentialVelocity
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- v(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), layerThicknessEdge(:,1:nEdgesSolve), &
+ tangentialVelocity(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -135,9 +135,9 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! h_edge
+ ! layerThicknessEdge
variableIndex = variableIndex + 1
- call ocn_compute_field_area_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
+ call ocn_compute_field_area_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), layerThicknessEdge(:,1:nEdgesSolve), &
sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -145,9 +145,9 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! vorticity
+ ! relativeVorticity
variableIndex = variableIndex + 1
- call ocn_compute_field_local_stats(dminfo, nVertLevels, nVerticesSolve, vorticity(:,1:nVerticesSolve), &
+ call ocn_compute_field_local_stats(dminfo, nVertLevels, nVerticesSolve, relativeVorticity(:,1:nVerticesSolve), &
sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -155,9 +155,9 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! vorticity**2
+ ! relativeVorticity**2
allocate(enstrophy(nVertLevels,nVerticesSolve))
- enstrophy(:,:)=vorticity(:,1:nVerticesSolve)**2
+ enstrophy(:,:)=relativeVorticity(:,1:nVerticesSolve)**2
variableIndex = variableIndex + 1
call ocn_compute_field_area_weighted_local_stats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &
enstrophy(:,:), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), &
@@ -169,10 +169,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! ke
+ ! kineticEnergy
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- ke(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
+ kineticEnergy(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -180,10 +180,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! Vor_edge
+ ! potentialVorticityEdge
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- Vor_edge(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), layerThicknessEdge(:,1:nEdgesSolve), &
+ potentialVorticityEdge(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -191,10 +191,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! Vor_vertex
+ ! potentialVorticityVertex
variableIndex = variableIndex + 1
call ocn_compute_field_area_weighted_local_stats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &
- Vor_vertex(:,1:nVerticesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ potentialVorticityVertex(:,1:nVerticesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), &
verticalSumMins_tmp(variableIndex), verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -202,10 +202,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! Vor_cell
+ ! potentialVorticityCell
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- Vor_cell(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
+ potentialVorticityCell(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -215,7 +215,7 @@
! gradVor_n
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), layerThicknessEdge(:,1:nEdgesSolve), &
gradVor_n(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
@@ -226,7 +226,7 @@
! gradVor_t
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), layerThicknessEdge(:,1:nEdgesSolve), &
gradVor_t(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
@@ -237,7 +237,7 @@
! pressure
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
pressure(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
@@ -246,10 +246,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! MontPot
+ ! montgomeryPotential
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- MontPot(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
+ montgomeryPotential(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -257,10 +257,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! wTop vertical velocity
+ ! vertTransportVelocityTop vertical velocity
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels+1, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- wTop(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels+1, nCellsSolve, areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
+ vertTransportVelocityTop(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -273,7 +273,7 @@
do iTracer=1,num_tracers
variableIndex = variableIndex + 1
tracerTemp = Tracers(iTracer,:,1:nCellsSolve)
- call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
+ call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
tracerTemp, sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
@@ -309,7 +309,7 @@
localCFL = 0.0
do elementIndex = 1,nEdgesSolve
- localCFL = max(localCFL, maxval(dt*u(:,elementIndex)/dcEdge(elementIndex)))
+ localCFL = max(localCFL, maxval(dt*normalVelocity(:,elementIndex)/dcEdge(elementIndex)))
end do
nMaxes = nMaxes + 1
maxes(nMaxes) = localCFL
@@ -350,43 +350,43 @@
volumeEdgeGlobal = sums(4)
! compute the averages (slightly different depending on how the sum was computed)
variableIndex = 0
- ! h
+ ! layerThickness
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/(areaCellGlobal*nVertLevels)
- ! u
+ ! normalVelocity
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
- ! v
+ ! tangentialVelocity
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
- ! h_edge
+ ! layerThicknessEdge
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/(areaEdgeGlobal*nVertLevels)
- ! vorticity
+ ! relativeVorticity
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/(nVerticesGlobal*nVertLevels)
- ! vorticity
+ ! relativeVorticity
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/(areaTriangleGlobal*nVertLevels)
- ! ke
+ ! kineticEnergy
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
- ! Vor_edge
+ ! potentialVorticityEdge
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
- ! Vor_vertex
+ ! potentialVorticityVertex
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/(areaTriangleGlobal*nVertLevels)
- ! Vor_cell
+ ! potentialVorticityCell
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
@@ -402,11 +402,11 @@
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
- ! MontPot
+ ! montgomeryPotential
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
- ! wTop vertical velocity
+ ! vertTransportVelocityTop vertical velocity
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
@@ -544,7 +544,7 @@
end subroutine ocn_compute_field_thickness_weighted_local_stats!}}}
- subroutine ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nElements, areas, h, field, &!{{{
+ subroutine ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nElements, areas, layerThickness, field, &!{{{
localSum, localMin, localMax, localVertSumMin, localVertSumMax)
implicit none
@@ -552,7 +552,7 @@
type (dm_info), intent(in) :: dminfo
integer, intent(in) :: nVertLevels, nElements
real (kind=RKIND), dimension(nElements), intent(in) :: areas
- real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h
+ real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: layerThickness
real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
real (kind=RKIND), intent(out) :: localSum, localMin, localMax, localVertSumMin, &
localVertSumMax
@@ -563,13 +563,13 @@
localSum = 0.0
do elementIndex = 1, nElements
- localSum = localSum + areas(elementIndex) * sum(h(:,elementIndex)*field(:,elementIndex))
+ localSum = localSum + areas(elementIndex) * sum(layerThickness(:,elementIndex)*field(:,elementIndex))
end do
localMin = minval(field)
localMax = maxval(field)
- localVertSumMin = minval(sum(h*field,1))
- localVertSumMax = maxval(sum(h*field,1))
+ localVertSumMin = minval(sum(layerThickness*field,1))
+ localVertSumMax = maxval(sum(layerThickness*field,1))
end subroutine ocn_compute_field_volume_weighted_local_stats!}}}
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_gm.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_gm.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_gm.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -35,13 +35,13 @@
type(state_type), intent(inout) :: s
type(mesh_type), intent(in) :: grid
- real(kind=RKIND), dimension(:,:), pointer :: uBolusGM, hEddyFlux, h_edge
+ real(kind=RKIND), dimension(:,:), pointer :: uBolusGM, hEddyFlux, layerThicknessEdge
integer, dimension(:), pointer :: maxLevelEdgeTop
integer :: k, iEdge, nEdges
uBolusGM => s % uBolusGM % array
- h_edge => s % h_edge % array
+ layerThicknessEdge => s % layerThicknessEdge % array
hEddyFlux => s % hEddyFlux % array
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
@@ -54,7 +54,7 @@
do iEdge = 1, nEdges
do k = 1, maxLevelEdgeTop(iEdge)
- uBolusGM(k,iEdge) = hEddyFlux(k,iEdge)/h_edge(k,iEdge)
+ uBolusGM(k,iEdge) = hEddyFlux(k,iEdge)/layerThicknessEdge(k,iEdge)
end do
end do
@@ -72,14 +72,14 @@
type(state_type), intent(inout) :: s
type(mesh_type), intent(in) :: grid
- real(kind=RKIND), dimension(:,:), pointer :: hEddyFlux, h
+ real(kind=RKIND), dimension(:,:), pointer :: hEddyFlux, layerThickness
real(kind=RKIND), dimension(:), pointer :: dcEdge
integer, dimension(:,:), pointer :: cellsOnEdge
integer, dimension(:), pointer :: maxLevelEdgeTop
integer :: k, cell1, cell2, iEdge, nEdges
hEddyFlux => s % hEddyFlux % array
- h => s % h % array
+ layerThickness => s % layerThickness % array
dcEdge => grid % dcEdge % array
cellsOnEdge => grid % cellsOnEdge % array
@@ -94,7 +94,7 @@
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k=1,maxLevelEdgeTop(iEdge)
- hEddyFlux(k,iEdge) = -config_h_kappa * (h(k,cell2) - h(k,cell1)) / dcEdge(iEdge)
+ hEddyFlux(k,iEdge) = -config_h_kappa * (layerThickness(k,cell2) - layerThickness(k,cell1)) / dcEdge(iEdge)
end do
end do
else
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_monthly_forcing.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_monthly_forcing.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_monthly_forcing.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -102,7 +102,7 @@
real (kind=RKIND), dimension(:,:), pointer :: windStressMonthly
real (kind=RKIND), dimension(:), pointer :: temperatureRestore
real (kind=RKIND), dimension(:), pointer :: salinityRestore
- real (kind=RKIND), dimension(:,:), pointer :: u_src
+ real (kind=RKIND), dimension(:,:), pointer :: normalVelocityForcing
integer :: iCell, iEdge, nCells, nEdges, nMonths, k
integer :: iMonth, iMonthP1, iDayInMonth, ierr
real (kind=RKIND) :: data, dataP1, weight, weightP1
@@ -117,7 +117,7 @@
temperatureRestore => grid % temperatureRestore % array
salinityRestore => grid % salinityRestore % array
- u_src => grid % u_src % array
+ normalVelocityForcing => grid % normalVelocityForcing % array
temperatureRestoreMonthly => grid % temperatureRestoreMonthly % array
salinityRestoreMonthly => grid % salinityRestoreMonthly % array
@@ -146,7 +146,7 @@
! Interpolate between iMonth and iMonthP1 records, using iDayInMonth
data = windStressMonthly(iMonth,iEdge)
dataP1 = windStressMonthly(iMonthP1,iEdge)
- u_src(1,iEdge) = data * weight + dataP1 * weightP1
+ normalVelocityForcing(1,iEdge) = data * weight + dataP1 * weightP1
end do
!--------------------------------------------------------------------
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_mpas_core.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_mpas_core.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_mpas_core.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -22,8 +22,6 @@
use ocn_vel_forcing
use ocn_vel_coriolis
- use ocn_tracer_hadv
- use ocn_tracer_vadv
use ocn_tracer_hmix
use ocn_gm
use ocn_restoring
@@ -85,10 +83,6 @@
call ocn_vel_forcing_init(err_tmp)
err = ior(err, err_tmp)
- call ocn_tracer_hadv_init(err_tmp)
- err = ior(err, err_tmp)
- call ocn_tracer_vadv_init(err_tmp)
- err = ior(err, err_tmp)
call ocn_tracer_hmix_init(err_tmp)
err = ior(err, err_tmp)
call ocn_restoring_init(err_tmp)
@@ -169,16 +163,10 @@
block => block % next
end do
- ! mrp 100316 In order for this to work, we need to pass domain % dminfo as an
- ! input arguement into mpas_init. Ask about that later. For now, there will be
- ! no initial statistics write.
-
if (config_write_stats_on_startup) then
call mpas_timer_start("global diagnostics", .false., globalDiagTimer)
call ocn_compute_global_diagnostics(domain, 1 , 0, dt)
call mpas_timer_stop("global diagnostics", globalDiagTimer)
-! call mpas_output_state_init(output_obj, domain, "OUTPUT")
-! call ocn_write_output_frame(output_obj, output_frame, domain)
endif
current_outfile_frames = 0
@@ -279,59 +267,48 @@
call ocn_diagnostic_solve(dt, block % state % time_levs(1) % state, mesh)
call mpas_timer_stop("diagnostic solve", initDiagSolveTimer)
- ! Compute velocity transport, used in advection terms of h and tracer tendency
+ ! Compute velocity transport, used in advection terms of layerThickness and tracer tendency
block % state % time_levs(1) % state % uTransport % array(:,:) &
- = block % state % time_levs(1) % state % u % array(:,:) &
+ = block % state % time_levs(1) % state % normalVelocity % array(:,:) &
+ block % state % time_levs(1) % state % uBolusGM % array(:,:)
call ocn_compute_mesh_scaling(mesh)
call mpas_rbf_interp_initialize(mesh)
call mpas_init_reconstruct(mesh)
- call mpas_reconstruct(mesh, block % state % time_levs(1) % state % u % array, &
- block % state % time_levs(1) % state % uReconstructX % array, &
- block % state % time_levs(1) % state % uReconstructY % array, &
- block % state % time_levs(1) % state % uReconstructZ % array, &
- block % state % time_levs(1) % state % uReconstructZonal % array, &
- block % state % time_levs(1) % state % uReconstructMeridional % array &
+ call mpas_reconstruct(mesh, block % state % time_levs(1) % state % normalVelocity % array, &
+ block % state % time_levs(1) % state % normalVelocityX % array, &
+ block % state % time_levs(1) % state % normalVelocityY % array, &
+ block % state % time_levs(1) % state % normalVelocityZ % array, &
+ block % state % time_levs(1) % state % normalVelocityZonal % array, &
+ block % state % time_levs(1) % state % normalVelocityMeridional % array &
)
-!TDR
- call mpas_reconstruct(mesh, mesh % u_src % array, &
- block % state % time_levs(1) % state % uSrcReconstructX % array, &
- block % state % time_levs(1) % state % uSrcReconstructY % array, &
- block % state % time_levs(1) % state % uSrcReconstructZ % array, &
- block % state % time_levs(1) % state % uSrcReconstructZonal % array, &
- block % state % time_levs(1) % state % uSrcReconstructMeridional % array &
+ call mpas_reconstruct(mesh, mesh % normalVelocityForcing % array, &
+ block % state % time_levs(1) % state % normalVelocityForcingReconstructX % array, &
+ block % state % time_levs(1) % state % normalVelocityForcingReconstructY % array, &
+ block % state % time_levs(1) % state % normalVelocityForcingReconstructZ % array, &
+ block % state % time_levs(1) % state % normalVelocityForcingReconstructZonal % array, &
+ block % state % time_levs(1) % state % normalVelocityForcingReconstructMeridional % array &
)
-!TDR
- ! initialize velocities and tracers on land to be -1e34
- ! The reconstructed velocity on land will have values not exactly
- ! -1e34 due to the interpolation of reconstruction.
+ ! initialize velocities and tracers on land to be zero.
block % mesh % areaCell % array(block % mesh % nCells+1) = -1.0e34
do iEdge=1,block % mesh % nEdges
- ! mrp 101115 note: in order to include flux boundary conditions, the following
- ! line will need to change. Right now, set boundary edges between land and
- ! water to have zero velocity.
- block % state % time_levs(1) % state % u % array( &
+ block % state % time_levs(1) % state % normalVelocity % array( &
block % mesh % maxLevelEdgeTop % array(iEdge)+1 &
:block % mesh % maxLevelEdgeBot % array(iEdge), iEdge) = 0.0
- block % state % time_levs(1) % state % u % array( &
+ block % state % time_levs(1) % state % normalVelocity % array( &
block % mesh % maxLevelEdgeBot % array(iEdge)+1: &
block % mesh % nVertLevels,iEdge) = 0.0
-! mrp changed to 0
-! block % mesh % nVertLevels,iEdge) = -1e34
end do
do iCell=1,block % mesh % nCells
block % state % time_levs(1) % state % tracers % array( &
:, block % mesh % maxLevelCell % array(iCell)+1 &
:block % mesh % nVertLevels,iCell) = 0.0
-! mrp changed to 0
-! :block % mesh % nVertLevels,iCell) = -1e34
end do
do i=2,nTimeLevs
@@ -569,14 +546,14 @@
type (block_type), pointer :: block
integer :: iTracer, cell, cell1, cell2
- real (kind=RKIND) :: uhSum, hSum, hEdge1, zMidPBC
+ real (kind=RKIND) :: normalThicknessFluxSum, thicknessSum, hEdge1, zMidPBC
integer, dimension(:), pointer :: maxLevelCell
real (kind=RKIND), dimension(:), pointer :: refBottomDepth, &
refBottomDepthTopOfCell, vertCoordMovementWeights, hZLevel, bottomDepth
real (kind=RKIND), dimension(:), allocatable :: minBottomDepth, minBottomDepthMid, zMidZLevel
- real (kind=RKIND), dimension(:,:), pointer :: h
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
integer :: nVertLevels
logical :: consistentSSH
@@ -585,8 +562,8 @@
block => domain % blocklist
do while (associated(block))
- h => block % state % time_levs(1) % state % h % array
- tracers => block % state % time_levs(1) % state % tracers % array
+ layerThickness => block % state % time_levs(1) % state % layerThickness % array
+ tracers => block % state % time_levs(1) % state % tracers % array
refBottomDepth => block % mesh % refBottomDepth % array
refBottomDepthTopOfCell => block % mesh % refBottomDepthTopOfCell % array
bottomDepth => block % mesh % bottomDepth % array
@@ -598,11 +575,6 @@
nVertLevels = block % mesh % nVertLevels
num_tracers = size(tracers, dim=1)
- ! mrp 120208 right now hZLevel is in the grid.nc file.
- ! We would like to transition to using refBottomDepth
- ! as the defining variable instead, and will transition soon.
- ! When the transition is done, hZLevel can be removed from
- ! registry and the following four lines deleted.
refBottomDepth(1) = hZLevel(1)
do k = 2,nVertLevels
refBottomDepth(k) = refBottomDepth(k-1) + hZLevel(k)
@@ -642,7 +614,7 @@
if (config_alter_ICs_for_pbcs.eq.'zlevel_pbcs_on') then
write (0,'(a)') ' Altering bottomDepth to avoid very thin cells.'
- write (0,'(a)') ' Altering h and tracer initial conditions to conform with partial bottom cells.'
+ write (0,'(a)') ' Altering layerThickness and tracer initial conditions to conform with partial bottom cells.'
allocate(minBottomDepth(nVertLevels),minBottomDepthMid(nVertLevels),zMidZLevel(nVertLevels))
@@ -672,7 +644,7 @@
k = maxLevelCell(iCell)
! Alter thickness of bottom level to account for PBC
- h(k,iCell) = bottomDepth(iCell) - refBottomDepthTopOfCell(k)
+ layerThickness(k,iCell) = bottomDepth(iCell) - refBottomDepthTopOfCell(k)
! Linearly interpolate the initial T&S for new location of bottom cell for PBCs
zMidPBC = -0.5*(bottomDepth(iCell) + refBottomDepthTopOfCell(k))
@@ -710,19 +682,19 @@
consistentSSH = .true.
do iCell = 1,nCells
! Check if abs(ssh)>2m. If so, print warning.
- if (abs(sum(h(1:maxLevelCell(iCell),iCell))-bottomDepth(iCell))>2.0) then
+ if (abs(sum(layerThickness(1:maxLevelCell(iCell),iCell))-bottomDepth(iCell))>2.0) then
consistentSSH = .false.
#ifdef MPAS_DEBUG
- write (0,'(a)') ' Warning: abs(sum(h)-bottomDepth)>2m. Most likely, initial h does not match bottomDepth.'
+ write (0,'(a)') ' Warning: abs(sum(h)-bottomDepth)>2m. Most likely, initial layerThickness does not match bottomDepth.'
write (0,*) ' iCell, K=maxLevelCell(iCell), bottomDepth(iCell),sum(h),bottomDepth,hZLevel(K),h(K): ', &
- iCell, maxLevelCell(iCell), bottomDepth(iCell),sum(h(1:maxLevelCell(iCell),iCell)),bottomDepth(iCell), &
- hZLevel(maxLevelCell(iCell)), h(maxLevelCell(iCell),iCell)
+ iCell, maxLevelCell(iCell), bottomDepth(iCell),sum(layerThickness(1:maxLevelCell(iCell),iCell)),bottomDepth(iCell), &
+ hZLevel(maxLevelCell(iCell)), layerThickness(maxLevelCell(iCell),iCell)
#endif
endif
enddo
if (.not. consistentSSH) then
- write(0,*) 'Warning: SSH is not consistent. Most likely, initial h does not match bottomDepth.'
+ write(0,*) 'Warning: SSH is not consistent. Most likely, initial layerThickness does not match bottomDepth.'
end if
endif
@@ -761,33 +733,33 @@
type (block_type), pointer :: block
integer :: iTracer, cell, cell1, cell2
- real (kind=RKIND) :: uhSum, hSum, hEdge1
+ real (kind=RKIND) :: normalThicknessFluxSum, layerThicknessSum, layerThicknessEdge1
real (kind=RKIND), dimension(:), pointer :: refBottomDepth
- real (kind=RKIND), dimension(:,:), pointer :: h
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness
integer :: nVertLevels
! Initialize z-level grid variables from h, read in from input file.
block => domain % blocklist
do while (associated(block))
- h => block % state % time_levs(1) % state % h % array
+ layerThickness => block % state % time_levs(1) % state % layerThickness % array
refBottomDepth => block % mesh % refBottomDepth % array
nVertLevels = block % mesh % nVertLevels
! Compute barotropic velocity at first timestep
! This is only done upon start-up.
if (trim(config_time_integrator) == 'unsplit_explicit') then
- block % state % time_levs(1) % state % uBtr % array(:) = 0.0
+ block % state % time_levs(1) % state % normalBarotropicVelocity % array(:) = 0.0
- block % state % time_levs(1) % state % uBcl % array(:,:) &
- = block % state % time_levs(1) % state % u % array(:,:)
+ block % state % time_levs(1) % state % normalBaroclinicVelocity % array(:,:) &
+ = block % state % time_levs(1) % state % normalVelocity % array(:,:)
elseif (trim(config_time_integrator) == 'split_explicit') then
if (config_filter_btr_mode) then
do iCell=1,block % mesh % nCells
- block % state % time_levs(1) % state % h % array(1,iCell) &
+ block % state % time_levs(1) % state % layerThickness % array(1,iCell) &
= block % mesh % refBottomDepth % array(1)
enddo
endif
@@ -796,53 +768,53 @@
cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
- ! uBtr = sum(u)/sum(h) on each column
+ ! normalBarotropicVelocity = sum(u)/sum(h) on each column
! ocn_diagnostic_solve has not yet been called, so compute hEdge
! just for this edge.
- ! hSum is initialized outside the loop because on land boundaries
- ! maxLevelEdgeTop=0, but I want to initialize hSum with a
+ ! thicknessSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
! nonzero value to avoid a NaN.
- hEdge1 = 0.5*( &
- block % state % time_levs(1) % state % h % array(1,cell1) &
- + block % state % time_levs(1) % state % h % array(1,cell2) )
- uhSum = hEdge1*block % state % time_levs(1) % state % u % array(1,iEdge)
- hSum = hEdge1
+ layerThicknessEdge1 = 0.5*( &
+ block % state % time_levs(1) % state % layerThickness % array(1,cell1) &
+ + block % state % time_levs(1) % state % layerThickness % array(1,cell2) )
+ normalThicknessFluxSum = layerThicknessEdge1*block % state % time_levs(1) % state % normalVelocity % array(1,iEdge)
+ layerThicknessSum = layerThicknessEdge1
do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
! ocn_diagnostic_solve has not yet been called, so compute hEdge
! just for this edge.
- hEdge1 = 0.5*( &
- block % state % time_levs(1) % state % h % array(k,cell1) &
- + block % state % time_levs(1) % state % h % array(k,cell2) )
+ layerThicknessEdge1 = 0.5*( &
+ block % state % time_levs(1) % state % layerThickness % array(k,cell1) &
+ + block % state % time_levs(1) % state % layerThickness % array(k,cell2) )
- uhSum = uhSum &
- + hEdge1*block % state % time_levs(1) % state % u % array(k,iEdge)
- hSum = hSum + hEdge1
+ normalThicknessFluxSum = normalThicknessFluxSum &
+ + layerThicknessEdge1*block % state % time_levs(1) % state % normalVelocity % array(k,iEdge)
+ layerThicknessSum = layerThicknessSum + layerThicknessEdge1
enddo
- block % state % time_levs(1) % state % uBtr % array(iEdge) = uhSum/hsum
+ block % state % time_levs(1) % state % normalBarotropicVelocity % array(iEdge) = normalThicknessFluxSum/layerThicknessSum
- ! uBcl(k,iEdge) = u(k,iEdge) - uBtr(iEdge)
+ ! normalBaroclinicVelocity(k,iEdge) = normalVelocity(k,iEdge) - normalBarotropicVelocity(iEdge)
do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
- block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
- = block % state % time_levs(1) % state % u % array(k,iEdge) &
- - block % state % time_levs(1) % state % uBtr % array(iEdge)
+ block % state % time_levs(1) % state % normalBaroclinicVelocity % array(k,iEdge) &
+ = block % state % time_levs(1) % state % normalVelocity % array(k,iEdge) &
+ - block % state % time_levs(1) % state % normalBarotropicVelocity % array(iEdge)
enddo
- ! uBcl=0, u=0 on land cells
+ ! normalBaroclinicVelocity=0, normalVelocity=0 on land cells
do k=block % mesh % maxLevelEdgeTop % array(iEdge)+1, block % mesh % nVertLevels
- block % state % time_levs(1) % state % uBcl % array(k,iEdge) = 0.0
- block % state % time_levs(1) % state % u % array(k,iEdge) = 0.0
+ block % state % time_levs(1) % state % normalBaroclinicVelocity % array(k,iEdge) = 0.0
+ block % state % time_levs(1) % state % normalVelocity % array(k,iEdge) = 0.0
enddo
enddo
if (config_filter_btr_mode) then
- ! filter uBtr out of initial condition
- block % state % time_levs(1) % state % u % array(:,:) &
- = block % state % time_levs(1) % state % uBcl % array(:,:)
+ ! filter normalBarotropicVelocity out of initial condition
+ block % state % time_levs(1) % state % normalVelocity % array(:,:) &
+ = block % state % time_levs(1) % state % normalBaroclinicVelocity % array(:,:)
- block % state % time_levs(1) % state % uBtr % array(:) = 0.0
+ block % state % time_levs(1) % state % normalBarotropicVelocity % array(:) = 0.0
endif
endif
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_restoring.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_restoring.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_restoring.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -65,7 +65,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_restoring_tend(grid, h, indexT, indexS, tracers, tend, err)!{{{
+ subroutine ocn_restoring_tend(grid, layerThickness, indexT, indexS, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -74,7 +74,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness
+ layerThickness !< Input: thickness
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -127,8 +127,8 @@
k = 1 ! restoring only in top layer
do iCell=1,nCellsSolve
- tend(indexT, k, iCell) = tend(indexT, k, iCell) - h(k,iCell)*(tracers(indexT, k, iCell) - temperatureRestore(iCell)) * invTemp
- tend(indexS, k, iCell) = tend(indexS, k, iCell) - h(k,iCell)*(tracers(indexS, k, iCell) - salinityRestore(iCell)) * invSalinity
+ tend(indexT, k, iCell) = tend(indexT, k, iCell) - layerThickness(k,iCell)*(tracers(indexT, k, iCell) - temperatureRestore(iCell)) * invTemp
+ tend(indexS, k, iCell) = tend(indexS, k, iCell) - layerThickness(k,iCell)*(tracers(indexS, k, iCell) - salinityRestore(iCell)) * invSalinity
! write(6,10) iCell, tracers(indexT, k, iCell), &
! temperatureRestore(iCell), tracers(indexT, k, iCell), &
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tendency.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tendency.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tendency.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -31,8 +31,6 @@
use ocn_vel_forcing
use ocn_vmix
- use ocn_tracer_hadv
- use ocn_tracer_vadv
use ocn_tracer_hmix
use ocn_restoring
@@ -56,8 +54,8 @@
!
!--------------------------------------------------------------------
- public :: ocn_tend_h, &
- ocn_tend_u, &
+ public :: ocn_tend_thick, &
+ ocn_tend_vel, &
ocn_tend_tracer, &
ocn_tendency_init
@@ -73,7 +71,7 @@
!***********************************************************************
!
-! routine ocn_tend_h
+! routine ocn_tend_thick
!
!> \brief Computes thickness tendency
!> \author Doug Jacobsen
@@ -84,31 +82,31 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tend_h(tend, s, grid)!{{{
+ subroutine ocn_tend_thick(tend, s, grid)!{{{
implicit none
type (tend_type), intent(inout) :: tend !< Input/Output: Tendency structure
type (state_type), intent(in) :: s !< Input: State information
type (mesh_type), intent(in) :: grid !< Input: Grid information
- real (kind=RKIND), dimension(:,:), pointer :: h_edge, wTop, tend_h, uTransport
+ real (kind=RKIND), dimension(:,:), pointer :: layerThicknessEdge, vertTransportVelocityTop, tend_layerThickness, uTransport
integer :: err
- call mpas_timer_start("ocn_tend_h")
+ call mpas_timer_start("ocn_tend_thick")
uTransport => s % uTransport % array
- wTop => s % wTop % array
- h_edge => s % h_edge % array
+ vertTransportVelocityTop => s % vertTransportVelocityTop % array
+ layerThicknessEdge => s % layerThicknessEdge % array
- tend_h => tend % h % array
+ tend_layerThickness => tend % layerThickness % array
!
! height tendency: start accumulating tendency terms
!
- tend_h = 0.0
+ tend_layerThickness = 0.0
- if(config_disable_h_all_tend) return
+ if(config_disable_thick_all_tend) return
!
! height tendency: horizontal advection term -</font>
<font color="gray">abla\cdot ( hu)
@@ -119,23 +117,23 @@
! QC Comment (3/15/12): need to make sure that uTranport is the right
! transport velocity here.
call mpas_timer_start("hadv", .false., thickHadvTimer)
- call ocn_thick_hadv_tend(grid, uTransport, h_edge, tend_h, err)
+ call ocn_thick_hadv_tend(grid, uTransport, layerThicknessEdge, tend_layerThickness, err)
call mpas_timer_stop("hadv", thickHadvTimer)
!
! height tendency: vertical advection term -d/dz(hw)
!
call mpas_timer_start("vadv", .false., thickVadvTimer)
- call ocn_thick_vadv_tend(grid, wtop, tend_h, err)
+ call ocn_thick_vadv_tend(grid, vertTransportVelocityTop, tend_layerThickness, err)
call mpas_timer_stop("vadv", thickVadvTimer)
- call mpas_timer_stop("ocn_tend_h")
+ call mpas_timer_stop("ocn_tend_thick")
- end subroutine ocn_tend_h!}}}
+ end subroutine ocn_tend_thick!}}}
!***********************************************************************
!
-! routine ocn_tend_u
+! routine ocn_tend_vel
!
!> \brief Computes velocity tendency
!> \author Doug Jacobsen
@@ -146,7 +144,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tend_u(tend, s, d, grid)!{{{
+ subroutine ocn_tend_vel(tend, s, d, grid)!{{{
implicit none
type (tend_type), intent(inout) :: tend !< Input/Output: Tendency structure
@@ -155,56 +153,55 @@
type (mesh_type), intent(in) :: grid !< Input: Grid information
real (kind=RKIND), dimension(:,:), pointer :: &
- h_edge, h, u, rho, zMid, pressure, &
- tend_u, circulation, vorticity, viscosity, ke, ke_edge, Vor_edge, &
- MontPot, wTop, divergence, vertViscTopOfEdge
+ layerThicknessEdge, h, normalVelocity, density, zMid, pressure, &
+ tend_normalVelocity, circulation, relativeVorticity, viscosity, kineticEnergy, kineticEnergyEdge, potentialVorticityEdge, &
+ montgomeryPotential, vertTransportVelocityTop, divergence, vertViscTopOfEdge
- real (kind=RKIND), dimension(:,:), pointer :: u_src
+ real (kind=RKIND), dimension(:,:), pointer :: normalVelocityForcing
integer :: err
- call mpas_timer_start("ocn_tend_u")
+ call mpas_timer_start("ocn_tend_vel")
- u => s % u % array
- rho => s % rho % array
- wTop => s % wTop % array
+ normalVelocity => s % normalVelocity % array
+ density => s % density % array
+ vertTransportVelocityTop => s % vertTransportVelocityTop % array
zMid => s % zMid % array
- h_edge => s % h_edge % array
+ layerThicknessEdge => s % layerThicknessEdge % array
viscosity => s % viscosity % array
- vorticity => s % vorticity % array
+ relativeVorticity => s % relativeVorticity % array
divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- Vor_edge => s % Vor_edge % array
- MontPot => s % MontPot % array
+ kineticEnergy => s % kineticEnergy % array
+ kineticEnergyEdge => s % kineticEnergyEdge % array
+ potentialVorticityEdge => s % potentialVorticityEdge % array
+ montgomeryPotential => s % montgomeryPotential % array
pressure => s % pressure % array
vertViscTopOfEdge => d % vertViscTopOfEdge % array
- tend_u => tend % u % array
+ tend_normalVelocity => tend % normalVelocity % array
- u_src => grid % u_src % array
+ normalVelocityForcing => grid % normalVelocityForcing % array
!
! velocity tendency: start accumulating tendency terms
!
- ! mrp 110516 efficiency: could remove next line and have first tend_u operation not be additive
- tend_u(:,:) = 0.0
+ tend_normalVelocity(:,:) = 0.0
- if(config_disable_u_all_tend) return
+ if(config_disable_vel_all_tend) return
!
! velocity tendency: nonlinear Coriolis term and grad of kinetic energy
!
call mpas_timer_start("coriolis", .false., velCorTimer)
- call ocn_vel_coriolis_tend(grid, Vor_edge, h_edge, u, ke, tend_u, err)
+ call ocn_vel_coriolis_tend(grid, potentialVorticityEdge, layerThicknessEdge, normalVelocity, kineticEnergy, tend_normalVelocity, err)
call mpas_timer_stop("coriolis", velCorTimer)
!
! velocity tendency: vertical advection term -w du/dz
!
call mpas_timer_start("vadv", .false., velVadvTimer)
- call ocn_vel_vadv_tend(grid, u, h_edge, wtop, tend_u, err)
+ call ocn_vel_vadv_tend(grid, normalVelocity, layerThicknessEdge, vertTransportVelocityTop, tend_normalVelocity, err)
call mpas_timer_stop("vadv", velVadvTimer)
!
@@ -212,37 +209,35 @@
!
call mpas_timer_start("pressure grad", .false., velPgradTimer)
if (config_pressure_gradient_type.eq.'MontgomeryPotential') then
- call ocn_vel_pressure_grad_tend(grid, MontPot, zMid, rho, tend_u, err)
+ call ocn_vel_pressure_grad_tend(grid, montgomeryPotential, zMid, density, tend_normalVelocity, err)
else
- call ocn_vel_pressure_grad_tend(grid, pressure, zMid, rho, tend_u, err)
+ call ocn_vel_pressure_grad_tend(grid, pressure, zMid, density, tend_normalVelocity, err)
end if
call mpas_timer_stop("pressure grad", velPgradTimer)
!
! velocity tendency: del2 dissipation, </font>
<font color="black">u_2 </font>
<font color="red">abla^2 u
- ! computed as </font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity )
+ ! computed as </font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="gray">abla relativeVorticity )
! strictly only valid for config_mom_del2 == constant
!
call mpas_timer_start("hmix", .false., velHmixTimer)
- call ocn_vel_hmix_tend(grid, divergence, vorticity, viscosity, tend_u, err)
+ call ocn_vel_hmix_tend(grid, divergence, relativeVorticity, viscosity, tend_normalVelocity, err)
call mpas_timer_stop("hmix", velHmixTimer)
!
! velocity tendency: forcing and bottom drag
!
- ! mrp 101115 note: in order to include flux boundary conditions, we will need to
- ! know the bottom edge with nonzero velocity and place the drag there.
call mpas_timer_start("forcings", .false., velForceTimer)
- call ocn_vel_forcing_tend(grid, u, u_src, ke_edge, h_edge, tend_u, err)
+ call ocn_vel_forcing_tend(grid, normalVelocity, normalVelocityForcing, kineticEnergyEdge, layerThicknessEdge, tend_normalVelocity, err)
call mpas_timer_stop("forcings", velForceTimer)
!
! velocity tendency: vertical mixing d/dz( nu_v du/dz))
!
- call mpas_timer_stop("ocn_tend_u")
+ call mpas_timer_stop("ocn_tend_vel")
- end subroutine ocn_tend_u!}}}
+ end subroutine ocn_tend_vel!}}}
!***********************************************************************
!
@@ -266,7 +261,7 @@
real (kind=RKIND), intent(in) :: dt !< Input: Time step
real (kind=RKIND), dimension(:,:), pointer :: &
- uTransport, h,wTop, h_edge, vertDiffTopOfCell, tend_h, uh
+ uTransport, layerThickness,vertTransportVelocityTop, layerThicknessEdge, vertDiffTopOfCell, tend_layerThickness, normalThicknessFlux
real (kind=RKIND), dimension(:,:,:), pointer :: &
tracers, tend_tr
@@ -275,14 +270,14 @@
call mpas_timer_start("ocn_tend_tracer")
uTransport => s % uTransport % array
- h => s % h % array
- wTop => s % wTop % array
+ layerThickness => s % layerThickness % array
+ vertTransportVelocityTop => s % vertTransportVelocityTop % array
tracers => s % tracers % array
- h_edge => s % h_edge % array
+ layerThicknessEdge => s % layerThicknessEdge % array
vertDiffTopOfCell => d % vertDiffTopOfCell % array
tend_tr => tend % tracers % array
- tend_h => tend % h % array
+ tend_layerThickness => tend % layerThickness % array
!
! initialize tracer tendency (RHS of tracer equation) to zero.
@@ -291,62 +286,44 @@
if(config_disable_tr_all_tend) return
- allocate(uh(grid % nVertLevels, grid % nEdges+1))
+ allocate(normalThicknessFlux(grid % nVertLevels, grid % nEdges+1))
!
! QC Comment (3/15/12): need to make sure that uTransport is the right
! transport velocity for the tracer.
do iEdge = 1, grid % nEdges
do k = 1, grid % nVertLevels
- uh(k, iEdge) = uTransport(k, iEdge) * h_edge(k, iEdge)
+ normalThicknessFlux(k, iEdge) = uTransport(k, iEdge) * layerThicknessEdge(k, iEdge)
end do
end do
!
- ! tracer tendency: horizontal advection term -div( h \phi u)
+ ! tracer tendency: horizontal advection term -div( layerThickness \phi u)
!
- ! mrp 101115 note: in order to include flux boundary conditions, we will need to
- ! assign h_edge for maxLevelEdgeTop:maxLevelEdgeBot in the compute_solve_diagnostics
- ! and then change maxLevelEdgeTop to maxLevelEdgeBot in the following section.
- ! tracer_edge at the boundary will also need to be defined for flux boundaries.
! Monotonoic Advection, or standard advection
call mpas_timer_start("adv", .false., tracerHadvTimer)
- call mpas_ocn_tracer_advection_tend(tracers, uh, wTop, h, h, dt, grid, tend_h, tend_tr)
+ call mpas_ocn_tracer_advection_tend(tracers, normalThicknessFlux, vertTransportVelocityTop, layerThickness, layerThickness, dt, grid, tend_layerThickness, tend_tr)
call mpas_timer_stop("adv", tracerHadvTimer)
!
! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 </font>
<font color="gray">abla \phi)
!
call mpas_timer_start("hmix", .false., tracerHmixTimer)
- call ocn_tracer_hmix_tend(grid, h_edge, tracers, tend_tr, err)
+ call ocn_tracer_hmix_tend(grid, layerThicknessEdge, tracers, tend_tr, err)
call mpas_timer_stop("hmix", tracerHmixTimer)
-! mrp 110516 printing
-!print *, 'tend_tr 1',minval(tend_tr(3,1,1:nCells)),&
-! maxval(tend_tr(3,1,1:nCells))
-!print *, 'tracer 1',minval(tracers(3,1,1:nCells)),&
-! maxval(tracers(3,1,1:nCells))
-! mrp 110516 printing end
-
-
-! mrp 110516 printing
-!print *, 'tend_tr 2',minval(tend_tr(3,1,1:nCells)),&
-! maxval(tend_tr(3,1,1:nCells))
-! mrp 110516 printing end
-
!
! add restoring to T and S in top model layer
!
call mpas_timer_start("restoring", .false., tracerRestoringTimer)
- call ocn_restoring_tend(grid, h, s%index_temperature, s%index_salinity, tracers, tend_tr, err)
+ call ocn_restoring_tend(grid, layerThickness, s%index_temperature, s%index_salinity, tracers, tend_tr, err)
call mpas_timer_stop("restoring", tracerRestoringTimer)
- 10 format(2i8,10e20.10)
call mpas_timer_stop("ocn_tend_tracer")
- deallocate(uh)
+ deallocate(normalThicknessFlux)
end subroutine ocn_tend_tracer!}}}
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_thick_hadv.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_thick_hadv.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_thick_hadv.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -62,7 +62,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_thick_hadv_tend(grid, u, h_edge, tend, err)!{{{
+ subroutine ocn_thick_hadv_tend(grid, normalVelocity, layerThicknessEdge, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -71,10 +71,10 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
+ normalVelocity !< Input: velocity
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
+ layerThicknessEdge !< Input: thickness at edge
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -142,7 +142,7 @@
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
do k = 1, maxLevelEdgeBot(iEdge)
- flux = u(k, iEdge) * dvEdge(iEdge) * h_edge(k, iEdge)
+ flux = normalVelocity(k, iEdge) * dvEdge(iEdge) * layerThicknessEdge(k, iEdge)
tend(k, iCell) = tend(k, iCell) + edgeSignOnCell(i, iCell) * flux * invAreaCell
end do
end do
@@ -180,7 +180,7 @@
thickHadvOn = .true.
- if(config_disable_h_hadv) thickHadvOn = .false.
+ if(config_disable_thick_hadv) thickHadvOn = .false.
err = 0
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_thick_vadv.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_thick_vadv.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_thick_vadv.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -62,7 +62,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_thick_vadv_tend(grid, wTop, tend, err)!{{{
+ subroutine ocn_thick_vadv_tend(grid, vertTransportVelocityTop, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -71,7 +71,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical velocity on top layer
+ vertTransportVelocityTop !< Input: vertical velocity on top layer
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -121,7 +121,7 @@
do iCell=1,nCells
do k=1,maxLevelCell(iCell)
- tend(k,iCell) = tend(k,iCell) + wTop(k+1,iCell) - wTop(k,iCell)
+ tend(k,iCell) = tend(k,iCell) + vertTransportVelocityTop(k+1,iCell) - vertTransportVelocityTop(k,iCell)
end do
end do
@@ -157,7 +157,7 @@
thickVadvOn = .true.
- if(config_disable_h_vadv) thickVadvOn = .false.
+ if(config_disable_thick_vadv) thickVadvOn = .false.
err = 0
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_average.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_average.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_average.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -11,35 +11,35 @@
subroutine ocn_time_average_init(state)!{{{
type (state_type), intent(inout) :: state
- real (kind=RKIND), pointer :: nAccumulate
+ real (kind=RKIND), pointer :: nAverage
- real (kind=RKIND), dimension(:), pointer :: acc_ssh, acc_sshVar
- real (kind=RKIND), dimension(:,:), pointer :: acc_uReconstructZonal, acc_uReconstructMeridional, acc_uReconstructZonalVar, acc_uReconstructMeridionalVar
- real (kind=RKIND), dimension(:,:), pointer :: acc_u, acc_uVar, acc_vertVelocityTop
+ real (kind=RKIND), dimension(:), pointer :: avgSSH, varSSH
+ real (kind=RKIND), dimension(:,:), pointer :: avgnormalVelocityZonal, avgnormalVelocityMeridional, varnormalVelocityZonal, varnormalVelocityMeridional
+ real (kind=RKIND), dimension(:,:), pointer :: avgNormalVelocity, varNormalVelocity, avgVertVelocityTop
- nAccumulate => state % nAccumulate % scalar
+ nAverage => state % nAverage % scalar
- acc_ssh => state % acc_ssh % array
- acc_sshVar => state % acc_sshVar % array
- acc_uReconstructZonal => state % acc_uReconstructZonal % array
- acc_uReconstructMeridional => state % acc_uReconstructMeridional % array
- acc_uReconstructZonalVar => state % acc_uReconstructZonalVar % array
- acc_uReconstructMeridionalVar => state % acc_uReconstructMeridionalVar % array
- acc_u => state % acc_u % array
- acc_uVar => state % acc_uVar % array
- acc_vertVelocityTop => state % acc_vertVelocityTop % array
+ avgSSH => state % avgSSH % array
+ varSSH => state % varSSH % array
+ avgnormalVelocityZonal => state % avgnormalVelocityZonal % array
+ avgnormalVelocityMeridional => state % avgnormalVelocityMeridional % array
+ varnormalVelocityZonal => state % varnormalVelocityZonal % array
+ varnormalVelocityMeridional => state % varnormalVelocityMeridional % array
+ avgNormalVelocity => state % avgNormalVelocity % array
+ varNormalVelocity => state % varNormalVelocity % array
+ avgVertVelocityTop => state % avgVertVelocityTop % array
- nAccumulate = 0
+ nAverage = 0
- acc_ssh = 0.0
- acc_sshVar = 0.0
- acc_uReconstructZonal = 0.0
- acc_uReconstructMeridional = 0.0
- acc_uReconstructZonalVar = 0.0
- acc_uReconstructMeridionalVar = 0.0
- acc_u = 0.0
- acc_uVar = 0.0
- acc_vertVelocityTop = 0.0
+ avgSSH = 0.0
+ varSSH = 0.0
+ avgnormalVelocityZonal = 0.0
+ avgnormalVelocityMeridional = 0.0
+ varnormalVelocityZonal = 0.0
+ varnormalVelocityMeridional = 0.0
+ avgNormalVelocity = 0.0
+ varNormalVelocity = 0.0
+ avgVertVelocityTop = 0.0
end subroutine ocn_time_average_init!}}}
@@ -47,92 +47,92 @@
type (state_type), intent(inout) :: state
type (state_type), intent(in) :: old_state
- real (kind=RKIND), pointer :: nAccumulate, old_nAccumulate
+ real (kind=RKIND), pointer :: nAverage, old_nAverage
real (kind=RKIND), dimension(:), pointer :: ssh
- real (kind=RKIND), dimension(:,:), pointer :: uReconstructZonal, uReconstructMeridional, u, vertVelocityTop
+ real (kind=RKIND), dimension(:,:), pointer :: normalVelocityZonal, normalVelocityMeridional, normalVelocity, vertVelocityTop
- real (kind=RKIND), dimension(:,:), pointer :: acc_u, acc_uVar, acc_vertVelocityTop
- real (kind=RKIND), dimension(:,:), pointer :: acc_uReconstructZonal, acc_uReconstructMeridional, acc_uReconstructZonalVar, acc_uReconstructMeridionalVar
- real (kind=RKIND), dimension(:), pointer :: acc_ssh, acc_sshVar
+ real (kind=RKIND), dimension(:,:), pointer :: avgNormalVelocity, varNormalVelocity, avgVertVelocityTop
+ real (kind=RKIND), dimension(:,:), pointer :: avgnormalVelocityZonal, avgnormalVelocityMeridional, varnormalVelocityZonal, varnormalVelocityMeridional
+ real (kind=RKIND), dimension(:), pointer :: avgSSH, varSSH
- real (kind=RKIND), dimension(:,:), pointer :: old_acc_u, old_acc_uVar, old_acc_vertVelocityTop
- real (kind=RKIND), dimension(:,:), pointer :: old_acc_uReconstructZonal, old_acc_uReconstructMeridional, old_acc_uReconstructZonalVar, old_acc_uReconstructMeridionalVar
- real (kind=RKIND), dimension(:), pointer :: old_acc_ssh, old_acc_sshVar
+ real (kind=RKIND), dimension(:,:), pointer :: old_avgNormalVelocity, old_varNormalVelocity, old_avgVertVelocityTop
+ real (kind=RKIND), dimension(:,:), pointer :: old_avgnormalVelocityZonal, old_avgnormalVelocityMeridional, old_varnormalVelocityZonal, old_varnormalVelocityMeridional
+ real (kind=RKIND), dimension(:), pointer :: old_avgSSH, old_varSSH
- old_nAccumulate => old_state % nAccumulate % scalar
- nAccumulate => state % nAccumulate % scalar
+ old_nAverage => old_state % nAverage % scalar
+ nAverage => state % nAverage % scalar
ssh => state % ssh % array
- uReconstructZonal => state % uReconstructZonal % array
- uReconstructMeridional => state % uReconstructMeridional % array
- u => state % u % array
+ normalVelocityZonal => state % normalVelocityZonal % array
+ normalVelocityMeridional => state % normalVelocityMeridional % array
+ normalVelocity => state % normalVelocity % array
vertVelocityTop => state % vertVelocityTop % array
- acc_ssh => state % acc_ssh % array
- acc_sshVar => state % acc_sshVar % array
- acc_uReconstructZonal => state % acc_uReconstructZonal % array
- acc_uReconstructMeridional => state % acc_uReconstructMeridional % array
- acc_uReconstructZonalVar => state % acc_uReconstructZonalVar % array
- acc_uReconstructMeridionalVar => state % acc_uReconstructMeridionalVar % array
- acc_u => state % acc_u % array
- acc_uVar => state % acc_uVar % array
- acc_vertVelocityTop => state % acc_vertVelocityTop % array
+ avgSSH => state % avgSSH % array
+ varSSH => state % varSSH % array
+ avgnormalVelocityZonal => state % avgnormalVelocityZonal % array
+ avgnormalVelocityMeridional => state % avgnormalVelocityMeridional % array
+ varnormalVelocityZonal => state % varnormalVelocityZonal % array
+ varnormalVelocityMeridional => state % varnormalVelocityMeridional % array
+ avgNormalVelocity => state % avgNormalVelocity % array
+ varNormalVelocity => state % varNormalVelocity % array
+ avgVertVelocityTop => state % avgVertVelocityTop % array
- old_acc_ssh => old_state % acc_ssh % array
- old_acc_sshVar => old_state % acc_sshVar % array
- old_acc_uReconstructZonal => old_state % acc_uReconstructZonal % array
- old_acc_uReconstructMeridional => old_state % acc_uReconstructMeridional % array
- old_acc_uReconstructZonalVar => old_state % acc_uReconstructZonalVar % array
- old_acc_uReconstructMeridionalVar => old_state % acc_uReconstructMeridionalVar % array
- old_acc_u => old_state % acc_u % array
- old_acc_uVar => old_state % acc_uVar % array
- old_acc_vertVelocityTop => old_state % acc_vertVelocityTop % array
+ old_avgSSH => old_state % avgSSH % array
+ old_varSSH => old_state % varSSH % array
+ old_avgnormalVelocityZonal => old_state % avgnormalVelocityZonal % array
+ old_avgnormalVelocityMeridional => old_state % avgnormalVelocityMeridional % array
+ old_varnormalVelocityZonal => old_state % varnormalVelocityZonal % array
+ old_varnormalVelocityMeridional => old_state % varnormalVelocityMeridional % array
+ old_avgNormalVelocity => old_state % avgNormalVelocity % array
+ old_varNormalVelocity => old_state % varNormalVelocity % array
+ old_avgVertVelocityTop => old_state % avgVertVelocityTop % array
- acc_ssh = old_acc_ssh + ssh
- acc_sshVar = old_acc_sshVar + ssh**2
- acc_uReconstructZonal = old_acc_uReconstructZonal + uReconstructZonal
- acc_uReconstructMeridional = old_acc_uReconstructMeridional + uReconstructMeridional
- acc_uReconstructZonalVar = old_acc_uReconstructZonalVar + uReconstructZonal**2
- acc_uReconstructMeridionalVar = old_acc_uReconstructMeridionalVar + uReconstructMeridional**2
- acc_u = old_acc_u + u
- acc_uVar = old_acc_uVar + u**2
- acc_vertVelocityTop = old_acc_vertVelocityTop + vertVelocityTop
+ avgSSH = old_avgSSH + ssh
+ varSSH = old_varSSH + ssh**2
+ avgnormalVelocityZonal = old_avgnormalVelocityZonal + normalVelocityZonal
+ avgnormalVelocityMeridional = old_avgnormalVelocityMeridional + normalVelocityMeridional
+ varnormalVelocityZonal = old_varnormalVelocityZonal + normalVelocityZonal**2
+ varnormalVelocityMeridional = old_varnormalVelocityMeridional + normalVelocityMeridional**2
+ avgNormalVelocity = old_avgNormalVelocity + normalVelocity
+ varNormalVelocity = old_varNormalVelocity + normalVelocity**2
+ avgVertVelocityTop = old_avgVertVelocityTop + vertVelocityTop
- nAccumulate = old_nAccumulate + 1
+ nAverage = old_nAverage + 1
end subroutine ocn_time_average_accumulate!}}}
subroutine ocn_time_average_normalize(state)!{{{
type (state_type), intent(inout) :: state
- real (kind=RKIND), pointer :: nAccumulate
+ real (kind=RKIND), pointer :: nAverage
- real (kind=RKIND), dimension(:), pointer :: acc_ssh, acc_sshVar
- real (kind=RKIND), dimension(:,:), pointer :: acc_uReconstructZonal, acc_uReconstructMeridional, acc_uReconstructZonalVar, acc_uReconstructMeridionalVar
- real (kind=RKIND), dimension(:,:), pointer :: acc_u, acc_uVar, acc_vertVelocityTop
+ real (kind=RKIND), dimension(:), pointer :: avgSSH, varSSH
+ real (kind=RKIND), dimension(:,:), pointer :: avgnormalVelocityZonal, avgnormalVelocityMeridional, varnormalVelocityZonal, varnormalVelocityMeridional
+ real (kind=RKIND), dimension(:,:), pointer :: avgNormalVelocity, varNormalVelocity, avgVertVelocityTop
- nAccumulate => state % nAccumulate % scalar
+ nAverage => state % nAverage % scalar
- acc_ssh => state % acc_ssh % array
- acc_sshVar => state % acc_sshVar % array
- acc_uReconstructZonal => state % acc_uReconstructZonal % array
- acc_uReconstructMeridional => state % acc_uReconstructMeridional % array
- acc_uReconstructZonalVar => state % acc_uReconstructZonalVar % array
- acc_uReconstructMeridionalVar => state % acc_uReconstructMeridionalVar % array
- acc_u => state % acc_u % array
- acc_uVar => state % acc_uVar % array
- acc_vertVelocityTop => state % acc_vertVelocityTop % array
+ avgSSH => state % avgSSH % array
+ varSSH => state % varSSH % array
+ avgnormalVelocityZonal => state % avgnormalVelocityZonal % array
+ avgnormalVelocityMeridional => state % avgnormalVelocityMeridional % array
+ varnormalVelocityZonal => state % varnormalVelocityZonal % array
+ varnormalVelocityMeridional => state % varnormalVelocityMeridional % array
+ avgNormalVelocity => state % avgNormalVelocity % array
+ varNormalVelocity => state % varNormalVelocity % array
+ avgVertVelocityTop => state % avgVertVelocityTop % array
- if(nAccumulate > 0) then
- acc_ssh = acc_ssh / nAccumulate
- acc_sshVar = acc_sshVar / nAccumulate
- acc_uReconstructZonal = acc_uReconstructZonal / nAccumulate
- acc_uReconstructMeridional = acc_uReconstructMeridional / nAccumulate
- acc_uReconstructZonalVar = acc_uReconstructZonalVar / nAccumulate
- acc_uReconstructMeridionalVar = acc_uReconstructMeridionalVar / nAccumulate
- acc_u = acc_u / nAccumulate
- acc_uVar = acc_uVar / nAccumulate
- acc_vertVelocityTop = acc_vertVelocityTop / nAccumulate
+ if(nAverage > 0) then
+ avgSSH = avgSSH / nAverage
+ varSSH = varSSH / nAverage
+ avgnormalVelocityZonal = avgnormalVelocityZonal / nAverage
+ avgnormalVelocityMeridional = avgnormalVelocityMeridional / nAverage
+ varnormalVelocityZonal = varnormalVelocityZonal / nAverage
+ varnormalVelocityMeridional = varnormalVelocityMeridional / nAverage
+ avgNormalVelocity = avgNormalVelocity / nAverage
+ varNormalVelocity = varNormalVelocity / nAverage
+ avgVertVelocityTop = avgVertVelocityTop / nAverage
end if
end subroutine ocn_time_average_normalize!}}}
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_integration.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_integration.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_integration.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -100,7 +100,7 @@
do while (associated(block))
block % state % time_levs(2) % state % xtime % scalar = timeStamp
- nanCheck = sum(block % state % time_levs(2) % state % u % array)
+ nanCheck = sum(block % state % time_levs(2) % state % normalVelocity % array)
if (nanCheck /= nanCheck) then
write(0,*) 'Abort: NaN detected'
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_integration_rk4.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_integration_rk4.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_integration_rk4.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -87,7 +87,7 @@
integer :: nCells, nEdges, nVertLevels, num_tracers
real (kind=RKIND) :: coef
real (kind=RKIND), dimension(:,:), pointer :: &
- u, h, h_edge, vertViscTopOfEdge, vertDiffTopOfCell, ke_edge
+ u, layerThickness, layerThicknessEdge, vertViscTopOfEdge, vertDiffTopOfCell, kineticEnergyEdge
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
integer, dimension(:), pointer :: &
maxLevelCell, maxLevelEdgeTop
@@ -99,17 +99,17 @@
!
! Initialize time_levs(2) with state at current time
! Initialize first RK state
- ! Couple tracers time_levs(2) with h in time-levels
+ ! Couple tracers time_levs(2) with layerThickness in time-levels
! Initialize RK weights
!
block => domain % blocklist
do while (associated(block))
- block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
- block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
+ block % state % time_levs(2) % state % normalVelocity % array(:,:) = block % state % time_levs(1) % state % normalVelocity % array(:,:)
+ block % state % time_levs(2) % state % layerThickness % array(:,:) = block % state % time_levs(1) % state % layerThickness % array(:,:)
do iCell=1,block % mesh % nCells ! couple tracers to h
do k=1,block % mesh % maxLevelCell % array(iCell)
block % state % time_levs(2) % state % tracers % array(:,k,iCell) = block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
- * block % state % time_levs(1) % state % h % array(k,iCell)
+ * block % state % time_levs(1) % state % layerThickness % array(k,iCell)
end do
end do
@@ -137,10 +137,10 @@
! --- update halos for diagnostic variables
call mpas_timer_start("RK4-diagnostic halo update")
- call mpas_dmpar_exch_halo_field(domain % blocklist % provis % Vor_edge)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % provis % potentialVorticityEdge)
if (config_mom_del4 > 0.0) then
call mpas_dmpar_exch_halo_field(domain % blocklist % provis % divergence)
- call mpas_dmpar_exch_halo_field(domain % blocklist % provis % vorticity)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % provis % relativeVorticity)
end if
call mpas_timer_stop("RK4-diagnostic halo update")
@@ -149,17 +149,17 @@
call mpas_timer_start("RK4-tendency computations")
block => domain % blocklist
do while (associated(block))
- ! advection of u uses u, while advection of h and tracers use uTransport.
- call ocn_wtop(block % mesh, block % provis % h % array, block % provis % h_edge % array, &
- block % provis % u % array, block % provis % wTop % array, err)
- call ocn_tend_u(block % tend, block % provis, block % diagnostics, block % mesh)
+ ! advection of u uses u, while advection of layerThickness and tracers use uTransport.
+ call ocn_vert_transport_velocity_top(block % mesh, block % provis % layerThickness % array, block % provis % layerThicknessEdge % array, &
+ block % provis % normalVelocity % array, block % provis % vertTransportVelocityTop % array, err)
+ call ocn_tend_vel(block % tend, block % provis, block % diagnostics, block % mesh)
- call ocn_wtop(block % mesh, block % provis % h % array, block % provis % h_edge % array, &
- block % provis % uTransport % array, block % provis % wTop % array, err)
- call ocn_tend_h(block % tend, block % provis, block % mesh)
+ call ocn_vert_transport_velocity_top(block % mesh, block % provis % layerThickness % array, block % provis % layerThicknessEdge % array, &
+ block % provis % uTransport % array, block % provis % vertTransportVelocityTop % array, err)
+ call ocn_tend_thick(block % tend, block % provis, block % mesh)
if (config_filter_btr_mode) then
- call ocn_filter_btr_mode_tend_u(block % tend, block % provis, block % mesh)
+ call ocn_filter_btr_mode_tend_vel(block % tend, block % provis, block % mesh)
endif
call ocn_tend_tracer(block % tend, block % provis, block % diagnostics, block % mesh, dt)
@@ -170,8 +170,8 @@
! --- update halos for prognostic variables
call mpas_timer_start("RK4-pronostic halo update")
- call mpas_dmpar_exch_halo_field(domain % blocklist % tend % u)
- call mpas_dmpar_exch_halo_field(domain % blocklist % tend % h)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % normalVelocity)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % layerThickness)
call mpas_dmpar_exch_halo_field(domain % blocklist % tend % tracers)
call mpas_timer_stop("RK4-pronostic halo update")
@@ -182,33 +182,33 @@
block => domain % blocklist
do while (associated(block))
- block % provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:) &
- + rk_substep_weights(rk_step) * block % tend % u % array(:,:)
+ block % provis % normalVelocity % array(:,:) = block % state % time_levs(1) % state % normalVelocity % array(:,:) &
+ + rk_substep_weights(rk_step) * block % tend % normalVelocity % array(:,:)
- block % provis % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:) &
- + rk_substep_weights(rk_step) * block % tend % h % array(:,:)
+ block % provis % layerThickness % array(:,:) = block % state % time_levs(1) % state % layerThickness % array(:,:) &
+ + rk_substep_weights(rk_step) * block % tend % layerThickness % array(:,:)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % maxLevelCell % array(iCell)
- block % provis % tracers % array(:,k,iCell) = ( block % state % time_levs(1) % state % h % array(k,iCell) * &
+ block % provis % tracers % array(:,k,iCell) = ( block % state % time_levs(1) % state % layerThickness % array(k,iCell) * &
block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
+ rk_substep_weights(rk_step) * block % tend % tracers % array(:,k,iCell) &
- ) / block % provis % h % array(k,iCell)
+ ) / block % provis % layerThickness % array(k,iCell)
end do
end do
if (config_prescribe_velocity) then
- block % provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ block % provis % normalVelocity % array(:,:) = block % state % time_levs(1) % state % normalVelocity % array(:,:)
end if
if (config_prescribe_thickness) then
- block % provis % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
+ block % provis % layerThickness % array(:,:) = block % state % time_levs(1) % state % layerThickness % array(:,:)
end if
call ocn_diagnostic_solve(dt, block % provis, block % mesh)
- ! Compute velocity transport, used in advection terms of h and tracer tendency
+ ! Compute velocity transport, used in advection terms of layerThickness and tracer tendency
block % provis % uTransport % array(:,:) &
- = block % provis % u % array(:,:) &
+ = block % provis % normalVelocity % array(:,:) &
+ block % provis % uBolusGM % array(:,:)
block => block % next
@@ -221,11 +221,11 @@
call mpas_timer_start("RK4-RK4 accumulate update")
block => domain % blocklist
do while (associated(block))
- block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &
- + rk_weights(rk_step) * block % tend % u % array(:,:)
+ block % state % time_levs(2) % state % normalVelocity % array(:,:) = block % state % time_levs(2) % state % normalVelocity % array(:,:) &
+ + rk_weights(rk_step) * block % tend % normalVelocity % array(:,:)
- block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &
- + rk_weights(rk_step) * block % tend % h % array(:,:)
+ block % state % time_levs(2) % state % layerThickness % array(:,:) = block % state % time_levs(2) % state % layerThickness % array(:,:) &
+ + rk_weights(rk_step) * block % tend % layerThickness % array(:,:)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % maxLevelCell % array(iCell)
@@ -256,7 +256,7 @@
do iCell = 1, block % mesh % nCells
do k = 1, block % mesh % maxLevelCell % array(iCell)
block % state % time_levs(2) % state % tracers % array(:, k, iCell) = block % state % time_levs(2) % state % tracers % array(:, k, iCell) &
- / block % state % time_levs(2) % state % h % array(k, iCell)
+ / block % state % time_levs(2) % state % layerThickness % array(k, iCell)
end do
end do
block => block % next
@@ -268,10 +268,10 @@
! Call ocean diagnostic solve in preparation for vertical mixing. Note
! it is called again after vertical mixing, because u and tracers change.
- ! For Richardson vertical mixing, only rho, h_edge, and ke_edge need to
+ ! For Richardson vertical mixing, only density, layerThicknessEdge, and kineticEnergyEdge need to
! be computed. For kpp, more variables may be needed. Either way, this
! could be made more efficient by only computing what is needed for the
- ! implicit vmix routine that follows. mrp 121023.
+ ! implicit vmix routine that follows.
call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
call ocn_vmix_implicit(dt, block % mesh, block % diagnostics, block % state % time_levs(2) % state, err)
@@ -283,7 +283,7 @@
! conducted on tendencies, not on the velocity and tracer fields. So this update is required to
! communicate the change due to implicit vertical mixing across the boundary.
call mpas_timer_start("RK4-implicit vert mix halos")
- call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % u)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % normalVelocity)
call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % tracers)
call mpas_timer_stop("RK4-implicit vert mix halos")
@@ -292,37 +292,35 @@
block => domain % blocklist
do while (associated(block))
if (config_prescribe_velocity) then
- block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ block % state % time_levs(2) % state % normalVelocity % array(:,:) = block % state % time_levs(1) % state % normalVelocity % array(:,:)
end if
if (config_prescribe_thickness) then
- block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
+ block % state % time_levs(2) % state % layerThickness % array(:,:) = block % state % time_levs(1) % state % layerThickness % array(:,:)
end if
call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
- ! Compute velocity transport, used in advection terms of h and tracer tendency
+ ! Compute velocity transport, used in advection terms of layerThickness and tracer tendency
block % state % time_levs(2) % state % uTransport % array(:,:) &
- = block % state % time_levs(2) % state % u % array(:,:) &
+ = block % state % time_levs(2) % state % normalVelocity % array(:,:) &
+ block % state % time_levs(2) % state % uBolusGM % array(:,:)
- call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array, &
- block % state % time_levs(2) % state % uReconstructX % array, &
- block % state % time_levs(2) % state % uReconstructY % array, &
- block % state % time_levs(2) % state % uReconstructZ % array, &
- block % state % time_levs(2) % state % uReconstructZonal % array, &
- block % state % time_levs(2) % state % uReconstructMeridional % array &
+ call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % normalVelocity % array, &
+ block % state % time_levs(2) % state % normalVelocityX % array, &
+ block % state % time_levs(2) % state % normalVelocityY % array, &
+ block % state % time_levs(2) % state % normalVelocityZ % array, &
+ block % state % time_levs(2) % state % normalVelocityZonal % array, &
+ block % state % time_levs(2) % state % normalVelocityMeridional % array &
)
-!TDR
- call mpas_reconstruct(block % mesh, block % mesh % u_src % array, &
- block % state % time_levs(2) % state % uSrcReconstructX % array, &
- block % state % time_levs(2) % state % uSrcReconstructY % array, &
- block % state % time_levs(2) % state % uSrcReconstructZ % array, &
- block % state % time_levs(2) % state % uSrcReconstructZonal % array, &
- block % state % time_levs(2) % state % uSrcReconstructMeridional % array &
+ call mpas_reconstruct(block % mesh, block % mesh % normalVelocityForcing % array, &
+ block % state % time_levs(2) % state % normalVelocityForcingReconstructX % array, &
+ block % state % time_levs(2) % state % normalVelocityForcingReconstructY % array, &
+ block % state % time_levs(2) % state % normalVelocityForcingReconstructZ % array, &
+ block % state % time_levs(2) % state % normalVelocityForcingReconstructZonal % array, &
+ block % state % time_levs(2) % state % normalVelocityForcingReconstructMeridional % array &
)
-!TDR
call ocn_time_average_accumulate(block % state % time_levs(2) % state, block % state % time_levs(1) % state)
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_integration_split.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_integration_split.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_time_integration_split.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -49,8 +49,8 @@
public :: ocn_time_integrator_split
type (timer_node), pointer :: timer_main, timer_prep, timer_bcl_vel, timer_btr_vel, timer_diagnostic_update, timer_implicit_vmix, &
- timer_halo_diagnostic, timer_halo_ubtr, timer_halo_ssh, timer_halo_f, timer_halo_h, &
- timer_halo_tracers, timer_halo_ubcl
+ timer_halo_diagnostic, timer_halo_normalBarotropicVelocity, timer_halo_ssh, timer_halo_f, timer_halo_thickness, &
+ timer_halo_tracers, timer_halo_normalBaroclinicVelocity
contains
@@ -89,11 +89,11 @@
eoe, oldBtrSubcycleTime, newBtrSubcycleTime, uPerpTime, BtrCorIter, &
n_bcl_iter(config_n_ts_iter), stage1_tend_time
type (block_type), pointer :: block
- real (kind=RKIND) :: uhSum, hSum, flux, sshEdge, hEdge1, &
- CoriolisTerm, uCorr, temp, temp_h, coef, FBtr_coeff, sshCell1, sshCell2
+ real (kind=RKIND) :: normalThicknessFluxSum, thicknessSum, flux, sshEdge, hEdge1, &
+ CoriolisTerm, uCorr, temp, temp_h, coef, barotropicThicknessFlux_coeff, sshCell1, sshCell2
integer :: num_tracers, ucorr_coef, err
real (kind=RKIND), dimension(:,:), pointer :: &
- u, h, h_edge, ke_edge, vertViscTopOfEdge, vertDiffTopOfCell
+ u, h, layerThicknessEdge, kineticEnergyEdge, vertViscTopOfEdge, vertDiffTopOfCell
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
integer, dimension(:), pointer :: &
maxLevelCell, maxLevelEdgeTop
@@ -117,22 +117,22 @@
! The baroclinic velocity needs be recomputed at the beginning of a
! timestep because the implicit vertical mixing is conducted on the
- ! total u. We keep uBtr from the previous timestep.
- ! Note that uBcl may now include a barotropic component, because the
- ! weights h have changed. That is OK, because the GBtrForcing variable
+ ! total u. We keep normalBarotropicVelocity from the previous timestep.
+ ! Note that normalBaroclinicVelocity may now include a barotropic component, because the
+ ! weights layerThickness have changed. That is OK, because the barotropicForcing variable
! subtracts out the barotropic component from the baroclinic.
- block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
- = block % state % time_levs(1) % state % u % array(k,iEdge) &
- - block % state % time_levs(1) % state % uBtr % array( iEdge)
+ block % state % time_levs(1) % state % normalBaroclinicVelocity % array(k,iEdge) &
+ = block % state % time_levs(1) % state % normalVelocity % array(k,iEdge) &
+ - block % state % time_levs(1) % state % normalBarotropicVelocity % array( iEdge)
- block % state % time_levs(2) % state % u % array(k,iEdge) &
- = block % state % time_levs(1) % state % u % array(k,iEdge)
+ block % state % time_levs(2) % state % normalVelocity % array(k,iEdge) &
+ = block % state % time_levs(1) % state % normalVelocity % array(k,iEdge)
- block % state % time_levs(2) % state % uBcl % array(k,iEdge) &
- = block % state % time_levs(1) % state % uBcl % array(k,iEdge)
+ block % state % time_levs(2) % state % normalBaroclinicVelocity % array(k,iEdge) &
+ = block % state % time_levs(1) % state % normalBaroclinicVelocity % array(k,iEdge)
- block % state % time_levs(2) % state % h_edge % array(k,iEdge) &
- = block % state % time_levs(1) % state % h_edge % array(k,iEdge)
+ block % state % time_levs(2) % state % layerThicknessEdge % array(k,iEdge) &
+ = block % state % time_levs(1) % state % layerThicknessEdge % array(k,iEdge)
end do
end do
@@ -143,8 +143,8 @@
do iCell=1,block % mesh % nCells
do k=1,block % mesh % maxLevelCell % array(iCell)
- block % state % time_levs(2) % state % h % array(k,iCell) &
- = block % state % time_levs(1) % state % h % array(k,iCell)
+ block % state % time_levs(2) % state % layerThickness % array(k,iCell) &
+ = block % state % time_levs(1) % state % layerThickness % array(k,iCell)
block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
= block % state % time_levs(1) % state % tracers % array(:,k,iCell)
@@ -167,10 +167,10 @@
! --- update halos for diagnostic variables
call mpas_timer_start("se halo diag", .false., timer_halo_diagnostic)
- call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % Vor_edge)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % potentialVorticityEdge)
if (config_mom_del4 > 0.0) then
call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % divergence)
- call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % vorticity)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % relativeVorticity)
end if
call mpas_timer_stop("se halo diag", timer_halo_diagnostic)
@@ -188,14 +188,14 @@
stage1_tend_time = min(split_explicit_step,2)
- ! compute wTop. Use u (rather than uTransport) for momentum advection.
+ ! compute vertTransportVelocityTop. Use u (rather than uTransport) for momentum advection.
! Use the most recent time level available.
- call ocn_wtop(block % mesh, block % state % time_levs(stage1_tend_time) % state % h % array, &
- block % state % time_levs(stage1_tend_time) % state % h_edge % array, &
- block % state % time_levs(stage1_tend_time) % state % u % array, &
- block % state % time_levs(stage1_tend_time) % state % wTop % array, err)
+ call ocn_vert_transport_velocity_top(block % mesh, block % state % time_levs(stage1_tend_time) % state % layerThickness % array, &
+ block % state % time_levs(stage1_tend_time) % state % layerThicknessEdge % array, &
+ block % state % time_levs(stage1_tend_time) % state % normalVelocity % array, &
+ block % state % time_levs(stage1_tend_time) % state % vertTransportVelocityTop % array, err)
- call ocn_tend_u(block % tend, block % state % time_levs(stage1_tend_time) % state, block % diagnostics, block % mesh)
+ call ocn_tend_vel(block % tend, block % state % time_levs(stage1_tend_time) % state, block % diagnostics, block % mesh)
block => block % next
end do
@@ -216,7 +216,7 @@
do while (associated(block))
allocate(uTemp(block % mesh % nVertLevels))
- ! Put f*uBcl^{perp} in uNew as a work variable
+ ! Put f*normalBaroclinicVelocity^{perp} in uNew as a work variable
call ocn_fuperp(block % state % time_levs(2) % state , block % mesh)
do iEdge=1,block % mesh % nEdges
@@ -226,38 +226,38 @@
uTemp = 0.0 ! could put this after with uTemp(maxleveledgetop+1:nvertlevels)=0
do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
- ! uBclNew = uBclOld + dt*(-f*uBclPerp + T(u*,w*,p*) + g*grad(SSH*) )
- ! Here uNew is a work variable containing -fEdge(iEdge)*uBclPerp(k,iEdge)
- uTemp(k) = block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
- + dt * (block % tend % u % array (k,iEdge) &
- + block % state % time_levs(2) % state % u % array (k,iEdge) & ! this is f*uBcl^{perp}
+ ! normalBaroclinicVelocityNew = normalBaroclinicVelocityOld + dt*(-f*normalBaroclinicVelocityPerp + T(u*,w*,p*) + g*grad(SSH*) )
+ ! Here uNew is a work variable containing -fEdge(iEdge)*normalBaroclinicVelocityPerp(k,iEdge)
+ uTemp(k) = block % state % time_levs(1) % state % normalBaroclinicVelocity % array(k,iEdge) &
+ + dt * (block % tend % normalVelocity % array (k,iEdge) &
+ + block % state % time_levs(2) % state % normalVelocity % array (k,iEdge) & ! this is f*normalBaroclinicVelocity^{perp}
+ split * gravity * ( block % state % time_levs(2) % state % ssh % array(cell2) &
- block % state % time_levs(2) % state % ssh % array(cell1) ) &
/block % mesh % dcEdge % array(iEdge) )
enddo
- ! hSum is initialized outside the loop because on land boundaries
- ! maxLevelEdgeTop=0, but I want to initialize hSum with a
+ ! thicknessSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
! nonzero value to avoid a NaN.
- uhSum = block % state % time_levs(2) % state % h_edge % array(1,iEdge) * uTemp(1)
- hSum = block % state % time_levs(2) % state % h_edge % array(1,iEdge)
+ normalThicknessFluxSum = block % state % time_levs(2) % state % layerThicknessEdge % array(1,iEdge) * uTemp(1)
+ thicknessSum = block % state % time_levs(2) % state % layerThicknessEdge % array(1,iEdge)
do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
- uhSum = uhSum + block % state % time_levs(2) % state % h_edge % array(k,iEdge) * uTemp(k)
- hSum = hSum + block % state % time_levs(2) % state % h_edge % array(k,iEdge)
+ normalThicknessFluxSum = normalThicknessFluxSum + block % state % time_levs(2) % state % layerThicknessEdge % array(k,iEdge) * uTemp(k)
+ thicknessSum = thicknessSum + block % state % time_levs(2) % state % layerThicknessEdge % array(k,iEdge)
enddo
- block % state % time_levs(1) % state % GBtrForcing % array(iEdge) = split*uhSum/hSum/dt
+ block % state % time_levs(1) % state % barotropicForcing % array(iEdge) = split*normalThicknessFluxSum/thicknessSum/dt
do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
! These two steps are together here:
!{\bf u}'_{k,n+1} = {\bf u}'_{k,n} - \Delta t {\overline {\bf G}}
!{\bf u}'_{k,n+1/2} = \frac{1}{2}\left({\bf u}^{'}_{k,n} +{\bf u}'_{k,n+1}\right)
- ! so that uBclNew is at time n+1/2
- block % state % time_levs(2) % state % uBcl % array(k,iEdge) &
+ ! so that normalBaroclinicVelocityNew is at time n+1/2
+ block % state % time_levs(2) % state % normalBaroclinicVelocity % array(k,iEdge) &
= 0.5*( &
- block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
- + uTemp(k) - dt * block % state % time_levs(1) % state % GBtrForcing % array(iEdge))
+ block % state % time_levs(1) % state % normalBaroclinicVelocity % array(k,iEdge) &
+ + uTemp(k) - dt * block % state % time_levs(1) % state % barotropicForcing % array(iEdge))
enddo
@@ -268,9 +268,9 @@
block => block % next
end do
- call mpas_timer_start("se halo ubcl", .false., timer_halo_ubcl)
- call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % uBcl)
- call mpas_timer_stop("se halo ubcl", timer_halo_ubcl)
+ call mpas_timer_start("se halo normalBaroclinicVelocity", .false., timer_halo_normalBaroclinicVelocity)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % normalBaroclinicVelocity)
+ call mpas_timer_stop("se halo normalBaroclinicVelocity", timer_halo_normalBaroclinicVelocity)
end do ! do j=1,config_n_bcl_iter
@@ -296,20 +296,20 @@
block => domain % blocklist
do while (associated(block))
- ! For Split_Explicit unsplit, simply set uBtrNew=0, uBtrSubcycle=0, and uNew=uBclNew
- block % state % time_levs(2) % state % uBtr % array(:) = 0.0
+ ! For Split_Explicit unsplit, simply set normalBarotropicVelocityNew=0, normalBarotropicVelocitySubcycle=0, and uNew=normalBaroclinicVelocityNew
+ block % state % time_levs(2) % state % normalBarotropicVelocity % array(:) = 0.0
- block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % uBcl % array(:,:)
+ block % state % time_levs(2) % state % normalVelocity % array(:,:) = block % state % time_levs(2) % state % normalBaroclinicVelocity % array(:,:)
do iEdge=1,block % mesh % nEdges
do k=1,block % mesh % nVertLevels
- ! uTranport = uBcl + uBolus
- ! This is u used in advective terms for h and tracers
+ ! uTranport = normalBaroclinicVelocity + uBolus
+ ! This is u used in advective terms for layerThickness and tracers
! in tendency calls in stage 3.
block % state % time_levs(2) % state % uTransport % array(k,iEdge) &
= block % mesh % edgeMask % array(k,iEdge) &
- *( block % state % time_levs(2) % state % uBcl % array(k,iEdge) &
+ *( block % state % time_levs(2) % state % normalBaroclinicVelocity % array(k,iEdge) &
+ block % state % time_levs(1) % state % uBolusGM % array(k,iEdge) )
enddo
@@ -325,7 +325,7 @@
do while (associated(block))
if (config_filter_btr_mode) then
- block % state % time_levs(1) % state % GBtrForcing % array(:) = 0.0
+ block % state % time_levs(1) % state % barotropicForcing % array(:) = 0.0
endif
do iCell=1,block % mesh % nCells
@@ -336,16 +336,16 @@
do iEdge=1,block % mesh % nEdges
- ! uBtrSubcycleOld = uBtrOld
- block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- = block % state % time_levs(1) % state % uBtr % array(iEdge)
+ ! normalBarotropicVelocitySubcycleOld = normalBarotropicVelocityOld
+ block % state % time_levs(oldBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge) &
+ = block % state % time_levs(1) % state % normalBarotropicVelocity % array(iEdge)
- ! uBtrNew = BtrOld This is the first for the summation
- block % state % time_levs(2) % state % uBtr % array(iEdge) &
- = block % state % time_levs(1) % state % uBtr % array(iEdge)
+ ! normalBarotropicVelocityNew = BtrOld This is the first for the summation
+ block % state % time_levs(2) % state % normalBarotropicVelocity % array(iEdge) &
+ = block % state % time_levs(1) % state % normalBarotropicVelocity % array(iEdge)
- ! FBtr = 0
- block % state % time_levs(1) % state % FBtr % array(iEdge) = 0.0
+ ! barotropicThicknessFlux = 0
+ block % state % time_levs(1) % state % barotropicThicknessFlux % array(iEdge) = 0.0
end do
block => block % next
@@ -359,7 +359,7 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Barotropic subcycle: VELOCITY PREDICTOR STEP
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- if (config_btr_gam1_uWt1>1.0e-12) then ! only do this part if it is needed in next SSH solve
+ if (config_btr_gam1_velWt1>1.0e-12) then ! only do this part if it is needed in next SSH solve
uPerpTime = oldBtrSubcycleTime
block => domain % blocklist
@@ -376,28 +376,28 @@
eoe = block % mesh % edgesOnEdge % array(i,iEdge)
CoriolisTerm = CoriolisTerm &
+ block % mesh % weightsOnEdge % array(i,iEdge) &
- * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &
+ * block % state % time_levs(uPerpTime) % state % normalBarotropicVelocitySubcycle % array(eoe) &
* block % mesh % fEdge % array(eoe)
end do
- ! uBtrNew = uBtrOld + dt/J*(-f*uBtroldPerp - g*grad(SSH) + G)
- block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- = (block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ ! normalBarotropicVelocityNew = normalBarotropicVelocityOld + dt/J*(-f*normalBarotropicVelocityoldPerp - g*grad(SSH) + G)
+ block % state % time_levs(newBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge) &
+ = (block % state % time_levs(oldBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge) &
+ dt / config_n_btr_subcycles * (CoriolisTerm - gravity &
* (block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
- block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) ) &
/ block % mesh % dcEdge % array(iEdge) &
- + block % state % time_levs(1) % state % GBtrForcing % array(iEdge))) * block % mesh % edgeMask % array(1, iEdge)
+ + block % state % time_levs(1) % state % barotropicForcing % array(iEdge))) * block % mesh % edgeMask % array(1, iEdge)
end do
block => block % next
end do ! block
- ! boundary update on uBtrNew
- call mpas_timer_start("se halo ubtr", .false., timer_halo_ubtr)
- call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle)
- call mpas_timer_stop("se halo ubtr", timer_halo_ubtr)
- endif ! config_btr_gam1_uWt1>1.0e-12
+ ! boundary update on normalBarotropicVelocityNew
+ call mpas_timer_start("se halo normalBarotropicVelocity", .false., timer_halo_normalBarotropicVelocity)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(newBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle)
+ call mpas_timer_stop("se halo normalBarotropicVelocity", timer_halo_normalBarotropicVelocity)
+ endif ! config_btr_gam1_velWt1>1.0e-12
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Barotropic subcycle: SSH PREDICTOR STEP
@@ -408,19 +408,18 @@
block % tend % ssh % array(:) = 0.0
if (config_btr_solve_SSH2) then
- ! If config_btr_solve_SSH2=.true., then do NOT accumulate FBtr in this SSH predictor
+ ! If config_btr_solve_SSH2=.true., then do NOT accumulate barotropicThicknessFlux in this SSH predictor
! section, because it will be accumulated in the SSH corrector section.
- FBtr_coeff = 0.0
+ barotropicThicknessFlux_coeff = 0.0
else
- ! otherwise, DO accumulate FBtr in this SSH predictor section
- FBtr_coeff = 1.0
+ ! otherwise, DO accumulate barotropicThicknessFlux in this SSH predictor section
+ barotropicThicknessFlux_coeff = 1.0
endif
- ! config_btr_gam1_uWt1 sets the forward weighting of velocity in the SSH computation
- ! config_btr_gam1_uWt1= 1 flux = uBtrNew*H
- ! config_btr_gam1_uWt1=0.5 flux = 1/2*(uBtrNew+uBtrOld)*H
- ! config_btr_gam1_uWt1= 0 flux = uBtrOld*H
- ! mrp 120201 efficiency: could we combine the following edge and cell loops?
+ ! config_btr_gam1_velWt1 sets the forward weighting of velocity in the SSH computation
+ ! config_btr_gam1_velWt1= 1 flux = normalBarotropicVelocityNew*H
+ ! config_btr_gam1_velWt1=0.5 flux = 1/2*(normalBarotropicVelocityNew+normalBarotropicVelocityOld)*H
+ ! config_btr_gam1_velWt1= 0 flux = normalBarotropicVelocityOld*H
do iCell = 1, block % mesh % nCells
do i = 1, block % mesh % nEdgesOnCell % array(iCell)
@@ -433,21 +432,21 @@
+ block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) )
! method 0: orig, works only without pbc:
- !hSum = sshEdge + block % mesh % refBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
+ !thicknessSum = sshEdge + block % mesh % refBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
! method 1, matches method 0 without pbcs, works with pbcs.
- hSum = sshEdge + min(block % mesh % bottomDepth % array(cell1), &
+ thicknessSum = sshEdge + min(block % mesh % bottomDepth % array(cell1), &
block % mesh % bottomDepth % array(cell2))
! method 2: may be better than method 1.
! Take average of full thickness at two neighboring cells.
- !hSum = sshEdge + 0.5 *( block % mesh % bottomDepth % array(cell1) &
+ !thicknessSum = sshEdge + 0.5 *( block % mesh % bottomDepth % array(cell1) &
! + block % mesh % bottomDepth % array(cell2) )
- flux = ((1.0-config_btr_gam1_uWt1) * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + config_btr_gam1_uWt1 * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &
- * hSum
+ flux = ((1.0-config_btr_gam1_velWt1) * block % state % time_levs(oldBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge) &
+ + config_btr_gam1_velWt1 * block % state % time_levs(newBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge)) &
+ * thicknessSum
block % tend % ssh % array(iCell) = block % tend % ssh % array(iCell) + block % mesh % edgeSignOncell % array(i, iCell) * flux &
* block % mesh % dvEdge % array(iEdge)
@@ -463,23 +462,23 @@
+ block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) )
! method 0: orig, works only without pbc:
- !hSum = sshEdge + block % mesh % refBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
+ !thicknessSum = sshEdge + block % mesh % refBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
! method 1, matches method 0 without pbcs, works with pbcs.
- hSum = sshEdge + min(block % mesh % bottomDepth % array(cell1), &
+ thicknessSum = sshEdge + min(block % mesh % bottomDepth % array(cell1), &
block % mesh % bottomDepth % array(cell2))
! method 2: may be better than method 1.
! take average of full thickness at two neighboring cells
- !hSum = sshEdge + 0.5 *( block % mesh % bottomDepth % array(cell1) &
+ !thicknessSum = sshEdge + 0.5 *( block % mesh % bottomDepth % array(cell1) &
! + block % mesh % bottomDepth % array(cell2) )
- flux = ((1.0-config_btr_gam1_uWt1) * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + config_btr_gam1_uWt1 * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &
- * hSum
+ flux = ((1.0-config_btr_gam1_velWt1) * block % state % time_levs(oldBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge) &
+ + config_btr_gam1_velWt1 * block % state % time_levs(newBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge)) &
+ * thicknessSum
- block % state % time_levs(1) % state % FBtr % array(iEdge) = block % state % time_levs(1) % state % FBtr % array(iEdge) &
- + FBtr_coeff*flux
+ block % state % time_levs(1) % state % barotropicThicknessFlux % array(iEdge) = block % state % time_levs(1) % state % barotropicThicknessFlux % array(iEdge) &
+ + barotropicThicknessFlux_coeff*flux
end do
! SSHnew = SSHold + dt/J*(-div(Flux))
@@ -508,7 +507,7 @@
block => domain % blocklist
do while (associated(block))
allocate(utemp(block % mesh % nEdges+1))
- uTemp(:) = block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:)
+ uTemp(:) = block % state % time_levs(newBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(:)
do iEdge=1,block % mesh % nEdges
cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
@@ -518,7 +517,7 @@
do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
eoe = block % mesh % edgesOnEdge % array(i,iEdge)
CoriolisTerm = CoriolisTerm + block % mesh % weightsOnEdge % array(i,iEdge) &
- !* block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &
+ !* block % state % time_levs(uPerpTime) % state % normalBarotropicVelocitySubcycle % array(eoe) &
* uTemp(eoe) &
* block % mesh % fEdge % array(eoe)
end do
@@ -530,21 +529,21 @@
sshCell2 = (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
+ config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell2)
- ! uBtrNew = uBtrOld + dt/J*(-f*uBtroldPerp - g*grad(SSH) + G)
- block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- = (block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ ! normalBarotropicVelocityNew = normalBarotropicVelocityOld + dt/J*(-f*normalBarotropicVelocityoldPerp - g*grad(SSH) + G)
+ block % state % time_levs(newBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge) &
+ = (block % state % time_levs(oldBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge) &
+ dt/config_n_btr_subcycles *(CoriolisTerm - gravity *(sshCell2 - sshCell1) /block % mesh % dcEdge % array(iEdge) &
- + block % state % time_levs(1) % state % GBtrForcing % array(iEdge))) * block % mesh % edgeMask % array(1,iEdge)
+ + block % state % time_levs(1) % state % barotropicForcing % array(iEdge))) * block % mesh % edgeMask % array(1,iEdge)
end do
deallocate(uTemp)
block => block % next
end do ! block
- ! boundary update on uBtrNew
- call mpas_timer_start("se halo ubtr", .false., timer_halo_ubtr)
- call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle)
- call mpas_timer_stop("se halo ubtr", timer_halo_ubtr)
+ ! boundary update on normalBarotropicVelocityNew
+ call mpas_timer_start("se halo normalBarotropicVelocity", .false., timer_halo_normalBarotropicVelocity)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(newBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle)
+ call mpas_timer_stop("se halo normalBarotropicVelocity", timer_halo_normalBarotropicVelocity)
end do !do BtrCorIter=1,config_n_btr_cor_iter
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -556,11 +555,10 @@
do while (associated(block))
block % tend % ssh % array(:) = 0.0
- ! config_btr_gam3_uWt2 sets the forward weighting of velocity in the SSH computation
- ! config_btr_gam3_uWt2= 1 flux = uBtrNew*H
- ! config_btr_gam3_uWt2=0.5 flux = 1/2*(uBtrNew+uBtrOld)*H
- ! config_btr_gam3_uWt2= 0 flux = uBtrOld*H
- ! mrp 120201 efficiency: could we combine the following edge and cell loops?
+ ! config_btr_gam3_velWt2 sets the forward weighting of velocity in the SSH computation
+ ! config_btr_gam3_velWt2= 1 flux = normalBarotropicVelocityNew*H
+ ! config_btr_gam3_velWt2=0.5 flux = 1/2*(normalBarotropicVelocityNew+normalBarotropicVelocityOld)*H
+ ! config_btr_gam3_velWt2= 0 flux = normalBarotropicVelocityOld*H
do iCell = 1, block % mesh % nCells
do i = 1, block % mesh % nEdgesOnCell % array(iCell)
@@ -578,21 +576,21 @@
sshEdge = 0.5 * (sshCell1 + sshCell2)
! method 0: orig, works only without pbc:
- !hSum = sshEdge + block % mesh % refBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
+ !thicknessSum = sshEdge + block % mesh % refBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
! method 1, matches method 0 without pbcs, works with pbcs.
- hSum = sshEdge + min(block % mesh % bottomDepth % array(cell1), &
+ thicknessSum = sshEdge + min(block % mesh % bottomDepth % array(cell1), &
block % mesh % bottomDepth % array(cell2))
! method 2: may be better than method 1.
! take average of full thickness at two neighboring cells
- !hSum = sshEdge + 0.5 *( block % mesh % bottomDepth % array(cell1) &
+ !thicknessSum = sshEdge + 0.5 *( block % mesh % bottomDepth % array(cell1) &
! + block % mesh % bottomDepth % array(cell2) )
- flux = ((1.0-config_btr_gam3_uWt2) * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + config_btr_gam3_uWt2 * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &
- * hSum
+ flux = ((1.0-config_btr_gam3_velWt2) * block % state % time_levs(oldBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge) &
+ + config_btr_gam3_velWt2 * block % state % time_levs(newBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge)) &
+ * thicknessSum
block % tend % ssh % array(iCell) = block % tend % ssh % array(iCell) + block % mesh % edgeSignOnCell % array(i, iCell) * flux &
* block % mesh % dvEdge % array(iEdge)
@@ -612,22 +610,22 @@
sshEdge = 0.5 * (sshCell1 + sshCell2)
! method 0: orig, works only without pbc:
- !hSum = sshEdge + block % mesh % refBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
+ !thicknessSum = sshEdge + block % mesh % refBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
! method 1, matches method 0 without pbcs, works with pbcs.
- hSum = sshEdge + min(block % mesh % bottomDepth % array(cell1), &
+ thicknessSum = sshEdge + min(block % mesh % bottomDepth % array(cell1), &
block % mesh % bottomDepth % array(cell2))
! method 2, better, I think.
! take average of full thickness at two neighboring cells
- !hSum = sshEdge + 0.5 *( block % mesh % bottomDepth % array(cell1) &
+ !thicknessSum = sshEdge + 0.5 *( block % mesh % bottomDepth % array(cell1) &
! + block % mesh % bottomDepth % array(cell2) )
- flux = ((1.0-config_btr_gam3_uWt2) * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + config_btr_gam3_uWt2 * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &
- * hSum
+ flux = ((1.0-config_btr_gam3_velWt2) * block % state % time_levs(oldBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge) &
+ + config_btr_gam3_velWt2 * block % state % time_levs(newBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge)) &
+ * thicknessSum
- block % state % time_levs(1) % state % FBtr % array(iEdge) = block % state % time_levs(1) % state % FBtr % array(iEdge) + flux
+ block % state % time_levs(1) % state % barotropicThicknessFlux % array(iEdge) = block % state % time_levs(1) % state % barotropicThicknessFlux % array(iEdge) + flux
end do
! SSHnew = SSHold + dt/J*(-div(Flux))
@@ -653,15 +651,15 @@
block => domain % blocklist
do while (associated(block))
- ! uBtrNew = uBtrNew + uBtrSubcycleNEW
+ ! normalBarotropicVelocityNew = normalBarotropicVelocityNew + normalBarotropicVelocitySubcycleNEW
! This accumulates the sum.
! If the Barotropic Coriolis iteration is limited to one, this could
! be merged with the above code.
do iEdge=1,block % mesh % nEdges
- block % state % time_levs(2) % state % uBtr % array(iEdge) &
- = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- + block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
+ block % state % time_levs(2) % state % normalBarotropicVelocity % array(iEdge) &
+ = block % state % time_levs(2) % state % normalBarotropicVelocity % array(iEdge) &
+ + block % state % time_levs(newBtrSubcycleTime) % state % normalBarotropicVelocitySubcycle % array(iEdge)
end do ! iEdge
block => block % next
@@ -676,15 +674,15 @@
! END Barotropic subcycle loop
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Normalize Barotropic subcycle sums: ssh, uBtr, and F
+ ! Normalize Barotropic subcycle sums: ssh, normalBarotropicVelocity, and F
block => domain % blocklist
do while (associated(block))
do iEdge=1,block % mesh % nEdges
- block % state % time_levs(1) % state % FBtr % array(iEdge) = block % state % time_levs(1) % state % FBtr % array(iEdge) &
+ block % state % time_levs(1) % state % barotropicThicknessFlux % array(iEdge) = block % state % time_levs(1) % state % barotropicThicknessFlux % array(iEdge) &
/ (config_n_btr_subcycles*config_btr_subcycle_loop_factor)
- block % state % time_levs(2) % state % uBtr % array(iEdge) = block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ block % state % time_levs(2) % state % normalBarotropicVelocity % array(iEdge) = block % state % time_levs(2) % state % normalBarotropicVelocity % array(iEdge) &
/ (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
end do
@@ -694,7 +692,7 @@
! boundary update on F
call mpas_timer_start("se halo F", .false., timer_halo_f)
- call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(1) % state % FBtr)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(1) % state % barotropicThicknessFlux)
call mpas_timer_stop("se halo F", timer_halo_f)
@@ -713,7 +711,7 @@
! - \sum_{k=1}^{N^{edge}} h_{k,*}^{edge} {\bf u}_k^{avg} \right)
! \left/ \sum_{k=1}^{N^{edge}} h_{k,*}^{edge} \right.
- if (config_u_correction) then
+ if (config_vel_correction) then
ucorr_coef = 1
else
ucorr_coef = 0
@@ -721,34 +719,34 @@
do iEdge=1,block % mesh % nEdges
- ! velocity for uCorrection is uBtr + uBcl + uBolus
+ ! velocity for uCorrection is normalBarotropicVelocity + normalBaroclinicVelocity + uBolus
uTemp(:) &
- = block % state % time_levs(2) % state % uBtr % array( iEdge) &
- + block % state % time_levs(2) % state % uBcl % array(:,iEdge) &
+ = block % state % time_levs(2) % state % normalBarotropicVelocity % array( iEdge) &
+ + block % state % time_levs(2) % state % normalBaroclinicVelocity % array(:,iEdge) &
+ block % state % time_levs(1) % state % uBolusGM % array(:,iEdge)
- ! hSum is initialized outside the loop because on land boundaries
- ! maxLevelEdgeTop=0, but I want to initialize hSum with a
+ ! thicknessSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
! nonzero value to avoid a NaN.
- uhSum = block % state % time_levs(2) % state % h_edge % array(1,iEdge) * uTemp(1)
- hSum = block % state % time_levs(2) % state % h_edge % array(1,iEdge)
+ normalThicknessFluxSum = block % state % time_levs(2) % state % layerThicknessEdge % array(1,iEdge) * uTemp(1)
+ thicknessSum = block % state % time_levs(2) % state % layerThicknessEdge % array(1,iEdge)
do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
- uhSum = uhSum + block % state % time_levs(2) % state % h_edge % array(k,iEdge) * uTemp(k)
- hSum = hSum + block % state % time_levs(2) % state % h_edge % array(k,iEdge)
+ normalThicknessFluxSum = normalThicknessFluxSum + block % state % time_levs(2) % state % layerThicknessEdge % array(k,iEdge) * uTemp(k)
+ thicknessSum = thicknessSum + block % state % time_levs(2) % state % layerThicknessEdge % array(k,iEdge)
enddo
- uCorr = ucorr_coef*(( block % state % time_levs(1) % state % FBtr % array(iEdge) - uhSum)/hSum)
+ uCorr = ucorr_coef*(( block % state % time_levs(1) % state % barotropicThicknessFlux % array(iEdge) - normalThicknessFluxSum)/thicknessSum)
do k=1,block % mesh % nVertLevels
- ! uTranport = uBtr + uBcl + uBolus + uCorrection
- ! This is u used in advective terms for h and tracers
+ ! uTranport = normalBarotropicVelocity + normalBaroclinicVelocity + uBolus + uCorrection
+ ! This is u used in advective terms for layerThickness and tracers
! in tendency calls in stage 3.
block % state % time_levs(2) % state % uTransport % array(k,iEdge) &
= block % mesh % edgeMask % array(k,iEdge) &
- *( block % state % time_levs(2) % state % uBtr % array( iEdge) &
- + block % state % time_levs(2) % state % uBcl % array(k,iEdge) &
+ *( block % state % time_levs(2) % state % normalBarotropicVelocity % array( iEdge) &
+ + block % state % time_levs(2) % state % normalBaroclinicVelocity % array(k,iEdge) &
+ block % state % time_levs(1) % state % uBolusGM % array(k,iEdge) &
+ uCorr )
@@ -771,31 +769,26 @@
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !TDR: it seems almost trivial to hold off on doing T, S and rho updates until the
- !TDR: dycore time step is complete. we might want to take this opportunity to clean-up
- !TDR: Stage3 in order to faciliate the testing of not doing tracer updates after this code is committed to trunk.
- !TDR: at this point, I am suggesting just pushing some of this code into subroutines.
- !TDR: see comments farther down
-
- ! dwj: 02/22/12 splitting thickness and tracer tendency computations and halo updates to allow monotonic advection.
+ ! Thickness tendency computations and thickness halo updates are completed before tracer
+ ! tendency computations to allow monotonic advection.
block => domain % blocklist
do while (associated(block))
- ! compute wTop. Use uTransport for advection of h and tracers.
- ! Use time level 1 values of h and h_edge because h has not yet been computed for time level 2.
- call ocn_wtop(block % mesh, block % state % time_levs(1) % state % h % array, &
- block % state % time_levs(1) % state % h_edge % array, &
+ ! compute vertTransportVelocityTop. Use uTransport for advection of layerThickness and tracers.
+ ! Use time level 1 values of layerThickness and layerThicknessEdge because layerThickness has not yet been computed for time level 2.
+ call ocn_vert_transport_velocity_top(block % mesh, block % state % time_levs(1) % state % layerThickness % array, &
+ block % state % time_levs(1) % state % layerThicknessEdge % array, &
block % state % time_levs(2) % state % uTransport % array, &
- block % state % time_levs(2) % state % wTop % array, err)
+ block % state % time_levs(2) % state % vertTransportVelocityTop % array, err)
- call ocn_tend_h(block % tend, block % state % time_levs(2) % state, block % mesh)
+ call ocn_tend_thick(block % tend, block % state % time_levs(2) % state, block % mesh)
block => block % next
end do
! update halo for thickness and tracer tendencies
- call mpas_timer_start("se halo h", .false., timer_halo_h)
- call mpas_dmpar_exch_halo_field(domain % blocklist % tend % h)
- call mpas_timer_stop("se halo h", timer_halo_h)
+ call mpas_timer_start("se halo thickness", .false., timer_halo_thickness)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % layerThickness)
+ call mpas_timer_stop("se halo thickness", timer_halo_thickness)
block => domain % blocklist
do while (associated(block))
@@ -819,9 +812,6 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if (split_explicit_step < config_n_ts_iter) then
- !TDR: should we move this code into a subroutine called "compute_intermediate_value_at_midtime"
- !TDR: this could be within a contains statement in this routine
-
! Only need T & S for earlier iterations,
! then all the tracers needed the last time through.
do iCell=1,block % mesh % nCells
@@ -830,20 +820,20 @@
! this is h_{n+1}
temp_h &
- = block % state % time_levs(1) % state % h % array(k,iCell) &
- + dt* block % tend % h % array(k,iCell)
+ = block % state % time_levs(1) % state % layerThickness % array(k,iCell) &
+ + dt* block % tend % layerThickness % array(k,iCell)
! this is h_{n+1/2}
- block % state % time_levs(2) % state % h % array(k,iCell) &
+ block % state % time_levs(2) % state % layerThickness % array(k,iCell) &
= 0.5*( &
- block % state % time_levs(1) % state % h % array(k,iCell) &
+ block % state % time_levs(1) % state % layerThickness % array(k,iCell) &
+ temp_h)
do i=1,2
! This is Phi at n+1
temp = ( &
block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
- * block % state % time_levs(1) % state % h % array(k,iCell) &
+ * block % state % time_levs(1) % state % layerThickness % array(k,iCell) &
+ dt * block % tend % tracers % array(i,k,iCell)) &
/ temp_h
@@ -860,20 +850,20 @@
do k=1,block % mesh % nVertLevels
- ! u = uBtr + uBcl
- ! here uBcl is at time n+1/2
+ ! u = normalBarotropicVelocity + normalBaroclinicVelocity
+ ! here normalBaroclinicVelocity is at time n+1/2
! This is u used in next iteration or step
- block % state % time_levs(2) % state % u % array(k,iEdge) &
+ block % state % time_levs(2) % state % normalVelocity % array(k,iEdge) &
= block % mesh % edgeMask % array(k,iEdge) &
- *( block % state % time_levs(2) % state % uBtr % array( iEdge) &
- + block % state % time_levs(2) % state % uBcl % array(k,iEdge) )
+ *( block % state % time_levs(2) % state % normalBarotropicVelocity % array( iEdge) &
+ + block % state % time_levs(2) % state % normalBaroclinicVelocity % array(k,iEdge) )
enddo
end do ! iEdge
- ! mrp 110512 I really only need this to compute h_edge, density, pressure, and SSH
- ! I can par this down later.
+ ! Efficiency note: We really only need this to compute layerThicknessEdge, density, pressure, and SSH
+ ! in this diagnostics solve.
call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -883,44 +873,41 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
elseif (split_explicit_step == config_n_ts_iter) then
- !TDR: should we move this code into a subroutine called "compute_final_values_at_nplus1"?
- !TDR: this could be within a contains statement in this routine
-
do iCell=1,block % mesh % nCells
do k=1,block % mesh % maxLevelCell % array(iCell)
! this is h_{n+1}
- block % state % time_levs(2) % state % h % array(k,iCell) &
- = block % state % time_levs(1) % state % h % array(k,iCell) &
- + dt* block % tend % h % array(k,iCell)
+ block % state % time_levs(2) % state % layerThickness % array(k,iCell) &
+ = block % state % time_levs(1) % state % layerThickness % array(k,iCell) &
+ + dt* block % tend % layerThickness % array(k,iCell)
! This is Phi at n+1
do i=1,block % state % time_levs(1) % state % num_tracers
block % state % time_levs(2) % state % tracers % array(i,k,iCell) &
= (block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
- * block % state % time_levs(1) % state % h % array(k,iCell) &
+ * block % state % time_levs(1) % state % layerThickness % array(k,iCell) &
+ dt * block % tend % tracers % array(i,k,iCell)) &
- / block % state % time_levs(2) % state % h % array(k,iCell)
+ / block % state % time_levs(2) % state % layerThickness % array(k,iCell)
enddo
end do
end do
! Recompute final u to go on to next step.
- ! u_{n+1} = uBtr_{n+1} + uBcl_{n+1}
- ! Right now uBclNew is at time n+1/2, so back compute to get uBcl at time n+1
- ! using uBcl_{n+1/2} = 1/2*(uBcl_n + u_Bcl_{n+1})
+ ! u_{n+1} = normalBarotropicVelocity_{n+1} + normalBaroclinicVelocity_{n+1}
+ ! Right now normalBaroclinicVelocityNew is at time n+1/2, so back compute to get normalBaroclinicVelocity at time n+1
+ ! using normalBaroclinicVelocity_{n+1/2} = 1/2*(normalBaroclinicVelocity_n + u_Bcl_{n+1})
! so the following lines are
- ! u_{n+1} = uBtr_{n+1} + 2*uBcl_{n+1/2} - uBcl_n
- ! note that uBcl is recomputed at the beginning of the next timestep due to Imp Vert mixing,
- ! so uBcl does not have to be recomputed here.
+ ! u_{n+1} = normalBarotropicVelocity_{n+1} + 2*normalBaroclinicVelocity_{n+1/2} - normalBaroclinicVelocity_n
+ ! note that normalBaroclinicVelocity is recomputed at the beginning of the next timestep due to Imp Vert mixing,
+ ! so normalBaroclinicVelocity does not have to be recomputed here.
do iEdge=1,block % mesh % nEdges
do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
- block % state % time_levs(2) % state % u % array(k,iEdge) &
- = block % state % time_levs(2) % state % uBtr % array( iEdge) &
- +2*block % state % time_levs(2) % state % uBcl % array(k,iEdge) &
- - block % state % time_levs(1) % state % uBcl % array(k,iEdge)
+ block % state % time_levs(2) % state % normalVelocity % array(k,iEdge) &
+ = block % state % time_levs(2) % state % normalBarotropicVelocity % array( iEdge) &
+ +2*block % state % time_levs(2) % state % normalBaroclinicVelocity % array(k,iEdge) &
+ - block % state % time_levs(1) % state % normalBaroclinicVelocity % array(k,iEdge)
end do
end do ! iEdges
@@ -942,10 +929,10 @@
! Call ocean diagnostic solve in preparation for vertical mixing. Note
! it is called again after vertical mixing, because u and tracers change.
- ! For Richardson vertical mixing, only rho, h_edge, and ke_edge need to
+ ! For Richardson vertical mixing, only density, layerThicknessEdge, and kineticEnergyEdge need to
! be computed. For kpp, more variables may be needed. Either way, this
! could be made more efficient by only computing what is needed for the
- ! implicit vmix routine that follows. mrp 121023.
+ ! implicit vmix routine that follows.
call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
call ocn_vmix_implicit(dt, block % mesh, block % diagnostics, block % state % time_levs(2) % state, err)
@@ -958,7 +945,7 @@
! conducted on tendencies, not on the velocity and tracer fields. So this update is required to
! communicate the change due to implicit vertical mixing across the boundary.
call mpas_timer_start("se implicit vert mix halos")
- call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % u)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % normalVelocity)
call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % tracers)
call mpas_timer_stop("se implicit vert mix halos")
@@ -968,37 +955,35 @@
do while (associated(block))
if (config_prescribe_velocity) then
- block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ block % state % time_levs(2) % state % normalVelocity % array(:,:) = block % state % time_levs(1) % state % normalVelocity % array(:,:)
end if
if (config_prescribe_thickness) then
- block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
+ block % state % time_levs(2) % state % layerThickness % array(:,:) = block % state % time_levs(1) % state % layerThickness % array(:,:)
end if
call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
- ! Compute velocity transport, used in advection terms of h and tracer tendency
+ ! Compute velocity transport, used in advection terms of layerThickness and tracer tendency
block % state % time_levs(2) % state % uTransport % array(:,:) &
- = block % state % time_levs(2) % state % u % array(:,:) &
+ = block % state % time_levs(2) % state % normalVelocity % array(:,:) &
+ block % state % time_levs(2) % state % uBolusGM % array(:,:)
- call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array, &
- block % state % time_levs(2) % state % uReconstructX % array, &
- block % state % time_levs(2) % state % uReconstructY % array, &
- block % state % time_levs(2) % state % uReconstructZ % array, &
- block % state % time_levs(2) % state % uReconstructZonal % array, &
- block % state % time_levs(2) % state % uReconstructMeridional % array &
+ call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % normalVelocity % array, &
+ block % state % time_levs(2) % state % normalVelocityX % array, &
+ block % state % time_levs(2) % state % normalVelocityY % array, &
+ block % state % time_levs(2) % state % normalVelocityZ % array, &
+ block % state % time_levs(2) % state % normalVelocityZonal % array, &
+ block % state % time_levs(2) % state % normalVelocityMeridional % array &
)
-!TDR
- call mpas_reconstruct(block % mesh, block % mesh % u_src % array, &
- block % state % time_levs(2) % state % uSrcReconstructX % array, &
- block % state % time_levs(2) % state % uSrcReconstructY % array, &
- block % state % time_levs(2) % state % uSrcReconstructZ % array, &
- block % state % time_levs(2) % state % uSrcReconstructZonal % array, &
- block % state % time_levs(2) % state % uSrcReconstructMeridional % array &
+ call mpas_reconstruct(block % mesh, block % mesh % normalVelocityForcing % array, &
+ block % state % time_levs(2) % state % normalVelocityForcingReconstructX % array, &
+ block % state % time_levs(2) % state % normalVelocityForcingReconstructY % array, &
+ block % state % time_levs(2) % state % normalVelocityForcingReconstructZ % array, &
+ block % state % time_levs(2) % state % normalVelocityForcingReconstructZonal % array, &
+ block % state % time_levs(2) % state % normalVelocityForcingReconstructMeridional % array &
)
-!TDR
call ocn_time_average_accumulate(block % state % time_levs(2) % state, block % state % time_levs(1) % state)
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -240,24 +240,24 @@
!> advection of tracers.
!
!-----------------------------------------------------------------------
- subroutine mpas_ocn_tracer_advection_tend(tracers, uh, w, h, verticalCellSize, dt, grid, tend_h, tend)!{{{
+ subroutine mpas_ocn_tracer_advection_tend(tracers, normalThicknessFlux, w, layerThickness, verticalCellSize, dt, grid, tend_layerThickness, tend)!{{{
real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: tracer tendency
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input/Output: tracer values
- real (kind=RKIND), dimension(:,:), intent(in) :: uh !< Input: Thickness weighted horizontal velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: normalThicknessFlux !< Input: Thickness weighted horizontal velocity
real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical velocity
- real (kind=RKIND), dimension(:,:), intent(in) :: h !< Input: Thickness field
+ real (kind=RKIND), dimension(:,:), intent(in) :: layerThickness !< Input: Thickness field
real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of a cell
real (kind=RKIND), intent(in) :: dt !< Input: Time step
type (mesh_type), intent(in) :: grid !< Input: grid information
- real (kind=RKIND), dimension(:,:), intent(in) :: tend_h !< Input: Thickness tendency information
+ real (kind=RKIND), dimension(:,:), intent(in) :: tend_layerThickness !< Input: Thickness tendency information
if(.not. tracerAdvOn) return
if(monotonicOn) then
- call mpas_ocn_tracer_advection_mono_tend(tracers, uh, w, h, verticalCellSize, dt, grid, tend_h, tend)
+ call mpas_ocn_tracer_advection_mono_tend(tracers, normalThicknessFlux, w, layerThickness, verticalCellSize, dt, grid, tend_layerThickness, tend)
else
- call mpas_ocn_tracer_advection_std_tend(tracers, uh, w, verticalCellSize, grid, tend)
+ call mpas_ocn_tracer_advection_std_tend(tracers, normalThicknessFlux, w, verticalCellSize, grid, tend)
endif
end subroutine mpas_ocn_tracer_advection_tend!}}}
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection_mono.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection_mono.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection_mono.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -43,7 +43,7 @@
!> Both horizontal and vertical.
!
!-----------------------------------------------------------------------
- subroutine mpas_ocn_tracer_advection_mono_tend(tracers, uh, w, h, verticalCellSize, dt, grid, tend_h, tend)!{{{
+ subroutine mpas_ocn_tracer_advection_mono_tend(tracers, normalThicknessFlux, w, layerThickness, verticalCellSize, dt, grid, tend_layerThickness, tend)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Input: s - current model state
@@ -52,11 +52,11 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: current tracer values
- real (kind=RKIND), dimension(:,:), intent(in) :: uh !< Input: Thichness weighted velocitiy
+ real (kind=RKIND), dimension(:,:), intent(in) :: normalThicknessFlux !< Input: Thichness weighted velocitiy
real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical velocitiy
- real (kind=RKIND), dimension(:,:), intent(in) :: h !< Input: Thickness
+ real (kind=RKIND), dimension(:,:), intent(in) :: layerThickness !< Input: Thickness
real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of a cell
- real (kind=RKIND), dimension(:,:), intent(in) :: tend_h !< Input: Tendency for thickness field
+ real (kind=RKIND), dimension(:,:), intent(in) :: tend_layerThickness !< Input: Tendency for thickness field
real (kind=RKIND), intent(in) :: dt !< Input: Timestep
type (mesh_type), intent(in) :: grid !< Input: Grid information
real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: Tracer tendency
@@ -134,7 +134,7 @@
do iCell = 1, nCells
do k=1, maxLevelCell(iCell)
- inv_h_new(k, iCell) = 1.0 / (h(k, iCell) + dt * tend_h(k, iCell))
+ inv_h_new(k, iCell) = 1.0 / (layerThickness(k, iCell) + dt * tend_layerThickness(k, iCell))
end do
end do
@@ -199,9 +199,9 @@
iCell = advCellsForEdge(i,iEdge)
do k = 1, maxLevelCell(iCell)
tracer_weight = lowOrderAdvectionMask(k, iEdge) * adv_coefs_2nd(i,iEdge) &
- + highOrderAdvectionMask(k, iEdge) * (adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,uh(k,iEdge))*adv_coefs_3rd(i,iEdge))
+ + highOrderAdvectionMask(k, iEdge) * (adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,normalThicknessFlux(k,iEdge))*adv_coefs_3rd(i,iEdge))
- tracer_weight = uh(k,iEdge)*tracer_weight
+ tracer_weight = normalThicknessFlux(k,iEdge)*tracer_weight
high_order_horiz_flux(k,iEdge) = high_order_horiz_flux(k,iEdge) + tracer_weight* tracer_cur(k,iCell)
end do ! k loop
end do ! i loop over nAdvCellsForEdge
@@ -247,7 +247,7 @@
invAreaCell2 = 1.0 / areaCell(cell2)
do k = 1, maxLevelEdgeTop(iEdge)
- flux_upwind = dvEdge(iEdge) * (max(0.0_RKIND,uh(k,iEdge))*tracer_cur(k,cell1) + min(0.0_RKIND,uh(k,iEdge))*tracer_cur(k,cell2))
+ flux_upwind = dvEdge(iEdge) * (max(0.0_RKIND,normalThicknessFlux(k,iEdge))*tracer_cur(k,cell1) + min(0.0_RKIND,normalThicknessFlux(k,iEdge))*tracer_cur(k,cell2))
high_order_horiz_flux(k,iEdge) = high_order_horiz_flux(k,iEdge) - flux_upwind
end do ! k loop
end do ! iEdge loop
@@ -259,7 +259,7 @@
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k = 1, maxLevelEdgeTop(iEdge)
- flux_upwind = dvEdge(iEdge) * (max(0.0_RKIND,uh(k,iEdge))*tracer_cur(k,cell1) + min(0.0_RKIND,uh(k,iEdge))*tracer_cur(k,cell2))
+ flux_upwind = dvEdge(iEdge) * (max(0.0_RKIND,normalThicknessFlux(k,iEdge))*tracer_cur(k,cell1) + min(0.0_RKIND,normalThicknessFlux(k,iEdge))*tracer_cur(k,cell2))
upwind_tendency(k,iCell) = upwind_tendency(k,iCell) + edgeSignOncell(i, iCell) * flux_upwind * invAreaCell1
@@ -275,9 +275,9 @@
! Factors are placed in the flux_incoming and flux_outgoing arrays
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
- tracer_min_new = (tracer_cur(k,iCell)*h(k,iCell) + dt*(upwind_tendency(k,iCell)+flux_outgoing(k,iCell))) * inv_h_new(k,iCell)
- tracer_max_new = (tracer_cur(k,iCell)*h(k,iCell) + dt*(upwind_tendency(k,iCell)+flux_incoming(k,iCell))) * inv_h_new(k,iCell)
- tracer_upwind_new = (tracer_cur(k,iCell)*h(k,iCell) + dt*upwind_tendency(k,iCell)) * inv_h_new(k,iCell)
+ tracer_min_new = (tracer_cur(k,iCell)*layerThickness(k,iCell) + dt*(upwind_tendency(k,iCell)+flux_outgoing(k,iCell))) * inv_h_new(k,iCell)
+ tracer_max_new = (tracer_cur(k,iCell)*layerThickness(k,iCell) + dt*(upwind_tendency(k,iCell)+flux_incoming(k,iCell))) * inv_h_new(k,iCell)
+ tracer_upwind_new = (tracer_cur(k,iCell)*layerThickness(k,iCell) + dt*upwind_tendency(k,iCell)) * inv_h_new(k,iCell)
scale_factor = (tracer_max(k,iCell)-tracer_upwind_new)/(tracer_max_new-tracer_upwind_new+eps)
flux_incoming(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
@@ -337,7 +337,7 @@
tracer_new(k, iCell) = tracer_new(k, iCell) + (high_order_vert_flux(k+1, iCell) - high_order_vert_flux(k, iCell)) + upwind_tendency(k,iCell)
!tracer_new is now the new state of the tracer. Only for a check on monotonicity
- tracer_new(k, iCell) = (tracer_cur(k, iCell)*h(k, iCell) + dt * tracer_new(k, iCell)) * inv_h_new(k, iCell)
+ tracer_new(k, iCell) = (tracer_cur(k, iCell)*layerThickness(k, iCell) + dt * tracer_new(k, iCell)) * inv_h_new(k, iCell)
end if
end do ! k loop
end do ! iCell loop
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection_std.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection_std.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection_std.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -45,7 +45,7 @@
!> tracer advection tendencies.
!
!-----------------------------------------------------------------------
- subroutine mpas_ocn_tracer_advection_std_tend(tracers, uh, w, verticalCellSize, grid, tend)!{{{
+ subroutine mpas_ocn_tracer_advection_std_tend(tracers, normalThicknessFlux, w, verticalCellSize, grid, tend)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Input: s - current model state
@@ -56,13 +56,13 @@
real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: Tracer tendency
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: Tracer values
- real (kind=RKIND), dimension(:,:), intent(in) :: uh !< Input: Thickness weighted horizontal velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: normalThicknessFlux !< Input: Thickness weighted horizontal velocity
real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical Velocity
real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of a cell
type (mesh_type), intent(in) :: grid !< Input: Grid information
call mpas_timer_start("tracer-hadv", .false.)
- call mpas_ocn_tracer_advection_std_hadv_tend(tracers, uh, grid, tend)
+ call mpas_ocn_tracer_advection_std_hadv_tend(tracers, normalThicknessFlux, grid, tend)
call mpas_timer_stop("tracer-hadv")
call mpas_timer_start("tracer-vadv", .false.)
call mpas_ocn_tracer_advection_std_vadv_tend(tracers, w, verticalCellSize, grid, tend)
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection_std_hadv.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection_std_hadv.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_advection_std_hadv.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -45,10 +45,10 @@
!> This routine computes the tendency for 3rd order horizontal advection of tracers.
!
!-----------------------------------------------------------------------
- subroutine mpas_ocn_tracer_advection_std_hadv_tend(tracers, uh, grid, tend)!{{{
+ subroutine mpas_ocn_tracer_advection_std_hadv_tend(tracers, normalThicknessFlux, grid, tend)!{{{
real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/output: Tracer tendency
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: Tracer values
- real (kind=RKIND), dimension(:,:), intent(in) :: uh !< Input: Thickness weighted horizontal velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: normalThicknessFlux !< Input: Thickness weighted horizontal velocity
type (mesh_type), intent(in) :: grid !< Input: Grid information
integer :: i, iCell, iEdge, k, iTracer, cell1, cell2
@@ -91,7 +91,7 @@
iCell = advCellsForEdge(i,iEdge)
do k=1,grid % nVertLevels
tracer_weight = lowOrderAdvectionMask(k, iEdge) * adv_coefs_2nd(i,iEdge) &
- + highOrderAdvectionMask(k, iEdge) * (adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,uh(k,iEdge))*adv_coefs_3rd(i,iEdge))
+ + highOrderAdvectionMask(k, iEdge) * (adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,normalThicknessFlux(k,iEdge))*adv_coefs_3rd(i,iEdge))
do iTracer=1,num_tracers
flux_arr(iTracer,k) = flux_arr(iTracer,k) + tracer_weight* tracers(iTracer,k,iCell)
end do
@@ -100,8 +100,8 @@
do k=1,grid % nVertLevels
do iTracer=1,num_tracers
- tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - uh(k,iEdge)*flux_arr(iTracer,k)/areaCell(cell1)
- tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + uh(k,iEdge)*flux_arr(iTracer,k)/areaCell(cell2)
+ tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - normalThicknessFlux(k,iEdge)*flux_arr(iTracer,k)/areaCell(cell1)
+ tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + normalThicknessFlux(k,iEdge)*flux_arr(iTracer,k)/areaCell(cell2)
end do
end do
end if
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,189 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_hadv
-!
-!> \brief MPAS ocean horizontal tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hadv
-
- use mpas_grid_types
- use mpas_configure
- use mpas_timer
-
- use ocn_tracer_hadv2
- use ocn_tracer_hadv3
- use ocn_tracer_hadv4
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_hadv_tend, &
- ocn_tracer_hadv_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- type (timer_node), pointer :: hadv2Timer, hadv3Timer, hadv4Timer
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_hadv_tend
-!
-!> \brief Computes tendency term for horizontal tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_hadv_tend(grid, u, h_edge, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: Error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: err1, err2, err3
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- call mpas_timer_start("hadv2", .false., hadv2Timer);
- call ocn_tracer_hadv2_tend(grid, u, h_edge, tracers, tend, err1)
- call mpas_timer_stop("hadv2", hadv2Timer);
- call mpas_timer_start("hadv3", .false., hadv3Timer);
- call ocn_tracer_hadv3_tend(grid, u, h_edge, tracers, tend, err2)
- call mpas_timer_stop("hadv3", hadv3Timer);
- call mpas_timer_start("hadv4", .false., hadv4Timer);
- call ocn_tracer_hadv4_tend(grid, u, h_edge, tracers, tend, err3)
- call mpas_timer_stop("hadv4", hadv4Timer);
-
- err = ior(err1, ior(err2, err3))
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_hadv_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_hadv_init
-!
-!> \brief Initializes ocean tracer horizontal advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_hadv_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: Error flag
-
- integer :: err1, err2, err3
-
- call ocn_tracer_hadv2_init(err1)
- call ocn_tracer_hadv3_init(err2)
- call ocn_tracer_hadv4_init(err3)
-
- err = ior(err1, ior(err2, err3))
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_hadv_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv2.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv2.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv2.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,199 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_hadv2
-!
-!> \brief MPAS ocean horizontal tracer advection 2nd order
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hadv2
-
- use mpas_grid_types
- use mpas_configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_hadv2_tend, &
- ocn_tracer_hadv2_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: hadv2On !< Flag to turn on/off 2nd order hadv
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_hadv2_tend
-!
-!> \brief Computes tendency term for horizontal tracer advection 2nd order
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal advection tendency for tracer
-!> based on current state using a 2nd order formulation.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_hadv2_tend(grid, u, h_edge, tracers , tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: tracer
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: Error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, k
-
- integer, dimension(:), pointer :: maxLevelEdgeTop
- integer, dimension(:,:), pointer :: cellsOnEdge
-
- real (kind=RKIND) :: flux, tracer_edge, invAreaCell1, invAreaCell2, r_tmp
-
- real (kind=RKIND), dimension(:), pointer :: dvEdge, areaCell
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.hadv2On) return
-
- nEdges = grid % nEdges
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- cellsOnEdge => grid % cellsOnEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- num_tracers = size(tracers, 1)
-
- do iEdge=1,nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
-
- invAreaCell1 = 1.0 / areaCell(cell1)
- invAreaCell2 = 1.0 / areaCell(cell2)
- do k=1,maxLevelEdgeTop(iEdge)
- r_tmp = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
- do iTracer=1,num_tracers
- tracer_edge = 0.5 * (tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))
- flux = r_tmp * tracer_edge
- tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - flux * invAreaCell1
- tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + flux * invAreaCell2
- end do
- end do
- end do
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_hadv2_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_hadv2_init
-!
-!> \brief Initializes ocean tracer horizontal advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> 2nd order horizontal tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_hadv2_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: Error flag
-
- err = 0
- hadv2On = .false.
-
- if (config_horiz_tracer_adv_order == 2) then
- hadv2On = .true.
- end if
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_hadv2_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hadv2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv3.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv3.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv3.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,239 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_hadv3
-!
-!> \brief MPAS ocean horizontal tracer advection 3rd order
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hadv3
-
- use mpas_grid_types
- use mpas_configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_hadv3_tend, &
- ocn_tracer_hadv3_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: hadv3On !< Flag to turn on/off 3rd order hadv
- real (kind=RKIND) :: coef_3rd_order !< Coefficient for 3rd order hadv
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_hadv3_tend
-!
-!> \brief Computes tendency term for horizontal tracer advection 3rd order
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal advection tendency for tracer
-!> based on current state using a 3rd order formulation.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_hadv3_tend(grid, u, h_edge, tracers , tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: tracer
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, i, k, &
- boundaryMask, velMask
-
- integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnCell
- integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, &
- cellMask, edgeMask
-
- real (kind=RKIND) :: flux, tracer_edge, d2fdx2_cell1, d2fdx2_cell2, &
- invAreaCell1, invAreaCell2
-
- real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
- real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.hadv3On) return
-
- nEdges = grid % nEdges
- num_tracers = size(tracers, dim=1)
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- cellMask => grid % cellMask % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnCell => grid % cellsOnCell % array
- dvEdge => grid % dvEdge % array
- dcEdge => grid % dcEdge % array
- areaCell => grid % areaCell % array
- deriv_two => grid % deriv_two % array
-
- do iEdge=1,nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
-
- invAreaCell1 = 1.0 / areaCell(cell1)
- invAreaCell2 = 1.0 / areaCell(cell2)
-
- do k=1,maxLevelEdgeTop(iEdge)
-
- d2fdx2_cell1 = 0.0
- d2fdx2_cell2 = 0.0
-
- boundaryMask = abs(transfer(cellMask(k,cell1) == 1 .and. cellMask(k,cell2) == 1,boundaryMask))
-
- do iTracer=1,num_tracers
-
- !-- if not a boundary cell
- d2fdx2_cell1 = deriv_two(1,1,iEdge) * tracers(iTracer,k,cell1) * boundaryMask
- d2fdx2_cell2 = deriv_two(1,2,iEdge) * tracers(iTracer,k,cell2) * boundaryMask
-
- !-- all edges of cell 1
- do i=1,nEdgesOnCell(cell1) * boundaryMask
- d2fdx2_cell1 = d2fdx2_cell1 + &
- deriv_two(i+1,1,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell1))
- end do
-
- !-- all edges of cell 2
- do i=1,nEdgesOnCell(cell2) * boundaryMask
- d2fdx2_cell2 = d2fdx2_cell2 + &
- deriv_two(i+1,2,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell2))
- end do
-
-
- velMask = 2*(abs(transfer(u(k,iEdge) <= 0, velMask))) - 1
- flux = dvEdge(iEdge) * u(k,iEdge) * h_edge(k,iEdge) * ( &
- 0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2)) &
- -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
- +velMask*(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-
- !-- update tendency
- tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - flux*invAreaCell1
- tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + flux*invAreaCell2
- enddo
- end do
- end do
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_hadv3_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_hadv3_init
-!
-!> \brief Initializes ocean tracer horizontal advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> 3rd order horizontal tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_hadv3_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- err = 0
- hadv3On = .false.
-
- if (config_horiz_tracer_adv_order == 3) then
- hadv3On = .true.
-
- coef_3rd_order = config_coef_3rd_order
- end if
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_hadv3_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hadv3
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv4.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv4.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hadv4.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,229 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_hadv4
-!
-!> \brief MPAS ocean horizontal tracer advection 4th order
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hadv4
-
- use mpas_grid_types
- use mpas_configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_hadv4_tend, &
- ocn_tracer_hadv4_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: hadv4On !< Flag to turning on/off 4th order hadv
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_hadv4_tend
-!
-!> \brief Computes tendency term for horizontal tracer advection 4th order
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal advection tendency for tracer
-!> based on current state using a 4th order formulation.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_hadv4_tend(grid, u, h_edge, tracers , tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: tracer
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, i, k, &
- boundaryMask
-
- integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnCell
- integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, cellMask
-
- real (kind=RKIND) :: flux, tracer_edge, d2fdx2_cell1, d2fdx2_cell2, invAreaCell1, invAreaCell2
-
- real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
- real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.hadv4On) return
-
- nEdges = grid % nEdges
- num_tracers = size(tracers, dim=1)
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- cellMask => grid % cellMask % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnCell => grid % cellsOnCell % array
- dvEdge => grid % dvEdge % array
- dcEdge => grid % dcEdge % array
- areaCell => grid % areaCell % array
- deriv_two => grid % deriv_two % array
-
- do iEdge=1,nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
-
- invAreaCell1 = 1.0 / areaCell(cell1)
- invAreaCell2 = 1.0 / areaCell(cell2)
-
- do k=1,maxLevelEdgeTop(iEdge)
-
- d2fdx2_cell1 = 0.0
- d2fdx2_cell2 = 0.0
-
- boundaryMask = abs(transfer(cellMask(k,cell1) == 1 .and. cellMask(k, cell2) == 1, boundaryMask))
-
- do iTracer=1,num_tracers
- d2fdx2_cell1 = deriv_two(1,1,iEdge) * tracers(iTracer,k,cell1) * boundaryMask
- d2fdx2_cell2 = deriv_two(1,2,iEdge) * tracers(iTracer,k,cell2) * boundaryMask
-
- !-- all edges of cell 1
- do i=1,nEdgesOnCell(cell1) * boundaryMask
- d2fdx2_cell1 = d2fdx2_cell1 + &
- deriv_two(i+1,1,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell1))
- end do
-
- !-- all edges of cell 2
- do i=1,nEdgesOnCell(cell2) * boundaryMask
- d2fdx2_cell2 = d2fdx2_cell2 + &
- deriv_two(i+1,2,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell2))
- end do
-
- flux = dvEdge(iEdge) * u(k,iEdge) * h_edge(k,iEdge) * ( &
- 0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2)) &
- -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-
- !-- update tendency
- tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - flux * invAreaCell1
- tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + flux * invAreaCell2
- enddo
- end do
- end do
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_hadv4_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_hadv4_init
-!
-!> \brief Initializes ocean tracer horizontal advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes the 4th order formulation for
-!> horizontal tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_hadv4_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: Error flag
-
- err = 0
- hadv4On = .false.
-
- if (config_horiz_tracer_adv_order == 4) then
- hadv4On = .true.
- end if
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_hadv4_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hadv4
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hmix.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hmix.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hmix.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -73,7 +73,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_hmix_tend(grid, h_edge, tracers, tend, err)!{{{
+ subroutine ocn_tracer_hmix_tend(grid, layerThicknessEdge, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -82,7 +82,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
+ layerThicknessEdge !< Input: thickness at edge
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -126,10 +126,10 @@
if(.not.tracerHmixOn) return
call mpas_timer_start("del2", .false., del2Timer)
- call ocn_tracer_hmix_del2_tend(grid, h_edge, tracers, tend, err1)
+ call ocn_tracer_hmix_del2_tend(grid, layerThicknessEdge, tracers, tend, err1)
call mpas_timer_stop("del2", del2Timer)
call mpas_timer_start("del4", .false., del4Timer)
- call ocn_tracer_hmix_del4_tend(grid, h_edge, tracers, tend, err2)
+ call ocn_tracer_hmix_del4_tend(grid, layerThicknessEdge, tracers, tend, err2)
call mpas_timer_stop("del4", del4Timer)
err = ior(err1, err2)
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hmix_del2.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hmix_del2.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hmix_del2.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -67,7 +67,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_hmix_del2_tend(grid, h_edge, tracers, tend, err)!{{{
+ subroutine ocn_tracer_hmix_del2_tend(grid, layerThicknessEdge, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -76,7 +76,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
+ layerThicknessEdge !< Input: thickness at edge
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -168,7 +168,7 @@
tracer_turb_flux = tracers(iTracer, k, cell2) - tracers(iTracer, k, cell1)
! div(h \kappa_2 </font>
<font color="gray">abla \phi) at cell center
- flux = h_edge(k, iEdge) * tracer_turb_flux * edgeMask(k, iEdge) * r_tmp
+ flux = layerThicknessEdge(k, iEdge) * tracer_turb_flux * edgeMask(k, iEdge) * r_tmp
tend(iTracer, k, iCell) = tend(iTracer, k, iCell) - edgeSignOnCell(i, iCell) * flux * invAreaCell1
end do
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hmix_del4.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hmix_del4.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_hmix_del4.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -67,7 +67,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_hmix_del4_tend(grid, h_edge, tracers, tend, err)!{{{
+ subroutine ocn_tracer_hmix_del4_tend(grid, layerThicknessEdge, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -76,7 +76,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
+ layerThicknessEdge !< Input: thickness at edge
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -168,8 +168,8 @@
do k = 1, maxLevelEdgeTop(iEdge)
do iTracer = 1, num_tracers * edgeMask(k, iEdge)
- r_tmp1 = invdcEdge * h_edge(k, iEdge) * tracers(iTracer, k, cell1)
- r_tmp2 = invdcEdge * h_edge(k, iEdge) * tracers(iTracer, k, cell2)
+ r_tmp1 = invdcEdge * layerThicknessEdge(k, iEdge) * tracers(iTracer, k, cell1)
+ r_tmp2 = invdcEdge * layerThicknessEdge(k, iEdge) * tracers(iTracer, k, cell2)
delsq_tracer(iTracer, k, iCell) = delsq_tracer(iTracer, k, iCell) - edgeSignOnCell(i, iCell) * (r_tmp2 - r_tmp1) * invAreaCell1
end do
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,192 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_vadv
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv
-
- use mpas_grid_types
- use mpas_configure
-
- use ocn_tracer_vadv_stencil
- use ocn_tracer_vadv_spline
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_vadv_tend, &
- ocn_tracer_vadv_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: vadvOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_tend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_tend(grid, h, wTop, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h, & !< Input: layer thickness
- wTop !< Input: vertical tracer in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: err1, err2
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- ! mrp 120202 efficiency note:
- ! The following if statement is not needed, since wTop is set to
- ! zero for isopycnal coordinates. This if statment saves flops
- ! for isopycnal coordinates. However, if the loops are pushed
- ! out, we could get rid of this if statement.
- if(.not.vadvOn) return
-
- call ocn_tracer_vadv_stencil_tend(grid, h, wTop, tracers, tend, err1)
- call ocn_tracer_vadv_spline_tend(grid, h, wTop, tracers, tend, err2)
-
- err = ior(err1, err2)
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical tracer advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- integer :: err1, err2
-
- err = 0
- vadvOn = .false.
-
- if (config_vert_coord_movement.ne.'isopycnal') then
- vadvOn = .true.
- call ocn_tracer_vadv_stencil_init(err1)
- call ocn_tracer_vadv_spline_init(err2)
-
- err = ior(err1, err2)
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_spline.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_spline.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_spline.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,196 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_vadv_spline
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_spline
-
- use mpas_grid_types
- use mpas_configure
- use mpas_timer
-
- use ocn_tracer_vadv_spline2
- use ocn_tracer_vadv_spline3
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_vadv_spline_tend, &
- ocn_tracer_vadv_spline_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- type (timer_node), pointer :: spline2_timer, spline3_timer
- logical :: splineOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_spline_tend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_spline_tend(grid, h, wTop, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h, & !< Input: layer thickness
- wTop !< Input: vertical tracer in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: err1, err2
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.splineOn) return
-
- call mpas_timer_start("spline 2", .false., spline2_timer)
- call ocn_tracer_vadv_spline2_tend(grid, h, wTop, tracers, tend, err1)
- call mpas_timer_stop("spline 2", spline2_timer)
-
- call mpas_timer_start("spline 3", .false., spline3_timer)
- call ocn_tracer_vadv_spline3_tend(grid, h, wTop, tracers, tend, err2)
- call mpas_timer_stop("spline 3", spline3_timer)
-
- err = ior(err1, err2)
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_spline_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_spline_init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical tracer advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_spline_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- integer :: err1, err2
-
- err = 0
-
- splineOn = .false.
-
- if(config_vert_tracer_adv.eq.'spline') then
- splineOn = .true.
-
- call ocn_tracer_vadv_spline2_init(err1)
- call ocn_tracer_vadv_spline3_init(err2)
-
- err = ior(err1, err2)
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_spline_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_spline
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,208 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_vadv_spline2
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_spline2
-
- use mpas_grid_types
- use mpas_configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_vadv_spline2_tend, &
- ocn_tracer_vadv_spline2_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: spline2On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_spline2_tend
-!
-!> \brief Computes tendency term for vertical tracer advection 2nd order spline
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state using a 2nd order spline.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_spline2_tend(grid, h, wTop, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h, & !< Input: layer thickness
- wTop !< Input: vertical tracer in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iCell, nCells, nCellsSolve, k, iTracer, num_tracers, nVertLevels
-
- integer, dimension(:), pointer :: maxLevelCell
-
- real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.spline2On) return
- ! Compute tracerTop using linear interpolation.
-
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- nVertLevels = grid % nVertLevels
- num_tracers = size(tracers, 1)
- maxLevelCell => grid % maxLevelCell % array
-
- allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
- do iCell=1,nCellsSolve
- tracerTop(:,1,iCell) = tracers(:,1,iCell)
- do k=2,maxLevelCell(iCell)
- do iTracer=1,num_tracers
- ! Note h on the k side is multiplied by tracer at k-1
- ! and h on the Km1 (k-1) side is mult. by tracer at k.
- tracerTop(iTracer,k,iCell) = &
- ( h(k ,iCell)*tracers(iTracer,k-1,iCell) &
- + h(k-1,iCell)*tracers(iTracer,k ,iCell) ) &
- / (h(k-1,iCell) + h(k,iCell))
- end do
- end do
- tracerTop(:,maxLevelCell(iCell)+1,iCell) = tracers(:,maxLevelCell(iCell),iCell)
- end do
-
- do iCell=1,nCellsSolve
- do k=1,maxLevelCell(iCell)
- do iTracer=1,num_tracers
- tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &
- - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
- - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
- end do
- end do
- end do
-
- deallocate(tracerTop)
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_spline2_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_spline2_init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> 2nd order spline based vertical tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_spline2_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- err = 0
-
- spline2On = .false.
-
- if(config_vert_tracer_adv_order.eq.2) then
- spline2On = .true.
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_spline2_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_spline2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,235 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_vadv_spline3
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_spline3
-
- use mpas_grid_types
- use mpas_configure
- use mpas_spline_interpolation
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_vadv_spline3_tend, &
- ocn_tracer_vadv_spline3_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: spline3On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_spline3_tend
-!
-!> \brief Computes tendency term for vertical tracer advection 3rd order spline
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state using a 3rd order spline.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_spline3_tend(grid, h, wTop, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h, & !< Input: layer thickness
- wTop !< Input: vertical tracer in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iCell, nCells, nCellsSolve, k, iTracer, num_tracers, nVertLevels
-
- integer, dimension(:), pointer :: maxLevelCell
-
- real (kind=RKIND), dimension(:), allocatable :: tracer2ndDer, &
- tracersIn, tracersOut, depthTop, depthMid
- real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.spline3On) return
- ! Compute tracerTop using linear interpolation.
-
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- nVertLevels = grid % nVertLevels
- num_tracers = size(tracers, 1)
- maxLevelCell => grid % maxLevelCell % array
-
- allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
- ! Compute tracerTop using cubic spline interpolation.
-
- allocate(tracer2ndDer(nVertLevels))
- allocate(tracersIn(nVertLevels),tracersOut(nVertLevels), &
- depthMid(nVertLevels), depthTop(nVertLevels+1))
-
- do iCell=1,nCellsSolve
-
- ! Here depth considers SSH to be depth=0. We don't need to
- ! have true z-coordinate depths because it is just for interpolation.
- depthTop(1) = 0.0
- do k=1,maxLevelCell(iCell)
- depthMid(k ) = depthTop(k) + 0.5*h(k,iCell)
- depthTop(k+1) = depthTop(k) + h(k,iCell)
- enddo
-
- ! mrp 110201 efficiency note: push tracer loop down
- ! into spline subroutines to improve efficiency
- do iTracer=1,num_tracers
-
- ! Place data in arrays to avoid creating new temporary arrays for every
- ! subroutine call.
- tracersIn(1:maxLevelCell(iCell))=tracers(iTracer,1:maxLevelCell(iCell),iCell)
-
- call mpas_cubic_spline_coefficients(depthMid, &
- tracersIn, maxLevelCell(iCell), tracer2ndDer)
-
- call mpas_interpolate_cubic_spline( &
- depthMid, tracersIn, tracer2ndDer, maxLevelCell(iCell), &
- depthTop(2:maxLevelCell(iCell)), tracersOut, maxLevelCell(iCell)-1 )
-
- tracerTop(itracer,1,iCell) = tracers(iTracer,1,iCell)
- tracerTop(iTracer,2:maxLevelCell(iCell),iCell) = tracersOut(1:maxLevelCell(iCell)-1)
- tracerTop(itracer,maxLevelCell(iCell)+1,iCell) = tracers(iTracer,maxLevelCell(iCell),iCell)
- end do
- end do
-
- do iCell=1,nCellsSolve
- do k=1,maxLevelCell(iCell)
- do iTracer=1,num_tracers
- tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &
- - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
- - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
- end do
- end do
- end do
-
- deallocate(tracer2ndDer)
- deallocate(tracersIn,tracersOut, depthMid, depthTop)
- deallocate(tracerTop)
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_spline3_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_spline3_init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> 3rd order spline based vertical tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_spline3_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- err = 0
-
- spline3On = .false.
-
- if(config_vert_tracer_adv_order.eq.3) then
- spline3On = .true.
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_spline3_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_spline3
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,201 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_vadv_stencil
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_stencil
-
- use mpas_grid_types
- use mpas_configure
- use mpas_timer
-
- use ocn_tracer_vadv_stencil2
- use ocn_tracer_vadv_stencil3
- use ocn_tracer_vadv_stencil4
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_vadv_stencil_tend, &
- ocn_tracer_vadv_stencil_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- type (timer_node), pointer :: stencil2_timer, stencil3_timer, stencil4_timer
-
- logical :: stencilOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_stencil_tend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracers
-!> based on current state and user choices of stencil based advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_stencil_tend(grid, h, wTop, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h, & !< Input: layer thickness
- wTop !< Input: vertical tracer in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: err1, err2, err3
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not. stencilOn) return
-
- call mpas_timer_start("stencil 2", .false., stencil2_timer)
- call ocn_tracer_vadv_stencil2_tend(grid, wTop, tracers, tend, err1)
- call mpas_timer_stop("stencil 2", stencil2_timer)
- call mpas_timer_start("stencil 3", .false., stencil3_timer)
- call ocn_tracer_vadv_stencil3_tend(grid, h, wTop, tracers, tend, err2)
- call mpas_timer_stop("stencil 3", stencil3_timer)
- call mpas_timer_start("stencil 4", .false., stencil4_timer)
- call ocn_tracer_vadv_stencil4_tend(grid, h, wTop, tracers, tend, err3)
- call mpas_timer_stop("stencil 4", stencil4_timer)
-
- err = ior(err1, ior(err2, err3))
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_stencil_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_stencil_init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> stencil based vertical tracer advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_stencil_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- integer :: err1, err2, err3
-
- err = 0
-
- stencilOn = .false.
-
- if (config_vert_tracer_adv.eq.'stencil') then
- stencilOn = .true.
-
- call ocn_tracer_vadv_stencil2_init(err1)
- call ocn_tracer_vadv_stencil3_init(err2)
- call ocn_tracer_vadv_stencil4_init(err3)
-
- err = ior(err1, ior(err2, err3))
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_stencil_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_stencil
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,208 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_vadv_stencil2
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_stencil2
-
- use mpas_grid_types
- use mpas_configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_vadv_stencil2_tend, &
- ocn_tracer_vadv_stencil2_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: stencil2On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_stencil2_tend
-!
-!> \brief Computes tendency term for vertical tracer advection 2nd order stencil
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state using a 2nd order stencil.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_stencil2_tend(grid, wTop, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical tracer in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: nCellsSolve, iCell, k, iTracer, num_tracers, nVertLevels
- integer :: nCells
-
- integer, dimension(:), pointer :: maxLevelCell
-
- real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
-
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.stencil2On) return
-
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- num_tracers = size(tracers, 1)
- nVertLevels = grid % nVertLevels
- maxLevelCell => grid % maxLevelCell % array
-
- allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
- ! Compute tracerTop using centered stencil, a simple average.
-
- do iCell=1,nCellsSolve
- tracerTop(:,1,iCell) = tracers(:,1,iCell)
- do k=2,maxLevelCell(iCell)
- do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- ( tracers(iTracer,k-1,iCell) &
- +tracers(iTracer,k ,iCell))/2.0
- end do
- end do
- tracerTop(:,maxLevelCell(iCell)+1,iCell) = tracers(:,maxLevelCell(iCell),iCell)
- end do
-
- do iCell=1,nCellsSolve
- do k=1,maxLevelCell(iCell)
- do iTracer=1,num_tracers
- tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &
- - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
- - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
- end do
- end do
- end do
-
- deallocate(tracerTop)
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_stencil2_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_stencil2_init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> a 2nd order stencil based vertical tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_stencil2_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- integer :: err1, err2, err3
-
- err = 0
- stencil2On = .false.
-
- if(config_vert_tracer_adv_order.eq.2) then
- stencil2On = .true.
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_stencil2_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_stencil2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,230 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_vadv_stencil3
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_stencil3
-
- use mpas_grid_types
- use mpas_configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_vadv_stencil3_tend, &
- ocn_tracer_vadv_stencil3_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: stencil3On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_stencil3_tend
-!
-!> \brief Computes tendency term for vertical tracer advection 3rd order stencil
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state using a 3rd order stencil.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_stencil3_tend(grid, h, wTop, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h, & !< Input: layer thickness
- wTop !< Input: vertical tracer in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: nCellsSolve, iCell, k, iTracer, num_tracers, nVertLevels
- integer :: nCells
-
- integer, dimension(:), pointer :: maxLevelCell
-
- real (kind=RKIND) :: cSignWTop, flux3Coef
- real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
-
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.stencil3On) return
-
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- num_tracers = size(tracers, 1)
- nVertLevels = grid % nVertLevels
- maxLevelCell => grid % maxLevelCell % array
-
- allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
- ! Compute tracerTop using 3rd order stencil. This is the same
- ! as 4th order, but includes upwinding.
-
- ! Hardwire flux3Coeff at 1.0 for now. Could add this to the
- ! namelist, if desired.
- flux3Coef = 1.0
- do iCell=1,nCellsSolve
- tracerTop(:,1,iCell) = tracers(:,1,iCell)
- k=2
- do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- ( h(k,iCell)*tracers(iTracer,k-1,iCell) &
- + h(k-1,iCell)*tracers(iTracer,k ,iCell) ) &
- / (h(k-1,iCell) + h(k,iCell))
- end do
- do k=3,maxLevelCell(iCell)-1
- cSignWTop = sign(flux3Coef,wTop(k,iCell))
- do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- ( (-1.+ cSignWTop)*tracers(iTracer,k-2,iCell) &
- +( 7.-3.*cSignWTop)*tracers(iTracer,k-1,iCell) &
- +( 7.+3.*cSignWTop)*tracers(iTracer,k ,iCell) &
- +(-1.- cSignWTop)*tracers(iTracer,k+1,iCell) &
- )/12.
- end do
- end do
- k=maxLevelCell(iCell)
- do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- ( h(k,iCell)*tracers(iTracer,k-1,iCell) &
- + h(k-1,iCell)*tracers(iTracer,k ,iCell) ) &
- / (h(k-1,iCell) + h(k,iCell))
- end do
- tracerTop(:,maxLevelCell(iCell)+1,iCell) = tracers(:,maxLevelCell(iCell),iCell)
- end do
-
- do iCell=1,nCellsSolve
- do k=1,maxLevelCell(iCell)
- do iTracer=1,num_tracers
- tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &
- - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
- - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
- end do
- end do
- end do
-
- deallocate(tracerTop)
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_stencil3_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_stencil3_init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> 3rd order stencil based vertical tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_stencil3_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- err = 0
- stencil3On = .false.
-
- if(config_vert_tracer_adv_order.eq.3) then
- stencil3On = .true.
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_stencil3_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_stencil3
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,225 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_tracer_vadv_stencil4
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_stencil4
-
- use mpas_grid_types
- use mpas_configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_tracer_vadv_stencil4_tend, &
- ocn_tracer_vadv_stencil4_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: stencil4On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_stencil4_tend
-!
-!> \brief Computes tendency term for vertical tracer advection 4th order stencil
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state using a 4th order stencil.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_stencil4_tend(grid, h, wTop, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h, & !< Input: layer thickness
- wTop !< Input: vertical tracer in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tracer tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: nCellsSolve, iCell, k, iTracer, num_tracers, nVertLevels
- integer :: nCells
-
- integer, dimension(:), pointer :: maxLevelCell
-
- real (kind=RKIND) :: cSingWTop, flux3Coef
- real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
-
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
- ! tendencies will be added together
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.Stencil4On) return
-
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- num_tracers = size(tracers, 1)
- nVertLevels = grid % nVertLevels
- maxLevelCell => grid % maxLevelCell % array
-
- allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
- ! Compute tracerTop using 4rd order stencil [-1 7 7 -1]
-
- do iCell=1,nCellsSolve
- tracerTop(:,1,iCell) = tracers(:,1,iCell)
- k=2
- do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- ( h(k ,iCell)*tracers(iTracer,k-1,iCell) &
- + h(k-1,iCell)*tracers(iTracer,k ,iCell) ) &
- / (h(k-1,iCell) + h(k,iCell))
- end do
- do k=3,maxLevelCell(iCell)-1
- do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- (- tracers(iTracer,k-2,iCell) &
- +7.*tracers(iTracer,k-1,iCell) &
- +7.*tracers(iTracer,k ,iCell) &
- - tracers(iTracer,k+1,iCell) &
- )/12.
- end do
- end do
- k=maxLevelCell(iCell)
- do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- ( h(k ,iCell)*tracers(iTracer,k-1,iCell) &
- + h(k-1,iCell)*tracers(iTracer,k ,iCell) ) &
- / (h(k-1,iCell) + h(k,iCell))
- end do
- tracerTop(:,maxLevelCell(iCell)+1,iCell) = tracers(:,maxLevelCell(iCell),iCell)
- end do
-
- do iCell=1,nCellsSolve
- do k=1,maxLevelCell(iCell)
- do iTracer=1,num_tracers
- tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &
- - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
- - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
- end do
- end do
- end do
-
- deallocate(tracerTop)
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_stencil4_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_vadv_stencil4_init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> 4th order stencil based vertical tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vadv_stencil4_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- err = 0
- stencil4On = .false.
-
- if(config_vert_tracer_adv_order.eq.4) then
- stencil4On = .true.
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vadv_stencil4_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_stencil4
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_coriolis.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_coriolis.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_coriolis.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -63,7 +63,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_coriolis_tend(grid, Vor_edge, h_edge, u, ke, tend, err)!{{{
+ subroutine ocn_vel_coriolis_tend(grid, Vor_edge, layerThicknessEdge, normalVelocity, kineticEnergy, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -74,11 +74,11 @@
real (kind=RKIND), dimension(:,:), intent(in) :: &
Vor_edge !< Input: Potential vorticity on edge
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: Thickness on edge
+ layerThicknessEdge !< Input: Thickness on edge
real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: Horizontal velocity
+ normalVelocity !< Input: Horizontal velocity
real (kind=RKIND), dimension(:,:), intent(in) :: &
- ke !< Input: Kinetic Energy
+ kineticEnergy !< Input: Kinetic Energy
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -142,10 +142,10 @@
do j = 1,nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(j,iEdge)
workpv = 0.5 * (Vor_edge(k,iEdge) + Vor_edge(k,eoe))
- q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * h_edge(k,eoe)
+ q = q + weightsOnEdge(j,iEdge) * normalVelocity(k,eoe) * workpv * layerThicknessEdge(k,eoe)
end do
- tend(k,iEdge) = tend(k,iEdge) + edgeMask(k, iEdge) * (q - ( ke(k,cell2) - ke(k,cell1) ) * invLength )
+ tend(k,iEdge) = tend(k,iEdge) + edgeMask(k, iEdge) * (q - ( kineticEnergy(k,cell2) - kineticEnergy(k,cell1) ) * invLength )
end do
end do
@@ -186,7 +186,7 @@
coriolisOn = .true.
- if(config_disable_u_coriolis) coriolisOn = .false.
+ if(config_disable_vel_coriolis) coriolisOn = .false.
!--------------------------------------------------------------------
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_forcing.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_forcing.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_forcing.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -68,7 +68,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_forcing_tend(grid, u, u_src, ke_edge, h_edge, tend, err)!{{{
+ subroutine ocn_vel_forcing_tend(grid, u, normalVelocityForcing, kineticEnergyEdge, layerThicknessEdge, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -80,13 +80,13 @@
u !< Input: velocity
real (kind=RKIND), dimension(:,:), intent(in) :: &
- u_src !< Input: wind stress
+ normalVelocityForcing !< Input: wind stress
real (kind=RKIND), dimension(:,:), intent(in) :: &
- ke_edge !< Input: kinetic energy at edge
+ kineticEnergyEdge !< Input: kinetic energy at edge
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
+ layerThicknessEdge !< Input: thickness at edge
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -124,7 +124,7 @@
!
!-----------------------------------------------------------------
- call ocn_vel_forcing_windstress_tend(grid, u_src, h_edge, tend, err1)
+ call ocn_vel_forcing_windstress_tend(grid, normalVelocityForcing, layerThicknessEdge, tend, err1)
call ocn_vel_forcing_rayleigh_tend(grid, u, tend, err2)
err = ior(err1, err2)
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_forcing_rayleigh.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_forcing_rayleigh.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_forcing_rayleigh.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -64,7 +64,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_forcing_rayleigh_tend(grid, u, tend, err)!{{{
+ subroutine ocn_vel_forcing_rayleigh_tend(grid, normalVelocity, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -73,7 +73,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
+ normalVelocity !< Input: velocity
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -122,7 +122,7 @@
do iEdge=1,nEdgesSolve
do k=1,maxLevelEdgeTop(iEdge)
- tend(k,iEdge) = tend(k,iEdge) - rayleighDampingCoef * u(k,iEdge)
+ tend(k,iEdge) = tend(k,iEdge) - rayleighDampingCoef * normalVelocity(k,iEdge)
enddo
enddo
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_forcing_windstress.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_forcing_windstress.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_forcing_windstress.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -62,7 +62,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_forcing_windstress_tend(grid, u_src, h_edge, tend, err)!{{{
+ subroutine ocn_vel_forcing_windstress_tend(grid, normalVelocityForcing, layerThicknessEdge, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -71,10 +71,10 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- u_src !< Input: wind stress
+ normalVelocityForcing !< Input: wind stress
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
+ layerThicknessEdge !< Input: thickness at edge
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -130,7 +130,7 @@
do k = 1,min(maxLevelEdgeTop(iEdge),1)
! forcing in top layer only
- tend(k,iEdge) = tend(k,iEdge) + edgeMask(k, iEdge) * (u_src(k,iEdge) / config_rho0 / h_edge(k,iEdge))
+ tend(k,iEdge) = tend(k,iEdge) + edgeMask(k, iEdge) * (normalVelocityForcing(k,iEdge) / config_density0 / layerThicknessEdge(k,iEdge))
enddo
enddo
@@ -168,7 +168,7 @@
windStressOn = .true.
- if(config_disable_u_windstress) windStressOn = .false.
+ if(config_disable_vel_windstress) windStressOn = .false.
err = 0
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -74,7 +74,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_hmix_tend(grid, divergence, vorticity, viscosity, tend, err)!{{{
+ subroutine ocn_vel_hmix_tend(grid, divergence, relativeVorticity, viscosity, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -86,7 +86,7 @@
divergence !< Input: velocity divergence
real (kind=RKIND), dimension(:,:), intent(in) :: &
- vorticity !< Input: vorticity
+ relativeVorticity !< Input: relative vorticity
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -132,15 +132,15 @@
viscosity = 0.0
call mpas_timer_start("del2", .false., del2Timer)
- call ocn_vel_hmix_del2_tend(grid, divergence, vorticity, viscosity, tend, err1)
+ call ocn_vel_hmix_del2_tend(grid, divergence, relativeVorticity, viscosity, tend, err1)
call mpas_timer_stop("del2", del2Timer)
call mpas_timer_start("leith", .false., leithTimer)
- call ocn_vel_hmix_leith_tend(grid, divergence, vorticity, viscosity, tend, err2)
+ call ocn_vel_hmix_leith_tend(grid, divergence, relativeVorticity, viscosity, tend, err2)
call mpas_timer_stop("leith", leithTimer)
call mpas_timer_start("del4", .false., del4Timer)
- call ocn_vel_hmix_del4_tend(grid, divergence, vorticity, tend, err3)
+ call ocn_vel_hmix_del4_tend(grid, divergence, relativeVorticity, tend, err3)
call mpas_timer_stop("del4", del4Timer)
err = ior(ior(err1, err2),err3)
@@ -187,7 +187,7 @@
err = ior(ior(err1, err2),err3)
- if(config_disable_u_hmix) hmixOn = .false.
+ if(config_disable_vel_hmix) hmixOn = .false.
!--------------------------------------------------------------------
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix_del2.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix_del2.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix_del2.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -64,13 +64,13 @@
!> This routine computes the horizontal mixing tendency for momentum
!> based on a Laplacian form for the mixing, \f$</font>
<font color="black">u_2 </font>
<font color="red">abla^2 u\f$
!> This tendency takes the
-!> form \f$</font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity )\f$,
+!> form \f$</font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="black">abla relativeVorticity )\f$,
!> where \f$</font>
<font color="black">u\f$ is a viscosity and \f$k\f$ is the vertical unit vector.
!> This form is strictly only valid for constant \f$</font>
<font color="gray">u\f$ .
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_hmix_del2_tend(grid, divergence, vorticity, viscosity, tend, err)!{{{
+ subroutine ocn_vel_hmix_del2_tend(grid, divergence, relativeVorticity, viscosity, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -82,7 +82,7 @@
divergence !< Input: velocity divergence
real (kind=RKIND), dimension(:,:), intent(in) :: &
- vorticity !< Input: vorticity
+ relativeVorticity !< Input: relative vorticity
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -151,13 +151,13 @@
do k=1,maxLevelEdgeTop(iEdge)
- ! Here -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
- ! is - </font>
<font color="red">abla vorticity pointing from vertex 2 to vertex 1, or equivalently
- ! + k \times </font>
<font color="blue">abla vorticity pointing from cell1 to cell2.
+ ! Here -( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) / dvEdge(iEdge)
+ ! is - </font>
<font color="blue">abla relativeVorticity pointing from vertex 2 to vertex 1, or equivalently
+ ! + k \times </font>
<font color="gray">abla relativeVorticity pointing from cell1 to cell2.
u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) * invLength1 &
-viscVortCoef &
- *( vorticity(k,vertex2) - vorticity(k,vertex1) ) * invLength2
+ *( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) * invLength2
visc2 = meshScalingDel2(iEdge) * eddyVisc2
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix_del4.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix_del4.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix_del4.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -66,13 +66,13 @@
!> based on a biharmonic form for the mixing. This mixing tendency
!> takes the form \f$-</font>
<font color="black">u_4 </font>
<font color="red">abla^4 u\f$
!> but is computed as
-!> \f$</font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity\f$
+!> \f$</font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="black">abla relativeVorticity\f$
!> applied recursively.
!> This formulation is only valid for constant \f$</font>
<font color="gray">u_4\f$ .
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_hmix_del4_tend(grid, divergence, vorticity, tend, err)!{{{
+ subroutine ocn_vel_hmix_del4_tend(grid, divergence, relativeVorticity, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -84,7 +84,7 @@
divergence !< Input: velocity divergence
real (kind=RKIND), dimension(:,:), intent(in) :: &
- vorticity !< Input: vorticity
+ relativeVorticity !< Input: relative vorticity
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -127,7 +127,7 @@
meshScalingDel4, areaCell
real (kind=RKIND), dimension(:,:), allocatable :: delsq_divergence, &
- delsq_circulation, delsq_vorticity, delsq_u
+ delsq_circulation, delsq_relativeVorticity, delsq_u
err = 0
@@ -159,10 +159,10 @@
allocate(delsq_u(nVertLEvels, nEdges+1))
allocate(delsq_divergence(nVertLevels, nCells+1))
- allocate(delsq_vorticity(nVertLevels, nVertices+1))
+ allocate(delsq_relativeVorticity(nVertLevels, nVertices+1))
delsq_u(:,:) = 0.0
- delsq_vorticity(:,:) = 0.0
+ delsq_relativeVorticity(:,:) = 0.0
delsq_divergence(:,:) = 0.0
!Compute delsq_u
@@ -177,19 +177,19 @@
invDvEdge = 1.0 / dvEdge(iEdge)
do k=1,maxLevelEdgeTop(iEdge)
- ! Compute </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity
+ ! Compute </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="gray">abla relativeVorticity
delsq_u(k, iEdge) = ( divergence(k,cell2) - divergence(k,cell1) ) * invDcEdge &
- -viscVortCoef *( vorticity(k,vertex2) - vorticity(k,vertex1)) * invDcEdge * sqrt(3.0) ! TDR
+ -viscVortCoef *( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1)) * invDcEdge * sqrt(3.0)
end do
end do
- ! Compute delsq_vorticity
+ ! Compute delsq_relativeVorticity
do iVertex = 1, nVertices
invAreaTri1 = 1.0 / areaTriangle(iVertex)
do i = 1, vertexDegree
iEdge = edgesOnVertex(i, iVertex)
do k = 1, maxLevelVertexTop(iVertex)
- delsq_vorticity(k, iVertex) = delsq_vorticity(k, iVertex) + edgeSignOnVertex(i, iVertex) * dcEdge(iEdge) * delsq_u(k, iEdge) * invAreaTri1
+ delsq_relativeVorticity(k, iVertex) = delsq_relativeVorticity(k, iVertex) + edgeSignOnVertex(i, iVertex) * dcEdge(iEdge) * delsq_u(k, iEdge) * invAreaTri1
end do
end do
end do
@@ -219,7 +219,7 @@
do k=1,maxLevelEdgeTop(iEdge)
u_diffusion = (delsq_divergence(k,cell2) - delsq_divergence(k,cell1)) * invDcEdge &
- -viscVortCoef * (delsq_vorticity(k,vertex2) - delsq_vorticity(k,vertex1) ) * invDcEdge * sqrt(3.0) ! TDR
+ -viscVortCoef * (delsq_relativeVorticity(k,vertex2) - delsq_relativeVorticity(k,vertex1) ) * invDcEdge * sqrt(3.0)
tend(k,iEdge) = tend(k,iEdge) - edgeMask(k, iEdge) * u_diffusion * r_tmp
end do
@@ -227,7 +227,7 @@
deallocate(delsq_u)
deallocate(delsq_divergence)
- deallocate(delsq_vorticity)
+ deallocate(delsq_relativeVorticity)
!--------------------------------------------------------------------
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix_leith.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix_leith.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_hmix_leith.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -76,7 +76,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_hmix_leith_tend(grid, divergence, vorticity, viscosity, tend, err)!{{{
+ subroutine ocn_vel_hmix_leith_tend(grid, divergence, relativeVorticity, viscosity, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -88,7 +88,7 @@
divergence !< Input: velocity divergence
real (kind=RKIND), dimension(:,:), intent(in) :: &
- vorticity !< Input: vorticity
+ relativeVorticity !< Input: relative vorticity
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -157,19 +157,19 @@
do k=1,maxLevelEdgeTop(iEdge)
- ! Here -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
- ! is - </font>
<font color="red">abla vorticity pointing from vertex 2 to vertex 1, or equivalently
- ! + k \times </font>
<font color="blue">abla vorticity pointing from cell1 to cell2.
+ ! Here -( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) / dvEdge(iEdge)
+ ! is - </font>
<font color="blue">abla relativeVorticity pointing from vertex 2 to vertex 1, or equivalently
+ ! + k \times </font>
<font color="red">abla relativeVorticity pointing from cell1 to cell2.
u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) * invLength1 &
-viscVortCoef &
- *( vorticity(k,vertex2) - vorticity(k,vertex1) ) * invLength2
+ *( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) * invLength2
! Here the first line is (\delta x)^3
! the second line is |</font>
<font color="black">abla \omega|
! and u_diffusion is </font>
<font color="gray">abla^2 u (see formula for $\bf{D}$ above).
visc2 = ( config_leith_parameter * config_leith_dx * meshScaling(iEdge) / 3.14)**3 &
- * abs( vorticity(k,vertex2) - vorticity(k,vertex1) ) * invLength1 * sqrt(3.0)
+ * abs( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) * invLength1 * sqrt(3.0)
visc2 = min(visc2, config_leith_visc2_max)
tend(k,iEdge) = tend(k,iEdge) + edgeMask(k, iEdge) * visc2 * u_diffusion
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_pressure_grad.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_pressure_grad.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_pressure_grad.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -45,7 +45,7 @@
!--------------------------------------------------------------------
logical :: pgradOn
- real (kind=RKIND) :: rho0Inv, grho0Inv
+ real (kind=RKIND) :: density0Inv, gdensity0Inv
!***********************************************************************
@@ -66,7 +66,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_pressure_grad_tend(grid, pressure, zMid, rho, tend, err)!{{{
+ subroutine ocn_vel_pressure_grad_tend(grid, pressure, zMid, density, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -77,7 +77,7 @@
real (kind=RKIND), dimension(:,:), intent(in) :: &
pressure, & !< Input: Pressure field or Mongomery potential
zMid, & !< Input: z-coordinate at mid-depth of layer
- rho !< Input: density
+ density !< Input: density
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -123,12 +123,12 @@
edgeMask => grid % edgeMask % array
! pressure for generalized coordinates
- ! -1/rho_0 (grad p_k + rho g grad z_k^{mid})
+ ! -1/density_0 (grad p_k + density g grad z_k^{mid})
! For pure isopycnal coordinates, we are still using
! grad(M), the gradient of Montgomery Potential, because
- ! we have set rho0Inv=1 and grho0Inv=0 in the init routine,
- ! and pressure is passed in as MontPot.
+ ! we have set density0Inv=1 and gdensity0Inv=0 in the init routine,
+ ! and pressure is passed in as montgomeryPotential.
do iEdge=1,nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
@@ -137,9 +137,9 @@
do k=1,maxLevelEdgeTop(iEdge)
tend(k,iEdge) = tend(k,iEdge) &
- - edgeMask(k,iEdge) * rho0Inv*( pressure(k,cell2) &
+ - edgeMask(k,iEdge) * density0Inv*( pressure(k,cell2) &
- pressure(k,cell1) )* invdcEdge &
- - edgeMask(k,iEdge) * grho0Inv* 0.5*(rho(k,cell1)+rho(k,cell2)) &
+ - edgeMask(k,iEdge) * gdensity0Inv* 0.5*(density(k,cell1)+density(k,cell2)) &
*( zMid(k,cell2) &
- zMid(k,cell1) )* invdcEdge
@@ -192,14 +192,14 @@
pgradOn = .true.
if (config_pressure_gradient_type.eq.'MontgomeryPotential') then
- rho0Inv = 1.0
- grho0Inv = 0.0
+ density0Inv = 1.0
+ gdensity0Inv = 0.0
else
- rho0Inv = 1.0/config_rho0
- grho0Inv = gravity/config_rho0
+ density0Inv = 1.0/config_density0
+ gdensity0Inv = gravity/config_density0
end if
- if(config_disable_u_pgrad) pgradOn = .false.
+ if(config_disable_vel_pgrad) pgradOn = .false.
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_vadv.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_vadv.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vel_vadv.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -64,7 +64,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_vadv_tend(grid, u, h_edge, wTop, tend, err)!{{{
+ subroutine ocn_vel_vadv_tend(grid, u, layerThicknessEdge, vertTransportVelocityTop, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -75,8 +75,8 @@
real (kind=RKIND), dimension(:,:), intent(in) :: &
u !< Input: Horizontal velocity
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge,&!< Input: thickness at edge
- wTop !< Input: Vertical velocity on top layer
+ layerThicknessEdge,&!< Input: thickness at edge
+ vertTransportVelocityTop !< Input: Vertical velocity on top layer
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -109,14 +109,9 @@
integer, dimension(:), pointer :: maxLevelEdgeTop
integer, dimension(:,:), pointer :: cellsOnEdge, edgeMask
- real (kind=RKIND) :: wTopEdge
+ real (kind=RKIND) :: vertTransportVelocityTopEdge
real (kind=RKIND), dimension(:), allocatable :: w_dudzTopEdge
- ! mrp 120202 efficiency note:
- ! The following if statement is not needed, since wTop is set to
- ! zero for isopycnal coordinates. This if statment saves flops
- ! for isopycnal coordinates. However, if the loops are pushed
- ! out, we could get rid of this if statement.
if(.not.velVadvOn) return
err = 0
@@ -135,11 +130,11 @@
do k=2,maxLevelEdgeTop(iEdge)
! Average w from cell center to edge
- wTopEdge = 0.5*(wTop(k,cell1)+wTop(k,cell2))
+ vertTransportVelocityTopEdge = 0.5*(vertTransportVelocityTop(k,cell1)+vertTransportVelocityTop(k,cell2))
! compute dudz at vertical interface with first order derivative.
- w_dudzTopEdge(k) = wTopEdge * (u(k-1,iEdge)-u(k,iEdge)) &
- / (0.5*(h_edge(k-1,iEdge) + h_edge(k,iEdge)))
+ w_dudzTopEdge(k) = vertTransportVelocityTopEdge * (u(k-1,iEdge)-u(k,iEdge)) &
+ / (0.5*(layerThicknessEdge(k-1,iEdge) + layerThicknessEdge(k,iEdge)))
end do
w_dudzTopEdge(maxLevelEdgeTop(iEdge)+1) = 0.0
! Average w*du/dz from vertical interface to vertical middle of cell
@@ -187,7 +182,7 @@
velVadvOn = .true.
end if
- if(config_disable_u_vadv) velVadvOn = .false.
+ if(config_disable_vel_vadv) velVadvOn = .false.
!--------------------------------------------------------------------
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vmix.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vmix.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vmix.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -149,7 +149,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_vmix_tend_implicit(grid, dt, ke_edge, vertViscTopOfEdge, h, h_edge, u, err)!{{{
+ subroutine ocn_vel_vmix_tend_implicit(grid, dt, kineticEnergyEdge, vertViscTopOfEdge, layerThickness, layerThicknessEdge, normalVelocity, err)!{{{
!-----------------------------------------------------------------
!
@@ -161,7 +161,7 @@
grid !< Input: grid information
real (kind=RKIND), dimension(:,:), intent(in) :: &
- ke_edge !< Input: kinetic energy at edge
+ kineticEnergyEdge !< Input: kinetic energy at edge
real (kind=RKIND), dimension(:,:), intent(in) :: &
vertViscTopOfEdge !< Input: vertical mixing coefficients
@@ -170,7 +170,7 @@
dt !< Input: time step
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness at cell center
+ layerThickness !< Input: thickness at cell center
!-----------------------------------------------------------------
!
@@ -179,10 +179,10 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(inout) :: &
- u !< Input: velocity
+ normalVelocity !< Input: velocity
real (kind=RKIND), dimension(:,:), intent(inout) :: &
- h_edge !< Input: thickness at edge
+ layerThicknessEdge !< Input: thickness at edge
!-----------------------------------------------------------------
!
@@ -204,7 +204,7 @@
integer, dimension(:,:), pointer :: cellsOnEdge
- real (kind=RKIND), dimension(:), allocatable :: A, B, C, uTemp
+ real (kind=RKIND), dimension(:), allocatable :: A, B, C, velTemp
err = 0
@@ -215,7 +215,7 @@
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
cellsOnEdge => grid % cellsOnEdge % array
- allocate(A(nVertLevels),B(nVertLevels),C(nVertLevels),uTemp(nVertLevels))
+ allocate(A(nVertLevels),B(nVertLevels),C(nVertLevels),velTemp(nVertLevels))
A(1)=0
do iEdge=1,nEdges
@@ -223,26 +223,26 @@
if (N.gt.0) then
! Compute A(k), B(k), C(k)
- ! h_edge is computed in compute_solve_diag, and is not available yet,
- ! so recompute h_edge here.
+ ! layerThicknessEdge is computed in compute_solve_diag, and is not available yet,
+ ! so recompute layerThicknessEdge here.
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k=1,N
- h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
+ layerThicknessEdge(k,iEdge) = 0.5 * (layerThickness(k,cell1) + layerThickness(k,cell2))
end do
! A is lower diagonal term
do k=2,N
A(k) = -2.0*dt*vertViscTopOfEdge(k,iEdge) &
- / (h_edge(k-1,iEdge) + h_edge(k,iEdge)) &
- / h_edge(k,iEdge)
+ / (layerThicknessEdge(k-1,iEdge) + layerThicknessEdge(k,iEdge)) &
+ / layerThicknessEdge(k,iEdge)
enddo
! C is upper diagonal term
do k=1,N-1
C(k) = -2.0*dt*vertViscTopOfEdge(k+1,iEdge) &
- / (h_edge(k,iEdge) + h_edge(k+1,iEdge)) &
- / h_edge(k,iEdge)
+ / (layerThicknessEdge(k,iEdge) + layerThicknessEdge(k+1,iEdge)) &
+ / layerThicknessEdge(k,iEdge)
enddo
! B is diagonal term
@@ -253,17 +253,17 @@
! Apply bottom drag boundary condition on the viscous term
B(N) = 1 - A(N) + dt*config_bottom_drag_coeff &
- *sqrt(2.0*ke_edge(k,iEdge))/h_edge(k,iEdge)
+ *sqrt(2.0*kineticEnergyEdge(k,iEdge))/layerThicknessEdge(k,iEdge)
- call tridiagonal_solve(A(2:N),B,C(1:N-1),u(:,iEdge),uTemp,N)
+ call tridiagonal_solve(A(2:N),B,C(1:N-1),normalVelocity(:,iEdge),velTemp,N)
- u(1:N,iEdge) = uTemp(1:N)
- u(N+1:nVertLevels,iEdge) = 0.0
+ normalVelocity(1:N,iEdge) = velTemp(1:N)
+ normalVelocity(N+1:nVertLevels,iEdge) = 0.0
end if
end do
- deallocate(A,B,C,uTemp)
+ deallocate(A,B,C,velTemp)
!--------------------------------------------------------------------
@@ -283,7 +283,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_vmix_tend_implicit(grid, dt, vertDiffTopOfCell, h, tracers, err)!{{{
+ subroutine ocn_tracer_vmix_tend_implicit(grid, dt, vertDiffTopOfCell, layerThickness, tracers, err)!{{{
!-----------------------------------------------------------------
!
@@ -301,7 +301,7 @@
dt !< Input: time step
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness at cell center
+ layerThickness !< Input: thickness at cell center
!-----------------------------------------------------------------
!
@@ -352,13 +352,13 @@
A(1)=0
do k=2,N
A(k) = -2.0*dt*vertDiffTopOfCell(k,iCell) &
- / (h(k-1,iCell) + h(k,iCell)) / h(k,iCell)
+ / (layerThickness(k-1,iCell) + layerThickness(k,iCell)) / layerThickness(k,iCell)
enddo
! C is upper diagonal term
do k=1,N-1
C(k) = -2.0*dt*vertDiffTopOfCell(k+1,iCell) &
- / (h(k,iCell) + h(k+1,iCell)) / h(k,iCell)
+ / (layerThickness(k,iCell) + layerThickness(k+1,iCell)) / layerThickness(k,iCell)
enddo
C(N) = 0.0
@@ -403,17 +403,17 @@
integer, intent(out) :: err
integer :: nCells
- real (kind=RKIND), dimension(:,:), pointer :: u, h, h_edge, vertViscTopOfEdge, vertDiffTopOfCell, ke_edge
+ real (kind=RKIND), dimension(:,:), pointer :: normalVelocity, layerThickness, layerThicknessEdge, vertViscTopOfEdge, vertDiffTopOfCell, kineticEnergyEdge
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
integer, dimension(:), pointer :: maxLevelCell
err = 0
- u => state % u % array
+ normalVelocity => state % normalVelocity % array
tracers => state % tracers % array
- h => state % h % array
- h_edge => state % h_edge % array
- ke_edge => state % ke_edge % array
+ layerThickness => state % layerThickness % array
+ layerThicknessEdge => state % layerThicknessEdge % array
+ kineticEnergyEdge => state % kineticEnergyEdge % array
vertViscTopOfEdge => diagnostics % vertViscTopOfEdge % array
vertDiffTopOfCell => diagnostics % vertDiffTopOfCell % array
maxLevelCell => grid % maxLevelCell % array
@@ -425,13 +425,13 @@
!
! Implicit vertical solve for momentum
!
- call ocn_vel_vmix_tend_implicit(grid, dt, ke_edge, vertViscTopOfEdge, h, h_edge, u, err)
+ call ocn_vel_vmix_tend_implicit(grid, dt, kineticEnergyEdge, vertViscTopOfEdge, layerThickness, layerThicknessEdge, normalVelocity, err)
!
! Implicit vertical solve for tracers
!
- call ocn_tracer_vmix_tend_implicit(grid, dt, vertDiffTopOfCell, h, tracers, err)
+ call ocn_tracer_vmix_tend_implicit(grid, dt, vertDiffTopOfCell, layerThickness, tracers, err)
end subroutine ocn_vmix_implicit!}}}
@@ -469,7 +469,7 @@
velVmixOn = .true.
tracerVmixOn = .true.
- if(config_disable_u_vmix) velVmixOn = .false.
+ if(config_disable_vel_vmix) velVmixOn = .false.
if(config_disable_tr_vmix) tracerVmixOn = .false.
call ocn_vmix_coefs_const_init(err1)
Modified: branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vmix_coefs_rich.F
===================================================================
--- branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vmix_coefs_rich.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_ocean/mpas_ocn_vmix_coefs_rich.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -109,7 +109,7 @@
integer :: err1, err2, err3, indexT, indexS
real (kind=RKIND), dimension(:,:), pointer :: &
- vertViscTopOfEdge, vertDiffTopOfCell, u, h, h_edge, rho, rhoDisplaced
+ vertViscTopOfEdge, vertDiffTopOfCell, normalVelocity, layerThickness, layerThicknessEdge, density, displacedDensity
real (kind=RKIND), dimension(:,:), pointer :: RiTopOfEdge, RiTopOfCell
@@ -133,23 +133,23 @@
RiTopOfEdge => d % RiTopOfEdge % array
RiTopOfCell => d % RiTopOfCell % array
- u => s % u % array
- h => s % h % array
- h_edge => s % h_edge % array
- rho => s % rho % array
- rhoDisplaced => s % rhoDisplaced % array
+ normalVelocity => s % normalVelocity % array
+ layerThickness => s % layerThickness % array
+ layerThicknessEdge => s % layerThicknessEdge % array
+ density => s % density % array
+ displacedDensity => s % displacedDensity % array
tracers => s % tracers % array
call mpas_timer_start("eos rich", .false., richEOSTimer)
- call ocn_equation_of_state_rho(s, grid, 0,'relative', err)
- call ocn_equation_of_state_rho(s, grid, 1,'relative', err)
+ call ocn_equation_of_state_density(s, grid, 0,'relative', err)
+ call ocn_equation_of_state_density(s, grid, 1,'relative', err)
call mpas_timer_stop("eos rich", richEOSTimer)
- call ocn_vmix_get_rich_numbers(grid, indexT, indexS, u, h, h_edge, &
- rho, rhoDisplaced, tracers, RiTopOfEdge, RiTopOfCell, err1)
+ call ocn_vmix_get_rich_numbers(grid, indexT, indexS, normalVelocity, layerThickness, layerThicknessEdge, &
+ density, displacedDensity, tracers, RiTopOfEdge, RiTopOfCell, err1)
- call ocn_vel_vmix_coefs_rich(grid, RiTopOfEdge, h_edge, vertViscTopOfEdge, err2)
- call ocn_tracer_vmix_coefs_rich(grid, RiTopOfCell, h, vertDiffTopOfCell, err3)
+ call ocn_vel_vmix_coefs_rich(grid, RiTopOfEdge, layerThicknessEdge, vertViscTopOfEdge, err2)
+ call ocn_tracer_vmix_coefs_rich(grid, RiTopOfCell, layerThickness, vertDiffTopOfCell, err3)
err = ior(err1, ior(err2, err3))
@@ -170,7 +170,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_vmix_coefs_rich(grid, RiTopOfEdge, h_edge, vertViscTopOfEdge, err)!{{{
+ subroutine ocn_vel_vmix_coefs_rich(grid, RiTopOfEdge, layerThicknessEdge, vertViscTopOfEdge, err)!{{{
!-----------------------------------------------------------------
!
@@ -182,7 +182,7 @@
grid !< Input: grid information
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
+ layerThicknessEdge !< Input: thickness at edge
real (kind=RKIND), dimension(:,:), intent(in) :: &
RiTopOfEdge !< Richardson number at top of edge
@@ -223,13 +223,11 @@
do iEdge = 1,nEdges
do k = 2,maxLevelEdgeTop(iEdge)
- ! mrp 110324 efficiency note: this if is inside iEdge and k loops.
+ ! efficiency note: these if statements are inside iEdge and k loops.
! Perhaps there is a more efficient way to do this.
if (RiTopOfEdge(k,iEdge)>0.0) then
vertViscTopOfEdge(k,iEdge) = vertViscTopOfEdge(k, iEdge) + config_bkrd_vert_visc &
+ config_rich_mix / (1.0 + 5.0*RiTopOfEdge(k,iEdge))**2
- ! maltrud do limiting of coefficient--should not be necessary
- ! also probably better logic could be found
if (vertViscTopOfEdge(k,iEdge) > config_convective_visc) then
vertViscTopOfEdge(k,iEdge) = config_convective_visc
end if
@@ -258,7 +256,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_vmix_coefs_rich(grid, RiTopOfCell, h, vertDiffTopOfCell, err)!{{{
+ subroutine ocn_tracer_vmix_coefs_rich(grid, RiTopOfCell, layerThickness, vertDiffTopOfCell, err)!{{{
!-----------------------------------------------------------------
!
@@ -270,7 +268,7 @@
grid !< Input: grid information
real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness at cell center
+ layerThickness !< Input: thickness at cell center
real (kind=RKIND), dimension(:,:), intent(in) :: &
RiTopOfCell !< Input: Richardson number at top of cell
@@ -311,18 +309,16 @@
maxLevelCell => grid % maxLevelCell % array
- coef = -gravity/config_rho0/2.0
+ coef = -gravity/config_density0/2.0
do iCell = 1,nCells
do k = 2,maxLevelCell(iCell)
- ! mrp 110324 efficiency note: this if is inside iCell and k loops.
+ ! efficiency note: these if statements are inside iEdge and k loops.
! Perhaps there is a more efficient way to do this.
if (RiTopOfCell(k,iCell)>0.0) then
vertDiffTopOfCell(k,iCell) = vertDiffTopOfCell(k, iCell) + config_bkrd_vert_diff &
+ (config_bkrd_vert_visc &
+ config_rich_mix / (1.0 + 5.0*RiTopOfCell(k,iCell))**2) &
/ (1.0 + 5.0*RiTopOfCell(k,iCell))
- ! maltrud do limiting of coefficient--should not be necessary
- ! also probably better logic could be found
if (vertDiffTopOfCell(k,iCell) > config_convective_diff) then
vertDiffTopOfCell(k,iCell) = config_convective_diff
end if
@@ -352,8 +348,8 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vmix_get_rich_numbers(grid, indexT, indexS, u, h, h_edge, & !{{{
- rho, rhoDisplaced, tracers, RiTopOfEdge, RiTopOfCell, err)
+ subroutine ocn_vmix_get_rich_numbers(grid, indexT, indexS, normalVelocity, layerThickness, layerThicknessEdge, & !{{{
+ density, displacedDensity, tracers, RiTopOfEdge, RiTopOfCell, err)
!-----------------------------------------------------------------
!
@@ -367,9 +363,9 @@
integer, intent(in) :: indexT !< Input: index for temperature
integer, intent(in) :: indexS !< Input: index for salinity
- real (kind=RKIND), dimension(:,:), intent(in) :: u !< Input: horizontal velocity
- real (kind=RKIND), dimension(:,:), intent(in) :: h !< Input: thickness
- real (kind=RKIND), dimension(:,:), intent(in) :: h_edge !< Input: thickness at edge
+ real (kind=RKIND), dimension(:,:), intent(in) :: normalVelocity !< Input: horizontal velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: layerThickness !< Input: thickness
+ real (kind=RKIND), dimension(:,:), intent(in) :: layerThicknessEdge !< Input: thickness at edge
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: tracers
@@ -385,8 +381,8 @@
!
!-----------------------------------------------------------------
- real (kind=RKIND), dimension(:,:), intent(inout) :: rho !< Input/output: density
- real (kind=RKIND), dimension(:,:), intent(inout) :: rhoDisplaced !< Input/output: displaced density
+ real (kind=RKIND), dimension(:,:), intent(inout) :: density !< Input/output: density
+ real (kind=RKIND), dimension(:,:), intent(inout) :: displacedDensity !< Input/output: displaced density
real (kind=RKIND), dimension(:,:), intent(inout) :: RiTopOfEdge !< Input/output: Richardson number top of cell
real (kind=RKIND), dimension(:,:), intent(inout) :: RiTopOfCell !< Input/output: Richardson number top of cell
@@ -406,8 +402,8 @@
real (kind=RKIND) :: coef, invAreaCell
real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaCell
- real (kind=RKIND), dimension(:,:), allocatable :: drhoTopOfCell, du2TopOfCell, &
- drhoTopOfEdge, du2TopOfEdge
+ real (kind=RKIND), dimension(:,:), allocatable :: ddensityTopOfCell, du2TopOfCell, &
+ ddensityTopOfEdge, du2TopOfEdge
err = 0
@@ -429,36 +425,26 @@
edgeSignOnCell => grid % edgeSignOnCell % array
allocate( &
- drhoTopOfCell(nVertLevels+1,nCells+1), drhoTopOfEdge(nVertLevels+1,nEdges), &
+ ddensityTopOfCell(nVertLevels+1,nCells+1), ddensityTopOfEdge(nVertLevels+1,nEdges), &
du2TopOfCell(nVertLevels+1,nCells+1), du2TopOfEdge(nVertLevels+1,nEdges))
- ! compute density of parcel displaced to next deeper z-level,
- ! in state % rhoDisplaced
-!maltrud make sure rho is current--check this for redundancy
-! call OcnEquationOfStateRho(grid, 'relative', 0, indexT, indexS, &
-! tracers, rho, err)
- ! mrp 110324 In order to visualize rhoDisplaced, include the following
-! call OcnEquationOfStateRho(grid, 'relative', 1, indexT, indexS, &
-! tracers, rhoDisplaced, err)
-
-
- ! drhoTopOfCell(k) = $\rho^*_{k-1}-\rho^*_k$
- drhoTopOfCell = 0.0
+ ! ddensityTopOfCell(k) = $\density^*_{k-1}-\density^*_k$
+ ddensityTopOfCell = 0.0
do iCell=1,nCells
do k=2,maxLevelCell(iCell)
- drhoTopOfCell(k,iCell) = rhoDisplaced(k-1,iCell) - rhoDisplaced(k,iCell)
+ ddensityTopOfCell(k,iCell) = displacedDensity(k-1,iCell) - displacedDensity(k,iCell)
end do
end do
- ! interpolate drhoTopOfCell to drhoTopOfEdge
- drhoTopOfEdge = 0.0
+ ! interpolate ddensityTopOfCell to ddensityTopOfEdge
+ ddensityTopOfEdge = 0.0
do iEdge=1,nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k=2,maxLevelEdgeTop(iEdge)
- drhoTopOfEdge(k,iEdge) = &
- (drhoTopOfCell(k,cell1) + &
- drhoTopOfCell(k,cell2))/2
+ ddensityTopOfEdge(k,iEdge) = &
+ (ddensityTopOfCell(k,cell1) + &
+ ddensityTopOfCell(k,cell2))/2
end do
end do
@@ -466,7 +452,7 @@
du2TopOfEdge=0.0
do iEdge=1,nEdges
do k=2,maxLevelEdgeTop(iEdge)
- du2TopOfEdge(k,iEdge) = (u(k-1,iEdge) - u(k,iEdge))**2
+ du2TopOfEdge(k,iEdge) = (normalVelocity(k-1,iEdge) - normalVelocity(k,iEdge))**2
end do
end do
@@ -483,30 +469,30 @@
end do
end do
- ! compute RiTopOfEdge using drhoTopOfEdge and du2TopOfEdge
- ! coef = -g/rho_0/2
+ ! compute RiTopOfEdge using ddensityTopOfEdge and du2TopOfEdge
+ ! coef = -g/density_0/2
RiTopOfEdge = 0.0
- coef = -gravity/config_rho0/2.0
+ coef = -gravity/config_density0/2.0
do iEdge = 1,nEdges
do k = 2,maxLevelEdgeTop(iEdge)
- RiTopOfEdge(k,iEdge) = coef*drhoTopOfEdge(k,iEdge) &
- *(h_edge(k-1,iEdge)+h_edge(k,iEdge)) &
+ RiTopOfEdge(k,iEdge) = coef*ddensityTopOfEdge(k,iEdge) &
+ *(layerThicknessEdge(k-1,iEdge)+layerThicknessEdge(k,iEdge)) &
/ (du2TopOfEdge(k,iEdge) + 1e-20)
end do
end do
- ! compute RiTopOfCell using drhoTopOfCell and du2TopOfCell
- ! coef = -g/rho_0/2
+ ! compute RiTopOfCell using ddensityTopOfCell and du2TopOfCell
+ ! coef = -g/density_0/2
RiTopOfCell = 0.0
do iCell = 1,nCells
do k = 2,maxLevelCell(iCell)
- RiTopOfCell(k,iCell) = coef*drhoTopOfCell(k,iCell) &
- *(h(k-1,iCell)+h(k,iCell)) &
+ RiTopOfCell(k,iCell) = coef*ddensityTopOfCell(k,iCell) &
+ *(layerThickness(k-1,iCell)+layerThickness(k,iCell)) &
/ (du2TopOfCell(k,iCell) + 1e-20)
end do
end do
- deallocate(drhoTopOfCell, drhoTopOfEdge, &
+ deallocate(ddensityTopOfCell, ddensityTopOfEdge, &
du2TopOfCell, du2TopOfEdge)
!--------------------------------------------------------------------
Deleted: branches/mpas_cdg_advection/src/core_sw/Registry
===================================================================
--- branches/mpas_cdg_advection/src/core_sw/Registry 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/core_sw/Registry 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,165 +0,0 @@
-%
-% namelist type namelist_record name default_value
-%
-namelist integer sw_model config_test_case 5
-namelist character sw_model config_time_integration RK4
-namelist real sw_model config_dt 172.8
-namelist character sw_model config_calendar_type 360day
-namelist character sw_model config_start_time 0000-01-01_00:00:00
-namelist character sw_model config_stop_time none
-namelist character sw_model config_run_duration none
-namelist integer sw_model config_stats_interval 100
-namelist logical sw_model config_h_ScaleWithMesh false
-namelist real sw_model config_h_mom_eddy_visc2 0.0
-namelist real sw_model config_h_mom_eddy_visc4 0.0
-namelist real sw_model config_h_tracer_eddy_diff2 0.0
-namelist real sw_model config_h_tracer_eddy_diff4 0.0
-namelist integer sw_model config_thickness_adv_order 2
-namelist integer sw_model config_tracer_adv_order 2
-namelist logical sw_model config_positive_definite false
-namelist logical sw_model config_monotonic false
-namelist logical sw_model config_wind_stress false
-namelist logical sw_model config_bottom_drag false
-namelist real sw_model config_apvm_upwinding 0.5
-namelist integer sw_model config_num_halos 2
-namelist character io config_input_name grid.nc
-namelist character io config_output_name output.nc
-namelist character io config_restart_name restart.nc
-namelist character io config_output_interval 06:00:00
-namelist integer io config_frames_per_outfile 0
-namelist integer io config_pio_num_iotasks 0
-namelist integer io config_pio_stride 1
-namelist character decomposition config_block_decomp_file_prefix graph.info.part.
-namelist integer decomposition config_number_of_blocks 0
-namelist logical decomposition config_explicit_proc_decomp .false.
-namelist character decomposition config_proc_decomp_file_prefix graph.info.part.
-namelist logical restart config_do_restart false
-namelist character restart config_restart_interval none
-
-%
-% dim type name_in_file name_in_code
-%
-dim nCells nCells
-dim nEdges nEdges
-dim maxEdges maxEdges
-dim maxEdges2 maxEdges2
-dim nVertices nVertices
-dim TWO 2
-dim R3 3
-dim FIFTEEN 15
-dim TWENTYONE 21
-dim vertexDegree vertexDegree
-dim nVertLevels nVertLevels
-dim nTracers nTracers
-
-%
-% var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class
-%
-var persistent text xtime ( Time ) 2 ro xtime state - -
-
-var persistent real latCell ( nCells ) 0 iro latCell mesh - -
-var persistent real lonCell ( nCells ) 0 iro lonCell mesh - -
-var persistent real xCell ( nCells ) 0 iro xCell mesh - -
-var persistent real yCell ( nCells ) 0 iro yCell mesh - -
-var persistent real zCell ( nCells ) 0 iro zCell mesh - -
-var persistent integer indexToCellID ( nCells ) 0 iro indexToCellID mesh - -
-
-var persistent real latEdge ( nEdges ) 0 iro latEdge mesh - -
-var persistent real lonEdge ( nEdges ) 0 iro lonEdge mesh - -
-var persistent real xEdge ( nEdges ) 0 iro xEdge mesh - -
-var persistent real yEdge ( nEdges ) 0 iro yEdge mesh - -
-var persistent real zEdge ( nEdges ) 0 iro zEdge mesh - -
-var persistent integer indexToEdgeID ( nEdges ) 0 iro indexToEdgeID mesh - -
-
-var persistent real latVertex ( nVertices ) 0 iro latVertex mesh - -
-var persistent real lonVertex ( nVertices ) 0 iro lonVertex mesh - -
-var persistent real xVertex ( nVertices ) 0 iro xVertex mesh - -
-var persistent real yVertex ( nVertices ) 0 iro yVertex mesh - -
-var persistent real zVertex ( nVertices ) 0 iro zVertex mesh - -
-var persistent integer indexToVertexID ( nVertices ) 0 iro indexToVertexID mesh - -
-
-var persistent real meshDensity ( nCells ) 0 iro meshDensity mesh - -
-var persistent real meshScalingDel2 ( nEdges ) 0 ro meshScalingDel2 mesh - -
-var persistent real meshScalingDel4 ( nEdges ) 0 ro meshScalingDel4 mesh - -
-
-var persistent integer cellsOnEdge ( TWO nEdges ) 0 iro cellsOnEdge mesh - -
-var persistent integer nEdgesOnCell ( nCells ) 0 iro nEdgesOnCell mesh - -
-var persistent integer nEdgesOnEdge ( nEdges ) 0 iro nEdgesOnEdge mesh - -
-var persistent integer edgesOnCell ( maxEdges nCells ) 0 iro edgesOnCell mesh - -
-var persistent integer edgesOnEdge ( maxEdges2 nEdges ) 0 iro edgesOnEdge mesh - -
-
-var persistent real weightsOnEdge ( maxEdges2 nEdges ) 0 iro weightsOnEdge mesh - -
-var persistent real dvEdge ( nEdges ) 0 iro dvEdge mesh - -
-var persistent real dcEdge ( nEdges ) 0 iro dcEdge mesh - -
-var persistent real angleEdge ( nEdges ) 0 iro angleEdge mesh - -
-var persistent real areaCell ( nCells ) 0 iro areaCell mesh - -
-var persistent real areaTriangle ( nVertices ) 0 iro areaTriangle mesh - -
-
-var persistent real edgeNormalVectors ( R3 nEdges ) 0 o edgeNormalVectors mesh - -
-var persistent real localVerticalUnitVectors ( R3 nCells ) 0 o localVerticalUnitVectors mesh - -
-var persistent real cellTangentPlane ( R3 TWO nCells ) 0 o cellTangentPlane mesh - -
-
-var persistent integer cellsOnCell ( maxEdges nCells ) 0 iro cellsOnCell mesh - -
-var persistent integer verticesOnCell ( maxEdges nCells ) 0 iro verticesOnCell mesh - -
-var persistent integer verticesOnEdge ( TWO nEdges ) 0 iro verticesOnEdge mesh - -
-var persistent integer edgesOnVertex ( vertexDegree nVertices ) 0 iro edgesOnVertex mesh - -
-var persistent integer cellsOnVertex ( vertexDegree nVertices ) 0 iro cellsOnVertex mesh - -
-var persistent real kiteAreasOnVertex ( vertexDegree nVertices ) 0 iro kiteAreasOnVertex mesh - -
-var persistent real fEdge ( nEdges ) 0 iro fEdge mesh - -
-var persistent real fVertex ( nVertices ) 0 iro fVertex mesh - -
-var persistent real fCell ( nCells ) 0 iro fCell mesh - -
-var persistent real h_s ( nCells ) 0 iro h_s mesh - -
-
-% Space needed for advection
-var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 o deriv_two mesh - -
-var persistent integer advCells ( TWENTYONE nCells ) 0 - advCells mesh - -
-
-% !! NOTE: the following arrays are needed to allow the use
-% !! of the module_advection.F w/o alteration
-% Space needed for deformation calculation weights
-var persistent real defc_a ( maxEdges nCells ) 0 - defc_a mesh - -
-var persistent real defc_b ( maxEdges nCells ) 0 - defc_b mesh - -
-var persistent real kdiff ( nVertLevels nCells Time ) 0 - kdiff mesh - -
-
-% Arrays required for reconstruction of velocity field
-var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 - coeffs_reconstruct mesh - -
-
-% Boundary conditions: read from input, saved in restart and written to output
-var persistent integer boundaryEdge ( nVertLevels nEdges ) 0 iro boundaryEdge mesh - -
-var persistent integer boundaryVertex ( nVertLevels nVertices ) 0 iro boundaryVertex mesh - -
-var persistent integer boundaryCell ( nVertLevels nCells ) 0 iro boundaryCell mesh - -
-var persistent real u_src ( nVertLevels nEdges ) 0 iro u_src mesh - -
-
-% Prognostic variables: read from input, saved in restart, and written to output
-var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
-var persistent real h ( nVertLevels nCells Time ) 2 iro h state - -
-var persistent real tracers ( nTracers nVertLevels nCells Time ) 2 iro tracers state - -
-
-% Tendency variables
-var persistent real tend_u ( nVertLevels nEdges Time ) 1 - u tend - -
-var persistent real tend_h ( nVertLevels nCells Time ) 1 - h tend - -
-var persistent real tend_tracers ( nTracers nVertLevels nCells Time ) 1 - tracers tend - -
-
-% Diagnostic fields: only written to output
-var persistent real v ( nVertLevels nEdges Time ) 2 o v state - -
-var persistent real divergence ( nVertLevels nCells Time ) 2 o divergence state - -
-var persistent real vorticity ( nVertLevels nVertices Time ) 2 o vorticity state - -
-var persistent real vorticity_cell ( nVertLevels nCells Time ) 2 o vorticity_cell state - -
-var persistent real pv_edge ( nVertLevels nEdges Time ) 2 o pv_edge state - -
-var persistent real h_edge ( nVertLevels nEdges Time ) 2 o h_edge state - -
-var persistent real ke ( nVertLevels nCells Time ) 2 o ke state - -
-var persistent real pv_vertex ( nVertLevels nVertices Time ) 2 o pv_vertex state - -
-var persistent real pv_cell ( nVertLevels nCells Time ) 2 o pv_cell state - -
-var persistent real uReconstructX ( nVertLevels nCells Time ) 2 o uReconstructX state - -
-var persistent real uReconstructY ( nVertLevels nCells Time ) 2 o uReconstructY state - -
-var persistent real uReconstructZ ( nVertLevels nCells Time ) 2 o uReconstructZ state - -
-var persistent real uReconstructZonal ( nVertLevels nCells Time ) 2 o uReconstructZonal state - -
-var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 2 o uReconstructMeridional state - -
-
-% Other diagnostic variables: neither read nor written to any files
-var persistent real vh ( nVertLevels nEdges Time ) 2 - vh state - -
-var persistent real circulation ( nVertLevels nVertices Time ) 2 - circulation state - -
-var persistent real gradPVt ( nVertLevels nEdges Time ) 2 - gradPVt state - -
-var persistent real gradPVn ( nVertLevels nEdges Time ) 2 - gradPVn state - -
-var persistent real h_vertex ( nVertLevels nVertices Time ) 2 - h_vertex state - -
-
Copied: branches/mpas_cdg_advection/src/core_sw/Registry.xml (from rev 2782, trunk/mpas/src/core_sw/Registry.xml)
===================================================================
--- branches/mpas_cdg_advection/src/core_sw/Registry.xml (rev 0)
+++ branches/mpas_cdg_advection/src/core_sw/Registry.xml 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,146 @@
+<?xml version="1.0"?>
+<registry model="mpas" core="sw" version="0.0.0">
+ <dims>
+ <dim name="nCells"/>
+ <dim name="nEdges"/>
+ <dim name="maxEdges"/>
+ <dim name="maxEdges2"/>
+ <dim name="nVertices"/>
+ <dim name="TWO" definition="2"/>
+ <dim name="R3" definition="3"/>
+ <dim name="FIFTEEN" definition="15"/>
+ <dim name="TWENTYONE" definition="21"/>
+ <dim name="vertexDegree"/>
+ <dim name="nVertLevels"/>
+ <dim name="nTracers"/>
+ </dims>
+ <nml_record name="sw_model">
+ <nml_option name="config_test_case" type="integer" default_value="5"/>
+ <nml_option name="config_time_integration" type="character" default_value="RK4"/>
+ <nml_option name="config_dt" type="real" default_value="172.8"/>
+ <nml_option name="config_calendar_type" type="character" default_value="360day"/>
+ <nml_option name="config_start_time" type="character" default_value="0000-01-01_00:00:00"/>
+ <nml_option name="config_stop_time" type="character" default_value="none"/>
+ <nml_option name="config_run_duration" type="character" default_value="none"/>
+ <nml_option name="config_stats_interval" type="integer" default_value="100"/>
+ <nml_option name="config_h_ScaleWithMesh" type="logical" default_value="false"/>
+ <nml_option name="config_h_mom_eddy_visc2" type="real" default_value="0.0"/>
+ <nml_option name="config_h_mom_eddy_visc4" type="real" default_value="0.0"/>
+ <nml_option name="config_h_tracer_eddy_diff2" type="real" default_value="0.0"/>
+ <nml_option name="config_h_tracer_eddy_diff4" type="real" default_value="0.0"/>
+ <nml_option name="config_thickness_adv_order" type="integer" default_value="2"/>
+ <nml_option name="config_tracer_adv_order" type="integer" default_value="2"/>
+ <nml_option name="config_positive_definite" type="logical" default_value="false"/>
+ <nml_option name="config_monotonic" type="logical" default_value="false"/>
+ <nml_option name="config_wind_stress" type="logical" default_value="false"/>
+ <nml_option name="config_bottom_drag" type="logical" default_value="false"/>
+ <nml_option name="config_apvm_upwinding" type="real" default_value="0.5"/>
+ <nml_option name="config_num_halos" type="integer" default_value="2"/>
+ </nml_record>
+ <nml_record name="io">
+ <nml_option name="config_input_name" type="character" default_value="grid.nc"/>
+ <nml_option name="config_output_name" type="character" default_value="output.nc"/>
+ <nml_option name="config_restart_name" type="character" default_value="restart.nc"/>
+ <nml_option name="config_output_interval" type="character" default_value="06:00:00"/>
+ <nml_option name="config_frames_per_outfile" type="integer" default_value="0"/>
+ <nml_option name="config_pio_num_iotasks" type="integer" default_value="0"/>
+ <nml_option name="config_pio_stride" type="integer" default_value="1"/>
+ </nml_record>
+ <nml_record name="decomposition">
+ <nml_option name="config_block_decomp_file_prefix" type="character" default_value="graph.info.part."/>
+ <nml_option name="config_number_of_blocks" type="integer" default_value="0"/>
+ <nml_option name="config_explicit_proc_decomp" type="logical" default_value=".false."/>
+ <nml_option name="config_proc_decomp_file_prefix" type="character" default_value="graph.info.part."/>
+ </nml_record>
+ <nml_record name="restart">
+ <nml_option name="config_do_restart" type="logical" default_value="false"/>
+ <nml_option name="config_restart_interval" type="character" default_value="none"/>
+ </nml_record>
+ <var_struct name="state" time_levs="2">
+ <var name="xtime" type="text" dimensions="Time" streams="ro"/>
+ <var name="u" type="real" dimensions="nVertLevels nEdges Time" streams="iro"/>
+ <var name="h" type="real" dimensions="nVertLevels nCells Time" streams="iro"/>
+ <var name="tracers" type="real" dimensions="nTracers nVertLevels nCells Time" streams="iro"/>
+ <var name="v" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="divergence" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="vorticity" type="real" dimensions="nVertLevels nVertices Time" streams="o"/>
+ <var name="vorticity_cell" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="pv_edge" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="h_edge" type="real" dimensions="nVertLevels nEdges Time" streams="o"/>
+ <var name="ke" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="pv_vertex" type="real" dimensions="nVertLevels nVertices Time" streams="o"/>
+ <var name="pv_cell" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructX" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructY" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructZ" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructZonal" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="uReconstructMeridional" type="real" dimensions="nVertLevels nCells Time" streams="o"/>
+ <var name="vh" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="circulation" type="real" dimensions="nVertLevels nVertices Time"/>
+ <var name="gradPVt" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="gradPVn" type="real" dimensions="nVertLevels nEdges Time"/>
+ <var name="h_vertex" type="real" dimensions="nVertLevels nVertices Time"/>
+ </var_struct>
+ <var_struct name="mesh" time_levs="0">
+ <var name="latCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="lonCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="xCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="yCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="zCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="indexToCellID" type="integer" dimensions="nCells" streams="iro"/>
+ <var name="latEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="lonEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="xEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="yEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="zEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="indexToEdgeID" type="integer" dimensions="nEdges" streams="iro"/>
+ <var name="latVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="lonVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="xVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="yVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="zVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="indexToVertexID" type="integer" dimensions="nVertices" streams="iro"/>
+ <var name="meshDensity" type="real" dimensions="nCells" streams="iro"/>
+ <var name="meshScalingDel2" type="real" dimensions="nEdges" streams="ro"/>
+ <var name="meshScalingDel4" type="real" dimensions="nEdges" streams="ro"/>
+ <var name="cellsOnEdge" type="integer" dimensions="TWO nEdges" streams="iro"/>
+ <var name="nEdgesOnCell" type="integer" dimensions="nCells" streams="iro"/>
+ <var name="nEdgesOnEdge" type="integer" dimensions="nEdges" streams="iro"/>
+ <var name="edgesOnCell" type="integer" dimensions="maxEdges nCells" streams="iro"/>
+ <var name="edgesOnEdge" type="integer" dimensions="maxEdges2 nEdges" streams="iro"/>
+ <var name="weightsOnEdge" type="real" dimensions="maxEdges2 nEdges" streams="iro"/>
+ <var name="dvEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="dcEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="angleEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="areaCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="areaTriangle" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="edgeNormalVectors" type="real" dimensions="R3 nEdges" streams="o"/>
+ <var name="localVerticalUnitVectors" type="real" dimensions="R3 nCells" streams="o"/>
+ <var name="cellTangentPlane" type="real" dimensions="R3 TWO nCells" streams="o"/>
+ <var name="cellsOnCell" type="integer" dimensions="maxEdges nCells" streams="iro"/>
+ <var name="verticesOnCell" type="integer" dimensions="maxEdges nCells" streams="iro"/>
+ <var name="verticesOnEdge" type="integer" dimensions="TWO nEdges" streams="iro"/>
+ <var name="edgesOnVertex" type="integer" dimensions="vertexDegree nVertices" streams="iro"/>
+ <var name="cellsOnVertex" type="integer" dimensions="vertexDegree nVertices" streams="iro"/>
+ <var name="kiteAreasOnVertex" type="real" dimensions="vertexDegree nVertices" streams="iro"/>
+ <var name="fEdge" type="real" dimensions="nEdges" streams="iro"/>
+ <var name="fVertex" type="real" dimensions="nVertices" streams="iro"/>
+ <var name="fCell" type="real" dimensions="nCells" streams="iro"/>
+ <var name="h_s" type="real" dimensions="nCells" streams="iro"/>
+ <var name="deriv_two" type="real" dimensions="FIFTEEN TWO nEdges" streams="o"/>
+ <var name="advCells" type="integer" dimensions="TWENTYONE nCells"/>
+ <var name="defc_a" type="real" dimensions="maxEdges nCells"/>
+ <var name="defc_b" type="real" dimensions="maxEdges nCells"/>
+ <var name="kdiff" type="real" dimensions="nVertLevels nCells Time"/>
+ <var name="coeffs_reconstruct" type="real" dimensions="R3 maxEdges nCells"/>
+ <var name="boundaryEdge" type="integer" dimensions="nVertLevels nEdges" streams="iro"/>
+ <var name="boundaryVertex" type="integer" dimensions="nVertLevels nVertices" streams="iro"/>
+ <var name="boundaryCell" type="integer" dimensions="nVertLevels nCells" streams="iro"/>
+ <var name="u_src" type="real" dimensions="nVertLevels nEdges" streams="iro"/>
+ </var_struct>
+ <var_struct name="tend" time_levs="1">
+ <var name="tend_u" type="real" dimensions="nVertLevels nEdges Time" name_in_code="u"/>
+ <var name="tend_h" type="real" dimensions="nVertLevels nCells Time" name_in_code="h"/>
+ <var name="tend_tracers" type="real" dimensions="nTracers nVertLevels nCells Time" name_in_code="tracers"/>
+ </var_struct>
+</registry>
Modified: branches/mpas_cdg_advection/src/framework/Makefile
===================================================================
--- branches/mpas_cdg_advection/src/framework/Makefile 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/Makefile 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,9 +1,5 @@
.SUFFIXES: .F .o
-ifdef ZOLTAN_HOME
- ZOLTANOBJ = mpas_zoltan_interface.o
-endif
-
OBJS = mpas_kind_types.o \
mpas_framework.o \
mpas_timer.o \
@@ -22,7 +18,6 @@
mpas_io_streams.o \
mpas_io_input.o \
mpas_io_output.o \
- $(ZOLTANOBJ) \
streams.o
all: framework
@@ -58,7 +53,7 @@
mpas_io_streams.o: mpas_attlist.o mpas_grid_types.o mpas_timekeeping.o mpas_io.o
-mpas_io_input.o: mpas_grid_types.o mpas_dmpar.o mpas_block_decomp.o mpas_block_creator.o mpas_sort.o mpas_configure.o mpas_timekeeping.o mpas_io_streams.o $(ZOLTANOBJ)
+mpas_io_input.o: mpas_grid_types.o mpas_dmpar.o mpas_block_decomp.o mpas_block_creator.o mpas_sort.o mpas_configure.o mpas_timekeeping.o mpas_io_streams.o
mpas_io_output.o: mpas_grid_types.o mpas_dmpar.o mpas_sort.o mpas_configure.o mpas_io_streams.o
Modified: branches/mpas_cdg_advection/src/framework/mpas_attlist.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_attlist.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_attlist.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,16 @@
+!***********************************************************************
+!
+! mpas_attlist
+!
+!> \brief MPAS Attribute list module
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This module provides type definitions and subroutines for working with attribute lists.
+!
+!-----------------------------------------------------------------------
+
module mpas_attlist
use mpas_kind_types
@@ -42,15 +55,26 @@
contains
+!***********************************************************************
+!
+! routine mpas_add_att_int0d
+!
+!> \brief MPAS Add 0D integer attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine adds a 0D integer attribute the attribute list.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_add_att_int0d(attList, attName, attValue, ierr)!{{{
- subroutine mpas_add_att_int0d(attList, attName, attValue, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- integer, intent(in) :: attValue
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input/Output: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ integer, intent(in) :: attValue !< Input: Attribute value
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -72,17 +96,28 @@
write(cursor % attName,'(a)') trim(attName)
cursor % attValueInt = attValue
- end subroutine mpas_add_att_int0d
+ end subroutine mpas_add_att_int0d!}}}
+!***********************************************************************
+!
+! routine mpas_add_att_int1d
+!
+!> \brief MPAS Add 1D integer attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine adds a 1D integer attribute the attribute list.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_add_att_int1d(attList, attName, attValue, ierr)!{{{
- subroutine mpas_add_att_int1d(attList, attName, attValue, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- integer, dimension(:), intent(in) :: attValue
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input/Output: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ integer, dimension(:), intent(in) :: attValue !< Input: Attribute value
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -105,17 +140,28 @@
write(cursor % attName,'(a)') trim(attName)
cursor % attValueIntA(:) = attValue(:)
- end subroutine mpas_add_att_int1d
+ end subroutine mpas_add_att_int1d!}}}
+!***********************************************************************
+!
+! routine mpas_add_att_real0d
+!
+!> \brief MPAS Add 0D real attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine adds a 0D real attribute the attribute list.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_add_att_real0d(attList, attName, attValue, ierr)!{{{
- subroutine mpas_add_att_real0d(attList, attName, attValue, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- real (kind=RKIND), intent(in) :: attValue
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input/Output: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ real (kind=RKIND), intent(in) :: attValue !< Input: Attribute value
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -137,17 +183,28 @@
write(cursor % attName,'(a)') trim(attName)
cursor % attValueReal = attValue
- end subroutine mpas_add_att_real0d
+ end subroutine mpas_add_att_real0d!}}}
+!***********************************************************************
+!
+! routine mpas_add_att_real1d
+!
+!> \brief MPAS Add 1D real attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine adds a 1D real attribute the attribute list.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_add_att_real1d(attList, attName, attValue, ierr)!{{{
- subroutine mpas_add_att_real1d(attList, attName, attValue, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- real (kind=RKIND), dimension(:), intent(in) :: attValue
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input/Output: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ real (kind=RKIND), dimension(:), intent(in) :: attValue !< Input: Attribute value
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -170,17 +227,28 @@
write(cursor % attName,'(a)') trim(attName)
cursor % attValueRealA(:) = attValue(:)
- end subroutine mpas_add_att_real1d
+ end subroutine mpas_add_att_real1d!}}}
+!***********************************************************************
+!
+! routine mpas_add_att_text
+!
+!> \brief MPAS Add text attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine adds a text attribute the attribute list.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_add_att_text(attList, attName, attValue, ierr)!{{{
- subroutine mpas_add_att_text(attList, attName, attValue, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- character (len=*), intent(in) :: attValue
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input/Output: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ character (len=*), intent(in) :: attValue !< Input: Attribute value
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -202,17 +270,28 @@
write(cursor % attName,'(a)') trim(attName)
write(cursor % attValueText,'(a)') trim(attValue)
- end subroutine mpas_add_att_text
+ end subroutine mpas_add_att_text!}}}
+!***********************************************************************
+!
+! routine mpas_get_att_int0d
+!
+!> \brief MPAS get 0D integer attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine returns the attribute value of a 0D integer attribute.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_get_att_int0d(attList, attName, attValue, ierr)!{{{
- subroutine mpas_get_att_int0d(attList, attName, attValue, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- integer, intent(out) :: attValue
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ integer, intent(out) :: attValue !< Output: Attribute value
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -233,17 +312,28 @@
if (present(ierr)) ierr = 1 ! Not found
- end subroutine mpas_get_att_int0d
+ end subroutine mpas_get_att_int0d!}}}
+!***********************************************************************
+!
+! routine mpas_get_att_int1d
+!
+!> \brief MPAS get 1D integer attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine returns the attribute value of a 1D integer attribute.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_get_att_int1d(attList, attName, attValue, ierr)!{{{
- subroutine mpas_get_att_int1d(attList, attName, attValue, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- integer, dimension(:), pointer :: attValue
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ integer, dimension(:), pointer :: attValue !< Output: Attribute value
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -265,17 +355,28 @@
if (present(ierr)) ierr = 1 ! Not found
- end subroutine mpas_get_att_int1d
+ end subroutine mpas_get_att_int1d!}}}
+!***********************************************************************
+!
+! routine mpas_get_att_real0d
+!
+!> \brief MPAS get 0D real attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine returns the attribute value of a 0D real attribute.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_get_att_real0d(attList, attName, attValue, ierr)!{{{
- subroutine mpas_get_att_real0d(attList, attName, attValue, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- real (kind=RKIND), intent(out) :: attValue
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ real (kind=RKIND), intent(out) :: attValue !< Output: Attribute value
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -296,17 +397,28 @@
if (present(ierr)) ierr = 1 ! Not found
- end subroutine mpas_get_att_real0d
+ end subroutine mpas_get_att_real0d!}}}
+!***********************************************************************
+!
+! routine mpas_get_att_real1d
+!
+!> \brief MPAS get 1D real attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine returns the attribute value of a 1D real attribute.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_get_att_real1d(attList, attName, attValue, ierr)!{{{
- subroutine mpas_get_att_real1d(attList, attName, attValue, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- real (kind=RKIND), dimension(:), pointer :: attValue
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ real (kind=RKIND), dimension(:), pointer :: attValue !< Output: Attribute value
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -328,17 +440,28 @@
if (present(ierr)) ierr = 1 ! Not found
- end subroutine mpas_get_att_real1d
+ end subroutine mpas_get_att_real1d!}}}
+!***********************************************************************
+!
+! routine mpas_get_att_text
+!
+!> \brief MPAS get text attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine returns the attribute value of a text attribute.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_get_att_text(attList, attName, attValue, ierr)!{{{
- subroutine mpas_get_att_text(attList, attName, attValue, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- character (len=*), intent(out) :: attValue
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ character (len=*), intent(out) :: attValue !< Output: Attribute value
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -359,16 +482,27 @@
if (present(ierr)) ierr = 1 ! Not found
- end subroutine mpas_get_att_text
+ end subroutine mpas_get_att_text!}}}
+!***********************************************************************
+!
+! routine mpas_remove_att
+!
+!> \brief MPAS remove attribute routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine removes an attribute from an attribute list.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_remove_att(attList, attName, ierr)!{{{
- subroutine mpas_remove_att(attList, attName, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- character (len=*), intent(in) :: attName
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input/Output: Attribute list
+ character (len=*), intent(in) :: attName !< Input: Attribute name
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor, cursor_prev
@@ -410,15 +544,26 @@
if (present(ierr)) ierr = 1 ! Not found
- end subroutine mpas_remove_att
+ end subroutine mpas_remove_att!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_attlist
+!
+!> \brief MPAS attribute list deallocation routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates an attribute list.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_deallocate_attlist(attList, ierr)!{{{
- subroutine mpas_deallocate_attlist(attList, ierr)
-
implicit none
- type (att_list_type), pointer :: attList
- integer, intent(out), optional :: ierr
+ type (att_list_type), pointer :: attList !< Input/Output: Attribute list
+ integer, intent(out), optional :: ierr !< Output: Error flag
type (att_list_type), pointer :: cursor
@@ -436,6 +581,6 @@
cursor => attList
end do
- end subroutine mpas_deallocate_attlist
+ end subroutine mpas_deallocate_attlist!}}}
end module mpas_attlist
Modified: branches/mpas_cdg_advection/src/framework/mpas_block_decomp.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_block_decomp.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_block_decomp.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,16 @@
+!***********************************************************************
+!
+! mpas_block_decomp
+!
+!> \brief This module contains routines related to the block decomposition.
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id$
+!> \details
+!> This module is repsonsible for reading the decomposition files, and determining which elements should live within which blocks.
+!> It also provides interfaces to find out how blocks map to processors.
+!
+!-----------------------------------------------------------------------
module mpas_block_decomp
use mpas_dmpar
@@ -23,6 +36,18 @@
contains
+!***********************************************************************
+!
+! routine mpas_block_decomp_cells_for_proc
+!
+!> \brief Determines list of cells for a specific processor
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id$
+!> \details
+!> This routine determines a list of cells for each processor, and what blocks the live in.
+!
+!-----------------------------------------------------------------------
subroutine mpas_block_decomp_cells_for_proc(dminfo, partial_global_graph_info, local_cell_list, block_id, block_start, block_count)!{{{
use mpas_configure
@@ -226,15 +251,30 @@
end subroutine mpas_block_decomp_cells_for_proc!}}}
+!***********************************************************************
+!
+! routine mpas_block_decomp_partitioned_edge_list
+!
+!> \brief Partitions list of edges for a processor
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id$
+!> \details
+!> This routine partitions a list of edges for each processor, based on a list of owned cells.
+!> Output edge list has 0-Halo edges first, followed by halo edges.
+!
+!-----------------------------------------------------------------------
subroutine mpas_block_decomp_partitioned_edge_list(nCells, cellIDList, maxCells, nEdges, cellsOnEdge, edgeIDList, ghostEdgeStart)!{{{
implicit none
- integer, intent(in) :: nCells, maxCells, nEdges
- integer, dimension(nCells), intent(in) :: cellIDList
- integer, dimension(maxCells, nEdges), intent(in) :: cellsOnEdge
- integer, dimension(nEdges), intent(inout) :: edgeIDList
- integer, intent(inout) :: ghostEdgeStart
+ integer, intent(in) :: nCells !< Input: Number of owned cells
+ integer, intent(in) :: maxCells !< Input: Maximum number of cells on an edge
+ integer, intent(in) :: nEdges !< Input: Number of edges
+ integer, dimension(nCells), intent(in) :: cellIDList !< Input: List of owned cell IDs
+ integer, dimension(maxCells, nEdges), intent(in) :: cellsOnEdge !< Input: Connectivity of cells on edges.
+ integer, dimension(nEdges), intent(inout) :: edgeIDList !< Input/Output: List of edge IDs
+ integer, intent(inout) :: ghostEdgeStart !< Input/Output: Index to beginning of edge halo
integer :: i, j, lastEdge
integer, dimension(nEdges) :: edgeIDListLocal
@@ -281,15 +321,28 @@
end subroutine mpas_block_decomp_partitioned_edge_list!}}}
+!***********************************************************************
+!
+! routine mpas_block_decomp_all_edges_in_block
+!
+!> \brief Determines all edges in a block.
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id$
+!> \details
+!> This routine creates a list of all edges that are in a block, based on a list of owned cells.
+!
+!-----------------------------------------------------------------------
subroutine mpas_block_decomp_all_edges_in_block(maxEdges, nCells, nEdgesOnCell, edgesOnCell, nEdges, edgeList)!{{{
implicit none
- integer, intent(in) :: maxEdges, nCells
- integer, dimension(nCells), intent(in) :: nEdgesOnCell
- integer, dimension(maxEdges, nCells), intent(in) :: edgesOnCell
- integer, intent(out) :: nEdges
- integer, dimension(:), pointer :: edgeList
+ integer, intent(in) :: maxEdges !< Input: Maximum number of edges on cell
+ integer, intent(in) :: nCells !< Input: Number of owned cells
+ integer, dimension(nCells), intent(in) :: nEdgesOnCell !< Input: Number of edges on each cell
+ integer, dimension(maxEdges, nCells), intent(in) :: edgesOnCell !< Input: ID of edges that border each cell
+ integer, intent(out) :: nEdges !< Output: Number of edges in block
+ integer, dimension(:), pointer :: edgeList !< Output: List of edges in block
integer :: i, j, k
type (hashtable) :: h
@@ -334,13 +387,25 @@
end subroutine mpas_block_decomp_all_edges_in_block!}}}
+!***********************************************************************
+!
+! routine mpas_block_decomp_add_halo
+!
+!> \brief Add halo to block
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id$
+!> \details
+!> This routine adds a halo layer to the block.
+!
+!-----------------------------------------------------------------------
subroutine mpas_block_decomp_add_halo(dminfo, local_graph_info, local_graph_with_halo)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- type (graph), intent(in) :: local_graph_info
- type (graph), intent(out) :: local_graph_with_halo
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ type (graph), intent(in) :: local_graph_info !< Input: Local graph structure for a block
+ type (graph), intent(out) :: local_graph_with_halo !< Output: Local graph structure for a block, with an extra halo
integer :: i, j, k
type (hashtable) :: h
@@ -408,6 +473,18 @@
end subroutine mpas_block_decomp_add_halo!}}}
+!***********************************************************************
+!
+! routine mpas_get_blocks_per_proc
+!
+!> \brief Determine number of blocks per processor
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id$
+!> \details
+!> This routine returns the number of blocks a specific processor owns.
+!
+!-----------------------------------------------------------------------
subroutine mpas_get_blocks_per_proc(dminfo, proc_number, blocks_per_proc)!{{{
type(dm_info), intent(in) :: dminfo !< Input: Domain Information
integer, intent(in) :: proc_number !< Input: Processor number
@@ -447,6 +524,18 @@
end subroutine mpas_get_blocks_per_proc!}}}
+!***********************************************************************
+!
+! routine mpas_get_local_block_id
+!
+!> \brief Determine the local ID of a block
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id$
+!> \details
+!> This routine returns the local block ID on the owning processor.
+!
+!-----------------------------------------------------------------------
subroutine mpas_get_local_block_id(dminfo, global_block_number, local_block_number)!{{{
type(dm_info), intent(in) :: dminfo !< Input: Domain Information
integer, intent(in) :: global_block_number !< Input: Global block id from 0 to config_number_of_blocks-1
@@ -473,6 +562,18 @@
end if
end subroutine mpas_get_local_block_id!}}}
+!***********************************************************************
+!
+! routine mpas_get_owning_proc
+!
+!> \brief Determine the owning processor ID for a specific block.
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id$
+!> \details
+!> This routine returns the ID of the processor that owns a specific block.
+!
+!-----------------------------------------------------------------------
subroutine mpas_get_owning_proc(dminfo, global_block_number, owning_proc)!{{{
type(dm_info), intent(in) :: dminfo !< Input: Domain Information
integer, intent(in) :: global_block_number !< Input: Global block id from 0 to config_number_of_blocks-1
@@ -499,13 +600,25 @@
end if
end subroutine mpas_get_owning_proc!}}}
+!***********************************************************************
+!
+! routine mpas_build_block_proc_list
+!
+!> \brief Build list of blocks per processor
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id$
+!> \details
+!> This routine builds the mapping of blocks to processors. Most useful when using an explicit decomposition.
+!
+!-----------------------------------------------------------------------
subroutine mpas_build_block_proc_list(dminfo)!{{{
use mpas_configure
implicit none
- type(dm_info), intent(in) :: dminfo
+ type(dm_info), intent(in) :: dminfo !< Input: Domain information
integer :: iounit, istatus, i, owning_proc
character (len=StrKIND) :: filename
@@ -556,6 +669,18 @@
end subroutine mpas_build_block_proc_list!}}}
+!***********************************************************************
+!
+! routine mpas_finish_block_proc_list
+!
+!> \brief Destroy list of blocks per processor
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id$
+!> \details
+!> This routine destroys the mapping of blocks to processors.
+!
+!-----------------------------------------------------------------------
subroutine mpas_finish_block_proc_list()!{{{
if(.not.explicitDecomp) return
deallocate(block_proc_list)
Modified: branches/mpas_cdg_advection/src/framework/mpas_configure.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_configure.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_configure.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,14 @@
+!-----------------------------------------------------------------------
+! mpas_configure
+!
+!> \brief MPAS Configuration routines.
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This module will contain all namelist parameter definitions, as well as the routine which reads them from the namelist file.
+!
+!-----------------------------------------------------------------------
module mpas_configure
use mpas_dmpar
@@ -6,13 +17,23 @@
contains
-
+!-----------------------------------------------------------------------
+! routine mpas_read_namelist
+!
+!> \brief MPAS read namelist routine
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine reads and broadcasts the namelist file.
+!
+!-----------------------------------------------------------------------
subroutine mpas_read_namelist(dminfo, nml_filename)
implicit none
- type (dm_info), intent(in) :: dminfo
- character (len=*), optional :: nml_filename
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ character (len=*), optional :: nml_filename !< Input - Optional: Namelist filename. Defaults to namelist.input
integer :: funit, ierr
Modified: branches/mpas_cdg_advection/src/framework/mpas_constants.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_constants.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_constants.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,17 @@
+!***********************************************************************
+!
+! mpas_constants
+!
+!> \brief MPAS Constant Module
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This module provides various constants that can be used in different parts of MPAS.
+!> They may or may not be a physical quantity.
+!
+!-----------------------------------------------------------------------
+
module mpas_constants
use mpas_kind_types
@@ -2,15 +16,30 @@
- real (kind=RKIND), parameter :: pii = 3.141592653589793
- real (kind=RKIND), parameter :: a = 6371229.0
- real (kind=RKIND), parameter :: omega = 7.29212e-5
- real (kind=RKIND), parameter :: gravity = 9.80616
- real (kind=RKIND), parameter :: rgas = 287.
- real (kind=RKIND), parameter :: cp = 1003.
- real (kind=RKIND), parameter :: cv = 716. ! cp - rgas
- real (kind=RKIND), parameter :: cvpm = -.71385842 ! -cv/cp
- real (kind=RKIND), parameter :: prandtl = 1.0
+ real (kind=RKIND), parameter :: pii = 3.141592653589793 !< Constant: Pi
+ real (kind=RKIND), parameter :: a = 6371229.0 !< Constant: Spherical Earth radius [m]
+ real (kind=RKIND), parameter :: omega = 7.29212e-5 !< Constant: Angular rotation rate of the Earth [s-1]
+ real (kind=RKIND), parameter :: gravity = 9.80616 !< Constant: Acceleration due to gravity [m s-2]
+ real (kind=RKIND), parameter :: rgas = 287.0 !< Constant: Gas constant for dry air [J kg-1 K-1]
+ real (kind=RKIND), parameter :: rv = 461.6 !< Constant: Gas constant for water vapor [J kg-1 K-1]
+ real (kind=RKIND), parameter :: rvord = rv/rgas !
+ real (kind=RKIND), parameter :: cp = 1003.0 !< Constant: Specific heat of dry air at constant pressure [J kg-1 K-1]
+ real (kind=RKIND), parameter :: cv = cp - rgas !< Constant: Specific heat of dry air at constant volume [J kg-1 K-1]
+ real (kind=RKIND), parameter :: cvpm = -cv/cp !
+ real (kind=RKIND), parameter :: prandtl = 1.0 !< Constant: Prandtl number
contains
+
+!***********************************************************************
+!
+! routine dummy
+!
+!> \brief MPAS Dummy Routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This is a dummy routine that doesn't do anything.
+!
+!-----------------------------------------------------------------------
subroutine dummy()
Modified: branches/mpas_cdg_advection/src/framework/mpas_dmpar.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_dmpar.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_dmpar.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,14 @@
+!-----------------------------------------------------------------------
+! mpas_dmpar
+!
+!> \brief MPAS Communication Routines
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This module contains all communication routines. All MPI calls should be made in this module.
+!
+!-----------------------------------------------------------------------
module mpas_dmpar
use mpas_dmpar_types
@@ -80,12 +91,24 @@
contains
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_init
+!
+!> \brief MPAS dmpar initialization routine.
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine initializes dmpar. It calls MPI_Init (if required), and setups up the communicators.
+!> It also setups of the domain information structure.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_init(dminfo, mpi_comm)!{{{
implicit none
- type (dm_info), intent(inout) :: dminfo
- integer, intent(in), optional :: mpi_comm ! Optional: externally-supplied MPI communicator
+ type (dm_info), intent(inout) :: dminfo !< Input/Output: Domain information
+ integer, intent(in), optional :: mpi_comm !< Input - Optional: externally-supplied MPI communicator
#ifdef _MPI
integer :: mpi_rank, mpi_size
@@ -124,11 +147,22 @@
end subroutine mpas_dmpar_init!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_finalize
+!
+!> \brief MPAS dmpar finalization routine.
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine finalizes dmpar. It calls MPI_Finalize (if required).
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_finalize(dminfo)!{{{
implicit none
- type (dm_info), intent(inout) :: dminfo
+ type (dm_info), intent(inout) :: dminfo !< Input/Output: Domain information.
#ifdef _MPI
integer :: mpi_ierr
@@ -140,11 +174,22 @@
end subroutine mpas_dmpar_finalize!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_abort
+!
+!> \brief MPAS dmpar abort routine.
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine aborts MPI. A call to it kills the model through the use of MPI_Abort.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_abort(dminfo)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
#ifdef _MPI
integer :: mpi_ierr, mpi_errcode
@@ -156,11 +201,22 @@
end subroutine mpas_dmpar_abort!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_global_abort
+!
+!> \brief MPAS dmpar global abort routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine aborts MPI. A call to it kills the model through the use of MPI_Abort on the world communicator, and outputs a message.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_global_abort(mesg)!{{{
implicit none
- character (len=*), intent(in) :: mesg
+ character (len=*), intent(in) :: mesg !< Input: Abort message
#ifdef _MPI
integer :: mpi_ierr, mpi_errcode
@@ -174,12 +230,23 @@
end subroutine mpas_dmpar_global_abort!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_bcast_int
+!
+!> \brief MPAS dmpar broadcast integer routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine broadcasts an integer to all processors in the communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_bcast_int(dminfo, i)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(inout) :: i
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(inout) :: i !< Input/Output: Integer to broadcast
#ifdef _MPI
integer :: mpi_ierr
@@ -189,13 +256,24 @@
end subroutine mpas_dmpar_bcast_int!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_bcast_ints
+!
+!> \brief MPAS dmpar broadcast integers routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine broadcasts an array of integers to all processors in the communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_bcast_ints(dminfo, n, iarray)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: n
- integer, dimension(n), intent(inout) :: iarray
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: n !< Input: Length of array
+ integer, dimension(n), intent(inout) :: iarray !< Input/Output: Array of integers
#ifdef _MPI
integer :: mpi_ierr
@@ -205,12 +283,23 @@
end subroutine mpas_dmpar_bcast_ints!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_bcast_real
+!
+!> \brief MPAS dmpar broadcast real routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine broadcasts a real to all processors in the communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_bcast_real(dminfo, r)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- real (kind=RKIND), intent(inout) :: r
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ real (kind=RKIND), intent(inout) :: r !< Input/Output: Real to be broadcast
#ifdef _MPI
integer :: mpi_ierr
@@ -220,13 +309,24 @@
end subroutine mpas_dmpar_bcast_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_bcast_reals
+!
+!> \brief MPAS dmpar broadcast reals routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine broadcasts an array of reals to all processors in the communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_bcast_reals(dminfo, n, rarray)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: n
- real (kind=RKIND), dimension(n), intent(inout) :: rarray
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: n !< Input: Length of array
+ real (kind=RKIND), dimension(n), intent(inout) :: rarray !< Input/Output: Array of reals to be broadcast
#ifdef _MPI
integer :: mpi_ierr
@@ -236,12 +336,23 @@
end subroutine mpas_dmpar_bcast_reals!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_bcast_logical
+!
+!> \brief MPAS dmpar broadcast logical routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine broadcasts a logical to all processors in the communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_bcast_logical(dminfo, l)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- logical, intent(inout) :: l
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ logical, intent(inout) :: l !< Input/Output: Logical to be broadcast
#ifdef _MPI
integer :: mpi_ierr
@@ -266,12 +377,23 @@
end subroutine mpas_dmpar_bcast_logical!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_bcast_char
+!
+!> \brief MPAS dmpar broadcast character routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine broadcasts a character to all processors in the communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_bcast_char(dminfo, c)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- character (len=*), intent(inout) :: c
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ character (len=*), intent(inout) :: c !< Input/Output: Character to be broadcast
#ifdef _MPI
integer :: mpi_ierr
@@ -281,13 +403,24 @@
end subroutine mpas_dmpar_bcast_char!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_sum_int
+!
+!> \brief MPAS dmpar sum integers routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine sums (Allreduce) integer values across all processors in a communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_sum_int(dminfo, i, isum)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: i
- integer, intent(out) :: isum
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: i !< Input: Integer value input
+ integer, intent(out) :: isum !< Output: Integer sum for output
integer :: mpi_ierr
@@ -299,13 +432,24 @@
end subroutine mpas_dmpar_sum_int!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_sum_real
+!
+!> \brief MPAS dmpar sum real routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine sums (Allreduce) real values across all processors in a communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_sum_real(dminfo, r, rsum)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- real(kind=RKIND), intent(in) :: r
- real(kind=RKIND), intent(out) :: rsum
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ real(kind=RKIND), intent(in) :: r !< Input: Real values to be summed
+ real(kind=RKIND), intent(out) :: rsum !< Output: Sum of reals for output
integer :: mpi_ierr
@@ -317,13 +461,24 @@
end subroutine mpas_dmpar_sum_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_min_int
+!
+!> \brief MPAS dmpar minimum integer routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine returns the minimum integer value across all processors in a communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_min_int(dminfo, i, imin)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: i
- integer, intent(out) :: imin
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: i !< Input: Integer value
+ integer, intent(out) :: imin !< Output: Minimum integer value
integer :: mpi_ierr
@@ -335,13 +490,24 @@
end subroutine mpas_dmpar_min_int!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_min_real
+!
+!> \brief MPAS dmpar minimum real routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine returns the minimum real value across all processors in a communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_min_real(dminfo, r, rmin)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- real(kind=RKIND), intent(in) :: r
- real(kind=RKIND), intent(out) :: rmin
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ real(kind=RKIND), intent(in) :: r !< Input: Real value
+ real(kind=RKIND), intent(out) :: rmin !< Output: Minimum of real value
integer :: mpi_ierr
@@ -353,13 +519,24 @@
end subroutine mpas_dmpar_min_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_max_int
+!
+!> \brief MPAS dmpar maximum integer routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine returns the maximum integer value across all processors in a communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_max_int(dminfo, i, imax)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: i
- integer, intent(out) :: imax
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: i !< Input: Integer value
+ integer, intent(out) :: imax !< Output: Maximum of integer values
integer :: mpi_ierr
@@ -371,13 +548,24 @@
end subroutine mpas_dmpar_max_int!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_max_real
+!
+!> \brief MPAS dmpar maximum real routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine returns the maximum real value across all processors in a communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_max_real(dminfo, r, rmax)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- real(kind=RKIND), intent(in) :: r
- real(kind=RKIND), intent(out) :: rmax
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ real(kind=RKIND), intent(in) :: r !< Input: Real value
+ real(kind=RKIND), intent(out) :: rmax !< Output: Maximum of real values
integer :: mpi_ierr
@@ -389,14 +577,25 @@
end subroutine mpas_dmpar_max_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_sum_int_array
+!
+!> \brief MPAS dmpar integer array sum routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes the sum of a set of integer arrays across all processors in a communicator.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_sum_int_array(dminfo, nElements, inArray, outArray)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: nElements
- integer, dimension(nElements), intent(in) :: inArray
- integer, dimension(nElements), intent(out) :: outArray
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: nElements !< Input: Length of arrays
+ integer, dimension(nElements), intent(in) :: inArray !< Input: Processor specific array to sum
+ integer, dimension(nElements), intent(out) :: outArray !< Output: Sum of arrays
integer :: mpi_ierr
@@ -408,14 +607,25 @@
end subroutine mpas_dmpar_sum_int_array!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_min_int_array
+!
+!> \brief MPAS dmpar integer array minimum routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes an array of minimum values for each index across all processors in a communicator, from some input arrays.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_min_int_array(dminfo, nElements, inArray, outArray)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: nElements
- integer, dimension(nElements), intent(in) :: inArray
- integer, dimension(nElements), intent(out) :: outArray
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: nElements !< Input: Array size
+ integer, dimension(nElements), intent(in) :: inArray !< Input: Input array of integers
+ integer, dimension(nElements), intent(out) :: outArray !< Output: Array of minimum integers
integer :: mpi_ierr
@@ -427,14 +637,25 @@
end subroutine mpas_dmpar_min_int_array!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_min_int_array
+!
+!> \brief MPAS dmpar integer array maximum routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes an array of maximum values for each index across all processors in a communicator, from some input arrays.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_max_int_array(dminfo, nElements, inArray, outArray)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: nElements
- integer, dimension(nElements), intent(in) :: inArray
- integer, dimension(nElements), intent(out) :: outArray
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: nElements !< Input: Length of arrays
+ integer, dimension(nElements), intent(in) :: inArray !< Input: Array of integers
+ integer, dimension(nElements), intent(out) :: outArray !< Output: Array of maximum integers
integer :: mpi_ierr
@@ -446,14 +667,25 @@
end subroutine mpas_dmpar_max_int_array!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_sum_real_array
+!
+!> \brief MPAS dmpar real array sum routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes the sum array of real values across all processors in a communicator, from some input arrays.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_sum_real_array(dminfo, nElements, inArray, outArray)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: nElements
- real(kind=RKIND), dimension(nElements), intent(in) :: inArray
- real(kind=RKIND), dimension(nElements), intent(out) :: outArray
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: nElements !< Input: Length of arrays
+ real(kind=RKIND), dimension(nElements), intent(in) :: inArray !< Input: Array of reals
+ real(kind=RKIND), dimension(nElements), intent(out) :: outArray !< Output: Array of real sums
integer :: mpi_ierr
@@ -465,14 +697,25 @@
end subroutine mpas_dmpar_sum_real_array!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_min_real_array
+!
+!> \brief MPAS dmpar real array minimum routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes the minimum array of real values across all processors in a communicator, from some input arrays.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_min_real_array(dminfo, nElements, inArray, outArray)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: nElements
- real(kind=RKIND), dimension(nElements), intent(in) :: inArray
- real(kind=RKIND), dimension(nElements), intent(out) :: outArray
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: nElements !< Input: Length of arrays
+ real(kind=RKIND), dimension(nElements), intent(in) :: inArray !< Input: Array of reals
+ real(kind=RKIND), dimension(nElements), intent(out) :: outArray !< Input: Array of minimum reals
integer :: mpi_ierr
@@ -484,14 +727,25 @@
end subroutine mpas_dmpar_min_real_array!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_max_real_array
+!
+!> \brief MPAS dmpar real array maximum routine.
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes the maximum array of real values across all processors in a communicator, from some input arrays.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_max_real_array(dminfo, nElements, inArray, outArray)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: nElements
- real(kind=RKIND), dimension(nElements), intent(in) :: inArray
- real(kind=RKIND), dimension(nElements), intent(out) :: outArray
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: nElements !< Input: Length of arrays
+ real(kind=RKIND), dimension(nElements), intent(in) :: inArray !< Input: Array of reals
+ real(kind=RKIND), dimension(nElements), intent(out) :: outArray !< Output: Array of maximum reals
integer :: mpi_ierr
@@ -503,15 +757,28 @@
end subroutine mpas_dmpar_max_real_array!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_scatter_ints
+!
+!> \brief MPAS dmpar scatter integers routine
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes the maximum array of real values across all processors in a communicator, from some input arrays.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_scatter_ints(dminfo, nprocs, noutlist, displs, counts, inlist, outlist)!{{{
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: nprocs, noutlist
- integer, dimension(nprocs), intent(in) :: displs, counts
- integer, dimension(:), pointer :: inlist
- integer, dimension(noutlist), intent(inout) :: outlist
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: nprocs !< Input: Number of processors
+ integer, intent(in) :: noutlist !< Input: Number integers to receive
+ integer, dimension(nprocs), intent(in) :: displs !< Input: Displacement in sending array
+ integer, dimension(nprocs), intent(in) :: counts !< Input: Number of integers to distribute
+ integer, dimension(:), pointer :: inlist !< Input: List of integers to send
+ integer, dimension(noutlist), intent(inout) :: outlist !< Output: List of received integers
#ifdef _MPI
integer :: mpi_ierr
@@ -521,15 +788,28 @@
end subroutine mpas_dmpar_scatter_ints!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_get_index_range
+!
+!> \brief MPAS dmpar processor specific range of indices
+!> \author Michael Duda
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine divides a global range of indices among all processors, and returns the range of indices a specific processors is responsible for.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_get_index_range(dminfo, &!{{{
global_start, global_end, &
local_start, local_end)
implicit none
- type (dm_info), intent(in) :: dminfo
- integer, intent(in) :: global_start, global_end
- integer, intent(out) :: local_start, local_end
+ type (dm_info), intent(in) :: dminfo !< Input: Domain information
+ integer, intent(in) :: global_start !< Input: Starting index in global range
+ integer, intent(in) :: global_end !< Input: Ending index in global range
+ integer, intent(out) :: local_start !< Output: Starting index in local range
+ integer, intent(out) :: local_end !< Output: Ending index in local range
local_start = nint(real(dminfo % my_proc_id) * real(global_end - global_start + 1) / real(dminfo % nprocs)) + 1
local_end = nint(real(dminfo % my_proc_id + 1) * real(global_end - global_start + 1) / real(dminfo % nprocs))
@@ -572,16 +852,27 @@
end subroutine mpas_dmpar_compute_index_range!}}}
- ! ----- NEW ROUTINES BELOW ----- !
-
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_get_exch_list
+!
+!> \brief MPAS dmpar exchange list builder
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine builds exchange lists to communicated between the lists of owned and needed fields, over a given number of halos.
+!> Exchange lists are built into the input fields.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_get_exch_list(haloLayer, ownedListField, neededListField, offsetListField, ownedLimitField)!{{{
implicit none
- integer, intent(in) :: haloLayer
- type (field1dInteger), pointer :: ownedListField, neededListField
- type (field0dInteger), pointer, optional :: offsetListField
- type (field0dInteger), pointer, optional :: ownedLimitField
+ integer, intent(in) :: haloLayer !< Input: Halo layer to build exchange list for
+ type (field1dInteger), pointer :: ownedListField !< Input/Output: List of owned fields
+ type (field1dInteger), pointer :: neededListField !< Input/Output: List of needed fields
+ type (field0dInteger), pointer, optional :: offsetListField !< Input: Offsets for placement of received data into destination arrays
+ type (field0dInteger), pointer, optional :: ownedLimitField !< Input: List of limits in owned array
type (dm_info), pointer :: dminfo
@@ -624,7 +915,7 @@
!
! For the neededListField:
- ! similar to the owneListField...
+ ! similar to the ownedListField...
dminfo => ownedListField % block % domain % dminfo
@@ -1122,14 +1413,25 @@
end subroutine mpas_dmpar_get_exch_list!}}}
-
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_alltoall_field1d_integer
+!
+!> \brief MPAS dmpar all-to-all 1D integer routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the all-to-all communication of an input field into an output field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_alltoall_field1d_integer(fieldIn, fieldout, haloLayersIn)!{{{
implicit none
- type (field1dInteger), pointer :: fieldIn
- type (field1dInteger), pointer :: fieldOut
- integer, dimension(:), pointer, optional :: haloLayersIn
+ type (field1dInteger), pointer :: fieldIn !< Input: Field to send
+ type (field1dInteger), pointer :: fieldOut !< Output: Field to receive
+ integer, dimension(:), pointer, optional :: haloLayersIn !< Input: Halo layers to communicated. Defaults to all.
type (field1dInteger), pointer :: fieldInPtr, fieldOutPtr
type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
@@ -1403,13 +1705,25 @@
end subroutine mpas_dmpar_alltoall_field1d_integer!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_alltoall_field2d_integer
+!
+!> \brief MPAS dmpar all-to-all 2D integer routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the all-to-all communication of an input field into an output field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_alltoall_field2d_integer(fieldIn, fieldout, haloLayersIn)!{{{
implicit none
- type (field2dInteger), pointer :: fieldIn
- type (field2dInteger), pointer :: fieldOut
- integer, dimension(:), pointer, optional :: haloLayersIn
+ type (field2dInteger), pointer :: fieldIn !< Input: Field to communicate from
+ type (field2dInteger), pointer :: fieldOut !< Output: Field to receive into
+ integer, dimension(:), pointer, optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (field2dInteger), pointer :: fieldInPtr, fieldOutPtr
type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
@@ -1684,13 +1998,25 @@
end subroutine mpas_dmpar_alltoall_field2d_integer!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_alltoall_field3d_integer
+!
+!> \brief MPAS dmpar all-to-all 3D integer routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the all-to-all communication of an input field into an output field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_alltoall_field3d_integer(fieldIn, fieldout, haloLayersIn)!{{{
implicit none
- type (field3dInteger), pointer :: fieldIn
- type (field3dInteger), pointer :: fieldOut
- integer, dimension(:), pointer, optional :: haloLayersIn
+ type (field3dInteger), pointer :: fieldIn !< Input: Field to send from
+ type (field3dInteger), pointer :: fieldOut !< Output: Field to receive into
+ integer, dimension(:), pointer, optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (field3dInteger), pointer :: fieldInPtr, fieldOutPtr
type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
@@ -1972,13 +2298,25 @@
end subroutine mpas_dmpar_alltoall_field3d_integer!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_alltoall_field1d_real
+!
+!> \brief MPAS dmpar all-to-all 1D real routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the all-to-all communication of an input field into an output field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_alltoall_field1d_real(fieldIn, fieldout, haloLayersIn)!{{{
implicit none
- type (field1dReal), pointer :: fieldIn
- type (field1dReal), pointer :: fieldOut
- integer, dimension(:), pointer, optional :: haloLayersIn
+ type (field1dReal), pointer :: fieldIn !< Input: Field to send from
+ type (field1dReal), pointer :: fieldOut !< Output: Field to receive into
+ integer, dimension(:), pointer, optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (field1dReal), pointer :: fieldInPtr, fieldOutPtr
type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
@@ -2250,13 +2588,25 @@
end subroutine mpas_dmpar_alltoall_field1d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_alltoall_field2d_real
+!
+!> \brief MPAS dmpar all-to-all 2D real routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the all-to-all communication of an input field into an output field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_alltoall_field2d_real(fieldIn, fieldout, haloLayersIn)!{{{
implicit none
- type (field2dReal), pointer :: fieldIn
- type (field2dReal), pointer :: fieldOut
- integer, dimension(:), pointer, optional :: haloLayersIn
+ type (field2dReal), pointer :: fieldIn !< Input: Field to send from
+ type (field2dReal), pointer :: fieldOut !< Output: Field to receive into
+ integer, dimension(:), pointer, optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (field2dReal), pointer :: fieldInPtr, fieldOutPtr
type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
@@ -2532,13 +2882,25 @@
end subroutine mpas_dmpar_alltoall_field2d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_alltoall_field3d_real
+!
+!> \brief MPAS dmpar all-to-all 3D real routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the all-to-all communication of an input field into an output field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_alltoall_field3d_real(fieldIn, fieldout, haloLayersIn)!{{{
implicit none
- type (field3dReal), pointer :: fieldIn
- type (field3dReal), pointer :: fieldOut
- integer, dimension(:), pointer, optional :: haloLayersIn
+ type (field3dReal), pointer :: fieldIn !< Input: Field to send from
+ type (field3dReal), pointer :: fieldOut !< Output: Field to receive into
+ integer, dimension(:), pointer, optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (field3dReal), pointer :: fieldInPtr, fieldOutPtr
type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
@@ -2822,13 +3184,25 @@
end subroutine mpas_dmpar_alltoall_field3d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_alltoall_field4d_real
+!
+!> \brief MPAS dmpar all-to-all 4D real routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the all-to-all communication of an input field into an output field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_alltoall_field4d_real(fieldIn, fieldout, haloLayersIn)!{{{
implicit none
- type (field4dReal), pointer :: fieldIn
- type (field4dReal), pointer :: fieldOut
- integer, dimension(:), pointer, optional :: haloLayersIn
+ type (field4dReal), pointer :: fieldIn !< Input: Field to send from
+ type (field4dReal), pointer :: fieldOut !< Output: Field to receive into
+ integer, dimension(:), pointer, optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (field4dReal), pointer :: fieldInPtr, fieldOutPtr
type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
@@ -3120,13 +3494,25 @@
end subroutine mpas_dmpar_alltoall_field4d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_alltoall_field5d_real
+!
+!> \brief MPAS dmpar all-to-all 5D real routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the all-to-all communication of an input field into an output field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_alltoall_field5d_real(fieldIn, fieldout, haloLayersIn)!{{{
implicit none
- type (field5dReal), pointer :: fieldIn
- type (field5dReal), pointer :: fieldOut
- integer, dimension(:), pointer, optional :: haloLayersIn
+ type (field5dReal), pointer :: fieldIn !< Input: Field to send from
+ type (field5dReal), pointer :: fieldOut !< Output: Field to receive into
+ integer, dimension(:), pointer, optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all.
type (field5dReal), pointer :: fieldInPtr, fieldOutPtr
type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
@@ -3424,14 +3810,24 @@
end subroutine mpas_dmpar_alltoall_field5d_real!}}}
-
-
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_exch_halo_field1d_integer
+!
+!> \brief MPAS dmpar halo exchange 1D integer field
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the halo exchange communication of an input field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_exch_halo_field1d_integer(field, haloLayersIn)!{{{
implicit none
- type (field1DInteger), pointer :: field
- integer, dimension(:), intent(in), optional :: haloLayersIn
+ type (field1DInteger), pointer :: field !< Input: Field to communicate
+ integer, dimension(:), intent(in), optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (dm_info), pointer :: dminfo
type (field1DInteger), pointer :: fieldCursor, fieldCursor2
@@ -3706,12 +4102,24 @@
end subroutine mpas_dmpar_exch_halo_field1d_integer!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_exch_halo_field2d_integer
+!
+!> \brief MPAS dmpar halo exchange 2D integer field
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the halo exchange communication of an input field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_exch_halo_field2d_integer(field, haloLayersIn)!{{{
implicit none
- type (field2DInteger), pointer :: field
- integer, dimension(:), intent(in), optional :: haloLayersIn
+ type (field2DInteger), pointer :: field !< Input: Field to communicate
+ integer, dimension(:), intent(in), optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (dm_info), pointer :: dminfo
type (field2DInteger), pointer :: fieldCursor, fieldCursor2
@@ -3987,12 +4395,24 @@
end subroutine mpas_dmpar_exch_halo_field2d_integer!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_exch_halo_field3d_integer
+!
+!> \brief MPAS dmpar halo exchange 3D integer field
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the halo exchange communication of an input field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_exch_halo_field3d_integer(field, haloLayersIn)!{{{
implicit none
- type (field3DInteger), pointer :: field
- integer, dimension(:), intent(in), optional :: haloLayersIn
+ type (field3DInteger), pointer :: field !< Input: Field to communicate
+ integer, dimension(:), intent(in), optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (dm_info), pointer :: dminfo
type (field3DInteger), pointer :: fieldCursor, fieldCursor2
@@ -4274,12 +4694,24 @@
end subroutine mpas_dmpar_exch_halo_field3d_integer!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_exch_halo_field1d_real
+!
+!> \brief MPAS dmpar halo exchange 1D real field
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the halo exchange communication of an input field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_exch_halo_field1d_real(field, haloLayersIn)!{{{
implicit none
- type (field1dReal), pointer :: field
- integer, dimension(:), intent(in), optional :: haloLayersIn
+ type (field1dReal), pointer :: field !< Input: Field to communicate
+ integer, dimension(:), intent(in), optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (dm_info), pointer :: dminfo
type (field1dReal), pointer :: fieldCursor, fieldCursor2
@@ -4552,12 +4984,24 @@
end subroutine mpas_dmpar_exch_halo_field1d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_exch_halo_field2d_real
+!
+!> \brief MPAS dmpar halo exchange 2D real field
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the halo exchange communication of an input field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_exch_halo_field2d_real(field, haloLayersIn)!{{{
implicit none
- type (field2dReal), pointer :: field
- integer, dimension(:), intent(in), optional :: haloLayersIn
+ type (field2dReal), pointer :: field !< Input: Field to communicate
+ integer, dimension(:), intent(in), optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (dm_info), pointer :: dminfo
type (field2dReal), pointer :: fieldCursor, fieldCursor2
@@ -4835,12 +5279,24 @@
end subroutine mpas_dmpar_exch_halo_field2d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_exch_halo_field3d_real
+!
+!> \brief MPAS dmpar halo exchange 3D real field
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the halo exchange communication of an input field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_exch_halo_field3d_real(field, haloLayersIn)!{{{
implicit none
- type (field3dReal), pointer :: field
- integer, dimension(:), intent(in), optional :: haloLayersIn
+ type (field3dReal), pointer :: field !< Input: Field to communicate
+ integer, dimension(:), intent(in), optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (dm_info), pointer :: dminfo
type (field3dReal), pointer :: fieldCursor, fieldCursor2
@@ -5122,12 +5578,24 @@
end subroutine mpas_dmpar_exch_halo_field3d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_exch_halo_field4d_real
+!
+!> \brief MPAS dmpar halo exchange 4D real field
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the halo exchange communication of an input field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_exch_halo_field4d_real(field, haloLayersIn)!{{{
implicit none
- type (field4dReal), pointer :: field
- integer, dimension(:), intent(in), optional :: haloLayersIn
+ type (field4dReal), pointer :: field !< Input: Field to communicate
+ integer, dimension(:), intent(in), optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (dm_info), pointer :: dminfo
type (field4dReal), pointer :: fieldCursor, fieldCursor2
@@ -5417,12 +5885,24 @@
end subroutine mpas_dmpar_exch_halo_field4d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_exch_halo_field5d_real
+!
+!> \brief MPAS dmpar halo exchange 5D real field
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles the halo exchange communication of an input field across all processors.
+!> It requries exchange lists to be created prior to calling this routine.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_exch_halo_field5d_real(field, haloLayersIn)!{{{
implicit none
- type (field5dReal), pointer :: field
- integer, dimension(:), intent(in), optional :: haloLayersIn
+ type (field5dReal), pointer :: field !< Input: Field to communicate
+ integer, dimension(:), intent(in), optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all
type (dm_info), pointer :: dminfo
type (field5dReal), pointer :: fieldCursor, fieldCursor2
@@ -5718,9 +6198,20 @@
end subroutine mpas_dmpar_exch_halo_field5d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_init_mulithalo_exchange_list
+!
+!> \brief MPAS dmpar initialize muiltihalo exchange list routine.
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine initializes the multihalo exchange lists, based on a number of halo layers.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_init_mulithalo_exchange_list(exchList, nHalos)!{{{
- type (mpas_multihalo_exchange_list), pointer :: exchList
- integer, intent(in) :: nHalos
+ type (mpas_multihalo_exchange_list), pointer :: exchList !< Input: Exchange list to initialize
+ integer, intent(in) :: nHalos !< Input: Number of halo layers for exchange list
integer :: i
@@ -5731,8 +6222,19 @@
end do
end subroutine mpas_dmpar_init_mulithalo_exchange_list!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_destroy_mulithalo_exchange_list
+!
+!> \brief MPAS dmpar destroy muiltihalo exchange list routine.
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine destroys the multihalo exchange lists.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_destroy_mulithalo_exchange_list(exchList)!{{{
- type (mpas_multihalo_exchange_list), pointer :: exchList
+ type (mpas_multihalo_exchange_list), pointer :: exchList !< Input: Exchange list to destroy.
integer :: nHalos
integer :: i
@@ -5748,8 +6250,19 @@
nullify(exchList)
end subroutine mpas_dmpar_destroy_mulithalo_exchange_list!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_destroy_communication_list
+!
+!> \brief MPAS dmpar destroy communication list routine.
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine destroys a communication lists.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_destroy_communication_list(commList)!{{{
- type (mpas_communication_list), pointer :: commList
+ type (mpas_communication_list), pointer :: commList !< Input: Communication list to destroy.
type (mpas_communication_list), pointer :: commListPtr
commListPtr => commList
@@ -5774,8 +6287,19 @@
end subroutine mpas_dmpar_destroy_communication_list!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_destroy_exchange_list
+!
+!> \brief MPAS dmpar destroy exchange list routine.
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine destroys a exchange lists.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_destroy_exchange_list(exchList)!{{{
- type (mpas_exchange_list), pointer :: exchList
+ type (mpas_exchange_list), pointer :: exchList !< Input: Exchange list to destroy
type (mpas_exchange_list), pointer :: exchListPtr
exchListPtr => exchList
@@ -5800,8 +6324,19 @@
end subroutine mpas_dmpar_destroy_exchange_list!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_copy_field1d_integer
+!
+!> \brief MPAS dmpar copy 1D integer field routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine copies a 1D integer field throughout a block list.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_copy_field1d_integer(field)!{{{
- type (field1dInteger), pointer :: field
+ type (field1dInteger), pointer :: field !< Input: Field to copy
type (field1dInteger), pointer :: fieldCursor
if(associated(field % next)) then
@@ -5813,8 +6348,19 @@
end if
end subroutine mpas_dmpar_copy_field1d_integer!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_copy_field2d_integer
+!
+!> \brief MPAS dmpar copy 2D integer field routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine copies a 2D integer field throughout a block list.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_copy_field2d_integer(field)!{{{
- type (field2dInteger), pointer :: field
+ type (field2dInteger), pointer :: field !< Input: Field to copy
type (field2dInteger), pointer :: fieldCursor
if(associated(field % next)) then
@@ -5826,8 +6372,19 @@
end if
end subroutine mpas_dmpar_copy_field2d_integer!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_copy_field3d_integer
+!
+!> \brief MPAS dmpar copy 3D integer field routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine copies a 3D integer field throughout a block list.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_copy_field3d_integer(field)!{{{
- type (field3dInteger), pointer :: field
+ type (field3dInteger), pointer :: field !< Input: Field to copy
type (field3dInteger), pointer :: fieldCursor
if(associated(field % next)) then
@@ -5839,8 +6396,19 @@
end if
end subroutine mpas_dmpar_copy_field3d_integer!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_copy_field1d_real
+!
+!> \brief MPAS dmpar copy 1D real field routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine copies a 1D real field throughout a block list.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_copy_field1d_real(field)!{{{
- type (field1dReal), pointer :: field
+ type (field1dReal), pointer :: field !< Input: Field to copy
type (field1dReal), pointer :: fieldCursor
@@ -5853,8 +6421,19 @@
end if
end subroutine mpas_dmpar_copy_field1d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_copy_field2d_real
+!
+!> \brief MPAS dmpar copy 2D real field routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine copies a 2D real field throughout a block list.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_copy_field2d_real(field)!{{{
- type (field2dReal), pointer :: field
+ type (field2dReal), pointer :: field !< Input: Field to copy
type (field2dReal), pointer :: fieldCursor
if(associated(field % next)) then
@@ -5866,8 +6445,19 @@
end if
end subroutine mpas_dmpar_copy_field2d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_copy_field3d_real
+!
+!> \brief MPAS dmpar copy 3D real field routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine copies a 3D real field throughout a block list.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_copy_field3d_real(field)!{{{
- type (field3dReal), pointer :: field
+ type (field3dReal), pointer :: field !< Input: Field to copy
type (field3dReal), pointer :: fieldCursor
if(associated(field % next)) then
@@ -5879,8 +6469,19 @@
end if
end subroutine mpas_dmpar_copy_field3d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_copy_field4d_real
+!
+!> \brief MPAS dmpar copy 4D real field routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine copies a 4D real field throughout a block list.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_copy_field4d_real(field)!{{{
- type (field4dReal), pointer :: field
+ type (field4dReal), pointer :: field !< Input: Field to copy
type (field4dReal), pointer :: fieldCursor
if(associated(field % next)) then
@@ -5892,8 +6493,19 @@
end if
end subroutine mpas_dmpar_copy_field4d_real!}}}
+!-----------------------------------------------------------------------
+! routine mpas_dmpar_copy_field5d_real
+!
+!> \brief MPAS dmpar copy 5D real field routine
+!> \author Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine copies a 5D real field throughout a block list.
+!
+!-----------------------------------------------------------------------
subroutine mpas_dmpar_copy_field5d_real(field)!{{{
- type (field5dReal), pointer :: field
+ type (field5dReal), pointer :: field !< Input: Field to copy
type (field5dReal), pointer :: fieldCursor
if(associated(field % next)) then
Modified: branches/mpas_cdg_advection/src/framework/mpas_dmpar_types.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_dmpar_types.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_dmpar_types.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,14 @@
+!-----------------------------------------------------------------------
+! mpas_dmpar_types
+!
+!> \brief MPAS Communication Type Definitions
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This module defines all communication related derived data types
+!
+!-----------------------------------------------------------------------
module mpas_dmpar_types
use mpas_kind_types
Modified: branches/mpas_cdg_advection/src/framework/mpas_framework.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_framework.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_framework.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,14 @@
+!-----------------------------------------------------------------------
+! mpas_framework
+!
+!> \brief MPAS Framework routines
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This module contains all routines related to the general MPAS framework interface.
+!
+!-----------------------------------------------------------------------
module mpas_framework
use mpas_dmpar
@@ -12,8 +23,18 @@
contains
-
- subroutine mpas_framework_init(dminfo, domain, mpi_comm, nml_filename, io_system)
+!-----------------------------------------------------------------------
+! routine mpas_framework_init
+!
+!> \brief MPAS framework initialization routine.
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine initializes the MPAS framework. It calls routines related to initializing different parts of MPAS, that are housed within the framework.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_framework_init(dminfo, domain, mpi_comm, nml_filename, io_system)!{{{
implicit none
@@ -43,10 +64,20 @@
end if
call MPAS_io_init(dminfo, pio_num_iotasks, pio_stride, io_system)
- end subroutine mpas_framework_init
+ end subroutine mpas_framework_init!}}}
-
- subroutine mpas_framework_finalize(dminfo, domain, io_system)
+!-----------------------------------------------------------------------
+! routine mpas_framework_finalize
+!
+!> \brief MPAS framework finalization routine.
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/26/13
+!> \version SVN:$Id:$
+!> \details
+!> This routine finalizes the MPAS framework. It calls routines related to finalizing different parts of MPAS, that are housed within the framework.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_framework_finalize(dminfo, domain, io_system)!{{{
implicit none
@@ -62,6 +93,6 @@
call mpas_timekeeping_finalize()
- end subroutine mpas_framework_finalize
+ end subroutine mpas_framework_finalize!}}}
end module mpas_framework
Modified: branches/mpas_cdg_advection/src/framework/mpas_grid_types.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_grid_types.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_grid_types.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,16 @@
+!***********************************************************************
+!
+! mpas_grid_types
+!
+!> \brief MPAS Grid and field type defintion module
+!> \author Michael Duda, Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This module defines derived data types related to fields, and variable structures.
+!> It also includes routines for allocating and deallocating these types.
+!
+!-----------------------------------------------------------------------
module mpas_grid_types
use mpas_kind_types
@@ -37,6 +50,7 @@
integer, dimension(5) :: dimSizes
logical :: hasTimeDimension
logical :: isSuperArray
+ logical :: isPersistent
type (att_list_type), pointer :: attList => null()
! Pointers to the prev and next blocks for this field on this task
@@ -66,6 +80,7 @@
integer, dimension(4) :: dimSizes
logical :: hasTimeDimension
logical :: isSuperArray
+ logical :: isPersistent
type (att_list_type), pointer :: attList => null()
! Pointers to the prev and next blocks for this field on this task
@@ -96,6 +111,7 @@
integer, dimension(3) :: dimSizes
logical :: hasTimeDimension
logical :: isSuperArray
+ logical :: isPersistent
type (att_list_type), pointer :: attList => null()
! Pointers to the prev and next blocks for this field on this task
@@ -125,6 +141,7 @@
integer, dimension(2) :: dimSizes
logical :: hasTimeDimension
logical :: isSuperArray
+ logical :: isPersistent
type (att_list_type), pointer :: attList => null()
! Pointers to the prev and next blocks for this field on this task
@@ -154,6 +171,7 @@
integer, dimension(1) :: dimSizes
logical :: hasTimeDimension
logical :: isSuperArray
+ logical :: isPersistent
type (att_list_type), pointer :: attList => null()
! Pointers to the prev and next blocks for this field on this task
@@ -210,6 +228,7 @@
integer, dimension(3) :: dimSizes
logical :: hasTimeDimension
logical :: isSuperArray
+ logical :: isPersistent
type (att_list_type), pointer :: attList => null()
! Pointers to the prev and next blocks for this field on this task
@@ -239,6 +258,7 @@
integer, dimension(2) :: dimSizes
logical :: hasTimeDimension
logical :: isSuperArray
+ logical :: isPersistent
type (att_list_type), pointer :: attList => null()
! Pointers to the prev and next blocks for this field on this task
@@ -268,6 +288,7 @@
integer, dimension(1) :: dimSizes
logical :: hasTimeDimension
logical :: isSuperArray
+ logical :: isPersistent
type (att_list_type), pointer :: attList => null()
! Pointers to the prev and next blocks for this field on this task
@@ -324,6 +345,7 @@
integer, dimension(1) :: dimSizes
logical :: hasTimeDimension
logical :: isSuperArray
+ logical :: isPersistent
type (att_list_type), pointer :: attList => null()
! Pointers to the prev and next blocks for this field on this task
@@ -419,6 +441,8 @@
! Also store parallelization info here
type (dm_info), pointer :: dminfo
+#include "model_variables.inc"
+ character (len=StrKIND*2) :: history !< History attribute, read in from input file.
end type domain_type
interface mpas_allocate_scratch_field
@@ -463,31 +487,54 @@
contains
+!***********************************************************************
+!
+! routine mpas_allocate_domain
+!
+!> \brief MPAS Domain allocation routine
+!> \author Michael Duda
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a domain structure.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_allocate_domain(dom, dminfo)!{{{
- subroutine mpas_allocate_domain(dom, dminfo)
-
implicit none
- type (domain_type), pointer :: dom
- type (dm_info), pointer :: dminfo
+ type (domain_type), pointer :: dom !< Input/Output: Domain structure
+ type (dm_info), pointer :: dminfo !< Input: Domain Information
allocate(dom)
nullify(dom % blocklist)
dom % dminfo => dminfo
- end subroutine mpas_allocate_domain
+ end subroutine mpas_allocate_domain!}}}
-
- subroutine mpas_allocate_block(nHaloLayers, b, dom, blockID, &
+!***********************************************************************
+!
+! routine mpas_allocate_block
+!
+!> \brief MPAS Block allocation routine
+!> \author Michael Duda
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a block structure. It calls routines to allocate the variable structures
+!> that are members of the block type.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_allocate_block(nHaloLayers, b, dom, blockID, &!{{{
#include "dim_dummy_args.inc"
)
implicit none
- integer, intent(in) :: nHaloLayers
- type (block_type), pointer :: b
- type (domain_type), pointer :: dom
- integer, intent(in) :: blockID
+ integer, intent(in) :: nHaloLayers !< Input: Number of halo laters
+ type (block_type), pointer :: b !< Input/Output: Block structure
+ type (domain_type), pointer :: dom !< Input: Domain structure
+ integer, intent(in) :: blockID !< Input: Global ID of block
#include "dim_dummy_decls.inc"
@@ -502,19 +549,30 @@
#include "block_allocs.inc"
- end subroutine mpas_allocate_block
+ end subroutine mpas_allocate_block!}}}
#include "group_alloc_routines.inc"
#include "provis_alloc_routines.inc"
-
+!***********************************************************************
+!
+! routine mpas_deallocate_domain
+!
+!> \brief MPAS Domain deallocation routine
+!> \author Michael Duda
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a domain structure.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_domain(dom)!{{{
implicit none
- type (domain_type), pointer :: dom
+ type (domain_type), pointer :: dom !< Input/Output: Domain to deallocate
type (block_type), pointer :: block_ptr
@@ -528,12 +586,28 @@
end subroutine mpas_deallocate_domain!}}}
+!***********************************************************************
+!
+! routine mpas_allocate_scratch_field1d_integer
+!
+!> \brief MPAS 1D Scratch integer allocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a 1D scratch integer field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_allocate_scratch_field1d_integer(f, single_block_in)!{{{
- type (field1dInteger), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field1dInteger), pointer :: f !< Input: Field to allocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated or all blocks.
logical :: single_block
type (field1dInteger), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -556,12 +630,28 @@
end subroutine mpas_allocate_scratch_field1d_integer!}}}
+!***********************************************************************
+!
+! routine mpas_allocate_scratch_field2d_integer
+!
+!> \brief MPAS 2D Scratch integer allocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a 2D scratch integer field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_allocate_scratch_field2d_integer(f, single_block_in)!{{{
- type (field2dInteger), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field2dInteger), pointer :: f !< Input: Field to allocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks.
logical :: single_block
type (field2dInteger), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -584,12 +674,28 @@
end subroutine mpas_allocate_scratch_field2d_integer!}}}
+!***********************************************************************
+!
+! routine mpas_allocate_scratch_field3d_integer
+!
+!> \brief MPAS 3D Scratch integer allocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a 3D scratch integer field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_allocate_scratch_field3d_integer(f, single_block_in)!{{{
- type (field3dInteger), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field3dInteger), pointer :: f !< Input: Field to allocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks.
logical :: single_block
type (field3dInteger), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -612,12 +718,28 @@
end subroutine mpas_allocate_scratch_field3d_integer!}}}
+!***********************************************************************
+!
+! routine mpas_allocate_scratch_field1d_real
+!
+!> \brief MPAS 1D Scratch real allocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a 1D scratch real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_allocate_scratch_field1d_real(f, single_block_in)!{{{
- type (field1dReal), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field1dReal), pointer :: f !< Input: Field to allocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks.
logical :: single_block
type (field1dReal), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -640,12 +762,28 @@
end subroutine mpas_allocate_scratch_field1d_real!}}}
+!***********************************************************************
+!
+! routine mpas_allocate_scratch_field2d_real
+!
+!> \brief MPAS 2D Scratch real allocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a 2D scratch real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_allocate_scratch_field2d_real(f, single_block_in)!{{{
- type (field2dReal), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field2dReal), pointer :: f !< Input: Field to allocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks.
logical :: single_block
type (field2dReal), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -668,12 +806,28 @@
end subroutine mpas_allocate_scratch_field2d_real!}}}
+!***********************************************************************
+!
+! routine mpas_allocate_scratch_field3d_real
+!
+!> \brief MPAS 3D Scratch real allocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a 3D scratch real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_allocate_scratch_field3d_real(f, single_block_in)!{{{
- type (field3dReal), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field3dReal), pointer :: f !< Input: Field to allocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks.
logical :: single_block
type (field3dReal), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -696,12 +850,28 @@
end subroutine mpas_allocate_scratch_field3d_real!}}}
+!***********************************************************************
+!
+! routine mpas_allocate_scratch_field4D_real
+!
+!> \brief MPAS 4D Scratch real allocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a 4D scratch real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_allocate_scratch_field4d_real(f, single_block_in)!{{{
- type (field4dReal), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field4dReal), pointer :: f !< Input: Field to allocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks.
logical :: single_block
type (field4dReal), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -724,12 +894,28 @@
end subroutine mpas_allocate_scratch_field4d_real!}}}
+!***********************************************************************
+!
+! routine mpas_allocate_scratch_field5D_real
+!
+!> \brief MPAS 5D Scratch real allocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a 5D scratch real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_allocate_scratch_field5d_real(f, single_block_in)!{{{
- type (field5dReal), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field5dReal), pointer :: f !< Input: Field to allocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks.
logical :: single_block
type (field5dReal), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -752,12 +938,28 @@
end subroutine mpas_allocate_scratch_field5d_real!}}}
+!***********************************************************************
+!
+! routine mpas_allocate_scratch_field1D_char
+!
+!> \brief MPAS 1D Scratch character deallocation rotuine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine allocates a 1D scratch character field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_allocate_scratch_field1d_char(f, single_block_in)!{{{
- type (field1dChar), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field1dChar), pointer :: f !< Input: Field to allocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks.
logical :: single_block
type (field1dChar), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -780,12 +982,28 @@
end subroutine mpas_allocate_scratch_field1d_char!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_scratch_field1D_integer
+!
+!> \brief MPAS 1D Scratch integer deallocation rotuine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 1D scratch integer field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_scratch_field1d_integer(f, single_block_in)!{{{
- type (field1dInteger), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field1dInteger), pointer :: f !< Input: Field to deallocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical that determines if a single block should be deallocated, or all blocks.
logical :: single_block
type (field1dInteger), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -809,12 +1027,28 @@
end subroutine mpas_deallocate_scratch_field1d_integer!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_scratch_field2D_integer
+!
+!> \brief MPAS 2D Scratch integer deallocation rotuine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 2D scratch integer field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_scratch_field2d_integer(f, single_block_in)!{{{
- type (field2dInteger), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field2dInteger), pointer :: f !< Input: Field to deallocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical that determines if a single block should be deallocated, or all blocks.
logical :: single_block
type (field2dInteger), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -838,12 +1072,28 @@
end subroutine mpas_deallocate_scratch_field2d_integer!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_scratch_field3D_integer
+!
+!> \brief MPAS 3D Scratch integer deallocation rotuine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 3D scratch integer field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_scratch_field3d_integer(f, single_block_in)!{{{
- type (field3dInteger), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field3dInteger), pointer :: f !< Input: Field to deallocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical that determines if a single block should be deallocated, or all blocks.
logical :: single_block
type (field3dInteger), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -867,12 +1117,28 @@
end subroutine mpas_deallocate_scratch_field3d_integer!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_scratch_field1D_real
+!
+!> \brief MPAS 1D Scratch real deallocation rotuine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 1D scratch real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_scratch_field1d_real(f, single_block_in)!{{{
- type (field1dReal), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field1dReal), pointer :: f !< Input: Field to deallocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical that determines if a single block should be deallocated, or all blocks.
logical :: single_block
type (field1dReal), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -896,12 +1162,28 @@
end subroutine mpas_deallocate_scratch_field1d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_scratch_field2D_real
+!
+!> \brief MPAS 2D Scratch real deallocation rotuine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 2D scratch real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_scratch_field2d_real(f, single_block_in)!{{{
- type (field2dReal), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field2dReal), pointer :: f !< Input: Field to deallocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical that determines if a single block should be deallocated, or all blocks.
logical :: single_block
type (field2dReal), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -925,12 +1207,28 @@
end subroutine mpas_deallocate_scratch_field2d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_scratch_field3D_real
+!
+!> \brief MPAS 3D Scratch real deallocation rotuine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 3D scratch real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_scratch_field3d_real(f, single_block_in)!{{{
- type (field3dReal), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field3dReal), pointer :: f !< Input: Field to deallocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical that determines if a single block should be deallocated, or all blocks.
logical :: single_block
type (field3dReal), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -954,12 +1252,28 @@
end subroutine mpas_deallocate_scratch_field3d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_scratch_field4D_real
+!
+!> \brief MPAS 4D Scratch real deallocation rotuine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 4D scratch real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_scratch_field4d_real(f, single_block_in)!{{{
- type (field4dReal), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field4dReal), pointer :: f !< Input: Field to deallocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical that determines if a single block should be deallocated, or all blocks.
logical :: single_block
type (field4dReal), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -983,12 +1297,28 @@
end subroutine mpas_deallocate_scratch_field4d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_scratch_field5D_real
+!
+!> \brief MPAS 5D Scratch real deallocation rotuine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 5D scratch real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_scratch_field5d_real(f, single_block_in)!{{{
- type (field5dReal), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field5dReal), pointer :: f !< Input: Field to deallocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical that determines if a single block should be deallocated, or all blocks.
logical :: single_block
type (field5dReal), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -1012,12 +1342,28 @@
end subroutine mpas_deallocate_scratch_field5d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_scratch_field1D_char
+!
+!> \brief MPAS 1D Scratch character deallocation rotuine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 1D scratch character field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_scratch_field1d_char(f, single_block_in)!{{{
- type (field1dChar), pointer :: f
- logical, intent(in), optional :: single_block_in
+ type (field1dChar), pointer :: f !< Input: Field to deallocate
+ logical, intent(in), optional :: single_block_in !< Input: Logical that determines if a single block should be deallocated, or all blocks.
logical :: single_block
type (field1dChar), pointer :: f_cursor
+ if(f % isPersistent) then
+ return
+ end if
+
if(present(single_block_in)) then
single_block = single_block_in
else
@@ -1041,9 +1387,20 @@
end subroutine mpas_deallocate_scratch_field1d_char!}}}
-
+!***********************************************************************
+!
+! routine mpas_deallocate_field0d_integer
+!
+!> \brief MPAS 0D integer deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 0D integer field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field0d_integer(f)!{{{
- type (field0dInteger), pointer :: f
+ type (field0dInteger), pointer :: f !< Input: Field to deallocate
type (field0dInteger), pointer :: f_cursor
f_cursor => f
@@ -1065,8 +1422,20 @@
end subroutine mpas_deallocate_field0d_integer!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field1D_integer
+!
+!> \brief MPAS 1D integer deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 1D integer field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field1d_integer(f)!{{{
- type (field1dInteger), pointer :: f
+ type (field1dInteger), pointer :: f !< Input: Field to deallocate
type (field1dInteger), pointer :: f_cursor
f_cursor => f
@@ -1092,8 +1461,20 @@
end subroutine mpas_deallocate_field1d_integer!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field2D_integer
+!
+!> \brief MPAS 2D integer deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 2D integer field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field2d_integer(f)!{{{
- type (field2dInteger), pointer :: f
+ type (field2dInteger), pointer :: f !< Input: Field to deallocate
type (field2dInteger), pointer :: f_cursor
f_cursor => f
@@ -1119,8 +1500,20 @@
end subroutine mpas_deallocate_field2d_integer!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field3D_integer
+!
+!> \brief MPAS 3D integer deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 3D integer field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field3d_integer(f)!{{{
- type (field3dInteger), pointer :: f
+ type (field3dInteger), pointer :: f !< Input: Field to deallocate
type (field3dInteger), pointer :: f_cursor
f_cursor => f
@@ -1146,8 +1539,20 @@
end subroutine mpas_deallocate_field3d_integer!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field0d_real
+!
+!> \brief MPAS 0D real deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 0D real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field0d_real(f)!{{{
- type (field0dReal), pointer :: f
+ type (field0dReal), pointer :: f !< Input: Field to deallocate
type (field0dReal), pointer :: f_cursor
f_cursor => f
@@ -1170,8 +1575,20 @@
end subroutine mpas_deallocate_field0d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field1D_real
+!
+!> \brief MPAS 1D real deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 1D real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field1d_real(f)!{{{
- type (field1dReal), pointer :: f
+ type (field1dReal), pointer :: f !< Input: Field to deallocate
type (field1dReal), pointer :: f_cursor
f_cursor => f
@@ -1197,8 +1614,20 @@
end subroutine mpas_deallocate_field1d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field2D_real
+!
+!> \brief MPAS 2D real deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 2D real field.
+!
+
subroutine mpas_deallocate_field2d_real(f)!{{{
- type (field2dReal), pointer :: f
+ type (field2dReal), pointer :: f !< Input: Field to deallocate
type (field2dReal), pointer :: f_cursor
f_cursor => f
@@ -1224,8 +1653,20 @@
end subroutine mpas_deallocate_field2d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field3D_real
+!
+!> \brief MPAS 3D real deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 3D real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field3d_real(f)!{{{
- type (field3dReal), pointer :: f
+ type (field3dReal), pointer :: f !< Input: Field to deallocate
type (field3dReal), pointer :: f_cursor
f_cursor => f
@@ -1251,8 +1692,20 @@
end subroutine mpas_deallocate_field3d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field4D_real
+!
+!> \brief MPAS 4D real deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 4D real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field4d_real(f)!{{{
- type (field4dReal), pointer :: f
+ type (field4dReal), pointer :: f !< Input: Field to deallocate
type (field4dReal), pointer :: f_cursor
f_cursor => f
@@ -1278,8 +1731,20 @@
end subroutine mpas_deallocate_field4d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field5D_real
+!
+!> \brief MPAS 5D real deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 5D real field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field5d_real(f)!{{{
- type (field5dReal), pointer :: f
+ type (field5dReal), pointer :: f !< Input: Field to deallocate
type (field5dReal), pointer :: f_cursor
f_cursor => f
@@ -1305,8 +1770,20 @@
end subroutine mpas_deallocate_field5d_real!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field0D_char
+!
+!> \brief MPAS 0D character deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 0D character field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field0d_char(f)!{{{
- type (field0dChar), pointer :: f
+ type (field0dChar), pointer :: f !< Input: Field to deallocate
type (field0dChar), pointer :: f_cursor
f_cursor => f
@@ -1328,8 +1805,20 @@
end subroutine mpas_deallocate_field0d_char!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_field1D_char
+!
+!> \brief MPAS 1D character deallocation routine.
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a 1D character field.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_field1d_char(f)!{{{
- type (field1dChar), pointer :: f
+ type (field1dChar), pointer :: f !< Input: Field to deallocate
type (field1dChar), pointer :: f_cursor
f_cursor => f
@@ -1355,16 +1844,29 @@
end subroutine mpas_deallocate_field1d_char!}}}
+!***********************************************************************
+!
+! routine mpas_deallocate_block
+!
+!> \brief MPAS Block deallocation routine
+!> \author Doug Jacobsen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine deallocates a block structure.
+!
+!-----------------------------------------------------------------------
subroutine mpas_deallocate_block(b)!{{{
implicit none
- type (block_type), intent(inout) :: b
+ type (block_type), intent(inout) :: b !< Input/Output: Block to be deallocated.
integer :: i
! BUG: It seems like we should be deallocating the exchange lists before we
! deallocate the array of head pointers and the parinfo type...
+ ! It also seems like these deallocations should happen with mpas_dmpar_destroy_multihalo_exchange_list
deallocate(b % parinfo % cellsToSend)
deallocate(b % parinfo % cellsToRecv)
Modified: branches/mpas_cdg_advection/src/framework/mpas_hash.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_hash.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_hash.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,14 +1,19 @@
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! MODULE HASH
+!***********************************************************************
!
-! Purpose: This module provides a dictionary/hashtable with insert, search, and
-! remove routines.
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! mpas_hash
+!
+!> \brief MPAS Hash table module
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This module provides A dictionary/hashtable with insert, search, and remove routines.
+!
+!-----------------------------------------------------------------------
module mpas_hash
! Parameters
- integer, parameter :: TABLESIZE=27183 ! Number of spaces in the table (the
- ! number of linked lists)
+ integer, parameter :: TABLESIZE=27183 !< Number of spaces in the table (the number of linked lists)
type hashnode
integer :: key
@@ -16,29 +21,35 @@
end type hashnode
type hashnode_ptr
- type (hashnode), pointer :: p ! Pointer to a list of entries
+ type (hashnode), pointer :: p !< Pointer to a list of entries
end type hashnode_ptr
type hashtable
integer :: size
- type (hashnode_ptr), dimension(TABLESIZE) :: table ! The hashtable array
+ type (hashnode_ptr), dimension(TABLESIZE) :: table !< The hashtable array
end type hashtable
contains
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Name: hash_init
- !
- ! Purpose: To initialize a hashtable
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_hash_init(h)
+!***********************************************************************
+!
+! routine mpas_hash_init
+!
+!> \brief MPAS Hash table init routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a hashtable.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_hash_init(h)!{{{
implicit none
! Arguments
- type (hashtable), intent(inout) :: h
+ type (hashtable), intent(inout) :: h !< Input/Output: Hash table
! Local variables
integer :: i
@@ -49,25 +60,29 @@
nullify(h%table(i)%p)
end do
- end subroutine mpas_hash_init
+ end subroutine mpas_hash_init!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Name: hash_insert
- !
- ! Purpose: Given a hashtable h and a key to be inserted into the hashtable,
- ! this routine adds key to the table.
- !
- ! NOTE: If the key already exists in the table, a second copy of the
- ! key is added to the table
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_hash_insert(h, key)
+!***********************************************************************
+!
+! routine mpas_hash_insert
+!
+!> \brief MPAS Hash table insert routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine inserts a key into a hashtable. If the key already exists in the hash table,
+!> a second copy of the key is added to the table.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_hash_insert(h, key)!{{{
implicit none
! Arguments
- integer, intent(in) :: key
- type (hashtable), intent(inout) :: h
+ integer, intent(in) :: key !< Input: Key
+ type (hashtable), intent(inout) :: h !< Input/Output: Hashtable
! Local variables
integer :: hashval, i
@@ -82,22 +97,27 @@
h%size = h%size + 1
- end subroutine mpas_hash_insert
+ end subroutine mpas_hash_insert!}}}
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Name: hash_search
- !
- ! Purpose: This function returns TRUE if the specified key was found in the
- ! hashtable h, and FALSE otherwise.
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- logical function mpas_hash_search(h, key)
+!***********************************************************************
+!
+! logical function mpas_hash_search
+!
+!> \brief MPAS Hash table search routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This function searches for a key within a hashtable. If the key is found TRUE is returned, and FALSE is return otherwise.
+!
+!-----------------------------------------------------------------------
+ logical function mpas_hash_search(h, key)!{{{
implicit none
! Arguments
- integer, intent(in) :: key
- type (hashtable), intent(inout) :: h
+ integer, intent(in) :: key !< Input: Key
+ type (hashtable), intent(inout) :: h !< Input/Output: Hashtable
! Local variables
integer :: hashval, i
@@ -170,6 +190,6 @@
h%size = 0
- end subroutine mpas_hash_destroy
+ end subroutine mpas_hash_destroy!}}}
end module mpas_hash
Modified: branches/mpas_cdg_advection/src/framework/mpas_io.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_io.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_io.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1248,7 +1248,10 @@
pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, tempchar)
charVal(1:count2(1)) = tempchar(1)(1:count2(1))
else
- pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % field_desc, charVal)
+ start1(1) = 1
+ count1(1) = field_cursor % fieldhandle % dims(1) % dimsize
+ pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start1, count1, tempchar)
+ charVal(1:count1(1)) = tempchar(1)(1:count1(1))
end if
else if (present(realArray1d)) then
! write (0,*) ' value is real1'
@@ -1643,7 +1646,9 @@
count2(1) = field_cursor % fieldhandle % dims(1) % dimsize
pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, (/charVal/))
else
- pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % field_desc, charVal)
+ start1(1) = 1
+ count1(1) = field_cursor % fieldhandle % dims(1) % dimsize
+ pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start1, count1, (/charVal/))
end if
else if (present(realArray1d)) then
call PIO_write_darray(handle % pio_file, field_cursor % fieldhandle % field_desc, field_cursor % fieldhandle % decomp % pio_iodesc, &
Modified: branches/mpas_cdg_advection/src/framework/mpas_io_input.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_io_input.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_io_input.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -10,10 +10,6 @@
use mpas_io_streams
-#ifdef HAVE_ZOLTAN
- use mpas_zoltan_interface
-#endif
-
integer, parameter :: STREAM_INPUT=1, STREAM_SFC=2, STREAM_RESTART=3
type io_input_object
@@ -245,6 +241,22 @@
end if
end if
+ call MPAS_readStreamAtt(input_obj % io_stream, 'history', domain % history, ierr)
+ if (ierr /= MPAS_STREAM_NOERR) then
+ write(0,*) 'Warning: Attribute History not found in '//trim(input_obj % filename)
+ write(0,*) ' Setting History to '''''
+ domain % history = ""
+ else
+ ! Remove C String NULL characters, replace C String newlines with semicolons
+ do i = 1, len(domain % history)
+ if(iachar(domain % history(i:i)) == 0) then
+ domain % history(i:i) = " "
+ else if(iachar(domain % history(i:i)) == 10) then
+ domain % history(i:i) = ";"
+ end if
+ end do
+ end if
+
block_ptr => domain % blocklist % next
do while (associated(block_ptr))
block_ptr % mesh % sphere_radius = domain % blocklist % mesh % sphere_radius
@@ -339,161 +351,12 @@
call mpas_deallocate_field(nVerticesSolveField)
call mpas_deallocate_field(nEdgesSolveField)
-#ifdef HAVE_ZOLTAN
- call mpas_deallocate_field(xCellField)
- call mpas_deallocate_field(yCellField)
- call mpas_deallocate_field(zCellField)
- call mpas_deallocate_field(xVertexField)
- call mpas_deallocate_field(yVertexField)
- call mpas_deallocate_field(zVertexField)
- call mpas_deallocate_field(xEdgeField)
- call mpas_deallocate_field(yEdgeField)
- call mpas_deallocate_field(zEdgeField)
-
- call mpas_deallocate_field(xCell)
- call mpas_deallocate_field(yCell)
- call mpas_deallocate_field(zCell)
- call mpas_deallocate_field(xVertex)
- call mpas_deallocate_field(yVertex)
- call mpas_deallocate_field(zVertex)
- call mpas_deallocate_field(xEdge)
- call mpas_deallocate_field(yEdge)
- call mpas_deallocate_field(zEdge)
-#endif
-
deallocate(local_cell_list)
deallocate(block_id)
deallocate(block_start)
deallocate(block_count)
deallocate(readingBlock)
-!#ifdef HAVE_ZOLTAN
-!#ifdef _MPI
-! allocate(xCell(size(local_cell_list)))
-! allocate(yCell(size(local_cell_list)))
-! allocate(zCell(size(local_cell_list)))
-! call mpas_dmpar_alltoall_field(domain % dminfo, xCellField % array, xCell, &
-! size(xCellField % array), size(local_cell_list), &
-! sendCellList, recvCellList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, yCellField % array, yCell, &
-! size(yCellField % array), size(local_cell_list), &
-! sendCellList, recvCellList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, zCellField % array, zCell, &
-! size(zCellField % array), size(local_cell_list), &
-! sendCellList, recvCellList)
-!#endif
-!#endif
-
-!#ifdef HAVE_ZOLTAN
-!#ifdef _MPI
-! !! For now, only use Zoltan with MPI
-! !! Zoltan initialization
-! call mpas_zoltan_start()
-!
-! !! Zoltan hook for cells
-! call mpas_zoltan_order_loc_hsfc_cells(block_graph_2Halo%nVertices,block_graph_2Halo%VertexID,3,xCell,yCell,zCell)
-!#endif
-!#endif
-!
-!
-!#ifdef HAVE_ZOLTAN
-!#ifdef _MPI
-! allocate(xEdge(nlocal_edges))
-! allocate(yEdge(nlocal_edges))
-! allocate(zEdge(nlocal_edges))
-! allocate(xVertex(nlocal_vertices))
-! allocate(yVertex(nlocal_vertices))
-! allocate(zVertex(nlocal_vertices))
-!#endif
-!#endif
-!
-!#ifdef HAVE_ZOLTAN
-!#ifdef _MPI
-! call mpas_dmpar_alltoall_field(domain % dminfo, xEdgeField % array, xEdge, &
-! size(xEdgeField % array), nlocal_edges, &
-! sendEdgeList, recvEdgeList)
-! call mpas_dmpar_alltoall_field(domain % dminfo, yEdgeField % array, yEdge, &
-! size(yEdgeField % array), nlocal_edges, &
-! sendEdgeList, recvEdgeList)
-! call mpas_dmpar_alltoall_field(domain % dminfo, zEdgeField % array, zEdge, &
-! size(zEdgeField % array), nlocal_edges, &
-! sendEdgeList, recvEdgeList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, xVertexField % array, xVertex, &
-! size(xVertexField % array), nlocal_vertices, &
-! sendVertexList, recvVertexList)
-! call mpas_dmpar_alltoall_field(domain % dminfo, yVertexField % array, yVertex, &
-! size(yVertexField % array), nlocal_vertices, &
-! sendVertexList, recvVertexList)
-! call mpas_dmpar_alltoall_field(domain % dminfo, zVertexField % array, zVertex, &
-! size(zVertexField % array), nlocal_vertices, &
-! sendVertexList, recvVertexList)
-! !!!!!!!!!!!!!!!!!!
-! !! Reorder edges
-! !!!!!!!!!!!!!!!!!!
-! call mpas_zoltan_order_loc_hsfc_edges(nOwnEdges,local_edge_list,3,xEdge,yEdge,zEdge)
-! !!!!!!!!!!!!!!!!!!
-!
-! !!!!!!!!!!!!!!!!!!
-! !! Reorder vertices
-! !!!!!!!!!!!!!!!!!!
-! call mpas_zoltan_order_loc_hsfc_verts(nOwnVertices,local_vertex_list,3,xVertex,yVertex,zVertex)
-! !!!!!!!!!!!!!!!!!!
-!
-! deallocate(sendEdgeList % list)
-! deallocate(sendEdgeList)
-! deallocate(recvEdgeList % list)
-! deallocate(recvEdgeList)
-!
-! deallocate(sendVertexList % list)
-! deallocate(sendVertexList)
-! deallocate(recvVertexList % list)
-! deallocate(recvVertexList)
-!
-! !
-! ! Knowing which edges/vertices are owned by this block and which are actually read
-! ! from the input or restart file, we can build exchange lists to perform
-! ! all-to-all field exchanges from process that reads a field to the processes that
-! ! need them
-! !
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! size(indexToEdgeIDField % array), nlocal_edges, &
-! indexToEdgeIDField % array, local_edge_list, &
-! sendEdgeList, recvEdgeList)
-!
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! size(indexToVertexIDField % array), nlocal_vertices, &
-! indexToVertexIDField % array, local_vertex_list, &
-! sendVertexList, recvVertexList)
-!
-!#endif
-!#endif
-!
-
-
-! !
-! ! Deallocate fields, graphs, and other memory
-! !
-!#ifdef HAVE_ZOLTAN
-!#ifdef _MPI
-! deallocate(xCellField % ioinfo)
-! deallocate(xCellField % array)
-! deallocate(yCellField % ioinfo)
-! deallocate(yCellField % array)
-! deallocate(zCellField % ioinfo)
-! deallocate(zCellField % array)
-!#endif
-!#endif
-
-!#ifdef HAVE_ZOLTAN
-!#ifdef _MPI
-! deallocate(xCell)
-! deallocate(yCell)
-! deallocate(zCell)
-!#endif
-!#endif
end subroutine mpas_input_state_for_domain!}}}
!CR:TODO: an identical subroutine is found in module_io_output - merge
@@ -672,61 +535,7 @@
call mpas_dmpar_init_mulithalo_exchange_list(indexToCellID % copyList, nHalos)
nullify(indexToCellID % next)
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI
- ! Cell x-coordinates (in 3d Cartesian space)
- allocate(xCell)
- allocate(xCell % ioinfo)
- xCell % ioinfo % fieldName = 'xCell'
- xCell % ioinfo % start(1) = readCellStart
- xCell % ioinfo % count(1) = nReadCells
- allocate(xCell % array(nReadCells))
- call MPAS_io_inq_var(inputHandle, 'xCell', ierr=ierr)
- call MPAS_io_set_var_indices(inputHandle, 'xCell', readIndices, ierr=ierr)
- call mpas_io_get_var(inputHandle, 'xCell', xCell % array, ierr)
- xCell % dimSizes(1) = nReadCells
- xCell % block => readingBlock
- xCell % sendList => indexToCellID % sendList
- xCell % recvList => indexToCellID % recvList
- xCell % copyList => indexToCellID % copyList
- nullify(xCell % next)
- ! Cell y-coordinates (in 3d Cartesian space)
- allocate(yCell)
- allocate(yCell % ioinfo)
- yCell % ioinfo % fieldName = 'yCell'
- yCell % ioinfo % start(1) = readCellStart
- yCell % ioinfo % count(1) = nReadCells
- allocate(yCell % array(nReadCells))
- call MPAS_io_inq_var(inputHandle, 'yCell', ierr=ierr)
- call MPAS_io_set_var_indices(inputHandle, 'yCell', readIndices, ierr=ierr)
- call mpas_io_get_var(inputHandle, 'yCell', yCell % array, ierr)
- yCell % sendList => indexToCellID % sendList
- yCell % recvList => indexToCellID % recvList
- yCell % copyList => indexToCellID % copyList
- yCell % dimSizes(1) = nReadCells
- yCell % block => readingBlock
- nullify(yCell % next)
-
- ! Cell z-coordinates (in 3d Cartesian space)
- allocate(zCell)
- allocate(zCell % ioinfo)
- zCell % ioinfo % fieldName = 'zCell'
- zCell % ioinfo % start(1) = readCellStart
- zCell % ioinfo % count(1) = nReadCells
- allocate(zCell % array(nReadCells))
- call MPAS_io_inq_var(inputHandle, 'zCell', ierr=ierr)
- call MPAS_io_set_var_indices(inputHandle, 'zCell', readIndices, ierr=ierr)
- call mpas_io_get_var(inputHandle, 'zCell', zCell % array, ierr)
- zCell % dimSizes(1) = nReadCells
- zCell % block => readingBlock
- zCell % sendList => indexToCellID % sendList
- zCell % recvList => indexToCellID % recvList
- zCell % copyList => indexToCellID % copyList
- nullify(zCell % next)
-#endif
-#endif
-
! Number of cell/edges/vertices adjacent to each cell
allocate(nEdgesOnCell)
allocate(nEdgesOnCell % ioinfo)
@@ -852,61 +661,6 @@
call mpas_dmpar_init_mulithalo_exchange_list(indexToEdgeID % copyList, nHalos+1)
nullify(indexToEdgeID % next)
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI
- ! Edge x-coordinates (in 3d Cartesian space)
- allocate(xEdge)
- allocate(xEdge % ioinfo)
- xEdge % ioinfo % fieldName = 'xEdge'
- xEdge % ioinfo % start(1) = readEdgeStart
- xEdge % ioinfo % count(1) = nReadEdges
- allocate(xEdge % array(nReadEdges))
- call MPAS_io_inq_var(inputHandle, 'xEdge', ierr=ierr)
- call MPAS_io_set_var_indices(inputHandle, 'xEdge', readIndices, ierr=ierr)
- call mpas_io_get_var(inputHandle, 'xEdge', xEdge % array, ierr)
- xEdge % dimSizes(1) = nReadEdges
- xEdge % block => readingBlock
- xEdge % sendList => indexToEdgeID % sendList
- xEdge % recvList => indexToEdgeID % recvList
- xEdge % copyList => indexToEdgeID % copyList
- nullify(xEdge % next)
-
- ! Edge y-coordinates (in 3d Cartesian space)
- allocate(yEdge)
- allocate(yEdge % ioinfo)
- yEdge % ioinfo % fieldName = 'yEdge'
- yEdge % ioinfo % start(1) = readEdgeStart
- yEdge % ioinfo % count(1) = nReadEdges
- allocate(yEdge % array(nReadEdges))
- call MPAS_io_inq_var(inputHandle, 'yEdge', ierr=ierr)
- call MPAS_io_set_var_indices(inputHandle, 'yEdge', readIndices, ierr=ierr)
- call mpas_io_get_var(inputHandle, 'yEdge', yEdge % array, ierr)
- yEdge % dimSizes(1) = nReadEdges
- yEdge % block => readingBlock
- yEdge % sendList => indexToEdgeID % sendList
- yEdge % recvList => indexToEdgeID % recvList
- yEdge % copyList => indexToEdgeID % copyList
- nullify(yEdge % next)
-
- ! Edge z-coordinates (in 3d Cartesian space)
- allocate(zEdge)
- allocate(zEdge % ioinfo)
- zEdge % ioinfo % fieldName = 'zEdge'
- zEdge % ioinfo % start(1) = readEdgeStart
- zEdge % ioinfo % count(1) = nReadEdges
- allocate(zEdge % array(nReadEdges))
- call MPAS_io_inq_var(inputHandle, 'zEdge', ierr=ierr)
- call MPAS_io_set_var_indices(inputHandle, 'zEdge', readIndices, ierr=ierr)
- call mpas_io_get_var(inputHandle, 'zEdge', zEdge % array, ierr)
- zEdge % dimSizes(1) = nReadEdges
- zEdge % block => readingBlock
- zEdge % sendList => indexToEdgeID % sendList
- zEdge % recvList => indexToEdgeID % recvList
- zEdge % copyList => indexToEdgeID % copyList
- nullify(zEdge % next)
-#endif
-#endif
-
! Global indices of cells adjacent to each edge
! used for determining which edges are owned by a block, where
@@ -972,61 +726,6 @@
call mpas_dmpar_init_mulithalo_exchange_list(indexToVertexID % copyList, nHalos+1)
nullify(indexToVertexID % next)
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI
- ! Vertex x-coordinates (in 3d Cartesian space)
- allocate(xVertex)
- allocate(xVertex % ioinfo)
- xVertex % ioinfo % fieldName = 'xVertex'
- xVertex % ioinfo % start(1) = readVertexStart
- xVertex % ioinfo % count(1) = nReadVertices
- allocate(xVertex % array(nReadVertices))
- call MPAS_io_inq_var(inputHandle, 'xVertex', ierr=ierr)
- call MPAS_io_set_var_indices(inputHandle, 'xVertex', readIndices, ierr=ierr)
- call mpas_io_get_var(inputHandle, 'xVertex', xVertex % array, ierr)
- xVertex % dimSizes(1) = nReadVertices
- xVertex % block => readingBlock
- xVertex % sendList => indexToVertexID % sendList
- xVertex % recvList => indexToVertexID % recvList
- xVertex % copyList => indexToVertexID % copyList
- nullify(xVertex % next)
-
- ! Vertex y-coordinates (in 3d Cartesian space)
- allocate(yVertex)
- allocate(yVertex % ioinfo)
- yVertex % ioinfo % fieldName = 'yVertex'
- yVertex % ioinfo % start(1) = readVertexStart
- yVertex % ioinfo % count(1) = nReadVertices
- allocate(yVertex % array(nReadVertices))
- call MPAS_io_inq_var(inputHandle, 'yVertex', ierr=ierr)
- call MPAS_io_set_var_indices(inputHandle, 'yVertex', readIndices, ierr=ierr)
- call mpas_io_get_var(inputHandle, 'yVertex', yVertex % array, ierr)
- yVertex % dimSizes(1) = nReadVertices
- yVertex % block => readingBlock
- yVertex % sendList => indexToVertexID % sendList
- yVertex % recvList => indexToVertexID % recvList
- yVertex % copyList => indexToVertexID % copyList
- nullify(yVertex % next)
-
- ! Vertex z-coordinates (in 3d Cartesian space)
- allocate(zVertex)
- allocate(zVertex % ioinfo)
- zVertex % ioinfo % fieldName = 'zVertex'
- zVertex % ioinfo % start(1) = readVertexStart
- zVertex % ioinfo % count(1) = nReadVertices
- allocate(zVertex % array(nReadVertices))
- call MPAS_io_inq_var(inputHandle, 'zVertex', ierr=ierr)
- call MPAS_io_set_var_indices(inputHandle, 'zVertex', readIndices, ierr=ierr)
- call mpas_io_get_var(inputHandle, 'zVertex', zVertex % array, ierr)
- zVertex % dimSizes(1) = nReadVertices
- zVertex % block => readingBlock
- zVertex % sendList => indexToVertexID % sendList
- zVertex % recvList => indexToVertexID % recvList
- zVertex % copyList => indexToVertexID % copyList
- nullify(zVertex % next)
-#endif
-#endif
-
! Global indices of cells adjacent to each vertex
! used for determining which vertices are owned by a block, where
Modified: branches/mpas_cdg_advection/src/framework/mpas_io_output.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_io_output.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_io_output.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -343,6 +343,13 @@
integer :: nferr, ierr
integer, dimension(10) :: dimlist
+ character (len=StrKIND*4) :: runCmd
+
+ if(len(trim(domain % history)) > 0) then
+ write(runCmd,'(a,a,i0,a,a,a)') trim(domain % history),' mpirun -n ',domain % dminfo % nProcs, ' ', trim(domain % coreName), '_model.exe; '
+ else
+ write(runCmd,'(a,i0,a,a,a)') 'mpirun -n ',domain % dminfo % nProcs, ' ', trim(domain % coreName), '_model.exe; '
+ end if
call MPAS_createStream(output_obj % io_stream, trim(output_obj % filename), MPAS_IO_PNETCDF, MPAS_IO_WRITE, 1, nferr)
@@ -354,6 +361,10 @@
call MPAS_writeStreamAtt(output_obj % io_stream, 'on_a_sphere', 'NO ', nferr)
end if
call MPAS_writeStreamAtt(output_obj % io_stream, 'sphere_radius', mesh % sphere_radius, nferr)
+ call MPAS_writeStreamAtt(output_obj % io_stream, 'model_name', domain % modelName, nferr)
+ call MPAS_writeStreamAtt(output_obj % io_stream, 'core_name', domain % coreName, nferr)
+ call MPAS_writeStreamAtt(output_obj % io_stream, 'model_version', domain % modelVersion, nferr)
+ call MPAS_writeStreamAtt(output_obj % io_stream, 'history', runCmd, nferr)
#include "add_output_atts.inc"
Modified: branches/mpas_cdg_advection/src/framework/mpas_kind_types.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_kind_types.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_kind_types.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,16 @@
+!***********************************************************************
+!
+! mpas_kind_types
+!
+!> \brief MPAS Kind definition module
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This module defines the kind types for basic fortran data types within MPAS.
+!
+!-----------------------------------------------------------------------
+
module mpas_kind_types
#ifdef SINGLE_PRECISION
@@ -10,6 +23,18 @@
contains
+!***********************************************************************
+!
+! routine dummy_kinds
+!
+!> \brief MPAS Dummy kind routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This is a dummy routine that doesn't do anything.
+!
+!-----------------------------------------------------------------------
subroutine dummy_kinds()
end subroutine dummy_kinds
Modified: branches/mpas_cdg_advection/src/framework/mpas_sort.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_sort.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_sort.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,16 @@
+!***********************************************************************
+!
+! mpas_sort
+!
+!> \brief MPAS Sort and search module
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This module provides routines for various sorting methods, in addition to a binary search.
+!
+!-----------------------------------------------------------------------
+
module mpas_sort
use mpas_kind_types
@@ -11,13 +24,27 @@
contains
+!***********************************************************************
+!
+! recursive routine mpas_mergesort
+!
+!> \brief MPAS Merge sort
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine recursively calls itself to perform a merge sort on array.
+!
+!-----------------------------------------------------------------------
recursive subroutine mpas_mergesort(array, d1, n1, n2)!{{{
implicit none
! Arguments
- integer, intent(in) :: n1, n2, d1
- integer, dimension(1:d1,n1:n2), intent(inout) :: array
+ integer, intent(in) :: d1 !< Input: Size of first dimension of array
+ integer, intent(in) :: n1 !< Input: Beginning of second dimension of array
+ integer, intent(in) :: n2 !< Input: Ending of second dimension of array
+ integer, dimension(1:d1,n1:n2), intent(inout) :: array !< Input/Output: Array to be sorted (in-place)
! Local variables
integer :: i, j, k
@@ -73,12 +100,24 @@
end subroutine mpas_mergesort!}}}
+!***********************************************************************
+!
+! routine mpas_quicksort_1dint
+!
+!> \brief MPAS 1D integer quicksort
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine performs a quicksort on a 1D integer array
+!
+!-----------------------------------------------------------------------
subroutine mpas_quicksort_1dint(nArray, array)!{{{
implicit none
- integer, intent(in) :: nArray
- integer, dimension(nArray), intent(inout) :: array
+ integer, intent(in) :: nArray !< Input: Array size
+ integer, dimension(nArray), intent(inout) :: array !< Input/Output: Array to be sorted
integer :: i, j, top, l, r, pivot, s
integer :: pivot_value
@@ -135,12 +174,24 @@
end subroutine mpas_quicksort_1dint!}}}
+!***********************************************************************
+!
+! routine mpas_quicksort_1dreal
+!
+!> \brief MPAS 1D real quicksort
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine performs a quicksort on a 1D real array
+!
+!-----------------------------------------------------------------------
subroutine mpas_quicksort_1dreal(nArray, array)!{{{
implicit none
- integer, intent(in) :: nArray
- real (kind=RKIND), dimension(nArray), intent(inout) :: array
+ integer, intent(in) :: nArray !< Input: Array size
+ real (kind=RKIND), dimension(nArray), intent(inout) :: array !< Input/Output: Array to be sorted
integer :: i, j, top, l, r, pivot, s
real (kind=RKIND) :: pivot_value
@@ -197,12 +248,24 @@
end subroutine mpas_quicksort_1dreal!}}}
+!***********************************************************************
+!
+! routine mpas_quicksort_2dint
+!
+!> \brief MPAS 2D integer quicksort
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine performs a quicksort on a 2D integer array
+!
+!-----------------------------------------------------------------------
subroutine mpas_quicksort_2dint(nArray, array)!{{{
implicit none
- integer, intent(in) :: nArray
- integer, dimension(2,nArray), intent(inout) :: array
+ integer, intent(in) :: nArray !< Input: Array size
+ integer, dimension(2,nArray), intent(inout) :: array !< Input/Output: Array to be sorted
integer :: i, j, top, l, r, pivot, s
integer :: pivot_value
@@ -259,12 +322,24 @@
end subroutine mpas_quicksort_2dint!}}}
+!***********************************************************************
+!
+! routine mpas_quicksort_2dreal
+!
+!> \brief MPAS 2D real quicksort
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine performs a quicksort on a 2D real array
+!
+!-----------------------------------------------------------------------
subroutine mpas_quicksort_2dreal(nArray, array)!{{{
implicit none
- integer, intent(in) :: nArray
- real (kind=RKIND), dimension(2,nArray), intent(inout) :: array
+ integer, intent(in) :: nArray !< Input: Array size
+ real (kind=RKIND), dimension(2,nArray), intent(inout) :: array !< Input/Output: Array to be sorted
integer :: i, j, top, l, r, pivot, s
real (kind=RKIND) :: pivot_value
@@ -321,6 +396,18 @@
end subroutine mpas_quicksort_2dreal!}}}
+!***********************************************************************
+!
+! integer function mpas_binary_search
+!
+!> \brief MPAS Binary search routine
+!> \author Michael Duda
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine performs a binary search in array for the key. It either returns the index of the key within array, or n2+1 if the key is not found.
+!
+!-----------------------------------------------------------------------
integer function mpas_binary_search(array, d1, n1, n2, key)!{{{
implicit none
Modified: branches/mpas_cdg_advection/src/framework/mpas_timer.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_timer.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_timer.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,17 @@
+!***********************************************************************
+!
+! mpas_timer
+!
+!> \brief MPAS Timer module
+!> \author Michael Duda, Doug Jacobsen
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This module provides developers with internal timer routines. These can be
+!> use to profile various parts of code within MPAS. Calls to TAU happen in this module as well
+!> to provide more detailed profiling.
+!
+!-----------------------------------------------------------------------
module mpas_timer
use mpas_kind_types
@@ -32,6 +46,19 @@
contains
+!***********************************************************************
+!
+! routine mpas_timer_start
+!
+!> \brief MPAS Timer start routine
+!> \author Doug Jacobsen
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine starts a timer. By default, timer_name is searched for in the linked list of timers.
+!> If timer_ptr is provided, the search doesn't happen and the pointer to the timer is used (or allocated if not created yet).
+!
+!-----------------------------------------------------------------------
subroutine mpas_timer_start(timer_name, clear_timer, timer_ptr)!{{{
# ifdef _MPI
use mpi
@@ -161,6 +188,19 @@
end subroutine mpas_timer_start!}}}
+!***********************************************************************
+!
+! routine mpas_timer_stop
+!
+!> \brief MPAS Timer stop routine
+!> \author Doug Jacobsen
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine stops a timer. By default, timer_name is searched for in the linked list of timers.
+!> If timer_ptr is provided, the search doesn't happen and the pointer to the timer is used.
+!
+!-----------------------------------------------------------------------
subroutine mpas_timer_stop(timer_name, timer_ptr)!{{{
# ifdef _MPI
use mpi
@@ -238,9 +278,23 @@
end subroutine mpas_timer_stop!}}}
+!***********************************************************************
+!
+! recursive routine mpas_timer_write
+!
+!> \brief MPAS Timer write routine
+!> \author Doug Jacobsen
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine writes all timer output to stdout. It recursively calls
+!> itself until all timers have been written out. Prior to writing timers,
+!> this routine calls mpas_timer_sync.
+!
+!-----------------------------------------------------------------------
recursive subroutine mpas_timer_write(timer_ptr, total_ptr)!{{{
- type (timer_node), pointer, optional :: timer_ptr
- type (timer_node), pointer, optional :: total_ptr
+ type (timer_node), pointer, optional :: timer_ptr !< Input - Optional: Pointer to a specific timer to write out.
+ type (timer_node), pointer, optional :: total_ptr !< Input - Optional: Pointer to the total_time timer.
character (len=StrKIND) :: tname
logical :: total_found, string_equals
@@ -312,8 +366,20 @@
end subroutine mpas_timer_write!}}}
+!***********************************************************************
+!
+! routine mpas_timer_init
+!
+!> \brief MPAS Timer init routine
+!> \author Doug Jacobsen
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes the mpas_timer setup. It needs to have access to the dminfo object in order to sync timers.
+!
+!-----------------------------------------------------------------------
subroutine mpas_timer_init(domain)!{{{
- type (domain_type), intent(in), optional :: domain
+ type (domain_type), intent(in), optional :: domain !< Input - Optional: Domain structure
if( present(domain) ) then
domain_info => domain % dminfo
@@ -323,6 +389,19 @@
end subroutine mpas_timer_init!}}}
+!***********************************************************************
+!
+! routine mpas_timer_sync
+!
+!> \brief MPAS Timer sync routine
+!> \author Doug Jacobsen
+!> \date 03/27/13
+!> \version SVN:$Id$
+!> \details
+!> This routine synchronizes timers across all processors in order to better represent
+!> the entire run domain with the timer output.
+!
+!-----------------------------------------------------------------------
subroutine mpas_timer_sync()!{{{
use mpas_dmpar
Deleted: branches/mpas_cdg_advection/src/framework/mpas_zoltan_interface.F
===================================================================
--- branches/mpas_cdg_advection/src/framework/mpas_zoltan_interface.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/mpas_zoltan_interface.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,581 +0,0 @@
-module mpas_zoltan_interface
- use zoltan
-
- implicit none
-
- include 'mpif.h'
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Data for reordering cells
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- integer :: numCells
- integer, dimension(:), pointer :: cellIDs
- integer :: geomDim
- real (kind=RKIND), dimension(:), pointer :: cellCoordX, cellCoordY, cellCoordZ
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Data for reordering edges
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- integer :: numEdges
- integer, dimension(:), pointer :: edgeIDs
- real (kind=RKIND), dimension(:), pointer :: edgeCoordX, edgeCoordY, edgeCoordZ
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Data for reordering vertices
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- integer :: numVerts
- integer, dimension(:), pointer :: vertIDs
- real (kind=RKIND), dimension(:), pointer :: vertCoordX, vertCoordY, vertCoordZ
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
- contains
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Perhaps not necessary, but implemented in case it helps
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_zoltan_start()
-
- integer(Zoltan_INT) :: error
- real(Zoltan_FLOAT) :: version
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Body of subroutine
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- error = Zoltan_Initialize(version)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- end subroutine
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_zoltan_order_loc_hsfc_cells(in_numcells,in_cellIDs,in_geomDim,in_cellX, &
- in_cellY, in_cellZ)
- implicit none
-
- integer :: in_numcells
- integer, dimension(:), pointer :: in_cellIDs
- integer :: in_geomDim
- real (kind=RKIND), dimension(:), pointer :: in_cellX, in_cellY, in_cellZ
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! local variables
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- type(Zoltan_Struct), pointer :: zz_obj
- integer(ZOLTAN_INT) :: ierr
-
- integer :: numGidEntries, i
- integer(ZOLTAN_INT), allocatable :: global_ids(:), permIndices(:),permGIDs(:)
- real(kind=RKIND), allocatable :: permXs(:),permYs(:),permZs(:)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Body of subroutine
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- numCells = in_numcells
- cellIDs => in_cellIDs
- geomDim = in_geomDim
- cellCoordX => in_cellX
- cellCoordY => in_cellY
- cellCoordZ => in_cellZ
-
- nullify(zz_obj)
- zz_obj => Zoltan_Create(MPI_COMM_SELF)
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! General Zoltan Parameters
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ierr = Zoltan_Set_Param(zz_obj, "ORDER_METHOD", "LOCAL_HSFC")
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! register query functions
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_OBJ_FN_TYPE,zqfNumCells)
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_OBJ_LIST_FN_TYPE,zqfGetCells)
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_GEOM_FN_TYPE,zqfGeomDim)
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_GEOM_FN_TYPE, zqfGetCellGeom)
-
- numGidEntries=1
-
- allocate(global_ids(numCells))
- allocate(permIndices(numCells))
- allocate(permGIDs(numCells))
- allocate(permXs(numCells))
- allocate(permYs(numCells))
- allocate(permZs(numCells))
-
- !! MMW: There might be a way to use cellIDs directly
- do i=1,numCells
- global_ids(i) = cellIDs(i)
- end do
-
- ierr = Zoltan_Order(zz_obj, numGidEntries, numCells, global_ids, permIndices);
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- !! This is necessary for now until we fix a small bug in Zoltan_Order
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- do i=1,numCells
- permGIDs(i) = global_ids(permIndices(i)+1)
- permXs(i) = cellCoordX(permIndices(i)+1)
- permYs(i) = cellCoordY(permIndices(i)+1)
- permZs(i) = cellCoordZ(permIndices(i)+1)
- end do
-
- !!do i=1,numCells
- !! write(*,*) global_ids(i), permGIDs(i)
- !!end do
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Actually change the ordering of the cells
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- do i=1,numCells
- cellIDs(i) = permGIDs(i)
- cellCoordX(i) = permXs(i)
- cellCoordY(i) = permYs(i)
- cellCoordZ(i) = permZs(i)
- end do
- !!!!!!!!!!!!!!!!!!!!!!!!!!
-
- deallocate(global_ids)
- deallocate(permIndices)
- deallocate(permGIDs)
- deallocate(permXs)
- deallocate(permYs)
- deallocate(permZs)
-
- call Zoltan_Destroy(zz_obj)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- end subroutine mpas_zoltan_order_loc_hsfc_cells
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! zoltan query function:
- !! Returns number of cells
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- integer function zqfNumCells(data, ierr)
-
- ! Local declarations
- integer(ZOLTAN_INT), intent(in) :: data(*)
- integer(ZOLTAN_INT), intent(out) :: ierr
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- zqfNumCells = numCells
- ierr = ZOLTAN_OK
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end function zqfNumCells
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! zoltan query function:
- !! Returns lists of Cell IDs
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_zqf_get_cells (data, num_gid_entries, num_lid_entries, global_ids, &
- local_ids, wgt_dim, obj_wgts, ierr)
- integer(ZOLTAN_INT), intent(in) :: data(*)
- integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
- integer(ZOLTAN_INT), intent(out) :: global_ids(*), local_ids(*)
- integer(ZOLTAN_INT), intent(in) :: wgt_dim
- real(ZOLTAN_FLOAT), intent(out) :: obj_wgts(*)
- integer(ZOLTAN_INT), intent(out) :: ierr
-
- ! local declarations
- integer :: i
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- do i= 1, numCells
- global_ids(i) = cellIDs(i)
- local_ids(i) = i
- end do
-
- ierr = ZOLTAN_OK
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end subroutine mpas_zqf_get_cells
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Zoltan Query Function:
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- integer function zqfGeomDim(data, ierr)
- !use zoltan
- implicit none
- integer(ZOLTAN_INT), intent(in) :: data(*)
- integer(ZOLTAN_INT) :: ierr
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- zqfGeomDim = geomDim
- ierr = ZOLTAN_OK
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end function zqfGeomDim
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Zoltan Query Function:
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_zqf_get_cell_geom(data, num_gid_entries, num_lid_entries, global_id, &
- local_id, geom_vec, ierr)
- !use zoltan
- implicit none
-
- integer(ZOLTAN_INT), intent(in) :: data(*)
- integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
- integer(ZOLTAN_INT), intent(in) :: global_id, local_id
- real(ZOLTAN_DOUBLE), intent(out) :: geom_vec(*)
- integer(ZOLTAN_INT), intent(out) :: ierr
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Assuming geom_dim is 3
- geom_vec(1) = cellCoordX(local_id)
- geom_vec(2) = cellCoordY(local_id)
- geom_vec(3) = cellCoordZ(local_id)
-
- ierr = ZOLTAN_OK
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end subroutine mpas_zqf_get_cell_geom
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! The ordering functions should perhaps be refactored so that there
- !! are not separate functions for cells, edges, and vertices
- !! Not sure if this is worth it with the additional conditionals that would
- !! be required.
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_zoltan_order_loc_hsfc_edges(in_numedges,in_edgeIDs,in_geomDim,in_edgeX, &
- in_edgeY, in_edgeZ)
- implicit none
-
- integer :: in_numedges
- integer, dimension(:), pointer :: in_edgeIDs
- integer :: in_geomDim
- real (kind=RKIND), dimension(:), pointer :: in_edgeX, in_edgeY, in_edgeZ
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! local variables
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- type(Zoltan_Struct), pointer :: zz_obj
- integer(ZOLTAN_INT) :: ierr
-
- integer :: numGidEntries, i
- integer(ZOLTAN_INT), allocatable :: global_ids(:), permIndices(:),permGIDs(:)
- real(kind=RKIND), allocatable :: permXs(:),permYs(:),permZs(:)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Body of subroutine
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- numEdges = in_numedges
- edgeIDs => in_edgeIDs
- geomDim = in_geomDim
- edgeCoordX => in_edgeX
- edgeCoordY => in_edgeY
- edgeCoordZ => in_edgeZ
-
- nullify(zz_obj)
- zz_obj => Zoltan_Create(MPI_COMM_SELF)
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! General Zoltan Parameters
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ierr = Zoltan_Set_Param(zz_obj, "ORDER_METHOD", "LOCAL_HSFC")
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! register query functions
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_OBJ_FN_TYPE,zqfNumEdges)
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_OBJ_LIST_FN_TYPE,zqfGetEdges)
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_GEOM_FN_TYPE,zqfGeomDim)
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_GEOM_FN_TYPE, zqfGetEdgeGeom)
-
- numGidEntries=1
-
- allocate(global_ids(numEdges))
- allocate(permIndices(numEdges))
- allocate(permGIDs(numEdges))
- allocate(permXs(numEdges))
- allocate(permYs(numEdges))
- allocate(permZs(numEdges))
-
- !! MMW: There might be a way to use edgeIDs directly
- do i=1,numEdges
- global_ids(i) = edgeIDs(i)
- end do
-
- ierr = Zoltan_Order(zz_obj, numGidEntries, numEdges, global_ids, permIndices);
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- !! This is necessary for now until we fix a small bug in Zoltan_Order
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- do i=1,numEdges
- permGIDs(i) = global_ids(permIndices(i)+1)
- permXs(i) = edgeCoordX(permIndices(i)+1)
- permYs(i) = edgeCoordY(permIndices(i)+1)
- permZs(i) = edgeCoordZ(permIndices(i)+1)
- end do
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Actually change the ordering of the edges
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- do i=1,numEdges
- edgeIDs(i) = permGIDs(i)
- edgeCoordX(i) = permXs(i)
- edgeCoordY(i) = permYs(i)
- edgeCoordZ(i) = permZs(i)
- end do
- !!!!!!!!!!!!!!!!!!!!!!!!!!
-
- deallocate(global_ids)
- deallocate(permIndices)
- deallocate(permGIDs)
- deallocate(permXs)
- deallocate(permYs)
- deallocate(permZs)
-
- call Zoltan_Destroy(zz_obj)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end subroutine mpas_zoltan_order_loc_hsfc_edges
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! zoltan query function:
- !! Returns number of edges
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- integer function zqfNumEdges(data, ierr)
- ! Local declarations
- integer(ZOLTAN_INT), intent(in) :: data(*)
- integer(ZOLTAN_INT), intent(out) :: ierr
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- zqfNumEdges = numEdges
- ierr = ZOLTAN_OK
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end function zqfNumEdges
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! zoltan query function:
- !! Returns lists of Edge IDs
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_zqf_get_edges (data, num_gid_entries, num_lid_entries, global_ids, &
- local_ids, wgt_dim, obj_wgts, ierr)
- integer(ZOLTAN_INT), intent(in) :: data(*)
- integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
- integer(ZOLTAN_INT), intent(out) :: global_ids(*), local_ids(*)
- integer(ZOLTAN_INT), intent(in) :: wgt_dim
- real(ZOLTAN_FLOAT), intent(out) :: obj_wgts(*)
- integer(ZOLTAN_INT), intent(out) :: ierr
-
- ! local declarations
- integer :: i
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- do i= 1, numEdges
- global_ids(i) = edgeIDs(i)
- local_ids(i) = i
- end do
-
- ierr = ZOLTAN_OK
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end subroutine mpas_zqf_get_edges
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Zoltan Query Function:
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_zqf_get_edge_geom(data, num_gid_entries, num_lid_entries, global_id, &
- local_id, geom_vec, ierr)
- !use zoltan
- implicit none
-
- integer(ZOLTAN_INT), intent(in) :: data(*)
- integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
- integer(ZOLTAN_INT), intent(in) :: global_id, local_id
- real(ZOLTAN_DOUBLE), intent(out) :: geom_vec(*)
- integer(ZOLTAN_INT), intent(out) :: ierr
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Assuming geom_dim is 3
- geom_vec(1) = edgeCoordX(local_id)
- geom_vec(2) = edgeCoordY(local_id)
- geom_vec(3) = edgeCoordZ(local_id)
-
- ierr = ZOLTAN_OK
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end subroutine mpas_zqf_get_edge_geom
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_zoltan_order_loc_hsfc_verts(in_numverts,in_vertIDs,in_geomDim,in_vertX, &
- in_vertY, in_vertZ)
- implicit none
-
- integer :: in_numverts
- integer, dimension(:), pointer :: in_vertIDs
- integer :: in_geomDim
- real (kind=RKIND), dimension(:), pointer :: in_vertX, in_vertY, in_vertZ
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! local variables
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- type(Zoltan_Struct), pointer :: zz_obj
- integer(ZOLTAN_INT) :: ierr
-
- integer :: numGidEntries, i
- integer(ZOLTAN_INT), allocatable :: global_ids(:), permIndices(:),permGIDs(:)
- real(kind=RKIND), allocatable :: permXs(:),permYs(:),permZs(:)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Body of subroutine
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- numVerts = in_numverts
- vertIDs => in_vertIDs
- geomDim = in_geomDim
- vertCoordX => in_vertX
- vertCoordY => in_vertY
- vertCoordZ => in_vertZ
-
- nullify(zz_obj)
- zz_obj => Zoltan_Create(MPI_COMM_SELF)
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! General Zoltan Parameters
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ierr = Zoltan_Set_Param(zz_obj, "ORDER_METHOD", "LOCAL_HSFC")
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! register query functions
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_OBJ_FN_TYPE,zqfNumVerts)
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_OBJ_LIST_FN_TYPE,zqfGetVerts)
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_GEOM_FN_TYPE,zqfGeomDim)
- ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_GEOM_FN_TYPE, zqfGetVertGeom)
-
- numGidEntries=1
-
- allocate(global_ids(numVerts))
- allocate(permIndices(numVerts))
- allocate(permGIDs(numVerts))
- allocate(permXs(numVerts))
- allocate(permYs(numVerts))
- allocate(permZs(numVerts))
-
- !! MMW: There might be a way to use vertIDs directly
- do i=1,numVerts
- global_ids(i) = vertIDs(i)
- end do
-
- ierr = Zoltan_Order(zz_obj, numGidEntries, numVerts, global_ids, permIndices);
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- !! This is necessary for now until we fix a small bug in Zoltan_Order
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- do i=1,numVerts
- permGIDs(i) = global_ids(permIndices(i)+1)
- permXs(i) = vertCoordX(permIndices(i)+1)
- permYs(i) = vertCoordY(permIndices(i)+1)
- permZs(i) = vertCoordZ(permIndices(i)+1)
- end do
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Actually change the ordering of the verts
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- do i=1,numVerts
- vertIDs(i) = permGIDs(i)
- vertCoordX(i) = permXs(i)
- vertCoordY(i) = permYs(i)
- vertCoordZ(i) = permZs(i)
- end do
- !!!!!!!!!!!!!!!!!!!!!!!!!!
-
- deallocate(global_ids)
- deallocate(permIndices)
- deallocate(permGIDs)
- deallocate(permXs)
- deallocate(permYs)
- deallocate(permZs)
-
- call Zoltan_Destroy(zz_obj)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- end subroutine mpas_zoltan_order_loc_hsfc_verts
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! zoltan query function:
- !! Returns number of verts
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- integer function zqfNumVerts(data, ierr)
-
- ! Local declarations
- integer(ZOLTAN_INT), intent(in) :: data(*)
- integer(ZOLTAN_INT), intent(out) :: ierr
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- zqfNumVerts = numVerts
- ierr = ZOLTAN_OK
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end function zqfNumVerts
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! zoltan query function:
- !! Returns lists of Vert IDs
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_zqf_get_verts (data, num_gid_entries, num_lid_entries, global_ids, &
- local_ids, wgt_dim, obj_wgts, ierr)
-
- integer(ZOLTAN_INT), intent(in) :: data(*)
- integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
- integer(ZOLTAN_INT), intent(out) :: global_ids(*), local_ids(*)
- integer(ZOLTAN_INT), intent(in) :: wgt_dim
- real(ZOLTAN_FLOAT), intent(out) :: obj_wgts(*)
- integer(ZOLTAN_INT), intent(out) :: ierr
-
- ! local declarations
- integer :: i
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- do i= 1, numVerts
- global_ids(i) = vertIDs(i)
- local_ids(i) = i
- end do
-
- ierr = ZOLTAN_OK
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end subroutine mpas_zqf_get_verts
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Zoltan Query Function:
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_zqf_get_vert_geom(data, num_gid_entries, num_lid_entries, global_id, &
- local_id, geom_vec, ierr)
- !use zoltan
- implicit none
-
- integer(ZOLTAN_INT), intent(in) :: data(*)
- integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
- integer(ZOLTAN_INT), intent(in) :: global_id, local_id
- real(ZOLTAN_DOUBLE), intent(out) :: geom_vec(*)
- integer(ZOLTAN_INT), intent(out) :: ierr
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !! Assuming geom_dim is 3
- geom_vec(1) = vertCoordX(local_id)
- geom_vec(2) = vertCoordY(local_id)
- geom_vec(3) = vertCoordZ(local_id)
-
- ierr = ZOLTAN_OK
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end subroutine mpas_zqf_get_vert_geom
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-
-
-end module mpas_zoltan_interface
Modified: branches/mpas_cdg_advection/src/framework/streams.c
===================================================================
--- branches/mpas_cdg_advection/src/framework/streams.c 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/framework/streams.c 2013-04-22 01:31:32 UTC (rev 2783)
@@ -34,14 +34,14 @@
return;
}
} else {
- sprintf(fname, "/dev/null", *id);
+ sprintf(fname, "/dev/null");
fd_err = open(fname,O_CREAT|O_WRONLY|O_TRUNC,0644);
if (dup2(fd_err, 2) < 0) {
printf("Error duplicating STDERR</font>
<font color="red">");
return;
}
- sprintf(fname, "/dev/null", *id);
+ sprintf(fname, "/dev/null");
fd_out = open(fname,O_CREAT|O_WRONLY|O_TRUNC,0644);
if (dup2(fd_out, 1) < 0) {
printf("Error duplicating STDOUT</font>
<font color="gray">");
Modified: branches/mpas_cdg_advection/src/operators/mpas_rbf_interpolation.F
===================================================================
--- branches/mpas_cdg_advection/src/operators/mpas_rbf_interpolation.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/operators/mpas_rbf_interpolation.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,16 @@
+!***********************************************************************
+!
+! mpas_rbf_interpolation
+!
+!> \brief MPAS Radial basis function interpolation module
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This module provides routines for performing interpolation with radial basis functions.
+!> It performs interpolation of scalar and vector functions in 2 and 3 dimensions.
+!
+!-----------------------------------------------------------------------
module mpas_rbf_interpolation
use mpas_dmpar
use mpas_grid_types
@@ -6,11 +19,6 @@
private
save
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Purpose: perform interpolation of scalar and vector functions in 2D
-! and 3D using Radial Basis Functions (RBFs).
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
! Initialize the geometry that will be useful from interpolation
public :: mpas_rbf_interp_initialize
@@ -93,26 +101,32 @@
contains
- subroutine mpas_rbf_interp_initialize(grid)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: compute geometric fields that will be potentially useful for calling
- ! the interpolation routines
- !
- ! Input: the grid
- !
- ! Output:
- ! edgeNormalVectors - the unit vector at the center of each edge tangent to the sphere
- ! cellTangentPlane - 2 orthogonal unit vectors in the tangent plane of each cell
- ! The first unit vector is chosen to point toward the center of the first
- ! edge on the cell.
- ! localVerticalUnitVectors - the unit normal vector of the tangent plane at the center
- ! of each cell
- !
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!***********************************************************************
+!
+! routine mpas_rbf_interp_initialize
+!
+!> \brief MPAS RBF interpolation initialization routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes geometric fields that will be potentially useful for calling
+!> the interpolation routines.
+!> Input: the grid
+!> Output:
+!> edgeNormalVectors - the unit vector at the center of each edge tangent to the sphere
+!> cellTangentPlane - 2 orthogonal unit vectors in the tangent plane of each cell
+!> The first unit vector is chosen to point toward the center of the first
+!> edge on the cell.
+!> localVerticalUnitVectors - the unit normal vector of the tangent plane at the center
+!> of each cell
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_initialize(grid)!{{{
+
implicit none
- type (mesh_type), intent(inout) :: grid
+ type (mesh_type), intent(inout) :: grid !< Input/Output: Grid information
integer :: nCells, nEdges
integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
@@ -185,34 +199,41 @@
cellTangentPlane(:,2,iCell) = yHatPlane
end do
- end subroutine mpas_rbf_interp_initialize
+ end subroutine mpas_rbf_interp_initialize!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in 2D that can be used to
- ! reconstruct a given scalar function at varying locations. This is useful
- ! for finding the location on the the RBF reconstruction of a function
- ! (e.g., a height field) that minimizes the distance to a point in 3D space.
- ! The reconstruction is performed with basis functions that are RBFs and constant
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! coeffCount - the size of coefficients, must be at least pointCount + 1
- ! points - the location of the "source" points in the 2D space where the values of
- ! the function are known
- ! fieldValues - the values of the function of interest at the points
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! Output:
- ! coefficients - the coefficients needed to perform interpolation of the funciton
- ! at destination points yet to be specified
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_loc_2D_sca_const_comp_coeffs(pointCount, coeffCount, &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_loc_2D_sca_const_comp_coeffs
+!
+!> \brief MPAS 2D scalar constant interpolation coefficient routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in 2D that can be used to reconstruct a given scalar function at varying locations.
+!> This is useful for finding the location on the RBF reconstruction of a function (e.g. a heigh field) that minimizes the distantce
+!> to a point in 3D space. The reconstruction is performed with basis functions that are RBFs and constant.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> coeffCount - the size of coefficients, must be at least pointCount + 1
+!> points - the location of the "source" points in the 2D space where the values of
+!> the function are known
+!> fieldValues - the values of the function of interest at the points
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> Output:
+!> coefficients - the coefficients needed to perform interpolation of the funciton
+!> at destination points yet to be specified
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_loc_2D_sca_const_comp_coeffs(pointCount, coeffCount, &!{{{
points, fieldValues, alpha, coefficients)
- integer, intent(in) :: pointCount, coeffCount
- real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
- real(kind=RKIND), dimension(pointCount), intent(in) :: fieldValues
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(coeffCount), intent(out) :: coefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ integer, intent(in) :: coeffCount !< Input: Number of coefficients
+ real(kind=RKIND), dimension(pointCount,2), intent(in) :: points !< Input: List of points
+ real(kind=RKIND), dimension(pointCount), intent(in) :: fieldValues !< Input: Value at points
+ real(kind=RKIND), intent(in) :: alpha !< Input: Charachteristic length scale of RBFs
+ real(kind=RKIND), dimension(coeffCount), intent(out) :: coefficients !< Output: List of coefficients
integer :: i, j, matrixSize
real(kind=RKIND), dimension(pointCount+1,pointCount+1) :: matrix
@@ -242,35 +263,44 @@
call mpas_legs(matrix(1:matrixSize,1:matrixSize), matrixSize, rhs(1:matrixSize), &
coefficients(1:matrixSize), pivotIndices(1:matrixSize))
- end subroutine mpas_rbf_interp_loc_2D_sca_const_comp_coeffs
+ end subroutine mpas_rbf_interp_loc_2D_sca_const_comp_coeffs!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in 2D that can be used to
- ! reconstruct a given scalar function at varying locations. This is useful
- ! for finding the location on the the RBF reconstruction of a function
- ! (e.g., a height field) that minimizes the distance to a point in 3D space.
- ! The reconstruction is performed with basis functions that are RBFs plus constant
- ! and linear
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! coeffCount - the size of coefficients, must be at least pointCount + 3
- ! points - the location of the "source" points in the 2D space where the values of
- ! the function are known
- ! fieldValues - the values of the function of interest at the points
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! Output:
- ! coefficients - the coefficients needed to perform interpolation of the funciton
- ! at destination points yet to be specified
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_loc_2D_sca_lin_comp_coeffs(pointCount, coeffCount, &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_loc_2D_sca_lin_comp_coeffs
+!
+!> \brief MPAS 2D scalar linear interpolation coefficient routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in 2D that can be used to
+!> reconstruct a given scalar function at varying locations. This is useful
+!> for finding the location on the the RBF reconstruction of a function
+!> (e.g., a height field) that minimizes the distance to a point in 3D space.
+!> The reconstruction is performed with basis functions that are RBFs plus constant
+!> and linear
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> coeffCount - the size of coefficients, must be at least pointCount + 3
+!> points - the location of the "source" points in the 2D space where the values of
+!> the function are known
+!> fieldValues - the values of the function of interest at the points
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> Output:
+!> coefficients - the coefficients needed to perform interpolation of the funciton
+!> at destination points yet to be specified
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_loc_2D_sca_lin_comp_coeffs(pointCount, coeffCount, &!{{{
points, fieldValues, alpha, coefficients)
- integer, intent(in) :: pointCount, coeffCount
- real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
- real(kind=RKIND), dimension(pointCount), intent(in) :: fieldValues
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(coeffCount), intent(out) :: coefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ integer, intent(in) :: coeffCount !< Input: Number of coefficients
+ real(kind=RKIND), dimension(pointCount,2), intent(in) :: points !< Input: List of points
+ real(kind=RKIND), dimension(pointCount), intent(in) :: fieldValues !< Input: List of values at points
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale for RBFs
+ real(kind=RKIND), dimension(coeffCount), intent(out) :: coefficients !< Output: List of coefficients
integer :: i, j, matrixSize
real(kind=RKIND), dimension(pointCount+3,pointCount+3) :: matrix
@@ -301,43 +331,53 @@
call mpas_legs(matrix(1:matrixSize,1:matrixSize), matrixSize, rhs(1:matrixSize), &
coefficients(1:matrixSize), pivotIndices(1:matrixSize))
- end subroutine mpas_rbf_interp_loc_2D_sca_lin_comp_coeffs
+ end subroutine mpas_rbf_interp_loc_2D_sca_lin_comp_coeffs!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Evalute a scalar function in 2D using coefficients computed in
- ! rbfInterp_loc_2D_sca_const_compCoeffs. This
- ! function can be called repeatedly with different destination points
- ! to quickly evaluate the interpolating function using the same
- ! coefficients. This is useful for finding the location on the the
- ! RBF reconstruction of a function (e.g., a height field) that minimizes
- ! the distance to a point in 3D space. The reconstruction is performed
- ! with basis functions that are RBFs and constant
- ! Input:
- ! fieldCount - the number fields to be evaluated. This is useful for reconstructing,
- ! for example, the x-, y- and z-components of a vector field at the same
- ! point in 2D
- ! coeffCount - the size of coefficients, must be at least pointCount + 1
- ! pointCount - the number of "source" points and functionValues supplied
- ! coefficients - the coefficients needed to perform interpolation of the funciton
- ! at the evaluationPoint
- ! evaluationPoint - the point in 2D where the function is to be reconstructed
- ! points - the location of the "source" points in the 2D space where the values of
- ! the function are known
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! Output:
- ! derivs - the value of the function, the 2 components of its Jacobian and
- ! the 3 unique components of its Hessian at the evaluationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_loc_2D_sca_const_eval_with_derivs(fieldCount, coeffCount, &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_loc_2D_sca_const_eval_with_derivs
+!
+!> \brief MPAS 2D scalar constant evaulation routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine evalutes a scalar function in 2D using coefficients computed in
+!> rbfInterp_loc_2D_sca_const_compCoeffs. This
+!> function can be called repeatedly with different destination points
+!> to quickly evaluate the interpolating function using the same
+!> coefficients. This is useful for finding the location on the the
+!> RBF reconstruction of a function (e.g., a height field) that minimizes
+!> the distance to a point in 3D space. The reconstruction is performed
+!> with basis functions that are RBFs and constant
+!> Input:
+!> fieldCount - the number fields to be evaluated. This is useful for reconstructing,
+!> for example, the x-, y- and z-components of a vector field at the same
+!> point in 2D
+!> coeffCount - the size of coefficients, must be at least pointCount + 1
+!> pointCount - the number of "source" points and functionValues supplied
+!> coefficients - the coefficients needed to perform interpolation of the funciton
+!> at the evaluationPoint
+!> evaluationPoint - the point in 2D where the function is to be reconstructed
+!> points - the location of the "source" points in the 2D space where the values of
+!> the function are known
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> Output:
+!> derivs - the value of the function, the 2 components of its Jacobian and
+!> the 3 unique components of its Hessian at the evaluationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_loc_2D_sca_const_eval_with_derivs(fieldCount, coeffCount, &!{{{
pointCount, coefficients, evaluationPoint, points, alpha, derivs)
- integer, intent(in) :: fieldCount, coeffCount, pointCount
- real(kind=RKIND), dimension(coeffCount, fieldCount), intent(in) :: coefficients
- real(kind=RKIND), dimension(2), intent(in) :: evaluationPoint
- real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
- real(kind=RKIND), intent(in) :: alpha
+ integer, intent(in) :: fieldCount !< Input: Number of fields
+ integer, intent(in) :: coeffCount !< Input: Number of coefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(coeffCount, fieldCount), intent(in) :: coefficients !< Input: List of coefficients
+ real(kind=RKIND), dimension(2), intent(in) :: evaluationPoint !< Input: Location for evaluation
+ real(kind=RKIND), dimension(pointCount,2), intent(in) :: points !< Input: List of points
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale for RBFs
- real(kind=RKIND), dimension(6,fieldCount), intent(out) :: derivs
+ real(kind=RKIND), dimension(6,fieldCount), intent(out) :: derivs !< Output: List of derivatives
integer :: pointIndex
real(kind=RKIND) :: x, y, rSquared, rbfValue, rbfDerivOverR, rbfSecondDeriv
@@ -369,43 +409,53 @@
end if
end do
derivs(1,:) = derivs(1,:) + coefficients(pointCount+1,:)
- end subroutine mpas_rbf_interp_loc_2D_sca_const_eval_with_derivs
+ end subroutine mpas_rbf_interp_loc_2D_sca_const_eval_with_derivs!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Evalute a scalar function in 2D using coefficients computed in
- ! rbfInterp_loc_2D_sca_const_compCoeffs. This
- ! function can be called repeatedly with different destination points
- ! to quickly evaluate the interpolating function using the same
- ! coefficients. This is useful for finding the location on the the
- ! RBF reconstruction of a function (e.g., a height field) that minimizes
- ! the distance to a point in 3D space. The reconstruction is performed
- ! with basis functions that are RBFs, constant and linear
- ! Input:
- ! fieldCount - the number fields to be evaluated. This is useful for reconstructing,
- ! for example, the x-, y- and z-components of a vector field at the same
- ! point in 2D
- ! coeffCount - the size of coefficients, must be at least pointCount + 1
- ! pointCount - the number of "source" points and functionValues supplied
- ! coefficients - the coefficients needed to perform interpolation of the funciton
- ! at the evaluationPoint
- ! evaluationPoint - the point in 2D where the function is to be reconstructed
- ! points - the location of the "source" points in the 2D space where the values of
- ! the function are known
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! Output:
- ! derivs - the value of the function, the 2 components of its Jacobian and
- ! the 3 unique components of its Hessian at the evaluationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_loc_2D_sca_lin_eval_with_derivs(fieldCount, coeffCount, &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_loc_2D_sca_lin_eval_with_derivs
+!
+!> \brief MPAS 2D scalar linear evaluation routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine evalutes a scalar function in 2D using coefficients computed in
+!> rbfInterp_loc_2D_sca_const_compCoeffs. This
+!> function can be called repeatedly with different destination points
+!> to quickly evaluate the interpolating function using the same
+!> coefficients. This is useful for finding the location on the the
+!> RBF reconstruction of a function (e.g., a height field) that minimizes
+!> the distance to a point in 3D space. The reconstruction is performed
+!> with basis functions that are RBFs, constant and linear
+!> Input:
+!> fieldCount - the number fields to be evaluated. This is useful for reconstructing,
+!> for example, the x-, y- and z-components of a vector field at the same
+!> point in 2D
+!> coeffCount - the size of coefficients, must be at least pointCount + 1
+!> pointCount - the number of "source" points and functionValues supplied
+!> coefficients - the coefficients needed to perform interpolation of the funciton
+!> at the evaluationPoint
+!> evaluationPoint - the point in 2D where the function is to be reconstructed
+!> points - the location of the "source" points in the 2D space where the values of
+!> the function are known
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> Output:
+!> derivs - the value of the function, the 2 components of its Jacobian and
+!> the 3 unique components of its Hessian at the evaluationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_loc_2D_sca_lin_eval_with_derivs(fieldCount, coeffCount, &!{{{
pointCount, coefficients, evaluationPoint, points, alpha, derivs)
- integer, intent(in) :: fieldCount, coeffCount, pointCount
- real(kind=RKIND), dimension(coeffCount, fieldCount), intent(in) :: coefficients
- real(kind=RKIND), dimension(2), intent(in) :: evaluationPoint
- real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
- real(kind=RKIND), intent(in) :: alpha
+ integer, intent(in) :: fieldCount !< Input: Number of fields
+ integer, intent(in) :: coeffCount !< Input: Number of coefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(coeffCount, fieldCount), intent(in) :: coefficients !< Input: List of coefficients
+ real(kind=RKIND), dimension(2), intent(in) :: evaluationPoint !< Input: Point for evaluation
+ real(kind=RKIND), dimension(pointCount,2), intent(in) :: points !< Input: List of points
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
- real(kind=RKIND), dimension(6,fieldCount), intent(out) :: derivs
+ real(kind=RKIND), dimension(6,fieldCount), intent(out) :: derivs !< Output: Derivatives
integer :: pointIndex
real(kind=RKIND) :: x, y, rSquared, rbfValue, rbfDerivOverR, rbfSecondDeriv
@@ -442,39 +492,47 @@
derivs(2,:) = derivs(2,:) + coefficients(pointCount+2,:)
derivs(3,:) = derivs(3,:) + coefficients(pointCount+3,:)
- end subroutine mpas_rbf_interp_loc_2D_sca_lin_eval_with_derivs
+ end subroutine mpas_rbf_interp_loc_2D_sca_lin_eval_with_derivs!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in 3D that can be used to
- ! interpolate a number of scalar functions at a given locations. This is useful
- ! if the interpolation location does not change with time, or if several
- ! fields are to be interpolated at a given time step. (If both the fields
- ! and the interpolation locations vary with time, there is no clear advantage in
- ! using either this method or the method for 2D interpoaltion above; for simplicity
- ! and because we foresee more uses for the method of this subroutine, we have not
- ! implemented a 3D version of the fixed field, variable interpolation location method
- ! as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
- ! conditions (or no boundaries). The interpolation is performed with basis functions
- ! that are RBFs plus a constant.
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! sourcePoints - the location of the "source" points in the 3D space where the values of
- ! the function are known
- ! destinationPoint - the point where the interpolation will be performed
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! Output:
- ! coefficients - the coefficients used to interpolate a function with Dirichlet
- ! boundary conditions to the specified destinationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_func_3D_sca_const_dir_comp_coeffs( &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_func_3D_sca_const_dir_comp_coeffs
+!
+!> \brief MPAS 3D scalar constant coefficients routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in 3D that can be used to
+!> interpolate a number of scalar functions at a given locations. This is useful
+!> if the interpolation location does not change with time, or if several
+!> fields are to be interpolated at a given time step. (If both the fields
+!> and the interpolation locations vary with time, there is no clear advantage in
+!> using either this method or the method for 2D interpoaltion above; for simplicity
+!> and because we foresee more uses for the method of this subroutine, we have not
+!> implemented a 3D version of the fixed field, variable interpolation location method
+!> as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
+!> conditions (or no boundaries). The interpolation is performed with basis functions
+!> that are RBFs plus a constant.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> sourcePoints - the location of the "source" points in the 3D space where the values of
+!> the function are known
+!> destinationPoint - the point where the interpolation will be performed
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> Output:
+!> coefficients - the coefficients used to interpolate a function with Dirichlet
+!> boundary conditions to the specified destinationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_func_3D_sca_const_dir_comp_coeffs( &!{{{
pointCount, sourcePoints, destinationPoint, alpha, coefficients)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of source points
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: List of destination points
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
+ real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients !< Output: List of coefficients
integer :: i, j
integer :: matrixSize
@@ -513,46 +571,54 @@
deallocate(coeffs)
deallocate(pivotIndices)
- end subroutine mpas_rbf_interp_func_3D_sca_const_dir_comp_coeffs
+ end subroutine mpas_rbf_interp_func_3D_sca_const_dir_comp_coeffs!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in a plane in 3D that can be used to
- ! interpolate a number of scalar functions at a given locations. This is useful
- ! if the interpolation location does not change with time, or if several
- ! fields are to be interpolated at a given time step. (If both the fields
- ! and the interpolation locations vary with time, there is no clear advantage in
- ! using either this method or the method for 2D interpoaltion above; for simplicity
- ! and because we foresee more uses for the method of this subroutine, we have not
- ! implemented a 3D version of the fixed field, variable interpolation location method
- ! as we have in 2D.) Coefficients are produced for handling both Dirichlet (or no)
- ! boundary conditions. The interpolation is performed with basis functions that are
- ! RBFs plus constant and linear. All points are projected into the plane given by the
- ! planeBasisVectors.
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! sourcePoints - the location of the "source" points in the 3D space where the values of
- ! the function are known. The points will be projected into the plane given by
- ! planeBasisVectors
- ! destinationPoint - the point in 3D where the interpolation will be performed. The
- ! destinationPoint will be projected into the plane given by planeBasisVectors.
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! planeBasisVectors - the basis fectors for the plane where interpolation is performed.
- ! All points are projected into this plane.
- ! Output:
- ! coefficients - the coefficients used to interpolate a function with Dirichlet
- ! boundary conditions to the specified destinationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_comp_coeffs( &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_func_3D_plane_sca_lin_dir_comp_coeffs
+!
+!> \brief MPAS 3D planar scalar linear coefficients routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in a plane in 3D that can be used to
+!> interpolate a number of scalar functions at a given locations. This is useful
+!> if the interpolation location does not change with time, or if several
+!> fields are to be interpolated at a given time step. (If both the fields
+!> and the interpolation locations vary with time, there is no clear advantage in
+!> using either this method or the method for 2D interpoaltion above; for simplicity
+!> and because we foresee more uses for the method of this subroutine, we have not
+!> implemented a 3D version of the fixed field, variable interpolation location method
+!> as we have in 2D.) Coefficients are produced for handling both Dirichlet (or no)
+!> boundary conditions. The interpolation is performed with basis functions that are
+!> RBFs plus constant and linear. All points are projected into the plane given by the
+!> planeBasisVectors.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> sourcePoints - the location of the "source" points in the 3D space where the values of
+!> the function are known. The points will be projected into the plane given by
+!> planeBasisVectors
+!> destinationPoint - the point in 3D where the interpolation will be performed. The
+!> destinationPoint will be projected into the plane given by planeBasisVectors.
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> planeBasisVectors - the basis fectors for the plane where interpolation is performed.
+!> All points are projected into this plane.
+!> Output:
+!> coefficients - the coefficients used to interpolate a function with Dirichlet
+!> boundary conditions to the specified destinationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_comp_coeffs( &!{{{
pointCount, sourcePoints, destinationPoint, &
alpha, planeBasisVectors, coefficients)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(2,3) :: planeBasisVectors
- real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of source points
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
+ real(kind=RKIND), dimension(2,3) :: planeBasisVectors !< Input: Basis vectors for the interpolation plane
+ real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients !< Output: List of coefficients
integer :: i, j
integer :: matrixSize
@@ -596,39 +662,47 @@
deallocate(coeffs)
deallocate(pivotIndices)
- end subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_comp_coeffs
+ end subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_comp_coeffs!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in 3D that can be used to
- ! interpolate a number of scalar functions at a given locations. This is useful
- ! if the interpolation location does not change with time, or if several
- ! fields are to be interpolated at a given time step. (If both the fields
- ! and the interpolation locations vary with time, there is no clear advantage in
- ! using either this method or the method for 2D interpoaltion above; for simplicity
- ! and because we foresee more uses for the method of this subroutine, we have not
- ! implemented a 3D version of the fixed field, variable interpolation location method
- ! as we have in 2D.) Coefficients are produced for handling both Dirichlet (or no)
- ! boundary conditions. The interpolation is performed with basis functions that are
- ! RBFs plus constant and linear.
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! sourcePoints - the location of the "source" points in the 3D space where the values of
- ! the function are known
- ! destinationPoint - the point where the interpolation will be performed
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! Output:
- ! coefficients - the coefficients used to interpolate a function with Dirichlet
- ! boundary conditions to the specified destinationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_func_3D_sca_lin_dir_comp_coeffs(pointCount, &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_func_3D_sca_lin_dir_comp_coeffs
+!
+!> \brief MPAS 3D scalar linear coefficients routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in 3D that can be used to
+!> interpolate a number of scalar functions at a given locations. This is useful
+!> if the interpolation location does not change with time, or if several
+!> fields are to be interpolated at a given time step. (If both the fields
+!> and the interpolation locations vary with time, there is no clear advantage in
+!> using either this method or the method for 2D interpoaltion above; for simplicity
+!> and because we foresee more uses for the method of this subroutine, we have not
+!> implemented a 3D version of the fixed field, variable interpolation location method
+!> as we have in 2D.) Coefficients are produced for handling both Dirichlet (or no)
+!> boundary conditions. The interpolation is performed with basis functions that are
+!> RBFs plus constant and linear.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> sourcePoints - the location of the "source" points in the 3D space where the values of
+!> the function are known
+!> destinationPoint - the point where the interpolation will be performed
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> Output:
+!> coefficients - the coefficients used to interpolate a function with Dirichlet
+!> boundary conditions to the specified destinationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_func_3D_sca_lin_dir_comp_coeffs(pointCount, &!{{{
sourcePoints, destinationPoint, alpha, coefficients)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of source points
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale for RBFs
+ real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients !< Output: List of coefficients
integer :: i, j
integer :: matrixSize
@@ -670,52 +744,60 @@
deallocate(coeffs)
deallocate(pivotIndices)
- end subroutine mpas_rbf_interp_func_3D_sca_lin_dir_comp_coeffs
+ end subroutine mpas_rbf_interp_func_3D_sca_lin_dir_comp_coeffs!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in 3D that can be used to
- ! interpolate a number of scalar functions at a given locations. This is useful
- ! if the interpolation location does not change with time, or if several
- ! fields are to be interpolated at a given time step. (If both the fields
- ! and the interpolation locations vary with time, there is no clear advantage in
- ! using either this method or the method for 2D interpoaltion above; for simplicity
- ! and because we foresee more uses for the method of this subroutine, we have not
- ! implemented a 3D version of the fixed field, variable interpolation location method
- ! as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
- ! boundary conditions. The interpolation is performed with basis functions that are
- ! RBFs plus a constant.
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! sourcePoints - the location of the "source" points in the 3D space where the values of
- ! the function are known
- ! isInterface - a logical array indicating which of the source points (if any) are at
- ! at the domain interface. These points and their normals will be used to compute the
- ! neumannCoefficients below
- ! interfaceNormals - a 3D normal vector for each sourcePoint. These vectors are only used
- ! at points where isInterface == .true., and can take arbitrary values elsewehere. The
- ! normal vector is used to compute coefficients for the normal derivative of the
- ! interpolating function in order to impose the Neumann Boundary condition
- ! destinationPoint - the point where the interpolation will be performed
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! Output:
- ! dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
- ! boundary conditions to the specified destinationPoint
- ! neumannCoefficients - the coefficients used to interpolate a function with Neumann
- ! boundary conditions to the specified destinationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_func_3D_sca_const_dir_neu_comp_coeffs( &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_func_3D_sca_const_dir_neu_comp_coeffs
+!
+!> \brief MPAS 3D scalar constant Dirichlet and Neumann coefficients routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in 3D that can be used to
+!> interpolate a number of scalar functions at a given locations. This is useful
+!> if the interpolation location does not change with time, or if several
+!> fields are to be interpolated at a given time step. (If both the fields
+!> and the interpolation locations vary with time, there is no clear advantage in
+!> using either this method or the method for 2D interpoaltion above; for simplicity
+!> and because we foresee more uses for the method of this subroutine, we have not
+!> implemented a 3D version of the fixed field, variable interpolation location method
+!> as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
+!> boundary conditions. The interpolation is performed with basis functions that are
+!> RBFs plus a constant.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> sourcePoints - the location of the "source" points in the 3D space where the values of
+!> the function are known
+!> isInterface - a logical array indicating which of the source points (if any) are at
+!> at the domain interface. These points and their normals will be used to compute the
+!> neumannCoefficients below
+!> interfaceNormals - a 3D normal vector for each sourcePoint. These vectors are only used
+!> at points where isInterface == .true., and can take arbitrary values elsewehere. The
+!> normal vector is used to compute coefficients for the normal derivative of the
+!> interpolating function in order to impose the Neumann Boundary condition
+!> destinationPoint - the point where the interpolation will be performed
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> Output:
+!> dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
+!> boundary conditions to the specified destinationPoint
+!> neumannCoefficients - the coefficients used to interpolate a function with Neumann
+!> boundary conditions to the specified destinationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_func_3D_sca_const_dir_neu_comp_coeffs( &!{{{
pointCount, sourcePoints, isInterface, interfaceNormals, destinationPoint, &
alpha, dirichletCoefficients, neumannCoefficients)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- logical, dimension(pointCount), intent(in) :: isInterface
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(pointCount), intent(out) :: &
- dirichletCoefficients, neumannCoefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of source points
+ logical, dimension(pointCount), intent(in) :: isInterface !< Input: Logicals determining if a source point is at an interface
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals !< Input: Normal vector at interface for each source point
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
+ real(kind=RKIND), dimension(pointCount), intent(out) :: dirichletCoefficients !< Output: Coefficients with Dirichlet BCs
+ real(kind=RKIND), dimension(pointCount), intent(out) :: neumannCoefficients !< Output: Coefficients with Neumann BCs
integer :: i, j
integer :: matrixSize
@@ -772,58 +854,66 @@
deallocate(coeffs)
deallocate(pivotIndices)
- end subroutine mpas_rbf_interp_func_3D_sca_const_dir_neu_comp_coeffs
+ end subroutine mpas_rbf_interp_func_3D_sca_const_dir_neu_comp_coeffs!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in a plane in 3D that can be used to
- ! interpolate a number of scalar functions at a given locations. This is useful
- ! if the interpolation location does not change with time, or if several
- ! fields are to be interpolated at a given time step. (If both the fields
- ! and the interpolation locations vary with time, there is no clear advantage in
- ! using either this method or the method for 2D interpoaltion above; for simplicity
- ! and because we foresee more uses for the method of this subroutine, we have not
- ! implemented a 3D version of the fixed field, variable interpolation location method
- ! as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
- ! boundary conditions. The interpolation is performed with basis functions that are
- ! RBFs plus constant and linear. All points are projected into the plane given by the
- ! planeBasisVectors.
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! sourcePoints - the location of the "source" points in the 3D space where the values of
- ! the function are known. The sourcePoints will be projected into the plane given by
- ! planeBasisVectors
- ! isInterface - a logical array indicating which of the source points (if any) are at
- ! at the domain interface. These points and their normals will be used to compute the
- ! neumannCoefficients below
- ! interfaceNormals - a 3D normal vector for each sourcePoint. These vectors are only used
- ! at points where isInterface == .true., and can take arbitrary values elsewehere. The
- ! normal vector is used to compute coefficients for the normal derivative of the
- ! interpolating function in order to impose the Neumann Boundary condition
- ! destinationPoint - the point in 3D where the interpolation will be performed. The
- ! destinationPoint will be projected into the plane given by planeBasisVectors.
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! planeBasisVectors - the basis fectors for the plane where interpolation is performed.
- ! All points are projected into this plane.
- ! Output:
- ! dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
- ! boundary conditions to the specified destinationPoint
- ! neumannCoefficients - the coefficients used to interpolate a function with Neumann
- ! boundary conditions to the specified destinationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_neu_comp_coeffs( &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_func_3D_plane_sca_lin_dir_neu_comp_coeffs
+!
+!> \brief MPAS 3D scalar planar linear Dirichlet and Neumann coefficients routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in a plane in 3D that can be used to
+!> interpolate a number of scalar functions at a given locations. This is useful
+!> if the interpolation location does not change with time, or if several
+!> fields are to be interpolated at a given time step. (If both the fields
+!> and the interpolation locations vary with time, there is no clear advantage in
+!> using either this method or the method for 2D interpoaltion above; for simplicity
+!> and because we foresee more uses for the method of this subroutine, we have not
+!> implemented a 3D version of the fixed field, variable interpolation location method
+!> as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
+!> boundary conditions. The interpolation is performed with basis functions that are
+!> RBFs plus constant and linear. All points are projected into the plane given by the
+!> planeBasisVectors.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> sourcePoints - the location of the "source" points in the 3D space where the values of
+!> the function are known. The sourcePoints will be projected into the plane given by
+!> planeBasisVectors
+!> isInterface - a logical array indicating which of the source points (if any) are at
+!> at the domain interface. These points and their normals will be used to compute the
+!> neumannCoefficients below
+!> interfaceNormals - a 3D normal vector for each sourcePoint. These vectors are only used
+!> at points where isInterface == .true., and can take arbitrary values elsewehere. The
+!> normal vector is used to compute coefficients for the normal derivative of the
+!> interpolating function in order to impose the Neumann Boundary condition
+!> destinationPoint - the point in 3D where the interpolation will be performed. The
+!> destinationPoint will be projected into the plane given by planeBasisVectors.
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> planeBasisVectors - the basis fectors for the plane where interpolation is performed.
+!> All points are projected into this plane.
+!> Output:
+!> dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
+!> boundary conditions to the specified destinationPoint
+!> neumannCoefficients - the coefficients used to interpolate a function with Neumann
+!> boundary conditions to the specified destinationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_neu_comp_coeffs( &!{{{
pointCount, sourcePoints, isInterface, interfaceNormals, destinationPoint, &
alpha, planeBasisVectors, dirichletCoefficients, neumannCoefficients)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- logical, dimension(pointCount), intent(in) :: isInterface
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(2,3) :: planeBasisVectors
- real(kind=RKIND), dimension(pointCount), intent(out) :: &
- dirichletCoefficients, neumannCoefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of points
+ logical, dimension(pointCount), intent(in) :: isInterface !< Input: List of logicals determining if point is at an interface
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals !< Input: List of interface normals
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
+ real(kind=RKIND), dimension(2,3) :: planeBasisVectors !< Input: Basis vectors for interpolation plane
+ real(kind=RKIND), dimension(pointCount), intent(out) :: dirichletCoefficients !< Output: List of Dirichlet coefficients
+ real(kind=RKIND), dimension(pointCount), intent(out) :: neumannCoefficients !< Output: List of Neumann coefficients
integer :: i, j
integer :: matrixSize
@@ -889,52 +979,60 @@
deallocate(coeffs)
deallocate(pivotIndices)
- end subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_neu_comp_coeffs
+ end subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_neu_comp_coeffs!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in 3D that can be used to
- ! interpolate a number of scalar functions at a given locations. This is useful
- ! if the interpolation location does not change with time, or if several
- ! fields are to be interpolated at a given time step. (If both the fields
- ! and the interpolation locations vary with time, there is no clear advantage in
- ! using either this method or the method for 2D interpoaltion above; for simplicity
- ! and because we foresee more uses for the method of this subroutine, we have not
- ! implemented a 3D version of the fixed field, variable interpolation location method
- ! as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
- ! boundary conditions. The interpolation is performed with basis functions that are
- ! RBFs plus constant and linear.
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! sourcePoints - the location of the "source" points in the 3D space where the values of
- ! the function are known
- ! isInterface - a logical array indicating which of the source points (if any) are at
- ! at the domain interface. These points and their normals will be used to compute the
- ! neumannCoefficients below
- ! interfaceNormals - a 3D normal vector for each sourcePoint. These vectors are only used
- ! at points where isInterface == .true., and can take arbitrary values elsewehere. The
- ! normal vector is used to compute coefficients for the normal derivative of the
- ! interpolating function in order to impose the Neumann Boundary condition
- ! destinationPoint - the point where the interpolation will be performed
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! Output:
- ! dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
- ! boundary conditions to the specified destinationPoint
- ! neumannCoefficients - the coefficients used to interpolate a function with Neumann
- ! boundary conditions to the specified destinationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_func_3D_sca_lin_dir_neu_comp_coeffs(pointCount, &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_func_3D_sca_lin_dir_neu_comp_coeffs
+!
+!> \brief MPAS 3D scalar linear Dirichlet and Neumann coefficients routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in 3D that can be used to
+!> interpolate a number of scalar functions at a given locations. This is useful
+!> if the interpolation location does not change with time, or if several
+!> fields are to be interpolated at a given time step. (If both the fields
+!> and the interpolation locations vary with time, there is no clear advantage in
+!> using either this method or the method for 2D interpoaltion above; for simplicity
+!> and because we foresee more uses for the method of this subroutine, we have not
+!> implemented a 3D version of the fixed field, variable interpolation location method
+!> as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
+!> boundary conditions. The interpolation is performed with basis functions that are
+!> RBFs plus constant and linear.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> sourcePoints - the location of the "source" points in the 3D space where the values of
+!> the function are known
+!> isInterface - a logical array indicating which of the source points (if any) are at
+!> at the domain interface. These points and their normals will be used to compute the
+!> neumannCoefficients below
+!> interfaceNormals - a 3D normal vector for each sourcePoint. These vectors are only used
+!> at points where isInterface == .true., and can take arbitrary values elsewehere. The
+!> normal vector is used to compute coefficients for the normal derivative of the
+!> interpolating function in order to impose the Neumann Boundary condition
+!> destinationPoint - the point where the interpolation will be performed
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> Output:
+!> dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
+!> boundary conditions to the specified destinationPoint
+!> neumannCoefficients - the coefficients used to interpolate a function with Neumann
+!> boundary conditions to the specified destinationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_func_3D_sca_lin_dir_neu_comp_coeffs(pointCount, &!{{{
sourcePoints, isInterface, interfaceNormals, destinationPoint, &
alpha, dirichletCoefficients, neumannCoefficients)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- logical, dimension(pointCount), intent(in) :: isInterface
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(pointCount), intent(out) :: &
- dirichletCoefficients, neumannCoefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of points
+ logical, dimension(pointCount), intent(in) :: isInterface !< Input: List of logicals determining if point as at an interface
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals !< Input: List of interface normals
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
+ real(kind=RKIND), dimension(pointCount), intent(out) :: dirichletCoefficients !< Output: List of Dirichlet coefficients
+ real(kind=RKIND), dimension(pointCount), intent(out) :: neumannCoefficients !< Outut: List of Neumann coefficients
integer :: i, j
integer :: matrixSize
@@ -997,45 +1095,53 @@
deallocate(coeffs)
deallocate(pivotIndices)
- end subroutine mpas_rbf_interp_func_3D_sca_lin_dir_neu_comp_coeffs
+ end subroutine mpas_rbf_interp_func_3D_sca_lin_dir_neu_comp_coeffs!}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in 3D that can be used to
- ! interpolate a number of vector functions at a given locations. This is useful
- ! if the interpolation location does not change with time, or if several
- ! fields are to be interpolated at a given time step. (If both the vector fields
- ! and the interpolation locations vary with time, there is no clear advantage in
- ! using either this method or the method for 2D interpoaltion above; for simplicity
- ! and because we foresee more uses for the method of this subroutine, we have not
- ! implemented a 3D version of the fixed field, variable interpolation location method
- ! as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
- ! conditions (or no boundaries). The interpolation is performed with basis functions
- ! that are RBFs plus a constant.
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! sourcePoints - the location of the "source" points in the 3D space where the values of
- ! the function are known
- ! unitVectors - the unit vectors associated with each of the sourcePoints. Interpolation
- ! is performed by supplying the value of the vector function dotted into each of these unit
- ! vectors. If multiple unit vectors are supplied at the same sourcePoint, they *must* be
- ! orthogonal for the interpolation to succeed.
- ! destinationPoint - the point where the interpolation will be performed
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! Output:
- ! coefficients - the coefficients used to interpolate a function with Dirichlet
- ! boundary conditions to the specified destinationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_func_3D_vec_const_dir_comp_coeffs(pointCount, &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_func_3D_vec_const_dir_comp_coeffs
+!
+!> \brief MPAS 3D vector constant Dirichlet coefficients routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in 3D that can be used to
+!> interpolate a number of vector functions at a given locations. This is useful
+!> if the interpolation location does not change with time, or if several
+!> fields are to be interpolated at a given time step. (If both the vector fields
+!> and the interpolation locations vary with time, there is no clear advantage in
+!> using either this method or the method for 2D interpoaltion above; for simplicity
+!> and because we foresee more uses for the method of this subroutine, we have not
+!> implemented a 3D version of the fixed field, variable interpolation location method
+!> as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
+!> conditions (or no boundaries). The interpolation is performed with basis functions
+!> that are RBFs plus a constant.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> sourcePoints - the location of the "source" points in the 3D space where the values of
+!> the function are known
+!> unitVectors - the unit vectors associated with each of the sourcePoints. Interpolation
+!> is performed by supplying the value of the vector function dotted into each of these unit
+!> vectors. If multiple unit vectors are supplied at the same sourcePoint, they *must* be
+!> orthogonal for the interpolation to succeed.
+!> destinationPoint - the point where the interpolation will be performed
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> Output:
+!> coefficients - the coefficients used to interpolate a function with Dirichlet
+!> boundary conditions to the specified destinationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_func_3D_vec_const_dir_comp_coeffs(pointCount, &!{{{
sourcePoints, unitVectors, destinationPoint, &
alpha, coefficients)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors !< Input: List of unit vectors
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
+ real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients !< Output: List of coefficients
integer :: i, j
integer :: matrixSize
@@ -1082,51 +1188,59 @@
deallocate(coeffs)
deallocate(pivotIndices)
- end subroutine mpas_rbf_interp_func_3D_vec_const_dir_comp_coeffs
+ end subroutine mpas_rbf_interp_func_3D_vec_const_dir_comp_coeffs !}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in 3D that can be used to
- ! interpolate a number of vector functions at a given locations. This is useful
- ! if the interpolation location does not change with time, or if several
- ! fields are to be interpolated at a given time step. (If both the vector fields
- ! and the interpolation locations vary with time, there is no clear advantage in
- ! using either this method or the method for 2D interpoaltion above; for simplicity
- ! and because we foresee more uses for the method of this subroutine, we have not
- ! implemented a 3D version of the fixed field, variable interpolation location method
- ! as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
- ! conditions (or no boundaries). The interpolation is performed with basis functions
- ! that are RBFs plus a constant.
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! sourcePoints - the location of the "source" points in the 3D space where the values of
- ! the function are known. The sourcePoints are projected into the plane given by
- ! planeBasisVectors
- ! unitVectors - the unit vectors associated with each of the sourcePoints. Interpolation
- ! is performed by supplying the value of the vector function dotted into each of these unit
- ! vectors. If multiple unit vectors are supplied at the same sourcePoint, they *must* be
- ! orthogonal for the interpolation to succeed. The unitVectors are projected into the
- ! plane given by planeBasisVectors
- ! destinationPoint - the point where the interpolation will be performed. The destinationPoint
- ! is projected into the plane given by planeBasisVectors
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! planeBasisVectors - the basis fectors for the plane where interpolation is performed.
- ! All points are projected into this plane.
- ! Output:
- ! coefficients - the coefficients used to interpolate a function with Dirichlet
- ! boundary conditions to the specified destinationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_func_3D_plane_vec_const_dir_comp_coeffs(pointCount, &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_func_3D_plane_vec_const_dir_comp_coeffs
+!
+!> \brief MPAS 3D vector planar constant Dirichlet coefficients routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in 3D that can be used to
+!> interpolate a number of vector functions at a given locations. This is useful
+!> if the interpolation location does not change with time, or if several
+!> fields are to be interpolated at a given time step. (If both the vector fields
+!> and the interpolation locations vary with time, there is no clear advantage in
+!> using either this method or the method for 2D interpoaltion above; for simplicity
+!> and because we foresee more uses for the method of this subroutine, we have not
+!> implemented a 3D version of the fixed field, variable interpolation location method
+!> as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
+!> conditions (or no boundaries). The interpolation is performed with basis functions
+!> that are RBFs plus a constant.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> sourcePoints - the location of the "source" points in the 3D space where the values of
+!> the function are known. The sourcePoints are projected into the plane given by
+!> planeBasisVectors
+!> unitVectors - the unit vectors associated with each of the sourcePoints. Interpolation
+!> is performed by supplying the value of the vector function dotted into each of these unit
+!> vectors. If multiple unit vectors are supplied at the same sourcePoint, they *must* be
+!> orthogonal for the interpolation to succeed. The unitVectors are projected into the
+!> plane given by planeBasisVectors
+!> destinationPoint - the point where the interpolation will be performed. The destinationPoint
+!> is projected into the plane given by planeBasisVectors
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> planeBasisVectors - the basis fectors for the plane where interpolation is performed.
+!> All points are projected into this plane.
+!> Output:
+!> coefficients - the coefficients used to interpolate a function with Dirichlet
+!> boundary conditions to the specified destinationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_func_3D_plane_vec_const_dir_comp_coeffs(pointCount, &!{{{
sourcePoints, unitVectors, destinationPoint, &
alpha, planeBasisVectors, coefficients)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(2,3) :: planeBasisVectors
- real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors !< Input: List of unit vectors
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
+ real(kind=RKIND), dimension(2,3) :: planeBasisVectors !< Input: Basis vectors for interpolation plane
+ real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients !< Output: List of coefficients
integer :: i, j
integer :: matrixSize
@@ -1191,55 +1305,63 @@
deallocate(coeffs)
deallocate(pivotIndices)
- end subroutine mpas_rbf_interp_func_3D_plane_vec_const_dir_comp_coeffs
+ end subroutine mpas_rbf_interp_func_3D_plane_vec_const_dir_comp_coeffs !}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in 3D that can be used to
- ! interpolate a number of vector functions at a given locations. This is useful
- ! if the interpolation location does not change with time, or if several
- ! fields are to be interpolated at a given time step. (If both the vector fields
- ! and the interpolation locations vary with time, there is no clear advantage in
- ! using either this method or the method for 2D interpoaltion above; for simplicity
- ! and because we foresee more uses for the method of this subroutine, we have not
- ! implemented a 3D version of the fixed field, variable interpolation location method
- ! as we have in 2D.) Coefficients are produced for handling Dirichlet normal /
- ! Neumann tangential boundary conditions (such as free slip). The interpolation is
- ! performed with basis functions that are RBFs plus a constant.
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! sourcePoints - the location of the "source" points in the 3D space where the values of
- ! the function are known
- ! isTangentToInterface - a logical array indicating which sourcePoints/unitVectors are
- ! tangent to the interface where the boundary condition will be applied. A Neumann
- ! boundary condition will be applied at these points in these directions.
- ! normalVectorIndex - where isTangentToInterface == .true., the index into unitVectors that
- ! gives the normal vector at the same sourcePoint. This information is needed to compute
- ! the Neumann boundary condition at this point.
- ! unitVectors - the unit vectors associated with each of the sourcePoints. Interpolation
- ! is performed by supplying the value of the vector function dotted into each of these unit
- ! vectors. If multiple unit vectors are supplied at the same sourcePoint, they *must* be
- ! orthogonal for the interpolation to succeed. A normal vector and two tangential vectors
- ! are needed at each interface point in order to satisfy the Dirichlet normal boundary
- ! condition and the Neumann tangential boundary conditions at these points.
- ! destinationPoint - the point where the interpolation will be performed
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! Output:
- ! coefficients - the coefficients used to interpolate a function with Dirichlet
- ! boundary conditions to the specified destinationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_func_3D_vec_const_tan_neu_comp_coeffs(pointCount, &
+!***********************************************************************
+!
+! routine mpas_rbf_interp_func_3D_vec_const_tan_neu_comp_coeffs
+!
+!> \brief MPAS 3D vector constant tangent Neumann coefficients routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in 3D that can be used to
+!> interpolate a number of vector functions at a given locations. This is useful
+!> if the interpolation location does not change with time, or if several
+!> fields are to be interpolated at a given time step. (If both the vector fields
+!> and the interpolation locations vary with time, there is no clear advantage in
+!> using either this method or the method for 2D interpoaltion above; for simplicity
+!> and because we foresee more uses for the method of this subroutine, we have not
+!> implemented a 3D version of the fixed field, variable interpolation location method
+!> as we have in 2D.) Coefficients are produced for handling Dirichlet normal /
+!> Neumann tangential boundary conditions (such as free slip). The interpolation is
+!> performed with basis functions that are RBFs plus a constant.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> sourcePoints - the location of the "source" points in the 3D space where the values of
+!> the function are known
+!> isTangentToInterface - a logical array indicating which sourcePoints/unitVectors are
+!> tangent to the interface where the boundary condition will be applied. A Neumann
+!> boundary condition will be applied at these points in these directions.
+!> normalVectorIndex - where isTangentToInterface == .true., the index into unitVectors that
+!> gives the normal vector at the same sourcePoint. This information is needed to compute
+!> the Neumann boundary condition at this point.
+!> unitVectors - the unit vectors associated with each of the sourcePoints. Interpolation
+!> is performed by supplying the value of the vector function dotted into each of these unit
+!> vectors. If multiple unit vectors are supplied at the same sourcePoint, they *must* be
+!> orthogonal for the interpolation to succeed. A normal vector and two tangential vectors
+!> are needed at each interface point in order to satisfy the Dirichlet normal boundary
+!> condition and the Neumann tangential boundary conditions at these points.
+!> destinationPoint - the point where the interpolation will be performed
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> Output:
+!> coefficients - the coefficients used to interpolate a function with Dirichlet
+!> boundary conditions to the specified destinationPoint
+!-----------------------------------------------------------------------
+ subroutine mpas_rbf_interp_func_3D_vec_const_tan_neu_comp_coeffs(pointCount, &!{{{
sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, destinationPoint, &
alpha, coefficients)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- logical, dimension(pointCount), intent(in) :: isTangentToInterface
- integer, dimension(pointCount), intent(in) :: normalVectorIndex
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of points
+ logical, dimension(pointCount), intent(in) :: isTangentToInterface !< Input: List of logicals determining if point is tangent to interface
+ integer, dimension(pointCount), intent(in) :: normalVectorIndex !< Input: Index of for normal vectors
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors !< Input: List of unit vectors
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
+ real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients !< Output: List of coefficients
integer :: i, j
integer :: matrixSize
@@ -1287,61 +1409,70 @@
deallocate(coeffs)
deallocate(pivotIndices)
- end subroutine mpas_rbf_interp_func_3D_vec_const_tan_neu_comp_coeffs
+ end subroutine mpas_rbf_interp_func_3D_vec_const_tan_neu_comp_coeffs !}}}
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: Compute interpolation coefficients in 3D that can be used to
- ! interpolate a number of vector functions at a given locations. This is useful
- ! if the interpolation location does not change with time, or if several
- ! fields are to be interpolated at a given time step. (If both the vector fields
- ! and the interpolation locations vary with time, there is no clear advantage in
- ! using either this method or the method for 2D interpoaltion above; for simplicity
- ! and because we foresee more uses for the method of this subroutine, we have not
- ! implemented a 3D version of the fixed field, variable interpolation location method
- ! as we have in 2D.) Coefficients are produced for handling Dirichlet normal /
- ! Neumann tangential boundary conditions (such as free slip). The interpolation is
- ! performed with basis functions that are RBFs plus a constant.
- ! Input:
- ! pointCount - the number of "source" points and functionValues supplied
- ! sourcePoints - the location of the "source" points in the 3D space where the values of
- ! the function are known. The sourcePoints are projected into the plane given by
- ! planeBasisVectors
- ! isTangentToInterface - a logical array indicating which sourcePoints/unitVectors are
- ! tangent to the interface where the boundary condition will be applied. A Neumann
- ! boundary condition will be applied at these points in these directions.
- ! normalVectorIndex - where isTangentToInterface == .true., the index into unitVectors that
- ! gives the normal vector at the same sourcePoint. This information is needed to compute
- ! the Neumann boundary condition at this point.
- ! unitVectors - the unit vectors associated with each of the sourcePoints. Interpolation
- ! is performed by supplying the value of the vector function dotted into each of these unit
- ! vectors. If multiple unit vectors are supplied at the same sourcePoint, they *must* be
- ! orthogonal for the interpolation to succeed. A normal vector and two tangential vectors
- ! are needed at each interface point in order to satisfy the Dirichlet normal boundary
- ! condition and the Neumann tangential boundary conditions at these points. The unitVectors
- ! are projected into the plane given by planeBasisVectors
- ! destinationPoint - the point where the interpolation will be performed. The destinationPoint
- ! is projected into the plane given by planeBasisVectors
- ! alpha - a constant that give the characteristic length scale of the RBFs,
- ! should be on the order of the distance between points
- ! planeBasisVectors - the basis fectors for the plane where interpolation is performed.
- ! All points are projected into this plane.
- ! Output:
- ! coefficients - the coefficients used to interpolate a function with Dirichlet
- ! boundary conditions to the specified destinationPoint
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- subroutine mpas_rbf_interp_func_3D_plane_vec_const_tan_neu_comp_coeffs(&
+!***********************************************************************
+!
+! routine mpas_rbf_interp_func_3D_plane_vec_const_tan_neu_comp_coeffs
+!
+!> \brief MPAS 3D vector planar constant tangent Neumann coefficients routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes interpolation coefficients in 3D that can be used to
+!> interpolate a number of vector functions at a given locations. This is useful
+!> if the interpolation location does not change with time, or if several
+!> fields are to be interpolated at a given time step. (If both the vector fields
+!> and the interpolation locations vary with time, there is no clear advantage in
+!> using either this method or the method for 2D interpoaltion above; for simplicity
+!> and because we foresee more uses for the method of this subroutine, we have not
+!> implemented a 3D version of the fixed field, variable interpolation location method
+!> as we have in 2D.) Coefficients are produced for handling Dirichlet normal /
+!> Neumann tangential boundary conditions (such as free slip). The interpolation is
+!> performed with basis functions that are RBFs plus a constant.
+!> Input:
+!> pointCount - the number of "source" points and functionValues supplied
+!> sourcePoints - the location of the "source" points in the 3D space where the values of
+!> the function are known. The sourcePoints are projected into the plane given by
+!> planeBasisVectors
+!> isTangentToInterface - a logical array indicating which sourcePoints/unitVectors are
+!> tangent to the interface where the boundary condition will be applied. A Neumann
+!> boundary condition will be applied at these points in these directions.
+!> normalVectorIndex - where isTangentToInterface == .true., the index into unitVectors that
+!> gives the normal vector at the same sourcePoint. This information is needed to compute
+!> the Neumann boundary condition at this point.
+!> unitVectors - the unit vectors associated with each of the sourcePoints. Interpolation
+!> is performed by supplying the value of the vector function dotted into each of these unit
+!> vectors. If multiple unit vectors are supplied at the same sourcePoint, they *must* be
+!> orthogonal for the interpolation to succeed. A normal vector and two tangential vectors
+!> are needed at each interface point in order to satisfy the Dirichlet normal boundary
+!> condition and the Neumann tangential boundary conditions at these points. The unitVectors
+!> are projected into the plane given by planeBasisVectors
+!> destinationPoint - the point where the interpolation will be performed. The destinationPoint
+!> is projected into the plane given by planeBasisVectors
+!> alpha - a constant that give the characteristic length scale of the RBFs,
+!> should be on the order of the distance between points
+!> planeBasisVectors - the basis fectors for the plane where interpolation is performed.
+!> All points are projected into this plane.
+!> Output:
+!> coefficients - the coefficients used to interpolate a function with Dirichlet
+!> boundary conditions to the specified destinationPoint
+!-----------------------------------------------------------------------
+
+ subroutine mpas_rbf_interp_func_3D_plane_vec_const_tan_neu_comp_coeffs(&!{{{
pointCount, sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, &
destinationPoint, alpha, planeBasisVectors, coefficients)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- logical, dimension(pointCount), intent(in) :: isTangentToInterface
- integer, dimension(pointCount), intent(in) :: normalVectorIndex
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(2,3), intent(in) :: planeBasisVectors
- real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
+ integer, intent(in) :: pointCount !< input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of points
+ logical, dimension(pointCount), intent(in) :: isTangentToInterface !< Input: List of logicals determining if point is tangent to interface
+ integer, dimension(pointCount), intent(in) :: normalVectorIndex !< Input: Index for normal vectors
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors !< Input: List of unit vectors
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
+ real(kind=RKIND), dimension(2,3), intent(in) :: planeBasisVectors !< Input: Basis vectors for interpolation plane
+ real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients !< Output: List of coefficients
integer :: i, j
integer :: matrixSize
@@ -1407,52 +1538,99 @@
deallocate(coeffs)
deallocate(pivotIndices)
- end subroutine mpas_rbf_interp_func_3D_plane_vec_const_tan_neu_comp_coeffs
+ end subroutine mpas_rbf_interp_func_3D_plane_vec_const_tan_neu_comp_coeffs !}}}
!!!!!!!!!!!!!!!!!!!!!
! private subroutines
!!!!!!!!!!!!!!!!!!!!!
- function evaluate_rbf(rSquared) result(rbfValue)
- real(kind=RKIND), intent(in) :: rSquared
+!***********************************************************************
+!
+! function evaluate_rbf
+!
+!> \brief MPAS RBF Evaluation function
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This function evaluates an RBF and returns the value.
+!-----------------------------------------------------------------------
+ function evaluate_rbf(rSquared) result(rbfValue)!{{{
+ real(kind=RKIND), intent(in) :: rSquared !< Input: Squared value of r
real(kind=RKIND) :: rbfValue
! inverse multiquadratic
rbfValue = 1/sqrt(1 + rSquared)
- end function evaluate_rbf
+ end function evaluate_rbf!}}}
- subroutine mpas_evaluate_rbf_and_deriv(rSquared, rbfValue, rbfDerivOverR)
- real(kind=RKIND), intent(in) :: rSquared
- real(kind=RKIND), intent(out) :: rbfValue, rbfDerivOverR
+!***********************************************************************
+!
+! routine mpas_evaluate_rbf_and_deriv
+!
+!> \brief MPAS RBF Evaluation and derivative routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the value and derivative of a RBF.
+!-----------------------------------------------------------------------
+ subroutine mpas_evaluate_rbf_and_deriv(rSquared, rbfValue, rbfDerivOverR)!{{{
+ real(kind=RKIND), intent(in) :: rSquared !< Input: Squared value of R
+ real(kind=RKIND), intent(out) :: rbfValue !< Output: Value of RBF
+ real(kind=RKIND), intent(out) :: rbfDerivOverR !< Outut: Derivative of RBF over R
! inverse multiquadratic
rbfValue = 1/sqrt(1 + rSquared)
rbfDerivOverR = -rbfValue**3
- end subroutine mpas_evaluate_rbf_and_deriv
+ end subroutine mpas_evaluate_rbf_and_deriv!}}}
- subroutine mpas_evaluate_rbf_and_derivs(rSquared, rbfValue, rbfDerivOverR, rbfSecondDeriv)
- real(kind=RKIND), intent(in) :: rSquared
- real(kind=RKIND), intent(out) :: rbfValue, rbfDerivOverR, rbfSecondDeriv
+!***********************************************************************
+!
+! routine mpas_evaluate_rbf_and_derivs
+!
+!> \brief MPAS RBF Evaluation and first and second derivative routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the value and the first two derivatives of a RBF.
+!-----------------------------------------------------------------------
+ subroutine mpas_evaluate_rbf_and_derivs(rSquared, rbfValue, rbfDerivOverR, rbfSecondDeriv)!{{{
+ real(kind=RKIND), intent(in) :: rSquared !< Input: Squared value of R
+ real(kind=RKIND), intent(out) :: rbfValue !< Output: Value of RBF
+ real(kind=RKIND), intent(out) :: rbfDerivOverR !< Output: Value of first derivative of RBF
+ real(kind=RKIND), intent(out) :: rbfSecondDeriv !< Output: Value of second derivative of RBF
! inverse multiquadratic
rbfValue = 1/sqrt(1 + rSquared)
rbfDerivOverR = -rbfValue**3
rbfSecondDeriv = (2*rSquared-1)*rbfValue**5
- end subroutine mpas_evaluate_rbf_and_derivs
+ end subroutine mpas_evaluate_rbf_and_derivs!}}}
- subroutine mpas_set_up_scalar_rbf_dirichlet_matrix_and_rhs(pointCount, sourcePoints, destinationPoint, &
+!***********************************************************************
+!
+! routine mpas_set_up_scalar_rbf_dirichlet_matrix_and_rhs
+!
+!> \brief MPAS RBF Scalar Matrix and RHS setup routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine sets up the matrix and RHS for scalar Dirichlet RBF interpolation.
+!-----------------------------------------------------------------------
+ subroutine mpas_set_up_scalar_rbf_dirichlet_matrix_and_rhs(pointCount, sourcePoints, destinationPoint, &!{{{
alpha, dirichletMatrix, rhs)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: dirichletMatrix
- real(kind=RKIND), dimension(pointCount), intent(out) :: rhs
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of points
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBF
+ real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: dirichletMatrix !< Output: Matrix
+ real(kind=RKIND), dimension(pointCount), intent(out) :: rhs !< Output: Right hand side
integer :: i, j
@@ -1471,21 +1649,32 @@
rhs(j) = evaluate_rbf(rSquared)
end do
- end subroutine mpas_set_up_scalar_rbf_dirichlet_matrix_and_rhs
+ end subroutine mpas_set_up_scalar_rbf_dirichlet_matrix_and_rhs!}}}
- subroutine mpas_set_up_scalar_rbf_matrix_and_rhs(pointCount, &
+!***********************************************************************
+!
+! routine mpas_set_up_scalar_rbf_matrix_and_rhs
+!
+!> \brief MPAS RBF Scalar Matrix and RHS setup routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine sets up the matrix and RHS for scalar Dirichlet and Neumann RBF interpolation.
+!-----------------------------------------------------------------------
+ subroutine mpas_set_up_scalar_rbf_matrix_and_rhs(pointCount, &!{{{
sourcePoints, isInterface, interfaceNormals, destinationPoint, &
alpha, dirichletMatrix, neumannMatrix, rhs)
- integer, intent(in) :: pointCount
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
- logical, dimension(pointCount), intent(in) :: isInterface
- real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
- real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: &
- dirichletMatrix, neumannMatrix
- real(kind=RKIND), dimension(pointCount), intent(out) :: rhs
+ integer, intent(in) :: pointCount !< Input: Number of points
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints !< Input: List of points
+ logical, dimension(pointCount), intent(in) :: isInterface !< Input: Logicals determining if point is an interface
+ real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals !< Input: Normals at interfaces
+ real(kind=RKIND), dimension(3), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBF
+ real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: dirichletMatrix !< Output: Dirichlet Matrix
+ real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: neumannMatrix !< Output: Neumann Matrix
+ real(kind=RKIND), dimension(pointCount), intent(out) :: rhs !< Output: Right hand side
integer :: i, j
@@ -1517,19 +1706,31 @@
rhs(j) = evaluate_rbf(rSquared)
end do
- end subroutine mpas_set_up_scalar_rbf_matrix_and_rhs
+ end subroutine mpas_set_up_scalar_rbf_matrix_and_rhs!}}}
- subroutine mpas_set_up_vector_dirichlet_rbf_matrix_and_rhs(pointCount, dimensions, &
+!***********************************************************************
+!
+! routine mpas_set_up_vector_dirichlet_rbf_matrix_and_rhs
+!
+!> \brief MPAS RBF Vector Matrix and RHS setup routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine sets up the matrix and RHS for vector Dirichlet RBF interpolation.
+!-----------------------------------------------------------------------
+ subroutine mpas_set_up_vector_dirichlet_rbf_matrix_and_rhs(pointCount, dimensions, &!{{{
sourcePoints, unitVectors, destinationPoint, &
alpha, matrix, rhs)
- integer, intent(in) :: pointCount, dimensions
- real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: sourcePoints
- real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: unitVectors
- real(kind=RKIND), dimension(dimensions), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: matrix
- real(kind=RKIND), dimension(pointCount,dimensions), intent(out) :: rhs
+ integer, intent(in) :: pointCount !< Input: Number of points
+ integer, intent(in) :: dimensions !< Input: Number of dimensions
+ real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: sourcePoints !< Input: List of points
+ real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: unitVectors !< Input: List of unit vectors
+ real(kind=RKIND), dimension(dimensions), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBFs
+ real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: matrix !< Output: Matrix
+ real(kind=RKIND), dimension(pointCount,dimensions), intent(out) :: rhs !< Output: Right hand side
integer :: i, j
@@ -1550,21 +1751,33 @@
rhs(j,:) = evaluate_rbf(rSquared)*unitVectors(j,:)
end do
- end subroutine mpas_set_up_vector_dirichlet_rbf_matrix_and_rhs
+ end subroutine mpas_set_up_vector_dirichlet_rbf_matrix_and_rhs!}}}
- subroutine mpas_set_up_vector_free_slip_rbf_matrix_and_rhs(pointCount, dimensions, &
+!***********************************************************************
+!
+! routine mpas_set_up_vector_free_slip_rbf_matrix_and_rhs
+!
+!> \brief MPAS RBF Vector Matrix and RHS setup routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine sets up the matrix and RHS for vector Free Slip RBF interpolation.
+!-----------------------------------------------------------------------
+ subroutine mpas_set_up_vector_free_slip_rbf_matrix_and_rhs(pointCount, dimensions, &!{{{
sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, destinationPoint, &
alpha, matrix, rhs)
- integer, intent(in) :: pointCount, dimensions
- real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: sourcePoints
- logical, dimension(pointCount), intent(in) :: isTangentToInterface
- integer, dimension(pointCount), intent(in) :: normalVectorIndex
- real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: unitVectors
- real(kind=RKIND), dimension(dimensions), intent(in) :: destinationPoint
- real(kind=RKIND), intent(in) :: alpha
- real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: matrix
- real(kind=RKIND), dimension(pointCount,dimensions), intent(out) :: rhs
+ integer, intent(in) :: pointCount !< Input: Number of points
+ integer, intent(in) :: dimensions !< Input: Number of dimensions
+ real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: sourcePoints !< Input: List of points
+ logical, dimension(pointCount), intent(in) :: isTangentToInterface !< Input: Logical to determine if point is tangent to interface
+ integer, dimension(pointCount), intent(in) :: normalVectorIndex !< Input: Index to normal vector
+ real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: unitVectors !< Input: List of unit vectors
+ real(kind=RKIND), dimension(dimensions), intent(in) :: destinationPoint !< Input: Destination point
+ real(kind=RKIND), intent(in) :: alpha !< Input: Characteristic length scale of RBF
+ real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: matrix !< Output: Matrix
+ real(kind=RKIND), dimension(pointCount,dimensions), intent(out) :: rhs !< Output: Right hand side
integer :: i, j
@@ -1597,24 +1810,47 @@
rhs(j,:) = evaluate_rbf(rSquared)*unitVectors(j,:)
end do
- end subroutine mpas_set_up_vector_free_slip_rbf_matrix_and_rhs
+ end subroutine mpas_set_up_vector_free_slip_rbf_matrix_and_rhs!}}}
- subroutine mpas_unit_vec_in_r3(xin)
+!***********************************************************************
+!
+! routine mpas_unit_vec_in_r3
+!
+!> \brief MPAS 3D unit vector routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine creates a unit vector out of an input point.
+!-----------------------------------------------------------------------
+ subroutine mpas_unit_vec_in_r3(xin)!{{{
implicit none
- real (kind=RKIND), intent(inout) :: xin(3)
+ real (kind=RKIND), intent(inout) :: xin(3) !< Input/Output: Vector and unit vector
real (kind=RKIND) :: mag
mag = sqrt(xin(1)**2+xin(2)**2+xin(3)**2)
xin(:) = xin(:) / mag
- end subroutine mpas_unit_vec_in_r3
+ end subroutine mpas_unit_vec_in_r3!}}}
- subroutine mpas_cross_product_in_r3(p_1,p_2,p_out)
- real (kind=RKIND), intent(in) :: p_1 (3), p_2 (3)
- real (kind=RKIND), intent(out) :: p_out (3)
+!***********************************************************************
+!
+! routine mpas_cross_product_in_r3
+!
+!> \brief MPAS 3D cross product routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the cross product of two input vectors.
+!-----------------------------------------------------------------------
+ subroutine mpas_cross_product_in_r3(p_1,p_2,p_out)!{{{
+ real (kind=RKIND), intent(in) :: p_1 (3) !< Input: Vector 1
+ real (kind=RKIND), intent(in) :: p_2 (3) !< Input: Vector 2
+ real (kind=RKIND), intent(out) :: p_out (3) !< Output: Cross product of vector 1 and vector 2
p_out(1) = p_1(2)*p_2(3)-p_1(3)*p_2(2)
p_out(2) = p_1(3)*p_2(1)-p_1(1)*p_2(3)
p_out(3) = p_1(1)*p_2(2)-p_1(2)*p_2(1)
- end subroutine mpas_cross_product_in_r3
+ end subroutine mpas_cross_product_in_r3!}}}
! Updated 10/24/2001.
!
@@ -1656,20 +1892,28 @@
! WRITE (6, "(F16.8)") (X(I), I=1,N)
!END PROGRAM EX43
-
-subroutine mpas_legs (A,N,B,X,INDX)
+!***********************************************************************
!
-! subroutine to solve the equation A(N,N)*X(N) = B(N) with the
-! partial-pivoting Gaussian elimination scheme.
-! Copyright (c) Tao Pang 2001.
+! routine mpas_legs
!
+!> \brief MPAS Gaussian elimination solver routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine solves the equation A(N,N)*X(N) = B(N) with the partial-pivoting
+!> Gaussian Elimination scheme. Copyright (c) Tao Pang 2001.
+!-----------------------------------------------------------------------
+subroutine mpas_legs (A,N,B,X,INDX)!{{{
+
IMPLICIT NONE
- integer, INTENT (IN) :: N
- integer :: I,J
- integer, INTENT (OUT), DIMENSION (N) :: INDX
- real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
- real(kind=RKIND), INTENT (INOUT), DIMENSION (N) :: B
- real(kind=RKIND), INTENT (OUT), DIMENSION (N) :: X
+ integer, INTENT (IN) :: N !< Input: Size of matrix and vectors
+ integer, INTENT (OUT), DIMENSION (N) :: INDX !< Output: Pivot vector
+ real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A !< Input/Output: Matrix
+ real(kind=RKIND), INTENT (INOUT), DIMENSION (N) :: B !< Input/Output: Right hand side vector
+ real(kind=RKIND), INTENT (OUT), DIMENSION (N) :: X !< Output: Solution
+
+ integer :: I,J
!
CALL elgs (A,N,INDX)
!
@@ -1688,7 +1932,7 @@
X(I) = X(I)/A(INDX(I),I)
END DO
!
-END subroutine mpas_legs
+END subroutine mpas_legs!}}}
!
@@ -1709,18 +1953,26 @@
! !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
-subroutine migs (A,N,X,INDX)
+!***********************************************************************
!
-! subroutine to invert matrix A(N,N) with the inverse stored
-! in X(N,N) in the output. Copyright (c) Tao Pang 2001.
+! routine migs
!
+!> \brief Matrix inversion routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine inverts the matrix A(N,N) and stores it in X(N,B)
+!> Copyright (c) Tao Pang 2001.
+!-----------------------------------------------------------------------
+subroutine migs (A,N,X,INDX)!{{{
IMPLICIT NONE
- integer, INTENT (IN) :: N
+ integer, INTENT (IN) :: N !< Input: Size of matrix and inverse
+ integer, INTENT (OUT), DIMENSION (N) :: INDX !< Output: Pivot vector
+ real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A !< Input/Output: Matrix to invert
+ real(kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X !< Output: Inverse of Matrix
+ real(kind=RKIND), DIMENSION (N,N) :: B
integer :: I,J,K
- integer, INTENT (OUT), DIMENSION (N) :: INDX
- real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
- real(kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
- real(kind=RKIND), DIMENSION (N,N) :: B
!
DO I = 1, N
DO J = 1, N
@@ -1751,10 +2003,22 @@
X(J,I) = X(J,I)/A(INDX(J),J)
END DO
END DO
-END subroutine migs
+END subroutine migs!}}}
+!***********************************************************************
+!
+! routine elgs
+!
+!> \brief Partial-pivoting Gaussian elimination routine
+!> \author Xylar Asay-Davis
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This routine performs the partial-pivoting Gaussian elimination.
+!> Copyright (c) Tao Pang 2001.
+!-----------------------------------------------------------------------
-subroutine elgs (A,N,INDX)
+subroutine elgs (A,N,INDX)!{{{
!
! subroutine to perform the partial-pivoting Gaussian elimination.
! A(N,N) is the original matrix in the input and transformed matrix
@@ -1762,11 +2026,11 @@
! INDX(N) records the pivoting order. Copyright (c) Tao Pang 2001.
!
IMPLICIT NONE
- integer, INTENT (IN) :: N
+ integer, INTENT (IN) :: N !< Input: Size of matrix
+ integer, INTENT (OUT), DIMENSION (N) :: INDX !< Output: Pivot vector
+ real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A !< Input/Output: Matrix and solution
integer :: I,J,K,ITMP
- integer, INTENT (OUT), DIMENSION (N) :: INDX
real(kind=RKIND) :: C1,PI,PI1,PJ
- real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
real(kind=RKIND), DIMENSION (N) :: C
!
! Initialize the index
@@ -1818,7 +2082,7 @@
END DO
END DO
!
-END subroutine elgs
+END subroutine elgs!}}}
end module mpas_rbf_interpolation
Modified: branches/mpas_cdg_advection/src/operators/mpas_spline_interpolation.F
===================================================================
--- branches/mpas_cdg_advection/src/operators/mpas_spline_interpolation.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/operators/mpas_spline_interpolation.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,15 @@
+!***********************************************************************
+!
+! mpas_spline_interpolation
+!
+!> \brief MPAS Vector reconstruction module
+!> \author Mark Petersen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This module provides routines for performing spline interpolation.
+!
+!-----------------------------------------------------------------------
module mpas_spline_interpolation
use mpas_kind_types
@@ -13,44 +25,42 @@
mpas_interpolate_linear, &
mpas_test_interpolate
-! Short Descriptions:
-
-! mpas_cubic_spline_coefficients: Compute second derivatives at nodes.
-! This must be run before any of the other cubic spine functions.
-
-! mpas_interpolate_cubic_spline: Compute cubic spline interpolation.
-
-! mpas_integrate_cubic_spline: Compute a single integral from spline data.
-
-! mpas_integrate_column_cubic_spline: Compute multiple integrals from spline data.
-
-! mpas_interpolate_linear: Compute linear interpolation.
-
-! mpas_test_interpolate: Test spline interpolation subroutines.
-
contains
- subroutine mpas_cubic_spline_coefficients(x,y,n,y2ndDer)
+!***********************************************************************
+!
+! routine mpas_cubic_spline_coefficients
+!
+!> \brief MPAS Cubic spline coefficients routine
+!> \author Mark Petersen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> This routine computes second derivatives at nodes.
+!> This must be run before any of the other cubic spine functions.
+!>
+!> Given arrays x(1:n) and y(1:n) containing a function,
+!> i.e., y(i) = f(x(i)), with x monotonically increasing
+!> this routine returns an array y2ndDer(1:n) that contains
+!> the second derivatives of the interpolating function at x(1:n).
+!> This routine uses boundary conditions for a natural spline,
+!> with zero second derivative on that boundary.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_cubic_spline_coefficients(x,y,n,y2ndDer) !{{{
-! Given arrays x(1:n) and y(1:n) containing a function,
-! i.e., y(i) = f(x(i)), with x monotonically increasing
-! this routine returns an array y2ndDer(1:n) that contains
-! the second derivatives of the interpolating function at x(1:n).
-! This routine uses boundary conditions for a natural spline,
-! with zero second derivative on that boundary.
-
! INPUT PARAMETERS:
integer, intent(in) :: &
- n ! number of nodes
+ n !< Input: number of nodes
real(kind=RKIND), intent(in), dimension(n) :: &
- x, &! location of nodes
- y ! value at nodes
+ x, &!< Input: location of nodes
+ y !< Input: value at nodes
! OUTPUT PARAMETERS:
real(kind=RKIND), intent(out), dimension(n) :: &
- y2ndDer ! dy^2/dx^2 at each node
+ y2ndDer !< Output: dy^2/dx^2 at each node
! local variables:
@@ -75,39 +85,48 @@
y2ndDer(i)=y2ndDer(i)*y2ndDer(i+1)+a(i)
enddo
- end subroutine mpas_cubic_spline_coefficients
+ end subroutine mpas_cubic_spline_coefficients!}}}
-
- subroutine mpas_interpolate_cubic_spline( &
+!***********************************************************************
+!
+! routine mpas_interpolate_cubic_spline
+!
+!> \brief MPAS Cubic spline interpolation routine
+!> \author Mark Petersen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> Given the arrays x(1:n) and y(1:n), which tabulate a function,
+!> and given the array y2ndDer(1:n), which is the output from
+!> CubicSplineCoefficients above, this routine returns the
+!> cubic-spline interpolated values of yOut(1:nOut) at xOut(1:nOut).
+!> This subroutine assumes that both x and xOut are monotonically
+!> increasing, and that all values of xOut are within the first and
+!> last values of x.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_interpolate_cubic_spline( &!{{{
x,y,y2ndDer,n, &
xOut,yOut,nOut)
-! Given the arrays x(1:n) and y(1:n), which tabulate a function,
-! and given the array y2ndDer(1:n), which is the output from
-! CubicSplineCoefficients above, this routine returns the
-! cubic-spline interpolated values of yOut(1:nOut) at xOut(1:nOut).
-! This subroutine assumes that both x and xOut are monotonically
-! increasing, and that all values of xOut are within the first and
-! last values of x.
-
! INPUT PARAMETERS:
real (kind=RKIND), dimension(n), intent(in) :: &
- x, &! node location, input grid
- y, &! interpolation variable, input grid
- y2ndDer ! 2nd derivative of y at nodes
+ x, &!< Input: node location, input grid
+ y, &!< Input: interpolation variable, input grid
+ y2ndDer !< Input: 2nd derivative of y at nodes
real (kind=RKIND), dimension(nOut), intent(in) :: &
- xOut ! node location, output grid
+ xOut !< Input: node location, output grid
integer, intent(in) :: &
- n, &! number of nodes, input grid
- nOut ! number of nodes, output grid
+ n, &!< Input: number of nodes, input grid
+ nOut !< Input: number of nodes, output grid
! OUTPUT PARAMETERS:
real (kind=RKIND), dimension(nOut), intent(out) :: &
- yOut ! interpolation variable, output grid
+ yOut !< Output: interpolation variable, output grid
! local variables:
@@ -139,34 +158,43 @@
enddo kInLoop
-end subroutine mpas_interpolate_cubic_spline
+end subroutine mpas_interpolate_cubic_spline!}}}
+!***********************************************************************
+!
+! routine mpas_integrate_cubic_spline
+!
+!> \brief MPAS Cubic spline integration routine
+!> \author Mark Petersen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> Given the arrays x(1:n) and y(1:n), which tabulate a function,
+!> and given the array y2ndDer(1:n), which is the output from
+!> CubicSplineCoefficients above, this routine returns y_integral,
+!> the integral of y from x1 to x2. The integration formula was
+!> created by analytically integrating a cubic spline between each node.
+!> This subroutine assumes that x is monotonically increasing, and
+!> that x1 < x2.
+!
+!-----------------------------------------------------------------------
+subroutine mpas_integrate_cubic_spline(x,y,y2ndDer,n,x1,x2,y_integral) !{{{
-subroutine mpas_integrate_cubic_spline(x,y,y2ndDer,n,x1,x2,y_integral)
-
-! Given the arrays x(1:n) and y(1:n), which tabulate a function,
-! and given the array y2ndDer(1:n), which is the output from
-! CubicSplineCoefficients above, this routine returns y_integral,
-! the integral of y from x1 to x2. The integration formula was
-! created by analytically integrating a cubic spline between each node.
-! This subroutine assumes that x is monotonically increasing, and
-! that x1 < x2.
-
! INPUT PARAMETERS:
integer, intent(in) :: &
- n ! number of nodes
+ n !< Input: number of nodes
real(kind=RKIND), intent(in), dimension(n) :: &
- x, &! location of nodes
- y, &! value at nodes
- y2ndDer ! dy^2/dx^2 at each node
+ x, &!< Input: location of nodes
+ y, &!< Input: value at nodes
+ y2ndDer !< Input: dy^2/dx^2 at each node
real(kind=RKIND), intent(in) :: &
- x1,x2 ! limits of integration
+ x1,x2 !< Input: limits of integration
! OUTPUT PARAMETERS:
real(kind=RKIND), intent(out) :: &
- y_integral ! integral of y
+ y_integral !< Output: integral of y
! local variables:
@@ -215,40 +243,49 @@
enddo ! j
- end subroutine mpas_integrate_cubic_spline
+ end subroutine mpas_integrate_cubic_spline!}}}
-
- subroutine mpas_integrate_column_cubic_spline( &
+!***********************************************************************
+!
+! routine mpas_integrate_column_cubic_spline
+!
+!> \brief MPAS Cubic spline column integration routine
+!> \author Mark Petersen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> Given the arrays x(1:n) and y(1:n), which tabulate a function,
+!> and given the array y2ndDer(1:n), which is the output from
+!> CubicSplineCoefficients above, this routine returns
+!> y_integral(1:nOut), the integral of y.
+!> This is a cumulative integration, so that
+!> y_integral(j) holds the integral of y from x(1) to xOut(j).
+!> The integration formula was created by analytically integrating a
+!> cubic spline between each node.
+!> This subroutine assumes that both x and xOut are monotonically
+!> increasing, and that all values of xOut are within the first and
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_integrate_column_cubic_spline( &!{{{
x,y,y2ndDer,n, &
xOut,y_integral, nOut)
-! Given the arrays x(1:n) and y(1:n), which tabulate a function,
-! and given the array y2ndDer(1:n), which is the output from
-! CubicSplineCoefficients above, this routine returns
-! y_integral(1:nOut), the integral of y.
-! This is a cumulative integration, so that
-! y_integral(j) holds the integral of y from x(1) to xOut(j).
-! The integration formula was created by analytically integrating a
-! cubic spline between each node.
-! This subroutine assumes that both x and xOut are monotonically
-! increasing, and that all values of xOut are within the first and
-
! INPUT PARAMETERS:
integer, intent(in) :: &
- n, &! number of nodes
- nOut ! number of output locations to compute integral
+ n, &!< Input: number of nodes
+ nOut !< Input: number of output locations to compute integral
real(kind=RKIND), intent(in), dimension(n) :: &
- x, &! location of nodes
- y, &! value at nodes
- y2ndDer ! dy^2/dx^2 at each node
+ x, &!< Input: location of nodes
+ y, &!< Input: value at nodes
+ y2ndDer !< Input: dy^2/dx^2 at each node
real(kind=RKIND), dimension(nOut), intent(in) :: &
- xOut ! output locations to compute integral
+ xOut !< Input: output locations to compute integral
! OUTPUT PARAMETERS:
real(kind=RKIND), dimension(nOut), intent(out) :: &
- y_integral ! integral from 0 to xOut
+ y_integral !< Output: integral from 0 to xOut
! local variables:
@@ -295,37 +332,47 @@
enddo k_loop
- end subroutine mpas_integrate_column_cubic_spline
+ end subroutine mpas_integrate_column_cubic_spline!}}}
-
- subroutine mpas_interpolate_linear( &
+!***********************************************************************
+!
+! routine mpas_interpolate_linear
+!
+!> \brief MPAS Linear interpolation routine
+!> \author Mark Petersen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> Given the arrays x(1:n) and y(1:n), which tabulate a function,
+!> this routine returns the linear interpolated values of yOut(1:nOut)
+!> at xOut(1:nOut).
+!> This subroutine assumes that both x and xOut are monotonically
+!> increasing, and that all values of xOut are within the first and
+!> last values of x.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_interpolate_linear( &!{{{
x,y,n, &
xOut,yOut,nOut)
-! Given the arrays x(1:n) and y(1:n), which tabulate a function,
-! this routine returns the linear interpolated values of yOut(1:nOut)
-! at xOut(1:nOut).
-! This subroutine assumes that both x and xOut are monotonically
-! increasing, and that all values of xOut are within the first and
-! last values of x.
! !INPUT PARAMETERS:
real (kind=RKIND), dimension(n), intent(in) :: &
- x, &! node location, input grid
- y ! interpolation variable, input grid
+ x, &!< Input: node location, input grid
+ y !< Input: interpolation variable, input grid
real (kind=RKIND), dimension(nOut), intent(in) :: &
- xOut ! node location, output grid
+ xOut !< Input: node location, output grid
integer, intent(in) :: &
- N, &! number of nodes, input grid
- NOut ! number of nodes, output grid
+ N, &!< Input: number of nodes, input grid
+ NOut !< Input: number of nodes, output grid
! !OUTPUT PARAMETERS:
real (kind=RKIND), dimension(nOut), intent(out) :: &
- yOut ! interpolation variable, output grid
+ yOut !< Output: interpolation variable, output grid
!-----------------------------------------------------------------------
!
@@ -355,13 +402,22 @@
enddo kInLoop
- end subroutine mpas_interpolate_linear
+ end subroutine mpas_interpolate_linear!}}}
+!***********************************************************************
+!
+! routine mpas_test_interpolate
+!
+!> \brief MPAS Interpolation test routine
+!> \author Mark Petersen
+!> \date 04/02/13
+!> \version SVN:$Id$
+!> \details
+!> Test routine to show how to operate the cubic spline subroutines
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_test_interpolate!{{{
- subroutine mpas_test_interpolate
-
-! Test function to show how to operate the cubic spline subroutines
-
integer, parameter :: &
n = 10
real (kind=RKIND), dimension(n) :: &
@@ -426,7 +482,7 @@
print '(a,100f8.4,a)', 'yOut = [',yOut,'];'
print *, "plot(x,y,'-*r',xOut,yOut,'x')"
- end subroutine mpas_test_interpolate
+ end subroutine mpas_test_interpolate!}}}
end module mpas_spline_interpolation
Modified: branches/mpas_cdg_advection/src/operators/mpas_vector_reconstruction.F
===================================================================
--- branches/mpas_cdg_advection/src/operators/mpas_vector_reconstruction.F 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/operators/mpas_vector_reconstruction.F 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,3 +1,15 @@
+!***********************************************************************
+!
+! mpas_vector_reconstruction
+!
+!> \brief MPAS Vector reconstruction module
+!> \author Xylar Asay-Davis, Todd Ringler
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> This module provides routines for performing vector reconstruction from edges to cell centers.
+!
+!-----------------------------------------------------------------------
module mpas_vector_reconstruction
use mpas_grid_types
@@ -11,19 +23,25 @@
contains
- subroutine mpas_init_reconstruct(grid)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: pre-compute coefficients used by the reconstruct() routine
- !
- ! Input: grid meta data
- !
- ! Output: grid % coeffs_reconstruct - coefficients used to reconstruct
- ! velocity vectors at cell centers
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!***********************************************************************
+!
+! routine mpas_init_reconstruct
+!
+!> \brief MPAS Vector reconstruction initialization routine
+!> \author Xylar Asay-Davis, Todd Ringler
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> Purpose: pre-compute coefficients used by the reconstruct() routine
+!> Input: grid meta data
+!> Output: grid % coeffs_reconstruct - coefficients used to reconstruct
+!> velocity vectors at cell centers
+!-----------------------------------------------------------------------
+ subroutine mpas_init_reconstruct(grid)!{{{
implicit none
- type (mesh_type), intent(inout) :: grid
+ type (mesh_type), intent(inout) :: grid !< Input/Output: Grid information
! temporary arrays needed in the (to be constructed) init procedure
integer :: nCellsSolve
@@ -110,23 +128,32 @@
deallocate(edgeOnCellNormals)
deallocate(coeffs)
- end subroutine mpas_init_reconstruct
+ end subroutine mpas_init_reconstruct!}}}
- subroutine mpas_reconstruct(grid, u, uReconstructX, uReconstructY, uReconstructZ, uReconstructZonal, uReconstructMeridional)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Purpose: reconstruct vector field at cell centers based on radial basis functions
- !
- ! Input: grid meta data and vector component data residing at cell edges
- !
- ! Output: reconstructed vector field (measured in X,Y,Z) located at cell centers
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!***********************************************************************
+!
+! routine mpas_reconstruct
+!
+!> \brief MPAS Vector reconstruction routine
+!> \author Xylar Asay-Davis, Todd Ringler
+!> \date 03/28/13
+!> \version SVN:$Id$
+!> \details
+!> Purpose: reconstruct vector field at cell centers based on radial basis functions
+!> Input: grid meta data and vector component data residing at cell edges
+!> Output: reconstructed vector field (measured in X,Y,Z) located at cell centers
+!-----------------------------------------------------------------------
+ subroutine mpas_reconstruct(grid, u, uReconstructX, uReconstructY, uReconstructZ, uReconstructZonal, uReconstructMeridional)!{{{
implicit none
- type (mesh_type), intent(in) :: grid
- real (kind=RKIND), dimension(:,:), intent(in) :: u
- real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructX, uReconstructY, uReconstructZ
- real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructZonal, uReconstructMeridional
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+ real (kind=RKIND), dimension(:,:), intent(in) :: u !< Input: Velocity field on edges
+ real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructX !< Output: X Component of velocity reconstructed to cell centers
+ real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructY !< Output: Y Component of velocity reconstructed to cell centers
+ real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructZ !< Output: Z Component of velocity reconstructed to cell centers
+ real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructZonal !< Output: Zonal Component of velocity reconstructed to cell centers
+ real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructMeridional !< Output: Meridional Component of velocity reconstructed to cell centers
! temporary arrays needed in the compute procedure
integer :: nCellsSolve
@@ -191,6 +218,6 @@
uReconstructMeridional = uReconstructY
end if
- end subroutine mpas_reconstruct
+ end subroutine mpas_reconstruct!}}}
end module mpas_vector_reconstruction
Modified: branches/mpas_cdg_advection/src/registry/Makefile
===================================================================
--- branches/mpas_cdg_advection/src/registry/Makefile 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/registry/Makefile 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,14 +1,17 @@
.SUFFIXES: .c .o
-OBJS = parse.o dictionary.o gen_inc.o fortprintf.o
+OBJS = parse.o dictionary.o gen_inc.o fortprintf.o ezxml/ezxml.o
all: parse
+ezxml/ezxml.o:
+ (cd ezxml; $(CC) -c ezxml.c)
+
parse: $(OBJS)
$(CC) -o $@ $(OBJS)
clean:
- $(RM) *.o parse
+ $(RM) *.o ezxml/*.o parse
.c.o:
$(CC) -c $<
Copied: branches/mpas_cdg_advection/src/registry/Registry.xsd (from rev 2782, trunk/mpas/src/registry/Registry.xsd)
===================================================================
--- branches/mpas_cdg_advection/src/registry/Registry.xsd (rev 0)
+++ branches/mpas_cdg_advection/src/registry/Registry.xsd 2013-04-22 01:31:32 UTC (rev 2783)
@@ -0,0 +1,125 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" elementFormDefault="qualified" attributeFormDefault="unqualified" >
+ <xs:element name="registry" >
+ <xs:complexType>
+ <xs:sequence>
+ <!-- The dims element contains all dimensions -->
+ <xs:element name="dims" >
+ <xs:complexType>
+ <xs:sequence>
+ <!-- Each dimension is an independent child of the <dims></dims> element. -->
+ <xs:element name="dim" maxOccurs="unbounded" >
+ <xs:complexType>
+ <!-- The name attribute should specify the name of the dimension. -->
+ <xs:attribute name="name" type="xs:string" use="required"/>
+ <!-- The definition attribute is used to define a dimension based on other pre-defined dimensions -->
+ <xs:attribute name="definition" type="xs:string" use="optional"/>
+ <!-- The units attribute defines the units of the dimension. -->
+ <xs:attribute name="units" type="xs:string" use="optional"/>
+ <!-- The description attribute describes the dimensions. -->
+ <xs:attribute name="description" type="xs:string" use="optional"/>
+ </xs:complexType>
+ </xs:element>
+ </xs:sequence>
+ </xs:complexType>
+ </xs:element>
+ <!-- The nml_record element contains all namelist options for a particular namelist record -->
+ <xs:element name="nml_record" maxOccurs="unbounded" >
+ <xs:complexType>
+ <xs:sequence>
+ <!-- The nml_option element defines a particular namelist option that lives within the defined nml_record -->
+ <xs:element name="nml_option" maxOccurs="unbounded" >
+ <xs:complexType>
+ <!-- The name attribute defines the name of the namelist option. This is how it would look in a namelist file. -->
+ <xs:attribute name="name" type="xs:string" use="required"/>
+ <!-- The type attribute defines the type of the particular namelist option. Options are real, integer, character, and logical. -->
+ <xs:attribute name="type" type="xs:string" use="required"/>
+ <!-- The default_value attribute defines the default value of the namelist option. This is used if the option is omitted from a namelist file. -->
+ <xs:attribute name="default_value" type="xs:string" use="required"/>
+ <!-- The units attribute defines the units for the particular namelist option. -->
+ <xs:attribute name="units" type="xs:string" use="optional"/>
+ <!-- The description attribute describes the namelist option. -->
+ <xs:attribute name="description" type="xs:string" use="optional"/>
+ <!-- The possible_values attribute defines what values are allowable for the namelist option. -->
+ <xs:attribute name="possible_values" type="xs:string" use="optional"/>
+ </xs:complexType>
+ </xs:element>
+ </xs:sequence>
+ <!-- The name attribute defines the name of the namelist record. This would be seen as &name in the actual namelist. -->
+ <xs:attribute name="name" type="xs:string" use="required"/>
+ </xs:complexType>
+ </xs:element>
+ <!-- The var_struct element defines a grouping of variables. This is similar to mesh, or state and lives at the domain % blocklist level. -->
+ <xs:element name="var_struct" maxOccurs="unbounded" >
+ <xs:complexType>
+ <xs:sequence>
+ <!-- The var_array element defines an array of variables.
+ Within the code all constituent variables are merged into a one higher dimension array, for ease of use.
+ When written to the output file, they will be named their individual names. -->
+ <xs:element name="var_array" maxOccurs="unbounded" minOccurs="0" >
+ <xs:complexType>
+ <xs:sequence>
+ <!-- This specific var element defines a variable that is a constituent to a particular var_array group. -->
+ <xs:element name="var" maxOccurs="unbounded" minOccurs="0" >
+ <xs:complexType>
+ <!-- The name attribute is the name of the variable. This how it will be displayed in the output file. -->
+ <xs:attribute name="name" type="xs:string" use="required"/>
+ <!-- The array_group attribute is used to group variables within the var_array for ease of use. -->
+ <xs:attribute name="array_group" type="xs:string" use="required"/>
+ <!-- The streams attribute defines the streams this variable is included in. Allowable values are omitted, i, r, o and any combination of i, r, and o. -->
+ <xs:attribute name="streams" type="xs:string" use="optional"/>
+ <!-- The name_in_code attribute defines the name of the variable in the code, if it should be different then in the input/output/restart streams. -->
+ <xs:attribute name="name_in_code" type="xs:string" use="optional"/>
+ <!-- The units attribute defines the units of the particular variable -->
+ <xs:attribute name="units" type="xs:string" use="optional"/>
+ <!-- The description attribute describes the particular variable -->
+ <xs:attribute name="description" type="xs:string" use="optional"/>
+ </xs:complexType>
+ </xs:element>
+ </xs:sequence>
+ <!-- The name attribute is the name of the var_array that will be seen in the code. -->
+ <xs:attribute name="name" type="xs:string" use="required"/>
+ <!-- The type attribute defines the type of all constituents for the var_array. Valid options are real, integer, logical, and character -->
+ <xs:attribute name="type" type="xs:string" use="required"/>
+ <!-- The dimensions attribute defines the dimensions of each individual constituent. This does not include the collapsed dimension. -->
+ <xs:attribute name="dimensions" type="xs:string" use="required"/>
+ <!-- The persistence attribute determines if the var_array is persistence or scratch. Valid options are persistent, and scratch. -->
+ <xs:attribute name="persistence" type="xs:string" use="optional"/>
+ </xs:complexType>
+ </xs:element>
+ <!-- This var element defines a variable that does not live within a var_array group. -->
+ <xs:element name="var" maxOccurs="unbounded" minOccurs="0" >
+ <xs:complexType>
+ <!-- The name attribute defines the name in the NetCDF files of this variable. -->
+ <xs:attribute name="name" type="xs:string" use="required"/>
+ <!-- The type attribute defines the type within MPAS of the variable. -->
+ <xs:attribute name="type" type="xs:string" use="required"/>
+ <!-- The dimensions attribute defines the dimensions of the variable. -->
+ <xs:attribute name="dimensions" type="xs:string" use="required"/>
+ <!-- The streams attribute defines the streams this variable is included in. -->
+ <xs:attribute name="streams" type="xs:string" use="optional"/>
+ <!-- The name_in_code attribute defines the name of the variable within MPAS (if different from name). -->
+ <xs:attribute name="name_in_code" type="xs:string" use="optional"/>
+ <!-- The units attribute defines the units of the variable. -->
+ <xs:attribute name="units" type="xs:string" use="optional"/>
+ <!-- The description attribute provides a brief description of the variable. -->
+ <xs:attribute name="description" type="xs:string" use="optional"/>
+ </xs:complexType>
+ </xs:element>
+ </xs:sequence>
+ <!-- The name attribute defines the name of the var_struct. This would be similar to mesh, or state. -->
+ <xs:attribute name="name" type="xs:string" use="required"/>
+ <!-- The time_levs attribute defines the number of time levels this var_struct contains. -->
+ <xs:attribute name="time_levs" type="xs:int" use="required"/>
+ </xs:complexType>
+ </xs:element>
+ </xs:sequence>
+ <!-- The model attribute defines the name of the model that is being run. Typically this will be MPAS. It will be written to all output files as a global attribute. -->
+ <xs:attribute name="model" type="xs:string" use="required"/>
+ <!-- The core attribute defines the core a Registry.xml file belongs to. It will be written to all output files as a global attribute. -->
+ <xs:attribute name="core" type="xs:string" use="required"/>
+ <!-- The version attribute defines the version of the model/core combination. It will be written to all output files as a global attribute. -->
+ <xs:attribute name="version" type="xs:string" use="required"/>
+ </xs:complexType>
+ </xs:element>
+</xs:schema>
Modified: branches/mpas_cdg_advection/src/registry/gen_inc.c
===================================================================
--- branches/mpas_cdg_advection/src/registry/gen_inc.c 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/registry/gen_inc.c 2013-04-22 01:31:32 UTC (rev 2783)
@@ -169,7 +169,18 @@
fclose(fd);
}
+void gen_history_attributes(char * modelname, char * corename, char * version)
+{
+ FILE *fd;
+ fd = fopen("model_variables.inc","w");
+ fortprintf(fd, " character (len=StrKIND) :: modelName = '%s' !< Constant: Name of model</font>
<font color="blue">", modelname);
+ fortprintf(fd, " character (len=StrKIND) :: coreName = '%s' !< Constant: Name of core</font>
<font color="blue">", corename);
+ fortprintf(fd, " character (len=StrKIND) :: modelVersion = '%s' !< Constant: Version number</font>
<font color="gray">", version);
+ fclose(fd);
+}
+
+
void gen_field_defs(struct group_list * groups, struct variable * vars, struct dimension * dims)
{
struct variable * var_ptr;
@@ -822,8 +833,10 @@
fortprintf(fd, " %s %% %s %% isSuperArray = .false.</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->ndims > 0) {
if(var_ptr->persistence == SCRATCH){
+ fortprintf(fd, " %s %% %s %% isPersistent = .false.</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " nullify(%s %% %s %% array)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
} else if(var_ptr->persistence == PERSISTENT){
+ fortprintf(fd, " %s %% %s %% isPersistent = .true.</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " allocate(%s %% %s %% array(", group_ptr->name, var_ptr->name_in_code);
dimlist_ptr = var_ptr->dimlist;
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
@@ -1161,7 +1174,10 @@
for(i=1; i<=ntime_levs; i++)
{
fortprintf(fd, " if(associated(next) .and. associated(prev)) then</font>
<font color="red">");
- fortprintf(fd, " call mpas_create_%s_links(b %% %s %% time_levs(%i) %% %s, prev = prev %% %s %% time_levs(%i) %% %s, next = next %% %s %% time_levs(%i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name, i, group_ptr->name, i, group_ptr->name, group_ptr->name, i, group_ptr->name);
+// fortprintf(fd, " call mpas_create_%s_links(b %% %s %% time_levs(%i) %% %s, prev = prev %% %s %% time_levs(%i) %% %s, next = next %% %s %% time_levs(%i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name, i, group_ptr->name, i, group_ptr->name, group_ptr->name, i, group_ptr->name);
+ fortprintf(fd, " call mpas_create_%s_links(b %% %s %% time_levs(%i) %% %s, ", group_ptr->name, group_ptr->name, i, group_ptr->name, i);
+ fortprintf(fd, " prev = prev %% %s %% time_levs(%i) %% %s,", group_ptr->name, i, group_ptr->name);
+ fortprintf(fd, " next = next %% %s %% time_levs(%i) %% %s)</font>
<font color="black">", group_ptr->name, i, group_ptr->name);
fortprintf(fd, " else if(associated(next)) then</font>
<font color="black">");
fortprintf(fd, " call mpas_create_%s_links(b %% %s %% time_levs(%i) %% %s, next = next %% %s %% time_levs(%i) %% %s)</font>
<font color="black">", group_ptr->name, group_ptr->name, i, group_ptr->name, group_ptr->name, i, group_ptr->name);
fortprintf(fd, " else if(associated(prev)) then</font>
<font color="gray">");
@@ -1389,7 +1405,7 @@
void gen_reads(struct group_list * groups, struct variable * vars, struct dimension * dims)
{
struct variable * var_ptr;
- struct variable_list * var_list_ptr;
+ struct variable_list * var_list_ptr, *var_list_ptr2;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr, * lastdim;
struct group_list * group_ptr;
@@ -2119,8 +2135,10 @@
/* fortprintf(fd, " write(0,*) \'adding input field %s\'</font>
<font color="black">", var_ptr->super_array); */
fortprintf(fd, " call MPAS_streamAddField(input_obj %% io_stream, %s %% %s, nferr)</font>
<font color="blue">", struct_deref, var_ptr->super_array);
while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
+ var_list_ptr2 = var_list_ptr;
var_list_ptr = var_list_ptr->next;
}
+ var_list_ptr = var_list_ptr2;
}
else {
fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. input_obj %% stream == STREAM_INPUT) .or. &</font>
<font color="gray">", struct_deref, var_ptr->name_in_code);
@@ -2176,8 +2194,10 @@
/* fortprintf(fd, " write(0,*) \'exchange halo for %s\'</font>
<font color="black">", var_ptr->super_array); */
fortprintf(fd, " call mpas_dmpar_exch_halo_field(%s %% %s)</font>
<font color="blue">", struct_deref, var_ptr->super_array);
while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
+ var_list_ptr2 = var_list_ptr;
var_list_ptr = var_list_ptr->next;
}
+ var_list_ptr = var_list_ptr2;
}
else {
fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. input_obj %% stream == STREAM_INPUT) .or. &</font>
<font color="gray">", struct_deref, var_ptr->name_in_code);
@@ -2383,7 +2403,7 @@
void gen_writes(struct group_list * groups, struct variable * vars, struct dimension * dims, struct namelist * namelists)
{
struct variable * var_ptr;
- struct variable_list * var_list_ptr;
+ struct variable_list * var_list_ptr, *var_list_ptr2;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr, * lastdim;
struct group_list * group_ptr;
@@ -2565,8 +2585,10 @@
memcpy(super_array, var_ptr->super_array, 1024);
fortprintf(fd, " call MPAS_streamAddField(output_obj %% io_stream, %s %% %s, ierr)</font>
<font color="blue">", struct_deref, super_array);
while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
+ var_list_ptr2 = var_list_ptr;
var_list_ptr = var_list_ptr->next;
}
+ var_list_ptr = var_list_ptr2;
}
else {
fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="gray">", struct_deref, var_ptr->name_in_code);
Modified: branches/mpas_cdg_advection/src/registry/gen_inc.h
===================================================================
--- branches/mpas_cdg_advection/src/registry/gen_inc.h 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/registry/gen_inc.h 2013-04-22 01:31:32 UTC (rev 2783)
@@ -1,4 +1,5 @@
void gen_namelists(struct namelist *);
+void gen_history_attributes(char * modelname, char * corename, char * version);
void gen_field_defs(struct group_list * groups, struct variable *, struct dimension *);
void gen_reads(struct group_list * groups, struct variable *, struct dimension *);
void gen_writes(struct group_list * groups, struct variable *, struct dimension *, struct namelist *);
Modified: branches/mpas_cdg_advection/src/registry/parse.c
===================================================================
--- branches/mpas_cdg_advection/src/registry/parse.c 2013-04-19 20:21:24 UTC (rev 2782)
+++ branches/mpas_cdg_advection/src/registry/parse.c 2013-04-22 01:31:32 UTC (rev 2783)
@@ -3,6 +3,7 @@
#include <string.h>
#include "registry_types.h"
#include "gen_inc.h"
+#include "ezxml/ezxml.h"
int parse_reg(FILE *, struct namelist **, struct dimension **, struct variable **, struct group_list **);
int getword(FILE *, char *);
@@ -18,6 +19,8 @@
struct variable * vars;
struct group_list * groups;
+ char modelname[1024], corename[1024], version[1024];
+
if (argc != 2) {
fprintf(stderr,"Reading registry file from standard input</font>
<font color="gray">");
regfile = stdin;
@@ -30,13 +33,21 @@
nls = NULL;
dims = NULL;
vars = NULL;
+
+ if (parse_reg_xml(regfile, &nls, &dims, &vars, &groups, &modelname, &corename, &version)) {
+ return 1;
+ }
+
+/* Old Parser
if (parse_reg(regfile, &nls, &dims, &vars, &groups)) {
return 1;
}
+*/
sort_vars(vars);
sort_group_vars(groups);
+ gen_history_attributes(modelname, corename, version);
gen_namelists(nls);
gen_field_defs(groups, vars, dims);
gen_reads(groups, vars, dims);
@@ -45,7 +56,412 @@
return 0;
}
+int parse_reg_xml(FILE * regfile, struct namelist **nls, struct dimension ** dims, struct variable ** vars, struct group_list ** groups, char * modelname, char * corename, char * version)
+{
+ struct namelist * nls_ptr, *nls_ptr2;
+ struct namelist * nls_chk_ptr;
+ struct dimension * dim_ptr, *dim_ptr2;
+ struct variable * var_ptr, *var_ptr2;
+ struct dimension_list * dimlist_ptr;
+ struct dimension * dimlist_cursor;
+ struct group_list * grouplist_ptr;
+ struct variable_list * vlist_cursor;
+ ezxml_t registry = ezxml_parse_fp(regfile);
+ ezxml_t dims_xml, dim_xml;
+ ezxml_t structs_xml, var_arr_xml, var_xml;
+ ezxml_t nmlrecs_xml, nmlopt_xml;
+
+ const char *dimname, *dimunits, *dimdesc, *dimdef;
+ const char *nmlrecname, *nmloptname, *nmlopttype, *nmloptval, *nmloptunits, *nmloptdesc, *nmloptposvals;
+ const char *structname, *structlevs;
+ const char *vararrname, *vararrtype, *vararrdims, *vararrpersistence;
+ const char *varname, *varpersistence, *vartype, *vardims, *varunits, *vardesc, *vararrgroup, *varstreams;
+ const char *varname_in_code;
+ const char *const_model, *const_core, *const_version;
+
+ char dimensions[2048];
+ char *dimension_list;
+ char dimension_buffer[128];
+ char streams_buffer[128];
+
+ NEW_NAMELIST(nls_ptr)
+ NEW_DIMENSION(dim_ptr)
+ NEW_VARIABLE(var_ptr)
+ NEW_GROUP_LIST(grouplist_ptr);
+ *nls = nls_ptr;
+ *dims = dim_ptr;
+ *vars = var_ptr;
+ *groups = grouplist_ptr;
+
+ // Get model information
+ const_model = ezxml_attr(registry, "model");
+ const_core = ezxml_attr(registry, "core");
+ const_version = ezxml_attr(registry, "version");
+
+ if(const_model == NULL)
+ sprintf(modelname, "MISSING");
+ else
+ sprintf(modelname, "%s", const_model);
+
+ if(const_core == NULL)
+ sprintf(corename, "MISSING");
+ else
+ sprintf(corename, "%s", const_core);
+
+ if(const_version == NULL)
+ sprintf(version, "MISSING");
+ else
+ sprintf(version, "%s", const_version);
+
+ // Parse Namelist Records
+ for (nmlrecs_xml = ezxml_child(registry, "nml_record"); nmlrecs_xml; nmlrecs_xml = nmlrecs_xml->next){
+ nmlrecname = ezxml_attr(nmlrecs_xml, "name");
+ for (nmlopt_xml = ezxml_child(nmlrecs_xml, "nml_option"); nmlopt_xml; nmlopt_xml = nmlopt_xml->next){
+ nmloptname = ezxml_attr(nmlopt_xml, "name");
+ nmlopttype = ezxml_attr(nmlopt_xml, "type");
+ nmloptval = ezxml_attr(nmlopt_xml, "default_value");
+ nmloptunits = ezxml_attr(nmlopt_xml, "units");
+ nmloptdesc = ezxml_attr(nmlopt_xml, "description");
+ nmloptposvals = ezxml_attr(nmlopt_xml, "possible_values");
+
+ snprintf(nls_ptr->record, 1024, "%s", nmlrecname);
+ snprintf(nls_ptr->name, 1024, "%s", nmloptname);
+
+ if(strncmp(nmlopttype, "real", 1024) == 0){
+ nls_ptr->vtype = REAL;
+ } else if(strncmp(nmlopttype, "integer", 1024) == 0){
+ nls_ptr->vtype = INTEGER;
+ } else if(strncmp(nmlopttype, "logical", 1024) == 0){
+ nls_ptr->vtype = LOGICAL;
+ } else if(strncmp(nmlopttype, "character", 1024) == 0){
+ nls_ptr->vtype = CHARACTER;
+ }
+
+ switch(nls_ptr->vtype){
+ case REAL:
+ nls_ptr->defval.rval = (float)atof(nmloptval);
+ break;
+ case INTEGER:
+ nls_ptr->defval.ival = atoi(nmloptval);
+ break;
+ case LOGICAL:
+ if(strncmp(nmloptval, "true", 1024) ==0){
+ nls_ptr->defval.lval = 1;
+ } else if (strncmp(nmloptval, "false", 1024) == 0){
+ nls_ptr->defval.lval = 0;
+ }
+ break;
+ case CHARACTER:
+ snprintf(nls_ptr->defval.cval, 32, "%s", nmloptval);
+ break;
+ }
+
+ NEW_NAMELIST(nls_ptr->next)
+ nls_ptr2 = nls_ptr;
+ nls_ptr = nls_ptr->next;
+ }
+ }
+
+ if(nls_ptr2->next) free(nls_ptr2->next);
+ nls_ptr2->next = NULL;
+
+ // Parse Dimensions
+ for (dims_xml = ezxml_child(registry, "dims"); dims_xml; dims_xml = dims_xml->next){
+ for (dim_xml = ezxml_child(dims_xml, "dim"); dim_xml; dim_xml = dim_xml->next){
+ dimname = ezxml_attr(dim_xml, "name");
+ dimdef = ezxml_attr(dim_xml, "definition");
+ dimunits = ezxml_attr(dim_xml, "units");
+ dimdesc = ezxml_attr(dim_xml, "description");
+
+ dim_ptr->namelist_defined = 0;
+
+ snprintf(dim_ptr->name_in_file, 1024, "%s", dimname);
+ if(dimdef == NULL){
+ snprintf(dim_ptr->name_in_code, 1024, "%s", dimname);
+ dim_ptr->constant_value = -1;
+ } else {
+ snprintf(dim_ptr->name_in_code, 1024, "%s", dimdef);
+ // Check namelist defined ??
+ dim_ptr->constant_value = is_integer_constant(dim_ptr->name_in_code);
+ if(strncmp(dim_ptr->name_in_code, "namelist:", 9) == 0) {
+ dim_ptr->namelist_defined = 1;
+ snprintf(dim_ptr->name_in_code, 1024, "%s", (dim_ptr->name_in_code)+9);
+
+ /* Check that the referenced namelist variable is defined as an integer variable */
+ nls_chk_ptr = (*nls)->next;
+ while (nls_chk_ptr) {
+ if (strncmp(nls_chk_ptr->name, dim_ptr->name_in_code, 1024) == 0) {
+ if (nls_chk_ptr->vtype != INTEGER) {
+ printf("</font>
<font color="black">Registry error: Namelist variable %s must be an integer for namelist-derived dimension %s</font>
<font color="black"></font>
<font color="blue">", nls_chk_ptr->name, dim_ptr->name_in_file);
+ return 1;
+ }
+ break;
+ }
+ nls_chk_ptr = nls_chk_ptr->next;
+ }
+ if (!nls_chk_ptr) {
+ printf("</font>
<font color="black">Registry error: Namelist variable %s not defined for namelist-derived dimension %s</font>
<font color="black"></font>
<font color="blue">", dim_ptr->name_in_code, dim_ptr->name_in_file);
+ return 1;
+ }
+
+ }
+ }
+
+ NEW_DIMENSION(dim_ptr->next)
+ dim_ptr2 = dim_ptr;
+ dim_ptr = dim_ptr->next;
+ }
+ }
+
+ if(dim_ptr2->next) free(dim_ptr2->next);
+ dim_ptr2->next = NULL;
+
+ // Parse Variable Structures
+ for(structs_xml = ezxml_child(registry, "var_struct"); structs_xml; structs_xml = structs_xml->next){
+ structname = ezxml_attr(structs_xml, "name");
+ structlevs = ezxml_attr(structs_xml, "time_levs");
+
+ grouplist_ptr = *groups;
+ while(grouplist_ptr->next) grouplist_ptr = grouplist_ptr->next;
+ NEW_GROUP_LIST(grouplist_ptr->next);
+ grouplist_ptr = grouplist_ptr->next;
+ snprintf(grouplist_ptr->name, 1024, "%s", structname);
+ vlist_cursor = NULL;
+
+ // Parse variable arrays
+ for(var_arr_xml = ezxml_child(structs_xml, "var_array"); var_arr_xml; var_arr_xml = var_arr_xml->next){
+ vararrname = ezxml_attr(var_arr_xml, "name");
+ vararrtype = ezxml_attr(var_arr_xml, "type");
+ vararrdims = ezxml_attr(var_arr_xml, "dimensions");
+ vararrpersistence = ezxml_attr(var_arr_xml, "persistence");
+
+ //Parse variables in variable arrays
+ for(var_xml = ezxml_child(var_arr_xml, "var"); var_xml; var_xml = var_xml->next){
+ varname = ezxml_attr(var_xml, "name");
+ varunits = ezxml_attr(var_xml, "units");
+ vardesc = ezxml_attr(var_xml, "description");
+ varstreams = ezxml_attr(var_xml, "streams");
+ vararrgroup = ezxml_attr(var_xml, "array_group");
+ varname_in_code = ezxml_attr(var_xml, "name_in_code");
+
+ if(vlist_cursor == NULL){
+ NEW_VARIABLE_LIST(grouplist_ptr->vlist);
+ vlist_cursor = grouplist_ptr->vlist;
+ } else {
+ NEW_VARIABLE_LIST(vlist_cursor->next);
+ vlist_cursor->next->prev = vlist_cursor;
+ vlist_cursor = vlist_cursor->next;
+ }
+ vlist_cursor->var = var_ptr;
+ vlist_cursor->next = NULL;
+
+ var_ptr->ndims = 0;
+ var_ptr->timedim = 0;
+ var_ptr->iostreams = 0;
+
+ snprintf(var_ptr->name_in_file, 1024, "%s", varname);
+
+ if(vararrpersistence == NULL){
+ var_ptr->persistence = PERSISTENT;
+ } else {
+ if(strncmp(vararrpersistence, "persistent", 1024) == 0){
+ var_ptr->persistence = PERSISTENT;
+ } else if(strncmp(vararrpersistence, "scratch", 1024) == 0){
+ var_ptr->persistence = SCRATCH;
+ }
+ }
+
+ if(strncmp(vararrtype, "real", 1024) == 0){
+ var_ptr->vtype = REAL;
+ } else if(strncmp(vararrtype, "integer", 1024) == 0){
+ var_ptr->vtype = INTEGER;
+ } else if(strncmp(vararrtype, "logical", 1024) == 0){
+ var_ptr->vtype = LOGICAL;
+ } else if(strncmp(vararrtype, "text", 1024) == 0){
+ var_ptr->vtype = CHARACTER;
+ }
+
+ NEW_DIMENSION_LIST(dimlist_ptr)
+ var_ptr->dimlist = dimlist_ptr;
+
+ snprintf(dimensions,2048, "%s", vararrdims);
+ dimension_list = strtok(dimensions, " ");
+ while(dimension_list != NULL){
+ snprintf(dimension_buffer, 128, "%s", dimension_list);
+ if(strncmp(dimension_buffer, "Time", 1024) == 0){
+ var_ptr->timedim = 1;
+ } else {
+ NEW_DIMENSION_LIST(dimlist_ptr->next)
+ dimlist_ptr->next->prev = dimlist_ptr;
+ dimlist_ptr = dimlist_ptr->next;
+
+ dimlist_cursor = (*dims);
+ while(dimlist_cursor && (strncmp(dimension_buffer, dimlist_cursor->name_in_file, 1024) != 0)){
+ dimlist_cursor = dimlist_cursor->next;
+ }
+ if (dimlist_cursor) {
+ dimlist_ptr->dim = dimlist_cursor;
+ } else {
+ fprintf(stderr, "Error: Unknown dimension %s for variable %s</font>
<font color="blue">", dimension_buffer, var_ptr->name_in_file);
+ return 1;
+ }
+ var_ptr->ndims++;
+ }
+ dimension_list = strtok(NULL, " ");
+ }
+ dimlist_ptr = var_ptr->dimlist;
+ if(var_ptr->dimlist) var_ptr->dimlist = var_ptr->dimlist->next;
+ free(dimlist_ptr);
+
+ var_ptr->ntime_levs = atoi(structlevs);
+
+ if(varstreams != NULL){
+ snprintf(streams_buffer, 128, "%s", varstreams);
+ if(strchr(streams_buffer, (int)'i')) var_ptr->iostreams |= INPUT0;
+ if(strchr(streams_buffer, (int)'s')) var_ptr->iostreams |= SFC0;
+ if(strchr(streams_buffer, (int)'r')) var_ptr->iostreams |= RESTART0;
+ if(strchr(streams_buffer, (int)'o')) var_ptr->iostreams |= OUTPUT0;
+ }
+
+ if(varname_in_code == NULL){
+ snprintf(var_ptr->name_in_code, 1024, "%s", varname);
+ } else {
+ snprintf(var_ptr->name_in_code, 1024, "%s", varname_in_code);
+ }
+
+ snprintf(var_ptr->super_array, 1024, "%s", vararrname);
+ snprintf(var_ptr->array_class, 1024, "%s", vararrgroup);
+
+ NEW_VARIABLE(var_ptr->next);
+ var_ptr2 = var_ptr;
+ var_ptr = var_ptr->next;
+ }
+ }
+
+ for(var_xml = ezxml_child(structs_xml, "var"); var_xml; var_xml = var_xml->next){
+ varname = ezxml_attr(var_xml, "name");
+ varpersistence = ezxml_attr(var_xml, "persistence");
+ vartype = ezxml_attr(var_xml, "type");
+ vardims = ezxml_attr(var_xml, "dimensions");
+ varunits = ezxml_attr(var_xml, "units");
+ vardesc = ezxml_attr(var_xml, "description");
+ varstreams = ezxml_attr(var_xml, "streams");
+ varname_in_code = ezxml_attr(var_xml, "name_in_code");
+
+ if(vlist_cursor == NULL){
+ NEW_VARIABLE_LIST(grouplist_ptr->vlist);
+ vlist_cursor = grouplist_ptr->vlist;
+ } else {
+ NEW_VARIABLE_LIST(vlist_cursor->next);
+ vlist_cursor->next->prev = vlist_cursor;
+ vlist_cursor = vlist_cursor->next;
+ }
+ vlist_cursor->var = var_ptr;
+ vlist_cursor->next = NULL;
+
+ var_ptr->ndims = 0;
+ var_ptr->timedim = 0;
+ var_ptr->iostreams = 0;
+
+ snprintf(var_ptr->name_in_file, 1024, "%s", varname);
+
+ if(varpersistence == NULL){
+ var_ptr->persistence = PERSISTENT;
+ } else {
+ if(strncmp(varpersistence, "persistent", 1024) == 0){
+ var_ptr->persistence = PERSISTENT;
+ } else if(strncmp(varpersistence, "scratch", 1024) == 0){
+ var_ptr->persistence = SCRATCH;
+ }
+ }
+
+ if(strncmp(vartype, "real", 1024) == 0){
+ var_ptr->vtype = REAL;
+ } else if(strncmp(vartype, "integer", 1024) == 0){
+ var_ptr->vtype = INTEGER;
+ } else if(strncmp(vartype, "logical", 1024) == 0){
+ var_ptr->vtype = LOGICAL;
+ } else if(strncmp(vartype, "text", 1024) == 0){
+ var_ptr->vtype = CHARACTER;
+ }
+
+ NEW_DIMENSION_LIST(dimlist_ptr)
+ var_ptr->dimlist = dimlist_ptr;
+
+ snprintf(dimensions, 2048, "%s", vardims);
+ dimension_list = strtok(dimensions, " ");
+ while(dimension_list != NULL){
+ snprintf(dimension_buffer, 128, "%s", dimension_list);
+ if(strncmp(dimension_buffer, "Time", 1024) == 0){
+ var_ptr->timedim = 1;
+ } else {
+ NEW_DIMENSION_LIST(dimlist_ptr->next)
+ dimlist_ptr->next->prev = dimlist_ptr;
+ dimlist_ptr = dimlist_ptr->next;
+
+ dimlist_cursor = (*dims);
+ while(dimlist_cursor && (strncmp(dimension_buffer, dimlist_cursor->name_in_file, 1024) != 0) )
+ dimlist_cursor = dimlist_cursor->next;
+ if (dimlist_cursor) {
+ dimlist_ptr->dim = dimlist_cursor;
+ } else {
+ fprintf(stderr, "Error: Unknown dimension %s for variable %s</font>
<font color="gray">", dimension_buffer, var_ptr->name_in_file);
+ return 1;
+ }
+ var_ptr->ndims++;
+ }
+ dimension_list = strtok(NULL, " ");
+ }
+
+ dimlist_ptr = var_ptr->dimlist;
+ if(var_ptr->dimlist) var_ptr->dimlist = var_ptr->dimlist->next;
+ free(dimlist_ptr);
+
+ var_ptr->ntime_levs = atoi(structlevs);
+
+ if(varstreams != NULL){
+ snprintf(streams_buffer, 128, "%s", varstreams);
+ if(strchr(streams_buffer, (int)'i')) {
+ var_ptr->iostreams |= INPUT0;
+ }
+ if(strchr(streams_buffer, (int)'s')) {
+ var_ptr->iostreams |= SFC0;
+ }
+ if(strchr(streams_buffer, (int)'r')) {
+ var_ptr->iostreams |= RESTART0;
+ }
+ if(strchr(streams_buffer, (int)'o')) {
+ var_ptr->iostreams |= OUTPUT0;
+ }
+ }
+
+ if(varname_in_code == NULL){
+ snprintf(var_ptr->name_in_code, 1024, "%s", varname);
+ } else {
+ snprintf(var_ptr->name_in_code, 1024, "%s", varname_in_code);
+ }
+
+ snprintf(var_ptr->super_array, 1024, "-");
+ snprintf(var_ptr->array_class, 1024, "-");
+
+ NEW_VARIABLE(var_ptr->next);
+ var_ptr2 = var_ptr;
+ var_ptr = var_ptr->next;
+ }
+ }
+
+ if(var_ptr2->next) free(var_ptr2->next);
+ var_ptr2->next = NULL;
+
+ grouplist_ptr = *groups;
+ if ((*groups)->next) *groups = (*groups)->next;
+ if (grouplist_ptr) free(grouplist_ptr);
+
+ return 0;
+}
+
+
int parse_reg(FILE * regfile, struct namelist ** nls, struct dimension ** dims, struct variable ** vars, struct group_list ** groups)
{
char word[1024];
@@ -228,7 +644,6 @@
vlist_cursor->var = var_ptr;
}
-
getword(regfile, var_ptr->super_array);
getword(regfile, var_ptr->array_class);
@@ -402,7 +817,7 @@
memcpy(super_array, var_ptr->var->super_array, 1024);
var_ptr2_prev = var_ptr;
var_ptr2 = var_ptr->next;
- if (var_ptr2 && strncmp(super_array, var_ptr2->var->super_array, 1024) != 0) {
+ if (var_ptr2 != NULL && strncmp(super_array, var_ptr2->var->super_array, 1024) != 0) {
while (var_ptr2) {
if (strncmp(super_array, var_ptr2->var->super_array, 1024) == 0) {
var_ptr2_prev->next = var_ptr2->next;
</font>
</pre>