<p><b>duda</b> 2013-03-26 17:03:26 -0600 (Tue, 26 Mar 2013)</p><p>BRANCH COMMIT<br>
<br>
Merge changes from the trunk, principally, the switch to an XML Registry file.<br>
</p><hr noshade><pre><font color="gray">Index: branches/atmos_physics
===================================================================
--- branches/atmos_physics 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics 2013-03-26 23:03:26 UTC (rev 2670)
Property changes on: branches/atmos_physics
___________________________________________________________________
Modified: svn:mergeinfo
## -2,15 +2,23 ##
/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
/branches/ocean_projects/imp_vert_mix_error:1847-1887
/branches/ocean_projects/imp_vert_mix_mrp:754-986
/branches/ocean_projects/leith_mrp:2182-2241
+/branches/ocean_projects/linear_eos:2435-2437
/branches/ocean_projects/monotonic_advection:1499-1640
/branches/ocean_projects/monthly_forcing:1810-1867
+/branches/ocean_projects/namelist_cleanup:2319-2414
/branches/ocean_projects/option3_b4b_test:2201-2231
/branches/ocean_projects/partial_bottom_cells:2172-2226
+/branches/ocean_projects/remove_sw_test_cases:2539-2540
/branches/ocean_projects/restart_reproducibility:2239-2272
+/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/vert_adv_mrp:704-745
## -21,6 +29,8 ##
/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:1371-2274
+/branches/xml_registry:2610-2662
+/trunk/mpas:1371-2666
\ No newline at end of property
Modified: branches/atmos_physics/Makefile
===================================================================
--- branches/atmos_physics/Makefile 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/Makefile 2013-03-26 23:03:26 UTC (rev 2670)
@@ -353,12 +353,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/atmos_physics/namelist.input.ocean
===================================================================
--- branches/atmos_physics/namelist.input.ocean 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/namelist.input.ocean 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,110 +1,163 @@
-&sw_model
- config_test_case = 0
- config_time_integration = 'split_explicit'
- config_rk_filter_btr_mode = .false.
- config_dt = 180.0
- config_start_time = '0000-01-01_00:00:00'
- config_run_duration = '1_00:00:00'
- config_stats_interval = 480
+&time_management
+ config_do_restart = .false.
+ config_start_time = '0000-01-01_00:00:00'
+ config_stop_time = 'none'
+ config_run_duration = '0_06:00:00'
+ config_calendar_type = '360day'
/
&io
- config_input_name = 'grid.nc'
- config_output_name = 'output.nc'
- config_restart_name = 'restart.nc'
- config_output_interval = '1_00:00:00'
- config_frames_per_outfile = 1000000
- config_pio_num_iotasks = 0
- config_pio_stride = 1
- config_write_output_on_startup = .true.
+ config_input_name = 'grid.nc'
+ config_output_name = 'output.nc'
+ config_restart_name = 'restart.nc'
+ config_restart_interval = '0_06:00:00'
+ config_output_interval = '0_06:00:00'
+ config_stats_interval = '0_01:00:00'
+ config_write_stats_on_startup = .true.
+ config_write_output_on_startup = .true.
+ config_frames_per_outfile = 1000
+ config_pio_num_iotasks = 0
+ config_pio_stride = 1
/
+&time_integration
+ config_dt = 3000.0
+ config_time_integrator = 'split_explicit'
+/
+&grid
+ config_num_halos = 3
+ config_vert_coord_movement = 'uniform_stretching'
+ config_alter_ICs_for_pbcs = 'zlevel_pbcs_off'
+ config_min_pbc_fraction = 0.10
+ config_check_ssh_consistency = .true.
+/
&decomposition
- config_number_of_blocks = 0
- config_block_decomp_file_prefix = 'graph.info.part.'
- config_explicit_proc_decomp = .false.
- config_proc_decomp_file_prefix = 'graph.info.part.'
+ config_block_decomp_file_prefix = 'graph.info.part.'
+ config_number_of_blocks = 0
+ config_explicit_proc_decomp = .false.
+ config_proc_decomp_file_prefix = 'graph.info.part.'
/
-&restart
- config_do_restart = .false.
- config_restart_interval = '120_00:00:00'
+&hmix
+ config_hmix_ScaleWithMesh = .false.
+ config_visc_vorticity_term = .true.
+ config_apvm_scale_factor = 0.0
/
-&grid
- config_vert_grid_type = 'isopycnal'
- config_pressure_type = 'pressure'
- config_rho0 = 1014.65
+&hmix_del2
+ config_use_mom_del2 = .false.
+ config_use_tracer_del2 = .false.
+ config_mom_del2 = 0.0
+ config_tracer_del2 = 0.0
+ config_vorticity_del2_scale = 1.0
/
-&partial_bottom_cells
- config_alter_ICs_for_pbcs = 'off'
- config_min_pbc_fraction = 0.10
- config_check_ssh_consistency = .true.
- config_check_zlevel_consistency = .false.
+&hmix_del4
+ config_use_mom_del4 = .true.
+ config_use_tracer_del4 = .false.
+ config_mom_del4 = 5.0e13
+ config_tracer_del4 = 0.0
+ config_vorticity_del4_scale = 1.0
/
-&split_explicit_ts
- config_n_ts_iter = 2
- config_n_bcl_iter_beg = 1
- config_n_bcl_iter_mid = 2
- config_n_bcl_iter_end = 2
- config_n_btr_subcycles = 10
- config_n_btr_cor_iter = 2
- config_u_correction = .true.
- config_filter_btr_mode = .false.
- config_btr_subcycle_loop_factor = 2
- config_btr_gam1_uWt1 = 0.5
- config_btr_gam2_SSHWt1 = 1.0
- config_btr_gam3_uWt2 = 1.0
- config_btr_solve_SSH2 = .false.
+&hmix_Leith
+ config_use_Leith_del2 = .false.
+ config_Leith_parameter = 1.0
+ config_Leith_dx = 15000.0
+ config_Leith_visc2_max = 2.5e3
/
-&hmix
- config_h_mom_eddy_visc2 = 100.0
- config_h_mom_eddy_visc4 = 0.0
- config_h_kappa = 0.0
- config_h_kappa_q = 0.0
- config_visc_vorticity_term = .true.
- config_h_tracer_eddy_diff2 = 1.0e5
- config_h_tracer_eddy_diff4 = 0.0
+&standard_GM
+ config_h_kappa = 0.0
+ config_h_kappa_q = 0.0
/
-&hmix_leith
- config_use_leith_del2 = .false.
- config_leith_parameter = 1.0
- config_leith_dx = 15000.0
- config_leith_visc2_max = 2.5e3
+&Rayleigh_damping
+ config_Rayleigh_friction = .false.
+ config_Rayleigh_damping_coeff = 0.0
/
&vmix
- config_vert_visc_type = 'const'
- config_vert_diff_type = 'const'
- config_implicit_vertical_mix = .true.
- config_convective_visc = 1.0
- config_convective_diff = 1.0
- config_bottom_drag_coeff = 1.0e-3
+ config_convective_visc = 1.0
+ config_convective_diff = 1.0
/
&vmix_const
- config_vert_visc = 1.0e-5
- config_vert_diff = 1.0e-5
+ config_use_const_visc = .false.
+ config_use_const_diff = .false.
+ config_vert_visc = 2.5e-4
+ config_vert_diff = 2.5e-5
/
&vmix_rich
- config_bkrd_vert_visc = 1.0e-5
- config_bkrd_vert_diff = 1.0e-5
- config_rich_mix = 0.005
+ config_use_rich_visc = .true.
+ config_use_rich_diff = .true.
+ config_bkrd_vert_visc = 1.0e-4
+ config_bkrd_vert_diff = 1.0e-5
+ config_rich_mix = 0.005
/
&vmix_tanh
- config_max_visc_tanh = 2.5e-1
- config_min_visc_tanh = 1.0e-4
- config_max_diff_tanh = 2.5e-2
- config_min_diff_tanh = 1.0e-5
- config_zMid_tanh = -100
- config_zWidth_tanh = 100
+ config_use_tanh_visc = .false.
+ config_use_tanh_diff = .false.
+ config_max_visc_tanh = 2.5e-1
+ config_min_visc_tanh = 1.0e-4
+ config_max_diff_tanh = 2.5e-2
+ config_min_diff_tanh = 1.0e-5
+ config_zMid_tanh = -100
+ config_zWidth_tanh = 100
/
-&eos
- config_eos_type = 'linear'
+&forcing
+ config_use_monthly_forcing = .false.
+ config_restoreTS = .false.
+ config_restoreT_timescale = 90.0
+ config_restoreS_timescale = 90.0
/
&advection
- config_vert_tracer_adv = 'stencil'
- config_vert_tracer_adv_order = 2
- config_horiz_tracer_adv_order = 2
- config_thickness_adv_order = 2
- config_monotonic = .false.
+ config_vert_tracer_adv = 'stencil'
+ config_vert_tracer_adv_order = 3
+ config_horiz_tracer_adv_order = 3
+ config_coef_3rd_order = 0.25
+ config_monotonic = .true.
/
-&restore
- config_restoreTS = .false.
- config_restoreT_timescale = 90.0
- config_restoreS_timescale = 90.0
+&bottom_drag
+ config_bottom_drag_coeff = 1.0e-3
/
+&pressure_gradient
+ config_pressure_gradient_type = 'pressure_and_zmid'
+ config_rho0 = 1014.65
+/
+&eos
+ config_eos_type = 'jm'
+/
+&eos_linear
+ config_eos_linear_alpha = 2.55e-1
+ 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
+/
+&split_explicit_ts
+ config_n_ts_iter = 2
+ config_n_bcl_iter_beg = 1
+ config_n_bcl_iter_mid = 2
+ config_n_bcl_iter_end = 2
+ config_n_btr_subcycles = 20
+ config_n_btr_cor_iter = 2
+ config_u_correction = .true.
+ config_btr_subcycle_loop_factor = 2
+ config_btr_gam1_uWt1 = 0.5
+ config_btr_gam2_SSHWt1 = 1.0
+ config_btr_gam3_uWt2 = 1.0
+ config_btr_solve_SSH2 = .false.
+/
+&debug
+ config_check_zlevel_consistency = .false.
+ config_filter_btr_mode = .false.
+ config_prescribe_velocity = .false.
+ 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_tr_all_tend = .false.
+ config_disable_tr_adv = .false.
+ config_disable_tr_hmix = .false.
+ config_disable_tr_vmix = .false.
+/
Modified: branches/atmos_physics/src/Makefile
===================================================================
--- branches/atmos_physics/src/Makefile 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/Makefile 2013-03-26 23:03:26 UTC (rev 2670)
@@ -23,7 +23,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 )
Copied: branches/atmos_physics/src/Makefile.in.CESM_OCN (from rev 2666, trunk/mpas/src/Makefile.in.CESM_OCN)
===================================================================
--- branches/atmos_physics/src/Makefile.in.CESM_OCN (rev 0)
+++ branches/atmos_physics/src/Makefile.in.CESM_OCN 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,32 @@
+include $(CASEROOT)/Macros
+RM = rm -f
+CPP = cpp -C -P -traditional
+FC=$(MPIFC)
+CC=$(MPICC)
+NETCDF=$(NETCDF_PATH)
+PNETCDF=$(PNETCDF_PATH)
+PIO=$(EXEROOT)/pio
+FILE_OFFSET = -DOFFSET64BIT
+CPPFLAGS += $(MODEL_FORMULATION) $(FILE_OFFSET) $(ZOLTAN_DEFINE) -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
+
+all:
+ @echo $(CPPINCLUDES)
+ @echo $(FCINCLUDES)
+ ( $(MAKE) mpas RM="$(RM)" CPP="$(CPP)" NETCDF="$(NETCDF)" PNETCDF="$(PNETCDF)" \
+ PIO="$(PIO)" FC="$(FC)" CC="$(CC)" SFC="$(SFC)" SCC="$(SCC)" \
+ CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" FCINCLUDES="$(FCINCLUDES)" )
+
+mpas: reg_includes externals frame ops dycore drver
+ ar ru lib$(CORE).a framework/*.o
+ ar ru lib$(CORE).a operators/*.o
+ ar ru lib$(CORE).a core_$(CORE)/*.o
+ ar ru lib$(CORE).a $(CORE)_cesm_driver/*.o
+
+externals:
+
+drver: reg_includes externals frame ops dycore
+ ( cd $(CORE)_cesm_driver; $(MAKE) CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" all )
+
Modified: branches/atmos_physics/src/core_hyd_atmos/Registry
===================================================================
--- branches/atmos_physics/src/core_hyd_atmos/Registry 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_hyd_atmos/Registry 2013-03-26 23:03:26 UTC (rev 2670)
@@ -96,7 +96,7 @@
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 nEdges ) 0 o cellTangentPlane 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 - -
Copied: branches/atmos_physics/src/core_hyd_atmos/Registry.xml (from rev 2666, trunk/mpas/src/core_hyd_atmos/Registry.xml)
===================================================================
--- branches/atmos_physics/src/core_hyd_atmos/Registry.xml (rev 0)
+++ branches/atmos_physics/src/core_hyd_atmos/Registry.xml 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,179 @@
+<?xml version="1.0"?>
+<registry>
+ <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>
Copied: branches/atmos_physics/src/core_init_nhyd_atmos/Registry.xml (from rev 2666, trunk/mpas/src/core_init_nhyd_atmos/Registry.xml)
===================================================================
--- branches/atmos_physics/src/core_init_nhyd_atmos/Registry.xml (rev 0)
+++ branches/atmos_physics/src/core_init_nhyd_atmos/Registry.xml 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,297 @@
+<?xml version="1.0"?>
+<registry>
+
+<!-- **************************************************************************************** -->
+<!-- ************************************** 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>
Copied: branches/atmos_physics/src/core_nhyd_atmos/Registry.xml (from rev 2666, trunk/mpas/src/core_nhyd_atmos/Registry.xml)
===================================================================
--- branches/atmos_physics/src/core_nhyd_atmos/Registry.xml (rev 0)
+++ branches/atmos_physics/src/core_nhyd_atmos/Registry.xml 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,994 @@
+<?xml version="1.0"?>
+<registry>
+
+<!-- **************************************************************************************** -->
+<!-- ************************************** 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_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] -->
+ <!-- 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"/>
+
+ <!-- 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). -->
+
+ <!-- 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="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>
Index: branches/atmos_physics/src/core_ocean
===================================================================
--- branches/atmos_physics/src/core_ocean 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean 2013-03-26 23:03:26 UTC (rev 2670)
Property changes on: branches/atmos_physics/src/core_ocean
___________________________________________________________________
Modified: svn:mergeinfo
## -2,15 +2,23 ##
/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
/branches/ocean_projects/imp_vert_mix_error/src/core_ocean:1847-1887
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean:754-986
/branches/ocean_projects/leith_mrp/src/core_ocean:2182-2241
+/branches/ocean_projects/linear_eos/src/core_ocean:2435-2437
/branches/ocean_projects/monotonic_advection/src/core_ocean:1499-1640
/branches/ocean_projects/monthly_forcing/src/core_ocean:1810-1867
+/branches/ocean_projects/namelist_cleanup/src/core_ocean:2319-2414
/branches/ocean_projects/option3_b4b_test/src/core_ocean:2201-2231
/branches/ocean_projects/partial_bottom_cells/src/core_ocean:2172-2226
+/branches/ocean_projects/remove_sw_test_cases/src/core_ocean:2539-2540
/branches/ocean_projects/restart_reproducibility/src/core_ocean:2239-2272
+/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/vert_adv_mrp/src/core_ocean:704-745
## -23,6 +31,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:1371-2274
+/branches/xml_registry/src/core_ocean:2610-2662
+/trunk/mpas/src/core_ocean:1371-2666
\ No newline at end of property
Modified: branches/atmos_physics/src/core_ocean/Makefile
===================================================================
--- branches/atmos_physics/src/core_ocean/Makefile 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/Makefile 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,79 +1,79 @@
.SUFFIXES: .F .o
OBJS = mpas_ocn_mpas_core.o \
- mpas_ocn_test_cases.o \
mpas_ocn_advection.o \
- mpas_ocn_thick_hadv.o \
- mpas_ocn_thick_vadv.o \
- mpas_ocn_gm.o \
- mpas_ocn_vel_coriolis.o \
- mpas_ocn_vel_vadv.o \
- mpas_ocn_vel_hmix.o \
- mpas_ocn_vel_hmix_del2.o \
- mpas_ocn_vel_hmix_leith.o \
- mpas_ocn_vel_hmix_del4.o \
- mpas_ocn_vel_forcing.o \
- mpas_ocn_vel_forcing_windstress.o \
- mpas_ocn_vel_forcing_bottomdrag.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 \
- mpas_ocn_vmix_coefs_tanh.o \
- mpas_ocn_restoring.o \
- mpas_ocn_tendency.o \
- mpas_ocn_tracer_advection.o \
- mpas_ocn_tracer_advection_std.o \
- mpas_ocn_tracer_advection_std_hadv.o \
- mpas_ocn_tracer_advection_std_vadv.o \
- mpas_ocn_tracer_advection_std_vadv2.o \
- mpas_ocn_tracer_advection_std_vadv3.o \
- mpas_ocn_tracer_advection_std_vadv4.o \
- mpas_ocn_tracer_advection_mono.o \
- mpas_ocn_tracer_advection_helpers.o \
+ mpas_ocn_thick_hadv.o \
+ mpas_ocn_thick_vadv.o \
+ mpas_ocn_gm.o \
+ mpas_ocn_vel_coriolis.o \
+ mpas_ocn_vel_vadv.o \
+ mpas_ocn_vel_hmix.o \
+ mpas_ocn_vel_hmix_del2.o \
+ mpas_ocn_vel_hmix_leith.o \
+ mpas_ocn_vel_hmix_del4.o \
+ mpas_ocn_vel_forcing.o \
+ 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 \
+ mpas_ocn_vmix_coefs_tanh.o \
+ mpas_ocn_restoring.o \
+ mpas_ocn_tendency.o \
+ mpas_ocn_diagnostics.o \
+ mpas_ocn_tracer_advection.o \
+ mpas_ocn_tracer_advection_std.o \
+ mpas_ocn_tracer_advection_std_hadv.o \
+ mpas_ocn_tracer_advection_std_vadv.o \
+ mpas_ocn_tracer_advection_std_vadv2.o \
+ mpas_ocn_tracer_advection_std_vadv3.o \
+ mpas_ocn_tracer_advection_std_vadv4.o \
+ mpas_ocn_tracer_advection_mono.o \
+ mpas_ocn_tracer_advection_helpers.o \
mpas_ocn_time_integration.o \
mpas_ocn_time_integration_rk4.o \
mpas_ocn_time_integration_split.o \
- mpas_ocn_equation_of_state.o \
- mpas_ocn_equation_of_state_jm.o \
- mpas_ocn_equation_of_state_linear.o \
+ mpas_ocn_equation_of_state.o \
+ mpas_ocn_equation_of_state_jm.o \
+ mpas_ocn_equation_of_state_linear.o \
+ mpas_ocn_diagnostics.o \
mpas_ocn_global_diagnostics.o \
- mpas_ocn_time_average.o \
- mpas_ocn_monthly_forcing.o
+ mpas_ocn_time_average.o \
+ mpas_ocn_monthly_forcing.o
all: core_hyd
core_hyd: $(OBJS)
ar -ru libdycore.a $(OBJS)
-mpas_ocn_test_cases.o:
-
mpas_ocn_advection.o:
mpas_ocn_time_integration.o: mpas_ocn_time_integration_rk4.o mpas_ocn_time_integration_split.o
-mpas_ocn_time_integration_rk4.o:
+mpas_ocn_time_integration_rk4.o: mpas_ocn_tendency.o mpas_ocn_diagnostics.o
-mpas_ocn_time_integration_split.o:
+mpas_ocn_time_integration_split.o: mpas_ocn_tendency.o mpas_ocn_diagnostics.o
mpas_ocn_tendency.o: mpas_ocn_time_average.o
+mpas_ocn_diagnostics.o: mpas_ocn_time_average.o
+
mpas_ocn_global_diagnostics.o:
mpas_ocn_time_average.o:
@@ -96,12 +96,10 @@
mpas_ocn_vel_hmix_del4.o:
-mpas_ocn_vel_forcing.o: mpas_ocn_vel_forcing_windstress.o mpas_ocn_vel_forcing_bottomdrag.o mpas_ocn_vel_forcing_rayleigh.o
+mpas_ocn_vel_forcing.o: mpas_ocn_vel_forcing_windstress.o mpas_ocn_vel_forcing_rayleigh.o
mpas_ocn_vel_forcing_windstress.o:
-mpas_ocn_vel_forcing_bottomdrag.o:
-
mpas_ocn_vel_forcing_rayleigh.o:
mpas_ocn_vel_coriolis.o:
@@ -172,61 +170,59 @@
mpas_ocn_monthly_forcing.o:
-mpas_ocn_mpas_core.o: mpas_ocn_mpas_core.o \
- mpas_ocn_test_cases.o \
- mpas_ocn_advection.o \
- mpas_ocn_thick_hadv.o \
+mpas_ocn_mpas_core.o: mpas_ocn_advection.o \
+ mpas_ocn_thick_hadv.o \
mpas_ocn_gm.o \
- mpas_ocn_thick_vadv.o \
- mpas_ocn_vel_coriolis.o \
- mpas_ocn_vel_vadv.o \
- mpas_ocn_vel_hmix.o \
- mpas_ocn_vel_hmix_del2.o \
- mpas_ocn_vel_hmix_leith.o \
- mpas_ocn_vel_hmix_del4.o \
- mpas_ocn_vel_forcing.o \
- mpas_ocn_vel_forcing_windstress.o \
- mpas_ocn_vel_forcing_bottomdrag.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 \
- mpas_ocn_vmix_coefs_tanh.o \
- mpas_ocn_restoring.o \
- mpas_ocn_tracer_advection.o \
- mpas_ocn_tracer_advection_std.o \
- mpas_ocn_tracer_advection_std_hadv.o \
- mpas_ocn_tracer_advection_std_vadv.o \
- mpas_ocn_tracer_advection_std_vadv2.o \
- mpas_ocn_tracer_advection_std_vadv3.o \
- mpas_ocn_tracer_advection_std_vadv4.o \
- mpas_ocn_tracer_advection_mono.o \
- mpas_ocn_tracer_advection_helpers.o \
- mpas_ocn_tendency.o \
- mpas_ocn_time_integration.o \
- mpas_ocn_time_integration_rk4.o \
- mpas_ocn_time_integration_split.o \
- mpas_ocn_equation_of_state.o \
- mpas_ocn_equation_of_state_jm.o \
- mpas_ocn_equation_of_state_linear.o \
- mpas_ocn_global_diagnostics.o \
- mpas_ocn_time_average.o \
- mpas_ocn_monthly_forcing.o
+ mpas_ocn_thick_vadv.o \
+ mpas_ocn_vel_coriolis.o \
+ mpas_ocn_vel_vadv.o \
+ mpas_ocn_vel_hmix.o \
+ mpas_ocn_vel_hmix_del2.o \
+ mpas_ocn_vel_hmix_leith.o \
+ mpas_ocn_vel_hmix_del4.o \
+ 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 \
+ mpas_ocn_vmix.o \
+ mpas_ocn_vmix_coefs_const.o \
+ mpas_ocn_vmix_coefs_rich.o \
+ mpas_ocn_vmix_coefs_tanh.o \
+ mpas_ocn_restoring.o \
+ mpas_ocn_tracer_advection.o \
+ mpas_ocn_tracer_advection_std.o \
+ mpas_ocn_tracer_advection_std_hadv.o \
+ mpas_ocn_tracer_advection_std_vadv.o \
+ mpas_ocn_tracer_advection_std_vadv2.o \
+ mpas_ocn_tracer_advection_std_vadv3.o \
+ mpas_ocn_tracer_advection_std_vadv4.o \
+ mpas_ocn_tracer_advection_mono.o \
+ mpas_ocn_tracer_advection_helpers.o \
+ mpas_ocn_tendency.o \
+ mpas_ocn_diagnostics.o \
+ mpas_ocn_time_integration.o \
+ mpas_ocn_time_integration_rk4.o \
+ mpas_ocn_time_integration_split.o \
+ mpas_ocn_equation_of_state.o \
+ mpas_ocn_equation_of_state_jm.o \
+ mpas_ocn_equation_of_state_linear.o \
+ mpas_ocn_global_diagnostics.o \
+ mpas_ocn_time_average.o \
+ mpas_ocn_monthly_forcing.o
clean:
$(RM) *.o *.mod *.f90 libdycore.a
Modified: branches/atmos_physics/src/core_ocean/Registry
===================================================================
--- branches/atmos_physics/src/core_ocean/Registry 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/Registry 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,102 +1,146 @@
%
% namelist type namelist_record name default_value
%
-namelist integer sw_model config_test_case 5
-namelist character sw_model config_time_integration RK4
-namelist logical sw_model config_rk_filter_btr_mode false
-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_initial_stats false
-namelist logical sw_model config_prescribe_velocity false
-namelist logical sw_model config_prescribe_thickness false
-namelist integer sw_model config_num_halos 3
-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 24:00:00
-namelist integer io config_frames_per_outfile 0
+namelist logical time_management config_do_restart .false.
+namelist character time_management config_start_time '0000-01-01_00:00:00'
+namelist character time_management config_stop_time 'none'
+namelist character time_management config_run_duration '0_06:00:00'
+namelist character time_management config_calendar_type '360day'
+
+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_restart_interval '0_06:00:00'
+namelist character io config_output_interval '0_06:00:00'
+namelist character io config_stats_interval '0_01:00:00'
+namelist logical io config_write_stats_on_startup .true.
+namelist logical io config_write_output_on_startup .true.
+namelist integer io config_frames_per_outfile 1000
namelist integer io config_pio_num_iotasks 0
namelist integer io config_pio_stride 1
-namelist logical io config_write_output_on_startup true
-namelist character decomposition config_block_decomp_file_prefix graph.info.part.
+
+namelist real time_integration config_dt 3000.0
+namelist character time_integration config_time_integrator 'split_explicit'
+
+namelist integer grid config_num_halos 3
+namelist character grid config_vert_coord_movement 'uniform_stretching'
+namelist character grid config_alter_ICs_for_pbcs 'zlevel_pbcs_off'
+namelist real grid config_min_pbc_fraction 0.10
+namelist logical grid config_check_ssh_consistency .true.
+
+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
-namelist character grid config_vert_grid_type isopycnal
-namelist character grid config_pressure_type pressure
-namelist real grid config_rho0 1028
-namelist logical grid config_enforce_zstar_at_restart false
-namelist character partial_bottom_cells config_alter_ICs_for_pbcs zlevel_pbcs_off
-namelist real partial_bottom_cells config_min_pbc_fraction 0.10
-namelist logical partial_bottom_cells config_check_ssh_consistency true
-namelist logical partial_bottom_cells config_check_zlevel_consistency false
-namelist integer split_explicit_ts config_n_ts_iter 2
-namelist integer split_explicit_ts config_n_bcl_iter_beg 2
-namelist integer split_explicit_ts config_n_bcl_iter_mid 2
-namelist integer split_explicit_ts config_n_bcl_iter_end 2
-namelist integer split_explicit_ts config_n_btr_subcycles 20
-namelist integer split_explicit_ts config_n_btr_cor_iter 2
-namelist logical split_explicit_ts config_u_correction true
-namelist logical split_explicit_ts config_filter_btr_mode false
-namelist integer split_explicit_ts config_btr_subcycle_loop_factor 2
-namelist real split_explicit_ts config_btr_gam1_uWt1 0.5
-namelist real split_explicit_ts config_btr_gam2_SSHWt1 1.0
-namelist real split_explicit_ts config_btr_gam3_uWt2 1.0
-namelist logical split_explicit_ts config_btr_solve_SSH2 false
-namelist logical hmix config_h_ScaleWithMesh false
-namelist real hmix config_h_mom_eddy_visc2 0.0
-namelist real hmix config_h_mom_eddy_visc4 0.0
-namelist logical hmix config_visc_vorticity_term true
-namelist real hmix config_visc_vorticity_visc2_scale 1.0
-namelist real hmix config_visc_vorticity_visc4_scale 1.0
-namelist logical hmix config_include_KE_vertex false
-namelist real hmix config_h_tracer_eddy_diff2 0.0
-namelist real hmix config_h_tracer_eddy_diff4 0.0
-namelist real hmix config_h_kappa 0.0
-namelist real hmix config_h_kappa_q 0.0
-namelist logical hmix config_rayleigh_friction false
-namelist real hmix config_rayleigh_damping_coeff 0.0
-namelist real hmix config_apvm_scale_factor 0.0
-namelist logical hmix_leith config_use_leith_del2 false
-namelist real hmix_leith config_leith_parameter 0.0
-namelist real hmix_leith config_leith_dx 0.0
-namelist real hmix_leith config_leith_visc2_max 1000000.0
-namelist character vmix config_vert_visc_type const
-namelist character vmix config_vert_diff_type const
-namelist logical vmix config_implicit_vertical_mix true
+namelist logical decomposition config_explicit_proc_decomp .false.
+namelist character decomposition config_proc_decomp_file_prefix 'graph.info.part.'
+
+namelist logical hmix config_hmix_ScaleWithMesh .false.
+namelist logical hmix config_visc_vorticity_term .true.
+namelist real hmix config_apvm_scale_factor 0.0
+
+namelist logical hmix_del2 config_use_mom_del2 .false.
+namelist logical hmix_del2 config_use_tracer_del2 .false.
+namelist real hmix_del2 config_mom_del2 0.0
+namelist real hmix_del2 config_tracer_del2 0.0
+namelist real hmix_del2 config_vorticity_del2_scale 1.0
+
+namelist logical hmix_del4 config_use_mom_del4 .true.
+namelist logical hmix_del4 config_use_tracer_del4 .false.
+namelist real hmix_del4 config_mom_del4 5.0e13
+namelist real hmix_del4 config_tracer_del4 0.0
+namelist real hmix_del4 config_vorticity_del4_scale 1.0
+
+namelist logical hmix_Leith config_use_Leith_del2 .false.
+namelist real hmix_Leith config_Leith_parameter 1.0
+namelist real hmix_Leith config_Leith_dx 15000.0
+namelist real hmix_Leith config_Leith_visc2_max 2.5e3
+
+namelist real standard_GM config_h_kappa 0.0
+namelist real standard_GM config_h_kappa_q 0.0
+
+namelist logical Rayleigh_damping config_Rayleigh_friction .false.
+namelist real Rayleigh_damping config_Rayleigh_damping_coeff 0.0
+
namelist real vmix config_convective_visc 1.0
namelist real vmix config_convective_diff 1.0
-namelist real vmix config_bottom_drag_coeff 1.0e-3
+
+namelist logical vmix_const config_use_const_visc .false.
+namelist logical vmix_const config_use_const_diff .false.
namelist real vmix_const config_vert_visc 2.5e-4
namelist real vmix_const config_vert_diff 2.5e-5
+
+namelist logical vmix_rich config_use_rich_visc .true.
+namelist logical vmix_rich config_use_rich_diff .true.
namelist real vmix_rich config_bkrd_vert_visc 1.0e-4
namelist real vmix_rich config_bkrd_vert_diff 1.0e-5
namelist real vmix_rich config_rich_mix 0.005
+
+namelist logical vmix_tanh config_use_tanh_visc .false.
+namelist logical vmix_tanh config_use_tanh_diff .false.
namelist real vmix_tanh config_max_visc_tanh 2.5e-1
namelist real vmix_tanh config_min_visc_tanh 1.0e-4
namelist real vmix_tanh config_max_diff_tanh 2.5e-2
namelist real vmix_tanh config_min_diff_tanh 1.0e-5
namelist real vmix_tanh config_zMid_tanh -100
namelist real vmix_tanh config_zWidth_tanh 100
-namelist character eos config_eos_type linear
-namelist character advection config_vert_tracer_adv stencil
-namelist integer advection config_vert_tracer_adv_order 4
-namelist integer advection config_horiz_tracer_adv_order 2
-namelist integer advection config_thickness_adv_order 2
+
+namelist logical forcing config_use_monthly_forcing .false.
+namelist logical forcing config_restoreTS .false.
+namelist real forcing config_restoreT_timescale 90.0
+namelist real forcing config_restoreS_timescale 90.0
+
+namelist character advection config_vert_tracer_adv 'stencil'
+namelist integer advection config_vert_tracer_adv_order 3
+namelist integer advection config_horiz_tracer_adv_order 3
namelist real advection config_coef_3rd_order 0.25
-namelist logical advection config_monotonic false
-namelist logical advection config_check_monotonicity false
-namelist logical restore config_restoreTS false
-namelist real restore config_restoreT_timescale 90.0
-namelist real restore config_restoreS_timescale 90.0
-namelist logical restore config_use_monthly_forcing false
+namelist logical advection config_monotonic .true.
+namelist real bottom_drag config_bottom_drag_coeff 1.0e-3
+
+namelist character pressure_gradient config_pressure_gradient_type 'pressure_and_zmid'
+namelist real pressure_gradient config_rho0 1014.65
+
+namelist character eos config_eos_type 'jm'
+
+namelist real eos_linear config_eos_linear_alpha 2.55e-1
+namelist real eos_linear config_eos_linear_beta 7.64e-1
+namelist real eos_linear config_eos_linear_Tref 19.0
+namelist real eos_linear config_eos_linear_Sref 35.0
+namelist real eos_linear config_eos_linear_rhoref 1025.022
+
+namelist integer split_explicit_ts config_n_ts_iter 2
+namelist integer split_explicit_ts config_n_bcl_iter_beg 1
+namelist integer split_explicit_ts config_n_bcl_iter_mid 2
+namelist integer split_explicit_ts config_n_bcl_iter_end 2
+namelist integer split_explicit_ts config_n_btr_subcycles 20
+namelist integer split_explicit_ts config_n_btr_cor_iter 2
+namelist logical split_explicit_ts config_u_correction .true.
+namelist integer split_explicit_ts config_btr_subcycle_loop_factor 2
+namelist real split_explicit_ts config_btr_gam1_uWt1 0.5
+namelist real split_explicit_ts config_btr_gam2_SSHWt1 1.0
+namelist real split_explicit_ts config_btr_gam3_uWt2 1.0
+namelist logical split_explicit_ts config_btr_solve_SSH2 .false.
+
+namelist logical debug config_check_zlevel_consistency .false.
+namelist logical debug config_filter_btr_mode .false.
+namelist logical debug config_prescribe_velocity .false.
+namelist logical debug config_prescribe_thickness .false.
+namelist logical debug config_include_KE_vertex .false.
+namelist logical debug config_check_tracer_monotonicity .false.
+namelist logical debug config_disable_h_all_tend .false.
+namelist logical debug config_disable_h_hadv .false.
+namelist logical debug config_disable_h_vadv .false.
+namelist logical debug config_disable_u_all_tend .false.
+namelist logical debug config_disable_u_coriolis .false.
+namelist logical debug config_disable_u_pgrad .false.
+namelist logical debug config_disable_u_hmix .false.
+namelist logical debug config_disable_u_windstress .false.
+namelist logical debug config_disable_u_vmix .false.
+namelist logical debug config_disable_u_vadv .false.
+namelist logical debug config_disable_tr_all_tend .false.
+namelist logical debug config_disable_tr_adv .false.
+namelist logical debug config_disable_tr_hmix .false.
+namelist logical debug config_disable_tr_vmix .false.
+
%
% dim type name_in_file name_in_code
%
@@ -161,7 +205,7 @@
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 nEdges ) 0 o cellTangentPlane 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 - -
@@ -195,7 +239,7 @@
% Arrays required for reconstruction of velocity field
var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 - coeffs_reconstruct mesh - -
-% Arrays for z-level version of mpas-ocean
+% Arrays for non-isopycnal version of mpas-ocean
var persistent integer maxLevelCell ( nCells ) 0 iro maxLevelCell mesh - -
var persistent integer maxLevelEdgeTop ( nEdges ) 0 - maxLevelEdgeTop mesh - -
var persistent integer maxLevelEdgeBot ( nEdges ) 0 - maxLevelEdgeBot mesh - -
@@ -204,7 +248,7 @@
var persistent real refBottomDepth ( nVertLevels ) 0 iro refBottomDepth mesh - -
var persistent real refBottomDepthTopOfCell ( nVertLevelsP1 ) 0 - refBottomDepthTopOfCell mesh - -
var persistent real hZLevel ( nVertLevels ) 0 iro hZLevel mesh - -
-var persistent real zstarWeight ( nVertLevels ) 0 - zstarWeight mesh - -
+var persistent real vertCoordMovementWeights ( nVertLevels ) 0 iro vertCoordMovementWeights mesh - -
% Boundary conditions and masks
var persistent integer boundaryEdge ( nVertLevels nEdges ) 0 - boundaryEdge mesh - -
@@ -239,7 +283,7 @@
var persistent real tend_tracer1 ( nVertLevels nCells Time ) 1 - tracer1 tend tracers testing
% state variables for Split Explicit timesplitting
-var persistent real uBtr ( nEdges Time ) 2 ir uBtr state - -
+var persistent real uBtr ( nEdges Time ) 2 r uBtr state - -
var persistent real ssh ( nCells Time ) 2 o ssh state - -
var persistent real uBtrSubcycle ( nEdges Time ) 2 - uBtrSubcycle state - -
var persistent real sshSubcycle ( nCells Time ) 2 - sshSubcycle state - -
@@ -284,7 +328,9 @@
var persistent real MontPot ( nVertLevels nCells Time ) 2 - MontPot state - -
var persistent real pressure ( nVertLevels nCells Time ) 2 - pressure state - -
var persistent real wTop ( nVertLevelsP1 nCells Time ) 2 - wTop state - -
+var persistent real vertVelocityTop ( nVertLevelsP1 nCells Time ) 2 - vertVelocityTop state - -
var persistent real rhoDisplaced ( nVertLevels nCells Time ) 2 - rhoDisplaced state - -
+var persistent real BruntVaisalaFreqTop ( nVertLevels nCells Time ) 2 o BruntVaisalaFreqTop state - -
var persistent real viscosity ( nVertLevels nEdges Time ) 2 o viscosity state - -
% Other diagnostic variables: neither read nor written to any files
@@ -317,8 +363,12 @@
var persistent real acc_uReconstructMeridionalVar ( nVertLevels nCells Time ) 2 o acc_uReconstructMeridionalVar state - -
var persistent real acc_u ( nVertLevels nEdges Time ) 2 o acc_u state - -
var persistent real acc_uVar ( nVertLevels nEdges Time ) 2 o acc_uVar state - -
+var persistent real acc_vertVelocityTop ( nVertLevelsP1 nCells Time ) 2 o acc_vertVelocityTop state - -
% Sign fields, for openmp and bit reproducibility without branching statements.
var persistent integer edgeSignOnCell ( maxEdges nCells ) 0 - edgeSignOnCell mesh - -
var persistent integer edgeSignOnVertex ( maxEdges nVertices ) 0 - edgeSignOnVertex mesh - -
var persistent integer kiteIndexOnCell ( maxEdges nCells ) 0 - kiteIndexOnCell mesh - -
+
+% Sea surface pressure, for coupling
+var persistent real seaSurfacePressure ( nCells Time ) 0 ir seaSurfacePressure mesh - -
Copied: branches/atmos_physics/src/core_ocean/Registry.xml (from rev 2666, trunk/mpas/src/core_ocean/Registry.xml)
===================================================================
--- branches/atmos_physics/src/core_ocean/Registry.xml (rev 0)
+++ branches/atmos_physics/src/core_ocean/Registry.xml 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,1071 @@
+<?xml version="1.0"?>
+<registry>
+ <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=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_Leith_parameter" type="real" default_value="1.0" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_Leith_dx" type="real" default_value="15000.0" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_Leith_visc2_max" type="real" default_value="2.5e3" units=""
+ description=""
+ possible_values=""
+ />
+ </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 u_src, 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=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_vert_tracer_adv_order" type="integer" default_value="3" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_horiz_tracer_adv_order" type="integer" default_value="3" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_coef_3rd_order" type="real" default_value="0.25" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_monotonic" type="logical" default_value=".true." units=""
+ description=""
+ possible_values=""
+ />
+ </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_rho0" 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=""
+ description=""
+ possible_values=""
+ />
+ </nml_record>
+ <nml_record name="eos_linear">
+ <nml_option name="config_eos_linear_alpha" type="real" default_value="2.55e-1" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_eos_linear_beta" type="real" default_value="7.64e-1" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_eos_linear_Tref" type="real" default_value="19.0" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_eos_linear_Sref" type="real" default_value="35.0" units=""
+ description=""
+ possible_values=""
+ />
+ <nml_option name="config_eos_linear_rhoref" type="real" default_value="1025.022" units=""
+ description=""
+ possible_values=""
+ />
+ </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_u_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_uWt1" 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_uWt2" 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_h_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_h_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_h_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_u_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_u_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_u_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_u_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_u_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_u_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_u_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="u" type="real" dimensions="nVertLevels nEdges Time" streams="ir" units="m s^{-1}"
+ description="horizonal velocity, normal component to an edge"
+ />
+ <var name="h" type="real" dimensions="nVertLevels nCells Time" streams="iro" units="m"
+ description="layer thickness"
+ />
+ <var name="rho" type="real" dimensions="nVertLevels nCells Time" streams="iro" units="kg m^{-3}"
+ description="density"
+ />
+ <var name="uBtr" 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="uBtrSubcycle" 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="FBtr" 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="GBtrForcing" 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="uBcl" 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="v" 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="vorticity" type="real" dimensions="nVertLevels nVertices Time" streams="o" units="s^{-1}"
+ description="curl of horizontal velocity"
+ />
+ <var name="Vor_edge" type="real" dimensions="nVertLevels nEdges Time" units="s^{-1}"
+ description="vorticity averaged from vertices to edges"
+ />
+ <var name="h_edge" type="real" dimensions="nVertLevels nEdges Time" units="m"
+ description="layer thickness averaged from cell center to edges"
+ />
+ <var name="h_vertex" type="real" dimensions="nVertLevels nVertices Time" units="m"
+ description="layer thickness averaged from cell center to vertices"
+ />
+ <var name="ke" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m^2 s^{-2}"
+ description="kinetic energy of horizonal velocity"
+ />
+ <var name="kev" type="real" dimensions="nVertLevels nVertices Time" streams="o" units="m^2 s^{-2}"
+ description="kinetic energy of horizonal velocity defined at vertices"
+ />
+ <var name="kevc" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m^2 s^{-2}"
+ description="kinetic energy of horizonal velocity defined at vertices"
+ />
+ <var name="ke_edge" type="real" dimensions="nVertLevels nEdges Time" units="m^2 s^{-2}"
+ description="kinetic energy of horizonal velocity defined at edges"
+ />
+ <var name="Vor_vertex" type="real" dimensions="nVertLevels nVertices Time" units="s^{-1}"
+ description="curl of horizontal velocity defined at vertices"
+ />
+ <var name="Vor_cell" type="real" dimensions="nVertLevels nCells Time" streams="o" units="s^{-1}"
+ description="curl of horizontal velocity defined at cell centers"
+ />
+ <var name="uReconstructX" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+ description="component of horizontal velocity in the x-direction (cartesian)"
+ />
+ <var name="uReconstructY" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+ description="component of horizontal velocity in the y-direction (cartesian)"
+ />
+ <var name="uReconstructZ" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+ description="component of horizontal velocity in the z-direction (cartesian)"
+ />
+ <var name="uReconstructZonal" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="component of horizontal velocity in the eastward direction"
+ />
+ <var name="uReconstructMeridional" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="component of horizontal velocity in the northward"
+ />
+ <var name="uSrcReconstructX" type="real" dimensions="nVertLevels nCells Time" units="N m^{-2}"
+ description="wind stress in the x-direction (cartesian)"
+ />
+ <var name="uSrcReconstructY" type="real" dimensions="nVertLevels nCells Time" units="N m^{-2}"
+ description="wind stress in the y-direction (cartesian)"
+ />
+ <var name="uSrcReconstructZ" type="real" dimensions="nVertLevels nCells Time" units="N m^{-2}"
+ description="wind stress in the z-direction (cartesian)"
+ />
+ <var name="uSrcReconstructZonal" type="real" dimensions="nVertLevels nCells Time" streams="o" units="N m^{-2}"
+ description="wind stress in the eastward direction"
+ />
+ <var name="uSrcReconstructMeridional" type="real" dimensions="nVertLevels nCells Time" streams="o" units="N m^{-2}"
+ description="wind stress in the northward direction"
+ />
+ <var name="MontPot" 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="wTop" 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="rhoDisplaced" 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="nAccumulate" type="real" dimensions="Time" streams="o" units="unitless"
+ description="number of timesteps in time-averaged variables"
+ />
+ <var name="acc_ssh" type="real" dimensions="nCells Time" streams="o" units="m"
+ description="time-averaged sea surface height"
+ />
+ <var name="acc_sshVar" type="real" dimensions="nCells Time" streams="o" units="m"
+ description="variance of sea surface height"
+ />
+ <var name="acc_uReconstructZonal" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="time-averaged velocity in the eastward direction"
+ />
+ <var name="acc_uReconstructMeridional" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="time-averaged velocity in the northward direction"
+ />
+ <var name="acc_uReconstructZonalVar" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="variance of velocity in the eastward direction"
+ />
+ <var name="acc_uReconstructMeridionalVar" type="real" dimensions="nVertLevels nCells Time" streams="o" units="m s^{-1}"
+ description="variance of velocity in the northward direction"
+ />
+ <var name="acc_u" type="real" dimensions="nVertLevels nEdges Time" streams="o" units="m s^{-1}"
+ description="time-averaged velocity, normal to cell edge"
+ />
+ <var name="acc_uVar" type="real" dimensions="nVertLevels nEdges Time" streams="o" units="m s^{-1}"
+ description="variance of velocity, normal to cell edge"
+ />
+ <var name="acc_vertVelocityTop" 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=""
+ 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=""
+ 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=""
+ 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=""
+ 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=""
+ description="Variable used with advection setup to compute advection coefficients. Deformation weight coefficients."
+ />
+ <var name="defc_b" type="real" dimensions="maxEdges nCells" units=""
+ 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=""
+ description="{\color{red} TO BE REMOVED}"
+ />
+ <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="u_src" 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_u" type="real" dimensions="nVertLevels nEdges Time" units="m s^{-2}" name_in_code="u"
+ description="time tendency of normal component of velocity"
+ />
+ <var name="tend_h" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}" name_in_code="h"
+ 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>
Copied: branches/atmos_physics/src/core_ocean/mpas_ocn_diagnostics.F (from rev 2666, trunk/mpas/src/core_ocean/mpas_ocn_diagnostics.F)
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_diagnostics.F (rev 0)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_diagnostics.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,834 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_diagnostics
+!
+!> \brief MPAS ocean diagnostics driver
+!> \author Mark Petersen
+!> \date 23 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routines for computing
+!> diagnostic variables, and other quantities such as wTop.
+!
+!-----------------------------------------------------------------------
+
+module ocn_diagnostics
+
+ use mpas_grid_types
+ use mpas_configure
+ use mpas_constants
+ use mpas_timer
+
+ use ocn_gm
+ use ocn_equation_of_state
+
+ implicit none
+ private
+ save
+
+ type (timer_node), pointer :: diagEOSTimer
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_diagnostic_solve, &
+ ocn_wtop, &
+ ocn_fuperp, &
+ ocn_filter_btr_mode_u, &
+ ocn_filter_btr_mode_tend_u, &
+ ocn_diagnostics_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ integer :: ke_cell_flag, ke_vertex_flag
+ real (kind=RKIND) :: coef_3rd_order, fCoef
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_diagnostic_solve
+!
+!> \brief Computes diagnostic variables
+!> \author Mark Petersen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the diagnostic variables for the ocean
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_diagnostic_solve(dt, s, grid)!{{{
+ implicit none
+
+ real (kind=RKIND), intent(in) :: dt !< Input: Time step
+ type (state_type), intent(inout) :: s !< Input/Output: State information
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+
+
+ integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
+ integer :: boundaryMask, velMask, nCells, nEdges, nVertices, nVertLevels, vertexDegree, err
+
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
+ maxLevelVertexBot
+ integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &
+ verticesOnEdge, edgesOnEdge, edgesOnVertex,boundaryCell, kiteIndexOnCell, &
+ verticesOnCell, edgeSignOnVertex, edgeSignOnCell, edgesOnCell
+
+ real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2, coef_3rd_order, r_tmp, &
+ invAreaCell1, invAreaCell2, invAreaTri1, invAreaTri2, invLength, h_vertex, 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, &
+ vertVelocityTop, BruntVaisalaFreqTop
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracers, deriv_two
+ character :: c1*6
+
+ h => s % h % array
+ u => s % u % array
+ uTransport => s % uTransport % array
+ uBolusGM => s % uBolusGM % array
+ v => s % v % array
+ h_edge => s % h_edge % array
+ circulation => s % circulation % array
+ vorticity => s % vorticity % 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
+ gradVor_n => s % gradVor_n % array
+ gradVor_t => s % gradVor_t % array
+ rho => s % rho % array
+ rhoDisplaced=> s % rhoDisplaced % array
+ MontPot => s % MontPot % array
+ pressure => s % pressure % array
+ zMid => s % zMid % array
+ ssh => s % ssh % array
+ tracers => s % tracers % array
+ vertVelocityTop => s % vertVelocityTop % array
+ BruntVaisalaFreqTop => s % BruntVaisalaFreqTop % array
+
+ weightsOnEdge => grid % weightsOnEdge % array
+ kiteAreasOnVertex => grid % kiteAreasOnVertex % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnVertex => grid % cellsOnVertex % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ edgesOnCell => grid % edgesOnCell % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ edgesOnVertex => grid % edgesOnVertex % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ areaTriangle => grid % areaTriangle % array
+ bottomDepth => grid % bottomDepth % array
+ fVertex => grid % fVertex % array
+ deriv_two => grid % deriv_two % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelEdgeBot => grid % maxLevelEdgeBot % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+ kiteIndexOnCell => grid % kiteIndexOnCell % array
+ verticesOnCell => grid % verticesOnCell % array
+
+ seaSurfacePressure => grid % seaSurfacePressure % array
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+ vertexDegree = grid % vertexDegree
+
+ boundaryCell => grid % boundaryCell % array
+
+ edgeSignOnVertex => grid % edgeSignOnVertex % array
+ edgeSignOnCell => grid % edgeSignOnCell % array
+
+ !
+ ! Compute height on cell edges at velocity locations
+ ! Namelist options control the order of accuracy of the reconstructed h_edge value
+ !
+
+ ! initialize h_edge to avoid divide by zero and NaN problems.
+ h_edge = -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))
+ end do
+ end do
+
+ !
+ ! 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
+ tracers(s % index_temperature,:,nCells+1) = -1e34
+ tracers(s % index_salinity,:,nCells+1) = -1e34
+
+ circulation(:,:) = 0.0
+ vorticity(:,:) = 0.0
+ divergence(:,:) = 0.0
+ vertVelocityTop(:,:)=0.0
+ ke(:,:) = 0.0
+ v(:,:) = 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)
+
+ circulation(k, iVertex) = circulation(k, iVertex) + edgeSignOnVertex(i, iVertex) * r_tmp
+ vorticity(k, iVertex) = vorticity(k, iVertex) + edgeSignOnVertex(i, iVertex) * r_tmp * invAreaTri1
+ end do
+ end do
+ end do
+
+ allocate(div_hu(nVertLevels))
+ do iCell = 1, nCells
+ div_hu(:) = 0.0
+ invAreaCell1 = 1.0 / areaCell(iCell)
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
+ do k = 1, maxLevelCell(iCell)
+ r_tmp = dvEdge(iEdge) * u(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)
+ end do
+ end do
+ ! Vertical velocity at bottom (maxLevelCell(iCell)+1) is zero, initialized above.
+ do k=maxLevelCell(iCell),1,-1
+ vertVelocityTop(k,iCell) = vertVelocityTop(k+1,iCell) - div_hu(k)
+ end do
+ end do
+ deallocate(div_hu)
+
+ do iEdge=1,nEdges
+ ! Compute v (tangential) velocities
+ do i=1,nEdgesOnEdge(iEdge)
+ eoe = edgesOnEdge(i,iEdge)
+ do k = 1,maxLevelEdgeTop(iEdge)
+ v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe)
+ end do
+ end do
+ end do
+
+ !
+ ! Compute kinetic energy in each vertex
+ !
+ kev(:,:) = 0.0; kevc(:,:) = 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
+ end do
+ end do
+ end do
+
+ do iCell = 1, nCells*ke_vertex_flag
+ invAreaCell1 = 1.0 / areaCell(iCell)
+ do i = 1, nEdgesOnCell(iCell)
+ 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
+ end do
+ end do
+ end do
+
+ !
+ ! Compute kinetic energy in each cell by blending ke and kevc
+ !
+ 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)
+ end do
+ end do
+
+ !
+ ! Compute ke on cell edges at velocity locations for quadratic bottom drag.
+ !
+ 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))
+ 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 )
+ !
+ do iVertex = 1,nVertices
+ invAreaTri1 = 1.0 / areaTriangle(iVertex)
+ do k=1,maxLevelVertexBot(iVertex)
+ h_vertex = 0.0
+ do i=1,vertexDegree
+ h_vertex = h_vertex + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
+ end do
+ h_vertex = h_vertex * invAreaTri1
+
+ Vor_vertex(k,iVertex) = (fCoef*fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
+ end do
+ end do
+
+ Vor_cell(:,:) = 0.0
+ Vor_edge(:,:) = 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))
+ end do
+ end do
+
+ do iCell = 1, nCells
+ invAreaCell1 = 1.0 / areaCell(iCell)
+
+ do i = 1, nEdgesOnCell(iCell)
+ 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
+ end do
+ end do
+ end do
+
+ do iEdge = 1,nEdges
+ cell1 = cellsOnEdge(1, iEdge)
+ cell2 = cellsOnEdge(2, iEdge)
+ vertex1 = verticesOnedge(1, iEdge)
+ vertex2 = verticesOnedge(2, iEdge)
+
+ invLength = 1.0 / dcEdge(iEdge)
+ ! 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
+ 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
+ enddo
+
+ enddo
+
+ !
+ ! Modify PV edge with upstream bias.
+ !
+ 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) )
+ enddo
+ enddo
+
+ !
+ ! equation of state
+ !
+ ! For an isopycnal model, density should remain constant.
+ ! For zlevel, calculate in-situ density
+ if (config_vert_coord_movement.ne.'isopycnal') then
+ call mpas_timer_start("equation of state", .false., diagEOSTimer)
+
+ ! compute in-place density
+ call ocn_equation_of_state_rho(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)
+
+ call mpas_timer_stop("equation of state", diagEOSTimer)
+ endif
+
+ !
+ ! Pressure
+ ! This section must be after computing rho
+ !
+ if (config_pressure_gradient_type.eq.'MontgomeryPotential') then
+
+ ! For Isopycnal model.
+ ! Compute pressure at top of each layer, and then
+ ! Montgomery Potential.
+ allocate(pTop(nVertLevels))
+ do iCell=1,nCells
+
+ ! assume atmospheric pressure at the surface is zero for now.
+ pTop(1) = 0.0
+ ! 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)))
+
+ do k=2,nVertLevels
+ pTop(k) = pTop(k-1) + rho(k-1,iCell)*gravity* h(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))
+ end do
+
+ end do
+ deallocate(pTop)
+
+ else
+
+ do iCell=1,nCells
+ ! 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)
+
+ 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))
+ end do
+
+ ! Compute zMid, the z-coordinate of the middle of the layer.
+ ! This is used for the rho 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)
+
+ do k=maxLevelCell(iCell)-1, 1, -1
+ zMid(k,iCell) = zMid(k+1,iCell) &
+ + 0.5*( h(k+1,iCell) &
+ + h(k ,iCell))
+ end do
+
+ end do
+
+ endif
+
+ !
+ ! Brunt-Vaisala frequency
+ !
+ coef = -gravity/config_rho0
+ 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)) &
+ / (zMid(k-1,iCell) - zMid(k,iCell))
+ end do
+ end do
+
+ !
+ ! Sea Surface Height
+ !
+ do iCell=1,nCells
+ ! Start at the bottom where we know the depth, and go up.
+ ! The bottom depth for this cell is bottomDepth(iCell).
+ ! 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))
+
+ end do
+
+ !
+ ! Apply the GM closure as a bolus velocity
+ !
+ if (config_h_kappa .GE. epsilon(0D0)) then
+ call ocn_gm_compute_uBolus(s,grid)
+ else
+ uBolusGM = 0.0
+ end if
+
+ end subroutine ocn_diagnostic_solve!}}}
+
+!***********************************************************************
+!
+! routine ocn_wtop
+!
+!> \brief Computes vertical transport
+!> \author Mark Petersen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical transport through the top of each
+!> cell.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_wtop(grid,h,h_edge,u,wTop, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h !< Input: thickness
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: h interpolated to an edge
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ u !< Input: transport
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(out) :: &
+ wTop !< Output: vertical transport at top of cell
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ 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
+
+ integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree
+
+
+ real (kind=RKIND), dimension(:), pointer :: &
+ dvEdge, areaCell, vertCoordMovementWeights
+ real (kind=RKIND), dimension(:), allocatable:: div_hu, h_tend_col
+ real (kind=RKIND) :: div_hu_btr
+
+ integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &
+ verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &
+ boundaryEdge, boundaryCell, edgeSignOnCell
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
+ maxLevelVertexBot, maxLevelVertexTop
+
+ err = 0
+
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ areaCell => grid % areaCell % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ edgesOnCell => grid % edgesOnCell % array
+ edgeSignOnCell => grid % edgeSignOnCell % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeBot => grid % maxLevelEdgeBot % array
+ dvEdge => grid % dvEdge % array
+ vertCoordMovementWeights => grid % vertCoordMovementWeights % array
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nVertLevels = grid % nVertLevels
+
+
+ if (config_vert_coord_movement.eq.'isopycnal') then
+ ! set vertical transport to zero in isopycnal case
+ wTop=0.0
+ return
+ end if
+
+ allocate(div_hu(nVertLevels), h_tend_col(nVertLevels))
+
+ !
+ ! Compute div(h^{edge} u) for each cell
+ ! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
+ !
+
+ do iCell=1,nCells
+ div_hu(:) = 0.0
+ div_hu_btr = 0.0
+ hSum = 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
+ 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)
+ end do
+
+ if(hSum > 0.0) then
+ h_tend_col = h_tend_col / hSum
+ 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
+ do k=maxLevelCell(iCell),2,-1
+ wTop(k,iCell) = wTop(k+1,iCell) - div_hu(k) - h_tend_col(k)
+ end do
+ end do
+
+ deallocate(div_hu, h_tend_col)
+
+ end subroutine ocn_wtop!}}}
+
+!***********************************************************************
+!
+! routine ocn_fuperp
+!
+!> \brief Computes f u_perp
+!> \author Mark Petersen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes f u_perp for the ocean
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_fuperp(s, grid)!{{{
+ implicit none
+
+ type (state_type), intent(inout) :: s !< Input/Output: State information
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+
+ integer :: iEdge, cell1, cell2, eoe, i, j, k
+ integer :: nEdgesSolve
+ real (kind=RKIND), dimension(:), pointer :: fEdge
+ real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge, u, uBcl
+ type (dm_info) :: dminfo
+
+ integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnEdge
+ integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnEdge
+
+ call mpas_timer_start("ocn_fuperp")
+
+ u => s % u % array
+ uBcl => s % uBcl % array
+ weightsOnEdge => grid % weightsOnEdge % array
+ fEdge => grid % fEdge % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+
+ fEdge => grid % fEdge % array
+
+ nEdgesSolve = grid % nEdgesSolve
+
+ !
+ ! Put f*uBcl^{perp} in u as a work variable
+ !
+ do iEdge=1,nEdgesSolve
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+
+ do k=1,maxLevelEdgeTop(iEdge)
+
+ u(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)
+ end do
+ end do
+ end do
+
+ call mpas_timer_stop("ocn_fuperp")
+
+ end subroutine ocn_fuperp!}}}
+
+!***********************************************************************
+!
+! routine ocn_filter_btr_mode_u
+!
+!> \brief filters barotropic mode out of the velocity variable.
+!> \author Mark Petersen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine filters barotropic mode out of the velocity variable.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_filter_btr_mode_u(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
+ integer, dimension(:), pointer :: maxLevelEdgeTop
+
+ call mpas_timer_start("ocn_filter_btr_mode_u")
+
+ u => s % u % array
+ h_edge => s % h_edge % 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
+ ! nonzero value to avoid a NaN.
+ uhSum = h_edge(1,iEdge) * u(1,iEdge)
+ hSum = h_edge(1,iEdge)
+
+ do k=2,maxLevelEdgeTop(iEdge)
+ uhSum = uhSum + h_edge(k,iEdge) * u(k,iEdge)
+ hSum = hSum + h_edge(k,iEdge)
+ enddo
+
+ vertSum = uhSum/hSum
+ do k=1,maxLevelEdgeTop(iEdge)
+ u(k,iEdge) = u(k,iEdge) - vertSum
+ enddo
+ enddo ! iEdge
+
+ call mpas_timer_stop("ocn_filter_btr_mode_u")
+
+ end subroutine ocn_filter_btr_mode_u!}}}
+
+!***********************************************************************
+!
+! routine ocn_filter_btr_mode_tend_u
+!
+!> \brief ocn_filters barotropic mode out of the u tendency
+!> \author Mark Petersen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine filters barotropic mode out of the u tendency.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_filter_btr_mode_tend_u(tend, s, grid)!{{{
+ implicit none
+
+ type (tend_type), intent(inout) :: tend
+ type (state_type), intent(in) :: s
+ 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
+
+ integer, dimension(:), pointer :: maxLevelEdgeTop
+
+ call mpas_timer_start("ocn_filter_btr_mode_tend_u")
+
+ tend_u => tend % u % array
+ h_edge => s % h_edge % 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
+ ! nonzero value to avoid a NaN.
+ uhSum = h_edge(1,iEdge) * tend_u(1,iEdge)
+ hSum = h_edge(1,iEdge)
+
+ do k=2,maxLevelEdgeTop(iEdge)
+ uhSum = uhSum + h_edge(k,iEdge) * tend_u(k,iEdge)
+ hSum = hSum + h_edge(k,iEdge)
+ enddo
+
+ vertSum = uhSum/hSum
+ do k=1,maxLevelEdgeTop(iEdge)
+ tend_u(k,iEdge) = tend_u(k,iEdge) - vertSum
+ enddo
+ enddo ! iEdge
+
+ call mpas_timer_stop("ocn_filter_btr_mode_tend_u")
+
+ end subroutine ocn_filter_btr_mode_tend_u!}}}
+
+!***********************************************************************
+!
+! routine ocn_diagnostics_init
+!
+!> \brief Initializes flags used within diagnostics routines.
+!> \author Mark Petersen
+!> \date 4 November 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes flags related to quantities computed within
+!> other diagnostics routines.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_diagnostics_init(err)!{{{
+ integer, intent(out) :: err !< Output: Error flag
+
+ err = 0
+
+ if(config_include_KE_vertex) then
+ ke_vertex_flag = 1
+ ke_cell_flag = 0
+ else
+ ke_vertex_flag = 0
+ ke_cell_flag = 1
+ endif
+
+ if (trim(config_time_integrator) == 'RK4') then
+ ! 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 the Coriolis term
+ ! is added separately to the momentum tendencies.
+ fCoef = 0
+ end if
+
+ end subroutine ocn_diagnostics_init!}}}
+
+!***********************************************************************
+
+end module ocn_diagnostics
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_equation_of_state.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_equation_of_state.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_equation_of_state.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -158,7 +158,7 @@
linearEos = .false.
jmEos = .false.
- if(config_vert_grid_type.ne.'isopycnal') then
+ if(config_vert_coord_movement.ne.'isopycnal') then
eosON = .true.
if (config_eos_type.eq.'linear') then
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_equation_of_state_linear.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_equation_of_state_linear.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_equation_of_state_linear.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -82,27 +82,21 @@
integer, intent(in) :: indexT, indexS
integer, intent(out) :: err
- real (kind=RKIND), parameter :: rho_ref = 1025.022 ! kg / m^3
- real (kind=RKIND), parameter :: alpha = 2.55e-1 ! kg / m^3 / K (dT/dRho)
- real (kind=RKIND), parameter :: beta = 7.64e-1 ! kg / m^3 / psu (dS/dRho)
- real (kind=RKIND), parameter :: T_ref = 19.0 ! K
- real (kind=RKIND), parameter :: S_ref = 35.0 ! psu
- real (kind=RKIND), parameter :: rho_prime_ref = rho_ref + alpha * T_ref - beta * S_ref
-
integer, dimension(:), pointer :: maxLevelCell
integer :: nCells, iCell, k
type (dm_info) :: dminfo
- maxLevelCell => grid % maxLevelCell % array
- nCells = grid % nCells
+ maxLevelCell => grid % maxLevelCell % array
+ nCells = grid % nCells
err = 0
do iCell=1,nCells
do k=1,maxLevelCell(iCell)
! Linear equation of state
- ! rho = rho_ref - alpha * (T - T_ref) + beta * (S - S_ref)
- rho(k,iCell) = rho_prime_ref - alpha*tracers(indexT,k,iCell) + beta*tracers(indexS,k,iCell)
+ rho(k,iCell) = config_eos_linear_rhoref &
+ - 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
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_global_diagnostics.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_global_diagnostics.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_global_diagnostics.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -421,27 +421,27 @@
! write out the data to files
if (dminfo % my_proc_id == IO_NODE) then
fileID = getFreeUnit()
- open(fileID,file='stats_min.txt',ACCESS='append')
+ open(fileID,file='stats_min.txt',STATUS='UNKNOWN', POSITION='append')
write (fileID,'(100es24.14)') mins(1:nVariables)
close (fileID)
- open(fileID,file='stats_max.txt',ACCESS='append')
+ open(fileID,file='stats_max.txt',STATUS='UNKNOWN', POSITION='append')
write (fileID,'(100es24.14)') maxes(1:nVariables)
close (fileID)
- open(fileID,file='stats_sum.txt',ACCESS='append')
+ open(fileID,file='stats_sum.txt',STATUS='UNKNOWN', POSITION='append')
write (fileID,'(100es24.14)') sums(1:nVariables)
close (fileID)
- open(fileID,file='stats_avg.txt',ACCESS='append')
+ open(fileID,file='stats_avg.txt',STATUS='UNKNOWN', POSITION='append')
write (fileID,'(100es24.14)') averages(1:nVariables)
close (fileID)
- open(fileID,file='stats_time.txt',ACCESS='append')
+ open(fileID,file='stats_time.txt',STATUS='UNKNOWN', POSITION='append')
write (fileID,'(i10,10x,a,100es24.14)') timeIndex, &
state % xtime % scalar, dt, &
CFLNumberGlobal
close (fileID)
- open(fileID,file='stats_colmin.txt',ACCESS='append')
+ open(fileID,file='stats_colmin.txt',STATUS='UNKNOWN', POSITION='append')
write (fileID,'(100es24.14)') verticalSumMins(1:nVariables)
close (fileID)
- open(fileID,file='stats_colmax.txt',ACCESS='append')
+ open(fileID,file='stats_colmax.txt',STATUS='UNKNOWN', POSITION='append')
write (fileID,'(100es24.14)') verticalSumMaxes(1:nVariables)
close (fileID)
end if
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_gm.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_gm.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_gm.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -30,7 +30,7 @@
contains
- subroutine ocn_gm_compute_uBolus(s, grid)
+ subroutine ocn_gm_compute_uBolus(s, grid)!{{{
implicit none
type(state_type), intent(inout) :: s
type(mesh_type), intent(in) :: grid
@@ -50,7 +50,7 @@
call ocn_gm_compute_hEddyFlux(s, grid)
- if (config_vert_grid_type .EQ. 'isopycnal') then
+ if (config_vert_coord_movement .EQ. 'isopycnal') then
do iEdge = 1, nEdges
do k = 1, maxLevelEdgeTop(iEdge)
@@ -65,10 +65,9 @@
end if
- end subroutine ocn_gm_compute_uBolus
+ end subroutine ocn_gm_compute_uBolus!}}}
-
- subroutine ocn_gm_compute_hEddyFlux(s, grid)
+ subroutine ocn_gm_compute_hEddyFlux(s, grid)!{{{
implicit none
type(state_type), intent(inout) :: s
type(mesh_type), intent(in) :: grid
@@ -90,7 +89,7 @@
hEddyFlux(:,:) = 0.0
- if (config_vert_grid_type .EQ. 'isopycnal') then
+ if (config_vert_coord_movement .EQ. 'isopycnal') then
do iEdge = 1,nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
@@ -104,12 +103,10 @@
end if
- end subroutine ocn_gm_compute_hEddyFlux
+ end subroutine ocn_gm_compute_hEddyFlux!}}}
+ subroutine ocn_get_h_kappa(s, grid)!{{{
-
- subroutine ocn_get_h_kappa(s, grid)
-
type (state_type), intent(inout) :: s
type (mesh_type), intent(in) :: grid
@@ -121,11 +118,10 @@
h_kappa(:,:) = config_h_kappa
- end subroutine ocn_get_h_kappa
+ end subroutine ocn_get_h_kappa!}}}
+ subroutine ocn_get_h_kappa_q(s, grid)!{{{
- subroutine ocn_get_h_kappa_q(s, grid)
-
type (state_type), intent(inout) :: s
type (mesh_type), intent(in) :: grid
@@ -137,6 +133,6 @@
h_kappa_q(:,:) = config_h_kappa_q
- end subroutine ocn_get_h_kappa_q
+ end subroutine ocn_get_h_kappa_q!}}}
end module ocn_gm
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_mpas_core.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_mpas_core.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_mpas_core.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -7,16 +7,20 @@
use mpas_timer
use ocn_global_diagnostics
- use ocn_test_cases
use ocn_time_integration
use ocn_tendency
+ use ocn_diagnostics
use ocn_monthly_forcing
+ use ocn_thick_hadv
+ use ocn_thick_vadv
+
use ocn_vel_pressure_grad
use ocn_vel_vadv
use ocn_vel_hmix
use ocn_vel_forcing
+ use ocn_vel_coriolis
use ocn_tracer_hadv
use ocn_tracer_vadv
@@ -64,9 +68,16 @@
! Initialize submodules before initializing blocks.
call ocn_timestep_init(err)
+ call ocn_thick_hadv_init(err_tmp)
+ err = ior(err, err_tmp)
+
+ call ocn_thick_vadv_init(err_tmp)
+ err = ior(err, err_tmp)
+
+ call ocn_vel_coriolis_init(err_tmp)
+ err = ior(err, err_tmp)
call ocn_vel_pressure_grad_init(err_tmp)
err = ior(err, err_tmp)
-
call ocn_vel_vadv_init(err_tmp)
err = ior(err, err_tmp)
call ocn_vel_hmix_init(err_tmp)
@@ -91,6 +102,8 @@
call ocn_tendency_init(err_tmp)
err = ior(err,err_tmp)
+ call ocn_diagnostics_init(err_tmp)
+ err = ior(err,err_tmp)
call mpas_ocn_tracer_advection_init(err_tmp)
err = ior(err,err_tmp)
@@ -104,40 +117,38 @@
call mpas_dmpar_abort(dminfo)
endif
- if (.not. config_do_restart) call setup_sw_test_case(domain)
+ if (config_vert_coord_movement.ne.'isopycnal') call ocn_init_vert_coord(domain)
- if (config_vert_grid_type.ne.'isopycnal') call ocn_init_vert_coord(domain)
-
call ocn_compute_max_level(domain)
- if (config_enforce_zstar_at_restart) then
- call ocn_init_h_zstar(domain)
- endif
-
if (.not.config_do_restart) call ocn_init_split_timestep(domain)
- write (0,'(a,a10)'), ' Vertical grid type is: ',config_vert_grid_type
+ write (0,'(a,a)') ' Vertical coordinate movement is: ',trim(config_vert_coord_movement)
- if (config_vert_grid_type.ne.'isopycnal'.and. &
- config_vert_grid_type.ne.'zlevel'.and. &
- config_vert_grid_type.ne.'zstar1'.and. &
- config_vert_grid_type.ne.'zstar'.and. &
- config_vert_grid_type.ne.'zstarWeights') then
- write (0,*) ' Incorrect choice of config_vert_grid_type.'
+ if (config_vert_coord_movement.ne.'isopycnal'.and. &
+ config_vert_coord_movement.ne.'fixed'.and. &
+ config_vert_coord_movement.ne.'uniform_stretching'.and. &
+ config_vert_coord_movement.ne.'user_specified') then
+ write (0,*) ' Incorrect choice of config_vert_coord_movement.'
call mpas_dmpar_abort(dminfo)
endif
- write (0,'(a,a10)'), ' Pressure type is: ',config_pressure_type
- if (config_pressure_type.ne.'pressure'.and. &
- config_pressure_type.ne.'MontgomeryPotential') then
- write (0,*) ' Incorrect choice of config_pressure_type.'
+ write (0,'(a,a)') ' Pressure type is: ',trim(config_pressure_gradient_type)
+ if (config_pressure_gradient_type.ne.'pressure_and_zmid'.and. &
+ config_pressure_gradient_type.ne.'MontgomeryPotential') then
+ write (0,*) ' Incorrect choice of config_pressure_gradient_type.'
call mpas_dmpar_abort(dminfo)
endif
+ if(config_vert_coord_movement .ne. 'isopycnal' .and. config_pressure_gradient_type .eq. 'MontgomeryPotential') then
+ write (0,*) ' Incorrect combination of config_vert_coord_movement and config_pressure_gradient_type'
+ call mpas_dmpar_abort(dminfo)
+ end if
+
if (config_filter_btr_mode.and. &
- config_vert_grid_type.ne.'zlevel')then
+ config_vert_coord_movement.ne.'fixed')then
write (0,*) 'filter_btr_mode has only been tested with'// &
- ' config_vert_grid_type=zlevel.'
+ ' config_vert_coord_movement=fixed.'
call mpas_dmpar_abort(dminfo)
endif
@@ -158,16 +169,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_initial_stats) then
+ 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
@@ -184,11 +189,19 @@
type (MPAS_Time_Type) :: startTime, stopTime, alarmStartTime
type (MPAS_TimeInterval_type) :: runDuration, timeStep, alarmTimeStep
+ character(len=StrKIND) :: restartTimeStamp
integer :: ierr
- call mpas_set_time(curr_time=startTime, dateTimeString=config_start_time, ierr=ierr)
+ if(config_start_time == 'file') then
+ open(22,file='restart_timestamp',form='formatted',status='old')
+ read(22,*) restartTimeStamp
+ close(22)
+ call mpas_set_time(curr_time=startTime, dateTimeString=restartTimeStamp, ierr=ierr)
+ else
+ call mpas_set_time(curr_time=startTime, dateTimeString=config_start_time, ierr=ierr)
+ end if
+
call mpas_set_timeInterval(timeStep, dt=dt, ierr=ierr)
-
if (trim(config_run_duration) /= "none") then
call mpas_set_timeInterval(runDuration, timeString=config_run_duration, ierr=ierr)
call mpas_create_clock(clock, startTime=startTime, timeStep=timeStep, runDuration=runDuration, ierr=ierr)
@@ -222,11 +235,11 @@
!TODO: use this code if we desire to convert config_stats_interval to alarms
!(must also change config_stats_interval type to character)
! set stats alarm, if necessary
- !if (trim(config_stats_interval) /= "none") then
- ! call mpas_set_timeInterval(alarmTimeStep, timeString=config_stats_interval, ierr=ierr)
- ! alarmStartTime = startTime + alarmTimeStep
- ! call mpas_add_clock_alarm(clock, statsAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
- !end if
+ if (trim(config_stats_interval) /= "none") then
+ call mpas_set_timeInterval(alarmTimeStep, timeString=config_stats_interval, ierr=ierr)
+ alarmStartTime = startTime + alarmTimeStep
+ call mpas_add_clock_alarm(clock, statsAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
+ end if
call mpas_get_time(curr_time=startTime, dateTimeString=startTimeStamp, ierr=ierr)
@@ -277,7 +290,6 @@
block % state % time_levs(1) % state % uReconstructMeridional % 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, &
@@ -285,18 +297,12 @@
block % state % time_levs(1) % state % uSrcReconstructZonal % array, &
block % state % time_levs(1) % state % uSrcReconstructMeridional % 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 % mesh % maxLevelEdgeTop % array(iEdge)+1 &
:block % mesh % maxLevelEdgeBot % array(iEdge), iEdge) = 0.0
@@ -304,15 +310,11 @@
block % state % time_levs(1) % state % u % 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
@@ -506,30 +508,31 @@
call ocn_timestep(domain, dt, timeStamp)
- if (config_stats_interval > 0) then
- if (mod(itimestep, config_stats_interval) == 0) then
- call mpas_timer_start("global diagnostics", .false., globalDiagTimer)
- call ocn_compute_global_diagnostics(domain, 2, itimestep, dt);
- call mpas_timer_stop("global diagnostics", globalDiagTimer)
- end if
- end if
+ !if (config_stats_interval > 0) then
+ ! if (mod(itimestep, config_stats_interval) == 0) then
+ ! call mpas_timer_start("global diagnostics", .false., globalDiagTimer)
+ ! call ocn_compute_global_diagnostics(domain, 2, itimestep, dt);
+ ! call mpas_timer_stop("global diagnostics", globalDiagTimer)
+ ! end if
+ !end if
!TODO: replace the above code block with this if we desire to convert config_stats_interval to use alarms
- !if (mpas_is_alarm_ringing(clock, statsAlarmID, ierr=ierr)) then
- ! call mpas_reset_clock_alarm(clock, statsAlarmID, ierr=ierr)
+ if (mpas_is_alarm_ringing(clock, statsAlarmID, ierr=ierr)) then
+ call mpas_reset_clock_alarm(clock, statsAlarmID, ierr=ierr)
- ! block_ptr => domain % blocklist
- ! if (associated(block_ptr % next)) then
- ! write(0,*) 'Error: computeGlobalDiagnostics assumes ',&
- ! 'that there is only one block per processor.'
- ! end if
+! block_ptr => domain % blocklist
+! if (associated(block_ptr % next)) then
+! write(0,*) 'Error: computeGlobalDiagnostics assumes ',&
+! 'that there is only one block per processor.'
+! end if
- ! call mpas_timer_start("global diagnostics")
- ! call ocn_compute_global_diagnostics(domain % dminfo, &
- ! block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
- ! timeStamp, dt)
- ! call mpas_timer_stop("global diagnostics")
- !end if
+ call mpas_timer_start("global diagnostics")
+ call ocn_compute_global_diagnostics(domain, 2, itimestep, dt);
+ ! call ocn_compute_global_diagnostics(domain % dminfo, &
+ ! block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
+ ! timeStamp, dt)
+ call mpas_timer_stop("global diagnostics")
+ end if
end subroutine mpas_timestep!}}}
@@ -553,7 +556,7 @@
integer, dimension(:), pointer :: maxLevelCell
real (kind=RKIND), dimension(:), pointer :: refBottomDepth, &
- refBottomDepthTopOfCell, zstarWeight, hZLevel, bottomDepth
+ refBottomDepthTopOfCell, vertCoordMovementWeights, hZLevel, bottomDepth
real (kind=RKIND), dimension(:), allocatable :: minBottomDepth, minBottomDepthMid, zMidZLevel
real (kind=RKIND), dimension(:,:), pointer :: h
@@ -570,7 +573,7 @@
refBottomDepth => block % mesh % refBottomDepth % array
refBottomDepthTopOfCell => block % mesh % refBottomDepthTopOfCell % array
bottomDepth => block % mesh % bottomDepth % array
- zstarWeight => block % mesh % zstarWeight % array
+ vertCoordMovementWeights => block % mesh % vertCoordMovementWeights % array
hZLevel => block % mesh % hZLevel % array
maxLevelCell => block % mesh % maxLevelCell % array
@@ -578,11 +581,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)
@@ -594,28 +592,17 @@
refBottomDepthTopOfCell(k+1) = refBottomDepth(k)
end do
- ! Initialization of zstarWeights. This determines how SSH perturbations
+ ! Initialization of vertCoordMovementWeights. This determines how SSH perturbations
! are distributed throughout the column.
- if (config_vert_grid_type.eq.'zlevel') then
+ if (config_vert_coord_movement.eq.'fixed') then
- zstarWeight = 0.0
- zstarWeight(1) = 1.0
+ vertCoordMovementWeights = 0.0
+ vertCoordMovementWeights(1) = 1.0
- elseif (config_vert_grid_type.eq.'zstar') then
+ elseif (config_vert_coord_movement.eq.'uniform_stretching') then
- zstarWeight = 1.0
+ vertCoordMovementWeights = 1.0
- elseif (config_vert_grid_type.eq.'zstarWeights') then
-
- ! This is a test with other weights, just to make sure zstar functions
- ! using variable weights.
-
- zstarWeight = 0.0
- zstarWeight(1:5) = 1.0
- do k=1,10
- zstarWeight(5+k) = 1.0-k*0.1
- end do
-
endif
! Initial condition files (ocean.nc, produced by basin) include a realistic
@@ -768,13 +755,13 @@
! Compute barotropic velocity at first timestep
! This is only done upon start-up.
- if (trim(config_time_integration) == 'unsplit_explicit') then
+ if (trim(config_time_integrator) == 'unsplit_explicit') then
block % state % time_levs(1) % state % uBtr % array(:) = 0.0
block % state % time_levs(1) % state % uBcl % array(:,:) &
= block % state % time_levs(1) % state % u % array(:,:)
- elseif (trim(config_time_integration) == 'split_explicit') then
+ elseif (trim(config_time_integrator) == 'split_explicit') then
if (config_filter_btr_mode) then
do iCell=1,block % mesh % nCells
@@ -843,64 +830,6 @@
end subroutine ocn_init_split_timestep!}}}
- subroutine ocn_init_h_zstar(domain)!{{{
- ! If changing from zlevel to zstar, compute h based on zstar weights,
- ! where SSH is distributed through the layers. We only change h.
- ! We do not remap the tracer variables, so this breaks total global
- ! conservation.
-
- use mpas_grid_types
- use mpas_configure
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- type (block_type), pointer :: block
-
- integer :: i, iCell, iEdge, iVertex, k, nVertLevels
- integer, dimension(:), pointer :: maxLevelCell
-
- real (kind=RKIND) :: hSum, sumZstarWeights
- real (kind=RKIND), dimension(:), pointer :: hZLevel, zstarWeight, &
- refBottomDepth
- real (kind=RKIND), dimension(:,:), pointer :: h
-
- ! 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
- nVertLevels = block % mesh % nVertLevels
- hZLevel => block % mesh % hZLevel % array
- maxLevelCell => block % mesh % maxLevelCell % array
- zstarWeight => block % mesh % zstarWeight % array
- refBottomDepth => block % mesh % refBottomDepth % array
-
- do iCell=1,block % mesh % nCells
- ! Compute the total column thickness, hSum, and the sum of zstar weights.
- hSum = 0.0
- sumZstarWeights = 0.0
- do k = 1,maxLevelCell(iCell)
- hSum = hSum + h(k,iCell)
- sumZstarWeights = sumZstarWeights + zstarWeight(k)
- enddo
-
- ! h_k = h_k^{zlevel} + zeta * W_k/sum(W_k)
- ! where zeta is SSH and W_k are weights
- do k = 1,maxLevelCell(iCell)
- h(k,iCell) = hZLevel(k) &
- + (hSum - refBottomDepth(maxLevelCell(iCell))) &
- * zstarWeight(k)/sumZstarWeights
- enddo
-
- enddo
-
- block => block % next
- end do
-
- end subroutine ocn_init_h_zstar!}}}
-
subroutine ocn_compute_max_level(domain)!{{{
! Initialize maxLevel and bouncary grid variables.
@@ -951,7 +880,7 @@
! for z-grids, maxLevelCell should be in input state
! Isopycnal grid uses all vertical cells
- if (config_vert_grid_type.eq.'isopycnal') then
+ if (config_vert_coord_movement.eq.'isopycnal') then
maxLevelCell(1:nCells) = nVertLevels
endif
maxLevelCell(nCells+1) = 0
@@ -1072,7 +1001,7 @@
meshScalingDel2(:) = 1.0
meshScalingDel4(:) = 1.0
meshScaling(:) = 1.0
- if (config_h_ScaleWithMesh) then
+ if (config_hmix_ScaleWithMesh) then
do iEdge=1,mesh%nEdges
cell1 = mesh % cellsOnEdge % array(1,iEdge)
cell2 = mesh % cellsOnEdge % array(2,iEdge)
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_tendency.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_tendency.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_tendency.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -8,9 +8,7 @@
!> \version SVN:$Id:$
!> \details
!> This module contains the routines for computing
-!> various tendencies for the ocean. As well as routines
-!> for computing diagnostic variables, and other quantities
-!> such as wTop.
+!> tendency terms for the ocean primitive equations.
!
!-----------------------------------------------------------------------
@@ -25,32 +23,26 @@
use ocn_thick_hadv
use ocn_thick_vadv
- use ocn_gm
use ocn_vel_coriolis
use ocn_vel_pressure_grad
use ocn_vel_vadv
use ocn_vel_hmix
use ocn_vel_forcing
+ use ocn_vmix
use ocn_tracer_hadv
use ocn_tracer_vadv
use ocn_tracer_hmix
use ocn_restoring
- use ocn_equation_of_state
- use ocn_vmix
-
- use ocn_time_average
-
implicit none
private
save
- type (timer_node), pointer :: diagEOSTimer
type (timer_node), pointer :: thickHadvTimer, thickVadvTimer
- type (timer_node), pointer :: velCorTimer, velVadvTimer, velPgradTimer, velHmixTimer, velForceTimer, velExpVmixTimer
- type (timer_node), pointer :: tracerHadvTimer, tracerVadvTimer, tracerHmixTimer, tracerExpVmixTimer, tracerRestoringTimer
+ type (timer_node), pointer :: velCorTimer, velVadvTimer, velPgradTimer, velHmixTimer, velForceTimer
+ type (timer_node), pointer :: tracerHadvTimer, tracerVadvTimer, tracerHmixTimer, tracerRestoringTimer
!--------------------------------------------------------------------
!
@@ -66,13 +58,8 @@
public :: ocn_tend_h, &
ocn_tend_u, &
- ocn_tend_scalar, &
- ocn_diagnostic_solve, &
- ocn_wtop, &
- ocn_fuperp, &
- ocn_tendency_init, &
- ocn_filter_btr_mode_u, &
- ocn_filter_btr_mode_tend_u
+ ocn_tend_tracer, &
+ ocn_tendency_init
!--------------------------------------------------------------------
!
@@ -80,11 +67,6 @@
!
!--------------------------------------------------------------------
- integer :: hadv2nd, hadv3rd, hadv4th
- integer :: ke_cell_flag, ke_vertex_flag
- real (kind=RKIND) :: coef_3rd_order, fCoef
-
-
!***********************************************************************
contains
@@ -126,6 +108,8 @@
!
tend_h = 0.0
+ if(config_disable_h_all_tend) return
+
!
! height tendency: horizontal advection term -</font>
<font color="gray">abla\cdot ( hu)
!
@@ -203,9 +187,10 @@
!
! 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
+ if(config_disable_u_all_tend) return
+
!
! velocity tendency: nonlinear Coriolis term and grad of kinetic energy
!
@@ -225,7 +210,7 @@
! velocity tendency: pressure gradient
!
call mpas_timer_start("pressure grad", .false., velPgradTimer)
- if (config_pressure_type.eq.'MontgomeryPotential') then
+ if (config_pressure_gradient_type.eq.'MontgomeryPotential') then
call ocn_vel_pressure_grad_tend(grid, MontPot, zMid, rho, tend_u, err)
else
call ocn_vel_pressure_grad_tend(grid, pressure, zMid, rho, tend_u, err)
@@ -235,7 +220,7 @@
!
! velocity tendency: del2 dissipation, </font>
<font color="black">u_2 </font>
<font color="black">abla^2 u
! computed as </font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="gray">abla vorticity )
- ! strictly only valid for config_h_mom_eddy_visc2 == constant
+ ! 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)
@@ -244,8 +229,6 @@
!
! 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)
@@ -254,28 +237,23 @@
!
! velocity tendency: vertical mixing d/dz( nu_v du/dz))
!
- if (.not.config_implicit_vertical_mix) then
- call mpas_timer_start("explicit vmix", .false., velExpVmixTimer)
- call ocn_vel_vmix_tend_explicit(grid, u, h_edge, vertvisctopofedge, tend_u, err)
- call mpas_timer_stop("explicit vmix", velExpVmixTimer)
- endif
call mpas_timer_stop("ocn_tend_u")
end subroutine ocn_tend_u!}}}
!***********************************************************************
!
-! routine ocn_tendSalar
+! routine ocn_tend_tracer
!
-!> \brief Computes scalar tendency
+!> \brief Computes tracer tendency
!> \author Doug Jacobsen
!> \date 23 September 2011
!> \version SVN:$Id$
!> \details
-!> This routine computes the scalar (tracer) tendency for the ocean
+!> This routine computes tracer tendencies for the ocean
!
!-----------------------------------------------------------------------
- subroutine ocn_tend_scalar(tend, s, d, grid, dt)!{{{
+ subroutine ocn_tend_tracer(tend, s, d, grid, dt)!{{{
implicit none
type (tend_type), intent(inout) :: tend !< Input/Output: Tendency structure
@@ -291,7 +269,7 @@
integer :: err, iEdge, k
- call mpas_timer_start("ocn_tend_scalar")
+ call mpas_timer_start("ocn_tend_tracer")
uTransport => s % uTransport % array
h => s % h % array
@@ -303,6 +281,13 @@
tend_tr => tend % tracers % array
tend_h => tend % h % array
+ !
+ ! initialize tracer tendency (RHS of tracer equation) to zero.
+ !
+ tend_tr(:,:,:) = 0.0
+
+ if(config_disable_tr_all_tend) return
+
allocate(uh(grid % nVertLevels, grid % nEdges+1))
!
! QC Comment (3/15/12): need to make sure that uTransport is the right
@@ -314,17 +299,8 @@
end do
!
- ! initialize tracer tendency (RHS of tracer equation) to zero.
- !
- tend_tr(:,:,:) = 0.0
-
- !
! tracer tendency: horizontal advection term -div( h \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)
@@ -338,30 +314,7 @@
call ocn_tracer_hmix_tend(grid, h_edge, 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
-
!
- ! tracer tendency: vertical diffusion h d/dz( \kappa_v d\phi/dz)
- !
- if (.not.config_implicit_vertical_mix) then
- call mpas_timer_start("explicit vmix", .false., tracerExpVmixTimer)
-
- call ocn_tracer_vmix_tend_explicit(grid, h, vertdifftopofcell, tracers, tend_tr, err)
-
- call mpas_timer_stop("explicit vmix", tracerExpVmixTimer)
- endif
-
-! 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)
@@ -370,791 +323,14 @@
call mpas_timer_stop("restoring", tracerRestoringTimer)
- 10 format(2i8,10e20.10)
- call mpas_timer_stop("ocn_tend_scalar")
+ call mpas_timer_stop("ocn_tend_tracer")
deallocate(uh)
- end subroutine ocn_tend_scalar!}}}
+ end subroutine ocn_tend_tracer!}}}
!***********************************************************************
!
-! routine ocn_diagnostic_solve
-!
-!> \brief Computes diagnostic variables
-!> \author Doug Jacobsen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the diagnostic variables for the ocean
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_diagnostic_solve(dt, s, grid)!{{{
- implicit none
-
- real (kind=RKIND), intent(in) :: dt !< Input: Time step
- type (state_type), intent(inout) :: s !< Input/Output: State information
- type (mesh_type), intent(in) :: grid !< Input: Grid information
-
-
- integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
- integer :: boundaryMask, velMask, nCells, nEdges, nVertices, nVertLevels, vertexDegree, err
-
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
- maxLevelVertexBot
- integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &
- verticesOnEdge, edgesOnEdge, edgesOnVertex,boundaryCell, kiteIndexOnCell, verticesOnCell, edgeSignOnVertex, edgeSignOnCell, edgesOnCell
-
- real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2, coef_3rd_order, r_tmp, invAreaCell1, invAreaCell2, invAreaTri1, invAreaTri2, invLength, h_vertex
-
- real (kind=RKIND), dimension(:), allocatable:: pTop
-
- real (kind=RKIND), dimension(:), pointer :: &
- bottomDepth, fVertex, dvEdge, dcEdge, areaCell, areaTriangle, ssh
- 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, temperature, salinity, kev, kevc, uBolusGM, uTransport
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers, deriv_two
- real (kind=RKIND), dimension(:,:), allocatable:: div_u
- character :: c1*6
-
- h => s % h % array
- u => s % u % array
- uTransport => s % uTransport % array
- uBolusGM => s % uBolusGM % array
- v => s % v % array
- h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % 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
- gradVor_n => s % gradVor_n % array
- gradVor_t => s % gradVor_t % array
- rho => s % rho % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
- zMid => s % zMid % array
- ssh => s % ssh % array
- tracers => s % tracers % array
-
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnCell => grid % edgesOnCell % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- bottomDepth => grid % bottomDepth % array
- fVertex => grid % fVertex % array
- deriv_two => grid % deriv_two % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelEdgeBot => grid % maxLevelEdgeBot % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
- kiteIndexOnCell => grid % kiteIndexOnCell % array
- verticesOnCell => grid % verticesOnCell % array
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
- vertexDegree = grid % vertexDegree
-
- boundaryCell => grid % boundaryCell % array
-
- edgeSignOnVertex => grid % edgeSignOnVertex % array
- edgeSignOnCell => grid % edgeSignOnCell % array
-
-
- !
- ! Compute height on cell edges at velocity locations
- ! Namelist options control the order of accuracy of the reconstructed h_edge 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
- coef_3rd_order = config_coef_3rd_order
-
- do iEdge=1,nEdges*hadv2nd
- 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))
- end do
- end do
-
- do iEdge=1,nEdges*hadv3rd
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
-
- do k=1,maxLevelEdgeTop(iEdge)
-
- d2fdx2_cell1 = 0.0
- d2fdx2_cell2 = 0.0
-
- boundaryMask = abs(transfer(.not.(boundaryCell(k,cell1) == 0 .and. boundaryCell(k,cell2) == 0), boundaryMask))
-
- d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1) * boundaryMask
- d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2) * boundaryMask
-
- !-- all edges of cell 1
- do i=1, nEdgesOnCell(cell1) * boundaryMask
- d2fdx2_cell1 = d2fdx2_cell1 + &
- deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (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) * h(k,grid % CellsOnCell % array (i,cell2))
- end do
-
- velMask = 2*(abs(transfer(u(k,iEdge) <= 0, velMask))) - 1
-
- h_edge(k,iEdge) = 0.5*(h(k,cell1) + h(k,cell2)) - (dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
- + velMask * (dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
-
- end do ! do k
- end do ! do iEdge
-
- do iEdge=1,nEdges*hadv4th
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
-
- do k=1,maxLevelEdgeTop(iEdge)
-
- d2fdx2_cell1 = 0.0
- d2fdx2_cell2 = 0.0
-
- boundaryMask = abs(transfer(.not.(boundaryCell(k,cell1) == 0 .and. boundaryCell(k,cell2) == 0), boundaryMask))
-
- d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1) * boundaryMask
- d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2) * boundaryMask
-
- !-- all edges of cell 1
- do i=1, nEdgesOnCell(cell1) * boundaryMask
- d2fdx2_cell1 = d2fdx2_cell1 + &
- deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (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) * h(k,grid % CellsOnCell % array (i,cell2))
- end do
-
- h_edge(k,iEdge) = &
- 0.5*(h(k,cell1) + h(k,cell2)) &
- -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
-
- end do ! do k
- end do ! do iEdge
-
- !
- ! 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
- tracers(s % index_temperature,:,nCells+1) = -1e34
- tracers(s % index_salinity,:,nCells+1) = -1e34
-
- circulation(:,:) = 0.0
- vorticity(:,:) = 0.0
- divergence(:,:) = 0.0
- ke(:,:) = 0.0
- v(:,:) = 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)
-
- circulation(k, iVertex) = circulation(k, iVertex) + edgeSignOnVertex(i, iVertex) * r_tmp
- vorticity(k, iVertex) = vorticity(k, iVertex) + edgeSignOnVertex(i, iVertex) * r_tmp * invAreaTri1
- end do
- end do
- end do
-
- do iCell = 1, nCells
- invAreaCell1 = 1.0 / areaCell(iCell)
- do i = 1, nEdgesOnCell(iCell)
- iEdge = edgesOnCell(i, iCell)
- do k = 1, maxLevelCell(iCell)
- r_tmp = dvEdge(iEdge) * u(k, iEdge) * invAreaCell1
-
- divergence(k, iCell) = divergence(k, iCell) - edgeSignOnCell(i, iCell) * r_tmp
- ke(k, iCell) = ke(k, iCell) + 0.25 * r_tmp * dcEdge(iEdge) * u(k,iEdge)
- end do
- end do
- end do
-
- do iEdge=1,nEdges
- ! 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)
- end do
- end do
-
- end do
-
- !
- ! Compute kinetic energy in each vertex
- !
- kev(:,:) = 0.0; kevc(:,:) = 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
- end do
- end do
- end do
-
- do iCell = 1, nCells*ke_vertex_flag
- invAreaCell1 = 1.0 / areaCell(iCell)
- do i = 1, nEdgesOnCell(iCell)
- 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
- end do
- end do
- end do
-
- !
- ! Compute kinetic energy in each cell by blending ke and kevc
- !
- 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)
- end do
- end do
-
- !
- ! Compute ke 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))
- 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 )
- !
- do iVertex = 1,nVertices
- invAreaTri1 = 1.0 / areaTriangle(iVertex)
- do k=1,maxLevelVertexBot(iVertex)
- h_vertex = 0.0
- do i=1,vertexDegree
- h_vertex = h_vertex + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
- end do
- h_vertex = h_vertex * invAreaTri1
-
- Vor_vertex(k,iVertex) = (fCoef*fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
- end do
- end do
-
- Vor_cell(:,:) = 0.0
- Vor_edge(:,:) = 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))
- end do
- end do
-
- do iCell = 1, nCells
- invAreaCell1 = 1.0 / areaCell(iCell)
-
- do i = 1, nEdgesOnCell(iCell)
- 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
- end do
- end do
- end do
-
- do iEdge = 1,nEdges
- cell1 = cellsOnEdge(1, iEdge)
- cell2 = cellsOnEdge(2, iEdge)
- vertex1 = verticesOnedge(1, iEdge)
- vertex2 = verticesOnedge(2, iEdge)
-
- invLength = 1.0 / dcEdge(iEdge)
- ! 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
- 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
- enddo
-
- enddo
-
- !
- ! Modify PV edge with upstream bias.
- !
- 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) )
- enddo
- enddo
-
- !
- ! equation of state
- !
- ! For an isopycnal model, density should remain constant.
- ! For zlevel, calculate in-situ density
- if (config_vert_grid_type.ne.'isopycnal') then
- call mpas_timer_start("equation of state", .false., diagEOSTimer)
- call ocn_equation_of_state_rho(s, grid, 0, 'relative', err)
- ! mrp 110324 In order to visualize rhoDisplaced, include the following
- call ocn_equation_of_state_rho(s, grid, 1, 'relative', err)
- call mpas_timer_stop("equation of state", diagEOSTimer)
- endif
-
- !
- ! Pressure
- ! This section must be after computing rho
- !
- ! dwj: 10/25/2011 - Need to explore isopycnal vs zlevel flags
- if (config_pressure_type.eq.'MontgomeryPotential') then
-
- ! For Isopycnal model.
- ! Compute pressure at top of each layer, and then
- ! Montgomery Potential.
- allocate(pTop(nVertLevels))
- do iCell=1,nCells
-
- ! assume atmospheric pressure at the surface is zero for now.
- pTop(1) = 0.0
- ! 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)))
-
- do k=2,nVertLevels
- pTop(k) = pTop(k-1) + rho(k-1,iCell)*gravity* h(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))
- end do
-
- end do
- deallocate(pTop)
-
- else
-
- do iCell=1,nCells
- ! pressure for generalized coordinates
- ! assume atmospheric pressure at the surface is zero for now.
- pressure(1,iCell) = rho(1,iCell)*gravity &
- * 0.5*h(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))
- end do
-
- ! Compute zMid, the z-coordinate of the middle of the layer.
- ! This is used for the rho 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)
-
- do k=maxLevelCell(iCell)-1, 1, -1
- zMid(k,iCell) = zMid(k+1,iCell) &
- + 0.5*( h(k+1,iCell) &
- + h(k ,iCell))
- end do
-
- end do
-
- endif
-
- !
- ! Sea Surface Height
- !
- do iCell=1,nCells
- ! Start at the bottom where we know the depth, and go up.
- ! The bottom depth for this cell is bottomDepth(iCell).
- ! 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))
-
- end do
-
- !
- ! Apply the GM closure as a bolus velocity
- !
- 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
-
- end subroutine ocn_diagnostic_solve!}}}
-
-!***********************************************************************
-!
-! routine ocn_wtop
-!
-!> \brief Computes vertical velocity
-!> \author Doug Jacobsen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical velocity in the top layer for the ocean
-!
-!-----------------------------------------------------------------------
- subroutine ocn_wtop(grid,h,h_edge,u,wTop, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: h interpolated to an edge
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(out) :: &
- wTop !< Output: vertical transport at top edge
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- 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
-
- integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree
-
-
- real (kind=RKIND), dimension(:), pointer :: &
- dvEdge, areaCell, zstarWeight
- real (kind=RKIND), dimension(:), allocatable:: div_hu, h_tend_col
- real (kind=RKIND) :: div_hu_btr
-
- integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &
- verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &
- boundaryEdge, boundaryCell, edgeSignOnCell
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
- maxLevelVertexBot, maxLevelVertexTop
-
- err = 0
-
- nEdgesOnCell => grid % nEdgesOnCell % array
- areaCell => grid % areaCell % array
- cellsOnEdge => grid % cellsOnEdge % array
- edgesOnCell => grid % edgesOnCell % array
- edgeSignOnCell => grid % edgeSignOnCell % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeBot => grid % maxLevelEdgeBot % array
- dvEdge => grid % dvEdge % array
- zstarWeight => grid % zstarWeight % array
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nVertLevels = grid % nVertLevels
-
-
- if (config_vert_grid_type.eq.'isopycnal') then
- ! set vertical velocity to zero in isopycnal case
- wTop=0.0_RKIND
- return
- end if
-
- allocate(div_hu(nVertLevels), h_tend_col(nVertLevels))
-
- !
- ! Compute div(h^{edge} u) for each cell
- ! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
- !
-
- do iCell=1,nCells
- div_hu(:) = 0.0_RKIND
- div_hu_btr = 0.0_RKIND
- hSum = 0.0_RKIND
- invAreaCell = 1.0_RKIND / areaCell(iCell)
-
- 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 = edgeSignOnCell(i, iCell) * flux * 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) = - zstarWeight(k) * h(k, iCell) * div_hu_btr
- hSum = hSum + zstarWeight(k) * h(k, iCell)
- end do
-
- if(hSum > 0.0) then
- h_tend_col = h_tend_col / hSum
- end if
-
- ! Vertical velocity through layer interface at top and
- ! bottom is zero.
- wTop(1,iCell) = 0.0_RKIND
- wTop(maxLevelCell(iCell)+1,iCell) = 0.0_RKIND
- do k=maxLevelCell(iCell),2,-1
- wTop(k,iCell) = wTop(k+1,iCell) - div_hu(k) - h_tend_col(k)
- end do
- end do
-
- deallocate(div_hu, h_tend_col)
-
- end subroutine ocn_wtop!}}}
-
-!***********************************************************************
-!
-! routine ocn_fuperp
-!
-!> \brief Computes f u_perp
-!> \author Doug Jacobsen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes f u_perp for the ocean
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_fuperp(s, grid)!{{{
- implicit none
-
- 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
- type (dm_info) :: dminfo
-
- integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnEdge
- integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnEdge
-
- call mpas_timer_start("ocn_fuperp")
-
- u => s % u % array
- uBcl => s % uBcl % array
- weightsOnEdge => grid % weightsOnEdge % array
- fEdge => grid % fEdge % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- cellsOnEdge => grid % cellsOnEdge % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
-
- fEdge => grid % fEdge % array
-
- nEdgesSolve = grid % nEdgesSolve
-
- !
- ! Put f*uBcl^{perp} in u as a work variable
- !
- do iEdge=1,nEdgesSolve
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
-
- do k=1,maxLevelEdgeTop(iEdge)
-
- u(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)
- end do
- end do
- end do
-
- call mpas_timer_stop("ocn_fuperp")
-
- end subroutine ocn_fuperp!}}}
-
-!***********************************************************************
-!
-! routine ocn_filter_btr_mode_u
-!
-!> \brief filters barotropic mode out of the velocity variable.
-!> \author Mark Petersen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine filters barotropic mode out of the velocity variable.
-!
-!-----------------------------------------------------------------------
- subroutine ocn_filter_btr_mode_u(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
- integer, dimension(:), pointer :: maxLevelEdgeTop
-
- call mpas_timer_start("ocn_filter_btr_mode_u")
-
- u => s % u % array
- h_edge => s % h_edge % 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
- ! nonzero value to avoid a NaN.
- uhSum = h_edge(1,iEdge) * u(1,iEdge)
- hSum = h_edge(1,iEdge)
-
- do k=2,maxLevelEdgeTop(iEdge)
- uhSum = uhSum + h_edge(k,iEdge) * u(k,iEdge)
- hSum = hSum + h_edge(k,iEdge)
- enddo
-
- vertSum = uhSum/hSum
- do k=1,maxLevelEdgeTop(iEdge)
- u(k,iEdge) = u(k,iEdge) - vertSum
- enddo
- enddo ! iEdge
-
- call mpas_timer_stop("ocn_filter_btr_mode_u")
-
- end subroutine ocn_filter_btr_mode_u!}}}
-
-!***********************************************************************
-!
-! routine ocn_filter_btr_mode_tend_u
-!
-!> \brief ocn_filters barotropic mode out of the u tendency
-!> \author Mark Petersen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine filters barotropic mode out of the u tendency.
-!
-!-----------------------------------------------------------------------
- subroutine ocn_filter_btr_mode_tend_u(tend, s, grid)!{{{
- implicit none
-
- type (tend_type), intent(inout) :: tend
- type (state_type), intent(in) :: s
- 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
-
- integer, dimension(:), pointer :: maxLevelEdgeTop
-
- call mpas_timer_start("ocn_filter_btr_mode_tend_u")
-
- tend_u => tend % u % array
- h_edge => s % h_edge % 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
- ! nonzero value to avoid a NaN.
- uhSum = h_edge(1,iEdge) * tend_u(1,iEdge)
- hSum = h_edge(1,iEdge)
-
- do k=2,maxLevelEdgeTop(iEdge)
- uhSum = uhSum + h_edge(k,iEdge) * tend_u(k,iEdge)
- hSum = hSum + h_edge(k,iEdge)
- enddo
-
- vertSum = uhSum/hSum
- do k=1,maxLevelEdgeTop(iEdge)
- tend_u(k,iEdge) = tend_u(k,iEdge) - vertSum
- enddo
- enddo ! iEdge
-
- call mpas_timer_stop("ocn_filter_btr_mode_tend_u")
-
- end subroutine ocn_filter_btr_mode_tend_u!}}}
-
-!***********************************************************************
-!
! routine ocn_tendency_init
!
!> \brief Initializes flags used within tendency routines.
@@ -1171,49 +347,6 @@
err = 0
- coef_3rd_order = 0.
-
- if (config_thickness_adv_order == 2) then
- hadv2nd = 1
- hadv3rd = 0
- hadv4th = 0
- else if (config_thickness_adv_order == 3) then
- hadv2nd = 0
- hadv3rd = 1
- hadv4th = 0
-
- if(config_monotonic) then
- coef_3rd_order = 0.25
- else
- coef_3rd_order = 1.0
- endif
- else if (config_thickness_adv_order == 4) then
- hadv2nd = 0
- hadv3rd = 0
- hadv4th = 1
- end if
-
-
- if(config_include_KE_vertex) then
- ke_vertex_flag = 1
- ke_cell_flag = 0
- else
- ke_vertex_flag = 0
- ke_cell_flag = 1
- endif
-
- if (trim(config_time_integration) == 'RK4') then
- ! for RK4, PV is really PV = (eta+f)/h
- fCoef = 1
- elseif (trim(config_time_integration) == 'split_explicit' &
- .or.trim(config_time_integration) == 'unsplit_explicit') then
- ! for split explicit, PV is eta/h because f is added separately to the momentum forcing.
- ! mrp temp, new should be:
- fCoef = 0
- ! old, for testing:
- ! fCoef = 1
- end if
-
end subroutine ocn_tendency_init!}}}
!***********************************************************************
Deleted: branches/atmos_physics/src/core_ocean/mpas_ocn_test_cases.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_test_cases.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_test_cases.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,526 +0,0 @@
- module ocn_test_cases
-
- use mpas_grid_types
- use mpas_configure
- use mpas_constants
-
-
- contains
-
-
- subroutine setup_sw_test_case(domain)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Configure grid metadata and model state for the shallow water test case
- ! specified in the namelist
- !
- ! Output: block - a subset (not necessarily proper) of the model domain to be
- ! initialized
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- integer :: i, iCell, iEdge, iVtx, iLevel
- type (block_type), pointer :: block_ptr
- type (dm_info) :: dminfo
-
- if (config_test_case == 0) then
- write(0,*) 'Using initial conditions supplied in input file'
-
- else if (config_test_case == 1) then
- write(0,*) ' Setting up shallow water test case 1:'
- write(0,*) ' Advection of Cosine Bell over the Pole'
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
- call sw_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
- block_ptr => block_ptr % next
- end do
-
- else if (config_test_case == 2) then
- write(0,*) ' Setup shallow water test case 2: '// &
- 'Global Steady State Nonlinear Zonal Geostrophic Flow'
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
- call sw_test_case_2(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
- block_ptr => block_ptr % next
- end do
-
- else if (config_test_case == 5) then
- write(0,*) ' Setup shallow water test case 5:'// &
- ' Zonal Flow over an Isolated Mountain'
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
- call sw_test_case_5(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
- block_ptr => block_ptr % next
- end do
-
- else if (config_test_case == 6) then
- write(0,*) ' Set up shallow water test case 6:'
- write(0,*) ' Rossby-Haurwitz Wave'
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
- call sw_test_case_6(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
- block_ptr => block_ptr % next
- end do
-
- else
- write(0,*) 'Abort: config_test_case=',config_test_case
- write(0,*) 'Only test case 1, 2, 5, and 6 ', &
- 'are currently supported. '
- call mpas_dmpar_abort(dminfo)
- end if
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
-
- do i=2,nTimeLevs
- call mpas_copy_state(block_ptr % state % time_levs(i) % state, &
- block_ptr % state % time_levs(1) % state)
- end do
-
- block_ptr => block_ptr % next
- end do
-
- end subroutine setup_sw_test_case
-
-
- subroutine sw_test_case_1(grid, state)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Setup shallow water test case 1: Advection of Cosine Bell over the Pole
- !
- ! Reference: Williamson, D.L., et al., "A Standard Test Set for Numerical
- ! Approximations to the Shallow Water Equations in Spherical
- ! Geometry" J. of Comp. Phys., 102, pp. 211--224
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- type (mesh_type), intent(inout) :: grid
- type (state_type), intent(inout) :: state
-
- real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
- real (kind=RKIND), parameter :: h0 = 1000.0
- real (kind=RKIND), parameter :: theta_c = 0.0
- real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
- real (kind=RKIND), parameter :: alpha = pii/4.0
-
- integer :: iCell, iEdge, iVtx
- real (kind=RKIND) :: r, u, v
- real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
- !
- ! Scale all distances and areas from a unit sphere to one with radius a
- !
- grid % xCell % array = grid % xCell % array * a
- grid % yCell % array = grid % yCell % array * a
- grid % zCell % array = grid % zCell % array * a
- grid % xVertex % array = grid % xVertex % array * a
- grid % yVertex % array = grid % yVertex % array * a
- grid % zVertex % array = grid % zVertex % array * a
- grid % xEdge % array = grid % xEdge % array * a
- grid % yEdge % array = grid % yEdge % array * a
- grid % zEdge % array = grid % zEdge % array * a
- grid % dvEdge % array = grid % dvEdge % array * a
- grid % dcEdge % array = grid % dcEdge % array * a
- grid % areaCell % array = grid % areaCell % array * a**2.0
- grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
- grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
- !
- ! Initialize wind field
- !
- allocate(psiVertex(grid % nVertices))
- do iVtx=1,grid % nVertices
- psiVertex(iVtx) = -a * u0 * ( &
- sin(grid%latVertex%array(iVtx)) * cos(alpha) - &
- cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &
- )
- end do
- do iEdge=1,grid % nEdges
- state % u % array(1,iEdge) = -1.0 * ( &
- psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
- psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
- ) / grid%dvEdge%array(iEdge)
- end do
- deallocate(psiVertex)
-
- !
- ! Initialize cosine bell at (theta_c, lambda_c)
- !
- do iCell=1,grid % nCells
- r = sphere_distance(theta_c, lambda_c, grid % latCell % array(iCell), grid % lonCell % array(iCell), a)
- if (r < a/3.0) then
- state % h % array(1,iCell) = (h0 / 2.0) * (1.0 + cos(pii*r*3.0/a))
- else
- state % h % array(1,iCell) = 0.0
- end if
- end do
-
- end subroutine sw_test_case_1
-
-
- subroutine sw_test_case_2(grid, state)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Setup shallow water test case 2: Global Steady State Nonlinear Zonal
- ! Geostrophic Flow
- !
- ! Reference: Williamson, D.L., et al., "A Standard Test Set for Numerical
- ! Approximations to the Shallow Water Equations in Spherical
- ! Geometry" J. of Comp. Phys., 102, pp. 211--224
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- type (mesh_type), intent(inout) :: grid
- type (state_type), intent(inout) :: state
-
- real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
- real (kind=RKIND), parameter :: gh0 = 29400.0
- real (kind=RKIND), parameter :: alpha = 0.0
-
- integer :: iCell, iEdge, iVtx
- real (kind=RKIND) :: u, v
- real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-
- !
- ! Scale all distances and areas from a unit sphere to one with radius a
- !
- grid % xCell % array = grid % xCell % array * a
- grid % yCell % array = grid % yCell % array * a
- grid % zCell % array = grid % zCell % array * a
- grid % xVertex % array = grid % xVertex % array * a
- grid % yVertex % array = grid % yVertex % array * a
- grid % zVertex % array = grid % zVertex % array * a
- grid % xEdge % array = grid % xEdge % array * a
- grid % yEdge % array = grid % yEdge % array * a
- grid % zEdge % array = grid % zEdge % array * a
- grid % dvEdge % array = grid % dvEdge % array * a
- grid % dcEdge % array = grid % dcEdge % array * a
- grid % areaCell % array = grid % areaCell % array * a**2.0
- grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
- grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-
- !
- ! Initialize wind field
- !
- allocate(psiVertex(grid % nVertices))
- do iVtx=1,grid % nVertices
- psiVertex(iVtx) = -a * u0 * ( &
- sin(grid%latVertex%array(iVtx)) * cos(alpha) - &
- cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &
- )
- end do
- do iEdge=1,grid % nEdges
- state % u % array(1,iEdge) = -1.0 * ( &
- psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
- psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
- ) / grid%dvEdge%array(iEdge)
- end do
- deallocate(psiVertex)
-
- !
- ! Generate rotated Coriolis field
- !
- do iEdge=1,grid % nEdges
- grid % fEdge % array(iEdge) = 2.0 * omega * &
- ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &
- sin(grid%latEdge%array(iEdge)) * cos(alpha) &
- )
- end do
- do iVtx=1,grid % nVertices
- grid % fVertex % array(iVtx) = 2.0 * omega * &
- (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &
- sin(grid%latVertex%array(iVtx)) * cos(alpha) &
- )
- end do
-
- !
- ! Initialize height field (actually, fluid thickness field)
- !
- do iCell=1,grid % nCells
- state % h % array(1,iCell) = (gh0 - (a * omega * u0 + 0.5 * u0**2.0) * &
- (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &
- sin(grid%latCell%array(iCell)) * cos(alpha) &
- )**2.0 &
- ) / &
- gravity
- end do
-
- end subroutine sw_test_case_2
-
-
- subroutine sw_test_case_5(grid, state)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Setup shallow water test case 5: Zonal Flow over an Isolated Mountain
- !
- ! Reference: Williamson, D.L., et al., "A Standard Test Set for Numerical
- ! Approximations to the Shallow Water Equations in Spherical
- ! Geometry" J. of Comp. Phys., 102, pp. 211--224
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- type (mesh_type), intent(inout) :: grid
- type (state_type), intent(inout) :: state
-
- real (kind=RKIND), parameter :: u0 = 20.
- real (kind=RKIND), parameter :: gh0 = 5960.0*gravity
-! real (kind=RKIND), parameter :: hs0 = 2000. original
- real (kind=RKIND), parameter :: hs0 = 250. !mrp 100204
- real (kind=RKIND), parameter :: theta_c = pii/6.0
- real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
- real (kind=RKIND), parameter :: rr = pii/9.0
- real (kind=RKIND), parameter :: alpha = 0.0
-
- integer :: iCell, iEdge, iVtx
- real (kind=RKIND) :: r, u, v
- real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-
- !
- ! Scale all distances and areas from a unit sphere to one with radius a
- !
- grid % xCell % array = grid % xCell % array * a
- grid % yCell % array = grid % yCell % array * a
- grid % zCell % array = grid % zCell % array * a
- grid % xVertex % array = grid % xVertex % array * a
- grid % yVertex % array = grid % yVertex % array * a
- grid % zVertex % array = grid % zVertex % array * a
- grid % xEdge % array = grid % xEdge % array * a
- grid % yEdge % array = grid % yEdge % array * a
- grid % zEdge % array = grid % zEdge % array * a
- grid % dvEdge % array = grid % dvEdge % array * a
- grid % dcEdge % array = grid % dcEdge % array * a
- grid % areaCell % array = grid % areaCell % array * a**2.0
- grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
- grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
- !
- ! Initialize wind field
- !
- allocate(psiVertex(grid % nVertices))
- do iVtx=1,grid % nVertices
- psiVertex(iVtx) = -a * u0 * ( &
- sin(grid%latVertex%array(iVtx)) * cos(alpha) - &
- cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &
- )
- end do
- do iEdge=1,grid % nEdges
- state % u % array(1,iEdge) = -1.0 * ( &
- psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
- psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
- ) / grid%dvEdge%array(iEdge)
- end do
- deallocate(psiVertex)
-
- !
- ! Generate rotated Coriolis field
- !
- do iEdge=1,grid % nEdges
- grid % fEdge % array(iEdge) = 2.0 * omega * &
- (-cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &
- sin(grid%latEdge%array(iEdge)) * cos(alpha) &
- )
- end do
- do iVtx=1,grid % nVertices
- grid % fVertex % array(iVtx) = 2.0 * omega * &
- (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &
- sin(grid%latVertex%array(iVtx)) * cos(alpha) &
- )
- end do
-
- !
- ! Initialize mountain
- !
- do iCell=1,grid % nCells
- if (grid % lonCell % array(iCell) < 0.0) grid % lonCell % array(iCell) = grid % lonCell % array(iCell) + 2.0 * pii
- r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + (grid % latCell % array(iCell) - theta_c)**2.0))
- grid % bottomDepth % array(iCell) = hs0 * (1.0 - r/rr)
- end do
-! output about mountain
-print *, 'bottomDepth',minval(grid % bottomDepth % array),sum(grid % bottomDepth % array)/grid % nCells, maxval(grid % bottomDepth % array)
-
- !
- ! Initialize tracer fields
- !
- do iCell=1,grid % nCells
- r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + (grid % latCell % array(iCell) - theta_c)**2.0))
- state % tracers % array(1,1,iCell) = 1.0 - r/rr
- end do
- do iCell=1,grid % nCells
- r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + &
- (grid % latCell % array(iCell) - theta_c - pii/6.0)**2.0 &
- ) &
- )
- state % tracers % array(2,1,iCell) = 1.0 - r/rr
- end do
-
- !
- ! Initialize height field (actually, fluid thickness field)
- !
- do iCell=1,grid % nCells
- state % h % array(1,iCell) = (gh0 - (a * omega * u0 + 0.5 * u0**2.0) * &
- (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &
- sin(grid%latCell%array(iCell)) * cos(alpha) &
- )**2.0 &
- ) / &
- gravity
- state % h % array(1,iCell) = state % h % array(1,iCell) - grid % bottomDepth % array(iCell)
- end do
-
- end subroutine sw_test_case_5
-
-
- subroutine sw_test_case_6(grid, state)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Setup shallow water test case 6: Rossby-Haurwitz Wave
- !
- ! Reference: Williamson, D.L., et al., "A Standard Test Set for Numerical
- ! Approximations to the Shallow Water Equations in Spherical
- ! Geometry" J. of Comp. Phys., 102, pp. 211--224
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- type (mesh_type), intent(inout) :: grid
- type (state_type), intent(inout) :: state
-
- real (kind=RKIND), parameter :: h0 = 8000.0
- real (kind=RKIND), parameter :: w = 7.848e-6
- real (kind=RKIND), parameter :: K = 7.848e-6
- real (kind=RKIND), parameter :: R = 4.0
-
- integer :: iCell, iEdge, iVtx
- real (kind=RKIND) :: u, v
- real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-
- !
- ! Scale all distances and areas from a unit sphere to one with radius a
- !
- grid % xCell % array = grid % xCell % array * a
- grid % yCell % array = grid % yCell % array * a
- grid % zCell % array = grid % zCell % array * a
- grid % xVertex % array = grid % xVertex % array * a
- grid % yVertex % array = grid % yVertex % array * a
- grid % zVertex % array = grid % zVertex % array * a
- grid % xEdge % array = grid % xEdge % array * a
- grid % yEdge % array = grid % yEdge % array * a
- grid % zEdge % array = grid % zEdge % array * a
- grid % dvEdge % array = grid % dvEdge % array * a
- grid % dcEdge % array = grid % dcEdge % array * a
- grid % areaCell % array = grid % areaCell % array * a**2.0
- grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
- grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
- !
- ! Initialize wind field
- !
- allocate(psiVertex(grid % nVertices))
- do iVtx=1,grid % nVertices
- psiVertex(iVtx) = -a * a * w * sin(grid%latVertex%array(iVtx)) + &
- a *a * K * (cos(grid%latVertex%array(iVtx))**R) * &
- sin(grid%latVertex%array(iVtx)) * cos(R * grid%lonVertex%array(iVtx))
- end do
- do iEdge=1,grid % nEdges
- state % u % array(1,iEdge) = -1.0 * ( &
- psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
- psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
- ) / grid%dvEdge%array(iEdge)
- end do
- deallocate(psiVertex)
-
- !
- ! Initialize height field (actually, fluid thickness field)
- !
- do iCell=1,grid % nCells
- state % h % array(1,iCell) = (gravity * h0 + a*a*aa(grid%latCell%array(iCell)) + &
- a*a*bb(grid%latCell%array(iCell)) * cos(R*grid%lonCell%array(iCell)) + &
- a*a*cc(grid%latCell%array(iCell)) * cos(2.0*R*grid%lonCell%array(iCell)) &
- ) / gravity
- end do
-
- end subroutine sw_test_case_6
-
-
- real 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 function aa(theta)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! A, used in height field computation for Rossby-Haurwitz wave
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- real (kind=RKIND), parameter :: w = 7.848e-6
- real (kind=RKIND), parameter :: K = 7.848e-6
- real (kind=RKIND), parameter :: R = 4.0
-
- real (kind=RKIND), intent(in) :: theta
-
- aa = 0.5 * w * (2.0 * omega + w) * cos(theta)**2.0 + &
- 0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 + 2.0*R**2.0 - R - 2.0 - 2.0*R**2*cos(theta)**(-2.0))
-
- end function aa
-
-
- real function bb(theta)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! B, used in height field computation for Rossby-Haurwitz wave
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- real (kind=RKIND), parameter :: w = 7.848e-6
- real (kind=RKIND), parameter :: K = 7.848e-6
- real (kind=RKIND), parameter :: R = 4.0
-
- real (kind=RKIND), intent(in) :: theta
-
- bb = (2.0*(omega + w)*K / ((R+1.0)*(R+2.0))) * cos(theta)**R * ((R**2.0 + 2.0*R + 2.0) - ((R+1.0)*cos(theta))**2.0)
-
- end function bb
-
-
- real function cc(theta)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! C, used in height field computation for Rossby-Haurwitz wave
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- real (kind=RKIND), parameter :: w = 7.848e-6
- real (kind=RKIND), parameter :: K = 7.848e-6
- real (kind=RKIND), parameter :: R = 4.0
-
- real (kind=RKIND), intent(in) :: theta
-
- cc = 0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 - R - 2.0)
-
- end function cc
-
-end module ocn_test_cases
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_thick_hadv.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_thick_hadv.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_thick_hadv.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -41,8 +41,9 @@
! Private module variables
!
!--------------------------------------------------------------------
+
+ logical :: thickHadvOn
-
!***********************************************************************
contains
@@ -120,6 +121,8 @@
err = 0
+ if(.not.thickHadvOn) return
+
nEdges = grid % nEdges
nCells = grid % nCells
nVertLevels = grid % nVertLevels
@@ -175,6 +178,10 @@
integer, intent(out) :: err !< Output: error flag
+ thickHadvOn = .true.
+
+ if(config_disable_h_hadv) thickHadvOn = .false.
+
err = 0
!--------------------------------------------------------------------
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_thick_vadv.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_thick_vadv.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_thick_vadv.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -42,6 +42,7 @@
!
!--------------------------------------------------------------------
+ logical :: thickVadvOn
!***********************************************************************
@@ -111,6 +112,8 @@
err = 0
+ if(.not.thickVadvOn) return
+
maxLevelCell => grid % maxLevelCell % array
nCells = grid % nCells
@@ -151,6 +154,10 @@
!-----------------------------------------------------------------
integer, intent(out) :: err !< Output: error flag
+
+ thickVadvOn = .true.
+
+ if(config_disable_h_vadv) thickVadvOn = .false.
err = 0
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_time_average.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_time_average.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_time_average.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -11,11 +11,11 @@
subroutine ocn_time_average_init(state)!{{{
type (state_type), intent(inout) :: state
- real, pointer :: nAccumulate
+ real (kind=RKIND), pointer :: nAccumulate
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
+ real (kind=RKIND), dimension(:,:), pointer :: acc_u, acc_uVar, acc_vertVelocityTop
nAccumulate => state % nAccumulate % scalar
@@ -27,6 +27,7 @@
acc_uReconstructMeridionalVar => state % acc_uReconstructMeridionalVar % array
acc_u => state % acc_u % array
acc_uVar => state % acc_uVar % array
+ acc_vertVelocityTop => state % acc_vertVelocityTop % array
nAccumulate = 0
@@ -38,6 +39,7 @@
acc_uReconstructMeridionalVar = 0.0
acc_u = 0.0
acc_uVar = 0.0
+ acc_vertVelocityTop = 0.0
end subroutine ocn_time_average_init!}}}
@@ -45,16 +47,16 @@
type (state_type), intent(inout) :: state
type (state_type), intent(in) :: old_state
- real, pointer :: nAccumulate, old_nAccumulate
+ real (kind=RKIND), pointer :: nAccumulate, old_nAccumulate
real (kind=RKIND), dimension(:), pointer :: ssh
- real (kind=RKIND), dimension(:,:), pointer :: uReconstructZonal, uReconstructMeridional, u
+ real (kind=RKIND), dimension(:,:), pointer :: uReconstructZonal, uReconstructMeridional, u, vertVelocityTop
- real (kind=RKIND), dimension(:,:), pointer :: acc_u, acc_uVar
+ 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 :: old_acc_u, old_acc_uVar
+ 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
@@ -65,6 +67,7 @@
uReconstructZonal => state % uReconstructZonal % array
uReconstructMeridional => state % uReconstructMeridional % array
u => state % u % array
+ vertVelocityTop => state % vertVelocityTop % array
acc_ssh => state % acc_ssh % array
acc_sshVar => state % acc_sshVar % array
@@ -74,6 +77,7 @@
acc_uReconstructMeridionalVar => state % acc_uReconstructMeridionalVar % array
acc_u => state % acc_u % array
acc_uVar => state % acc_uVar % array
+ acc_vertVelocityTop => state % acc_vertVelocityTop % array
old_acc_ssh => old_state % acc_ssh % array
old_acc_sshVar => old_state % acc_sshVar % array
@@ -83,6 +87,7 @@
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
acc_ssh = old_acc_ssh + ssh
acc_sshVar = old_acc_sshVar + ssh**2
@@ -92,6 +97,7 @@
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
nAccumulate = old_nAccumulate + 1
end subroutine ocn_time_average_accumulate!}}}
@@ -99,11 +105,11 @@
subroutine ocn_time_average_normalize(state)!{{{
type (state_type), intent(inout) :: state
- real, pointer :: nAccumulate
+ real (kind=RKIND), pointer :: nAccumulate
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
+ real (kind=RKIND), dimension(:,:), pointer :: acc_u, acc_uVar, acc_vertVelocityTop
nAccumulate => state % nAccumulate % scalar
@@ -115,6 +121,7 @@
acc_uReconstructMeridionalVar => state % acc_uReconstructMeridionalVar % array
acc_u => state % acc_u % array
acc_uVar => state % acc_uVar % array
+ acc_vertVelocityTop => state % acc_vertVelocityTop % array
if(nAccumulate > 0) then
acc_ssh = acc_ssh / nAccumulate
@@ -125,6 +132,7 @@
acc_uReconstructMeridionalVar = acc_uReconstructMeridionalVar / nAccumulate
acc_u = acc_u / nAccumulate
acc_uVar = acc_uVar / nAccumulate
+ acc_vertVelocityTop = acc_vertVelocityTop / nAccumulate
end if
end subroutine ocn_time_average_normalize!}}}
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_time_integration.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_time_integration.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_time_integration.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -85,6 +85,8 @@
real (kind=RKIND), intent(in) :: dt
character(len=*), intent(in) :: timeStamp
+ real (kind=RKIND) :: nanCheck
+
type (dm_info) :: dminfo
type (block_type), pointer :: block
@@ -98,7 +100,9 @@
do while (associated(block))
block % state % time_levs(2) % state % xtime % scalar = timeStamp
- if (isNaN(sum(block % state % time_levs(2) % state % u % array))) then
+ nanCheck = sum(block % state % time_levs(2) % state % u % array)
+
+ if (nanCheck /= nanCheck) then
write(0,*) 'Abort: NaN detected'
call mpas_dmpar_abort(dminfo)
endif
@@ -117,14 +121,14 @@
rk4On = .false.
splitOn = .false.
- if (trim(config_time_integration) == 'RK4') then
+ if (trim(config_time_integrator) == 'RK4') then
rk4On = .true.
- elseif (trim(config_time_integration) == 'split_explicit' &
- .or.trim(config_time_integration) == 'unsplit_explicit') then
+ elseif (trim(config_time_integrator) == 'split_explicit' &
+ .or.trim(config_time_integrator) == 'unsplit_explicit') then
splitOn = .true.
else
err = 1
- write(*,*) 'Incorrect choice for config_time_integration:', trim(config_time_integration)
+ write(*,*) 'Incorrect choice for config_time_integrator:', trim(config_time_integrator)
write(*,*) ' choices are: RK4, split_explicit, unsplit_explicit'
endif
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_time_integration_rk4.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_time_integration_rk4.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_time_integration_rk4.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -22,6 +22,7 @@
use mpas_timer
use ocn_tendency
+ use ocn_diagnostics
use ocn_equation_of_state
use ocn_vmix
@@ -137,7 +138,7 @@
call mpas_timer_start("RK4-diagnostic halo update")
call mpas_dmpar_exch_halo_field(domain % blocklist % provis % Vor_edge)
- if (config_h_mom_eddy_visc4 > 0.0) then
+ 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)
end if
@@ -148,11 +149,6 @@
call mpas_timer_start("RK4-tendency computations")
block => domain % blocklist
do while (associated(block))
-
- if (.not.config_implicit_vertical_mix) then
- call ocn_vmix_coefs(block % mesh, block % provis, block % diagnostics, err)
- end if
-
! 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)
@@ -162,11 +158,11 @@
block % provis % uTransport % array, block % provis % wTop % array, err)
call ocn_tend_h(block % tend, block % provis, block % mesh)
- if (config_rk_filter_btr_mode) then
+ if (config_filter_btr_mode) then
call ocn_filter_btr_mode_tend_u(block % tend, block % provis, block % mesh)
endif
- call ocn_tend_scalar(block % tend, block % provis, block % diagnostics, block % mesh, dt)
+ call ocn_tend_tracer(block % tend, block % provis, block % diagnostics, block % mesh, dt)
block => block % next
end do
call mpas_timer_stop("RK4-tendency computations")
@@ -200,10 +196,6 @@
end do
end do
- if (config_test_case == 1) then ! For case 1, wind field should be fixed
- block % provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
- end if
-
if (config_prescribe_velocity) then
block % provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
@@ -254,7 +246,7 @@
call mpas_timer_stop("RK4-main loop")
!
- ! A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
+ ! A little clean up at the end: rescale tracer fields and compute diagnostics for new state
!
call mpas_timer_start("RK4-cleaup phase")
@@ -270,42 +262,35 @@
block => block % next
end do
+ call mpas_timer_start("RK4-implicit vert mix")
+ block => domain % blocklist
+ do while(associated(block))
- if (config_implicit_vertical_mix) then
- call mpas_timer_start("RK4-implicit vert mix")
- block => domain % blocklist
- do while(associated(block))
+ ! 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
+ ! 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.
+ call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
- ! 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
- ! 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.
- 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)
+ block => block % next
+ end do
- call ocn_vmix_implicit(dt, block % mesh, block % diagnostics, block % state % time_levs(2) % state, err)
- block => block % next
- end do
+ ! Update halo on u and tracers, which were just updated for implicit vertical mixing. If not done,
+ ! this leads to lack of volume conservation. It is required because halo updates in RK4 are only
+ ! 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 % tracers)
+ call mpas_timer_stop("RK4-implicit vert mix halos")
- ! Update halo on u and tracers, which were just updated for implicit vertical mixing. If not done,
- ! this leads to lack of volume conservation. It is required because halo updates in RK4 are only
- ! 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 % tracers)
- call mpas_timer_stop("RK4-implicit vert mix halos")
+ call mpas_timer_stop("RK4-implicit vert mix")
- call mpas_timer_stop("RK4-implicit vert mix")
- end if
-
block => domain % blocklist
do while (associated(block))
- if (config_test_case == 1) then ! For case 1, wind field should be fixed
- block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
- end if
-
if (config_prescribe_velocity) then
block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
@@ -329,7 +314,6 @@
block % state % time_levs(2) % state % uReconstructMeridional % 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, &
@@ -337,7 +321,6 @@
block % state % time_levs(2) % state % uSrcReconstructZonal % array, &
block % state % time_levs(2) % state % uSrcReconstructMeridional % array &
)
-!TDR
call ocn_time_average_accumulate(block % state % time_levs(2) % state, block % state % time_levs(1) % state)
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_time_integration_split.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_time_integration_split.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_time_integration_split.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -24,6 +24,7 @@
use mpas_timer
use ocn_tendency
+ use ocn_diagnostics
use ocn_equation_of_state
use ocn_vmix
@@ -167,7 +168,7 @@
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)
- if (config_h_mom_eddy_visc4 > 0.0) then
+ 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)
end if
@@ -187,10 +188,6 @@
stage1_tend_time = min(split_explicit_step,2)
- if (.not.config_implicit_vertical_mix) then
- call ocn_vmix_coefs(block % mesh, block % state % time_levs(stage1_tend_time) % state, block % diagnostics, err)
- end if
-
! compute wTop. 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, &
@@ -209,9 +206,9 @@
do j=1,n_bcl_iter(split_explicit_step)
! Use this G coefficient to avoid an if statement within the iEdge loop.
- if (trim(config_time_integration) == 'unsplit_explicit') then
+ if (trim(config_time_integrator) == 'unsplit_explicit') then
split = 0
- elseif (trim(config_time_integration) == 'split_explicit') then
+ elseif (trim(config_time_integrator) == 'split_explicit') then
split = 1
endif
@@ -294,7 +291,7 @@
oldBtrSubcycleTime = 1
newBtrSubcycleTime = 2
- if (trim(config_time_integration) == 'unsplit_explicit') then
+ if (trim(config_time_integrator) == 'unsplit_explicit') then
block => domain % blocklist
do while (associated(block))
@@ -321,7 +318,7 @@
block => block % next
end do ! block
- elseif (trim(config_time_integration) == 'split_explicit') then
+ elseif (trim(config_time_integrator) == 'split_explicit') then
! Initialize variables for barotropic subcycling
block => domain % blocklist
@@ -423,7 +420,6 @@
! 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?
do iCell = 1, block % mesh % nCells
do i = 1, block % mesh % nEdgesOnCell % array(iCell)
@@ -563,7 +559,6 @@
! 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?
do iCell = 1, block % mesh % nCells
do i = 1, block % mesh % nEdgesOnCell % array(iCell)
@@ -774,13 +769,8 @@
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !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))
@@ -802,7 +792,7 @@
block => domain % blocklist
do while (associated(block))
- call ocn_tend_scalar(block % tend, block % state % time_levs(2) % state, block % diagnostics, block % mesh, dt)
+ call ocn_tend_tracer(block % tend, block % state % time_levs(2) % state, block % diagnostics, block % mesh, dt)
block => block % next
end do
@@ -822,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
@@ -875,8 +862,8 @@
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 h_edge, density, pressure, and SSH
+ ! in this diagnostics solve.
call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -886,9 +873,6 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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)
@@ -939,43 +923,37 @@
! END large iteration loop
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- if (config_implicit_vertical_mix) then
- call mpas_timer_start("se implicit vert mix")
- block => domain % blocklist
- do while(associated(block))
+ call mpas_timer_start("se implicit vert mix")
+ block => domain % blocklist
+ do while(associated(block))
- ! 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
- ! 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.
- call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
+ ! 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
+ ! 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.
+ 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)
+ call ocn_vmix_implicit(dt, block % mesh, block % diagnostics, block % state % time_levs(2) % state, err)
- block => block % next
- end do
+ block => block % next
+ end do
- ! Update halo on u and tracers, which were just updated for implicit vertical mixing. If not done,
- ! this leads to lack of volume conservation. It is required because halo updates in stage 3 are only
- ! 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 % tracers)
- call mpas_timer_stop("se implicit vert mix halos")
+ ! Update halo on u and tracers, which were just updated for implicit vertical mixing. If not done,
+ ! this leads to lack of volume conservation. It is required because halo updates in stage 3 are only
+ ! 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 % tracers)
+ call mpas_timer_stop("se implicit vert mix halos")
- call mpas_timer_stop("se implicit vert mix")
- end if
+ call mpas_timer_stop("se implicit vert mix")
block => domain % blocklist
do while (associated(block))
- if (config_test_case == 1) then ! For case 1, wind field should be fixed
- block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
- end if
-
if (config_prescribe_velocity) then
block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
@@ -991,12 +969,6 @@
= block % state % time_levs(2) % state % u % array(:,:) &
+ block % state % time_levs(2) % state % uBolusGM % array(:,:)
-!!!!!!!!!!!!!!!!!!!!!!!!!! mrp
- ! Recompute wTop with all updated information. The wTop in stage 3 used
- ! the previous h and u before implicit vertical mixing.
-!!!!!!
-! remove: call ocn_wtop(block % state % time_levs(2) % state,block % state % time_levs(2) % state, block % mesh)
-
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, &
@@ -1005,7 +977,6 @@
block % state % time_levs(2) % state % uReconstructMeridional % 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, &
@@ -1013,7 +984,6 @@
block % state % time_levs(2) % state % uSrcReconstructZonal % array, &
block % state % time_levs(2) % state % uSrcReconstructMeridional % array &
)
-!TDR
call ocn_time_average_accumulate(block % state % time_levs(2) % state, block % state % time_levs(1) % state)
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -32,6 +32,7 @@
mpas_ocn_tracer_advection_coefficients, &
mpas_ocn_tracer_advection_tend
+ logical :: tracerAdvOn
logical :: monotonicOn
contains
@@ -251,6 +252,8 @@
type (mesh_type), intent(in) :: grid !< Input: grid information
real (kind=RKIND), dimension(:,:), intent(in) :: tend_h !< 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)
else
@@ -279,6 +282,10 @@
err = 0
+ tracerAdvOn = .true.
+
+ if(config_disable_tr_adv) tracerAdvOn = .false.
+
call mpas_ocn_tracer_advection_std_init(err_tmp)
call mpas_ocn_tracer_advection_mono_init(err_tmp)
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection_mono.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection_mono.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection_mono.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -147,7 +147,7 @@
upwind_tendency(k, iCell) = 0.0
!tracer_new is supposed to be the "new" tracer state. This allows bounds checks.
- if (config_check_monotonicity) then
+ if (config_check_tracer_monotonicity) then
tracer_new(k,iCell) = 0.0
end if
end do ! k loop
@@ -199,7 +199,7 @@
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.,uh(k,iEdge))*adv_coefs_3rd(i,iEdge))
+ + highOrderAdvectionMask(k, iEdge) * (adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,uh(k,iEdge))*adv_coefs_3rd(i,iEdge))
tracer_weight = uh(k,iEdge)*tracer_weight
high_order_horiz_flux(k,iEdge) = high_order_horiz_flux(k,iEdge) + tracer_weight* tracer_cur(k,iCell)
@@ -207,8 +207,6 @@
end do ! i loop over nAdvCellsForEdge
end do ! iEdge loop
- call mpas_dmpar_exch_halo_field(high_order_horiz_flux_field)
-
! low order upwind vertical flux (monotonic and diffused)
! Remove low order flux from the high order flux.
! Store left over high order flux in high_order_vert_flux array.
@@ -216,8 +214,8 @@
do iCell = 1, nCells
do k = 2, maxLevelCell(iCell)
! dwj 02/03/12 Ocean and Atmosphere are different in vertical
-! flux_upwind = max(0.,w(k,iCell))*tracer_cur(k-1,iCell) + min(0.,w(k,iCell))*tracer_cur(k,iCell)
- flux_upwind = min(0.,w(k,iCell))*tracer_cur(k-1,iCell) + max(0.,w(k,iCell))*tracer_cur(k,iCell)
+! flux_upwind = max(0.0_RKIND,w(k,iCell))*tracer_cur(k-1,iCell) + min(0.0_RKIND,w(k,iCell))*tracer_cur(k,iCell)
+ flux_upwind = min(0.0_RKIND,w(k,iCell))*tracer_cur(k-1,iCell) + max(0.0_RKIND,w(k,iCell))*tracer_cur(k,iCell)
upwind_tendency(k-1,iCell) = upwind_tendency(k-1,iCell) + flux_upwind
upwind_tendency(k ,iCell) = upwind_tendency(k ,iCell) - flux_upwind
high_order_vert_flux(k,iCell) = high_order_vert_flux(k,iCell) - flux_upwind
@@ -229,8 +227,8 @@
! it is negative
do k = 1, maxLevelCell(iCell)
! dwj 02/03/12 Ocean and Atmosphere are different in vertical
-! flux_incoming (k,iCell) = -(min(0.,high_order_vert_flux(k+1,iCell))-max(0.,high_order_vert_flux(k,iCell)))
-! flux_outgoing(k,iCell) = -(max(0.,high_order_vert_flux(k+1,iCell))-min(0.,high_order_vert_flux(k,iCell)))
+! flux_incoming (k,iCell) = -(min(0.0_RKIND,high_order_vert_flux(k+1,iCell))-max(0.0_RKIND,high_order_vert_flux(k,iCell)))
+! flux_outgoing(k,iCell) = -(max(0.0_RKIND,high_order_vert_flux(k+1,iCell))-min(0.0_RKIND,high_order_vert_flux(k,iCell)))
flux_incoming (k, iCell) = max(0.0_RKIND, high_order_vert_flux(k+1, iCell)) - min(0.0_RKIND, high_order_vert_flux(k, iCell))
flux_outgoing(k, iCell) = min(0.0_RKIND, high_order_vert_flux(k+1, iCell)) - max(0.0_RKIND, high_order_vert_flux(k, iCell))
@@ -249,7 +247,7 @@
invAreaCell2 = 1.0 / areaCell(cell2)
do k = 1, maxLevelEdgeTop(iEdge)
- flux_upwind = dvEdge(iEdge) * (max(0.,uh(k,iEdge))*tracer_cur(k,cell1) + min(0.,uh(k,iEdge))*tracer_cur(k,cell2))
+ 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))
high_order_horiz_flux(k,iEdge) = high_order_horiz_flux(k,iEdge) - flux_upwind
end do ! k loop
end do ! iEdge loop
@@ -266,8 +264,8 @@
upwind_tendency(k,iCell) = upwind_tendency(k,iCell) + edgeSignOncell(i, iCell) * flux_upwind * invAreaCell1
! Accumulate remaining high order fluxes
- flux_outgoing(k,iCell) = flux_outgoing(k,iCell) + edgeSignOnCell(i, iCell) * high_order_horiz_flux(k, iEdge) * invAreaCell1
- flux_incoming(k,iCell) = flux_incoming(k,iCell) - edgeSignOnCell(i, iCell) * high_order_horiz_flux(k, iEdge) * invAreaCell1
+ flux_outgoing(k,iCell) = flux_outgoing(k,iCell) + min(0.0_RKIND, edgeSignOnCell(i, iCell) * high_order_horiz_flux(k, iEdge)) * invAreaCell1
+ flux_incoming(k,iCell) = flux_incoming(k,iCell) + max(0.0_RKIND, edgeSignOnCell(i, iCell) * high_order_horiz_flux(k, iEdge)) * invAreaCell1
end do
end do
end do
@@ -282,10 +280,10 @@
tracer_upwind_new = (tracer_cur(k,iCell)*h(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, max( 0.0, scale_factor) )
+ flux_incoming(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
scale_factor = (tracer_upwind_new-tracer_min(k,iCell))/(tracer_upwind_new-tracer_min_new+eps)
- flux_outgoing(k,iCell) = min( 1.0, max( 0.0, scale_factor) )
+ flux_outgoing(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
end do ! k loop
end do ! iCell loop
@@ -295,8 +293,8 @@
cell2 = cellsOnEdge(2,iEdge)
do k = 1, maxLevelEdgeTop(iEdge)
flux = high_order_horiz_flux(k,iEdge)
- flux = max(0.,flux) * min(flux_outgoing(k,cell1), flux_incoming(k,cell2)) &
- + min(0.,flux) * min(flux_incoming(k,cell1), flux_outgoing(k,cell2))
+ flux = max(0.0_RKIND,flux) * min(flux_outgoing(k,cell1), flux_incoming(k,cell2)) &
+ + min(0.0_RKIND,flux) * min(flux_incoming(k,cell1), flux_outgoing(k,cell2))
high_order_horiz_flux(k,iEdge) = flux
end do ! k loop
end do ! iEdge loop
@@ -306,10 +304,10 @@
do k = 2, maxLevelCell(iCell)
flux = high_order_vert_flux(k,iCell)
! dwj 02/03/12 Ocean and Atmosphere are different in vertical.
-! flux = max(0.,flux) * min(flux_outgoing(k-1,iCell), flux_incoming(k ,iCell)) &
-! + min(0.,flux) * min(flux_outgoing(k ,iCell), flux_incoming(k-1,iCell))
- flux = max(0.,flux) * min(flux_outgoing(k ,iCell), flux_incoming(k-1,iCell)) &
- + min(0.,flux) * min(flux_outgoing(k-1,iCell), flux_incoming(k ,iCell))
+! flux = max(0.0_RKIND,flux) * min(flux_outgoing(k-1,iCell), flux_incoming(k ,iCell)) &
+! + min(0.0_RKIND,flux) * min(flux_outgoing(k ,iCell), flux_incoming(k-1,iCell))
+ flux = max(0.0_RKIND,flux) * min(flux_outgoing(k ,iCell), flux_incoming(k-1,iCell)) &
+ + min(0.0_RKIND,flux) * min(flux_outgoing(k-1,iCell), flux_incoming(k ,iCell))
high_order_vert_flux(k,iCell) = flux
end do ! k loop
end do ! iCell loop
@@ -322,7 +320,7 @@
do k = 1, maxLevelEdgeTop(iEdge)
tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + edgeSignOnCell(i, iCell) * high_order_horiz_flux(k, iEdge) * invAreaCell1
- if(config_check_monotonicity) then
+ if(config_check_tracer_monotonicity) then
tracer_new(k, iCell) = tracer_new(k, iCell) + edgeSignOnCell(i, iCell) * high_order_horiz_flux(k, iEdge) * invAreaCell1
end if
end do
@@ -334,7 +332,7 @@
do k = 1,maxLevelCell(iCell)
tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + (high_order_vert_flux(k+1, iCell) - high_order_vert_flux(k, iCell)) + upwind_tendency(k,iCell)
- if (config_check_monotonicity) then
+ if (config_check_tracer_monotonicity) then
!tracer_new holds a tendency for now. Only for a check on monotonicity
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)
@@ -344,7 +342,7 @@
end do ! k loop
end do ! iCell loop
- if (config_check_monotonicity) then
+ if (config_check_tracer_monotonicity) then
!build min and max bounds on old and new tracer for check on monotonicity.
do iCell = 1, nCellsSolve
do k = 1, maxLevelCell(iCell)
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection_std.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection_std.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection_std.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -51,7 +51,7 @@
! Input: s - current model state
! grid - grid metadata
!
- ! Output: tend - computed scalar tendencies
+ ! Output: tend - computed tracer tendencies
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: Tracer tendency
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection_std_hadv.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection_std_hadv.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_advection_std_hadv.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -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.,uh(k,iEdge))*adv_coefs_3rd(i,iEdge))
+ + highOrderAdvectionMask(k, iEdge) * (adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,uh(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
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_hmix.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_hmix.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_hmix.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -47,6 +47,7 @@
!
!--------------------------------------------------------------------
+ logical :: tracerHmixOn
type (timer_node), pointer :: del2Timer, del4Timer
@@ -122,6 +123,8 @@
!
!-----------------------------------------------------------------
+ if(.not.tracerHmixOn) return
+
call mpas_timer_start("del2", .false., del2Timer)
call ocn_tracer_hmix_del2_tend(grid, h_edge, tracers, tend, err1)
call mpas_timer_stop("del2", del2Timer)
@@ -165,6 +168,9 @@
integer :: err1, err2
+ tracerHmixOn = .true.
+
+ if(config_disable_tr_hmix) tracerHmixOn = .false.
call ocn_tracer_hmix_del2_init(err1)
call ocn_tracer_hmix_del4_init(err2)
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_hmix_del2.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_hmix_del2.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_hmix_del2.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -211,11 +211,13 @@
del2on = .false.
- if ( config_h_tracer_eddy_diff2 > 0.0 ) then
+ if ( config_tracer_del2 > 0.0 ) then
del2On = .true.
- eddyDiff2 = config_h_tracer_eddy_diff2
+ eddyDiff2 = config_tracer_del2
endif
+ if(.not.config_use_tracer_del2) del2on = .false.
+
!--------------------------------------------------------------------
end subroutine ocn_tracer_hmix_del2_init!}}}
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_hmix_del4.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_hmix_del4.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_hmix_del4.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -193,7 +193,7 @@
flux = tracer_turb_flux * invdcEdge
- tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + edgeSignOnCell(i, iCell) * invAreaCell1
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + edgeSignOnCell(i, iCell) * flux * invAreaCell1
end do
end do
end do
@@ -233,11 +233,13 @@
err = 0
del4on = .false.
- if ( config_h_tracer_eddy_diff4 > 0.0 ) then
+ if ( config_tracer_del4 > 0.0 ) then
del4On = .true.
- eddyDiff4 = config_h_tracer_eddy_diff4
+ eddyDiff4 = config_tracer_del4
endif
+ if(.not.config_use_tracer_del4) del4on = .false.
+
!--------------------------------------------------------------------
end subroutine ocn_tracer_hmix_del4_init!}}}
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_vadv.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_vadv.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_vadv.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -123,11 +123,6 @@
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)
@@ -172,7 +167,7 @@
err = 0
vadvOn = .false.
- if (config_vert_grid_type.ne.'isopycnal') then
+ if (config_vert_coord_movement.ne.'isopycnal') then
vadvOn = .true.
call ocn_tracer_vadv_stencil_init(err1)
call ocn_tracer_vadv_spline_init(err2)
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -150,8 +150,6 @@
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
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vel_coriolis.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vel_coriolis.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vel_coriolis.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -43,6 +43,7 @@
!
!--------------------------------------------------------------------
+ logical :: coriolisOn
!***********************************************************************
@@ -116,6 +117,8 @@
err = 0
+ if(.not.coriolisOn) return
+
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
nEdgesOnEdge => grid % nEdgesOnEdge % array
cellsOnEdge => grid % cellsOnEdge % array
@@ -181,6 +184,10 @@
err = 0
+ coriolisOn = .true.
+
+ if(config_disable_u_coriolis) coriolisOn = .false.
+
!--------------------------------------------------------------------
end subroutine ocn_vel_coriolis_init!}}}
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vel_forcing.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vel_forcing.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vel_forcing.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -18,7 +18,6 @@
use mpas_configure
use ocn_vel_forcing_windstress
- use ocn_vel_forcing_bottomdrag
use ocn_vel_forcing_rayleigh
implicit none
@@ -115,7 +114,7 @@
!
!-----------------------------------------------------------------
- integer :: err1, err2, err3
+ integer :: err1, err2
!-----------------------------------------------------------------
!
@@ -126,11 +125,9 @@
!-----------------------------------------------------------------
call ocn_vel_forcing_windstress_tend(grid, u_src, h_edge, tend, err1)
- call ocn_vel_forcing_bottomdrag_tend(grid, u, ke_edge, h_edge, tend, err2)
- call ocn_vel_forcing_rayleigh_tend(grid, u, tend, err3)
+ call ocn_vel_forcing_rayleigh_tend(grid, u, tend, err2)
err = ior(err1, err2)
- err = ior(err, err3)
!--------------------------------------------------------------------
@@ -164,14 +161,12 @@
integer, intent(out) :: err !< Output: error flag
- integer :: err1, err2, err3
+ integer :: err1, err2
call ocn_vel_forcing_windstress_init(err1)
- call ocn_vel_forcing_bottomdrag_init(err2)
- call ocn_vel_forcing_rayleigh_init(err3)
+ call ocn_vel_forcing_rayleigh_init(err2)
err = ior(err1, err2)
- err = ior(err, err3)
!--------------------------------------------------------------------
Deleted: branches/atmos_physics/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,193 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_vel_forcing_bottomdrag
-!
-!> \brief MPAS ocean bottom drag
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routine for computing
-!> tendencies from bottom drag.
-!
-!-----------------------------------------------------------------------
-
-module ocn_vel_forcing_bottomdrag
-
- use mpas_grid_types
- use mpas_configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_vel_forcing_bottomdrag_tend, &
- ocn_vel_forcing_bottomdrag_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: bottomDragOn
- real (kind=RKIND) :: bottomDragCoef
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_vel_forcing_bottomdrag_tend
-!
-!> \brief Computes tendency term from bottom drag
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the bottom drag tendency for momentum
-!> based on current state.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_vel_forcing_bottomdrag_tend(grid, u, ke_edge, h_edge, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- ke_edge !< Input: kinetic energy at edge
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- 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 :: iEdge, nEdgesSolve, k
- integer, dimension(:), pointer :: maxLevelEdgeTop
- integer, dimension(:,:), pointer :: edgeMask
-
- !-----------------------------------------------------------------
- !
- ! 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.bottomDragOn) return
-
- nEdgesSolve = grid % nEdgesSolve
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- edgeMask => grid % edgeMask % array
-
- do iEdge=1,grid % nEdgesSolve
-
- k = max(maxLevelEdgeTop(iEdge), 1)
-
- ! bottom drag is the same as POP:
- ! -c |u| u where c is unitless and 1.0e-3.
- ! see POP Reference guide, section 3.4.4.
-
- tend(k,iEdge) = tend(k,iEdge)-edgeMask(k,iEdge)*(bottomDragCoef*u(k,iEdge)*sqrt(2.0*ke_edge(k,iEdge))/h_edge(k,iEdge))
-
- enddo
-
-
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_vel_forcing_bottomdrag_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_vel_forcing_bottomdrag_init
-!
-!> \brief Initializes ocean bottom drag
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes quantities related to bottom drag
-!> in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_vel_forcing_bottomdrag_init(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
-
- err = 0
-
- bottomDragOn = .false.
-
- if (.not.config_implicit_vertical_mix) then
- bottomDragOn = .true.
- bottomDragCoef = config_bottom_drag_coeff
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_vel_forcing_bottomdrag_init!}}}
-
-!***********************************************************************
-
-end module ocn_vel_forcing_bottomdrag
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vel_forcing_windstress.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vel_forcing_windstress.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vel_forcing_windstress.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -168,6 +168,8 @@
windStressOn = .true.
+ if(config_disable_u_windstress) windStressOn = .false.
+
err = 0
!--------------------------------------------------------------------
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -48,6 +48,7 @@
!
!--------------------------------------------------------------------
+ logical :: hmixOn
type (timer_node), pointer :: del2Timer, leithTimer, del4Timer
@@ -126,6 +127,8 @@
!
!-----------------------------------------------------------------
+ if(.not.hmixOn) return
+
viscosity = 0.0
call mpas_timer_start("del2", .false., del2Timer)
@@ -176,12 +179,16 @@
integer :: err1, err2, err3
+ hmixOn = .true.
+
call ocn_vel_hmix_del2_init(err1)
call ocn_vel_hmix_leith_init(err2)
call ocn_vel_hmix_del4_init(err3)
err = ior(ior(err1, err2),err3)
+ if(config_disable_u_hmix) hmixOn = .false.
+
!--------------------------------------------------------------------
end subroutine ocn_vel_hmix_init!}}}
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix_del2.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix_del2.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix_del2.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -201,19 +201,20 @@
hmixDel2On = .false.
- if ( config_h_mom_eddy_visc2 > 0.0 ) then
+ if ( config_mom_del2 > 0.0 ) then
hmixDel2On = .true.
- eddyVisc2 = config_h_mom_eddy_visc2
+ eddyVisc2 = config_mom_del2
-
if (config_visc_vorticity_term) then
- viscVortCoef = config_visc_vorticity_visc2_scale
+ viscVortCoef = config_vorticity_del2_scale
else
viscVortCoef = 0.0
endif
endif
+ if(.not.config_use_mom_del2) hmixDel2On = .false.
+
!--------------------------------------------------------------------
end subroutine ocn_vel_hmix_del2_init!}}}
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix_del4.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix_del4.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix_del4.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -116,7 +116,7 @@
integer :: iCell, iVertex
integer :: nVertices, nVertLevels, nCells, nEdges, nEdgesSolve, vertexDegree
- integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelVertexBot, &
+ integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelVertexTop, &
maxLevelCell, nEdgesOnCell
integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge, edgeMask, edgesOnVertex, edgesOnCell, edgeSignOnVertex, edgeSignOnCell
@@ -141,7 +141,7 @@
vertexDegree = grid % vertexDegree
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
+ maxLevelVertexTop => grid % maxLevelVertexTop % array
maxLevelCell => grid % maxLevelCell % array
cellsOnEdge => grid % cellsOnEdge % array
verticesOnEdge => grid % verticesOnEdge % array
@@ -179,7 +179,7 @@
do k=1,maxLevelEdgeTop(iEdge)
! Compute </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="gray">abla vorticity
delsq_u(k, iEdge) = ( divergence(k,cell2) - divergence(k,cell1) ) * invDcEdge &
- -viscVortCoef *( vorticity(k,vertex2) - vorticity(k,vertex1)) * invDcEdge * sqrt(3.0) ! TDR
+ -viscVortCoef *( vorticity(k,vertex2) - vorticity(k,vertex1)) * invDcEdge * sqrt(3.0)
end do
end do
@@ -188,7 +188,7 @@
invAreaTri1 = 1.0 / areaTriangle(iVertex)
do i = 1, vertexDegree
iEdge = edgesOnVertex(i, iVertex)
- do k = 1, maxLevelVertexBot(iVertex)
+ do k = 1, maxLevelVertexTop(iVertex)
delsq_vorticity(k, iVertex) = delsq_vorticity(k, iVertex) + edgeSignOnVertex(i, iVertex) * dcEdge(iEdge) * delsq_u(k, iEdge) * invAreaTri1
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_vorticity(k,vertex2) - delsq_vorticity(k,vertex1) ) * invDcEdge * sqrt(3.0)
tend(k,iEdge) = tend(k,iEdge) - edgeMask(k, iEdge) * u_diffusion * r_tmp
end do
@@ -261,17 +261,19 @@
hmixDel4On = .false.
- if ( config_h_mom_eddy_visc4 > 0.0 ) then
+ if ( config_mom_del4 > 0.0 ) then
hmixDel4On = .true.
- eddyVisc4 = config_h_mom_eddy_visc4
+ eddyVisc4 = config_mom_del4
if (config_visc_vorticity_term) then
- viscVortCoef = config_visc_vorticity_visc4_scale
+ viscVortCoef = config_vorticity_del4_scale
else
viscVortCoef = 0.0
endif
endif
+ if(.not.config_use_mom_del4) hmixDel4On = .false.
+
!--------------------------------------------------------------------
end subroutine ocn_vel_hmix_del4_init!}}}
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix_leith.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix_leith.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vel_hmix_leith.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -216,7 +216,7 @@
hmixLeithOn = .true.
if (config_visc_vorticity_term) then
- viscVortCoef = config_visc_vorticity_visc2_scale
+ viscVortCoef = config_vorticity_del2_scale
else
viscVortCoef = 0.0
endif
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vel_pressure_grad.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vel_pressure_grad.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vel_pressure_grad.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -44,6 +44,7 @@
!
!--------------------------------------------------------------------
+ logical :: pgradOn
real (kind=RKIND) :: rho0Inv, grho0Inv
@@ -113,6 +114,8 @@
err = 0
+ if(.not.pgradOn) return
+
nEdgesSolve = grid % nEdgesSolve
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
cellsOnEdge => grid % cellsOnEdge % array
@@ -186,7 +189,9 @@
err = 0
- if (config_pressure_type.eq.'MontgomeryPotential') then
+ pgradOn = .true.
+
+ if (config_pressure_gradient_type.eq.'MontgomeryPotential') then
rho0Inv = 1.0
grho0Inv = 0.0
else
@@ -194,8 +199,10 @@
grho0Inv = gravity/config_rho0
end if
+ if(config_disable_u_pgrad) pgradOn = .false.
+
!--------------------------------------------------------------------
end subroutine ocn_vel_pressure_grad_init!}}}
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vel_vadv.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vel_vadv.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vel_vadv.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -112,11 +112,6 @@
real (kind=RKIND) :: wTopEdge
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
@@ -183,10 +178,12 @@
err = 0
velVadvOn = .false.
- if (config_vert_grid_type.ne.'isopycnal') then
+ if (config_vert_coord_movement.ne.'isopycnal') then
velVadvOn = .true.
end if
+ if(config_disable_u_vadv) velVadvOn = .false.
+
!--------------------------------------------------------------------
end subroutine ocn_vel_vadv_init!}}}
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vmix.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vmix.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vmix.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -15,6 +15,7 @@
module ocn_vmix
+ use mpas_kind_types
use mpas_grid_types
use mpas_configure
use mpas_timer
@@ -43,8 +44,6 @@
tridiagonal_solve_mult
public :: ocn_vmix_coefs, &
- ocn_vel_vmix_tend_explicit, &
- ocn_tracer_vmix_tend_explicit, &
ocn_vel_vmix_tend_implicit, &
ocn_tracer_vmix_tend_implicit, &
ocn_vmix_init, &
@@ -56,7 +55,7 @@
!
!--------------------------------------------------------------------
- logical :: explicitOn, implicitOn
+ logical :: velVmixOn, tracerVmixOn
!***********************************************************************
@@ -123,6 +122,9 @@
err = 0
+ d % vertViscTopOfEdge % array = 0.0_RKIND
+ d % vertDiffTopOfCell % array = 0.0_RKIND
+
call ocn_vmix_coefs_const_build(grid, s, d, err1)
call ocn_vmix_coefs_tanh_build(grid, s, d, err2)
call ocn_vmix_coefs_rich_build(grid, s, d, err3)
@@ -135,99 +137,6 @@
!***********************************************************************
!
-! routine ocn_vel_vmix_tendExplict
-!
-!> \brief Computes tendencies for explict momentum vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the tendencies for explicit vertical mixing for momentum
-!> using computed coefficients.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_vel_vmix_tend_explicit(grid, u, h_edge, vertViscTopOfEdge, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- 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) :: &
- vertViscTopOfEdge !< Input: vertical mixing coefficients
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: tendency information
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iEdge, nEdgesSolve, k, nVertLevels
-
- integer, dimension(:), pointer :: maxLevelEdgeTop
-
- real (kind=RKIND), dimension(:), allocatable :: fluxVertTop
-
- err = 0
-
- if(implicitOn) return
-
- nEdgessolve = grid % nEdgesSolve
- nVertLevels = grid % nVertLevels
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
-
- allocate(fluxVertTop(nVertLevels+1))
- fluxVertTop(1) = 0.0
- do iEdge=1,nEdgesSolve
- do k=2,maxLevelEdgeTop(iEdge)
- fluxVertTop(k) = vertViscTopOfEdge(k,iEdge) &
- * ( u(k-1,iEdge) - u(k,iEdge) ) &
- * 2 / (h_edge(k-1,iEdge) + h_edge(k,iEdge))
- enddo
- fluxVertTop(maxLevelEdgeTop(iEdge)+1) = 0.0
-
- do k=1,maxLevelEdgeTop(iEdge)
- tend(k,iEdge) = tend(k,iEdge) &
- + (fluxVertTop(k) - fluxVertTop(k+1)) &
- / h_edge(k,iEdge)
- enddo
-
- end do
- deallocate(fluxVertTop)
- !--------------------------------------------------------------------
-
- end subroutine ocn_vel_vmix_tend_explicit!}}}
-
-!***********************************************************************
-!
! routine ocn_vel_vmix_tend_implicit
!
!> \brief Computes tendencies for implicit momentum vertical mixing
@@ -299,7 +208,7 @@
err = 0
- if(explicitOn) return
+ if(.not.velVmixOn) return
nEdges = grid % nEdges
nVertLevels = grid % nVertLevels
@@ -362,110 +271,6 @@
!***********************************************************************
!
-! routine ocn_tracer_vmix_tendExplict
-!
-!> \brief Computes tendencies for explict tracer vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the tendencies for explicit vertical mixing for
-!> tracers using computed coefficients.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_tracer_vmix_tend_explicit(grid, h, vertDiffTopOfCell, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness at cell center
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- vertDiffTopOfCell !< Input: vertical mixing coefficients
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tendency information
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iCell, nCellsSolve, k, iTracer, num_tracers, nVertLevels
-
- integer, dimension(:), pointer :: maxLevelCell
-
- real (kind=RKIND), dimension(:,:), allocatable :: fluxVertTop
-
- err = 0
-
- if(implicitOn) return
-
- nCellsSolve = grid % nCellsSolve
- nVertLevels = grid % nVertLevels
- num_tracers = size(tracers, dim=1)
-
- maxLevelCell => grid % maxLevelCell % array
-
- allocate(fluxVertTop(num_tracers,nVertLevels+1))
- fluxVertTop(:,1) = 0.0
- do iCell=1,nCellsSolve
-
- do k=2,maxLevelCell(iCell)
- do iTracer=1,num_tracers
- ! compute \kappa_v d\phi/dz
- fluxVertTop(iTracer,k) = vertDiffTopOfCell(k,iCell) &
- * ( tracers(iTracer,k-1,iCell) &
- - tracers(iTracer,k ,iCell) ) &
- * 2 / (h(k-1,iCell) + h(k,iCell))
-
- enddo
- enddo
- fluxVertTop(:,maxLevelCell(iCell)+1) = 0.0
-
- do k=1,maxLevelCell(iCell)
- do iTracer=1,num_tracers
- ! This is h d/dz( fluxVertTop) but h and dz cancel, so
- ! reduces to delta( fluxVertTop)
- tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &
- + fluxVertTop(iTracer,k) - fluxVertTop(iTracer,k+1)
- enddo
- enddo
-
- enddo ! iCell loop
- deallocate(fluxVertTop)
- !--------------------------------------------------------------------
-
- end subroutine ocn_tracer_vmix_tend_explicit!}}}
-
-!***********************************************************************
-!
! routine ocn_tracer_vmix_tend_implicit
!
!> \brief Computes tendencies for implicit tracer vertical mixing
@@ -530,7 +335,7 @@
err = 0
- if(explicitOn) return
+ if(.not.tracerVmixOn) return
nCells = grid % nCells
nVertLevels = grid % nVertLevels
@@ -640,8 +445,7 @@
!> \version SVN:$Id$
!> \details
!> This routine initializes a variety of quantities related to
-!> vertical mixing in the ocean. This primarily determines if
-!> explicit or implicit vertical mixing is to be used.
+!> vertical mixing in the ocean.
!
!-----------------------------------------------------------------------
@@ -662,13 +466,11 @@
err = 0
- explicitOn = .true.
- implicitOn = .false.
+ velVmixOn = .true.
+ tracerVmixOn = .true.
- if(config_implicit_vertical_mix) then
- explicitOn = .false.
- implicitOn = .true.
- end if
+ if(config_disable_u_vmix) velVmixOn = .false.
+ if(config_disable_tr_vmix) tracerVmixOn = .false.
call ocn_vmix_coefs_const_init(err1)
call ocn_vmix_coefs_tanh_init(err2)
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vmix_coefs_const.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vmix_coefs_const.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vmix_coefs_const.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -121,7 +121,6 @@
!-----------------------------------------------------------------
err = 0
- if((.not.constViscOn) .and. (.not.constDiffOn)) return
vertViscTopOfEdge => d % vertViscTopOfEdge % array
vertDiffTopOfCell => d % vertDiffTopOfCell % array
@@ -185,7 +184,7 @@
if(.not.constViscOn) return
- vertViscTopOfEdge = constVisc
+ vertViscTopOfEdge = vertViscTopOfEdge + constVisc
!--------------------------------------------------------------------
@@ -241,7 +240,7 @@
if(.not.constDiffOn) return
- vertDiffTopOfCell = constDiff
+ vertDiffTopOfCell = vertDiffTopOfCell + constDiff
!--------------------------------------------------------------------
@@ -279,18 +278,20 @@
err = 0
- constViscOn = .false.
- constDiffOn = .false.
+ constViscOn = config_use_const_visc
+ constDiffOn = config_use_const_diff
+ constVisc = config_vert_visc
+ constDiff = config_vert_diff
- if (config_vert_visc_type.eq.'const') then
- constViscOn = .true.
- constVisc = config_vert_visc
- endif
+! if (config_vert_visc_type.eq.'const') then
+! constViscOn = .true.
+! constVisc = config_vert_visc
+! endif
- if (config_vert_diff_type.eq.'const') then
- constDiffOn = .true.
- constDiff = config_vert_diff
- endif
+! if (config_vert_diff_type.eq.'const') then
+! constDiffOn = .true.
+! constDiff = config_vert_diff
+! endif
!--------------------------------------------------------------------
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vmix_coefs_rich.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vmix_coefs_rich.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vmix_coefs_rich.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -124,7 +124,6 @@
!-----------------------------------------------------------------
err = 0
- if((.not.richViscOn) .and. (.not.richDiffOn)) return
indexT = s%index_temperature
indexS = s%index_salinity
@@ -222,35 +221,19 @@
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- vertViscTopOfEdge = 0.0
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) = config_bkrd_vert_visc &
+ 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
- if( config_implicit_vertical_mix) then
- vertViscTopOfEdge(k,iEdge) = config_convective_visc
- else
- vertViscTopOfEdge(k,iEdge) = &
- ((h_edge(k-1,iEdge)+h_edge(k,iEdge))/2.0)**2/config_dt/4.0
- end if
+ vertViscTopOfEdge(k,iEdge) = config_convective_visc
end if
else
- ! mrp 110324 efficiency note: this if is inside iCell and k loops.
- if (config_implicit_vertical_mix) then
- ! for Ri<0 and implicit mix, use convective diffusion
- vertViscTopOfEdge(k,iEdge) = config_convective_visc
- else
- ! for Ri<0 and explicit vertical mix,
- ! use maximum diffusion allowed by CFL criterion
- vertViscTopOfEdge(k,iEdge) = &
- ((h_edge(k-1,iEdge)+h_edge(k,iEdge))/2.0)**2/config_dt/4.0
- end if
+ ! for Ri<0 use the convective value for the viscosity
+ vertViscTopOfEdge(k,iEdge) = config_convective_visc
end if
end do
end do
@@ -326,38 +309,22 @@
maxLevelCell => grid % maxLevelCell % array
- vertDiffTopOfCell = 0.0
coef = -gravity/config_rho0/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) = config_bkrd_vert_diff &
+ 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
- if (config_implicit_vertical_mix) then
- vertDiffTopOfCell(k,iCell) = config_convective_diff
- else
- vertDiffTopOfCell(k,iCell) = &
- ((h(k-1,iCell)+h(k,iCell))/2.0)**2/config_dt/4.0
- end if
+ vertDiffTopOfCell(k,iCell) = config_convective_diff
end if
else
- ! mrp 110324 efficiency note: this if is inside iCell and k loops.
- if (config_implicit_vertical_mix) then
- ! for Ri<0 and implicit mix, use convective diffusion
- vertDiffTopOfCell(k,iCell) = config_convective_diff
- else
- ! for Ri<0 and explicit vertical mix,
- ! use maximum diffusion allowed by CFL criterion
- vertDiffTopOfCell(k,iCell) = &
- ((h(k-1,iCell)+h(k,iCell))/2.0)**2/config_dt/4.0
- end if
+ ! for Ri<0 use the convective value for the diffusion
+ vertDiffTopOfCell(k,iCell) = config_convective_diff
end if
end do
end do
@@ -461,16 +428,6 @@
drhoTopOfCell(nVertLevels+1,nCells+1), drhoTopOfEdge(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
do iCell=1,nCells
@@ -573,16 +530,16 @@
err = 0
- richViscOn = .false.
- richDiffOn = .false.
+ richViscOn = config_use_rich_visc
+ richDiffOn = config_use_rich_diff
- if (config_vert_visc_type.eq.'rich') then
- richViscOn = .true.
- endif
+! if (config_vert_visc_type.eq.'rich') then
+! richViscOn = .true.
+! endif
- if (config_vert_diff_type.eq.'rich') then
- richDiffOn = .true.
- endif
+! if (config_vert_diff_type.eq.'rich') then
+! richDiffOn = .true.
+! endif
!--------------------------------------------------------------------
Modified: branches/atmos_physics/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -115,7 +115,6 @@
!-----------------------------------------------------------------
err = 0
- if((.not.tanhViscOn) .and. (.not.tanhDiffOn)) return
vertViscTopOfEdge => d % vertViscTopOfEdge % array
vertDiffTopOfCell => d % vertDiffTopOfCell % array
@@ -189,9 +188,8 @@
! refBottomDepth is used here for simplicity. Using zMid and h, which
! vary in time, would give the exact location of the top, but it
! would only change the diffusion value very slightly.
- vertViscTopOfEdge = 0.0
do k=2,nVertLevels
- vertViscTopOfEdge(k,:) = -(config_max_visc_tanh-config_min_visc_tanh)/2.0 &
+ vertViscTopOfEdge(k,:) = vertViscTopOfEdge(k,:)-(config_max_visc_tanh-config_min_visc_tanh)/2.0 &
*tanh((refBottomDepth(k-1)+config_ZMid_tanh) &
/config_zWidth_tanh) &
+ (config_max_visc_tanh+config_min_visc_tanh)/2
@@ -262,9 +260,8 @@
! refBottomDepth is used here for simplicity. Using zMid and h, which
! vary in time, would give the exact location of the top, but it
! would only change the diffusion value very slightly.
- vertDiffTopOfCell = 0.0
do k=2,nVertLevels
- vertDiffTopOfCell(k,:) = -(config_max_diff_tanh-config_min_diff_tanh)/2.0 &
+ vertDiffTopOfCell(k,:) = vertDiffTopOfCell(k,:)-(config_max_diff_tanh-config_min_diff_tanh)/2.0 &
*tanh((refBottomDepth(k-1)+config_ZMid_tanh) &
/config_zWidth_tanh) &
+ (config_max_diff_tanh+config_min_diff_tanh)/2
@@ -305,16 +302,16 @@
err = 0
- tanhViscOn = .false.
- tanhDiffOn = .false.
+ tanhViscOn = config_use_tanh_visc
+ tanhDiffOn = config_use_tanh_diff
- if (config_vert_visc_type.eq.'tanh') then
- tanhViscOn = .true.
- endif
+! if (config_vert_visc_type.eq.'tanh') then
+! tanhViscOn = .true.
+! endif
- if (config_vert_diff_type.eq.'tanh') then
- tanhDiffOn = .true.
- endif
+! if (config_vert_diff_type.eq.'tanh') then
+! tanhDiffOn = .true.
+! endif
!--------------------------------------------------------------------
Modified: branches/atmos_physics/src/core_sw/Registry
===================================================================
--- branches/atmos_physics/src/core_sw/Registry 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/core_sw/Registry 2013-03-26 23:03:26 UTC (rev 2670)
@@ -97,7 +97,7 @@
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 nEdges ) 0 o cellTangentPlane 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 - -
Copied: branches/atmos_physics/src/core_sw/Registry.xml (from rev 2666, trunk/mpas/src/core_sw/Registry.xml)
===================================================================
--- branches/atmos_physics/src/core_sw/Registry.xml (rev 0)
+++ branches/atmos_physics/src/core_sw/Registry.xml 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,146 @@
+<?xml version="1.0"?>
+<registry>
+ <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/atmos_physics/src/framework/mpas_dmpar.F
===================================================================
--- branches/atmos_physics/src/framework/mpas_dmpar.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/framework/mpas_dmpar.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -2825,12 +2825,13 @@
integer, dimension(:), pointer, optional :: haloLayersIn
type (field4dReal), pointer :: fieldInPtr, fieldOutPtr
- type (mpas_exchange_list), pointer :: exchListPtr
+ type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
type (dm_info), pointer :: dminfo
logical :: comm_list_found
+ integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: nAdded, bufferOffset
integer :: mpi_ierr
integer :: iHalo, iBuffer, i, j, k, l
@@ -3122,12 +3123,13 @@
integer, dimension(:), pointer, optional :: haloLayersIn
type (field5dReal), pointer :: fieldInPtr, fieldOutPtr
- type (mpas_exchange_list), pointer :: exchListPtr
+ type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
type (dm_info), pointer :: dminfo
logical :: comm_list_found
+ integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: nAdded, bufferOffset
integer :: mpi_ierr
integer :: iHalo, iBuffer, i, j, k, l, m
Modified: branches/atmos_physics/src/framework/mpas_grid_types.F
===================================================================
--- branches/atmos_physics/src/framework/mpas_grid_types.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/framework/mpas_grid_types.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -37,6 +37,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 +67,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 +98,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 +128,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 +158,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 +215,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 +245,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 +275,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 +332,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
@@ -534,6 +543,10 @@
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
@@ -562,6 +575,10 @@
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
@@ -590,6 +607,10 @@
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
@@ -618,6 +639,10 @@
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
@@ -646,6 +671,10 @@
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
@@ -674,6 +703,10 @@
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
@@ -702,6 +735,10 @@
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
@@ -730,6 +767,10 @@
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
@@ -758,6 +799,10 @@
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
@@ -786,6 +831,10 @@
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
@@ -815,6 +864,10 @@
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
@@ -844,6 +897,10 @@
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
@@ -873,6 +930,10 @@
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
@@ -902,6 +963,10 @@
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
@@ -931,6 +996,10 @@
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
@@ -960,6 +1029,10 @@
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
@@ -989,6 +1062,10 @@
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
@@ -1018,6 +1095,10 @@
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
Modified: branches/atmos_physics/src/framework/mpas_io.F
===================================================================
--- branches/atmos_physics/src/framework/mpas_io.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/framework/mpas_io.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1489,6 +1489,8 @@
real (kind=RKIND), dimension(:,:,:,:,:), intent(out) :: array
integer, intent(out), optional :: ierr
+ integer :: pio_ierr
+ type (fieldlist_type), pointer :: field_cursor
! write(0,*) 'Called MPAS_io_get_var_real5d()'
if (present(ierr)) ierr = MPAS_IO_NOERR
@@ -1849,6 +1851,8 @@
real (kind=RKIND), dimension(:,:,:,:,:), intent(in) :: array
integer, intent(out), optional :: ierr
+ integer :: pio_ierr
+ type (fieldlist_type), pointer :: field_cursor
! write(0,*) 'Called MPAS_io_put_var_real5d()'
if (present(ierr)) ierr = MPAS_IO_NOERR
Modified: branches/atmos_physics/src/framework/mpas_io_streams.F
===================================================================
--- branches/atmos_physics/src/framework/mpas_io_streams.F 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/framework/mpas_io_streams.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -993,7 +993,10 @@
logical :: isDecomposed
integer :: ndims
type (field4dReal), pointer :: field_ptr
+ character (len=StrKIND), dimension(5) :: dimNames
+ character (len=StrKIND), dimension(:), pointer :: dimNamesInq
integer, dimension(:), pointer :: indices
+ type (field_list_type), pointer :: field_list_cursor
type (field_list_type), pointer :: new_field_list_node
logical :: any_success
logical, dimension(:), pointer :: isAvailable
@@ -1091,7 +1094,10 @@
logical :: isDecomposed
integer :: ndims
type (field5dReal), pointer :: field_ptr
+ character (len=StrKIND), dimension(5) :: dimNames
+ character (len=StrKIND), dimension(:), pointer :: dimNamesInq
integer, dimension(:), pointer :: indices
+ type (field_list_type), pointer :: field_list_cursor
type (field_list_type), pointer :: new_field_list_node
logical :: any_success
logical, dimension(:), pointer :: isAvailable
Deleted: branches/atmos_physics/src/ocean_cesm_driver/Makefile
===================================================================
--- trunk/mpas/src/ocean_cesm_driver/Makefile 2013-03-25 16:55:55 UTC (rev 2666)
+++ branches/atmos_physics/src/ocean_cesm_driver/Makefile 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,24 +0,0 @@
-.SUFFIXES: .F .o
-
-OBJS = ocn_comp_mct.o \
- ocn_communicator.o \
- mpaso_cpl_indices.o \
- mpaso_mct_vars.o
-
-all: $(OBJS)
-
-ocn_comp_mct.o: ocn_communicator.o mpaso_cpl_indices.o mpaso_mct_vars.o
-
-ocn_communicator.o:
-
-mpaso_cpl_indices.o:
-
-mpaso_mct_vars.o:
-
-clean:
- $(RM) *.o *.mod *.f90
-
-.F.o:
- $(RM) $@ $*.mod
- $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $< > $*.f90
- $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../core_$(CORE) -I../external/esmf_time_f90
Copied: branches/atmos_physics/src/ocean_cesm_driver/Makefile (from rev 2666, trunk/mpas/src/ocean_cesm_driver/Makefile)
===================================================================
--- branches/atmos_physics/src/ocean_cesm_driver/Makefile (rev 0)
+++ branches/atmos_physics/src/ocean_cesm_driver/Makefile 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,24 @@
+.SUFFIXES: .F .o
+
+OBJS = ocn_comp_mct.o \
+ ocn_communicator.o \
+ mpaso_cpl_indices.o \
+ mpaso_mct_vars.o
+
+all: $(OBJS)
+
+ocn_comp_mct.o: ocn_communicator.o mpaso_cpl_indices.o mpaso_mct_vars.o
+
+ocn_communicator.o:
+
+mpaso_cpl_indices.o:
+
+mpaso_mct_vars.o:
+
+clean:
+ $(RM) *.o *.mod *.f90
+
+.F.o:
+ $(RM) $@ $*.mod
+ $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $< > $*.f90
+ $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../core_$(CORE) -I../external/esmf_time_f90
Deleted: branches/atmos_physics/src/ocean_cesm_driver/mpaso_cpl_indices.F
===================================================================
--- trunk/mpas/src/ocean_cesm_driver/mpaso_cpl_indices.F 2013-03-25 16:55:55 UTC (rev 2666)
+++ branches/atmos_physics/src/ocean_cesm_driver/mpaso_cpl_indices.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,125 +0,0 @@
-module mpaso_cpl_indices
-
- use seq_flds_mod
- use mct_mod
-
- implicit none
-
- SAVE
- public ! By default make data private
-
- ! ocn -> drv
-
- integer :: index_o2x_So_t
- integer :: index_o2x_So_u
- integer :: index_o2x_So_v
- integer :: index_o2x_So_s
- integer :: index_o2x_So_dhdx
- integer :: index_o2x_So_dhdy
- integer :: index_o2x_Fioo_q
- integer :: index_o2x_Faoo_fco2_ocn
- integer :: index_o2x_Faoo_fdms_ocn
-
- ! drv -> ocn
-
- integer :: index_x2o_Si_ifrac ! fractional ice wrt ocean
- integer :: index_x2o_So_duu10n ! 10m wind speed squared (m^2/s^2)
- integer :: index_x2o_Sa_pslv ! sea-level pressure (Pa)
- integer :: index_x2o_Sa_co2prog ! bottom atm level prognostic CO2
- integer :: index_x2o_Sa_co2diag ! bottom atm level diagnostic CO2
- integer :: index_x2o_Foxx_taux ! zonal wind stress (taux) (W/m2 )
- integer :: index_x2o_Foxx_tauy ! meridonal wind stress (tauy) (W/m2 )
- integer :: index_x2o_Foxx_swnet ! net short-wave heat flux (W/m2 )
- integer :: index_x2o_Foxx_sen ! sensible heat flux (W/m2 )
- integer :: index_x2o_Foxx_lat
- integer :: index_x2o_Foxx_lwup ! longwave radiation (up) (W/m2 )
- integer :: index_x2o_Faxa_lwdn ! longwave radiation (down) (W/m2 )
- integer :: index_x2o_Fioi_melth ! heat flux from snow & ice melt (W/m2 )
- integer :: index_x2o_Fioi_meltw ! snow melt flux (kg/m2/s)
- integer :: index_x2o_Fioi_salt ! salt (kg(salt)/m2/s)
- integer :: index_x2o_Foxx_evap ! evaporation flux (kg/m2/s)
- integer :: index_x2o_Faxa_prec
- integer :: index_x2o_Faxa_snow ! water flux due to snow (kg/m2/s)
- integer :: index_x2o_Faxa_rain ! water flux due to rain (kg/m2/s)
- integer :: index_x2o_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition
- integer :: index_x2o_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition
- integer :: index_x2o_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition
- integer :: index_x2o_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition
- integer :: index_x2o_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition
- integer :: index_x2o_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition
- integer :: index_x2o_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition
- integer :: index_x2o_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition
- integer :: index_x2o_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition
- integer :: index_x2o_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition
- integer :: index_x2o_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition
- integer :: index_x2o_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition
- integer :: index_x2o_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition
- integer :: index_x2o_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition
- integer :: index_x2o_Forr_roff ! river runoff flux (kg/m2/s)
- integer :: index_x2o_Forr_ioff ! ice runoff flux (kg/m2/s)
-
-contains
-
- subroutine mpaso_cpl_indices_set( )
-
- type(mct_aVect) :: o2x ! temporary
- type(mct_aVect) :: x2o ! temporary
-
- ! Determine attribute vector indices
-
- ! create temporary attribute vectors
- call mct_aVect_init(x2o, rList=seq_flds_x2o_fields, lsize=1)
- call mct_aVect_init(o2x, rList=seq_flds_o2x_fields, lsize=1)
-
- index_o2x_So_t = mct_avect_indexra(o2x,'So_t')
- index_o2x_So_u = mct_avect_indexra(o2x,'So_u')
- index_o2x_So_v = mct_avect_indexra(o2x,'So_v')
- index_o2x_So_s = mct_avect_indexra(o2x,'So_s')
- index_o2x_So_dhdx = mct_avect_indexra(o2x,'So_dhdx')
- index_o2x_So_dhdy = mct_avect_indexra(o2x,'So_dhdy')
- index_o2x_Fioo_q = mct_avect_indexra(o2x,'Fioo_q')
- index_o2x_Faoo_fco2_ocn = mct_avect_indexra(o2x,'Faoo_fco2_ocn',perrWith='quiet')
- index_o2x_Faoo_fdms_ocn = mct_avect_indexra(o2x,'Faoo_fdms_ocn',perrWith='quiet')
- index_x2o_Si_ifrac = mct_avect_indexra(x2o,'Si_ifrac')
- index_x2o_Sa_pslv = mct_avect_indexra(x2o,'Sa_pslv')
- index_x2o_So_duu10n = mct_avect_indexra(x2o,'So_duu10n')
-
- index_x2o_Foxx_tauy = mct_avect_indexra(x2o,'Foxx_tauy')
- index_x2o_Foxx_taux = mct_avect_indexra(x2o,'Foxx_taux')
- index_x2o_Foxx_swnet = mct_avect_indexra(x2o,'Foxx_swnet')
- index_x2o_Foxx_lat = mct_avect_indexra(x2o,'Foxx_lat')
- index_x2o_Foxx_sen = mct_avect_indexra(x2o,'Foxx_sen')
- index_x2o_Foxx_lwup = mct_avect_indexra(x2o,'Foxx_lwup')
- index_x2o_Faxa_lwdn = mct_avect_indexra(x2o,'Faxa_lwdn')
- index_x2o_Fioi_melth = mct_avect_indexra(x2o,'Fioi_melth')
- index_x2o_Fioi_meltw = mct_avect_indexra(x2o,'Fioi_meltw')
- index_x2o_Fioi_salt = mct_avect_indexra(x2o,'Fioi_salt')
- index_x2o_Faxa_prec = mct_avect_indexra(x2o,'Faxa_prec')
- index_x2o_Faxa_snow = mct_avect_indexra(x2o,'Faxa_snow')
- index_x2o_Faxa_rain = mct_avect_indexra(x2o,'Faxa_rain')
- index_x2o_Foxx_evap = mct_avect_indexra(x2o,'Foxx_evap')
- index_x2o_Forr_roff = mct_avect_indexra(x2o,'Forr_roff')
- index_x2o_Forr_ioff = mct_avect_indexra(x2o,'Forr_ioff')
- index_x2o_Faxa_bcphidry = mct_avect_indexra(x2o,'Faxa_bcphidry')
- index_x2o_Faxa_bcphodry = mct_avect_indexra(x2o,'Faxa_bcphodry')
- index_x2o_Faxa_bcphiwet = mct_avect_indexra(x2o,'Faxa_bcphiwet')
- index_x2o_Faxa_ocphidry = mct_avect_indexra(x2o,'Faxa_ocphidry')
- index_x2o_Faxa_ocphodry = mct_avect_indexra(x2o,'Faxa_ocphodry')
- index_x2o_Faxa_ocphiwet = mct_avect_indexra(x2o,'Faxa_ocphiwet')
- index_x2o_Faxa_dstdry1 = mct_avect_indexra(x2o,'Faxa_dstdry1')
- index_x2o_Faxa_dstdry2 = mct_avect_indexra(x2o,'Faxa_dstdry2')
- index_x2o_Faxa_dstdry3 = mct_avect_indexra(x2o,'Faxa_dstdry3')
- index_x2o_Faxa_dstdry4 = mct_avect_indexra(x2o,'Faxa_dstdry4')
- index_x2o_Faxa_dstwet1 = mct_avect_indexra(x2o,'Faxa_dstwet1')
- index_x2o_Faxa_dstwet2 = mct_avect_indexra(x2o,'Faxa_dstwet2')
- index_x2o_Faxa_dstwet3 = mct_avect_indexra(x2o,'Faxa_dstwet3')
- index_x2o_Faxa_dstwet4 = mct_avect_indexra(x2o,'Faxa_dstwet4')
- index_x2o_Sa_co2prog = mct_avect_indexra(x2o,'Sa_co2prog',perrWith='quiet')
- index_x2o_Sa_co2diag = mct_avect_indexra(x2o,'Sa_co2diag',perrWith='quiet')
-
- call mct_aVect_clean(x2o)
- call mct_aVect_clean(o2x)
-
- end subroutine mpaso_cpl_indices_set
-
-end module mpaso_cpl_indices
Copied: branches/atmos_physics/src/ocean_cesm_driver/mpaso_cpl_indices.F (from rev 2666, trunk/mpas/src/ocean_cesm_driver/mpaso_cpl_indices.F)
===================================================================
--- branches/atmos_physics/src/ocean_cesm_driver/mpaso_cpl_indices.F (rev 0)
+++ branches/atmos_physics/src/ocean_cesm_driver/mpaso_cpl_indices.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,125 @@
+module mpaso_cpl_indices
+
+ use seq_flds_mod
+ use mct_mod
+
+ implicit none
+
+ SAVE
+ public ! By default make data private
+
+ ! ocn -> drv
+
+ integer :: index_o2x_So_t
+ integer :: index_o2x_So_u
+ integer :: index_o2x_So_v
+ integer :: index_o2x_So_s
+ integer :: index_o2x_So_dhdx
+ integer :: index_o2x_So_dhdy
+ integer :: index_o2x_Fioo_q
+ integer :: index_o2x_Faoo_fco2_ocn
+ integer :: index_o2x_Faoo_fdms_ocn
+
+ ! drv -> ocn
+
+ integer :: index_x2o_Si_ifrac ! fractional ice wrt ocean
+ integer :: index_x2o_So_duu10n ! 10m wind speed squared (m^2/s^2)
+ integer :: index_x2o_Sa_pslv ! sea-level pressure (Pa)
+ integer :: index_x2o_Sa_co2prog ! bottom atm level prognostic CO2
+ integer :: index_x2o_Sa_co2diag ! bottom atm level diagnostic CO2
+ integer :: index_x2o_Foxx_taux ! zonal wind stress (taux) (W/m2 )
+ integer :: index_x2o_Foxx_tauy ! meridonal wind stress (tauy) (W/m2 )
+ integer :: index_x2o_Foxx_swnet ! net short-wave heat flux (W/m2 )
+ integer :: index_x2o_Foxx_sen ! sensible heat flux (W/m2 )
+ integer :: index_x2o_Foxx_lat
+ integer :: index_x2o_Foxx_lwup ! longwave radiation (up) (W/m2 )
+ integer :: index_x2o_Faxa_lwdn ! longwave radiation (down) (W/m2 )
+ integer :: index_x2o_Fioi_melth ! heat flux from snow & ice melt (W/m2 )
+ integer :: index_x2o_Fioi_meltw ! snow melt flux (kg/m2/s)
+ integer :: index_x2o_Fioi_salt ! salt (kg(salt)/m2/s)
+ integer :: index_x2o_Foxx_evap ! evaporation flux (kg/m2/s)
+ integer :: index_x2o_Faxa_prec
+ integer :: index_x2o_Faxa_snow ! water flux due to snow (kg/m2/s)
+ integer :: index_x2o_Faxa_rain ! water flux due to rain (kg/m2/s)
+ integer :: index_x2o_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition
+ integer :: index_x2o_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition
+ integer :: index_x2o_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition
+ integer :: index_x2o_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition
+ integer :: index_x2o_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition
+ integer :: index_x2o_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition
+ integer :: index_x2o_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition
+ integer :: index_x2o_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition
+ integer :: index_x2o_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition
+ integer :: index_x2o_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition
+ integer :: index_x2o_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition
+ integer :: index_x2o_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition
+ integer :: index_x2o_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition
+ integer :: index_x2o_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition
+ integer :: index_x2o_Forr_roff ! river runoff flux (kg/m2/s)
+ integer :: index_x2o_Forr_ioff ! ice runoff flux (kg/m2/s)
+
+contains
+
+ subroutine mpaso_cpl_indices_set( )
+
+ type(mct_aVect) :: o2x ! temporary
+ type(mct_aVect) :: x2o ! temporary
+
+ ! Determine attribute vector indices
+
+ ! create temporary attribute vectors
+ call mct_aVect_init(x2o, rList=seq_flds_x2o_fields, lsize=1)
+ call mct_aVect_init(o2x, rList=seq_flds_o2x_fields, lsize=1)
+
+ index_o2x_So_t = mct_avect_indexra(o2x,'So_t')
+ index_o2x_So_u = mct_avect_indexra(o2x,'So_u')
+ index_o2x_So_v = mct_avect_indexra(o2x,'So_v')
+ index_o2x_So_s = mct_avect_indexra(o2x,'So_s')
+ index_o2x_So_dhdx = mct_avect_indexra(o2x,'So_dhdx')
+ index_o2x_So_dhdy = mct_avect_indexra(o2x,'So_dhdy')
+ index_o2x_Fioo_q = mct_avect_indexra(o2x,'Fioo_q')
+ index_o2x_Faoo_fco2_ocn = mct_avect_indexra(o2x,'Faoo_fco2_ocn',perrWith='quiet')
+ index_o2x_Faoo_fdms_ocn = mct_avect_indexra(o2x,'Faoo_fdms_ocn',perrWith='quiet')
+ index_x2o_Si_ifrac = mct_avect_indexra(x2o,'Si_ifrac')
+ index_x2o_Sa_pslv = mct_avect_indexra(x2o,'Sa_pslv')
+ index_x2o_So_duu10n = mct_avect_indexra(x2o,'So_duu10n')
+
+ index_x2o_Foxx_tauy = mct_avect_indexra(x2o,'Foxx_tauy')
+ index_x2o_Foxx_taux = mct_avect_indexra(x2o,'Foxx_taux')
+ index_x2o_Foxx_swnet = mct_avect_indexra(x2o,'Foxx_swnet')
+ index_x2o_Foxx_lat = mct_avect_indexra(x2o,'Foxx_lat')
+ index_x2o_Foxx_sen = mct_avect_indexra(x2o,'Foxx_sen')
+ index_x2o_Foxx_lwup = mct_avect_indexra(x2o,'Foxx_lwup')
+ index_x2o_Faxa_lwdn = mct_avect_indexra(x2o,'Faxa_lwdn')
+ index_x2o_Fioi_melth = mct_avect_indexra(x2o,'Fioi_melth')
+ index_x2o_Fioi_meltw = mct_avect_indexra(x2o,'Fioi_meltw')
+ index_x2o_Fioi_salt = mct_avect_indexra(x2o,'Fioi_salt')
+ index_x2o_Faxa_prec = mct_avect_indexra(x2o,'Faxa_prec')
+ index_x2o_Faxa_snow = mct_avect_indexra(x2o,'Faxa_snow')
+ index_x2o_Faxa_rain = mct_avect_indexra(x2o,'Faxa_rain')
+ index_x2o_Foxx_evap = mct_avect_indexra(x2o,'Foxx_evap')
+ index_x2o_Forr_roff = mct_avect_indexra(x2o,'Forr_roff')
+ index_x2o_Forr_ioff = mct_avect_indexra(x2o,'Forr_ioff')
+ index_x2o_Faxa_bcphidry = mct_avect_indexra(x2o,'Faxa_bcphidry')
+ index_x2o_Faxa_bcphodry = mct_avect_indexra(x2o,'Faxa_bcphodry')
+ index_x2o_Faxa_bcphiwet = mct_avect_indexra(x2o,'Faxa_bcphiwet')
+ index_x2o_Faxa_ocphidry = mct_avect_indexra(x2o,'Faxa_ocphidry')
+ index_x2o_Faxa_ocphodry = mct_avect_indexra(x2o,'Faxa_ocphodry')
+ index_x2o_Faxa_ocphiwet = mct_avect_indexra(x2o,'Faxa_ocphiwet')
+ index_x2o_Faxa_dstdry1 = mct_avect_indexra(x2o,'Faxa_dstdry1')
+ index_x2o_Faxa_dstdry2 = mct_avect_indexra(x2o,'Faxa_dstdry2')
+ index_x2o_Faxa_dstdry3 = mct_avect_indexra(x2o,'Faxa_dstdry3')
+ index_x2o_Faxa_dstdry4 = mct_avect_indexra(x2o,'Faxa_dstdry4')
+ index_x2o_Faxa_dstwet1 = mct_avect_indexra(x2o,'Faxa_dstwet1')
+ index_x2o_Faxa_dstwet2 = mct_avect_indexra(x2o,'Faxa_dstwet2')
+ index_x2o_Faxa_dstwet3 = mct_avect_indexra(x2o,'Faxa_dstwet3')
+ index_x2o_Faxa_dstwet4 = mct_avect_indexra(x2o,'Faxa_dstwet4')
+ index_x2o_Sa_co2prog = mct_avect_indexra(x2o,'Sa_co2prog',perrWith='quiet')
+ index_x2o_Sa_co2diag = mct_avect_indexra(x2o,'Sa_co2diag',perrWith='quiet')
+
+ call mct_aVect_clean(x2o)
+ call mct_aVect_clean(o2x)
+
+ end subroutine mpaso_cpl_indices_set
+
+end module mpaso_cpl_indices
Deleted: branches/atmos_physics/src/ocean_cesm_driver/mpaso_mct_vars.F
===================================================================
--- trunk/mpas/src/ocean_cesm_driver/mpaso_mct_vars.F 2013-03-25 16:55:55 UTC (rev 2666)
+++ branches/atmos_physics/src/ocean_cesm_driver/mpaso_mct_vars.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,15 +0,0 @@
-module mpaso_mct_vars
-
- use seq_flds_mod
- use mct_mod
-
- implicit none
-
- save
- public ! By default make data private
-
- integer :: MPASO_MCT_OCNID
- type(mct_gsMap), pointer :: MPASO_MCT_gsMap_o
- type(mct_gGrid), pointer :: MPASO_MCT_dom_o
-
-end module mpaso_mct_vars
Copied: branches/atmos_physics/src/ocean_cesm_driver/mpaso_mct_vars.F (from rev 2666, trunk/mpas/src/ocean_cesm_driver/mpaso_mct_vars.F)
===================================================================
--- branches/atmos_physics/src/ocean_cesm_driver/mpaso_mct_vars.F (rev 0)
+++ branches/atmos_physics/src/ocean_cesm_driver/mpaso_mct_vars.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,15 @@
+module mpaso_mct_vars
+
+ use seq_flds_mod
+ use mct_mod
+
+ implicit none
+
+ save
+ public ! By default make data private
+
+ integer :: MPASO_MCT_OCNID
+ type(mct_gsMap), pointer :: MPASO_MCT_gsMap_o
+ type(mct_gGrid), pointer :: MPASO_MCT_dom_o
+
+end module mpaso_mct_vars
Deleted: branches/atmos_physics/src/ocean_cesm_driver/ocn_communicator.F
===================================================================
--- trunk/mpas/src/ocean_cesm_driver/ocn_communicator.F 2013-03-25 16:55:55 UTC (rev 2666)
+++ branches/atmos_physics/src/ocean_cesm_driver/ocn_communicator.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,5 +0,0 @@
-module ocn_communicator
-
- integer, public :: mpi_communicator_ocn
-
-end module ocn_communicator
Copied: branches/atmos_physics/src/ocean_cesm_driver/ocn_communicator.F (from rev 2666, trunk/mpas/src/ocean_cesm_driver/ocn_communicator.F)
===================================================================
--- branches/atmos_physics/src/ocean_cesm_driver/ocn_communicator.F (rev 0)
+++ branches/atmos_physics/src/ocean_cesm_driver/ocn_communicator.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,5 @@
+module ocn_communicator
+
+ integer, public :: mpi_communicator_ocn
+
+end module ocn_communicator
Deleted: branches/atmos_physics/src/ocean_cesm_driver/ocn_comp_mct.F
===================================================================
--- trunk/mpas/src/ocean_cesm_driver/ocn_comp_mct.F 2013-03-25 16:55:55 UTC (rev 2666)
+++ branches/atmos_physics/src/ocean_cesm_driver/ocn_comp_mct.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,1633 +0,0 @@
-module ocn_comp_mct
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!BOP
-! !MODULE: ocn_comp_mct
-! !INTERFACE:
-
-! !DESCRIPTION:
-! This is the main driver for the Model for Predication Across Scales Ocean Model (MPAS-O).
-!
-! !REVISION HISTORY:
-! SVN:$Id:
-!
-! !USES:
- use mct_mod
- use esmf
- use seq_flds_mod
- use seq_cdata_mod
- use seq_infodata_mod
- use seq_timemgr_mod
- use seq_comm_mct, only : seq_comm_suffix, seq_comm_inst, seq_comm_name
- use shr_file_mod
- use shr_cal_mod, only : shr_cal_date2ymd
- use shr_sys_mod
- use shr_pio_mod
- use perf_mod
- use ocn_communicator, only: mpi_communicator_ocn
-
- use mpaso_cpl_indices
- use mpaso_mct_vars
-
- use mpas_framework
- use mpas_core
- use mpas_kind_types
-
-!
-! !PUBLIC MEMBER FUNCTIONS:
- implicit none
- public :: ocn_init_mct
- public :: ocn_run_mct
- public :: ocn_final_mct
- SAVE
- private ! By default make data private
-
-!
-! ! PUBLIC DATA:
-!
-! !REVISION HISTORY:
-! Author: Mariana Vertenstein
-!
-!EOP
-! !PRIVATE MODULE FUNCTIONS:
- private :: ocn_export_mct
- private :: ocn_import_mct
- private :: ocn_SetGSMap_mct
- private :: ocn_domain_mct
-!
-! !PRIVATE MODULE VARIABLES
-
- logical :: ldiag_cpl = .false.
-
- integer, private :: &
- cpl_write_restart, &! flag id for write restart
- cpl_write_history, &! flag id for write history
- cpl_write_tavg, &! flag id for write tavg
- cpl_diag_global, &! flag id for computing diagnostics
- cpl_diag_transp, &! flag id for computing diagnostics
- my_task
-
- real (kind=RKIND), dimension(:,:,:,:), allocatable :: SBUFF_SUM ! accumulated sum of send buffer quantities
- ! for averaging before being sent
- real (kind=RKIND) :: tlast_coupled
-
- integer :: nsend, nrecv
-
- character(len=StrKIND) :: runtype
-
- type(seq_infodata_type), pointer :: infodata
- type (iosystem_desc_t), pointer :: io_system
-
- !! MPAS-O Datatypes
- type (dm_info), pointer :: dminfo
- type (domain_type), pointer :: domain
- type (io_output_object), save :: output_obj
- integer :: output_frame
-! type (MPAS_Clock_type) :: clock
-
-!=======================================================================
-
-contains
-
-!***********************************************************************
-!BOP
-!
-! !IROUTINE: ocn_init_mct
-!
-! !INTERFACE:
- subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{
-!
-! !DESCRIPTION:
-! Initialize POP
-!
-! !INPUT/OUTPUT PARAMETERS:
-
- type(ESMF_Clock), intent(in) :: EClock
- type(seq_cdata), intent(inout) :: cdata_o
- type(mct_aVect), intent(inout) :: x2o_o, o2x_o
- character(len=*), optional, intent(in) :: NLFilename ! Namelist filename
-!
-! !REVISION HISTORY:
-! Author: Mariana Vertenstein
-!EOP
-!-----------------------------------------------------------------------
-!
-! local variables
-!
-!-----------------------------------------------------------------------
-
- integer :: OCNID, mpicom_o, lsize, start_ymd, start_tod, start_year, start_day, &
- start_month, start_hour, iyear, ocn_cpl_dt, mpas_o_cpl_dt, shrlogunit, shrloglev
-
- type(mct_gsMap), pointer :: gsMap_o
-
- type(mct_gGrid), pointer :: dom_o
-
- integer :: errorCode ! error code
-
- integer :: nThreads
-
- real (kind=RKIND) :: precadj
-
- type (MPAS_Time_Type) :: currTime
- integer :: iam,ierr
- integer :: iyear0, imonth0
- character(len=StrKIND) :: starttype ! infodata start type
- character(len=StrKIND) :: timeStamp
- character(len=StrKIND) :: nml_filename
-
- integer :: lbnum
-
-!-----------------------------------------------------------------------
-!
-! set cdata pointers
-!
-!-----------------------------------------------------------------------
-
- errorCode = 0
-
- call seq_cdata_setptrs(cdata_o, ID=OCNID, mpicom=mpicom_o, &
- gsMap=gsMap_o, dom=dom_o, infodata=infodata)
-
- MPASO_MCT_OCNID = OCNID
- MPASO_MCT_gsMap_o => gsMap_o
- MPASO_MCT_dom_o => dom_o
-
-#if (defined _MEMTRACE)
- call MPI_comm_rank(mpicom_o,iam,ierr)
- if(iam == 0) then
- lbnum=1
- call memmon_dump_fort('memmon.out','ocn_init_mct:start::',lbnum)
- endif
-#endif
-
-
- ! The following communicator module variable will be utilized in init_communicate that
- ! is called by initial - this is done to make the code backwards compatible
-
- mpi_communicator_ocn = mpicom_o
-
-!-----------------------------------------------------------------------
-!
-! initialize the model run
-!
-!-----------------------------------------------------------------------
-
- call mpaso_cpl_indices_set()
-
-! call seq_infodata_GetData( infodata, case_name=runid )
- call seq_infodata_GetData( infodata, start_type=starttype)
-
-
- if ( trim(starttype) == trim(seq_infodata_start_type_start)) then
- runtype = "initial"
- else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then
- runtype = "continue"
- else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then
- runtype = "branch"
- else
- call mpas_dmpar_global_abort(' ocn_comp_mct ERROR: unknown starttype')
- end if
-
-!-----------------------------------------------------------------------
-!
-! first initializaiton phase of mpas-o
-! initialize mpas-o because grid information is needed for
-! creation of GSMap_ocn.
-! call mpas-o initialization routines
-!
-!-----------------------------------------------------------------------
-
-! inst_name = seq_comm_name(OCNID)
-! inst_index = seq_comm_inst(OCNID)
-! inst_suffix = seq_comm_suffix(OCNID)
-
- call t_startf('mpas-o_init')
- nml_filename = "mpaso.in"
-
- io_system => shr_pio_getiosys(ocnid)
-
- call mpas_framework_init(dminfo, domain, mpi_communicator_ocn, nml_filename, io_system)
-
- my_task = dminfo % my_proc_id
- call mpas_timer_start("total time")
-
- call mpas_input_state_for_domain(domain)
-
- call mpas_core_init(domain, timeStamp)
-
-!-----------------------------------------------------------------------
-!
-! initialize time-stamp information
-!
-!-----------------------------------------------------------------------
-
- call t_stopf ('mpas-o_init')
-
-!----------------------------------------------------------------------------
-!
-! reset shr logging to my log file
-!
-!----------------------------------------------------------------------------
-
- call shr_file_getLogUnit (shrlogunit)
- call shr_file_getLogLevel(shrloglev)
-! call shr_file_setLogUnit (stdout)
-
-!-----------------------------------------------------------------------
-!
-! check for consistency of mpas-o and sync clock initial time
-!
-!-----------------------------------------------------------------------
-
- if (runtype == 'initial') then
- currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
- call mpas_get_time(curr_time=currTime, YYYY=iyear0, MM=imonth0, ierr=ierr)
- call seq_timemgr_EClockGetData(EClock, start_ymd=start_ymd, start_tod=start_tod)
- call shr_cal_date2ymd(start_ymd,start_year,start_month,start_day)
-
- if (iyear0 /= start_year) then
- call mpas_dmpar_global_abort(' iyear0 does not match start_year')
- end if
- if (imonth0 /= start_month) then
- call mpas_dmpar_global_abort(' imonth0 does not match start_year')
- end if
- end if
-
-!-----------------------------------------------------------------------
-!
-! initialize MCT attribute vectors and indices
-!
-!-----------------------------------------------------------------------
-
- call t_startf ('mpas-o_mct_init')
-
- call ocn_SetGSMap_mct( mpicom_o, OCNID, GSMap_o )
- lsize = mct_gsMap_lsize(gsMap_o, mpicom_o)
-
- ! Initialize mct ocn domain (needs ocn initialization info)
-
- call ocn_domain_mct( lsize, gsMap_o, dom_o )
-
- ! Inialize mct attribute vectors
-
- call mct_aVect_init(x2o_o, rList=seq_flds_x2o_fields, lsize=lsize)
- call mct_aVect_zero(x2o_o)
-
- call mct_aVect_init(o2x_o, rList=seq_flds_o2x_fields, lsize=lsize)
- call mct_aVect_zero(o2x_o)
-
- nsend = mct_avect_nRattr(o2x_o)
- nrecv = mct_avect_nRattr(x2o_o)
-
-!-----------------------------------------------------------------------
-!
-! initialize necessary coupling info
-!
-!-----------------------------------------------------------------------
-
- call seq_timemgr_EClockGetData(EClock, dtime=ocn_cpl_dt)
- mpas_o_cpl_dt = 86400 / config_ncouple_per_day
- if (mpas_o_cpl_dt /= ocn_cpl_dt) then
- write(0,*)'mpas-o_cpl_dt= ',mpas_o_cpl_dt, &
- ' ocn_cpl_dt= ',ocn_cpl_dt
- call mpas_dmpar_global_abort('ERROR mpas-o_cpl_dt and ocn_cpl_dt must be identical')
- end if
-
-!-----------------------------------------------------------------------
-!
-! send intial state to driver
-!
-!-----------------------------------------------------------------------
-
-! if ( lsend_precip_fact ) then
-! precadj = precip_fact * 1.0e6_r8
-! call seq_infodata_PutData( infodata, precip_fact=precadj)
-! end if
-
- call ocn_export_mct(o2x_o, errorCode)
- if (errorCode /= 0) then
- call mpas_dmpar_global_abort('ERROR in ocn_export_mct')
- endif
-
- call t_stopf ('mpas-o_mct_init')
-
-! call seq_infodata_PutData( infodata, ocn_nx = nx_global , ocn_ny = ny_global)
- call seq_infodata_PutData( infodata, ocn_prognostic=.true., ocnrof_prognostic=.true.)
-
-!----------------------------------------------------------------------------
-!
-! Reset shr logging to original values
-!
-!----------------------------------------------------------------------------
-
- call shr_file_setLogUnit (shrlogunit)
- call shr_file_setLogLevel(shrloglev)
-
-#if (defined _MEMTRACE)
- if(iam == 0) then
- lbnum=1
- call memmon_dump_fort('memmon.out','ocn_init_mct:end::',lbnum)
- call memmon_reset_addr()
- endif
-#endif
-
-!-----------------------------------------------------------------------
-!
-! output delimiter to log file
-!
-!-----------------------------------------------------------------------
-
- !DWJ IO Units
-! if (my_task == master_task) then
-! write(stdout,blank_fmt)
-! write(stdout,'(" End of initialization")')
-! write(stdout,blank_fmt)
-! write(stdout,ndelim_fmt)
-! call POP_IOUnitsFlush(POP_stdout)
-#ifdef CCSMCOUPLED
-! call POP_IOUnitsFlush(stdout)
-#endif
-! endif
-
- !
- ! Set up output streams to be written to by the MPAS core
- !
- output_frame = 1
-
- if(config_frames_per_outfile > 0) then
- call mpas_output_state_init(output_obj, domain, "OUTPUT", trim(timeStamp))
- else
- call mpas_output_state_init(output_obj, domain, "OUTPUT")
- end if
-
-!-----------------------------------------------------------------------
-!EOC
-
- end subroutine ocn_init_mct!}}}
-
-!***********************************************************************
-!BOP
-!
-! !IROUTINE: ocn_run_mct
-!
-! !INTERFACE:
- subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{
-
- use mpas_kind_types
- use mpas_grid_types
- use mpas_io_output
- use mpas_timer
-
- implicit none
-!
-! !DESCRIPTION:
-! Run POP for a coupling interval
-!
-! !INPUT/OUTPUT PARAMETERS:
- type(ESMF_Clock) , intent(in) :: EClock
- type(seq_cdata) , intent(inout) :: cdata_o
- type(mct_aVect) , intent(inout) :: x2o_o
- type(mct_aVect) , intent(inout) :: o2x_o
-
-!!
-!! !REVISION HISTORY:
-!! Author: Mariana Vertenstein
-!!EOP
-!!-----------------------------------------------------------------------
-!!
-!! local variables
-!!
-!!-----------------------------------------------------------------------
-!
-! integer :: errorCode ! error flag
-!
-! integer :: itimestep
-!
-! integer :: &
-! ymd, & ! POP2 current date (YYYYMMDD)
-! tod, & ! POP2 current time of day (sec)
-! ymd_sync, & ! Sync clock current date (YYYYMMDD)
-! tod_sync, & ! Sync clcok current time of day (sec)
-! shrlogunit, & ! old values
-! shrloglev ! old values
-!
-! character(len=char_len_long) :: &
-! fname
-!
-! type(seq_infodata_type), pointer :: &
-! infodata ! Input init object
-!
-! real (kind=RKIND) :: &
-! precadj
-!
-! logical :: &
-! lcoupled, & ! temporary
-! rstwr, & ! true => write restart at end of day
-! first_time = .true.
-!
-! character (char_len) :: message
-!
-! integer(int_kind) :: info_debug
-!
-! integer :: lbnum
-
- integer :: itimestep
- real (kind=RKIND) :: dt
- type (block_type), pointer :: block_ptr
-
- type (MPAS_Time_Type) :: currTime
- character(len=StrKIND) :: timeStamp
- integer :: ierr
-
- ! Eventually, dt should be domain specific
- dt = config_dt
-
- currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
- call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
- write(0,*) 'Initial time ', trim(timeStamp)
-
- call ocn_write_output_frame(output_obj, output_frame, domain)
- block_ptr => domain % blocklist
-
- do while(associated(block_ptr))
- call ocn_time_average_init(block_ptr % state % time_levs(1) % state)
- block_ptr => block_ptr % next
- end do
-
- ! During integration, time level 1 stores the model state at the beginning of the
- ! time step, and time level 2 stores the state advanced dt in time by timestep(...)
- itimestep = 0
- do while (.not. mpas_is_clock_stop_time(clock))
-
- itimestep = itimestep + 1
- call mpas_advance_clock(clock)
-
- currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
- call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
- write(0,*) 'Doing timestep ', trim(timeStamp)
-
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- call ocn_build_forcing_arrays(currTime, block_ptr % mesh, ierr)
- block_ptr => block_ptr % next
- end do
-
- call mpas_timer_start("time integration", .false., timeIntTimer)
- call mpas_timestep(domain, itimestep, dt, timeStamp)
- call mpas_timer_stop("time integration", timeIntTimer)
-
- ! Move time level 2 fields back into time level 1 for next time step
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- call mpas_shift_time_levels_state(block_ptr % state)
- block_ptr => block_ptr % next
- end do
-
- if (mpas_is_alarm_ringing(clock, outputAlarmID, ierr=ierr)) then
- call mpas_reset_clock_alarm(clock, outputAlarmID, ierr=ierr)
- ! output_frame will always be > 1 here unless it was reset after the maximum number of frames per outfile was reached
- if(output_frame == 1) then
- call mpas_output_state_finalize(output_obj, domain % dminfo)
- call mpas_output_state_init(output_obj, domain, "OUTPUT", trim(timeStamp))
- end if
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
- call ocn_time_average_normalize(block_ptr % state % time_levs(1) % state)
- block_ptr => block_ptr % next
- end do
-
- call ocn_write_output_frame(output_obj, output_frame, domain)
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
- call ocn_time_average_init(block_ptr % state % time_levs(1) % state)
- block_ptr => block_ptr % next
- end do
- end if
-
- if (mpas_is_alarm_ringing(clock, restartAlarmID, ierr=ierr)) then
- call mpas_reset_clock_alarm(clock, restartAlarmID, ierr=ierr)
-
- ! Write one restart time per file
- call mpas_output_state_init(restart_obj, domain, "RESTART", trim(timeStamp))
- call mpas_output_state_for_domain(restart_obj, domain, 1)
- call mpas_output_state_finalize(restart_obj, domain % dminfo)
- end if
-
- end do
-!
-!#if (defined _MEMTRACE)
-! if(my_task == 0 ) then
-! lbnum=1
-! call memmon_dump_fort('memmon.out',SubName//':start::',lbnum)
-! endif
-!#endif
-!
-!!-----------------------------------------------------------------------
-!!
-!! start up the main timer
-!!
-!!-----------------------------------------------------------------------
-!
-! call mpas_timer_start('total time')
-!
-!
-!!-----------------------------------------------------------------------
-!!
-!! reset shr logging to my log file
-!!
-!!----------------------------------------------------------------------------
-!
-! errorCode = POP_Success
-!
-! call shr_file_getLogUnit (shrlogunit)
-! call shr_file_getLogLevel(shrloglev)
-! call shr_file_setLogUnit (stdout)
-!
-! call seq_cdata_setptrs(cdata_o, infodata=infodata)
-!
-!!----------------------------------------------------------------------------
-!!
-!! restart flag (rstwr) will assume only an eod restart for now
-!!
-!!----------------------------------------------------------------------------
-!
-! call seq_infodata_GetData( infodata, info_debug=info_debug)
-! if (info_debug >= 2) then
-! ldiag_cpl = .true.
-! else
-! ldiag_cpl = .false.
-! endif
-!
-! rstwr = seq_timemgr_RestartAlarmIsOn(EClock)
-!
-!!-----------------------------------------------------------------------
-!!
-!! advance the model in time over coupling interval
-!! write restart dumps and archiving
-!!
-!!-----------------------------------------------------------------------
-!
-! ! Note that all ocean time flags are evaluated each timestep in time_manager
-! ! ocn_import_mct is analogous to pop_unpack_fluxes_from_coupler in cpl6
-! ! ocn_export_mct is analogous to prepare_send_to_coupler in cpl6
-! ! tlast_coupled is set to zero at the end of ocn_export_mct
-!
-! itimestep = 0
-! timestep: do
-! ! obtain import state from driver
-! if (check_time_flag(cpl_ts) .or. nsteps_run == 0) then
-! call ocn_import_mct(x2o_o, errorCode)
-!
-! if (errorCode /= POP_Success) then
-! call POP_ErrorPrint(errorCode)
-! call exit_POP(sigAbort, 'ERROR in step')
-! endif
-!
-! !DWJ Need to write on mpas side
-!! call pop_set_coupled_forcing
-! end if
-!
-!
-! end do timestep
-!
-! advance: do
-!
-! call step(errorCode)
-!
-! if (errorCode /= POP_Success) then
-! call POP_ErrorPrint(errorCode)
-! call exit_POP(sigAbort, 'ERROR in step')
-! endif
-!
-! if (check_KE(100.0_r8)) then
-! !*** exit if energy is blowing
-! call output_driver
-! call exit_POP(sigAbort,'ERROR: k.e. > 100 ')
-! endif
-! call output_driver
-!
-! ! return export state to driver
-! call pop_sum_buffer()
-! if (check_time_flag(cpl_ts)) then
-! call ocn_export_mct(o2x_o, errorCode)
-! if (errorCode /= POP_Success) then
-! call POP_ErrorPrint(errorCode)
-! call exit_POP(sigAbort, 'ERROR in ocn_export_mct')
-! endif
-!
-! exit advance
-! end if
-!
-! enddo advance
-!
-! if ( lsend_precip_fact ) then
-! precadj = precip_fact * 1.0e6_r8
-! call seq_infodata_PutData( infodata, precip_fact=precadj )
-! end if
-!
-!!--------------------------------------------------------------------
-!!
-!! check that internal clock is in sync with master clock
-!!
-!!--------------------------------------------------------------------
-!
-! ymd = iyear*10000 + imonth*100 + iday
-! tod = ihour*seconds_in_hour + iminute*seconds_in_minute + isecond
-! if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then
-! call seq_timemgr_EClockGetData( EClock, curr_ymd=ymd_sync, &
-! curr_tod=tod_sync )
-! write(stdout,*)' pop2 ymd=',ymd ,' pop2 tod= ',tod
-! write(stdout,*)' sync ymd=',ymd_sync,' sync tod= ',tod_sync
-! write(stdout,*)' Internal pop2 clock not in sync with Sync Clock'
-! call shr_sys_abort( SubName// &
-! ":: Internal pop2 clock not in sync with Sync Clock")
-! end if
-!
-!!----------------------------------------------------------------------------
-!!
-!! Reset shr logging to original values
-!!
-!!----------------------------------------------------------------------------
-!
-! call shr_file_setLogUnit (shrlogunit)
-! call shr_file_setLogLevel(shrloglev)
-!
-! call mpas_timer_stop('total time')
-!
-!#if (defined _MEMTRACE)
-! if(my_task == 0) then
-! lbnum=1
-! call memmon_dump_fort('memmon.out',SubName//':end::',lbnum)
-! call memmon_reset_addr()
-! endif
-!#endif
-!-----------------------------------------------------------------------
-!EOC
-
- end subroutine ocn_run_mct!}}}
-
-!***********************************************************************
-!BOP
-!
-! !IROUTINE: ocn_final_mct
-!
-! !INTERFACE:
- subroutine ocn_final_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{
-!
-! !DESCRIPTION:
-! Finalize POP
-!
-! !USES:
-! !ARGUMENTS:
- type(ESMF_Clock) , intent(in) :: EClock
- type(seq_cdata) , intent(inout) :: cdata_o
- type(mct_aVect) , intent(inout) :: x2o_o
- type(mct_aVect) , intent(inout) :: o2x_o
-!
-! !REVISION HISTORY:
-! Author: Fei Liu
-!EOP
-!BOC
-!-----------------------------------------------------------------------
-!
-! local variables
-!
-!-----------------------------------------------------------------------
-
- integer :: &
- errorCode ! error code
-
-!-----------------------------------------------------------------------
-
-
-
- call mpas_output_state_finalize(output_obj, domain % dminfo)
- call mpas_timer_stop("total time")
- call mpas_timer_write()
- write(0,*) 'core finalize'
- call mpas_core_finalize(domain)
- write(0,*) 'framework finalize'
- call mpas_framework_finalize(dminfo, domain, io_system)
- write(0,*) 'done in final mct'
-
- end subroutine ocn_final_mct!}}}
-
-!***********************************************************************
-!BOP
-!IROUTINE: ocn_SetGSMap_mct
-! !INTERFACE:
-
- subroutine ocn_SetGSMap_mct( mpicom_ocn, OCNID, gsMap_ocn )!{{{
-
- use mpas_dmpar
-
-! !DESCRIPTION:
-! This routine mct global seg maps for the pop decomposition
-!
-! !REVISION HISTORY:
-! same as module
-
-! !INPUT/OUTPUT PARAMETERS:
-
- implicit none
- integer , intent(in) :: mpicom_ocn
- integer , intent(in) :: OCNID
- type(mct_gsMap), intent(inout) :: gsMap_ocn
-
-!EOP
-!BOC
-!-----------------------------------------------------------------------
-!
-! local variables
-!
-!-----------------------------------------------------------------------
-
- integer,allocatable :: &
- gindex(:)
-
- integer :: &
- i,j, k, n, iblock, &
- lsize, gsize, &
- ier
-
- type (block_type), pointer :: block_ptr
-
-!-----------------------------------------------------------------------
-! Build the POP grid numbering for MCT
-! NOTE: Numbering scheme is: West to East and South to North starting
-! at the south pole. Should be the same as what's used in SCRIP
-!-----------------------------------------------------------------------
-
- n = 0
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- n = n + block_ptr % mesh % nCellsSolve
- block_ptr => block_ptr % next
- end do
-
- lsize = n
- call mpas_dmpar_sum_int(dminfo, lsize, gsize)
- allocate(gindex(lsize),stat=ier)
-
- n = 0
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- do i = 1, block_ptr % mesh % nCellsSolve
- n = n + 1
- gindex(n) = block_ptr % mesh % indexToCellID % array(i)
- end do
- block_ptr => block_ptr % next
- end do
-
- call mct_gsMap_init( gsMap_ocn, gindex, mpicom_ocn, OCNID, lsize, gsize )
-
- deallocate(gindex)
-
-!-----------------------------------------------------------------------
-!EOC
-
- end subroutine ocn_SetGSMap_mct!}}}
-
-!***********************************************************************
-!BOP
-! !IROUTINE: ocn_domain_mct
-! !INTERFACE:
-
- subroutine ocn_domain_mct( lsize, gsMap_o, dom_o )!{{{
-
-! !DESCRIPTION:
-! This routine mct global seg maps for the pop decomposition
-!
-! !REVISION HISTORY:
-! same as module
-!
-! !INPUT/OUTPUT PARAMETERS:
-
- implicit none
- integer , intent(in) :: lsize
- type(mct_gsMap), intent(in) :: gsMap_o
- type(mct_ggrid), intent(inout) :: dom_o
-
-!EOP
-!BOC
-!-----------------------------------------------------------------------
-!
-! local variables
-!
-!-----------------------------------------------------------------------
-
- integer, pointer :: idata(:)
-
- real(kind=RKIND), pointer :: data(:)
- real(kind=RKIND) :: r2d
-
- integer :: i,j, k, n, ier
-
- type (block_type), pointer :: block_ptr
-
- r2d = 180.0/pii
-
-!-------------------------------------------------------------------
-!
-! initialize mct domain type, lat/lon in degrees,
-! area in radians^2, mask is 1 (ocean), 0 (non-ocean)
-!
-!-------------------------------------------------------------------
-
- call mct_gGrid_init( GGrid=dom_o, CoordChars=trim(seq_flds_dom_coord), &
- OtherChars=trim(seq_flds_dom_other), lsize=lsize )
- call mct_aVect_zero(dom_o%data)
- allocate(data(lsize))
-
-!-------------------------------------------------------------------
-!
-! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT
-!
-!-------------------------------------------------------------------
-
- call mct_gsMap_orderedPoints(gsMap_o, my_task, idata)
- call mct_gGrid_importIAttr(dom_o,'GlobGridNum',idata,lsize)
-
-!-------------------------------------------------------------------
-!
-! Determine domain (numbering scheme is: West to East and South to North to South pole)
-! Initialize attribute vector with special value
-!
-!-------------------------------------------------------------------
-
- data(:) = -9999.0_R8
- call mct_gGrid_importRAttr(dom_o,"lat" ,data,lsize)
- call mct_gGrid_importRAttr(dom_o,"lon" ,data,lsize)
- call mct_gGrid_importRAttr(dom_o,"area" ,data,lsize)
- call mct_gGrid_importRAttr(dom_o,"aream",data,lsize)
- data(:) = 0.0_R8
- call mct_gGrid_importRAttr(dom_o,"mask",data,lsize)
- call mct_gGrid_importRAttr(dom_o,"frac",data,lsize)
-
-!-------------------------------------------------------------------
-!
-! Fill in correct values for domain components
-!
-!-------------------------------------------------------------------
-
- n = 0
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- do i = 1, block_ptr % mesh % nCellsSolve
- n = n + 1
- data(n) = block_ptr % mesh % lonCell % array(i) * r2d
- end do
-
- block_ptr => block_ptr % next
- end do
- call mct_gGrid_importRattr(dom_o,"lon",data,lsize)
-
- n = 0
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- do i = 1, block_ptr % mesh % nCellsSolve
- n = n + 1
- data(n) = block_ptr % mesh % latCell % array(i) * r2d
- end do
- block_ptr => block_ptr % next
- end do
- call mct_gGrid_importRattr(dom_o,"lat",data,lsize)
-
- n = 0
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- do i = 1, block_ptr % mesh % nCellsSolve
- n = n + 1
- data(n) = block_ptr % mesh % areaCell % array(i) / (block_ptr % mesh % sphere_radius * block_ptr % mesh % sphere_radius)
- end do
- block_ptr => block_ptr % next
- end do
- call mct_gGrid_importRattr(dom_o,"area",data,lsize)
-
- data(:) = 1.0_RKIND ! No land cells in MPAS-O, only Ocean cells
- call mct_gGrid_importRattr(dom_o,"mask",data,lsize)
- call mct_gGrid_importRattr(dom_o,"frac",data,lsize)
-
- deallocate(data)
- deallocate(idata)
-
-!-----------------------------------------------------------------------
-!EOC
-
- end subroutine ocn_domain_mct!}}}
-
-
-!***********************************************************************
-!BOP
-! !IROUTINE: ocn_import_mct
-! !INTERFACE:
-
- subroutine ocn_import_mct(x2o_o, errorCode)!{{{
-
-! !DESCRIPTION:
-!-----------------------------------------------------------------------
-! This routine receives message from cpl7 driver
-!
-! The following fields are always received from the coupler:
-!
-! o taux -- zonal wind stress (taux) (W/m2 )
-! o tauy -- meridonal wind stress (tauy) (W/m2 )
-! o snow -- water flux due to snow (kg/m2/s)
-! o rain -- water flux due to rain (kg/m2/s)
-! o evap -- evaporation flux (kg/m2/s)
-! o meltw -- snow melt flux (kg/m2/s)
-! o salt -- salt (kg(salt)/m2/s)
-! o swnet -- net short-wave heat flux (W/m2 )
-! o sen -- sensible heat flux (W/m2 )
-! o lwup -- longwave radiation (up) (W/m2 )
-! o lwdn -- longwave radiation (down) (W/m2 )
-! o melth -- heat flux from snow&ice melt (W/m2 )
-! o ifrac -- ice fraction
-! o roff -- river runoff flux (kg/m2/s)
-! o ioff -- ice runoff flux (kg/m2/s)
-!
-! The following fields are sometimes received from the coupler,
-! depending on model options:
-!
-! o pslv -- sea-level pressure (Pa)
-! o duu10n -- 10m wind speed squared (m^2/s^2)
-! o co2prog-- bottom atm level prognostic co2
-! o co2diag-- bottom atm level diagnostic co2
-!
-!-----------------------------------------------------------------------
-!
-! !REVISION HISTORY:
-! same as module
-
-! !INPUT/OUTPUT PARAMETERS:
-
- type(mct_aVect) , intent(inout) :: x2o_o
-
-! !OUTPUT PARAMETERS:
-
- integer, intent(out) :: &
- errorCode ! returned error code
-
-!EOP
-!BOC
-!-----------------------------------------------------------------------
-!
-! local variables
-!
-!-----------------------------------------------------------------------
-
-! character (len=StrKIND) :: &
-! label, &
-! message
-!
-! integer :: &
-! i,j,k,n,iblock
-!
-! real (kind=RKIND), dimension(nx_block,ny_block) :: &
-! WORKB
-!
-! real (kind=RKIND), dimension(nx_block,ny_block,max_blocks_clinic) :: &
-! WORK1, WORK2 ! local work space
-!
-! real (r8) :: &
-! m2percm2, &
-! gsum
-!
-! type (block) :: this_block ! local block info
-!
-!!-----------------------------------------------------------------------
-!!
-!! zero out padded cells
-!!
-!!-----------------------------------------------------------------------
-!
-! errorCode = POP_Success
-!
-! WORK1 = c0
-! WORK2 = c0
-!
-!!-----------------------------------------------------------------------
-!!
-!! unpack and distribute wind stress, then convert to correct units
-!! and rotate components to local coordinates
-!!
-!!-----------------------------------------------------------------------
-!
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-!
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! WORK1(i,j,iblock) = x2o_o%rAttr(index_x2o_Foxx_taux,n)
-! WORK2(i,j,iblock) = x2o_o%rAttr(index_x2o_Foxx_tauy,n)
-! enddo
-! enddo
-! enddo ! iblock
-!
-! !***
-! !*** do NOT perform halo updates now, because vector updates must
-! !*** be done after the rotation is completed.
-! !***
-!
-!!-----------------------------------------------------------------------
-!!
-!! rotate true zonal/meridional wind stress into local coordinates,
-!! convert to dyne/cm**2, and shift SMFT to U grid
-!!
-!! halo updates are performed in subroutine rotate_wind_stress,
-!! following the rotation
-!!
-!!-----------------------------------------------------------------------
-!
-! call rotate_wind_stress(WORK1, WORK2)
-!
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-!
-!!-----------------------------------------------------------------------
-!!
-!! unpack and distribute fresh water flux and salt flux
-!!
-!! NOTE: if there are code changes associated with changing the names or
-!! the number of fluxes received from the coupler, then subroutine
-!! update_ghost_cells_coupler_fluxes will need to be modified also
-!!
-!!-----------------------------------------------------------------------
-!
-!
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! SNOW_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Faxa_snow,n)
-! WORKB (i,j ) = x2o_o%rAttr(index_x2o_Faxa_rain,n)
-! EVAP_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Foxx_evap,n)
-! MELT_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Fioi_meltw,n)
-! ROFF_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Forr_roff,n)
-! IOFF_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Forr_ioff,n)
-! SALT_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Fioi_salt,n)
-!
-! PREC_F(i,j,iblock) = WORKB(i,j) + SNOW_F(i,j,iblock) ! rain + snow
-!
-! WORKB(i,j ) = x2o_o%rAttr(index_x2o_Foxx_swnet,n)
-! SHF_QSW(i,j,iblock) = WORKB(i,j)* &
-! RCALCT(i,j,iblock)*hflux_factor ! convert from W/m**2
-! SENH_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Foxx_sen,n)
-! LWUP_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Foxx_lwup,n)
-! LWDN_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Faxa_lwdn,n)
-! MELTH_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Fioi_melth,n)
-!
-! WORKB(i,j ) = x2o_o%rAttr(index_x2o_Si_ifrac,n)
-! IFRAC(i,j,iblock) = WORKB(i,j) * RCALCT(i,j,iblock)
-!
-! !*** converting from Pa to dynes/cm**2
-! WORKB(i,j ) = x2o_o%rAttr(index_x2o_Sa_pslv,n)
-! ATM_PRESS(i,j,iblock) = c10 * WORKB(i,j) * RCALCT(i,j,iblock)
-!
-! !*** converting from m**2/s**2 to cm**2/s**2
-! WORKB(i,j ) = x2o_o%rAttr(index_x2o_So_duu10n,n)
-! U10_SQR(i,j,iblock) = cmperm * cmperm * WORKB(i,j) * RCALCT(i,j,iblock)
-!
-! enddo
-! enddo
-!
-! enddo
-!
-!!-----------------------------------------------------------------------
-!!
-!! incoming data quality control
-!!
-!!-----------------------------------------------------------------------
-!#ifdef CCSMCOUPLED
-! if ( any(IOFF_F < c0) ) then
-! call shr_sys_abort ('Error: incoming IOFF_F is negative')
-! endif
-!#endif
-!
-!
-!!-----------------------------------------------------------------------
-!!
-!! update ghost cells for fluxes received from the coupler
-!!
-!!-----------------------------------------------------------------------
-!
-! call update_ghost_cells_coupler_fluxes(errorCode)
-!
-! if (errorCode /= POP_Success) then
-! call POP_ErrorSet(errorCode, &
-! 'ocn_import_mct: error in update_ghost_cells_coupler_fluxes')
-! return
-! endif
-!
-!!-----------------------------------------------------------------------
-!!
-!! unpack atmospheric CO2
-!!
-!!-----------------------------------------------------------------------
-!
-! if (index_x2o_Sa_co2prog > 0) then
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-!
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! WORK1(i,j,iblock) = x2o_o%rAttr(index_x2o_Sa_co2prog,n)
-! enddo
-! enddo
-! enddo
-!
-! call POP_HaloUpdate(WORK1,POP_haloClinic, &
-! POP_gridHorzLocCenter, &
-! POP_fieldKindScalar, errorCode, &
-! fillValue = 0.0_POP_r8)
-!
-! if (errorCode /= POP_Success) then
-! call POP_ErrorSet(errorCode, &
-! 'ocn_import_mct: error updating PROG CO2 halo')
-! return
-! endif
-!
-! call named_field_set(ATM_CO2_PROG_nf_ind, WORK1)
-! endif
-!
-! if (index_x2o_Sa_co2diag > 0) then
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-!
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! WORK1(i,j,iblock) = x2o_o%rAttr(index_x2o_Sa_co2diag,n)
-! enddo
-! enddo
-! enddo
-!
-! call POP_HaloUpdate(WORK1,POP_haloClinic, &
-! POP_gridHorzLocCenter, &
-! POP_fieldKindScalar, errorCode, &
-! fillValue = 0.0_POP_r8)
-!
-! if (errorCode /= POP_Success) then
-! call POP_ErrorSet(errorCode, &
-! 'ocn_import_mct: error updating DIAG CO2 halo')
-! return
-! endif
-!
-! call named_field_set(ATM_CO2_DIAG_nf_ind, WORK1)
-! endif
-!
-!!-----------------------------------------------------------------------
-!!
-!! receive orbital parameters
-!!
-!!-----------------------------------------------------------------------
-!
-! call seq_infodata_GetData(infodata, &
-! orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr)
-!
-!
-!!-----------------------------------------------------------------------
-!!
-!! diagnostics
-!!
-!!-----------------------------------------------------------------------
-!
-! if (ldiag_cpl) then
-!
-! write(message,'(6a,1x,5a)') &
-! ' Global averages of fluxes received from cpl at ', &
-! cyear,'/',cmonth ,'/',cday, chour,':',cminute,':',csecond
-! call document ('pop_recv_from_coupler', trim(message))
-!
-! m2percm2 = mpercm*mpercm
-! do k = 1,nrecv
-!
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-!
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! WORK1(i,j,iblock) = x2o_o%rAttr(k,n) ! mult. by TAREA in global_sum_prod
-! enddo
-! enddo
-! enddo
-!
-! gsum = global_sum_prod(WORK1 , TAREA, distrb_clinic, &
-! field_loc_center, RCALCT)*m2percm2
-! if (my_task == master_task) then
-! call seq_flds_getField(label,k,seq_flds_x2o_fields)
-! write(stdout,1100)'ocn','recv', label ,gsum
-! call shr_sys_flush(stdout)
-! endif
-! enddo
-! endif
-!
-!
-!1100 format ('comm_diag ', a3, 1x, a4, 1x, a8, 1x, es26.19:, 1x, a6)
-
-!-----------------------------------------------------------------------
-!EOC
-
- end subroutine ocn_import_mct!}}}
-!***********************************************************************
-!BOP
-! !IROUTINE: ocn_export_mct
-! !INTERFACE:
-
- subroutine ocn_export_mct(o2x_o, errorCode) !{{{
-
-! !DESCRIPTION:
-! This routine calls the routines necessary to send pop fields to
-! the CCSM cpl7 driver
-!
-! !REVISION HISTORY:
-! same as module
-!
-! !INPUT/OUTPUT PARAMETERS:
-
- type(mct_aVect) , intent(inout) :: o2x_o
-
-! !OUTPUT PARAMETERS:
-
- integer, intent(out) :: &
- errorCode ! returned error code
-
-!EOP
-!BOC
-!!-----------------------------------------------------------------------
-!!
-!! local variables
-!!
-!!-----------------------------------------------------------------------
-!
-! integer (int_kind) :: n, iblock
-!
-! character (char_len) :: label
-!
-! integer (int_kind) :: &
-! i,j,k
-!
-! real (r8), dimension(nx_block,ny_block) :: &
-! WORK1, WORK2, &! local work space
-! WORK3, WORK4
-!
-! real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: &
-! WORKA ! local work space with full block dimension
-!
-! real (r8) :: &
-! m2percm2, &
-! gsum
-!
-! type (block) :: this_block ! local block info
-!
-!!-----------------------------------------------------------------------
-!
-!!-----------------------------------------------------------------------
-!!
-!! initialize control buffer
-!!
-!!-----------------------------------------------------------------------
-!
-! errorCode = POP_Success
-!
-!!-----------------------------------------------------------------------
-!!
-!! interpolate onto T-grid points and rotate on T grid
-!!
-!!-----------------------------------------------------------------------
-!
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-!
-! call ugrid_to_tgrid(WORK3,SBUFF_SUM(:,:,iblock,index_o2x_So_u),iblock)
-! call ugrid_to_tgrid(WORK4,SBUFF_SUM(:,:,iblock,index_o2x_So_v),iblock)
-!
-! WORK1 = (WORK3*cos(ANGLET(:,:,iblock))+WORK4*sin(-ANGLET(:,:,iblock))) &
-! * mpercm/tlast_coupled
-! WORK2 = (WORK4*cos(ANGLET(:,:,iblock))-WORK3*sin(-ANGLET(:,:,iblock))) &
-! * mpercm/tlast_coupled
-!
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! o2x_o%rAttr(index_o2x_So_u,n) = WORK1(i,j)
-! o2x_o%rAttr(index_o2x_So_v,n) = WORK2(i,j)
-! enddo
-! enddo
-! enddo
-!
-!!-----------------------------------------------------------------------
-!!
-!! convert and pack surface temperature
-!!
-!!-----------------------------------------------------------------------
-!
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! o2x_o%rAttr(index_o2x_So_t,n) = &
-! SBUFF_SUM(i,j,iblock,index_o2x_So_t)/tlast_coupled + T0_Kelvin
-! enddo
-! enddo
-! enddo
-!
-!!-----------------------------------------------------------------------
-!!
-!! convert and pack salinity
-!!
-!!-----------------------------------------------------------------------
-!
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! o2x_o%rAttr(index_o2x_So_s,n) = &
-! SBUFF_SUM(i,j,iblock,index_o2x_So_s)*salt_to_ppt/tlast_coupled
-! enddo
-! enddo
-! enddo
-!
-!!-----------------------------------------------------------------------
-!!
-!! interpolate onto T-grid points, then rotate on T grid
-!!
-!!-----------------------------------------------------------------------
-!
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-! call ugrid_to_tgrid(WORK3,SBUFF_SUM(:,:,iblock,index_o2x_So_dhdx),iblock)
-! call ugrid_to_tgrid(WORK4,SBUFF_SUM(:,:,iblock,index_o2x_So_dhdy),iblock)
-!
-! WORK1 = (WORK3*cos(ANGLET(:,:,iblock)) + WORK4*sin(-ANGLET(:,:,iblock))) &
-! /grav/tlast_coupled
-! WORK2 = (WORK4*cos(ANGLET(:,:,iblock)) - WORK3*sin(-ANGLET(:,:,iblock))) &
-! /grav/tlast_coupled
-!
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! o2x_o%rAttr(index_o2x_So_dhdx,n) = WORK1(i,j)
-! o2x_o%rAttr(index_o2x_So_dhdy,n) = WORK2(i,j)
-! enddo
-! enddo
-! enddo
-!
-!!-----------------------------------------------------------------------
-!!
-!! pack heat flux due to freezing/melting (W/m^2)
-!! QFLUX computation and units conversion occurs in ice.F
-!!
-!!-----------------------------------------------------------------------
-!
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! o2x_o%rAttr(index_o2x_Fioo_q,n) = QFLUX(i,j,iblock)
-! enddo
-! enddo
-! enddo
-!
-! tlast_ice = c0
-! AQICE = c0
-! QICE = c0
-!
-!!-----------------------------------------------------------------------
-!!
-!! pack co2 flux, if requested (kg CO2/m^2/s)
-!! units conversion occurs where co2 flux is computed
-!!
-!!-----------------------------------------------------------------------
-!
-! if (index_o2x_Faoo_fco2_ocn > 0) then
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! o2x_o%rAttr(index_o2x_Faoo_fco2_ocn,n) = &
-! SBUFF_SUM(i,j,iblock,index_o2x_Faoo_fco2_ocn)/tlast_coupled
-! enddo
-! enddo
-! enddo
-! endif
-!
-!!-----------------------------------------------------------------------
-!!
-!! diagnostics
-!!
-!!-----------------------------------------------------------------------
-!
-! if (ldiag_cpl) then
-! call ccsm_char_date_and_time
-!!DEBUG write(message,'(6a,1x,5a)')' Global averages of fluxes sent to cpl at ', &
-!!DEBUG cyear,'/',cmonth, '/',cday, chour,':',cminute,':',csecond
-!!DEBUG call document ('pop_send_to_coupler', message)
-! write(stdout,*)'pop_send_to_coupler'
-!
-! m2percm2 = mpercm*mpercm
-! do k = 1,nsend
-! n = 0
-! do iblock = 1, nblocks_clinic
-! this_block = get_block(blocks_clinic(iblock),iblock)
-! do j=this_block%jb,this_block%je
-! do i=this_block%ib,this_block%ie
-! n = n + 1
-! WORKA(i,j,iblock) = o2x_o%rAttr(k,n)
-! enddo
-! enddo
-! enddo
-!
-! call POP_HaloUpdate(WORKA,POP_haloClinic, &
-! POP_gridHorzLocCenter, &
-! POP_fieldKindScalar, errorCode, &
-! fillValue = 0.0_POP_r8)
-!
-! if (errorCode /= POP_Success) then
-! call POP_ErrorSet(errorCode, &
-! 'ocn_export_mct: error updating halo for state')
-! return
-! endif
-!
-! gsum = global_sum_prod(WORKA , TAREA, distrb_clinic, &
-! field_loc_center, RCALCT)*m2percm2
-! if (my_task == master_task) then
-! call seq_flds_getField(label,k,seq_flds_o2x_fields)
-! write(stdout,1100)'ocn','send', label ,gsum
-! endif
-! enddo ! k
-! if (my_task == master_task) call shr_sys_flush(stdout)
-! endif
-!
-!1100 format ('comm_diag ', a3, 1x, a4, 1x, a8, 1x, es26.19:, 1x, a6)
-!
-! tlast_coupled = c0
-
-!-----------------------------------------------------------------------
-!EOC
-
- end subroutine ocn_export_mct!}}}
-
-!***********************************************************************
-
-!BOP
-! !IROUTINE: pop_sum_buffer
-! !INTERFACE:
-
- subroutine pop_sum_buffer!{{{
-
-! !DESCRIPTION:
-! This routine accumulates sums for averaging fields to
-! be sent to the coupler
-!
-! !REVISION HISTORY:
-! same as module
-!
-!EOP
-!BOC
-
-!#ifdef CCSMCOUPLED
-!!-----------------------------------------------------------------------
-!!
-!! local variables
-!!
-!!-----------------------------------------------------------------------
-!
-! real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: &
-! WORK ! local work arrays
-!
-! real (r8) :: &
-! delt, & ! time interval since last step
-! delt_last ! time interval for previous step
-!
-! integer (int_kind) :: &
-! iblock, & ! block index
-! sflux_co2_nf_ind = 0! named field index of fco2
-!
-! logical (log_kind) :: &
-! first = .true. ! only true for first call
-!
-! save first
-!
-!!-----------------------------------------------------------------------
-!!
-!! zero buffer if this is the first time after a coupling interval
-!!
-!!-----------------------------------------------------------------------
-!
-! if (tlast_coupled == c0) SBUFF_SUM = c0
-! WORK = c0
-!
-!!-----------------------------------------------------------------------
-!!
-!! update time since last coupling
-!!
-!!-----------------------------------------------------------------------
-!
-! if (avg_ts .or. back_to_back) then
-! delt = p5*dtt
-! else
-! delt = dtt
-! endif
-! tlast_coupled = tlast_coupled + delt
-!
-!!-----------------------------------------------------------------------
-!!
-!! allow for fco2 field to not be registered on first call
-!! because init_forcing is called before init_passive_tracers
-!! use weight from previous timestep because flux used here is that
-!! computed during the previous timestep
-!!
-!!-----------------------------------------------------------------------
-!
-! if (index_o2x_Faoo_fco2_ocn > 0) then
-! if (sflux_co2_nf_ind == 0) then
-! call named_field_get_index('SFLUX_CO2', sflux_co2_nf_ind, &
-! exit_on_err=.not. first)
-! endif
-!
-! if (avg_ts .or. back_to_back) then
-! delt_last = p5*dtt
-! else
-! delt_last = dtt
-! endif
-! endif
-!
-!!-----------------------------------------------------------------------
-!!
-!! accumulate sums of U,V,T,S and GRADP
-!! accumulate sum of co2 flux, if requested
-!! implicitly use zero flux if fco2 field not registered yet
-!! ice formation flux is handled separately in ice routine
-!!
-!!-----------------------------------------------------------------------
-!
-! !$OMP PARALLEL DO PRIVATE(iblock)
-! do iblock = 1, nblocks_clinic
-! SBUFF_SUM(:,:,iblock,index_o2x_So_u) = &
-! SBUFF_SUM(:,:,iblock,index_o2x_So_u) + delt* &
-! UVEL(:,:,1,curtime,iblock)
-!
-! SBUFF_SUM(:,:,iblock,index_o2x_So_v) = &
-! SBUFF_SUM(:,:,iblock,index_o2x_So_v) + delt* &
-! VVEL(:,:,1,curtime,iblock)
-!
-! SBUFF_SUM(:,:,iblock,index_o2x_So_t ) = &
-! SBUFF_SUM(:,:,iblock,index_o2x_So_t ) + delt* &
-! TRACER(:,:,1,1,curtime,iblock)
-!
-! SBUFF_SUM(:,:,iblock,index_o2x_So_s ) = &
-! SBUFF_SUM(:,:,iblock,index_o2x_So_s ) + delt* &
-! TRACER(:,:,1,2,curtime,iblock)
-!
-! SBUFF_SUM(:,:,iblock,index_o2x_So_dhdx) = &
-! SBUFF_SUM(:,:,iblock,index_o2x_So_dhdx) + delt* &
-! GRADPX(:,:,curtime,iblock)
-!
-! SBUFF_SUM(:,:,iblock,index_o2x_So_dhdy) = &
-! SBUFF_SUM(:,:,iblock,index_o2x_So_dhdy) + delt* &
-! GRADPY(:,:,curtime,iblock)
-!
-! if (index_o2x_Faoo_fco2_ocn > 0 .and. sflux_co2_nf_ind > 0) then
-! call named_field_get(sflux_co2_nf_ind, iblock, WORK(:,:,iblock))
-! SBUFF_SUM(:,:,iblock,index_o2x_Faoo_fco2_ocn) = &
-! SBUFF_SUM(:,:,iblock,index_o2x_Faoo_fco2_ocn) + delt_last*WORK(:,:,iblock)
-! endif
-!
-! enddo
-! !$OMP END PARALLEL DO
-!
-! first = .false.
-!
-!#endif
-!
-!-----------------------------------------------------------------------
-!EOC
-
- end subroutine pop_sum_buffer!}}}
-
-!***********************************************************************
-
-end module ocn_comp_mct
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Copied: branches/atmos_physics/src/ocean_cesm_driver/ocn_comp_mct.F (from rev 2666, trunk/mpas/src/ocean_cesm_driver/ocn_comp_mct.F)
===================================================================
--- branches/atmos_physics/src/ocean_cesm_driver/ocn_comp_mct.F (rev 0)
+++ branches/atmos_physics/src/ocean_cesm_driver/ocn_comp_mct.F 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,1633 @@
+module ocn_comp_mct
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!BOP
+! !MODULE: ocn_comp_mct
+! !INTERFACE:
+
+! !DESCRIPTION:
+! This is the main driver for the Model for Predication Across Scales Ocean Model (MPAS-O).
+!
+! !REVISION HISTORY:
+! SVN:$Id:
+!
+! !USES:
+ use mct_mod
+ use esmf
+ use seq_flds_mod
+ use seq_cdata_mod
+ use seq_infodata_mod
+ use seq_timemgr_mod
+ use seq_comm_mct, only : seq_comm_suffix, seq_comm_inst, seq_comm_name
+ use shr_file_mod
+ use shr_cal_mod, only : shr_cal_date2ymd
+ use shr_sys_mod
+ use shr_pio_mod
+ use perf_mod
+ use ocn_communicator, only: mpi_communicator_ocn
+
+ use mpaso_cpl_indices
+ use mpaso_mct_vars
+
+ use mpas_framework
+ use mpas_core
+ use mpas_kind_types
+
+!
+! !PUBLIC MEMBER FUNCTIONS:
+ implicit none
+ public :: ocn_init_mct
+ public :: ocn_run_mct
+ public :: ocn_final_mct
+ SAVE
+ private ! By default make data private
+
+!
+! ! PUBLIC DATA:
+!
+! !REVISION HISTORY:
+! Author: Mariana Vertenstein
+!
+!EOP
+! !PRIVATE MODULE FUNCTIONS:
+ private :: ocn_export_mct
+ private :: ocn_import_mct
+ private :: ocn_SetGSMap_mct
+ private :: ocn_domain_mct
+!
+! !PRIVATE MODULE VARIABLES
+
+ logical :: ldiag_cpl = .false.
+
+ integer, private :: &
+ cpl_write_restart, &! flag id for write restart
+ cpl_write_history, &! flag id for write history
+ cpl_write_tavg, &! flag id for write tavg
+ cpl_diag_global, &! flag id for computing diagnostics
+ cpl_diag_transp, &! flag id for computing diagnostics
+ my_task
+
+ real (kind=RKIND), dimension(:,:,:,:), allocatable :: SBUFF_SUM ! accumulated sum of send buffer quantities
+ ! for averaging before being sent
+ real (kind=RKIND) :: tlast_coupled
+
+ integer :: nsend, nrecv
+
+ character(len=StrKIND) :: runtype
+
+ type(seq_infodata_type), pointer :: infodata
+ type (iosystem_desc_t), pointer :: io_system
+
+ !! MPAS-O Datatypes
+ type (dm_info), pointer :: dminfo
+ type (domain_type), pointer :: domain
+ type (io_output_object), save :: output_obj
+ integer :: output_frame
+! type (MPAS_Clock_type) :: clock
+
+!=======================================================================
+
+contains
+
+!***********************************************************************
+!BOP
+!
+! !IROUTINE: ocn_init_mct
+!
+! !INTERFACE:
+ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{
+!
+! !DESCRIPTION:
+! Initialize POP
+!
+! !INPUT/OUTPUT PARAMETERS:
+
+ type(ESMF_Clock), intent(in) :: EClock
+ type(seq_cdata), intent(inout) :: cdata_o
+ type(mct_aVect), intent(inout) :: x2o_o, o2x_o
+ character(len=*), optional, intent(in) :: NLFilename ! Namelist filename
+!
+! !REVISION HISTORY:
+! Author: Mariana Vertenstein
+!EOP
+!-----------------------------------------------------------------------
+!
+! local variables
+!
+!-----------------------------------------------------------------------
+
+ integer :: OCNID, mpicom_o, lsize, start_ymd, start_tod, start_year, start_day, &
+ start_month, start_hour, iyear, ocn_cpl_dt, mpas_o_cpl_dt, shrlogunit, shrloglev
+
+ type(mct_gsMap), pointer :: gsMap_o
+
+ type(mct_gGrid), pointer :: dom_o
+
+ integer :: errorCode ! error code
+
+ integer :: nThreads
+
+ real (kind=RKIND) :: precadj
+
+ type (MPAS_Time_Type) :: currTime
+ integer :: iam,ierr
+ integer :: iyear0, imonth0
+ character(len=StrKIND) :: starttype ! infodata start type
+ character(len=StrKIND) :: timeStamp
+ character(len=StrKIND) :: nml_filename
+
+ integer :: lbnum
+
+!-----------------------------------------------------------------------
+!
+! set cdata pointers
+!
+!-----------------------------------------------------------------------
+
+ errorCode = 0
+
+ call seq_cdata_setptrs(cdata_o, ID=OCNID, mpicom=mpicom_o, &
+ gsMap=gsMap_o, dom=dom_o, infodata=infodata)
+
+ MPASO_MCT_OCNID = OCNID
+ MPASO_MCT_gsMap_o => gsMap_o
+ MPASO_MCT_dom_o => dom_o
+
+#if (defined _MEMTRACE)
+ call MPI_comm_rank(mpicom_o,iam,ierr)
+ if(iam == 0) then
+ lbnum=1
+ call memmon_dump_fort('memmon.out','ocn_init_mct:start::',lbnum)
+ endif
+#endif
+
+
+ ! The following communicator module variable will be utilized in init_communicate that
+ ! is called by initial - this is done to make the code backwards compatible
+
+ mpi_communicator_ocn = mpicom_o
+
+!-----------------------------------------------------------------------
+!
+! initialize the model run
+!
+!-----------------------------------------------------------------------
+
+ call mpaso_cpl_indices_set()
+
+! call seq_infodata_GetData( infodata, case_name=runid )
+ call seq_infodata_GetData( infodata, start_type=starttype)
+
+
+ if ( trim(starttype) == trim(seq_infodata_start_type_start)) then
+ runtype = "initial"
+ else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then
+ runtype = "continue"
+ else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then
+ runtype = "branch"
+ else
+ call mpas_dmpar_global_abort(' ocn_comp_mct ERROR: unknown starttype')
+ end if
+
+!-----------------------------------------------------------------------
+!
+! first initializaiton phase of mpas-o
+! initialize mpas-o because grid information is needed for
+! creation of GSMap_ocn.
+! call mpas-o initialization routines
+!
+!-----------------------------------------------------------------------
+
+! inst_name = seq_comm_name(OCNID)
+! inst_index = seq_comm_inst(OCNID)
+! inst_suffix = seq_comm_suffix(OCNID)
+
+ call t_startf('mpas-o_init')
+ nml_filename = "mpaso.in"
+
+ io_system => shr_pio_getiosys(ocnid)
+
+ call mpas_framework_init(dminfo, domain, mpi_communicator_ocn, nml_filename, io_system)
+
+ my_task = dminfo % my_proc_id
+ call mpas_timer_start("total time")
+
+ call mpas_input_state_for_domain(domain)
+
+ call mpas_core_init(domain, timeStamp)
+
+!-----------------------------------------------------------------------
+!
+! initialize time-stamp information
+!
+!-----------------------------------------------------------------------
+
+ call t_stopf ('mpas-o_init')
+
+!----------------------------------------------------------------------------
+!
+! reset shr logging to my log file
+!
+!----------------------------------------------------------------------------
+
+ call shr_file_getLogUnit (shrlogunit)
+ call shr_file_getLogLevel(shrloglev)
+! call shr_file_setLogUnit (stdout)
+
+!-----------------------------------------------------------------------
+!
+! check for consistency of mpas-o and sync clock initial time
+!
+!-----------------------------------------------------------------------
+
+ if (runtype == 'initial') then
+ currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+ call mpas_get_time(curr_time=currTime, YYYY=iyear0, MM=imonth0, ierr=ierr)
+ call seq_timemgr_EClockGetData(EClock, start_ymd=start_ymd, start_tod=start_tod)
+ call shr_cal_date2ymd(start_ymd,start_year,start_month,start_day)
+
+ if (iyear0 /= start_year) then
+ call mpas_dmpar_global_abort(' iyear0 does not match start_year')
+ end if
+ if (imonth0 /= start_month) then
+ call mpas_dmpar_global_abort(' imonth0 does not match start_year')
+ end if
+ end if
+
+!-----------------------------------------------------------------------
+!
+! initialize MCT attribute vectors and indices
+!
+!-----------------------------------------------------------------------
+
+ call t_startf ('mpas-o_mct_init')
+
+ call ocn_SetGSMap_mct( mpicom_o, OCNID, GSMap_o )
+ lsize = mct_gsMap_lsize(gsMap_o, mpicom_o)
+
+ ! Initialize mct ocn domain (needs ocn initialization info)
+
+ call ocn_domain_mct( lsize, gsMap_o, dom_o )
+
+ ! Inialize mct attribute vectors
+
+ call mct_aVect_init(x2o_o, rList=seq_flds_x2o_fields, lsize=lsize)
+ call mct_aVect_zero(x2o_o)
+
+ call mct_aVect_init(o2x_o, rList=seq_flds_o2x_fields, lsize=lsize)
+ call mct_aVect_zero(o2x_o)
+
+ nsend = mct_avect_nRattr(o2x_o)
+ nrecv = mct_avect_nRattr(x2o_o)
+
+!-----------------------------------------------------------------------
+!
+! initialize necessary coupling info
+!
+!-----------------------------------------------------------------------
+
+ call seq_timemgr_EClockGetData(EClock, dtime=ocn_cpl_dt)
+ mpas_o_cpl_dt = 86400 / config_ncouple_per_day
+ if (mpas_o_cpl_dt /= ocn_cpl_dt) then
+ write(0,*)'mpas-o_cpl_dt= ',mpas_o_cpl_dt, &
+ ' ocn_cpl_dt= ',ocn_cpl_dt
+ call mpas_dmpar_global_abort('ERROR mpas-o_cpl_dt and ocn_cpl_dt must be identical')
+ end if
+
+!-----------------------------------------------------------------------
+!
+! send intial state to driver
+!
+!-----------------------------------------------------------------------
+
+! if ( lsend_precip_fact ) then
+! precadj = precip_fact * 1.0e6_r8
+! call seq_infodata_PutData( infodata, precip_fact=precadj)
+! end if
+
+ call ocn_export_mct(o2x_o, errorCode)
+ if (errorCode /= 0) then
+ call mpas_dmpar_global_abort('ERROR in ocn_export_mct')
+ endif
+
+ call t_stopf ('mpas-o_mct_init')
+
+! call seq_infodata_PutData( infodata, ocn_nx = nx_global , ocn_ny = ny_global)
+ call seq_infodata_PutData( infodata, ocn_prognostic=.true., ocnrof_prognostic=.true.)
+
+!----------------------------------------------------------------------------
+!
+! Reset shr logging to original values
+!
+!----------------------------------------------------------------------------
+
+ call shr_file_setLogUnit (shrlogunit)
+ call shr_file_setLogLevel(shrloglev)
+
+#if (defined _MEMTRACE)
+ if(iam == 0) then
+ lbnum=1
+ call memmon_dump_fort('memmon.out','ocn_init_mct:end::',lbnum)
+ call memmon_reset_addr()
+ endif
+#endif
+
+!-----------------------------------------------------------------------
+!
+! output delimiter to log file
+!
+!-----------------------------------------------------------------------
+
+ !DWJ IO Units
+! if (my_task == master_task) then
+! write(stdout,blank_fmt)
+! write(stdout,'(" End of initialization")')
+! write(stdout,blank_fmt)
+! write(stdout,ndelim_fmt)
+! call POP_IOUnitsFlush(POP_stdout)
+#ifdef CCSMCOUPLED
+! call POP_IOUnitsFlush(stdout)
+#endif
+! endif
+
+ !
+ ! Set up output streams to be written to by the MPAS core
+ !
+ output_frame = 1
+
+ if(config_frames_per_outfile > 0) then
+ call mpas_output_state_init(output_obj, domain, "OUTPUT", trim(timeStamp))
+ else
+ call mpas_output_state_init(output_obj, domain, "OUTPUT")
+ end if
+
+!-----------------------------------------------------------------------
+!EOC
+
+ end subroutine ocn_init_mct!}}}
+
+!***********************************************************************
+!BOP
+!
+! !IROUTINE: ocn_run_mct
+!
+! !INTERFACE:
+ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{
+
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_io_output
+ use mpas_timer
+
+ implicit none
+!
+! !DESCRIPTION:
+! Run POP for a coupling interval
+!
+! !INPUT/OUTPUT PARAMETERS:
+ type(ESMF_Clock) , intent(in) :: EClock
+ type(seq_cdata) , intent(inout) :: cdata_o
+ type(mct_aVect) , intent(inout) :: x2o_o
+ type(mct_aVect) , intent(inout) :: o2x_o
+
+!!
+!! !REVISION HISTORY:
+!! Author: Mariana Vertenstein
+!!EOP
+!!-----------------------------------------------------------------------
+!!
+!! local variables
+!!
+!!-----------------------------------------------------------------------
+!
+! integer :: errorCode ! error flag
+!
+! integer :: itimestep
+!
+! integer :: &
+! ymd, & ! POP2 current date (YYYYMMDD)
+! tod, & ! POP2 current time of day (sec)
+! ymd_sync, & ! Sync clock current date (YYYYMMDD)
+! tod_sync, & ! Sync clcok current time of day (sec)
+! shrlogunit, & ! old values
+! shrloglev ! old values
+!
+! character(len=char_len_long) :: &
+! fname
+!
+! type(seq_infodata_type), pointer :: &
+! infodata ! Input init object
+!
+! real (kind=RKIND) :: &
+! precadj
+!
+! logical :: &
+! lcoupled, & ! temporary
+! rstwr, & ! true => write restart at end of day
+! first_time = .true.
+!
+! character (char_len) :: message
+!
+! integer(int_kind) :: info_debug
+!
+! integer :: lbnum
+
+ integer :: itimestep
+ real (kind=RKIND) :: dt
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Time_Type) :: currTime
+ character(len=StrKIND) :: timeStamp
+ integer :: ierr
+
+ ! Eventually, dt should be domain specific
+ dt = config_dt
+
+ currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+ call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
+ write(0,*) 'Initial time ', trim(timeStamp)
+
+ call ocn_write_output_frame(output_obj, output_frame, domain)
+ block_ptr => domain % blocklist
+
+ do while(associated(block_ptr))
+ call ocn_time_average_init(block_ptr % state % time_levs(1) % state)
+ block_ptr => block_ptr % next
+ end do
+
+ ! During integration, time level 1 stores the model state at the beginning of the
+ ! time step, and time level 2 stores the state advanced dt in time by timestep(...)
+ itimestep = 0
+ do while (.not. mpas_is_clock_stop_time(clock))
+
+ itimestep = itimestep + 1
+ call mpas_advance_clock(clock)
+
+ currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+ call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
+ write(0,*) 'Doing timestep ', trim(timeStamp)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call ocn_build_forcing_arrays(currTime, block_ptr % mesh, ierr)
+ block_ptr => block_ptr % next
+ end do
+
+ call mpas_timer_start("time integration", .false., timeIntTimer)
+ call mpas_timestep(domain, itimestep, dt, timeStamp)
+ call mpas_timer_stop("time integration", timeIntTimer)
+
+ ! Move time level 2 fields back into time level 1 for next time step
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_shift_time_levels_state(block_ptr % state)
+ block_ptr => block_ptr % next
+ end do
+
+ if (mpas_is_alarm_ringing(clock, outputAlarmID, ierr=ierr)) then
+ call mpas_reset_clock_alarm(clock, outputAlarmID, ierr=ierr)
+ ! output_frame will always be > 1 here unless it was reset after the maximum number of frames per outfile was reached
+ if(output_frame == 1) then
+ call mpas_output_state_finalize(output_obj, domain % dminfo)
+ call mpas_output_state_init(output_obj, domain, "OUTPUT", trim(timeStamp))
+ end if
+
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call ocn_time_average_normalize(block_ptr % state % time_levs(1) % state)
+ block_ptr => block_ptr % next
+ end do
+
+ call ocn_write_output_frame(output_obj, output_frame, domain)
+
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call ocn_time_average_init(block_ptr % state % time_levs(1) % state)
+ block_ptr => block_ptr % next
+ end do
+ end if
+
+ if (mpas_is_alarm_ringing(clock, restartAlarmID, ierr=ierr)) then
+ call mpas_reset_clock_alarm(clock, restartAlarmID, ierr=ierr)
+
+ ! Write one restart time per file
+ call mpas_output_state_init(restart_obj, domain, "RESTART", trim(timeStamp))
+ call mpas_output_state_for_domain(restart_obj, domain, 1)
+ call mpas_output_state_finalize(restart_obj, domain % dminfo)
+ end if
+
+ end do
+!
+!#if (defined _MEMTRACE)
+! if(my_task == 0 ) then
+! lbnum=1
+! call memmon_dump_fort('memmon.out',SubName//':start::',lbnum)
+! endif
+!#endif
+!
+!!-----------------------------------------------------------------------
+!!
+!! start up the main timer
+!!
+!!-----------------------------------------------------------------------
+!
+! call mpas_timer_start('total time')
+!
+!
+!!-----------------------------------------------------------------------
+!!
+!! reset shr logging to my log file
+!!
+!!----------------------------------------------------------------------------
+!
+! errorCode = POP_Success
+!
+! call shr_file_getLogUnit (shrlogunit)
+! call shr_file_getLogLevel(shrloglev)
+! call shr_file_setLogUnit (stdout)
+!
+! call seq_cdata_setptrs(cdata_o, infodata=infodata)
+!
+!!----------------------------------------------------------------------------
+!!
+!! restart flag (rstwr) will assume only an eod restart for now
+!!
+!!----------------------------------------------------------------------------
+!
+! call seq_infodata_GetData( infodata, info_debug=info_debug)
+! if (info_debug >= 2) then
+! ldiag_cpl = .true.
+! else
+! ldiag_cpl = .false.
+! endif
+!
+! rstwr = seq_timemgr_RestartAlarmIsOn(EClock)
+!
+!!-----------------------------------------------------------------------
+!!
+!! advance the model in time over coupling interval
+!! write restart dumps and archiving
+!!
+!!-----------------------------------------------------------------------
+!
+! ! Note that all ocean time flags are evaluated each timestep in time_manager
+! ! ocn_import_mct is analogous to pop_unpack_fluxes_from_coupler in cpl6
+! ! ocn_export_mct is analogous to prepare_send_to_coupler in cpl6
+! ! tlast_coupled is set to zero at the end of ocn_export_mct
+!
+! itimestep = 0
+! timestep: do
+! ! obtain import state from driver
+! if (check_time_flag(cpl_ts) .or. nsteps_run == 0) then
+! call ocn_import_mct(x2o_o, errorCode)
+!
+! if (errorCode /= POP_Success) then
+! call POP_ErrorPrint(errorCode)
+! call exit_POP(sigAbort, 'ERROR in step')
+! endif
+!
+! !DWJ Need to write on mpas side
+!! call pop_set_coupled_forcing
+! end if
+!
+!
+! end do timestep
+!
+! advance: do
+!
+! call step(errorCode)
+!
+! if (errorCode /= POP_Success) then
+! call POP_ErrorPrint(errorCode)
+! call exit_POP(sigAbort, 'ERROR in step')
+! endif
+!
+! if (check_KE(100.0_r8)) then
+! !*** exit if energy is blowing
+! call output_driver
+! call exit_POP(sigAbort,'ERROR: k.e. > 100 ')
+! endif
+! call output_driver
+!
+! ! return export state to driver
+! call pop_sum_buffer()
+! if (check_time_flag(cpl_ts)) then
+! call ocn_export_mct(o2x_o, errorCode)
+! if (errorCode /= POP_Success) then
+! call POP_ErrorPrint(errorCode)
+! call exit_POP(sigAbort, 'ERROR in ocn_export_mct')
+! endif
+!
+! exit advance
+! end if
+!
+! enddo advance
+!
+! if ( lsend_precip_fact ) then
+! precadj = precip_fact * 1.0e6_r8
+! call seq_infodata_PutData( infodata, precip_fact=precadj )
+! end if
+!
+!!--------------------------------------------------------------------
+!!
+!! check that internal clock is in sync with master clock
+!!
+!!--------------------------------------------------------------------
+!
+! ymd = iyear*10000 + imonth*100 + iday
+! tod = ihour*seconds_in_hour + iminute*seconds_in_minute + isecond
+! if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then
+! call seq_timemgr_EClockGetData( EClock, curr_ymd=ymd_sync, &
+! curr_tod=tod_sync )
+! write(stdout,*)' pop2 ymd=',ymd ,' pop2 tod= ',tod
+! write(stdout,*)' sync ymd=',ymd_sync,' sync tod= ',tod_sync
+! write(stdout,*)' Internal pop2 clock not in sync with Sync Clock'
+! call shr_sys_abort( SubName// &
+! ":: Internal pop2 clock not in sync with Sync Clock")
+! end if
+!
+!!----------------------------------------------------------------------------
+!!
+!! Reset shr logging to original values
+!!
+!!----------------------------------------------------------------------------
+!
+! call shr_file_setLogUnit (shrlogunit)
+! call shr_file_setLogLevel(shrloglev)
+!
+! call mpas_timer_stop('total time')
+!
+!#if (defined _MEMTRACE)
+! if(my_task == 0) then
+! lbnum=1
+! call memmon_dump_fort('memmon.out',SubName//':end::',lbnum)
+! call memmon_reset_addr()
+! endif
+!#endif
+!-----------------------------------------------------------------------
+!EOC
+
+ end subroutine ocn_run_mct!}}}
+
+!***********************************************************************
+!BOP
+!
+! !IROUTINE: ocn_final_mct
+!
+! !INTERFACE:
+ subroutine ocn_final_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{
+!
+! !DESCRIPTION:
+! Finalize POP
+!
+! !USES:
+! !ARGUMENTS:
+ type(ESMF_Clock) , intent(in) :: EClock
+ type(seq_cdata) , intent(inout) :: cdata_o
+ type(mct_aVect) , intent(inout) :: x2o_o
+ type(mct_aVect) , intent(inout) :: o2x_o
+!
+! !REVISION HISTORY:
+! Author: Fei Liu
+!EOP
+!BOC
+!-----------------------------------------------------------------------
+!
+! local variables
+!
+!-----------------------------------------------------------------------
+
+ integer :: &
+ errorCode ! error code
+
+!-----------------------------------------------------------------------
+
+
+
+ call mpas_output_state_finalize(output_obj, domain % dminfo)
+ call mpas_timer_stop("total time")
+ call mpas_timer_write()
+ write(0,*) 'core finalize'
+ call mpas_core_finalize(domain)
+ write(0,*) 'framework finalize'
+ call mpas_framework_finalize(dminfo, domain, io_system)
+ write(0,*) 'done in final mct'
+
+ end subroutine ocn_final_mct!}}}
+
+!***********************************************************************
+!BOP
+!IROUTINE: ocn_SetGSMap_mct
+! !INTERFACE:
+
+ subroutine ocn_SetGSMap_mct( mpicom_ocn, OCNID, gsMap_ocn )!{{{
+
+ use mpas_dmpar
+
+! !DESCRIPTION:
+! This routine mct global seg maps for the pop decomposition
+!
+! !REVISION HISTORY:
+! same as module
+
+! !INPUT/OUTPUT PARAMETERS:
+
+ implicit none
+ integer , intent(in) :: mpicom_ocn
+ integer , intent(in) :: OCNID
+ type(mct_gsMap), intent(inout) :: gsMap_ocn
+
+!EOP
+!BOC
+!-----------------------------------------------------------------------
+!
+! local variables
+!
+!-----------------------------------------------------------------------
+
+ integer,allocatable :: &
+ gindex(:)
+
+ integer :: &
+ i,j, k, n, iblock, &
+ lsize, gsize, &
+ ier
+
+ type (block_type), pointer :: block_ptr
+
+!-----------------------------------------------------------------------
+! Build the POP grid numbering for MCT
+! NOTE: Numbering scheme is: West to East and South to North starting
+! at the south pole. Should be the same as what's used in SCRIP
+!-----------------------------------------------------------------------
+
+ n = 0
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ n = n + block_ptr % mesh % nCellsSolve
+ block_ptr => block_ptr % next
+ end do
+
+ lsize = n
+ call mpas_dmpar_sum_int(dminfo, lsize, gsize)
+ allocate(gindex(lsize),stat=ier)
+
+ n = 0
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ do i = 1, block_ptr % mesh % nCellsSolve
+ n = n + 1
+ gindex(n) = block_ptr % mesh % indexToCellID % array(i)
+ end do
+ block_ptr => block_ptr % next
+ end do
+
+ call mct_gsMap_init( gsMap_ocn, gindex, mpicom_ocn, OCNID, lsize, gsize )
+
+ deallocate(gindex)
+
+!-----------------------------------------------------------------------
+!EOC
+
+ end subroutine ocn_SetGSMap_mct!}}}
+
+!***********************************************************************
+!BOP
+! !IROUTINE: ocn_domain_mct
+! !INTERFACE:
+
+ subroutine ocn_domain_mct( lsize, gsMap_o, dom_o )!{{{
+
+! !DESCRIPTION:
+! This routine mct global seg maps for the pop decomposition
+!
+! !REVISION HISTORY:
+! same as module
+!
+! !INPUT/OUTPUT PARAMETERS:
+
+ implicit none
+ integer , intent(in) :: lsize
+ type(mct_gsMap), intent(in) :: gsMap_o
+ type(mct_ggrid), intent(inout) :: dom_o
+
+!EOP
+!BOC
+!-----------------------------------------------------------------------
+!
+! local variables
+!
+!-----------------------------------------------------------------------
+
+ integer, pointer :: idata(:)
+
+ real(kind=RKIND), pointer :: data(:)
+ real(kind=RKIND) :: r2d
+
+ integer :: i,j, k, n, ier
+
+ type (block_type), pointer :: block_ptr
+
+ r2d = 180.0/pii
+
+!-------------------------------------------------------------------
+!
+! initialize mct domain type, lat/lon in degrees,
+! area in radians^2, mask is 1 (ocean), 0 (non-ocean)
+!
+!-------------------------------------------------------------------
+
+ call mct_gGrid_init( GGrid=dom_o, CoordChars=trim(seq_flds_dom_coord), &
+ OtherChars=trim(seq_flds_dom_other), lsize=lsize )
+ call mct_aVect_zero(dom_o%data)
+ allocate(data(lsize))
+
+!-------------------------------------------------------------------
+!
+! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT
+!
+!-------------------------------------------------------------------
+
+ call mct_gsMap_orderedPoints(gsMap_o, my_task, idata)
+ call mct_gGrid_importIAttr(dom_o,'GlobGridNum',idata,lsize)
+
+!-------------------------------------------------------------------
+!
+! Determine domain (numbering scheme is: West to East and South to North to South pole)
+! Initialize attribute vector with special value
+!
+!-------------------------------------------------------------------
+
+ data(:) = -9999.0_R8
+ call mct_gGrid_importRAttr(dom_o,"lat" ,data,lsize)
+ call mct_gGrid_importRAttr(dom_o,"lon" ,data,lsize)
+ call mct_gGrid_importRAttr(dom_o,"area" ,data,lsize)
+ call mct_gGrid_importRAttr(dom_o,"aream",data,lsize)
+ data(:) = 0.0_R8
+ call mct_gGrid_importRAttr(dom_o,"mask",data,lsize)
+ call mct_gGrid_importRAttr(dom_o,"frac",data,lsize)
+
+!-------------------------------------------------------------------
+!
+! Fill in correct values for domain components
+!
+!-------------------------------------------------------------------
+
+ n = 0
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ do i = 1, block_ptr % mesh % nCellsSolve
+ n = n + 1
+ data(n) = block_ptr % mesh % lonCell % array(i) * r2d
+ end do
+
+ block_ptr => block_ptr % next
+ end do
+ call mct_gGrid_importRattr(dom_o,"lon",data,lsize)
+
+ n = 0
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ do i = 1, block_ptr % mesh % nCellsSolve
+ n = n + 1
+ data(n) = block_ptr % mesh % latCell % array(i) * r2d
+ end do
+ block_ptr => block_ptr % next
+ end do
+ call mct_gGrid_importRattr(dom_o,"lat",data,lsize)
+
+ n = 0
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ do i = 1, block_ptr % mesh % nCellsSolve
+ n = n + 1
+ data(n) = block_ptr % mesh % areaCell % array(i) / (block_ptr % mesh % sphere_radius * block_ptr % mesh % sphere_radius)
+ end do
+ block_ptr => block_ptr % next
+ end do
+ call mct_gGrid_importRattr(dom_o,"area",data,lsize)
+
+ data(:) = 1.0_RKIND ! No land cells in MPAS-O, only Ocean cells
+ call mct_gGrid_importRattr(dom_o,"mask",data,lsize)
+ call mct_gGrid_importRattr(dom_o,"frac",data,lsize)
+
+ deallocate(data)
+ deallocate(idata)
+
+!-----------------------------------------------------------------------
+!EOC
+
+ end subroutine ocn_domain_mct!}}}
+
+
+!***********************************************************************
+!BOP
+! !IROUTINE: ocn_import_mct
+! !INTERFACE:
+
+ subroutine ocn_import_mct(x2o_o, errorCode)!{{{
+
+! !DESCRIPTION:
+!-----------------------------------------------------------------------
+! This routine receives message from cpl7 driver
+!
+! The following fields are always received from the coupler:
+!
+! o taux -- zonal wind stress (taux) (W/m2 )
+! o tauy -- meridonal wind stress (tauy) (W/m2 )
+! o snow -- water flux due to snow (kg/m2/s)
+! o rain -- water flux due to rain (kg/m2/s)
+! o evap -- evaporation flux (kg/m2/s)
+! o meltw -- snow melt flux (kg/m2/s)
+! o salt -- salt (kg(salt)/m2/s)
+! o swnet -- net short-wave heat flux (W/m2 )
+! o sen -- sensible heat flux (W/m2 )
+! o lwup -- longwave radiation (up) (W/m2 )
+! o lwdn -- longwave radiation (down) (W/m2 )
+! o melth -- heat flux from snow&ice melt (W/m2 )
+! o ifrac -- ice fraction
+! o roff -- river runoff flux (kg/m2/s)
+! o ioff -- ice runoff flux (kg/m2/s)
+!
+! The following fields are sometimes received from the coupler,
+! depending on model options:
+!
+! o pslv -- sea-level pressure (Pa)
+! o duu10n -- 10m wind speed squared (m^2/s^2)
+! o co2prog-- bottom atm level prognostic co2
+! o co2diag-- bottom atm level diagnostic co2
+!
+!-----------------------------------------------------------------------
+!
+! !REVISION HISTORY:
+! same as module
+
+! !INPUT/OUTPUT PARAMETERS:
+
+ type(mct_aVect) , intent(inout) :: x2o_o
+
+! !OUTPUT PARAMETERS:
+
+ integer, intent(out) :: &
+ errorCode ! returned error code
+
+!EOP
+!BOC
+!-----------------------------------------------------------------------
+!
+! local variables
+!
+!-----------------------------------------------------------------------
+
+! character (len=StrKIND) :: &
+! label, &
+! message
+!
+! integer :: &
+! i,j,k,n,iblock
+!
+! real (kind=RKIND), dimension(nx_block,ny_block) :: &
+! WORKB
+!
+! real (kind=RKIND), dimension(nx_block,ny_block,max_blocks_clinic) :: &
+! WORK1, WORK2 ! local work space
+!
+! real (r8) :: &
+! m2percm2, &
+! gsum
+!
+! type (block) :: this_block ! local block info
+!
+!!-----------------------------------------------------------------------
+!!
+!! zero out padded cells
+!!
+!!-----------------------------------------------------------------------
+!
+! errorCode = POP_Success
+!
+! WORK1 = c0
+! WORK2 = c0
+!
+!!-----------------------------------------------------------------------
+!!
+!! unpack and distribute wind stress, then convert to correct units
+!! and rotate components to local coordinates
+!!
+!!-----------------------------------------------------------------------
+!
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+!
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! WORK1(i,j,iblock) = x2o_o%rAttr(index_x2o_Foxx_taux,n)
+! WORK2(i,j,iblock) = x2o_o%rAttr(index_x2o_Foxx_tauy,n)
+! enddo
+! enddo
+! enddo ! iblock
+!
+! !***
+! !*** do NOT perform halo updates now, because vector updates must
+! !*** be done after the rotation is completed.
+! !***
+!
+!!-----------------------------------------------------------------------
+!!
+!! rotate true zonal/meridional wind stress into local coordinates,
+!! convert to dyne/cm**2, and shift SMFT to U grid
+!!
+!! halo updates are performed in subroutine rotate_wind_stress,
+!! following the rotation
+!!
+!!-----------------------------------------------------------------------
+!
+! call rotate_wind_stress(WORK1, WORK2)
+!
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+!
+!!-----------------------------------------------------------------------
+!!
+!! unpack and distribute fresh water flux and salt flux
+!!
+!! NOTE: if there are code changes associated with changing the names or
+!! the number of fluxes received from the coupler, then subroutine
+!! update_ghost_cells_coupler_fluxes will need to be modified also
+!!
+!!-----------------------------------------------------------------------
+!
+!
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! SNOW_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Faxa_snow,n)
+! WORKB (i,j ) = x2o_o%rAttr(index_x2o_Faxa_rain,n)
+! EVAP_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Foxx_evap,n)
+! MELT_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Fioi_meltw,n)
+! ROFF_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Forr_roff,n)
+! IOFF_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Forr_ioff,n)
+! SALT_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Fioi_salt,n)
+!
+! PREC_F(i,j,iblock) = WORKB(i,j) + SNOW_F(i,j,iblock) ! rain + snow
+!
+! WORKB(i,j ) = x2o_o%rAttr(index_x2o_Foxx_swnet,n)
+! SHF_QSW(i,j,iblock) = WORKB(i,j)* &
+! RCALCT(i,j,iblock)*hflux_factor ! convert from W/m**2
+! SENH_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Foxx_sen,n)
+! LWUP_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Foxx_lwup,n)
+! LWDN_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Faxa_lwdn,n)
+! MELTH_F(i,j,iblock) = x2o_o%rAttr(index_x2o_Fioi_melth,n)
+!
+! WORKB(i,j ) = x2o_o%rAttr(index_x2o_Si_ifrac,n)
+! IFRAC(i,j,iblock) = WORKB(i,j) * RCALCT(i,j,iblock)
+!
+! !*** converting from Pa to dynes/cm**2
+! WORKB(i,j ) = x2o_o%rAttr(index_x2o_Sa_pslv,n)
+! ATM_PRESS(i,j,iblock) = c10 * WORKB(i,j) * RCALCT(i,j,iblock)
+!
+! !*** converting from m**2/s**2 to cm**2/s**2
+! WORKB(i,j ) = x2o_o%rAttr(index_x2o_So_duu10n,n)
+! U10_SQR(i,j,iblock) = cmperm * cmperm * WORKB(i,j) * RCALCT(i,j,iblock)
+!
+! enddo
+! enddo
+!
+! enddo
+!
+!!-----------------------------------------------------------------------
+!!
+!! incoming data quality control
+!!
+!!-----------------------------------------------------------------------
+!#ifdef CCSMCOUPLED
+! if ( any(IOFF_F < c0) ) then
+! call shr_sys_abort ('Error: incoming IOFF_F is negative')
+! endif
+!#endif
+!
+!
+!!-----------------------------------------------------------------------
+!!
+!! update ghost cells for fluxes received from the coupler
+!!
+!!-----------------------------------------------------------------------
+!
+! call update_ghost_cells_coupler_fluxes(errorCode)
+!
+! if (errorCode /= POP_Success) then
+! call POP_ErrorSet(errorCode, &
+! 'ocn_import_mct: error in update_ghost_cells_coupler_fluxes')
+! return
+! endif
+!
+!!-----------------------------------------------------------------------
+!!
+!! unpack atmospheric CO2
+!!
+!!-----------------------------------------------------------------------
+!
+! if (index_x2o_Sa_co2prog > 0) then
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+!
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! WORK1(i,j,iblock) = x2o_o%rAttr(index_x2o_Sa_co2prog,n)
+! enddo
+! enddo
+! enddo
+!
+! call POP_HaloUpdate(WORK1,POP_haloClinic, &
+! POP_gridHorzLocCenter, &
+! POP_fieldKindScalar, errorCode, &
+! fillValue = 0.0_POP_r8)
+!
+! if (errorCode /= POP_Success) then
+! call POP_ErrorSet(errorCode, &
+! 'ocn_import_mct: error updating PROG CO2 halo')
+! return
+! endif
+!
+! call named_field_set(ATM_CO2_PROG_nf_ind, WORK1)
+! endif
+!
+! if (index_x2o_Sa_co2diag > 0) then
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+!
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! WORK1(i,j,iblock) = x2o_o%rAttr(index_x2o_Sa_co2diag,n)
+! enddo
+! enddo
+! enddo
+!
+! call POP_HaloUpdate(WORK1,POP_haloClinic, &
+! POP_gridHorzLocCenter, &
+! POP_fieldKindScalar, errorCode, &
+! fillValue = 0.0_POP_r8)
+!
+! if (errorCode /= POP_Success) then
+! call POP_ErrorSet(errorCode, &
+! 'ocn_import_mct: error updating DIAG CO2 halo')
+! return
+! endif
+!
+! call named_field_set(ATM_CO2_DIAG_nf_ind, WORK1)
+! endif
+!
+!!-----------------------------------------------------------------------
+!!
+!! receive orbital parameters
+!!
+!!-----------------------------------------------------------------------
+!
+! call seq_infodata_GetData(infodata, &
+! orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr)
+!
+!
+!!-----------------------------------------------------------------------
+!!
+!! diagnostics
+!!
+!!-----------------------------------------------------------------------
+!
+! if (ldiag_cpl) then
+!
+! write(message,'(6a,1x,5a)') &
+! ' Global averages of fluxes received from cpl at ', &
+! cyear,'/',cmonth ,'/',cday, chour,':',cminute,':',csecond
+! call document ('pop_recv_from_coupler', trim(message))
+!
+! m2percm2 = mpercm*mpercm
+! do k = 1,nrecv
+!
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+!
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! WORK1(i,j,iblock) = x2o_o%rAttr(k,n) ! mult. by TAREA in global_sum_prod
+! enddo
+! enddo
+! enddo
+!
+! gsum = global_sum_prod(WORK1 , TAREA, distrb_clinic, &
+! field_loc_center, RCALCT)*m2percm2
+! if (my_task == master_task) then
+! call seq_flds_getField(label,k,seq_flds_x2o_fields)
+! write(stdout,1100)'ocn','recv', label ,gsum
+! call shr_sys_flush(stdout)
+! endif
+! enddo
+! endif
+!
+!
+!1100 format ('comm_diag ', a3, 1x, a4, 1x, a8, 1x, es26.19:, 1x, a6)
+
+!-----------------------------------------------------------------------
+!EOC
+
+ end subroutine ocn_import_mct!}}}
+!***********************************************************************
+!BOP
+! !IROUTINE: ocn_export_mct
+! !INTERFACE:
+
+ subroutine ocn_export_mct(o2x_o, errorCode) !{{{
+
+! !DESCRIPTION:
+! This routine calls the routines necessary to send pop fields to
+! the CCSM cpl7 driver
+!
+! !REVISION HISTORY:
+! same as module
+!
+! !INPUT/OUTPUT PARAMETERS:
+
+ type(mct_aVect) , intent(inout) :: o2x_o
+
+! !OUTPUT PARAMETERS:
+
+ integer, intent(out) :: &
+ errorCode ! returned error code
+
+!EOP
+!BOC
+!!-----------------------------------------------------------------------
+!!
+!! local variables
+!!
+!!-----------------------------------------------------------------------
+!
+! integer (int_kind) :: n, iblock
+!
+! character (char_len) :: label
+!
+! integer (int_kind) :: &
+! i,j,k
+!
+! real (r8), dimension(nx_block,ny_block) :: &
+! WORK1, WORK2, &! local work space
+! WORK3, WORK4
+!
+! real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: &
+! WORKA ! local work space with full block dimension
+!
+! real (r8) :: &
+! m2percm2, &
+! gsum
+!
+! type (block) :: this_block ! local block info
+!
+!!-----------------------------------------------------------------------
+!
+!!-----------------------------------------------------------------------
+!!
+!! initialize control buffer
+!!
+!!-----------------------------------------------------------------------
+!
+! errorCode = POP_Success
+!
+!!-----------------------------------------------------------------------
+!!
+!! interpolate onto T-grid points and rotate on T grid
+!!
+!!-----------------------------------------------------------------------
+!
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+!
+! call ugrid_to_tgrid(WORK3,SBUFF_SUM(:,:,iblock,index_o2x_So_u),iblock)
+! call ugrid_to_tgrid(WORK4,SBUFF_SUM(:,:,iblock,index_o2x_So_v),iblock)
+!
+! WORK1 = (WORK3*cos(ANGLET(:,:,iblock))+WORK4*sin(-ANGLET(:,:,iblock))) &
+! * mpercm/tlast_coupled
+! WORK2 = (WORK4*cos(ANGLET(:,:,iblock))-WORK3*sin(-ANGLET(:,:,iblock))) &
+! * mpercm/tlast_coupled
+!
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! o2x_o%rAttr(index_o2x_So_u,n) = WORK1(i,j)
+! o2x_o%rAttr(index_o2x_So_v,n) = WORK2(i,j)
+! enddo
+! enddo
+! enddo
+!
+!!-----------------------------------------------------------------------
+!!
+!! convert and pack surface temperature
+!!
+!!-----------------------------------------------------------------------
+!
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! o2x_o%rAttr(index_o2x_So_t,n) = &
+! SBUFF_SUM(i,j,iblock,index_o2x_So_t)/tlast_coupled + T0_Kelvin
+! enddo
+! enddo
+! enddo
+!
+!!-----------------------------------------------------------------------
+!!
+!! convert and pack salinity
+!!
+!!-----------------------------------------------------------------------
+!
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! o2x_o%rAttr(index_o2x_So_s,n) = &
+! SBUFF_SUM(i,j,iblock,index_o2x_So_s)*salt_to_ppt/tlast_coupled
+! enddo
+! enddo
+! enddo
+!
+!!-----------------------------------------------------------------------
+!!
+!! interpolate onto T-grid points, then rotate on T grid
+!!
+!!-----------------------------------------------------------------------
+!
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+! call ugrid_to_tgrid(WORK3,SBUFF_SUM(:,:,iblock,index_o2x_So_dhdx),iblock)
+! call ugrid_to_tgrid(WORK4,SBUFF_SUM(:,:,iblock,index_o2x_So_dhdy),iblock)
+!
+! WORK1 = (WORK3*cos(ANGLET(:,:,iblock)) + WORK4*sin(-ANGLET(:,:,iblock))) &
+! /grav/tlast_coupled
+! WORK2 = (WORK4*cos(ANGLET(:,:,iblock)) - WORK3*sin(-ANGLET(:,:,iblock))) &
+! /grav/tlast_coupled
+!
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! o2x_o%rAttr(index_o2x_So_dhdx,n) = WORK1(i,j)
+! o2x_o%rAttr(index_o2x_So_dhdy,n) = WORK2(i,j)
+! enddo
+! enddo
+! enddo
+!
+!!-----------------------------------------------------------------------
+!!
+!! pack heat flux due to freezing/melting (W/m^2)
+!! QFLUX computation and units conversion occurs in ice.F
+!!
+!!-----------------------------------------------------------------------
+!
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! o2x_o%rAttr(index_o2x_Fioo_q,n) = QFLUX(i,j,iblock)
+! enddo
+! enddo
+! enddo
+!
+! tlast_ice = c0
+! AQICE = c0
+! QICE = c0
+!
+!!-----------------------------------------------------------------------
+!!
+!! pack co2 flux, if requested (kg CO2/m^2/s)
+!! units conversion occurs where co2 flux is computed
+!!
+!!-----------------------------------------------------------------------
+!
+! if (index_o2x_Faoo_fco2_ocn > 0) then
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! o2x_o%rAttr(index_o2x_Faoo_fco2_ocn,n) = &
+! SBUFF_SUM(i,j,iblock,index_o2x_Faoo_fco2_ocn)/tlast_coupled
+! enddo
+! enddo
+! enddo
+! endif
+!
+!!-----------------------------------------------------------------------
+!!
+!! diagnostics
+!!
+!!-----------------------------------------------------------------------
+!
+! if (ldiag_cpl) then
+! call ccsm_char_date_and_time
+!!DEBUG write(message,'(6a,1x,5a)')' Global averages of fluxes sent to cpl at ', &
+!!DEBUG cyear,'/',cmonth, '/',cday, chour,':',cminute,':',csecond
+!!DEBUG call document ('pop_send_to_coupler', message)
+! write(stdout,*)'pop_send_to_coupler'
+!
+! m2percm2 = mpercm*mpercm
+! do k = 1,nsend
+! n = 0
+! do iblock = 1, nblocks_clinic
+! this_block = get_block(blocks_clinic(iblock),iblock)
+! do j=this_block%jb,this_block%je
+! do i=this_block%ib,this_block%ie
+! n = n + 1
+! WORKA(i,j,iblock) = o2x_o%rAttr(k,n)
+! enddo
+! enddo
+! enddo
+!
+! call POP_HaloUpdate(WORKA,POP_haloClinic, &
+! POP_gridHorzLocCenter, &
+! POP_fieldKindScalar, errorCode, &
+! fillValue = 0.0_POP_r8)
+!
+! if (errorCode /= POP_Success) then
+! call POP_ErrorSet(errorCode, &
+! 'ocn_export_mct: error updating halo for state')
+! return
+! endif
+!
+! gsum = global_sum_prod(WORKA , TAREA, distrb_clinic, &
+! field_loc_center, RCALCT)*m2percm2
+! if (my_task == master_task) then
+! call seq_flds_getField(label,k,seq_flds_o2x_fields)
+! write(stdout,1100)'ocn','send', label ,gsum
+! endif
+! enddo ! k
+! if (my_task == master_task) call shr_sys_flush(stdout)
+! endif
+!
+!1100 format ('comm_diag ', a3, 1x, a4, 1x, a8, 1x, es26.19:, 1x, a6)
+!
+! tlast_coupled = c0
+
+!-----------------------------------------------------------------------
+!EOC
+
+ end subroutine ocn_export_mct!}}}
+
+!***********************************************************************
+
+!BOP
+! !IROUTINE: pop_sum_buffer
+! !INTERFACE:
+
+ subroutine pop_sum_buffer!{{{
+
+! !DESCRIPTION:
+! This routine accumulates sums for averaging fields to
+! be sent to the coupler
+!
+! !REVISION HISTORY:
+! same as module
+!
+!EOP
+!BOC
+
+!#ifdef CCSMCOUPLED
+!!-----------------------------------------------------------------------
+!!
+!! local variables
+!!
+!!-----------------------------------------------------------------------
+!
+! real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: &
+! WORK ! local work arrays
+!
+! real (r8) :: &
+! delt, & ! time interval since last step
+! delt_last ! time interval for previous step
+!
+! integer (int_kind) :: &
+! iblock, & ! block index
+! sflux_co2_nf_ind = 0! named field index of fco2
+!
+! logical (log_kind) :: &
+! first = .true. ! only true for first call
+!
+! save first
+!
+!!-----------------------------------------------------------------------
+!!
+!! zero buffer if this is the first time after a coupling interval
+!!
+!!-----------------------------------------------------------------------
+!
+! if (tlast_coupled == c0) SBUFF_SUM = c0
+! WORK = c0
+!
+!!-----------------------------------------------------------------------
+!!
+!! update time since last coupling
+!!
+!!-----------------------------------------------------------------------
+!
+! if (avg_ts .or. back_to_back) then
+! delt = p5*dtt
+! else
+! delt = dtt
+! endif
+! tlast_coupled = tlast_coupled + delt
+!
+!!-----------------------------------------------------------------------
+!!
+!! allow for fco2 field to not be registered on first call
+!! because init_forcing is called before init_passive_tracers
+!! use weight from previous timestep because flux used here is that
+!! computed during the previous timestep
+!!
+!!-----------------------------------------------------------------------
+!
+! if (index_o2x_Faoo_fco2_ocn > 0) then
+! if (sflux_co2_nf_ind == 0) then
+! call named_field_get_index('SFLUX_CO2', sflux_co2_nf_ind, &
+! exit_on_err=.not. first)
+! endif
+!
+! if (avg_ts .or. back_to_back) then
+! delt_last = p5*dtt
+! else
+! delt_last = dtt
+! endif
+! endif
+!
+!!-----------------------------------------------------------------------
+!!
+!! accumulate sums of U,V,T,S and GRADP
+!! accumulate sum of co2 flux, if requested
+!! implicitly use zero flux if fco2 field not registered yet
+!! ice formation flux is handled separately in ice routine
+!!
+!!-----------------------------------------------------------------------
+!
+! !$OMP PARALLEL DO PRIVATE(iblock)
+! do iblock = 1, nblocks_clinic
+! SBUFF_SUM(:,:,iblock,index_o2x_So_u) = &
+! SBUFF_SUM(:,:,iblock,index_o2x_So_u) + delt* &
+! UVEL(:,:,1,curtime,iblock)
+!
+! SBUFF_SUM(:,:,iblock,index_o2x_So_v) = &
+! SBUFF_SUM(:,:,iblock,index_o2x_So_v) + delt* &
+! VVEL(:,:,1,curtime,iblock)
+!
+! SBUFF_SUM(:,:,iblock,index_o2x_So_t ) = &
+! SBUFF_SUM(:,:,iblock,index_o2x_So_t ) + delt* &
+! TRACER(:,:,1,1,curtime,iblock)
+!
+! SBUFF_SUM(:,:,iblock,index_o2x_So_s ) = &
+! SBUFF_SUM(:,:,iblock,index_o2x_So_s ) + delt* &
+! TRACER(:,:,1,2,curtime,iblock)
+!
+! SBUFF_SUM(:,:,iblock,index_o2x_So_dhdx) = &
+! SBUFF_SUM(:,:,iblock,index_o2x_So_dhdx) + delt* &
+! GRADPX(:,:,curtime,iblock)
+!
+! SBUFF_SUM(:,:,iblock,index_o2x_So_dhdy) = &
+! SBUFF_SUM(:,:,iblock,index_o2x_So_dhdy) + delt* &
+! GRADPY(:,:,curtime,iblock)
+!
+! if (index_o2x_Faoo_fco2_ocn > 0 .and. sflux_co2_nf_ind > 0) then
+! call named_field_get(sflux_co2_nf_ind, iblock, WORK(:,:,iblock))
+! SBUFF_SUM(:,:,iblock,index_o2x_Faoo_fco2_ocn) = &
+! SBUFF_SUM(:,:,iblock,index_o2x_Faoo_fco2_ocn) + delt_last*WORK(:,:,iblock)
+! endif
+!
+! enddo
+! !$OMP END PARALLEL DO
+!
+! first = .false.
+!
+!#endif
+!
+!-----------------------------------------------------------------------
+!EOC
+
+ end subroutine pop_sum_buffer!}}}
+
+!***********************************************************************
+
+end module ocn_comp_mct
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Modified: branches/atmos_physics/src/registry/Makefile
===================================================================
--- branches/atmos_physics/src/registry/Makefile 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/registry/Makefile 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,9 +1,12 @@
.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)
Copied: branches/atmos_physics/src/registry/Registry.xsd (from rev 2666, trunk/mpas/src/registry/Registry.xsd)
===================================================================
--- branches/atmos_physics/src/registry/Registry.xsd (rev 0)
+++ branches/atmos_physics/src/registry/Registry.xsd 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,119 @@
+<?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>
+ </xs:complexType>
+ </xs:element>
+</xs:schema>
Deleted: branches/atmos_physics/src/registry/ezxml/ezxml.c
===================================================================
--- trunk/mpas/src/registry/ezxml/ezxml.c 2013-03-25 16:55:55 UTC (rev 2666)
+++ branches/atmos_physics/src/registry/ezxml/ezxml.c 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,1015 +0,0 @@
-/* ezxml.c
- *
- * Copyright 2004-2006 Aaron Voisine <aaron@voisine.org>
- *
- * Permission is hereby granted, free of charge, to any person obtaining
- * a copy of this software and associated documentation files (the
- * "Software"), to deal in the Software without restriction, including
- * without limitation the rights to use, copy, modify, merge, publish,
- * distribute, sublicense, and/or sell copies of the Software, and to
- * permit persons to whom the Software is furnished to do so, subject to
- * the following conditions:
- *
- * The above copyright notice and this permission notice shall be included
- * in all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
- * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
- * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
- * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
- * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
- */
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdarg.h>
-#include <string.h>
-#include <ctype.h>
-#include <unistd.h>
-#include <sys/types.h>
-#ifndef EZXML_NOMMAP
-#include <sys/mman.h>
-#endif // EZXML_NOMMAP
-#include <sys/stat.h>
-#include "ezxml.h"
-
-#define EZXML_WS "\t\r</font>
<font color="red"> " // whitespace
-#define EZXML_ERRL 128 // maximum error string length
-
-typedef struct ezxml_root *ezxml_root_t;
-struct ezxml_root { // additional data for the root tag
- struct ezxml xml; // is a super-struct built on top of ezxml struct
- ezxml_t cur; // current xml tree insertion point
- char *m; // original xml string
- size_t len; // length of allocated memory for mmap, -1 for malloc
- char *u; // UTF-8 conversion of string if original was UTF-16
- char *s; // start of work area
- char *e; // end of work area
- char **ent; // general entities (ampersand sequences)
- char ***attr; // default attributes
- char ***pi; // processing instructions
- short standalone; // non-zero if <?xml standalone="yes"?>
- char err[EZXML_ERRL]; // error string
-};
-
-char *EZXML_NIL[] = { NULL }; // empty, null terminated array of strings
-
-// returns the first child tag with the given name or NULL if not found
-ezxml_t ezxml_child(ezxml_t xml, const char *name)
-{
- xml = (xml) ? xml->child : NULL;
- while (xml && strcmp(name, xml->name)) xml = xml->sibling;
- return xml;
-}
-
-// returns the Nth tag with the same name in the same subsection or NULL if not
-// found
-ezxml_t ezxml_idx(ezxml_t xml, int idx)
-{
- for (; xml && idx; idx--) xml = xml->next;
- return xml;
-}
-
-// returns the value of the requested tag attribute or NULL if not found
-const char *ezxml_attr(ezxml_t xml, const char *attr)
-{
- int i = 0, j = 1;
- ezxml_root_t root = (ezxml_root_t)xml;
-
- if (! xml || ! xml->attr) return NULL;
- while (xml->attr[i] && strcmp(attr, xml->attr[i])) i += 2;
- if (xml->attr[i]) return xml->attr[i + 1]; // found attribute
-
- while (root->xml.parent) root = (ezxml_root_t)root->xml.parent; // root tag
- for (i = 0; root->attr[i] && strcmp(xml->name, root->attr[i][0]); i++);
- if (! root->attr[i]) return NULL; // no matching default attributes
- while (root->attr[i][j] && strcmp(attr, root->attr[i][j])) j += 3;
- return (root->attr[i][j]) ? root->attr[i][j + 1] : NULL; // found default
-}
-
-// same as ezxml_get but takes an already initialized va_list
-ezxml_t ezxml_vget(ezxml_t xml, va_list ap)
-{
- char *name = va_arg(ap, char *);
- int idx = -1;
-
- if (name && *name) {
- idx = va_arg(ap, int);
- xml = ezxml_child(xml, name);
- }
- return (idx < 0) ? xml : ezxml_vget(ezxml_idx(xml, idx), ap);
-}
-
-// Traverses the xml tree to retrieve a specific subtag. Takes a variable
-// length list of tag names and indexes. The argument list must be terminated
-// by either an index of -1 or an empty string tag name. Example:
-// title = ezxml_get(library, "shelf", 0, "book", 2, "title", -1);
-// This retrieves the title of the 3rd book on the 1st shelf of library.
-// Returns NULL if not found.
-ezxml_t ezxml_get(ezxml_t xml, ...)
-{
- va_list ap;
- ezxml_t r;
-
- va_start(ap, xml);
- r = ezxml_vget(xml, ap);
- va_end(ap);
- return r;
-}
-
-// returns a null terminated array of processing instructions for the given
-// target
-const char **ezxml_pi(ezxml_t xml, const char *target)
-{
- ezxml_root_t root = (ezxml_root_t)xml;
- int i = 0;
-
- if (! root) return (const char **)EZXML_NIL;
- while (root->xml.parent) root = (ezxml_root_t)root->xml.parent; // root tag
- while (root->pi[i] && strcmp(target, root->pi[i][0])) i++; // find target
- return (const char **)((root->pi[i]) ? root->pi[i] + 1 : EZXML_NIL);
-}
-
-// set an error string and return root
-ezxml_t ezxml_err(ezxml_root_t root, char *s, const char *err, ...)
-{
- va_list ap;
- int line = 1;
- char *t, fmt[EZXML_ERRL];
-
- for (t = root->s; t < s; t++) if (*t == '</font>
<font color="red">') line++;
- snprintf(fmt, EZXML_ERRL, "[error near line %d]: %s", line, err);
-
- va_start(ap, err);
- vsnprintf(root->err, EZXML_ERRL, fmt, ap);
- va_end(ap);
-
- return &root->xml;
-}
-
-// Recursively decodes entity and character references and normalizes new lines
-// ent is a null terminated array of alternating entity names and values. set t
-// to '&' for general entity decoding, '%' for parameter entity decoding, 'c'
-// for cdata sections, ' ' for attribute normalization, or '*' for non-cdata
-// attribute normalization. Returns s, or if the decoded string is longer than
-// s, returns a malloced string that must be freed.
-char *ezxml_decode(char *s, char **ent, char t)
-{
- char *e, *r = s, *m = s;
- long b, c, d, l;
-
- for (; *s; s++) { // normalize line endings
- while (*s == '\r') {
- *(s++) = '</font>
<font color="red">';
- if (*s == '</font>
<font color="red">') memmove(s, (s + 1), strlen(s));
- }
- }
-
- for (s = r; ; ) {
- while (*s && *s != '&' && (*s != '%' || t != '%') && !isspace(*s)) s++;
-
- if (! *s) break;
- else if (t != 'c' && ! strncmp(s, "&#", 2)) { // character reference
- if (s[2] == 'x') c = strtol(s + 3, &e, 16); // base 16
- else c = strtol(s + 2, &e, 10); // base 10
- if (! c || *e != ';') { s++; continue; } // not a character ref
-
- if (c < 0x80) *(s++) = c; // US-ASCII subset
- else { // multi-byte UTF-8 sequence
- for (b = 0, d = c; d; d /= 2) b++; // number of bits in c
- b = (b - 2) / 5; // number of bytes in payload
- *(s++) = (0xFF << (7 - b)) | (c >> (6 * b)); // head
- while (b) *(s++) = 0x80 | ((c >> (6 * --b)) & 0x3F); // payload
- }
-
- memmove(s, strchr(s, ';') + 1, strlen(strchr(s, ';')));
- }
- else if ((*s == '&' && (t == '&' || t == ' ' || t == '*')) ||
- (*s == '%' && t == '%')) { // entity reference
- for (b = 0; ent[b] && strncmp(s + 1, ent[b], strlen(ent[b]));
- b += 2); // find entity in entity list
-
- if (ent[b++]) { // found a match
- if ((c = strlen(ent[b])) - 1 > (e = strchr(s, ';')) - s) {
- l = (d = (s - r)) + c + strlen(e); // new length
- r = (r == m) ? strcpy(malloc(l), r) : realloc(r, l);
- e = strchr((s = r + d), ';'); // fix up pointers
- }
-
- memmove(s + c, e + 1, strlen(e)); // shift rest of string
- strncpy(s, ent[b], c); // copy in replacement text
- }
- else s++; // not a known entity
- }
- else if ((t == ' ' || t == '*') && isspace(*s)) *(s++) = ' ';
- else s++; // no decoding needed
- }
-
- if (t == '*') { // normalize spaces for non-cdata attributes
- for (s = r; *s; s++) {
- if ((l = strspn(s, " "))) memmove(s, s + l, strlen(s + l) + 1);
- while (*s && *s != ' ') s++;
- }
- if (--s >= r && *s == ' ') *s = '\0'; // trim any trailing space
- }
- return r;
-}
-
-// called when parser finds start of new tag
-void ezxml_open_tag(ezxml_root_t root, char *name, char **attr)
-{
- ezxml_t xml = root->cur;
-
- if (xml->name) xml = ezxml_add_child(xml, name, strlen(xml->txt));
- else xml->name = name; // first open tag
-
- xml->attr = attr;
- root->cur = xml; // update tag insertion point
-}
-
-// called when parser finds character content between open and closing tag
-void ezxml_char_content(ezxml_root_t root, char *s, size_t len, char t)
-{
- ezxml_t xml = root->cur;
- char *m = s;
- size_t l;
-
- if (! xml || ! xml->name || ! len) return; // sanity check
-
- s[len] = '\0'; // null terminate text (calling functions anticipate this)
- len = strlen(s = ezxml_decode(s, root->ent, t)) + 1;
-
- if (! *(xml->txt)) xml->txt = s; // initial character content
- else { // allocate our own memory and make a copy
- xml->txt = (xml->flags & EZXML_TXTM) // allocate some space
- ? realloc(xml->txt, (l = strlen(xml->txt)) + len)
- : strcpy(malloc((l = strlen(xml->txt)) + len), xml->txt);
- strcpy(xml->txt + l, s); // add new char content
- if (s != m) free(s); // free s if it was malloced by ezxml_decode()
- }
-
- if (xml->txt != m) ezxml_set_flag(xml, EZXML_TXTM);
-}
-
-// called when parser finds closing tag
-ezxml_t ezxml_close_tag(ezxml_root_t root, char *name, char *s)
-{
- if (! root->cur || ! root->cur->name || strcmp(name, root->cur->name))
- return ezxml_err(root, s, "unexpected closing tag </%s>", name);
-
- root->cur = root->cur->parent;
- return NULL;
-}
-
-// checks for circular entity references, returns non-zero if no circular
-// references are found, zero otherwise
-int ezxml_ent_ok(char *name, char *s, char **ent)
-{
- int i;
-
- for (; ; s++) {
- while (*s && *s != '&') s++; // find next entity reference
- if (! *s) return 1;
- if (! strncmp(s + 1, name, strlen(name))) return 0; // circular ref.
- for (i = 0; ent[i] && strncmp(ent[i], s + 1, strlen(ent[i])); i += 2);
- if (ent[i] && ! ezxml_ent_ok(name, ent[i + 1], ent)) return 0;
- }
-}
-
-// called when the parser finds a processing instruction
-void ezxml_proc_inst(ezxml_root_t root, char *s, size_t len)
-{
- int i = 0, j = 1;
- char *target = s;
-
- s[len] = '\0'; // null terminate instruction
- if (*(s += strcspn(s, EZXML_WS))) {
- *s = '\0'; // null terminate target
- s += strspn(s + 1, EZXML_WS) + 1; // skip whitespace after target
- }
-
- if (! strcmp(target, "xml")) { // <?xml ... ?>
- if ((s = strstr(s, "standalone")) && ! strncmp(s + strspn(s + 10,
- EZXML_WS "='\"") + 10, "yes", 3)) root->standalone = 1;
- return;
- }
-
- if (! root->pi[0]) *(root->pi = malloc(sizeof(char **))) = NULL; //first pi
-
- while (root->pi[i] && strcmp(target, root->pi[i][0])) i++; // find target
- if (! root->pi[i]) { // new target
- root->pi = realloc(root->pi, sizeof(char **) * (i + 2));
- root->pi[i] = malloc(sizeof(char *) * 3);
- root->pi[i][0] = target;
- root->pi[i][1] = (char *)(root->pi[i + 1] = NULL); // terminate pi list
- root->pi[i][2] = strdup(""); // empty document position list
- }
-
- while (root->pi[i][j]) j++; // find end of instruction list for this target
- root->pi[i] = realloc(root->pi[i], sizeof(char *) * (j + 3));
- root->pi[i][j + 2] = realloc(root->pi[i][j + 1], j + 1);
- strcpy(root->pi[i][j + 2] + j - 1, (root->xml.name) ? ">" : "<");
- root->pi[i][j + 1] = NULL; // null terminate pi list for this target
- root->pi[i][j] = s; // set instruction
-}
-
-// called when the parser finds an internal doctype subset
-short ezxml_internal_dtd(ezxml_root_t root, char *s, size_t len)
-{
- char q, *c, *t, *n = NULL, *v, **ent, **pe;
- int i, j;
-
- pe = memcpy(malloc(sizeof(EZXML_NIL)), EZXML_NIL, sizeof(EZXML_NIL));
-
- for (s[len] = '\0'; s; ) {
- while (*s && *s != '<' && *s != '%') s++; // find next declaration
-
- if (! *s) break;
- else if (! strncmp(s, "<!ENTITY", 8)) { // parse entity definitions
- c = s += strspn(s + 8, EZXML_WS) + 8; // skip white space separator
- n = s + strspn(s, EZXML_WS "%"); // find name
- *(s = n + strcspn(n, EZXML_WS)) = ';'; // append ; to name
-
- v = s + strspn(s + 1, EZXML_WS) + 1; // find value
- if ((q = *(v++)) != '"' && q != '\'') { // skip externals
- s = strchr(s, '>');
- continue;
- }
-
- for (i = 0, ent = (*c == '%') ? pe : root->ent; ent[i]; i++);
- ent = realloc(ent, (i + 3) * sizeof(char *)); // space for next ent
- if (*c == '%') pe = ent;
- else root->ent = ent;
-
- *(++s) = '\0'; // null terminate name
- if ((s = strchr(v, q))) *(s++) = '\0'; // null terminate value
- ent[i + 1] = ezxml_decode(v, pe, '%'); // set value
- ent[i + 2] = NULL; // null terminate entity list
- if (! ezxml_ent_ok(n, ent[i + 1], ent)) { // circular reference
- if (ent[i + 1] != v) free(ent[i + 1]);
- ezxml_err(root, v, "circular entity declaration &%s", n);
- break;
- }
- else ent[i] = n; // set entity name
- }
- else if (! strncmp(s, "<!ATTLIST", 9)) { // parse default attributes
- t = s + strspn(s + 9, EZXML_WS) + 9; // skip whitespace separator
- if (! *t) { ezxml_err(root, t, "unclosed <!ATTLIST"); break; }
- if (*(s = t + strcspn(t, EZXML_WS ">")) == '>') continue;
- else *s = '\0'; // null terminate tag name
- for (i = 0; root->attr[i] && strcmp(n, root->attr[i][0]); i++);
-
- while (*(n = ++s + strspn(s, EZXML_WS)) && *n != '>') {
- if (*(s = n + strcspn(n, EZXML_WS))) *s = '\0'; // attr name
- else { ezxml_err(root, t, "malformed <!ATTLIST"); break; }
-
- s += strspn(s + 1, EZXML_WS) + 1; // find next token
- c = (strncmp(s, "CDATA", 5)) ? "*" : " "; // is it cdata?
- if (! strncmp(s, "NOTATION", 8))
- s += strspn(s + 8, EZXML_WS) + 8;
- s = (*s == '(') ? strchr(s, ')') : s + strcspn(s, EZXML_WS);
- if (! s) { ezxml_err(root, t, "malformed <!ATTLIST"); break; }
-
- s += strspn(s, EZXML_WS ")"); // skip white space separator
- if (! strncmp(s, "#FIXED", 6))
- s += strspn(s + 6, EZXML_WS) + 6;
- if (*s == '#') { // no default value
- s += strcspn(s, EZXML_WS ">") - 1;
- if (*c == ' ') continue; // cdata is default, nothing to do
- v = NULL;
- }
- else if ((*s == '"' || *s == '\'') && // default value
- (s = strchr(v = s + 1, *s))) *s = '\0';
- else { ezxml_err(root, t, "malformed <!ATTLIST"); break; }
-
- if (! root->attr[i]) { // new tag name
- root->attr = (! i) ? malloc(2 * sizeof(char **))
- : realloc(root->attr,
- (i + 2) * sizeof(char **));
- root->attr[i] = malloc(2 * sizeof(char *));
- root->attr[i][0] = t; // set tag name
- root->attr[i][1] = (char *)(root->attr[i + 1] = NULL);
- }
-
- for (j = 1; root->attr[i][j]; j += 3); // find end of list
- root->attr[i] = realloc(root->attr[i],
- (j + 4) * sizeof(char *));
-
- root->attr[i][j + 3] = NULL; // null terminate list
- root->attr[i][j + 2] = c; // is it cdata?
- root->attr[i][j + 1] = (v) ? ezxml_decode(v, root->ent, *c)
- : NULL;
- root->attr[i][j] = n; // attribute name
- }
- }
- else if (! strncmp(s, "<!--", 4)) s = strstr(s + 4, "-->"); // comments
- else if (! strncmp(s, "<?", 2)) { // processing instructions
- if ((s = strstr(c = s + 2, "?>")))
- ezxml_proc_inst(root, c, s++ - c);
- }
- else if (*s == '<') s = strchr(s, '>'); // skip other declarations
- else if (*(s++) == '%' && ! root->standalone) break;
- }
-
- free(pe);
- return ! *root->err;
-}
-
-// Converts a UTF-16 string to UTF-8. Returns a new string that must be freed
-// or NULL if no conversion was needed.
-char *ezxml_str2utf8(char **s, size_t *len)
-{
- char *u;
- size_t l = 0, sl, max = *len;
- long c, d;
- int b, be = (**s == '\xFE') ? 1 : (**s == '\xFF') ? 0 : -1;
-
- if (be == -1) return NULL; // not UTF-16
-
- u = malloc(max);
- for (sl = 2; sl < *len - 1; sl += 2) {
- c = (be) ? (((*s)[sl] & 0xFF) << 8) | ((*s)[sl + 1] & 0xFF) //UTF-16BE
- : (((*s)[sl + 1] & 0xFF) << 8) | ((*s)[sl] & 0xFF); //UTF-16LE
- if (c >= 0xD800 && c <= 0xDFFF && (sl += 2) < *len - 1) { // high-half
- d = (be) ? (((*s)[sl] & 0xFF) << 8) | ((*s)[sl + 1] & 0xFF)
- : (((*s)[sl + 1] & 0xFF) << 8) | ((*s)[sl] & 0xFF);
- c = (((c & 0x3FF) << 10) | (d & 0x3FF)) + 0x10000;
- }
-
- while (l + 6 > max) u = realloc(u, max += EZXML_BUFSIZE);
- if (c < 0x80) u[l++] = c; // US-ASCII subset
- else { // multi-byte UTF-8 sequence
- for (b = 0, d = c; d; d /= 2) b++; // bits in c
- b = (b - 2) / 5; // bytes in payload
- u[l++] = (0xFF << (7 - b)) | (c >> (6 * b)); // head
- while (b) u[l++] = 0x80 | ((c >> (6 * --b)) & 0x3F); // payload
- }
- }
- return *s = realloc(u, *len = l);
-}
-
-// frees a tag attribute list
-void ezxml_free_attr(char **attr) {
- int i = 0;
- char *m;
-
- if (! attr || attr == EZXML_NIL) return; // nothing to free
- while (attr[i]) i += 2; // find end of attribute list
- m = attr[i + 1]; // list of which names and values are malloced
- for (i = 0; m[i]; i++) {
- if (m[i] & EZXML_NAMEM) free(attr[i * 2]);
- if (m[i] & EZXML_TXTM) free(attr[(i * 2) + 1]);
- }
- free(m);
- free(attr);
-}
-
-// parse the given xml string and return an ezxml structure
-ezxml_t ezxml_parse_str(char *s, size_t len)
-{
- ezxml_root_t root = (ezxml_root_t)ezxml_new(NULL);
- char q, e, *d, **attr, **a = NULL; // initialize a to avoid compile warning
- int l, i, j;
-
- root->m = s;
- if (! len) return ezxml_err(root, NULL, "root tag missing");
- root->u = ezxml_str2utf8(&s, &len); // convert utf-16 to utf-8
- root->e = (root->s = s) + len; // record start and end of work area
-
- e = s[len - 1]; // save end char
- s[len - 1] = '\0'; // turn end char into null terminator
-
- while (*s && *s != '<') s++; // find first tag
- if (! *s) return ezxml_err(root, s, "root tag missing");
-
- for (; ; ) {
- attr = (char **)EZXML_NIL;
- d = ++s;
-
- if (isalpha(*s) || *s == '_' || *s == ':' || *s < '\0') { // new tag
- if (! root->cur)
- return ezxml_err(root, d, "markup outside of root element");
-
- s += strcspn(s, EZXML_WS "/>");
- while (isspace(*s)) *(s++) = '\0'; // null terminate tag name
-
- if (*s && *s != '/' && *s != '>') // find tag in default attr list
- for (i = 0; (a = root->attr[i]) && strcmp(a[0], d); i++);
-
- for (l = 0; *s && *s != '/' && *s != '>'; l += 2) { // new attrib
- attr = (l) ? realloc(attr, (l + 4) * sizeof(char *))
- : malloc(4 * sizeof(char *)); // allocate space
- attr[l + 3] = (l) ? realloc(attr[l + 1], (l / 2) + 2)
- : malloc(2); // mem for list of maloced vals
- strcpy(attr[l + 3] + (l / 2), " "); // value is not malloced
- attr[l + 2] = NULL; // null terminate list
- attr[l + 1] = ""; // temporary attribute value
- attr[l] = s; // set attribute name
-
- s += strcspn(s, EZXML_WS "=/>");
- if (*s == '=' || isspace(*s)) {
- *(s++) = '\0'; // null terminate tag attribute name
- q = *(s += strspn(s, EZXML_WS "="));
- if (q == '"' || q == '\'') { // attribute value
- attr[l + 1] = ++s;
- while (*s && *s != q) s++;
- if (*s) *(s++) = '\0'; // null terminate attribute val
- else {
- ezxml_free_attr(attr);
- return ezxml_err(root, d, "missing %c", q);
- }
-
- for (j = 1; a && a[j] && strcmp(a[j], attr[l]); j +=3);
- attr[l + 1] = ezxml_decode(attr[l + 1], root->ent, (a
- && a[j]) ? *a[j + 2] : ' ');
- if (attr[l + 1] < d || attr[l + 1] > s)
- attr[l + 3][l / 2] = EZXML_TXTM; // value malloced
- }
- }
- while (isspace(*s)) s++;
- }
-
- if (*s == '/') { // self closing tag
- *(s++) = '\0';
- if ((*s && *s != '>') || (! *s && e != '>')) {
- if (l) ezxml_free_attr(attr);
- return ezxml_err(root, d, "missing >");
- }
- ezxml_open_tag(root, d, attr);
- ezxml_close_tag(root, d, s);
- }
- else if ((q = *s) == '>' || (! *s && e == '>')) { // open tag
- *s = '\0'; // temporarily null terminate tag name
- ezxml_open_tag(root, d, attr);
- *s = q;
- }
- else {
- if (l) ezxml_free_attr(attr);
- return ezxml_err(root, d, "missing >");
- }
- }
- else if (*s == '/') { // close tag
- s += strcspn(d = s + 1, EZXML_WS ">") + 1;
- if (! (q = *s) && e != '>') return ezxml_err(root, d, "missing >");
- *s = '\0'; // temporarily null terminate tag name
- if (ezxml_close_tag(root, d, s)) return &root->xml;
- if (isspace(*s = q)) s += strspn(s, EZXML_WS);
- }
- else if (! strncmp(s, "!--", 3)) { // xml comment
- if (! (s = strstr(s + 3, "--")) || (*(s += 2) != '>' && *s) ||
- (! *s && e != '>')) return ezxml_err(root, d, "unclosed <!--");
- }
- else if (! strncmp(s, "![CDATA[", 8)) { // cdata
- if ((s = strstr(s, "]]>")))
- ezxml_char_content(root, d + 8, (s += 2) - d - 10, 'c');
- else return ezxml_err(root, d, "unclosed <![CDATA[");
- }
- else if (! strncmp(s, "!DOCTYPE", 8)) { // dtd
- for (l = 0; *s && ((! l && *s != '>') || (l && (*s != ']' ||
- *(s + strspn(s + 1, EZXML_WS) + 1) != '>')));
- l = (*s == '[') ? 1 : l) s += strcspn(s + 1, "[]>") + 1;
- if (! *s && e != '>')
- return ezxml_err(root, d, "unclosed <!DOCTYPE");
- d = (l) ? strchr(d, '[') + 1 : d;
- if (l && ! ezxml_internal_dtd(root, d, s++ - d)) return &root->xml;
- }
- else if (*s == '?') { // <?...?> processing instructions
- do { s = strchr(s, '?'); } while (s && *(++s) && *s != '>');
- if (! s || (! *s && e != '>'))
- return ezxml_err(root, d, "unclosed <?");
- else ezxml_proc_inst(root, d + 1, s - d - 2);
- }
- else return ezxml_err(root, d, "unexpected <");
-
- if (! s || ! *s) break;
- *s = '\0';
- d = ++s;
- if (*s && *s != '<') { // tag character content
- while (*s && *s != '<') s++;
- if (*s) ezxml_char_content(root, d, s - d, '&');
- else break;
- }
- else if (! *s) break;
- }
-
- if (! root->cur) return &root->xml;
- else if (! root->cur->name) return ezxml_err(root, d, "root tag missing");
- else return ezxml_err(root, d, "unclosed tag <%s>", root->cur->name);
-}
-
-// Wrapper for ezxml_parse_str() that accepts a file stream. Reads the entire
-// stream into memory and then parses it. For xml files, use ezxml_parse_file()
-// or ezxml_parse_fd()
-ezxml_t ezxml_parse_fp(FILE *fp)
-{
- ezxml_root_t root;
- size_t l, len = 0;
- char *s;
-
- if (! (s = malloc(EZXML_BUFSIZE))) return NULL;
- do {
- len += (l = fread((s + len), 1, EZXML_BUFSIZE, fp));
- if (l == EZXML_BUFSIZE) s = realloc(s, len + EZXML_BUFSIZE);
- } while (s && l == EZXML_BUFSIZE);
-
- if (! s) return NULL;
- root = (ezxml_root_t)ezxml_parse_str(s, len);
- root->len = -1; // so we know to free s in ezxml_free()
- return &root->xml;
-}
-
-// A wrapper for ezxml_parse_str() that accepts a file descriptor. First
-// attempts to mem map the file. Failing that, reads the file into memory.
-// Returns NULL on failure.
-ezxml_t ezxml_parse_fd(int fd)
-{
- ezxml_root_t root;
- struct stat st;
- size_t l;
- void *m;
-
- if (fd < 0) return NULL;
- fstat(fd, &st);
-
-#ifndef EZXML_NOMMAP
- l = (st.st_size + sysconf(_SC_PAGESIZE) - 1) & ~(sysconf(_SC_PAGESIZE) -1);
- if ((m = mmap(NULL, l, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0)) !=
- MAP_FAILED) {
- madvise(m, l, MADV_SEQUENTIAL); // optimize for sequential access
- root = (ezxml_root_t)ezxml_parse_str(m, st.st_size);
- madvise(m, root->len = l, MADV_NORMAL); // put it back to normal
- }
- else { // mmap failed, read file into memory
-#endif // EZXML_NOMMAP
- l = read(fd, m = malloc(st.st_size), st.st_size);
- root = (ezxml_root_t)ezxml_parse_str(m, l);
- root->len = -1; // so we know to free s in ezxml_free()
-#ifndef EZXML_NOMMAP
- }
-#endif // EZXML_NOMMAP
- return &root->xml;
-}
-
-// a wrapper for ezxml_parse_fd that accepts a file name
-ezxml_t ezxml_parse_file(const char *file)
-{
- int fd = open(file, O_RDONLY, 0);
- ezxml_t xml = ezxml_parse_fd(fd);
-
- if (fd >= 0) close(fd);
- return xml;
-}
-
-// Encodes ampersand sequences appending the results to *dst, reallocating *dst
-// if length excedes max. a is non-zero for attribute encoding. Returns *dst
-char *ezxml_ampencode(const char *s, size_t len, char **dst, size_t *dlen,
- size_t *max, short a)
-{
- const char *e;
-
- for (e = s + len; s != e; s++) {
- while (*dlen + 10 > *max) *dst = realloc(*dst, *max += EZXML_BUFSIZE);
-
- switch (*s) {
- case '\0': return *dst;
- case '&': *dlen += sprintf(*dst + *dlen, "&amp;"); break;
- case '<': *dlen += sprintf(*dst + *dlen, "&lt;"); break;
- case '>': *dlen += sprintf(*dst + *dlen, "&gt;"); break;
- case '"': *dlen += sprintf(*dst + *dlen, (a) ? "&quot;" : "\""); break;
- case '</font>
<font color="black">': *dlen += sprintf(*dst + *dlen, (a) ? "&#xA;" : "</font>
<font color="red">"); break;
- case '\t': *dlen += sprintf(*dst + *dlen, (a) ? "&#x9;" : "\t"); break;
- case '\r': *dlen += sprintf(*dst + *dlen, "&#xD;"); break;
- default: (*dst)[(*dlen)++] = *s;
- }
- }
- return *dst;
-}
-
-// Recursively converts each tag to xml appending it to *s. Reallocates *s if
-// its length excedes max. start is the location of the previous tag in the
-// parent tag's character content. Returns *s.
-char *ezxml_toxml_r(ezxml_t xml, char **s, size_t *len, size_t *max,
- size_t start, char ***attr)
-{
- int i, j;
- char *txt = (xml->parent) ? xml->parent->txt : "";
- size_t off = 0;
-
- // parent character content up to this tag
- *s = ezxml_ampencode(txt + start, xml->off - start, s, len, max, 0);
-
- while (*len + strlen(xml->name) + 4 > *max) // reallocate s
- *s = realloc(*s, *max += EZXML_BUFSIZE);
-
- *len += sprintf(*s + *len, "<%s", xml->name); // open tag
- for (i = 0; xml->attr[i]; i += 2) { // tag attributes
- if (ezxml_attr(xml, xml->attr[i]) != xml->attr[i + 1]) continue;
- while (*len + strlen(xml->attr[i]) + 7 > *max) // reallocate s
- *s = realloc(*s, *max += EZXML_BUFSIZE);
-
- *len += sprintf(*s + *len, " %s=\"", xml->attr[i]);
- ezxml_ampencode(xml->attr[i + 1], -1, s, len, max, 1);
- *len += sprintf(*s + *len, "\"");
- }
-
- for (i = 0; attr[i] && strcmp(attr[i][0], xml->name); i++);
- for (j = 1; attr[i] && attr[i][j]; j += 3) { // default attributes
- if (! attr[i][j + 1] || ezxml_attr(xml, attr[i][j]) != attr[i][j + 1])
- continue; // skip duplicates and non-values
- while (*len + strlen(attr[i][j]) + 7 > *max) // reallocate s
- *s = realloc(*s, *max += EZXML_BUFSIZE);
-
- *len += sprintf(*s + *len, " %s=\"", attr[i][j]);
- ezxml_ampencode(attr[i][j + 1], -1, s, len, max, 1);
- *len += sprintf(*s + *len, "\"");
- }
- *len += sprintf(*s + *len, ">");
-
- *s = (xml->child) ? ezxml_toxml_r(xml->child, s, len, max, 0, attr) //child
- : ezxml_ampencode(xml->txt, -1, s, len, max, 0); //data
-
- while (*len + strlen(xml->name) + 4 > *max) // reallocate s
- *s = realloc(*s, *max += EZXML_BUFSIZE);
-
- *len += sprintf(*s + *len, "</%s>", xml->name); // close tag
-
- while (txt[off] && off < xml->off) off++; // make sure off is within bounds
- return (xml->ordered) ? ezxml_toxml_r(xml->ordered, s, len, max, off, attr)
- : ezxml_ampencode(txt + off, -1, s, len, max, 0);
-}
-
-// Converts an ezxml structure back to xml. Returns a string of xml data that
-// must be freed.
-char *ezxml_toxml(ezxml_t xml)
-{
- ezxml_t p = (xml) ? xml->parent : NULL, o = (xml) ? xml->ordered : NULL;
- ezxml_root_t root = (ezxml_root_t)xml;
- size_t len = 0, max = EZXML_BUFSIZE;
- char *s = strcpy(malloc(max), ""), *t, *n;
- int i, j, k;
-
- if (! xml || ! xml->name) return realloc(s, len + 1);
- while (root->xml.parent) root = (ezxml_root_t)root->xml.parent; // root tag
-
- for (i = 0; ! p && root->pi[i]; i++) { // pre-root processing instructions
- for (k = 2; root->pi[i][k - 1]; k++);
- for (j = 1; (n = root->pi[i][j]); j++) {
- if (root->pi[i][k][j - 1] == '>') continue; // not pre-root
- while (len + strlen(t = root->pi[i][0]) + strlen(n) + 7 > max)
- s = realloc(s, max += EZXML_BUFSIZE);
- len += sprintf(s + len, "<?%s%s%s?></font>
<font color="red">", t, *n ? " " : "", n);
- }
- }
-
- xml->parent = xml->ordered = NULL;
- s = ezxml_toxml_r(xml, &s, &len, &max, 0, root->attr);
- xml->parent = p;
- xml->ordered = o;
-
- for (i = 0; ! p && root->pi[i]; i++) { // post-root processing instructions
- for (k = 2; root->pi[i][k - 1]; k++);
- for (j = 1; (n = root->pi[i][j]); j++) {
- if (root->pi[i][k][j - 1] == '<') continue; // not post-root
- while (len + strlen(t = root->pi[i][0]) + strlen(n) + 7 > max)
- s = realloc(s, max += EZXML_BUFSIZE);
- len += sprintf(s + len, "</font>
<font color="red"><?%s%s%s?>", t, *n ? " " : "", n);
- }
- }
- return realloc(s, len + 1);
-}
-
-// free the memory allocated for the ezxml structure
-void ezxml_free(ezxml_t xml)
-{
- ezxml_root_t root = (ezxml_root_t)xml;
- int i, j;
- char **a, *s;
-
- if (! xml) return;
- ezxml_free(xml->child);
- ezxml_free(xml->ordered);
-
- if (! xml->parent) { // free root tag allocations
- for (i = 10; root->ent[i]; i += 2) // 0 - 9 are default entites (<>&"')
- if ((s = root->ent[i + 1]) < root->s || s > root->e) free(s);
- free(root->ent); // free list of general entities
-
- for (i = 0; (a = root->attr[i]); i++) {
- for (j = 1; a[j++]; j += 2) // free malloced attribute values
- if (a[j] && (a[j] < root->s || a[j] > root->e)) free(a[j]);
- free(a);
- }
- if (root->attr[0]) free(root->attr); // free default attribute list
-
- for (i = 0; root->pi[i]; i++) {
- for (j = 1; root->pi[i][j]; j++);
- free(root->pi[i][j + 1]);
- free(root->pi[i]);
- }
- if (root->pi[0]) free(root->pi); // free processing instructions
-
- if (root->len == -1) free(root->m); // malloced xml data
-#ifndef EZXML_NOMMAP
- else if (root->len) munmap(root->m, root->len); // mem mapped xml data
-#endif // EZXML_NOMMAP
- if (root->u) free(root->u); // utf8 conversion
- }
-
- ezxml_free_attr(xml->attr); // tag attributes
- if ((xml->flags & EZXML_TXTM)) free(xml->txt); // character content
- if ((xml->flags & EZXML_NAMEM)) free(xml->name); // tag name
- free(xml);
-}
-
-// return parser error message or empty string if none
-const char *ezxml_error(ezxml_t xml)
-{
- while (xml && xml->parent) xml = xml->parent; // find root tag
- return (xml) ? ((ezxml_root_t)xml)->err : "";
-}
-
-// returns a new empty ezxml structure with the given root tag name
-ezxml_t ezxml_new(const char *name)
-{
- static char *ent[] = { "lt;", "&#60;", "gt;", "&#62;", "quot;", "&#34;",
- "apos;", "&#39;", "amp;", "&#38;", NULL };
- ezxml_root_t root = (ezxml_root_t)memset(malloc(sizeof(struct ezxml_root)),
- '\0', sizeof(struct ezxml_root));
- root->xml.name = (char *)name;
- root->cur = &root->xml;
- strcpy(root->err, root->xml.txt = "");
- root->ent = memcpy(malloc(sizeof(ent)), ent, sizeof(ent));
- root->attr = root->pi = (char ***)(root->xml.attr = EZXML_NIL);
- return &root->xml;
-}
-
-// inserts an existing tag into an ezxml structure
-ezxml_t ezxml_insert(ezxml_t xml, ezxml_t dest, size_t off)
-{
- ezxml_t cur, prev, head;
-
- xml->next = xml->sibling = xml->ordered = NULL;
- xml->off = off;
- xml->parent = dest;
-
- if ((head = dest->child)) { // already have sub tags
- if (head->off <= off) { // not first subtag
- for (cur = head; cur->ordered && cur->ordered->off <= off;
- cur = cur->ordered);
- xml->ordered = cur->ordered;
- cur->ordered = xml;
- }
- else { // first subtag
- xml->ordered = head;
- dest->child = xml;
- }
-
- for (cur = head, prev = NULL; cur && strcmp(cur->name, xml->name);
- prev = cur, cur = cur->sibling); // find tag type
- if (cur && cur->off <= off) { // not first of type
- while (cur->next && cur->next->off <= off) cur = cur->next;
- xml->next = cur->next;
- cur->next = xml;
- }
- else { // first tag of this type
- if (prev && cur) prev->sibling = cur->sibling; // remove old first
- xml->next = cur; // old first tag is now next
- for (cur = head, prev = NULL; cur && cur->off <= off;
- prev = cur, cur = cur->sibling); // new sibling insert point
- xml->sibling = cur;
- if (prev) prev->sibling = xml;
- }
- }
- else dest->child = xml; // only sub tag
-
- return xml;
-}
-
-// Adds a child tag. off is the offset of the child tag relative to the start
-// of the parent tag's character content. Returns the child tag.
-ezxml_t ezxml_add_child(ezxml_t xml, const char *name, size_t off)
-{
- ezxml_t child;
-
- if (! xml) return NULL;
- child = (ezxml_t)memset(malloc(sizeof(struct ezxml)), '\0',
- sizeof(struct ezxml));
- child->name = (char *)name;
- child->attr = EZXML_NIL;
- child->txt = "";
-
- return ezxml_insert(child, xml, off);
-}
-
-// sets the character content for the given tag and returns the tag
-ezxml_t ezxml_set_txt(ezxml_t xml, const char *txt)
-{
- if (! xml) return NULL;
- if (xml->flags & EZXML_TXTM) free(xml->txt); // existing txt was malloced
- xml->flags &= ~EZXML_TXTM;
- xml->txt = (char *)txt;
- return xml;
-}
-
-// Sets the given tag attribute or adds a new attribute if not found. A value
-// of NULL will remove the specified attribute. Returns the tag given.
-ezxml_t ezxml_set_attr(ezxml_t xml, const char *name, const char *value)
-{
- int l = 0, c;
-
- if (! xml) return NULL;
- while (xml->attr[l] && strcmp(xml->attr[l], name)) l += 2;
- if (! xml->attr[l]) { // not found, add as new attribute
- if (! value) return xml; // nothing to do
- if (xml->attr == EZXML_NIL) { // first attribute
- xml->attr = malloc(4 * sizeof(char *));
- xml->attr[1] = strdup(""); // empty list of malloced names/vals
- }
- else xml->attr = realloc(xml->attr, (l + 4) * sizeof(char *));
-
- xml->attr[l] = (char *)name; // set attribute name
- xml->attr[l + 2] = NULL; // null terminate attribute list
- xml->attr[l + 3] = realloc(xml->attr[l + 1],
- (c = strlen(xml->attr[l + 1])) + 2);
- strcpy(xml->attr[l + 3] + c, " "); // set name/value as not malloced
- if (xml->flags & EZXML_DUP) xml->attr[l + 3][c] = EZXML_NAMEM;
- }
- else if (xml->flags & EZXML_DUP) free((char *)name); // name was strduped
-
- for (c = l; xml->attr[c]; c += 2); // find end of attribute list
- if (xml->attr[c + 1][l / 2] & EZXML_TXTM) free(xml->attr[l + 1]); //old val
- if (xml->flags & EZXML_DUP) xml->attr[c + 1][l / 2] |= EZXML_TXTM;
- else xml->attr[c + 1][l / 2] &= ~EZXML_TXTM;
-
- if (value) xml->attr[l + 1] = (char *)value; // set attribute value
- else { // remove attribute
- if (xml->attr[c + 1][l / 2] & EZXML_NAMEM) free(xml->attr[l]);
- memmove(xml->attr + l, xml->attr + l + 2, (c - l + 2) * sizeof(char*));
- xml->attr = realloc(xml->attr, (c + 2) * sizeof(char *));
- memmove(xml->attr[c + 1] + (l / 2), xml->attr[c + 1] + (l / 2) + 1,
- (c / 2) - (l / 2)); // fix list of which name/vals are malloced
- }
- xml->flags &= ~EZXML_DUP; // clear strdup() flag
- return xml;
-}
-
-// sets a flag for the given tag and returns the tag
-ezxml_t ezxml_set_flag(ezxml_t xml, short flag)
-{
- if (xml) xml->flags |= flag;
- return xml;
-}
-
-// removes a tag along with its subtags without freeing its memory
-ezxml_t ezxml_cut(ezxml_t xml)
-{
- ezxml_t cur;
-
- if (! xml) return NULL; // nothing to do
- if (xml->next) xml->next->sibling = xml->sibling; // patch sibling list
-
- if (xml->parent) { // not root tag
- cur = xml->parent->child; // find head of subtag list
- if (cur == xml) xml->parent->child = xml->ordered; // first subtag
- else { // not first subtag
- while (cur->ordered != xml) cur = cur->ordered;
- cur->ordered = cur->ordered->ordered; // patch ordered list
-
- cur = xml->parent->child; // go back to head of subtag list
- if (strcmp(cur->name, xml->name)) { // not in first sibling list
- while (strcmp(cur->sibling->name, xml->name))
- cur = cur->sibling;
- if (cur->sibling == xml) { // first of a sibling list
- cur->sibling = (xml->next) ? xml->next
- : cur->sibling->sibling;
- }
- else cur = cur->sibling; // not first of a sibling list
- }
-
- while (cur->next && cur->next != xml) cur = cur->next;
- if (cur->next) cur->next = cur->next->next; // patch next list
- }
- }
- xml->ordered = xml->sibling = xml->next = NULL;
- return xml;
-}
-
-#ifdef EZXML_TEST // test harness
-int main(int argc, char **argv)
-{
- ezxml_t xml;
- char *s;
- int i;
-
- if (argc != 2) return fprintf(stderr, "usage: %s xmlfile</font>
<font color="red">", argv[0]);
-
- xml = ezxml_parse_file(argv[1]);
- printf("%s</font>
<font color="gray">", (s = ezxml_toxml(xml)));
- free(s);
- i = fprintf(stderr, "%s", ezxml_error(xml));
- ezxml_free(xml);
- return (i) ? 1 : 0;
-}
-#endif // EZXML_TEST
Copied: branches/atmos_physics/src/registry/ezxml/ezxml.c (from rev 2666, trunk/mpas/src/registry/ezxml/ezxml.c)
===================================================================
--- branches/atmos_physics/src/registry/ezxml/ezxml.c (rev 0)
+++ branches/atmos_physics/src/registry/ezxml/ezxml.c 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,1015 @@
+/* ezxml.c
+ *
+ * Copyright 2004-2006 Aaron Voisine <aaron@voisine.org>
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining
+ * a copy of this software and associated documentation files (the
+ * "Software"), to deal in the Software without restriction, including
+ * without limitation the rights to use, copy, modify, merge, publish,
+ * distribute, sublicense, and/or sell copies of the Software, and to
+ * permit persons to whom the Software is furnished to do so, subject to
+ * the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included
+ * in all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+ * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <string.h>
+#include <ctype.h>
+#include <unistd.h>
+#include <sys/types.h>
+#ifndef EZXML_NOMMAP
+#include <sys/mman.h>
+#endif // EZXML_NOMMAP
+#include <sys/stat.h>
+#include "ezxml.h"
+
+#define EZXML_WS "\t\r</font>
<font color="blue"> " // whitespace
+#define EZXML_ERRL 128 // maximum error string length
+
+typedef struct ezxml_root *ezxml_root_t;
+struct ezxml_root { // additional data for the root tag
+ struct ezxml xml; // is a super-struct built on top of ezxml struct
+ ezxml_t cur; // current xml tree insertion point
+ char *m; // original xml string
+ size_t len; // length of allocated memory for mmap, -1 for malloc
+ char *u; // UTF-8 conversion of string if original was UTF-16
+ char *s; // start of work area
+ char *e; // end of work area
+ char **ent; // general entities (ampersand sequences)
+ char ***attr; // default attributes
+ char ***pi; // processing instructions
+ short standalone; // non-zero if <?xml standalone="yes"?>
+ char err[EZXML_ERRL]; // error string
+};
+
+char *EZXML_NIL[] = { NULL }; // empty, null terminated array of strings
+
+// returns the first child tag with the given name or NULL if not found
+ezxml_t ezxml_child(ezxml_t xml, const char *name)
+{
+ xml = (xml) ? xml->child : NULL;
+ while (xml && strcmp(name, xml->name)) xml = xml->sibling;
+ return xml;
+}
+
+// returns the Nth tag with the same name in the same subsection or NULL if not
+// found
+ezxml_t ezxml_idx(ezxml_t xml, int idx)
+{
+ for (; xml && idx; idx--) xml = xml->next;
+ return xml;
+}
+
+// returns the value of the requested tag attribute or NULL if not found
+const char *ezxml_attr(ezxml_t xml, const char *attr)
+{
+ int i = 0, j = 1;
+ ezxml_root_t root = (ezxml_root_t)xml;
+
+ if (! xml || ! xml->attr) return NULL;
+ while (xml->attr[i] && strcmp(attr, xml->attr[i])) i += 2;
+ if (xml->attr[i]) return xml->attr[i + 1]; // found attribute
+
+ while (root->xml.parent) root = (ezxml_root_t)root->xml.parent; // root tag
+ for (i = 0; root->attr[i] && strcmp(xml->name, root->attr[i][0]); i++);
+ if (! root->attr[i]) return NULL; // no matching default attributes
+ while (root->attr[i][j] && strcmp(attr, root->attr[i][j])) j += 3;
+ return (root->attr[i][j]) ? root->attr[i][j + 1] : NULL; // found default
+}
+
+// same as ezxml_get but takes an already initialized va_list
+ezxml_t ezxml_vget(ezxml_t xml, va_list ap)
+{
+ char *name = va_arg(ap, char *);
+ int idx = -1;
+
+ if (name && *name) {
+ idx = va_arg(ap, int);
+ xml = ezxml_child(xml, name);
+ }
+ return (idx < 0) ? xml : ezxml_vget(ezxml_idx(xml, idx), ap);
+}
+
+// Traverses the xml tree to retrieve a specific subtag. Takes a variable
+// length list of tag names and indexes. The argument list must be terminated
+// by either an index of -1 or an empty string tag name. Example:
+// title = ezxml_get(library, "shelf", 0, "book", 2, "title", -1);
+// This retrieves the title of the 3rd book on the 1st shelf of library.
+// Returns NULL if not found.
+ezxml_t ezxml_get(ezxml_t xml, ...)
+{
+ va_list ap;
+ ezxml_t r;
+
+ va_start(ap, xml);
+ r = ezxml_vget(xml, ap);
+ va_end(ap);
+ return r;
+}
+
+// returns a null terminated array of processing instructions for the given
+// target
+const char **ezxml_pi(ezxml_t xml, const char *target)
+{
+ ezxml_root_t root = (ezxml_root_t)xml;
+ int i = 0;
+
+ if (! root) return (const char **)EZXML_NIL;
+ while (root->xml.parent) root = (ezxml_root_t)root->xml.parent; // root tag
+ while (root->pi[i] && strcmp(target, root->pi[i][0])) i++; // find target
+ return (const char **)((root->pi[i]) ? root->pi[i] + 1 : EZXML_NIL);
+}
+
+// set an error string and return root
+ezxml_t ezxml_err(ezxml_root_t root, char *s, const char *err, ...)
+{
+ va_list ap;
+ int line = 1;
+ char *t, fmt[EZXML_ERRL];
+
+ for (t = root->s; t < s; t++) if (*t == '</font>
<font color="blue">') line++;
+ snprintf(fmt, EZXML_ERRL, "[error near line %d]: %s", line, err);
+
+ va_start(ap, err);
+ vsnprintf(root->err, EZXML_ERRL, fmt, ap);
+ va_end(ap);
+
+ return &root->xml;
+}
+
+// Recursively decodes entity and character references and normalizes new lines
+// ent is a null terminated array of alternating entity names and values. set t
+// to '&' for general entity decoding, '%' for parameter entity decoding, 'c'
+// for cdata sections, ' ' for attribute normalization, or '*' for non-cdata
+// attribute normalization. Returns s, or if the decoded string is longer than
+// s, returns a malloced string that must be freed.
+char *ezxml_decode(char *s, char **ent, char t)
+{
+ char *e, *r = s, *m = s;
+ long b, c, d, l;
+
+ for (; *s; s++) { // normalize line endings
+ while (*s == '\r') {
+ *(s++) = '</font>
<font color="blue">';
+ if (*s == '</font>
<font color="blue">') memmove(s, (s + 1), strlen(s));
+ }
+ }
+
+ for (s = r; ; ) {
+ while (*s && *s != '&' && (*s != '%' || t != '%') && !isspace(*s)) s++;
+
+ if (! *s) break;
+ else if (t != 'c' && ! strncmp(s, "&#", 2)) { // character reference
+ if (s[2] == 'x') c = strtol(s + 3, &e, 16); // base 16
+ else c = strtol(s + 2, &e, 10); // base 10
+ if (! c || *e != ';') { s++; continue; } // not a character ref
+
+ if (c < 0x80) *(s++) = c; // US-ASCII subset
+ else { // multi-byte UTF-8 sequence
+ for (b = 0, d = c; d; d /= 2) b++; // number of bits in c
+ b = (b - 2) / 5; // number of bytes in payload
+ *(s++) = (0xFF << (7 - b)) | (c >> (6 * b)); // head
+ while (b) *(s++) = 0x80 | ((c >> (6 * --b)) & 0x3F); // payload
+ }
+
+ memmove(s, strchr(s, ';') + 1, strlen(strchr(s, ';')));
+ }
+ else if ((*s == '&' && (t == '&' || t == ' ' || t == '*')) ||
+ (*s == '%' && t == '%')) { // entity reference
+ for (b = 0; ent[b] && strncmp(s + 1, ent[b], strlen(ent[b]));
+ b += 2); // find entity in entity list
+
+ if (ent[b++]) { // found a match
+ if ((c = strlen(ent[b])) - 1 > (e = strchr(s, ';')) - s) {
+ l = (d = (s - r)) + c + strlen(e); // new length
+ r = (r == m) ? strcpy(malloc(l), r) : realloc(r, l);
+ e = strchr((s = r + d), ';'); // fix up pointers
+ }
+
+ memmove(s + c, e + 1, strlen(e)); // shift rest of string
+ strncpy(s, ent[b], c); // copy in replacement text
+ }
+ else s++; // not a known entity
+ }
+ else if ((t == ' ' || t == '*') && isspace(*s)) *(s++) = ' ';
+ else s++; // no decoding needed
+ }
+
+ if (t == '*') { // normalize spaces for non-cdata attributes
+ for (s = r; *s; s++) {
+ if ((l = strspn(s, " "))) memmove(s, s + l, strlen(s + l) + 1);
+ while (*s && *s != ' ') s++;
+ }
+ if (--s >= r && *s == ' ') *s = '\0'; // trim any trailing space
+ }
+ return r;
+}
+
+// called when parser finds start of new tag
+void ezxml_open_tag(ezxml_root_t root, char *name, char **attr)
+{
+ ezxml_t xml = root->cur;
+
+ if (xml->name) xml = ezxml_add_child(xml, name, strlen(xml->txt));
+ else xml->name = name; // first open tag
+
+ xml->attr = attr;
+ root->cur = xml; // update tag insertion point
+}
+
+// called when parser finds character content between open and closing tag
+void ezxml_char_content(ezxml_root_t root, char *s, size_t len, char t)
+{
+ ezxml_t xml = root->cur;
+ char *m = s;
+ size_t l;
+
+ if (! xml || ! xml->name || ! len) return; // sanity check
+
+ s[len] = '\0'; // null terminate text (calling functions anticipate this)
+ len = strlen(s = ezxml_decode(s, root->ent, t)) + 1;
+
+ if (! *(xml->txt)) xml->txt = s; // initial character content
+ else { // allocate our own memory and make a copy
+ xml->txt = (xml->flags & EZXML_TXTM) // allocate some space
+ ? realloc(xml->txt, (l = strlen(xml->txt)) + len)
+ : strcpy(malloc((l = strlen(xml->txt)) + len), xml->txt);
+ strcpy(xml->txt + l, s); // add new char content
+ if (s != m) free(s); // free s if it was malloced by ezxml_decode()
+ }
+
+ if (xml->txt != m) ezxml_set_flag(xml, EZXML_TXTM);
+}
+
+// called when parser finds closing tag
+ezxml_t ezxml_close_tag(ezxml_root_t root, char *name, char *s)
+{
+ if (! root->cur || ! root->cur->name || strcmp(name, root->cur->name))
+ return ezxml_err(root, s, "unexpected closing tag </%s>", name);
+
+ root->cur = root->cur->parent;
+ return NULL;
+}
+
+// checks for circular entity references, returns non-zero if no circular
+// references are found, zero otherwise
+int ezxml_ent_ok(char *name, char *s, char **ent)
+{
+ int i;
+
+ for (; ; s++) {
+ while (*s && *s != '&') s++; // find next entity reference
+ if (! *s) return 1;
+ if (! strncmp(s + 1, name, strlen(name))) return 0; // circular ref.
+ for (i = 0; ent[i] && strncmp(ent[i], s + 1, strlen(ent[i])); i += 2);
+ if (ent[i] && ! ezxml_ent_ok(name, ent[i + 1], ent)) return 0;
+ }
+}
+
+// called when the parser finds a processing instruction
+void ezxml_proc_inst(ezxml_root_t root, char *s, size_t len)
+{
+ int i = 0, j = 1;
+ char *target = s;
+
+ s[len] = '\0'; // null terminate instruction
+ if (*(s += strcspn(s, EZXML_WS))) {
+ *s = '\0'; // null terminate target
+ s += strspn(s + 1, EZXML_WS) + 1; // skip whitespace after target
+ }
+
+ if (! strcmp(target, "xml")) { // <?xml ... ?>
+ if ((s = strstr(s, "standalone")) && ! strncmp(s + strspn(s + 10,
+ EZXML_WS "='\"") + 10, "yes", 3)) root->standalone = 1;
+ return;
+ }
+
+ if (! root->pi[0]) *(root->pi = malloc(sizeof(char **))) = NULL; //first pi
+
+ while (root->pi[i] && strcmp(target, root->pi[i][0])) i++; // find target
+ if (! root->pi[i]) { // new target
+ root->pi = realloc(root->pi, sizeof(char **) * (i + 2));
+ root->pi[i] = malloc(sizeof(char *) * 3);
+ root->pi[i][0] = target;
+ root->pi[i][1] = (char *)(root->pi[i + 1] = NULL); // terminate pi list
+ root->pi[i][2] = strdup(""); // empty document position list
+ }
+
+ while (root->pi[i][j]) j++; // find end of instruction list for this target
+ root->pi[i] = realloc(root->pi[i], sizeof(char *) * (j + 3));
+ root->pi[i][j + 2] = realloc(root->pi[i][j + 1], j + 1);
+ strcpy(root->pi[i][j + 2] + j - 1, (root->xml.name) ? ">" : "<");
+ root->pi[i][j + 1] = NULL; // null terminate pi list for this target
+ root->pi[i][j] = s; // set instruction
+}
+
+// called when the parser finds an internal doctype subset
+short ezxml_internal_dtd(ezxml_root_t root, char *s, size_t len)
+{
+ char q, *c, *t, *n = NULL, *v, **ent, **pe;
+ int i, j;
+
+ pe = memcpy(malloc(sizeof(EZXML_NIL)), EZXML_NIL, sizeof(EZXML_NIL));
+
+ for (s[len] = '\0'; s; ) {
+ while (*s && *s != '<' && *s != '%') s++; // find next declaration
+
+ if (! *s) break;
+ else if (! strncmp(s, "<!ENTITY", 8)) { // parse entity definitions
+ c = s += strspn(s + 8, EZXML_WS) + 8; // skip white space separator
+ n = s + strspn(s, EZXML_WS "%"); // find name
+ *(s = n + strcspn(n, EZXML_WS)) = ';'; // append ; to name
+
+ v = s + strspn(s + 1, EZXML_WS) + 1; // find value
+ if ((q = *(v++)) != '"' && q != '\'') { // skip externals
+ s = strchr(s, '>');
+ continue;
+ }
+
+ for (i = 0, ent = (*c == '%') ? pe : root->ent; ent[i]; i++);
+ ent = realloc(ent, (i + 3) * sizeof(char *)); // space for next ent
+ if (*c == '%') pe = ent;
+ else root->ent = ent;
+
+ *(++s) = '\0'; // null terminate name
+ if ((s = strchr(v, q))) *(s++) = '\0'; // null terminate value
+ ent[i + 1] = ezxml_decode(v, pe, '%'); // set value
+ ent[i + 2] = NULL; // null terminate entity list
+ if (! ezxml_ent_ok(n, ent[i + 1], ent)) { // circular reference
+ if (ent[i + 1] != v) free(ent[i + 1]);
+ ezxml_err(root, v, "circular entity declaration &%s", n);
+ break;
+ }
+ else ent[i] = n; // set entity name
+ }
+ else if (! strncmp(s, "<!ATTLIST", 9)) { // parse default attributes
+ t = s + strspn(s + 9, EZXML_WS) + 9; // skip whitespace separator
+ if (! *t) { ezxml_err(root, t, "unclosed <!ATTLIST"); break; }
+ if (*(s = t + strcspn(t, EZXML_WS ">")) == '>') continue;
+ else *s = '\0'; // null terminate tag name
+ for (i = 0; root->attr[i] && strcmp(n, root->attr[i][0]); i++);
+
+ while (*(n = ++s + strspn(s, EZXML_WS)) && *n != '>') {
+ if (*(s = n + strcspn(n, EZXML_WS))) *s = '\0'; // attr name
+ else { ezxml_err(root, t, "malformed <!ATTLIST"); break; }
+
+ s += strspn(s + 1, EZXML_WS) + 1; // find next token
+ c = (strncmp(s, "CDATA", 5)) ? "*" : " "; // is it cdata?
+ if (! strncmp(s, "NOTATION", 8))
+ s += strspn(s + 8, EZXML_WS) + 8;
+ s = (*s == '(') ? strchr(s, ')') : s + strcspn(s, EZXML_WS);
+ if (! s) { ezxml_err(root, t, "malformed <!ATTLIST"); break; }
+
+ s += strspn(s, EZXML_WS ")"); // skip white space separator
+ if (! strncmp(s, "#FIXED", 6))
+ s += strspn(s + 6, EZXML_WS) + 6;
+ if (*s == '#') { // no default value
+ s += strcspn(s, EZXML_WS ">") - 1;
+ if (*c == ' ') continue; // cdata is default, nothing to do
+ v = NULL;
+ }
+ else if ((*s == '"' || *s == '\'') && // default value
+ (s = strchr(v = s + 1, *s))) *s = '\0';
+ else { ezxml_err(root, t, "malformed <!ATTLIST"); break; }
+
+ if (! root->attr[i]) { // new tag name
+ root->attr = (! i) ? malloc(2 * sizeof(char **))
+ : realloc(root->attr,
+ (i + 2) * sizeof(char **));
+ root->attr[i] = malloc(2 * sizeof(char *));
+ root->attr[i][0] = t; // set tag name
+ root->attr[i][1] = (char *)(root->attr[i + 1] = NULL);
+ }
+
+ for (j = 1; root->attr[i][j]; j += 3); // find end of list
+ root->attr[i] = realloc(root->attr[i],
+ (j + 4) * sizeof(char *));
+
+ root->attr[i][j + 3] = NULL; // null terminate list
+ root->attr[i][j + 2] = c; // is it cdata?
+ root->attr[i][j + 1] = (v) ? ezxml_decode(v, root->ent, *c)
+ : NULL;
+ root->attr[i][j] = n; // attribute name
+ }
+ }
+ else if (! strncmp(s, "<!--", 4)) s = strstr(s + 4, "-->"); // comments
+ else if (! strncmp(s, "<?", 2)) { // processing instructions
+ if ((s = strstr(c = s + 2, "?>")))
+ ezxml_proc_inst(root, c, s++ - c);
+ }
+ else if (*s == '<') s = strchr(s, '>'); // skip other declarations
+ else if (*(s++) == '%' && ! root->standalone) break;
+ }
+
+ free(pe);
+ return ! *root->err;
+}
+
+// Converts a UTF-16 string to UTF-8. Returns a new string that must be freed
+// or NULL if no conversion was needed.
+char *ezxml_str2utf8(char **s, size_t *len)
+{
+ char *u;
+ size_t l = 0, sl, max = *len;
+ long c, d;
+ int b, be = (**s == '\xFE') ? 1 : (**s == '\xFF') ? 0 : -1;
+
+ if (be == -1) return NULL; // not UTF-16
+
+ u = malloc(max);
+ for (sl = 2; sl < *len - 1; sl += 2) {
+ c = (be) ? (((*s)[sl] & 0xFF) << 8) | ((*s)[sl + 1] & 0xFF) //UTF-16BE
+ : (((*s)[sl + 1] & 0xFF) << 8) | ((*s)[sl] & 0xFF); //UTF-16LE
+ if (c >= 0xD800 && c <= 0xDFFF && (sl += 2) < *len - 1) { // high-half
+ d = (be) ? (((*s)[sl] & 0xFF) << 8) | ((*s)[sl + 1] & 0xFF)
+ : (((*s)[sl + 1] & 0xFF) << 8) | ((*s)[sl] & 0xFF);
+ c = (((c & 0x3FF) << 10) | (d & 0x3FF)) + 0x10000;
+ }
+
+ while (l + 6 > max) u = realloc(u, max += EZXML_BUFSIZE);
+ if (c < 0x80) u[l++] = c; // US-ASCII subset
+ else { // multi-byte UTF-8 sequence
+ for (b = 0, d = c; d; d /= 2) b++; // bits in c
+ b = (b - 2) / 5; // bytes in payload
+ u[l++] = (0xFF << (7 - b)) | (c >> (6 * b)); // head
+ while (b) u[l++] = 0x80 | ((c >> (6 * --b)) & 0x3F); // payload
+ }
+ }
+ return *s = realloc(u, *len = l);
+}
+
+// frees a tag attribute list
+void ezxml_free_attr(char **attr) {
+ int i = 0;
+ char *m;
+
+ if (! attr || attr == EZXML_NIL) return; // nothing to free
+ while (attr[i]) i += 2; // find end of attribute list
+ m = attr[i + 1]; // list of which names and values are malloced
+ for (i = 0; m[i]; i++) {
+ if (m[i] & EZXML_NAMEM) free(attr[i * 2]);
+ if (m[i] & EZXML_TXTM) free(attr[(i * 2) + 1]);
+ }
+ free(m);
+ free(attr);
+}
+
+// parse the given xml string and return an ezxml structure
+ezxml_t ezxml_parse_str(char *s, size_t len)
+{
+ ezxml_root_t root = (ezxml_root_t)ezxml_new(NULL);
+ char q, e, *d, **attr, **a = NULL; // initialize a to avoid compile warning
+ int l, i, j;
+
+ root->m = s;
+ if (! len) return ezxml_err(root, NULL, "root tag missing");
+ root->u = ezxml_str2utf8(&s, &len); // convert utf-16 to utf-8
+ root->e = (root->s = s) + len; // record start and end of work area
+
+ e = s[len - 1]; // save end char
+ s[len - 1] = '\0'; // turn end char into null terminator
+
+ while (*s && *s != '<') s++; // find first tag
+ if (! *s) return ezxml_err(root, s, "root tag missing");
+
+ for (; ; ) {
+ attr = (char **)EZXML_NIL;
+ d = ++s;
+
+ if (isalpha(*s) || *s == '_' || *s == ':' || *s < '\0') { // new tag
+ if (! root->cur)
+ return ezxml_err(root, d, "markup outside of root element");
+
+ s += strcspn(s, EZXML_WS "/>");
+ while (isspace(*s)) *(s++) = '\0'; // null terminate tag name
+
+ if (*s && *s != '/' && *s != '>') // find tag in default attr list
+ for (i = 0; (a = root->attr[i]) && strcmp(a[0], d); i++);
+
+ for (l = 0; *s && *s != '/' && *s != '>'; l += 2) { // new attrib
+ attr = (l) ? realloc(attr, (l + 4) * sizeof(char *))
+ : malloc(4 * sizeof(char *)); // allocate space
+ attr[l + 3] = (l) ? realloc(attr[l + 1], (l / 2) + 2)
+ : malloc(2); // mem for list of maloced vals
+ strcpy(attr[l + 3] + (l / 2), " "); // value is not malloced
+ attr[l + 2] = NULL; // null terminate list
+ attr[l + 1] = ""; // temporary attribute value
+ attr[l] = s; // set attribute name
+
+ s += strcspn(s, EZXML_WS "=/>");
+ if (*s == '=' || isspace(*s)) {
+ *(s++) = '\0'; // null terminate tag attribute name
+ q = *(s += strspn(s, EZXML_WS "="));
+ if (q == '"' || q == '\'') { // attribute value
+ attr[l + 1] = ++s;
+ while (*s && *s != q) s++;
+ if (*s) *(s++) = '\0'; // null terminate attribute val
+ else {
+ ezxml_free_attr(attr);
+ return ezxml_err(root, d, "missing %c", q);
+ }
+
+ for (j = 1; a && a[j] && strcmp(a[j], attr[l]); j +=3);
+ attr[l + 1] = ezxml_decode(attr[l + 1], root->ent, (a
+ && a[j]) ? *a[j + 2] : ' ');
+ if (attr[l + 1] < d || attr[l + 1] > s)
+ attr[l + 3][l / 2] = EZXML_TXTM; // value malloced
+ }
+ }
+ while (isspace(*s)) s++;
+ }
+
+ if (*s == '/') { // self closing tag
+ *(s++) = '\0';
+ if ((*s && *s != '>') || (! *s && e != '>')) {
+ if (l) ezxml_free_attr(attr);
+ return ezxml_err(root, d, "missing >");
+ }
+ ezxml_open_tag(root, d, attr);
+ ezxml_close_tag(root, d, s);
+ }
+ else if ((q = *s) == '>' || (! *s && e == '>')) { // open tag
+ *s = '\0'; // temporarily null terminate tag name
+ ezxml_open_tag(root, d, attr);
+ *s = q;
+ }
+ else {
+ if (l) ezxml_free_attr(attr);
+ return ezxml_err(root, d, "missing >");
+ }
+ }
+ else if (*s == '/') { // close tag
+ s += strcspn(d = s + 1, EZXML_WS ">") + 1;
+ if (! (q = *s) && e != '>') return ezxml_err(root, d, "missing >");
+ *s = '\0'; // temporarily null terminate tag name
+ if (ezxml_close_tag(root, d, s)) return &root->xml;
+ if (isspace(*s = q)) s += strspn(s, EZXML_WS);
+ }
+ else if (! strncmp(s, "!--", 3)) { // xml comment
+ if (! (s = strstr(s + 3, "--")) || (*(s += 2) != '>' && *s) ||
+ (! *s && e != '>')) return ezxml_err(root, d, "unclosed <!--");
+ }
+ else if (! strncmp(s, "![CDATA[", 8)) { // cdata
+ if ((s = strstr(s, "]]>")))
+ ezxml_char_content(root, d + 8, (s += 2) - d - 10, 'c');
+ else return ezxml_err(root, d, "unclosed <![CDATA[");
+ }
+ else if (! strncmp(s, "!DOCTYPE", 8)) { // dtd
+ for (l = 0; *s && ((! l && *s != '>') || (l && (*s != ']' ||
+ *(s + strspn(s + 1, EZXML_WS) + 1) != '>')));
+ l = (*s == '[') ? 1 : l) s += strcspn(s + 1, "[]>") + 1;
+ if (! *s && e != '>')
+ return ezxml_err(root, d, "unclosed <!DOCTYPE");
+ d = (l) ? strchr(d, '[') + 1 : d;
+ if (l && ! ezxml_internal_dtd(root, d, s++ - d)) return &root->xml;
+ }
+ else if (*s == '?') { // <?...?> processing instructions
+ do { s = strchr(s, '?'); } while (s && *(++s) && *s != '>');
+ if (! s || (! *s && e != '>'))
+ return ezxml_err(root, d, "unclosed <?");
+ else ezxml_proc_inst(root, d + 1, s - d - 2);
+ }
+ else return ezxml_err(root, d, "unexpected <");
+
+ if (! s || ! *s) break;
+ *s = '\0';
+ d = ++s;
+ if (*s && *s != '<') { // tag character content
+ while (*s && *s != '<') s++;
+ if (*s) ezxml_char_content(root, d, s - d, '&');
+ else break;
+ }
+ else if (! *s) break;
+ }
+
+ if (! root->cur) return &root->xml;
+ else if (! root->cur->name) return ezxml_err(root, d, "root tag missing");
+ else return ezxml_err(root, d, "unclosed tag <%s>", root->cur->name);
+}
+
+// Wrapper for ezxml_parse_str() that accepts a file stream. Reads the entire
+// stream into memory and then parses it. For xml files, use ezxml_parse_file()
+// or ezxml_parse_fd()
+ezxml_t ezxml_parse_fp(FILE *fp)
+{
+ ezxml_root_t root;
+ size_t l, len = 0;
+ char *s;
+
+ if (! (s = malloc(EZXML_BUFSIZE))) return NULL;
+ do {
+ len += (l = fread((s + len), 1, EZXML_BUFSIZE, fp));
+ if (l == EZXML_BUFSIZE) s = realloc(s, len + EZXML_BUFSIZE);
+ } while (s && l == EZXML_BUFSIZE);
+
+ if (! s) return NULL;
+ root = (ezxml_root_t)ezxml_parse_str(s, len);
+ root->len = -1; // so we know to free s in ezxml_free()
+ return &root->xml;
+}
+
+// A wrapper for ezxml_parse_str() that accepts a file descriptor. First
+// attempts to mem map the file. Failing that, reads the file into memory.
+// Returns NULL on failure.
+ezxml_t ezxml_parse_fd(int fd)
+{
+ ezxml_root_t root;
+ struct stat st;
+ size_t l;
+ void *m;
+
+ if (fd < 0) return NULL;
+ fstat(fd, &st);
+
+#ifndef EZXML_NOMMAP
+ l = (st.st_size + sysconf(_SC_PAGESIZE) - 1) & ~(sysconf(_SC_PAGESIZE) -1);
+ if ((m = mmap(NULL, l, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0)) !=
+ MAP_FAILED) {
+ madvise(m, l, MADV_SEQUENTIAL); // optimize for sequential access
+ root = (ezxml_root_t)ezxml_parse_str(m, st.st_size);
+ madvise(m, root->len = l, MADV_NORMAL); // put it back to normal
+ }
+ else { // mmap failed, read file into memory
+#endif // EZXML_NOMMAP
+ l = read(fd, m = malloc(st.st_size), st.st_size);
+ root = (ezxml_root_t)ezxml_parse_str(m, l);
+ root->len = -1; // so we know to free s in ezxml_free()
+#ifndef EZXML_NOMMAP
+ }
+#endif // EZXML_NOMMAP
+ return &root->xml;
+}
+
+// a wrapper for ezxml_parse_fd that accepts a file name
+ezxml_t ezxml_parse_file(const char *file)
+{
+ int fd = open(file, O_RDONLY, 0);
+ ezxml_t xml = ezxml_parse_fd(fd);
+
+ if (fd >= 0) close(fd);
+ return xml;
+}
+
+// Encodes ampersand sequences appending the results to *dst, reallocating *dst
+// if length excedes max. a is non-zero for attribute encoding. Returns *dst
+char *ezxml_ampencode(const char *s, size_t len, char **dst, size_t *dlen,
+ size_t *max, short a)
+{
+ const char *e;
+
+ for (e = s + len; s != e; s++) {
+ while (*dlen + 10 > *max) *dst = realloc(*dst, *max += EZXML_BUFSIZE);
+
+ switch (*s) {
+ case '\0': return *dst;
+ case '&': *dlen += sprintf(*dst + *dlen, "&amp;"); break;
+ case '<': *dlen += sprintf(*dst + *dlen, "&lt;"); break;
+ case '>': *dlen += sprintf(*dst + *dlen, "&gt;"); break;
+ case '"': *dlen += sprintf(*dst + *dlen, (a) ? "&quot;" : "\""); break;
+ case '</font>
<font color="black">': *dlen += sprintf(*dst + *dlen, (a) ? "&#xA;" : "</font>
<font color="blue">"); break;
+ case '\t': *dlen += sprintf(*dst + *dlen, (a) ? "&#x9;" : "\t"); break;
+ case '\r': *dlen += sprintf(*dst + *dlen, "&#xD;"); break;
+ default: (*dst)[(*dlen)++] = *s;
+ }
+ }
+ return *dst;
+}
+
+// Recursively converts each tag to xml appending it to *s. Reallocates *s if
+// its length excedes max. start is the location of the previous tag in the
+// parent tag's character content. Returns *s.
+char *ezxml_toxml_r(ezxml_t xml, char **s, size_t *len, size_t *max,
+ size_t start, char ***attr)
+{
+ int i, j;
+ char *txt = (xml->parent) ? xml->parent->txt : "";
+ size_t off = 0;
+
+ // parent character content up to this tag
+ *s = ezxml_ampencode(txt + start, xml->off - start, s, len, max, 0);
+
+ while (*len + strlen(xml->name) + 4 > *max) // reallocate s
+ *s = realloc(*s, *max += EZXML_BUFSIZE);
+
+ *len += sprintf(*s + *len, "<%s", xml->name); // open tag
+ for (i = 0; xml->attr[i]; i += 2) { // tag attributes
+ if (ezxml_attr(xml, xml->attr[i]) != xml->attr[i + 1]) continue;
+ while (*len + strlen(xml->attr[i]) + 7 > *max) // reallocate s
+ *s = realloc(*s, *max += EZXML_BUFSIZE);
+
+ *len += sprintf(*s + *len, " %s=\"", xml->attr[i]);
+ ezxml_ampencode(xml->attr[i + 1], -1, s, len, max, 1);
+ *len += sprintf(*s + *len, "\"");
+ }
+
+ for (i = 0; attr[i] && strcmp(attr[i][0], xml->name); i++);
+ for (j = 1; attr[i] && attr[i][j]; j += 3) { // default attributes
+ if (! attr[i][j + 1] || ezxml_attr(xml, attr[i][j]) != attr[i][j + 1])
+ continue; // skip duplicates and non-values
+ while (*len + strlen(attr[i][j]) + 7 > *max) // reallocate s
+ *s = realloc(*s, *max += EZXML_BUFSIZE);
+
+ *len += sprintf(*s + *len, " %s=\"", attr[i][j]);
+ ezxml_ampencode(attr[i][j + 1], -1, s, len, max, 1);
+ *len += sprintf(*s + *len, "\"");
+ }
+ *len += sprintf(*s + *len, ">");
+
+ *s = (xml->child) ? ezxml_toxml_r(xml->child, s, len, max, 0, attr) //child
+ : ezxml_ampencode(xml->txt, -1, s, len, max, 0); //data
+
+ while (*len + strlen(xml->name) + 4 > *max) // reallocate s
+ *s = realloc(*s, *max += EZXML_BUFSIZE);
+
+ *len += sprintf(*s + *len, "</%s>", xml->name); // close tag
+
+ while (txt[off] && off < xml->off) off++; // make sure off is within bounds
+ return (xml->ordered) ? ezxml_toxml_r(xml->ordered, s, len, max, off, attr)
+ : ezxml_ampencode(txt + off, -1, s, len, max, 0);
+}
+
+// Converts an ezxml structure back to xml. Returns a string of xml data that
+// must be freed.
+char *ezxml_toxml(ezxml_t xml)
+{
+ ezxml_t p = (xml) ? xml->parent : NULL, o = (xml) ? xml->ordered : NULL;
+ ezxml_root_t root = (ezxml_root_t)xml;
+ size_t len = 0, max = EZXML_BUFSIZE;
+ char *s = strcpy(malloc(max), ""), *t, *n;
+ int i, j, k;
+
+ if (! xml || ! xml->name) return realloc(s, len + 1);
+ while (root->xml.parent) root = (ezxml_root_t)root->xml.parent; // root tag
+
+ for (i = 0; ! p && root->pi[i]; i++) { // pre-root processing instructions
+ for (k = 2; root->pi[i][k - 1]; k++);
+ for (j = 1; (n = root->pi[i][j]); j++) {
+ if (root->pi[i][k][j - 1] == '>') continue; // not pre-root
+ while (len + strlen(t = root->pi[i][0]) + strlen(n) + 7 > max)
+ s = realloc(s, max += EZXML_BUFSIZE);
+ len += sprintf(s + len, "<?%s%s%s?></font>
<font color="blue">", t, *n ? " " : "", n);
+ }
+ }
+
+ xml->parent = xml->ordered = NULL;
+ s = ezxml_toxml_r(xml, &s, &len, &max, 0, root->attr);
+ xml->parent = p;
+ xml->ordered = o;
+
+ for (i = 0; ! p && root->pi[i]; i++) { // post-root processing instructions
+ for (k = 2; root->pi[i][k - 1]; k++);
+ for (j = 1; (n = root->pi[i][j]); j++) {
+ if (root->pi[i][k][j - 1] == '<') continue; // not post-root
+ while (len + strlen(t = root->pi[i][0]) + strlen(n) + 7 > max)
+ s = realloc(s, max += EZXML_BUFSIZE);
+ len += sprintf(s + len, "</font>
<font color="blue"><?%s%s%s?>", t, *n ? " " : "", n);
+ }
+ }
+ return realloc(s, len + 1);
+}
+
+// free the memory allocated for the ezxml structure
+void ezxml_free(ezxml_t xml)
+{
+ ezxml_root_t root = (ezxml_root_t)xml;
+ int i, j;
+ char **a, *s;
+
+ if (! xml) return;
+ ezxml_free(xml->child);
+ ezxml_free(xml->ordered);
+
+ if (! xml->parent) { // free root tag allocations
+ for (i = 10; root->ent[i]; i += 2) // 0 - 9 are default entites (<>&"')
+ if ((s = root->ent[i + 1]) < root->s || s > root->e) free(s);
+ free(root->ent); // free list of general entities
+
+ for (i = 0; (a = root->attr[i]); i++) {
+ for (j = 1; a[j++]; j += 2) // free malloced attribute values
+ if (a[j] && (a[j] < root->s || a[j] > root->e)) free(a[j]);
+ free(a);
+ }
+ if (root->attr[0]) free(root->attr); // free default attribute list
+
+ for (i = 0; root->pi[i]; i++) {
+ for (j = 1; root->pi[i][j]; j++);
+ free(root->pi[i][j + 1]);
+ free(root->pi[i]);
+ }
+ if (root->pi[0]) free(root->pi); // free processing instructions
+
+ if (root->len == -1) free(root->m); // malloced xml data
+#ifndef EZXML_NOMMAP
+ else if (root->len) munmap(root->m, root->len); // mem mapped xml data
+#endif // EZXML_NOMMAP
+ if (root->u) free(root->u); // utf8 conversion
+ }
+
+ ezxml_free_attr(xml->attr); // tag attributes
+ if ((xml->flags & EZXML_TXTM)) free(xml->txt); // character content
+ if ((xml->flags & EZXML_NAMEM)) free(xml->name); // tag name
+ free(xml);
+}
+
+// return parser error message or empty string if none
+const char *ezxml_error(ezxml_t xml)
+{
+ while (xml && xml->parent) xml = xml->parent; // find root tag
+ return (xml) ? ((ezxml_root_t)xml)->err : "";
+}
+
+// returns a new empty ezxml structure with the given root tag name
+ezxml_t ezxml_new(const char *name)
+{
+ static char *ent[] = { "lt;", "&#60;", "gt;", "&#62;", "quot;", "&#34;",
+ "apos;", "&#39;", "amp;", "&#38;", NULL };
+ ezxml_root_t root = (ezxml_root_t)memset(malloc(sizeof(struct ezxml_root)),
+ '\0', sizeof(struct ezxml_root));
+ root->xml.name = (char *)name;
+ root->cur = &root->xml;
+ strcpy(root->err, root->xml.txt = "");
+ root->ent = memcpy(malloc(sizeof(ent)), ent, sizeof(ent));
+ root->attr = root->pi = (char ***)(root->xml.attr = EZXML_NIL);
+ return &root->xml;
+}
+
+// inserts an existing tag into an ezxml structure
+ezxml_t ezxml_insert(ezxml_t xml, ezxml_t dest, size_t off)
+{
+ ezxml_t cur, prev, head;
+
+ xml->next = xml->sibling = xml->ordered = NULL;
+ xml->off = off;
+ xml->parent = dest;
+
+ if ((head = dest->child)) { // already have sub tags
+ if (head->off <= off) { // not first subtag
+ for (cur = head; cur->ordered && cur->ordered->off <= off;
+ cur = cur->ordered);
+ xml->ordered = cur->ordered;
+ cur->ordered = xml;
+ }
+ else { // first subtag
+ xml->ordered = head;
+ dest->child = xml;
+ }
+
+ for (cur = head, prev = NULL; cur && strcmp(cur->name, xml->name);
+ prev = cur, cur = cur->sibling); // find tag type
+ if (cur && cur->off <= off) { // not first of type
+ while (cur->next && cur->next->off <= off) cur = cur->next;
+ xml->next = cur->next;
+ cur->next = xml;
+ }
+ else { // first tag of this type
+ if (prev && cur) prev->sibling = cur->sibling; // remove old first
+ xml->next = cur; // old first tag is now next
+ for (cur = head, prev = NULL; cur && cur->off <= off;
+ prev = cur, cur = cur->sibling); // new sibling insert point
+ xml->sibling = cur;
+ if (prev) prev->sibling = xml;
+ }
+ }
+ else dest->child = xml; // only sub tag
+
+ return xml;
+}
+
+// Adds a child tag. off is the offset of the child tag relative to the start
+// of the parent tag's character content. Returns the child tag.
+ezxml_t ezxml_add_child(ezxml_t xml, const char *name, size_t off)
+{
+ ezxml_t child;
+
+ if (! xml) return NULL;
+ child = (ezxml_t)memset(malloc(sizeof(struct ezxml)), '\0',
+ sizeof(struct ezxml));
+ child->name = (char *)name;
+ child->attr = EZXML_NIL;
+ child->txt = "";
+
+ return ezxml_insert(child, xml, off);
+}
+
+// sets the character content for the given tag and returns the tag
+ezxml_t ezxml_set_txt(ezxml_t xml, const char *txt)
+{
+ if (! xml) return NULL;
+ if (xml->flags & EZXML_TXTM) free(xml->txt); // existing txt was malloced
+ xml->flags &= ~EZXML_TXTM;
+ xml->txt = (char *)txt;
+ return xml;
+}
+
+// Sets the given tag attribute or adds a new attribute if not found. A value
+// of NULL will remove the specified attribute. Returns the tag given.
+ezxml_t ezxml_set_attr(ezxml_t xml, const char *name, const char *value)
+{
+ int l = 0, c;
+
+ if (! xml) return NULL;
+ while (xml->attr[l] && strcmp(xml->attr[l], name)) l += 2;
+ if (! xml->attr[l]) { // not found, add as new attribute
+ if (! value) return xml; // nothing to do
+ if (xml->attr == EZXML_NIL) { // first attribute
+ xml->attr = malloc(4 * sizeof(char *));
+ xml->attr[1] = strdup(""); // empty list of malloced names/vals
+ }
+ else xml->attr = realloc(xml->attr, (l + 4) * sizeof(char *));
+
+ xml->attr[l] = (char *)name; // set attribute name
+ xml->attr[l + 2] = NULL; // null terminate attribute list
+ xml->attr[l + 3] = realloc(xml->attr[l + 1],
+ (c = strlen(xml->attr[l + 1])) + 2);
+ strcpy(xml->attr[l + 3] + c, " "); // set name/value as not malloced
+ if (xml->flags & EZXML_DUP) xml->attr[l + 3][c] = EZXML_NAMEM;
+ }
+ else if (xml->flags & EZXML_DUP) free((char *)name); // name was strduped
+
+ for (c = l; xml->attr[c]; c += 2); // find end of attribute list
+ if (xml->attr[c + 1][l / 2] & EZXML_TXTM) free(xml->attr[l + 1]); //old val
+ if (xml->flags & EZXML_DUP) xml->attr[c + 1][l / 2] |= EZXML_TXTM;
+ else xml->attr[c + 1][l / 2] &= ~EZXML_TXTM;
+
+ if (value) xml->attr[l + 1] = (char *)value; // set attribute value
+ else { // remove attribute
+ if (xml->attr[c + 1][l / 2] & EZXML_NAMEM) free(xml->attr[l]);
+ memmove(xml->attr + l, xml->attr + l + 2, (c - l + 2) * sizeof(char*));
+ xml->attr = realloc(xml->attr, (c + 2) * sizeof(char *));
+ memmove(xml->attr[c + 1] + (l / 2), xml->attr[c + 1] + (l / 2) + 1,
+ (c / 2) - (l / 2)); // fix list of which name/vals are malloced
+ }
+ xml->flags &= ~EZXML_DUP; // clear strdup() flag
+ return xml;
+}
+
+// sets a flag for the given tag and returns the tag
+ezxml_t ezxml_set_flag(ezxml_t xml, short flag)
+{
+ if (xml) xml->flags |= flag;
+ return xml;
+}
+
+// removes a tag along with its subtags without freeing its memory
+ezxml_t ezxml_cut(ezxml_t xml)
+{
+ ezxml_t cur;
+
+ if (! xml) return NULL; // nothing to do
+ if (xml->next) xml->next->sibling = xml->sibling; // patch sibling list
+
+ if (xml->parent) { // not root tag
+ cur = xml->parent->child; // find head of subtag list
+ if (cur == xml) xml->parent->child = xml->ordered; // first subtag
+ else { // not first subtag
+ while (cur->ordered != xml) cur = cur->ordered;
+ cur->ordered = cur->ordered->ordered; // patch ordered list
+
+ cur = xml->parent->child; // go back to head of subtag list
+ if (strcmp(cur->name, xml->name)) { // not in first sibling list
+ while (strcmp(cur->sibling->name, xml->name))
+ cur = cur->sibling;
+ if (cur->sibling == xml) { // first of a sibling list
+ cur->sibling = (xml->next) ? xml->next
+ : cur->sibling->sibling;
+ }
+ else cur = cur->sibling; // not first of a sibling list
+ }
+
+ while (cur->next && cur->next != xml) cur = cur->next;
+ if (cur->next) cur->next = cur->next->next; // patch next list
+ }
+ }
+ xml->ordered = xml->sibling = xml->next = NULL;
+ return xml;
+}
+
+#ifdef EZXML_TEST // test harness
+int main(int argc, char **argv)
+{
+ ezxml_t xml;
+ char *s;
+ int i;
+
+ if (argc != 2) return fprintf(stderr, "usage: %s xmlfile</font>
<font color="blue">", argv[0]);
+
+ xml = ezxml_parse_file(argv[1]);
+ printf("%s</font>
<font color="gray">", (s = ezxml_toxml(xml)));
+ free(s);
+ i = fprintf(stderr, "%s", ezxml_error(xml));
+ ezxml_free(xml);
+ return (i) ? 1 : 0;
+}
+#endif // EZXML_TEST
Deleted: branches/atmos_physics/src/registry/ezxml/ezxml.h
===================================================================
--- trunk/mpas/src/registry/ezxml/ezxml.h 2013-03-25 16:55:55 UTC (rev 2666)
+++ branches/atmos_physics/src/registry/ezxml/ezxml.h 2013-03-26 23:03:26 UTC (rev 2670)
@@ -1,167 +0,0 @@
-/* ezxml.h
- *
- * Copyright 2004-2006 Aaron Voisine <aaron@voisine.org>
- *
- * Permission is hereby granted, free of charge, to any person obtaining
- * a copy of this software and associated documentation files (the
- * "Software"), to deal in the Software without restriction, including
- * without limitation the rights to use, copy, modify, merge, publish,
- * distribute, sublicense, and/or sell copies of the Software, and to
- * permit persons to whom the Software is furnished to do so, subject to
- * the following conditions:
- *
- * The above copyright notice and this permission notice shall be included
- * in all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
- * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
- * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
- * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
- * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
- */
-
-#ifndef _EZXML_H
-#define _EZXML_H
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdarg.h>
-#include <fcntl.h>
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-#define EZXML_BUFSIZE 1024 // size of internal memory buffers
-#define EZXML_NAMEM 0x80 // name is malloced
-#define EZXML_TXTM 0x40 // txt is malloced
-#define EZXML_DUP 0x20 // attribute name and value are strduped
-
-typedef struct ezxml *ezxml_t;
-struct ezxml {
- char *name; // tag name
- char **attr; // tag attributes { name, value, name, value, ... NULL }
- char *txt; // tag character content, empty string if none
- size_t off; // tag offset from start of parent tag character content
- ezxml_t next; // next tag with same name in this section at this depth
- ezxml_t sibling; // next tag with different name in same section and depth
- ezxml_t ordered; // next tag, same section and depth, in original order
- ezxml_t child; // head of sub tag list, NULL if none
- ezxml_t parent; // parent tag, NULL if current tag is root tag
- short flags; // additional information
-};
-
-// Given a string of xml data and its length, parses it and creates an ezxml
-// structure. For efficiency, modifies the data by adding null terminators
-// and decoding ampersand sequences. If you don't want this, copy the data and
-// pass in the copy. Returns NULL on failure.
-ezxml_t ezxml_parse_str(char *s, size_t len);
-
-// A wrapper for ezxml_parse_str() that accepts a file descriptor. First
-// attempts to mem map the file. Failing that, reads the file into memory.
-// Returns NULL on failure.
-ezxml_t ezxml_parse_fd(int fd);
-
-// a wrapper for ezxml_parse_fd() that accepts a file name
-ezxml_t ezxml_parse_file(const char *file);
-
-// Wrapper for ezxml_parse_str() that accepts a file stream. Reads the entire
-// stream into memory and then parses it. For xml files, use ezxml_parse_file()
-// or ezxml_parse_fd()
-ezxml_t ezxml_parse_fp(FILE *fp);
-
-// returns the first child tag (one level deeper) with the given name or NULL
-// if not found
-ezxml_t ezxml_child(ezxml_t xml, const char *name);
-
-// returns the next tag of the same name in the same section and depth or NULL
-// if not found
-#define ezxml_next(xml) ((xml) ? xml->next : NULL)
-
-// Returns the Nth tag with the same name in the same section at the same depth
-// or NULL if not found. An index of 0 returns the tag given.
-ezxml_t ezxml_idx(ezxml_t xml, int idx);
-
-// returns the name of the given tag
-#define ezxml_name(xml) ((xml) ? xml->name : NULL)
-
-// returns the given tag's character content or empty string if none
-#define ezxml_txt(xml) ((xml) ? xml->txt : "")
-
-// returns the value of the requested tag attribute, or NULL if not found
-const char *ezxml_attr(ezxml_t xml, const char *attr);
-
-// Traverses the ezxml sturcture to retrieve a specific subtag. Takes a
-// variable length list of tag names and indexes. The argument list must be
-// terminated by either an index of -1 or an empty string tag name. Example:
-// title = ezxml_get(library, "shelf", 0, "book", 2, "title", -1);
-// This retrieves the title of the 3rd book on the 1st shelf of library.
-// Returns NULL if not found.
-ezxml_t ezxml_get(ezxml_t xml, ...);
-
-// Converts an ezxml structure back to xml. Returns a string of xml data that
-// must be freed.
-char *ezxml_toxml(ezxml_t xml);
-
-// returns a NULL terminated array of processing instructions for the given
-// target
-const char **ezxml_pi(ezxml_t xml, const char *target);
-
-// frees the memory allocated for an ezxml structure
-void ezxml_free(ezxml_t xml);
-
-// returns parser error message or empty string if none
-const char *ezxml_error(ezxml_t xml);
-
-// returns a new empty ezxml structure with the given root tag name
-ezxml_t ezxml_new(const char *name);
-
-// wrapper for ezxml_new() that strdup()s name
-#define ezxml_new_d(name) ezxml_set_flag(ezxml_new(strdup(name)), EZXML_NAMEM)
-
-// Adds a child tag. off is the offset of the child tag relative to the start
-// of the parent tag's character content. Returns the child tag.
-ezxml_t ezxml_add_child(ezxml_t xml, const char *name, size_t off);
-
-// wrapper for ezxml_add_child() that strdup()s name
-#define ezxml_add_child_d(xml, name, off) \
- ezxml_set_flag(ezxml_add_child(xml, strdup(name), off), EZXML_NAMEM)
-
-// sets the character content for the given tag and returns the tag
-ezxml_t ezxml_set_txt(ezxml_t xml, const char *txt);
-
-// wrapper for ezxml_set_txt() that strdup()s txt
-#define ezxml_set_txt_d(xml, txt) \
- ezxml_set_flag(ezxml_set_txt(xml, strdup(txt)), EZXML_TXTM)
-
-// Sets the given tag attribute or adds a new attribute if not found. A value
-// of NULL will remove the specified attribute. Returns the tag given.
-ezxml_t ezxml_set_attr(ezxml_t xml, const char *name, const char *value);
-
-// Wrapper for ezxml_set_attr() that strdup()s name/value. Value cannot be NULL
-#define ezxml_set_attr_d(xml, name, value) \
- ezxml_set_attr(ezxml_set_flag(xml, EZXML_DUP), strdup(name), strdup(value))
-
-// sets a flag for the given tag and returns the tag
-ezxml_t ezxml_set_flag(ezxml_t xml, short flag);
-
-// removes a tag along with its subtags without freeing its memory
-ezxml_t ezxml_cut(ezxml_t xml);
-
-// inserts an existing tag into an ezxml structure
-ezxml_t ezxml_insert(ezxml_t xml, ezxml_t dest, size_t off);
-
-// Moves an existing tag to become a subtag of dest at the given offset from
-// the start of dest's character content. Returns the moved tag.
-#define ezxml_move(xml, dest, off) ezxml_insert(ezxml_cut(xml), dest, off)
-
-// removes a tag along with all its subtags
-#define ezxml_remove(xml) ezxml_free(ezxml_cut(xml))
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif // _EZXML_H
Copied: branches/atmos_physics/src/registry/ezxml/ezxml.h (from rev 2666, trunk/mpas/src/registry/ezxml/ezxml.h)
===================================================================
--- branches/atmos_physics/src/registry/ezxml/ezxml.h (rev 0)
+++ branches/atmos_physics/src/registry/ezxml/ezxml.h 2013-03-26 23:03:26 UTC (rev 2670)
@@ -0,0 +1,167 @@
+/* ezxml.h
+ *
+ * Copyright 2004-2006 Aaron Voisine <aaron@voisine.org>
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining
+ * a copy of this software and associated documentation files (the
+ * "Software"), to deal in the Software without restriction, including
+ * without limitation the rights to use, copy, modify, merge, publish,
+ * distribute, sublicense, and/or sell copies of the Software, and to
+ * permit persons to whom the Software is furnished to do so, subject to
+ * the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included
+ * in all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+ * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ */
+
+#ifndef _EZXML_H
+#define _EZXML_H
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <fcntl.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define EZXML_BUFSIZE 1024 // size of internal memory buffers
+#define EZXML_NAMEM 0x80 // name is malloced
+#define EZXML_TXTM 0x40 // txt is malloced
+#define EZXML_DUP 0x20 // attribute name and value are strduped
+
+typedef struct ezxml *ezxml_t;
+struct ezxml {
+ char *name; // tag name
+ char **attr; // tag attributes { name, value, name, value, ... NULL }
+ char *txt; // tag character content, empty string if none
+ size_t off; // tag offset from start of parent tag character content
+ ezxml_t next; // next tag with same name in this section at this depth
+ ezxml_t sibling; // next tag with different name in same section and depth
+ ezxml_t ordered; // next tag, same section and depth, in original order
+ ezxml_t child; // head of sub tag list, NULL if none
+ ezxml_t parent; // parent tag, NULL if current tag is root tag
+ short flags; // additional information
+};
+
+// Given a string of xml data and its length, parses it and creates an ezxml
+// structure. For efficiency, modifies the data by adding null terminators
+// and decoding ampersand sequences. If you don't want this, copy the data and
+// pass in the copy. Returns NULL on failure.
+ezxml_t ezxml_parse_str(char *s, size_t len);
+
+// A wrapper for ezxml_parse_str() that accepts a file descriptor. First
+// attempts to mem map the file. Failing that, reads the file into memory.
+// Returns NULL on failure.
+ezxml_t ezxml_parse_fd(int fd);
+
+// a wrapper for ezxml_parse_fd() that accepts a file name
+ezxml_t ezxml_parse_file(const char *file);
+
+// Wrapper for ezxml_parse_str() that accepts a file stream. Reads the entire
+// stream into memory and then parses it. For xml files, use ezxml_parse_file()
+// or ezxml_parse_fd()
+ezxml_t ezxml_parse_fp(FILE *fp);
+
+// returns the first child tag (one level deeper) with the given name or NULL
+// if not found
+ezxml_t ezxml_child(ezxml_t xml, const char *name);
+
+// returns the next tag of the same name in the same section and depth or NULL
+// if not found
+#define ezxml_next(xml) ((xml) ? xml->next : NULL)
+
+// Returns the Nth tag with the same name in the same section at the same depth
+// or NULL if not found. An index of 0 returns the tag given.
+ezxml_t ezxml_idx(ezxml_t xml, int idx);
+
+// returns the name of the given tag
+#define ezxml_name(xml) ((xml) ? xml->name : NULL)
+
+// returns the given tag's character content or empty string if none
+#define ezxml_txt(xml) ((xml) ? xml->txt : "")
+
+// returns the value of the requested tag attribute, or NULL if not found
+const char *ezxml_attr(ezxml_t xml, const char *attr);
+
+// Traverses the ezxml sturcture to retrieve a specific subtag. Takes a
+// variable length list of tag names and indexes. The argument list must be
+// terminated by either an index of -1 or an empty string tag name. Example:
+// title = ezxml_get(library, "shelf", 0, "book", 2, "title", -1);
+// This retrieves the title of the 3rd book on the 1st shelf of library.
+// Returns NULL if not found.
+ezxml_t ezxml_get(ezxml_t xml, ...);
+
+// Converts an ezxml structure back to xml. Returns a string of xml data that
+// must be freed.
+char *ezxml_toxml(ezxml_t xml);
+
+// returns a NULL terminated array of processing instructions for the given
+// target
+const char **ezxml_pi(ezxml_t xml, const char *target);
+
+// frees the memory allocated for an ezxml structure
+void ezxml_free(ezxml_t xml);
+
+// returns parser error message or empty string if none
+const char *ezxml_error(ezxml_t xml);
+
+// returns a new empty ezxml structure with the given root tag name
+ezxml_t ezxml_new(const char *name);
+
+// wrapper for ezxml_new() that strdup()s name
+#define ezxml_new_d(name) ezxml_set_flag(ezxml_new(strdup(name)), EZXML_NAMEM)
+
+// Adds a child tag. off is the offset of the child tag relative to the start
+// of the parent tag's character content. Returns the child tag.
+ezxml_t ezxml_add_child(ezxml_t xml, const char *name, size_t off);
+
+// wrapper for ezxml_add_child() that strdup()s name
+#define ezxml_add_child_d(xml, name, off) \
+ ezxml_set_flag(ezxml_add_child(xml, strdup(name), off), EZXML_NAMEM)
+
+// sets the character content for the given tag and returns the tag
+ezxml_t ezxml_set_txt(ezxml_t xml, const char *txt);
+
+// wrapper for ezxml_set_txt() that strdup()s txt
+#define ezxml_set_txt_d(xml, txt) \
+ ezxml_set_flag(ezxml_set_txt(xml, strdup(txt)), EZXML_TXTM)
+
+// Sets the given tag attribute or adds a new attribute if not found. A value
+// of NULL will remove the specified attribute. Returns the tag given.
+ezxml_t ezxml_set_attr(ezxml_t xml, const char *name, const char *value);
+
+// Wrapper for ezxml_set_attr() that strdup()s name/value. Value cannot be NULL
+#define ezxml_set_attr_d(xml, name, value) \
+ ezxml_set_attr(ezxml_set_flag(xml, EZXML_DUP), strdup(name), strdup(value))
+
+// sets a flag for the given tag and returns the tag
+ezxml_t ezxml_set_flag(ezxml_t xml, short flag);
+
+// removes a tag along with its subtags without freeing its memory
+ezxml_t ezxml_cut(ezxml_t xml);
+
+// inserts an existing tag into an ezxml structure
+ezxml_t ezxml_insert(ezxml_t xml, ezxml_t dest, size_t off);
+
+// Moves an existing tag to become a subtag of dest at the given offset from
+// the start of dest's character content. Returns the moved tag.
+#define ezxml_move(xml, dest, off) ezxml_insert(ezxml_cut(xml), dest, off)
+
+// removes a tag along with all its subtags
+#define ezxml_remove(xml) ezxml_free(ezxml_cut(xml))
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif // _EZXML_H
Modified: branches/atmos_physics/src/registry/gen_inc.c
===================================================================
--- branches/atmos_physics/src/registry/gen_inc.c 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/registry/gen_inc.c 2013-03-26 23:03:26 UTC (rev 2670)
@@ -822,8 +822,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) ||
@@ -1159,7 +1161,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">");
@@ -1387,7 +1392,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;
@@ -2117,8 +2122,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);
@@ -2174,8 +2181,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);
@@ -2381,7 +2390,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;
@@ -2563,8 +2572,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/atmos_physics/src/registry/parse.c
===================================================================
--- branches/atmos_physics/src/registry/parse.c 2013-03-26 21:36:57 UTC (rev 2669)
+++ branches/atmos_physics/src/registry/parse.c 2013-03-26 23:03:26 UTC (rev 2670)
@@ -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 *);
@@ -30,9 +31,16 @@
nls = NULL;
dims = NULL;
vars = NULL;
+
+ if (parse_reg_xml(regfile, &nls, &dims, &vars, &groups)) {
+ return 1;
+ }
+
+/* Old Parser
if (parse_reg(regfile, &nls, &dims, &vars, &groups)) {
return 1;
}
+*/
sort_vars(vars);
sort_group_vars(groups);
@@ -45,7 +53,391 @@
return 0;
}
+int parse_reg_xml(FILE * regfile, struct namelist **nls, struct dimension ** dims, struct variable ** vars, struct group_list ** groups)
+{
+ 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;
+
+ 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;
+
+ // 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 +620,6 @@
vlist_cursor->var = var_ptr;
}
-
getword(regfile, var_ptr->super_array);
getword(regfile, var_ptr->array_class);
@@ -402,7 +793,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>