<p><b>duda</b> 2010-11-12 11:21:35 -0700 (Fri, 12 Nov 2010)</p><p>Add changes to re-organize the driver and sub-driver levels of<br>
MPAS, removing all core-specific code, in particular, calls to<br>
test case initialization. Now, the sub-driver implements mpas_init(),<br>
mpas_run(), and mpas_finalize() routines, which make calls to the<br>
init/run/finalize routines implemented by main modules of the<br>
framework and core. These changes will allow us to separate the<br>
initialization step from the model proper, and should also make it<br>
easier to package MPAS as a component in a coupled system in<br>
future.<br>
<br>
The main calling structure now looks like<br>
<br>
main program [mpas.F]<br>
<br>
mpas_init() [module_mpas_subdriver]<br>
mpas_framework_init() [module_mpas_framework]<br>
mpas_core_init() [module_mpas_core]<br>
<br>
mpas_run() [module_mpas_subdriver]<br>
mpas_core_run() [module_mpas_core]<br>
<br>
mpas_finalize() [module_mpas_subdriver]<br>
mpas_core_finalize() [module_mpas_core]<br>
mpas_framework_finalize() [module_mpas_framework]<br>
<br>
Also, remove mpas_query() and STORAGE_FACTOR from module_grid_types.F, <br>
since these are no longer needed (we now use the registry to <br>
specify the number of time levels on a field-by-field basis).<br>
<br>
<br>
A src/core_hyd_atmos/module_mpas_core.F<br>
D src/core_hyd_atmos/mpas_interface.F<br>
M src/core_hyd_atmos/Makefile<br>
A src/core_sw/module_mpas_core.F<br>
D src/core_sw/mpas_interface.F<br>
M src/core_sw/Makefile<br>
M src/driver/mpas.F<br>
M src/driver/Makefile<br>
D src/driver/module_subdriver.F<br>
A src/driver/module_mpas_subdriver.F<br>
A src/core_ocean/module_mpas_core.F<br>
D src/core_ocean/mpas_interface.F<br>
M src/core_ocean/Makefile<br>
M src/framework/module_grid_types.F<br>
A src/framework/module_mpas_framework.F<br>
M src/framework/Makefile<br>
</p><hr noshade><pre><font color="gray">Modified: trunk/mpas/src/core_hyd_atmos/Makefile
===================================================================
--- trunk/mpas/src/core_hyd_atmos/Makefile 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/core_hyd_atmos/Makefile 2010-11-12 18:21:35 UTC (rev 612)
@@ -1,9 +1,9 @@
.SUFFIXES: .F .o
-OBJS = module_test_cases.o \
+OBJS = module_mpas_core.o \
+ module_test_cases.o \
module_time_integration.o \
- module_advection.o \
- mpas_interface.o
+ module_advection.o
all: core_hyd
@@ -16,7 +16,7 @@
module_advection.o:
-mpas_interface.o: module_advection.o module_test_cases.o module_time_integration.o
+module_mpas_core.o: module_advection.o module_test_cases.o module_time_integration.o
clean:
$(RM) *.o *.mod *.f90 libdycore.a
Added: trunk/mpas/src/core_hyd_atmos/module_mpas_core.F
===================================================================
--- trunk/mpas/src/core_hyd_atmos/module_mpas_core.F (rev 0)
+++ trunk/mpas/src/core_hyd_atmos/module_mpas_core.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -0,0 +1,201 @@
+module mpas_core
+
+ use mpas_framework
+
+ type (io_output_object) :: restart_obj
+ integer :: restart_frame
+
+
+ contains
+
+
+ subroutine mpas_core_init(domain)
+
+ use configure
+ use grid_types
+ use test_cases
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+
+ real (kind=RKIND) :: dt
+ type (block_type), pointer :: block
+
+
+ if (.not. config_do_restart) call setup_hyd_test_case(domain)
+
+ !
+ ! Initialize core
+ !
+ dt = config_dt
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_init_block(block, block % mesh, dt)
+ block => block % next
+ end do
+
+ restart_frame = 1
+
+ end subroutine mpas_core_init
+
+
+ subroutine mpas_init_block(block, mesh, dt)
+
+ use grid_types
+ use advection
+ use time_integration
+ use RBF_interpolation
+ use vector_reconstruction
+
+ implicit none
+
+ type (block_type), intent(inout) :: block
+ type (mesh_type), intent(inout) :: mesh
+ real (kind=RKIND), intent(in) :: dt
+
+
+ call compute_solver_constants(block % state % time_levs(1) % state, mesh)
+ call compute_state_diagnostics(block % state % time_levs(1) % state, mesh)
+ call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
+ call initialize_advection_rk(mesh)
+ call rbfInterp_initialize(mesh)
+ call init_reconstruct(mesh)
+ call reconstruct(block % state % time_levs(1) % state, mesh)
+
+ if (.not. config_do_restart) block % state % time_levs(1) % state % xtime % scalar = 0.0
+
+ end subroutine mpas_init_block
+
+
+ subroutine mpas_core_run(domain, output_obj, output_frame)
+
+ use grid_types
+ use io_output
+ use timer
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+ type (io_output_object), intent(inout) :: output_obj
+ integer, intent(inout) :: output_frame
+
+ integer :: ntimesteps, itimestep
+ real (kind=RKIND) :: dt
+ type (block_type), pointer :: block_ptr
+
+ ! Eventually, dt should be domain specific
+ dt = config_dt
+ ntimesteps = config_ntimesteps
+
+ call write_output_frame(output_obj, output_frame, domain)
+
+ ! 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(...)
+ do itimestep = 1,ntimesteps
+ write(0,*) 'Doing timestep ', itimestep
+ call timer_start("time integration")
+ call mpas_timestep(domain, itimestep, dt)
+ call timer_stop("time integration")
+
+ ! Move time level 2 fields back into time level 1 for next time step
+ call shift_time_levels_state(domain % blocklist % state)
+
+ if (mod(itimestep, config_output_interval) == 0) then
+ call write_output_frame(output_obj, output_frame, domain)
+ end if
+ if (mod(itimestep, config_restart_interval) == 0 .and. config_restart_interval > 0) then
+ if (restart_frame == 1) call output_state_init(restart_obj, domain, "RESTART")
+ call output_state_for_domain(restart_obj, domain, restart_frame)
+ restart_frame = restart_frame + 1
+ end if
+ end do
+
+ end subroutine mpas_core_run
+
+
+ subroutine write_output_frame(output_obj, output_frame, domain)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Compute diagnostic fields for a domain and write model state to output file
+ !
+ ! Input/Output: domain - contains model state; diagnostic field are computed
+ ! before returning
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ use grid_types
+ use io_output
+
+ implicit none
+
+ integer, intent(inout) :: output_frame
+ type (domain_type), intent(inout) :: domain
+ type (io_output_object), intent(inout) :: output_obj
+
+ integer :: i, j, k
+ integer :: eoe
+ type (block_type), pointer :: block_ptr
+
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
+ block_ptr => block_ptr % next
+ end do
+
+ call output_state_for_domain(output_obj, domain, output_frame)
+ output_frame = output_frame + 1
+
+ end subroutine write_output_frame
+
+
+ subroutine compute_output_diagnostics(state, grid)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Compute diagnostic fields for a domain
+ !
+ ! Input: state - contains model prognostic fields
+ ! grid - contains grid metadata
+ !
+ ! Output: state - upon returning, diagnostic fields will have be computed
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ use grid_types
+
+ implicit none
+
+ type (state_type), intent(inout) :: state
+ type (mesh_type), intent(in) :: grid
+
+ integer :: i, eoe
+ integer :: iEdge, k
+
+ end subroutine compute_output_diagnostics
+
+
+ subroutine mpas_timestep(domain, itimestep, dt)
+
+ use grid_types
+ use time_integration
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(in) :: itimestep
+ real (kind=RKIND), intent(in) :: dt
+
+ call timestep(domain, dt)
+
+ end subroutine mpas_timestep
+
+
+ subroutine mpas_core_finalize(domain)
+
+ use grid_types
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+
+ if (restart_frame > 1) call output_state_finalize(restart_obj, domain % dminfo)
+
+ end subroutine mpas_core_finalize
+
+end module mpas_core
Deleted: trunk/mpas/src/core_hyd_atmos/mpas_interface.F
===================================================================
--- trunk/mpas/src/core_hyd_atmos/mpas_interface.F 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/core_hyd_atmos/mpas_interface.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -1,88 +0,0 @@
-subroutine mpas_setup_test_case(domain)
-
- use grid_types
- use test_cases
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- call setup_hyd_test_case(domain)
-
-end subroutine mpas_setup_test_case
-
-
-subroutine mpas_init_domain(domain)
-! Initialize grid variables that are computed from the netcdf input file.
-
- use grid_types
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- ! This is currently a stub.
-
-end subroutine mpas_init_domain
-
-
-subroutine mpas_init(block, mesh, dt)
-
- use grid_types
- use advection
- use time_integration
- use RBF_interpolation
- use vector_reconstruction
-
- implicit none
-
- type (block_type), intent(inout) :: block
- type (mesh_type), intent(inout) :: mesh
- real (kind=RKIND), intent(in) :: dt
-
- call compute_solver_constants(block % state % time_levs(1) % state, mesh)
- call compute_state_diagnostics(block % state % time_levs(1) % state, mesh)
- call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
- call initialize_advection_rk(mesh)
- call rbfInterp_initialize(mesh)
- call init_reconstruct(mesh)
- call reconstruct(block % state % time_levs(1) % state, mesh)
-
-end subroutine mpas_init
-
-
-subroutine mpas_query(key, ivalue)
-
- implicit none
-
- character (len=256), intent(in) :: key
- integer, intent(out) :: ivalue
-
- if (index(key,'STORAGE_FACTOR') /= 0) then
- ivalue = 1
- end if
-
-end subroutine mpas_query
-
-
-subroutine mpas_timestep(domain, itimestep, dt)
-
- use grid_types
- use time_integration
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
- integer, intent(in) :: itimestep
- real (kind=RKIND), intent(in) :: dt
-
- call timestep(domain, dt)
-
-end subroutine mpas_timestep
-
-
-subroutine mpas_finalize()
-
- implicit none
-
-end subroutine mpas_finalize
Modified: trunk/mpas/src/core_ocean/Makefile
===================================================================
--- trunk/mpas/src/core_ocean/Makefile 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/core_ocean/Makefile 2010-11-12 18:21:35 UTC (rev 612)
@@ -1,10 +1,10 @@
.SUFFIXES: .F .o
-OBJS = module_test_cases.o \
+OBJS = module_mpas_core.o \
+ module_test_cases.o \
module_advection.o \
module_time_integration.o \
- module_global_diagnostics.o \
- mpas_interface.o
+ module_global_diagnostics.o
all: core_hyd
@@ -19,7 +19,7 @@
module_global_diagnostics.o:
-mpas_interface.o: module_advection.o module_global_diagnostics.o module_test_cases.o module_time_integration.o
+module_mpas_core.o: module_advection.o module_global_diagnostics.o module_test_cases.o module_time_integration.o
clean:
$(RM) *.o *.mod *.f90 libdycore.a
Added: trunk/mpas/src/core_ocean/module_mpas_core.F
===================================================================
--- trunk/mpas/src/core_ocean/module_mpas_core.F (rev 0)
+++ trunk/mpas/src/core_ocean/module_mpas_core.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -0,0 +1,225 @@
+module mpas_core
+
+ use mpas_framework
+
+ type (io_output_object) :: restart_obj
+ integer :: restart_frame
+
+
+ contains
+
+
+ subroutine mpas_core_init(domain)
+
+ use configure
+ use grid_types
+ use test_cases
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+
+ real (kind=RKIND) :: dt
+ type (block_type), pointer :: block
+
+
+ if (.not. config_do_restart) call setup_sw_test_case(domain)
+
+ !
+ ! Initialize core
+ !
+ dt = config_dt
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_init_block(block, block % mesh, dt)
+ 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.
+
+ ! call timer_start("global diagnostics")
+ ! call computeGlobalDiagnostics(domain % dminfo, block % state % time_levs(1) % state, mesh, 0, dt)
+ ! call timer_stop("global diagnostics")
+ ! call output_state_init(output_obj, domain, "OUTPUT")
+ ! call write_output_frame(output_obj, domain)
+
+ restart_frame = 1
+
+ end subroutine mpas_core_init
+
+
+ subroutine mpas_init_block(block, mesh, dt)
+
+ use grid_types
+ use time_integration
+ use RBF_interpolation
+ use vector_reconstruction
+
+ implicit none
+
+ type (block_type), intent(inout) :: block
+ type (mesh_type), intent(inout) :: mesh
+ real (kind=RKIND), intent(in) :: dt
+
+
+ call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
+
+ call rbfInterp_initialize(mesh)
+ call init_reconstruct(mesh)
+ call reconstruct(block % state % time_levs(1) % state, mesh)
+
+ if (.not. config_do_restart) block % state % time_levs(1) % state % xtime % scalar = 0.0
+
+ end subroutine mpas_init_block
+
+
+ subroutine mpas_core_run(domain, output_obj, output_frame)
+
+ use grid_types
+ use io_output
+ use timer
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+ type (io_output_object), intent(inout) :: output_obj
+ integer, intent(inout) :: output_frame
+
+ integer :: ntimesteps, itimestep
+ real (kind=RKIND) :: dt
+ type (block_type), pointer :: block_ptr
+
+ ! Eventually, dt should be domain specific
+ dt = config_dt
+ ntimesteps = config_ntimesteps
+
+ call write_output_frame(output_obj, output_frame, domain)
+
+ ! 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(...)
+ do itimestep = 1,ntimesteps
+ write(0,*) 'Doing timestep ', itimestep
+ call timer_start("time integration")
+ call mpas_timestep(domain, itimestep, dt)
+ call timer_stop("time integration")
+
+ ! Move time level 2 fields back into time level 1 for next time step
+ call shift_time_levels_state(domain % blocklist % state)
+
+ if (mod(itimestep, config_output_interval) == 0) then
+ call write_output_frame(output_obj, output_frame, domain)
+ end if
+ if (mod(itimestep, config_restart_interval) == 0 .and. config_restart_interval > 0) then
+ if (restart_frame == 1) call output_state_init(restart_obj, domain, "RESTART")
+ call output_state_for_domain(restart_obj, domain, restart_frame)
+ restart_frame = restart_frame + 1
+ end if
+ end do
+
+ end subroutine mpas_core_run
+
+
+ subroutine write_output_frame(output_obj, output_frame, domain)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Compute diagnostic fields for a domain and write model state to output file
+ !
+ ! Input/Output: domain - contains model state; diagnostic field are computed
+ ! before returning
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ use grid_types
+ use io_output
+
+ implicit none
+
+ integer, intent(inout) :: output_frame
+ type (domain_type), intent(inout) :: domain
+ type (io_output_object), intent(inout) :: output_obj
+
+ integer :: i, j, k
+ integer :: eoe
+ type (block_type), pointer :: block_ptr
+
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
+ block_ptr => block_ptr % next
+ end do
+
+ call output_state_for_domain(output_obj, domain, output_frame)
+ output_frame = output_frame + 1
+
+ end subroutine write_output_frame
+
+
+ subroutine compute_output_diagnostics(state, grid)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Compute diagnostic fields for a domain
+ !
+ ! Input: state - contains model prognostic fields
+ ! grid - contains grid metadata
+ !
+ ! Output: state - upon returning, diagnostic fields will have be computed
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ use grid_types
+
+ implicit none
+
+ type (state_type), intent(inout) :: state
+ type (mesh_type), intent(in) :: grid
+
+ integer :: i, eoe
+ integer :: iEdge, k
+
+ end subroutine compute_output_diagnostics
+
+
+ subroutine mpas_timestep(domain, itimestep, dt)
+
+ use grid_types
+ use time_integration
+ use timer
+ use global_diagnostics
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(in) :: itimestep
+ real (kind=RKIND), intent(in) :: dt
+ type (block_type), pointer :: block_ptr
+
+ call timestep(domain, dt)
+
+ if (mod(itimestep, config_stats_interval) == 0) then
+ 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 timer_start("global diagnostics")
+ call computeGlobalDiagnostics(domain % dminfo, &
+ block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
+ itimestep, dt)
+ call timer_stop("global diagnostics")
+ end if
+
+ end subroutine mpas_timestep
+
+
+ subroutine mpas_core_finalize(domain)
+
+ use grid_types
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+
+ if (restart_frame > 1) call output_state_finalize(restart_obj, domain % dminfo)
+
+ end subroutine mpas_core_finalize
+
+end module mpas_core
Deleted: trunk/mpas/src/core_ocean/mpas_interface.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_interface.F 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/core_ocean/mpas_interface.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -1,110 +0,0 @@
-subroutine mpas_setup_test_case(domain)
-
- use grid_types
- use test_cases
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- call setup_sw_test_case(domain)
-
-end subroutine mpas_setup_test_case
-
-subroutine mpas_init_domain(domain)
-! Initialize grid variables that are computed from the netcdf input file.
-
- use grid_types
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- ! This is currently a stub.
-
-end subroutine mpas_init_domain
-
-subroutine mpas_init(block, mesh, dt)
-
- use grid_types
- use time_integration
- use RBF_interpolation
- use vector_reconstruction
-
- implicit none
-
- type (block_type), intent(inout) :: block
- type (mesh_type), intent(inout) :: mesh
- real (kind=RKIND), intent(in) :: dt
-
- call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
-
- call rbfInterp_initialize(mesh)
- call init_reconstruct(mesh)
- call reconstruct(block % state % time_levs(1) % state, mesh)
-
-! 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.
-
-! call timer_start("global diagnostics")
-! call computeGlobalDiagnostics(domain % dminfo, block % state % time_levs(1) % state, mesh, 0, dt)
-! call timer_stop("global diagnostics")
-! call output_state_init(output_obj, domain, "OUTPUT")
-! call write_output_frame(output_obj, domain)
-
-end subroutine mpas_init
-
-
-subroutine mpas_query(key, ivalue)
-
- implicit none
-
- character (len=256), intent(in) :: key
- integer, intent(out) :: ivalue
-
- if (index(key,'STORAGE_FACTOR') /= 0) then
- ivalue = 2
- end if
-
-end subroutine mpas_query
-
-
-subroutine mpas_timestep(domain, itimestep, dt)
-
- use grid_types
- use time_integration
- use timer
- use global_diagnostics
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
- integer, intent(in) :: itimestep
- real (kind=RKIND), intent(in) :: dt
- type (block_type), pointer :: block_ptr
-
- call timestep(domain, dt)
-
- if (mod(itimestep, config_stats_interval) == 0) then
- 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 timer_start("global diagnostics")
- call computeGlobalDiagnostics(domain % dminfo, &
- block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
- itimestep, dt)
- call timer_stop("global diagnostics")
- end if
-
-end subroutine mpas_timestep
-
-
-subroutine mpas_finalize()
-
- implicit none
-
-end subroutine mpas_finalize
Modified: trunk/mpas/src/core_sw/Makefile
===================================================================
--- trunk/mpas/src/core_sw/Makefile 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/core_sw/Makefile 2010-11-12 18:21:35 UTC (rev 612)
@@ -1,10 +1,10 @@
.SUFFIXES: .F .o
-OBJS = module_test_cases.o \
+OBJS = module_mpas_core.o \
+ module_test_cases.o \
module_advection.o \
module_time_integration.o \
- module_global_diagnostics.o \
- mpas_interface.o
+ module_global_diagnostics.o
all: core_sw
@@ -19,7 +19,7 @@
module_global_diagnostics.o:
-mpas_interface.o: module_global_diagnostics.o module_test_cases.o module_time_integration.o module_advection.o
+module_mpas_core.o: module_global_diagnostics.o module_test_cases.o module_time_integration.o module_advection.o
clean:
$(RM) *.o *.mod *.f90 libdycore.a
Added: trunk/mpas/src/core_sw/module_mpas_core.F
===================================================================
--- trunk/mpas/src/core_sw/module_mpas_core.F (rev 0)
+++ trunk/mpas/src/core_sw/module_mpas_core.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -0,0 +1,217 @@
+module mpas_core
+
+ use mpas_framework
+
+ type (io_output_object) :: restart_obj
+ integer :: restart_frame
+
+
+ contains
+
+
+ subroutine mpas_core_init(domain)
+
+ use configure
+ use grid_types
+ use test_cases
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+
+ real (kind=RKIND) :: dt
+ type (block_type), pointer :: block
+
+
+ if (.not. config_do_restart) call setup_sw_test_case(domain)
+
+ !
+ ! Initialize core
+ !
+ dt = config_dt
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_init_block(block, block % mesh, dt)
+ block => block % next
+ end do
+
+ restart_frame = 1
+
+ end subroutine mpas_core_init
+
+
+ subroutine mpas_init_block(block, mesh, dt)
+
+ use grid_types
+ use time_integration
+ use RBF_interpolation
+ use vector_reconstruction
+
+ implicit none
+
+ type (block_type), intent(inout) :: block
+ type (mesh_type), intent(inout) :: mesh
+ real (kind=RKIND), intent(in) :: dt
+
+
+ call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
+
+ call rbfInterp_initialize(mesh)
+ call init_reconstruct(mesh)
+ call reconstruct(block % state % time_levs(1) % state, mesh)
+
+ if (.not. config_do_restart) block % state % time_levs(1) % state % xtime % scalar = 0.0
+
+ end subroutine mpas_init_block
+
+
+ subroutine mpas_core_run(domain, output_obj, output_frame)
+
+ use grid_types
+ use io_output
+ use timer
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+ type (io_output_object), intent(inout) :: output_obj
+ integer, intent(inout) :: output_frame
+
+ integer :: ntimesteps, itimestep
+ real (kind=RKIND) :: dt
+ type (block_type), pointer :: block_ptr
+
+ ! Eventually, dt should be domain specific
+ dt = config_dt
+ ntimesteps = config_ntimesteps
+
+ call write_output_frame(output_obj, output_frame, domain)
+
+ ! 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(...)
+ do itimestep = 1,ntimesteps
+ write(0,*) 'Doing timestep ', itimestep
+ call timer_start("time integration")
+ call mpas_timestep(domain, itimestep, dt)
+ call timer_stop("time integration")
+
+ ! Move time level 2 fields back into time level 1 for next time step
+ call shift_time_levels_state(domain % blocklist % state)
+
+ if (mod(itimestep, config_output_interval) == 0) then
+ call write_output_frame(output_obj, output_frame, domain)
+ end if
+ if (mod(itimestep, config_restart_interval) == 0 .and. config_restart_interval > 0) then
+ if (restart_frame == 1) call output_state_init(restart_obj, domain, "RESTART")
+ call output_state_for_domain(restart_obj, domain, restart_frame)
+ restart_frame = restart_frame + 1
+ end if
+ end do
+
+ end subroutine mpas_core_run
+
+
+ subroutine write_output_frame(output_obj, output_frame, domain)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Compute diagnostic fields for a domain and write model state to output file
+ !
+ ! Input/Output: domain - contains model state; diagnostic field are computed
+ ! before returning
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ use grid_types
+ use io_output
+
+ implicit none
+
+ integer, intent(inout) :: output_frame
+ type (domain_type), intent(inout) :: domain
+ type (io_output_object), intent(inout) :: output_obj
+
+ integer :: i, j, k
+ integer :: eoe
+ type (block_type), pointer :: block_ptr
+
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
+ block_ptr => block_ptr % next
+ end do
+
+ call output_state_for_domain(output_obj, domain, output_frame)
+ output_frame = output_frame + 1
+
+ end subroutine write_output_frame
+
+
+ subroutine compute_output_diagnostics(state, grid)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Compute diagnostic fields for a domain
+ !
+ ! Input: state - contains model prognostic fields
+ ! grid - contains grid metadata
+ !
+ ! Output: state - upon returning, diagnostic fields will have be computed
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ use grid_types
+
+ implicit none
+
+ type (state_type), intent(inout) :: state
+ type (mesh_type), intent(in) :: grid
+
+ integer :: i, eoe
+ integer :: iEdge, k
+
+ end subroutine compute_output_diagnostics
+
+
+ subroutine mpas_timestep(domain, itimestep, dt)
+
+ use grid_types
+ use time_integration
+ use timer
+ use global_diagnostics
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(in) :: itimestep
+ real (kind=RKIND), intent(in) :: dt
+ type (block_type), pointer :: block_ptr
+
+ call timestep(domain, dt)
+
+ if(config_stats_interval .gt. 0) then
+ if(mod(itimestep, config_stats_interval) == 0) then
+ 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 timer_start("global_diagnostics")
+ call computeGlobalDiagnostics(domain % dminfo, &
+ block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
+ itimestep, dt)
+ call timer_stop("global_diagnostics")
+ end if
+ end if
+
+ end subroutine mpas_timestep
+
+
+ subroutine mpas_core_finalize(domain)
+
+ use grid_types
+
+ implicit none
+
+ type (domain_type), intent(inout) :: domain
+
+ if (restart_frame > 1) call output_state_finalize(restart_obj, domain % dminfo)
+
+ end subroutine mpas_core_finalize
+
+end module mpas_core
Deleted: trunk/mpas/src/core_sw/mpas_interface.F
===================================================================
--- trunk/mpas/src/core_sw/mpas_interface.F 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/core_sw/mpas_interface.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -1,104 +0,0 @@
-subroutine mpas_setup_test_case(domain)
-
- use grid_types
- use test_cases
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- call setup_sw_test_case(domain)
-
-end subroutine mpas_setup_test_case
-
-
-subroutine mpas_init_domain(domain)
-! Initialize grid variables that are computed from the netcdf input file.
-
- use grid_types
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- ! This is currently a stub.
-
-end subroutine mpas_init_domain
-
-
-subroutine mpas_init(block, mesh, dt)
-
- use grid_types
- use time_integration
- use RBF_interpolation
- use vector_reconstruction
-
- implicit none
-
- type (block_type), intent(inout) :: block
- type (mesh_type), intent(inout) :: mesh
- real (kind=RKIND), intent(in) :: dt
-
- call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
-
- call rbfInterp_initialize(mesh)
- call init_reconstruct(mesh)
- call reconstruct(block % state % time_levs(1) % state, mesh)
-
-end subroutine mpas_init
-
-
-subroutine mpas_query(key, ivalue)
-
- implicit none
-
- character (len=256), intent(in) :: key
- integer, intent(out) :: ivalue
-
- if (index(key,'STORAGE_FACTOR') /= 0) then
- ivalue = 2
- end if
-
-end subroutine mpas_query
-
-
-subroutine mpas_timestep(domain, itimestep, dt)
-
- use grid_types
- use time_integration
- use timer
- use global_diagnostics
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
- integer, intent(in) :: itimestep
- real (kind=RKIND), intent(in) :: dt
- type (block_type), pointer :: block_ptr
-
- call timestep(domain, dt)
-
- if(config_stats_interval .gt. 0) then
- if(mod(itimestep, config_stats_interval) == 0) then
- 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 timer_start("global_diagnostics")
- call computeGlobalDiagnostics(domain % dminfo, &
- block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
- itimestep, dt)
- call timer_stop("global_diagnostics")
- end if
- end if
-
-end subroutine mpas_timestep
-
-
-subroutine mpas_finalize()
-
- implicit none
-
-end subroutine mpas_finalize
Modified: trunk/mpas/src/driver/Makefile
===================================================================
--- trunk/mpas/src/driver/Makefile 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/driver/Makefile 2010-11-12 18:21:35 UTC (rev 612)
@@ -1,13 +1,13 @@
.SUFFIXES: .F .o
-OBJS = module_subdriver.o \
+OBJS = module_mpas_subdriver.o \
mpas.o
all: $(OBJS)
-module_subdriver.o:
+module_mpas_subdriver.o:
-mpas.o: module_subdriver.o
+mpas.o: module_mpas_subdriver.o
clean:
$(RM) *.o *.mod *.f90
Copied: trunk/mpas/src/driver/module_mpas_subdriver.F (from rev 599, trunk/mpas/src/driver/module_subdriver.F)
===================================================================
--- trunk/mpas/src/driver/module_mpas_subdriver.F (rev 0)
+++ trunk/mpas/src/driver/module_mpas_subdriver.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -0,0 +1,86 @@
+module mpas_subdriver
+
+ use mpas_framework
+ use mpas_core
+
+ type (dm_info), pointer :: dminfo
+ type (domain_type), pointer :: domain
+ type (io_output_object) :: output_obj
+ integer :: output_frame
+
+
+ contains
+
+
+ subroutine mpas_init()
+
+ implicit none
+
+ real (kind=RKIND) :: dt
+
+ call timer_start("total time")
+ call timer_start("initialize")
+
+
+ !
+ ! Initialize infrastructure
+ !
+ call mpas_framework_init(dminfo, domain)
+
+
+ call input_state_for_domain(domain)
+
+
+ !
+ ! Initialize core
+ !
+ call mpas_core_init(domain)
+
+ call timer_stop("initialize")
+
+
+ !
+ ! Set up output streams to be written to by the MPAS core
+ !
+ output_frame = 1
+ call output_state_init(output_obj, domain, "OUTPUT")
+
+ end subroutine mpas_init
+
+
+ subroutine mpas_run()
+
+ implicit none
+
+ call mpas_core_run(domain, output_obj, output_frame)
+
+ end subroutine mpas_run
+
+
+ subroutine mpas_finalize()
+
+ implicit none
+
+ !
+ ! Finalize output streams
+ !
+ call output_state_finalize(output_obj, domain % dminfo)
+
+
+ !
+ ! Finalize core
+ !
+ call mpas_core_finalize(domain)
+
+ call timer_stop("total time")
+ call timer_write()
+
+
+ !
+ ! Finalize infrastructure
+ !
+ call mpas_framework_finalize(dminfo, domain)
+
+ end subroutine mpas_finalize
+
+end module mpas_subdriver
Deleted: trunk/mpas/src/driver/module_subdriver.F
===================================================================
--- trunk/mpas/src/driver/module_subdriver.F 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/driver/module_subdriver.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -1,150 +0,0 @@
-module subdriver
-
- use grid_types
- use io_output
- use configure
- use dmpar
- use timer
-
- integer :: output_frame
- integer :: restart_frame
-
- interface
- subroutine mpas_init(block, mesh, dt)
- use grid_types
- type (block_type), intent(inout) :: block
- type (mesh_type), intent(inout) :: mesh
- real (kind=RKIND), intent(in) :: dt
- end subroutine mpas_init
-
- subroutine mpas_timestep(domain, itimestep, dt)
- use grid_types
- type (domain_type), intent(inout) :: domain
- integer, intent(in) :: itimestep
- real (kind=RKIND), intent(in) :: dt
- end subroutine mpas_timestep
- end interface
-
-
- contains
-
-
- subroutine solve(domain)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Solve 2d shallow water equations over the time range specified in the
- ! namelist, writing model state to an output file periodically
- !
- ! Input/Output: domain - grid metadata and model state, to be advanced forward
- ! in time
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- integer :: ntimesteps, itimestep
- real (kind=RKIND) :: dt
- type (block_type), pointer :: block_ptr
- type (io_output_object) :: output_obj
- type (io_output_object) :: restart_obj
-
-
- ! Eventually, dt should be domain specific
- dt = config_dt
- ntimesteps = config_ntimesteps
-
-
- ! Compute diagnostic fields needed in solve loop, and initialize
- ! simulation time to 0 for all blocks
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
- call mpas_init(block_ptr, block_ptr % mesh, dt)
- if (.not. config_do_restart) block_ptr % state % time_levs(1) % state % xtime % scalar = 0.0
- block_ptr => block_ptr % next
- end do
-
- ! Before integrating, write out the initial state
- output_frame = 1
- restart_frame = 1
- call output_state_init(output_obj, domain, "OUTPUT")
- call write_output_frame(output_obj, domain)
-
-
- ! 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(...)
- do itimestep = 1,ntimesteps
- write(0,*) 'Doing timestep ', itimestep
- call timer_start("time integration")
- call mpas_timestep(domain, itimestep, dt)
- call timer_stop("time integration")
-
- ! Move time level 2 fields back into time level 1 for next time step
- call shift_time_levels_state(domain % blocklist % state)
-
- if (mod(itimestep, config_output_interval) == 0) then
- call write_output_frame(output_obj, domain)
- end if
- if (mod(itimestep, config_restart_interval) == 0 .and. config_restart_interval > 0) then
- if (restart_frame == 1) call output_state_init(restart_obj, domain, "RESTART")
- call output_state_for_domain(restart_obj, domain, restart_frame)
- restart_frame = restart_frame + 1
- end if
- end do
-
- call output_state_finalize(output_obj, domain % dminfo)
- if (restart_frame > 1) call output_state_finalize(restart_obj, domain % dminfo)
-
- end subroutine solve
-
-
- subroutine write_output_frame(output_obj, domain)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Compute diagnostic fields for a domain and write model state to output file
- !
- ! Input/Output: domain - contains model state; diagnostic field are computed
- ! before returning
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
- type (io_output_object), intent(inout) :: output_obj
-
- integer :: i, j, k
- integer :: eoe
- type (block_type), pointer :: block_ptr
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
- call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
- block_ptr => block_ptr % next
- end do
-
- call output_state_for_domain(output_obj, domain, output_frame)
- output_frame = output_frame + 1
-
- end subroutine write_output_frame
-
-
- subroutine compute_output_diagnostics(state, grid)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Compute diagnostic fields for a domain
- !
- ! Input: state - contains model prognostic fields
- ! grid - contains grid metadata
- !
- ! Output: state - upon returning, diagnostic fields will have be computed
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- type (state_type), intent(inout) :: state
- type (mesh_type), intent(in) :: grid
-
- integer :: i, eoe
- integer :: iEdge, k
-
- end subroutine compute_output_diagnostics
-
-
-end module subdriver
Modified: trunk/mpas/src/driver/mpas.F
===================================================================
--- trunk/mpas/src/driver/mpas.F 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/driver/mpas.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -1,51 +1,15 @@
program mpas
- use grid_types
- use configure
- use io_input
- use dmpar
- use timer
- use subdriver
+ use mpas_subdriver
implicit none
- interface mpas_setup_test_case
- subroutine mpas_setup_test_case(domain)
- use grid_types
- type (domain_type), intent(inout) :: domain
- end subroutine mpas_setup_test_case
- end interface mpas_setup_test_case
+ call mpas_init()
+ call mpas_run()
- type (dm_info), pointer :: dminfo
- type (domain_type), pointer :: domain
+ call mpas_finalize()
- allocate(dminfo)
- call dmpar_init(dminfo)
-
- call read_namelist(dminfo)
-
- call timer_start("total time")
-
- call timer_start("initialize")
- call allocate_domain(domain, dminfo)
-
- call input_state_for_domain(domain)
-
- call mpas_init_domain(domain)
-
- if (.not. config_do_restart) call mpas_setup_test_case(domain)
- call timer_stop("initialize")
-
- call solve(domain)
-
- call deallocate_domain(domain)
-
- call timer_stop("total time")
- call timer_write()
-
- call dmpar_finalize(dminfo)
-
stop
end program mpas
Modified: trunk/mpas/src/framework/Makefile
===================================================================
--- trunk/mpas/src/framework/Makefile 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/framework/Makefile 2010-11-12 18:21:35 UTC (rev 612)
@@ -4,7 +4,8 @@
ZOLTANOBJ = module_zoltan_interface.o
endif
-OBJS = module_timer.o \
+OBJS = module_mpas_framework.o \
+ module_timer.o \
module_configure.o \
module_constants.o \
module_grid_types.o \
@@ -22,6 +23,8 @@
framework: $(OBJS)
ar -ru libframework.a $(OBJS)
+module_mpas_framework.o: module_dmpar.o module_io_input.o module_io_output.o module_grid_types.o module_configure.o module_timer.o
+
module_configure.o: module_dmpar.o
module_grid_types.o: module_dmpar.o
Modified: trunk/mpas/src/framework/module_grid_types.F
===================================================================
--- trunk/mpas/src/framework/module_grid_types.F 2010-11-12 17:34:20 UTC (rev 611)
+++ trunk/mpas/src/framework/module_grid_types.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -93,7 +93,6 @@
! Derived type for storing part of a domain; used as a basic unit of work for a process
type block_type
- integer :: storageFactor ! Additional storage used by time integration scheme
#include "block_group_members.inc"
@@ -113,17 +112,7 @@
type (dm_info), pointer :: dminfo
end type domain_type
- !
- ! Solver interface routines provided by specific dycore
- !
- interface
- subroutine mpas_query(key, ivalue)
- character (len=256), intent(in) :: key
- integer, intent(out) :: ivalue
- end subroutine mpas_query
- end interface
-
contains
@@ -152,14 +141,10 @@
#include "dim_dummy_decls.inc"
integer :: i
- character (len=256) :: key
nullify(b % prev)
nullify(b % next)
- key = 'STORAGE_FACTOR'
- call mpas_query(key, b % storageFactor)
-
allocate(b % parinfo)
b % domain => dom
Added: trunk/mpas/src/framework/module_mpas_framework.F
===================================================================
--- trunk/mpas/src/framework/module_mpas_framework.F (rev 0)
+++ trunk/mpas/src/framework/module_mpas_framework.F 2010-11-12 18:21:35 UTC (rev 612)
@@ -0,0 +1,44 @@
+module mpas_framework
+
+ use dmpar
+ use grid_types
+ use io_input
+ use io_output
+ use configure
+ use timer
+
+
+ contains
+
+
+ subroutine mpas_framework_init(dminfo, domain)
+
+ implicit none
+
+ type (dm_info), pointer :: dminfo
+ type (domain_type), pointer :: domain
+
+ allocate(dminfo)
+ call dmpar_init(dminfo)
+
+ call read_namelist(dminfo)
+
+ call allocate_domain(domain, dminfo)
+
+ end subroutine mpas_framework_init
+
+
+ subroutine mpas_framework_finalize(dminfo, domain)
+
+ implicit none
+
+ type (dm_info), pointer :: dminfo
+ type (domain_type), pointer :: domain
+
+ call deallocate_domain(domain)
+
+ call dmpar_finalize(dminfo)
+
+ end subroutine mpas_framework_finalize
+
+end module mpas_framework
</font>
</pre>