<p><b>duda</b> 2010-09-16 12:44:25 -0600 (Thu, 16 Sep 2010)</p><p>BRANCH COMMIT<br>
<br>
Commit registry and framework changes for field storage re-organization.<br>
<br>
Note: To avoid scope conflict, definitions of super-array indices (e.g., index_qv)<br>
have been moved into the structures that immediately contain the super-arrays.<br>
For example, rather than scalars(index_qv, k, iCell), it will be necessary to use <br>
scalars(state % index_qv, k, iCell).<br>
<br>
Note: The order of arguments in copy_* routines (e.g., copy_state) has been changed<br>
so that the first argument is the destination and the second argument is the source;<br>
this was done to be more in line with the C standard library convention (e.g., memcpy).<br>
It would be trivial to change back to the original (src, dest) order if this causes<br>
too much confusion, though.<br>
<br>
Note: Until operators and core directories are converted to use new data types, <br>
the code will *not* compile.<br>
<br>
<br>
M registry/parse.c<br>
M registry/gen_inc.h<br>
M registry/gen_inc.c<br>
M registry/registry_types.h<br>
M framework/module_io_output.F<br>
M framework/module_grid_types.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/registry_reorg/src/framework/module_grid_types.F
===================================================================
--- branches/registry_reorg/src/framework/module_grid_types.F 2010-09-15 17:03:13 UTC (rev 499)
+++ branches/registry_reorg/src/framework/module_grid_types.F 2010-09-16 18:44:25 UTC (rev 500)
@@ -4,8 +4,7 @@
integer, parameter :: nTimeLevs = 2
-#include "super_array_indices.inc"
-
+
! Derived type describing info for doing I/O specific to a field
type io_info
character (len=1024) :: fieldName
@@ -66,7 +65,7 @@
! Derived type for storing grid meta-data
- type grid_meta
+ type mesh_type
#include "field_dimensions.inc"
@@ -75,21 +74,12 @@
#include "time_invariant_fields.inc"
- end type grid_meta
+ end type mesh_type
- ! Derived type for storing model state
- type grid_state
+#include "variable_groups.inc"
-#include "time_varying_fields.inc"
- end type grid_state
-
- type grid_state_ptr
- type (grid_state), pointer :: state
- end type grid_state_ptr
-
-
! Type for storing (possibly architecture specific) information concerning to parallelism
type parallel_info
type (exchange_list), pointer :: cellsToSend ! List of types describing which cells to send to other blocks
@@ -105,11 +95,8 @@
type block_type
integer :: storageFactor ! Additional storage used by time integration scheme
- type (grid_meta), pointer :: mesh
- type (grid_state_ptr), pointer, dimension(:) :: time_levs
+#include "block_group_members.inc"
- type (grid_state), allocatable, dimension(:) :: intermediate_step
-
type (domain_type), pointer :: domain
type (parallel_info), pointer :: parinfo
@@ -170,60 +157,21 @@
nullify(b % prev)
nullify(b % next)
- allocate(b % time_levs(nTimeLevs))
-
- allocate(b % mesh)
- call allocate_grid_meta(b % mesh, &
-#include "dim_dummy_args.inc"
- )
-
- do i=1,nTimeLevs
- allocate(b % time_levs(i) % state)
- call allocate_grid_state(b % time_levs(i) % state, b)
- end do
-
key = 'STORAGE_FACTOR'
call mpas_query(key, b % storageFactor)
- ! Allocate storage for intermediate steps used by time integration scheme
- allocate(b % intermediate_step(b % storageFactor))
- do i=1,b % storageFactor
- call allocate_grid_state(b % intermediate_step(i), b)
- end do
-
allocate(b % parinfo)
b % domain => dom
+#include "block_allocs.inc"
+
end subroutine allocate_block
- subroutine allocate_grid_meta(g, &
-#include "dim_dummy_args.inc"
- )
+#include "group_alloc_routines.inc"
- implicit none
- type (grid_meta), intent(inout) :: g
-#include "dim_dummy_decls.inc"
-
-#include "grid_meta_allocs.inc"
-
- end subroutine allocate_grid_meta
-
-
- subroutine allocate_grid_state(s, b)
-
- implicit none
-
- type (grid_state), intent(inout) :: s
- type (block_type), pointer :: b
-
-#include "grid_state_allocs.inc"
-
- end subroutine allocate_grid_state
-
-
subroutine deallocate_domain(dom)
implicit none
@@ -251,78 +199,19 @@
integer :: i
- call deallocate_grid_meta(b % mesh)
- deallocate(b % mesh)
- do i=1,nTimeLevs
- call deallocate_grid_state(b % time_levs(i) % state)
- deallocate(b % time_levs(i) % state)
- end do
- deallocate(b % time_levs)
- do i=1,b % storageFactor
- call deallocate_grid_state(b % intermediate_step(i))
- end do
- deallocate(b % intermediate_step)
deallocate(b % parinfo)
+#include "block_deallocs.inc"
+
end subroutine deallocate_block
- subroutine deallocate_grid_meta(g)
+#include "group_dealloc_routines.inc"
- implicit none
- type (grid_meta), intent(inout) :: g
+#include "group_copy_routines.inc"
-#include "grid_meta_deallocs.inc"
- end subroutine deallocate_grid_meta
+#include "group_shift_level_routines.inc"
-
- subroutine deallocate_grid_state(s)
-
- implicit none
-
- type (grid_state), intent(inout) :: s
-
-#include "grid_state_deallocs.inc"
-
- end subroutine deallocate_grid_state
-
-
- subroutine copy_state(src, dest)
-
- implicit none
-
- type (grid_state), intent(in) :: src
- type (grid_state), intent(inout) :: dest
-
-#include "copy_state.inc"
-
- end subroutine copy_state
-
-
- subroutine shift_time_levels(domain)
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- integer :: i
- type (block_type), pointer :: block_ptr
- type (grid_state), pointer :: sptr
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
-
- sptr => block_ptr % time_levs(1) % state
- do i=1,nTimeLevs-1
- block_ptr % time_levs(i) % state => block_ptr % time_levs(i+1) % state
- end do
- block_ptr % time_levs(nTimeLevs) % state => sptr
-
- block_ptr => block_ptr % next
- end do
-
- end subroutine shift_time_levels
-
end module grid_types
Modified: branches/registry_reorg/src/framework/module_io_output.F
===================================================================
--- branches/registry_reorg/src/framework/module_io_output.F 2010-09-15 17:03:13 UTC (rev 499)
+++ branches/registry_reorg/src/framework/module_io_output.F 2010-09-16 18:44:25 UTC (rev 500)
@@ -337,7 +337,7 @@
type (io_output_object), intent(inout) :: output_obj
type (dm_info), intent(in) :: dminfo
- type (grid_meta), intent(in) :: mesh
+ type (mesh_type), intent(in) :: mesh
#include "dim_dummy_decls.inc"
integer :: nferr
Modified: branches/registry_reorg/src/registry/gen_inc.c
===================================================================
--- branches/registry_reorg/src/registry/gen_inc.c 2010-09-15 17:03:13 UTC (rev 499)
+++ branches/registry_reorg/src/registry/gen_inc.c 2010-09-16 18:44:25 UTC (rev 500)
@@ -150,12 +150,15 @@
}
-void gen_field_defs(struct variable * vars, struct dimension * dims)
+void gen_field_defs(struct group_list * groups, struct variable * vars, struct dimension * dims)
{
struct variable * var_ptr;
struct variable * var_ptr2;
+ struct variable_list * var_list_ptr;
+ struct variable_list * var_list_ptr2;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr;
+ struct group_list * group_ptr;
FILE * fd;
char super_array[1024];
char array_class[1024];
@@ -163,59 +166,7 @@
int class_start, class_end;
int vtype;
- /*
- * Generate indices for super arrays
- */
- fd = fopen("super_array_indices.inc", "w");
- var_ptr = vars;
- memcpy(super_array, var_ptr->super_array, 1024);
- i = 1;
- while (var_ptr) {
- if (strncmp(super_array, var_ptr->super_array, 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- i = 1;
- }
- if (strncmp(var_ptr->array_class, "-", 1024) != 0) fortprintf(fd, " integer :: index_%s = %i</font>
<font color="red">", var_ptr->name_in_code, i++);
- var_ptr = var_ptr->next;
- }
- var_ptr = vars;
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- class_start = 1;
- class_end = 1;
- i = 1;
- while (var_ptr) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (strncmp(super_array, var_ptr->super_array, 1024) != 0) {
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="red">", array_class, class_end);
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="red">", super_array, i);
- class_start = 1;
- class_end = 1;
- i = 1;
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
- }
- else if (strncmp(array_class, var_ptr->array_class, 1024) != 0) {
- fortprintf(fd, " integer :: %s_end = %i</font>
<font color="red">", array_class, class_end);
- class_start = class_end+1;
- class_end = class_start;
- memcpy(array_class, var_ptr->array_class, 1024);
- fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
- i++;
- }
- else {
- class_end++;
- i++;
- }
- }
- var_ptr = var_ptr->next;
- }
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="red">", array_class, class_end);
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="gray">", super_array, i);
- fclose(fd);
-
/*
* Generate declarations of dimensions
*/
@@ -311,96 +262,278 @@
/*
- * Generate declarations of time-invariant fields
+ * Generate declarations of mesh group
*/
fd = fopen("time_invariant_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 0) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ group_ptr = groups;
+ while (group_ptr) {
+
+ if (!strncmp(group_ptr->name, "mesh", 1024)) {
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ }
+ if (strncmp(var_list_ptr->var->array_class, "-", 1024) != 0) fortprintf(fd, " integer :: index_%s = %i</font>
<font color="blue">", var_list_ptr->var->name_in_code, i++);
+ var_list_ptr = var_list_ptr->next;
+ }
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(var_list_ptr->var->super_array, "-", 1024) != 0) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="blue">", array_class, class_start);
+ }
+ else if (strncmp(array_class, var_list_ptr->var->array_class, 1024) != 0) {
+ fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ class_start = class_end+1;
+ class_end = class_start;
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
+ i++;
+ }
+ else {
+ class_end++;
+ i++;
+ }
}
- if (vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
- if (vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
+ var_list_ptr = var_list_ptr->next;
}
- else {
- if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- var_ptr = var_ptr->next;
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
+ if (!strncmp(var_ptr->super_array, "-", 1024)) {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ }
+ else {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", var_ptr->ndims+1, var_ptr->super_array);
+ while (var_list_ptr->next && !strncmp(var_list_ptr->next->var->super_array, var_list_ptr->var->super_array, 1024)) var_list_ptr = var_list_ptr->next;
+ }
+ var_list_ptr = var_list_ptr->next;
}
+ break;
}
- else
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
/*
- * Generate declarations of time-invariant fields
+ * Generate declarations of non-mesh groups
*/
- fd = fopen("time_varying_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ fd = fopen("variable_groups.inc", "w");
+
+ group_ptr = groups;
+ while (group_ptr) {
+ if (strncmp(group_ptr->name, "mesh", 1024)) {
+ fortprintf(fd, " type %s_type</font>
<font color="blue">", group_ptr->name);
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ }
+ if (strncmp(var_list_ptr->var->array_class, "-", 1024) != 0) fortprintf(fd, " integer :: index_%s = %i</font>
<font color="blue">", var_list_ptr->var->name_in_code, i++);
+ var_list_ptr = var_list_ptr->next;
+ }
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(var_list_ptr->var->super_array, "-", 1024) != 0) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="blue">", array_class, class_start);
+ }
+ else if (strncmp(array_class, var_list_ptr->var->array_class, 1024) != 0) {
+ fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ class_start = class_end+1;
+ class_end = class_start;
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
+ i++;
+ }
+ else {
+ class_end++;
+ i++;
+ }
}
- if (vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
- if (vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
+ var_list_ptr = var_list_ptr->next;
}
- else {
- if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- var_ptr = var_ptr->next;
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
+ if (!strncmp(var_ptr->super_array, "-", 1024)) {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ }
+ else {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ while (var_list_ptr->next && !strncmp(var_list_ptr->next->var->super_array, var_list_ptr->var->super_array, 1024)) var_list_ptr = var_list_ptr->next;
+ }
+ var_list_ptr = var_list_ptr->next;
}
+
+ fortprintf(fd, " end type %s_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " type %s_pointer_type</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " type (%s_type), pointer :: %s </font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " end type %s_pointer_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+
+ fortprintf(fd, " type %s_multilevel_type</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " integer :: nTimeLevels</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_pointer_type), dimension(:), pointer :: time_levs</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " end type %s_multilevel_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">", group_ptr->name);
+ }
+
}
- else
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
-
/*
- * Generate grid metadata allocations
+ * Generate instantiations of variable groups in block_type
*/
- fd = fopen("grid_meta_allocs.inc", "w");
+ fd = fopen("block_group_members.inc", "w");
- dim_ptr = dims;
- while (dim_ptr) {
- if (dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " g %% %s = %s</font>
<font color="red">", dim_ptr->name_in_code, dim_ptr->name_in_code);
- if (dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " g %% %s = %s</font>
<font color="red">", dim_ptr->name_in_file, dim_ptr->name_in_file);
- dim_ptr = dim_ptr->next;
+ group_ptr = groups;
+ while (group_ptr) {
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ fortprintf(fd, " type (%s_multilevel_type), pointer :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ else
+ fortprintf(fd, " type (%s_type), pointer :: %s</font>
<font color="red">", group_ptr->name, group_ptr->name);
+ group_ptr = group_ptr->next;
}
- fortprintf(fd, "</font>
<font color="red">");
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 0) {
+ fclose(fd);
+
+
+ /* To be included in allocate_block */
+ fd = fopen("block_allocs.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " allocate(b %% %s)</font>
<font color="blue">", group_ptr->name);
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " b %% %s %% nTimeLevels = %i</font>
<font color="blue">", group_ptr->name, group_ptr->vlist->var->ntime_levs);
+ fortprintf(fd, " allocate(b %% %s %% time_levs(%i))</font>
<font color="blue">", group_ptr->name, group_ptr->vlist->var->ntime_levs);
+ fortprintf(fd, " do i=1,b %% %s %% nTimeLevels</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " allocate(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " call allocate_%s(b %% %s %% time_levs(i) %% %s, &</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_args.inc\"</font>
<font color="blue">");
+ fortprintf(fd, " )</font>
<font color="blue">");
+ fortprintf(fd, " end do</font>
<font color="black"></font>
<font color="blue">");
+ }
+ else {
+ fortprintf(fd, " call allocate_%s(b %% %s, &</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_args.inc\"</font>
<font color="blue">");
+ fortprintf(fd, " )</font>
<font color="black"></font>
<font color="blue">");
+ }
+ group_ptr = group_ptr->next;
+ }
+ fclose(fd);
+
+
+ /* To be included in deallocate_block */
+ fd = fopen("block_deallocs.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " do i=1,b %% %s %% nTimeLevels</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " call deallocate_%s(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, " deallocate(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " deallocate(b %% %s %% time_levs)</font>
<font color="blue">", group_ptr->name);
+ }
+ else {
+ fortprintf(fd, " call deallocate_%s(b %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ }
+ fortprintf(fd, " deallocate(b %% %s)</font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+ group_ptr = group_ptr->next;
+ }
+ fclose(fd);
+
+ /* Definitions of allocate subroutines */
+ fd = fopen("group_alloc_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " subroutine allocate_%s(%s, &</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_args.inc\"</font>
<font color="blue">");
+ fortprintf(fd, " )</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), intent(inout) :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_decls.inc\"</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+
+ if (!strncmp(group_ptr->name, "mesh", 1024)) {
+ dim_ptr = dims;
+ while (dim_ptr) {
+ if (dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " %s %% %s = %s</font>
<font color="blue">", group_ptr->name, dim_ptr->name_in_code, dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " %s %% %s = %s</font>
<font color="blue">", group_ptr->name, dim_ptr->name_in_file, dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+ fortprintf(fd, "</font>
<font color="red">");
+ }
+
+
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
memcpy(super_array, var_ptr->super_array, 1024);
memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ var_list_ptr2 = var_list_ptr;
+ var_list_ptr = var_list_ptr->next;
}
- fortprintf(fd, " allocate(g %% %s)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(g %% %s %% array(%i, ", var_ptr2->super_array, i);
+ var_ptr2 = var_list_ptr2->var;
+ fortprintf(fd, " allocate(%s %% %s)</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " allocate(%s %% %s %% ioinfo)</font>
<font color="gray">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " allocate(%s %% %s %% array(%i, ", group_ptr->name, var_ptr2->super_array, i);
dimlist_ptr = var_ptr2->dimlist;
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
@@ -421,29 +554,29 @@
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " g %% %s %% array = 0</font>
<font color="blue">", var_ptr2->super_array ); /* initialize field to zero */
+ fortprintf(fd, " %s %% %s %% array = 0</font>
<font color="red">", group_ptr->name, var_ptr2->super_array ); /* initialize field to zero */
if (var_ptr2->iostreams & INPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
else
- fortprintf(fd, " g %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
if (var_ptr2->iostreams & RESTART0)
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
else
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
if (var_ptr2->iostreams & OUTPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
else
- fortprintf(fd, " g %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .false.</font>
<font color="black">", group_ptr->name, var_ptr2->super_array);
fortprintf(fd, "</font>
<font color="red">");
}
else {
- fortprintf(fd, " allocate(g %% %s)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " allocate(%s %% %s)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " allocate(%s %% %s %% ioinfo)</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->ndims > 0) {
- fortprintf(fd, " allocate(g %% %s %% array(", 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) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
@@ -464,306 +597,104 @@
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " g %% %s %% array = 0</font>
<font color="blue">", var_ptr->name_in_code ); /* initialize field to zero */
+ fortprintf(fd, " %s %% %s %% array = 0</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code ); /* initialize field to zero */
}
if (var_ptr->iostreams & INPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
else
- fortprintf(fd, " g %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->iostreams & RESTART0)
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
else
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->iostreams & OUTPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
else
- fortprintf(fd, " g %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .false.</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, "</font>
<font color="red">");
- var_ptr = var_ptr->next;
+ var_list_ptr = var_list_ptr->next;
}
}
- else
- var_ptr = var_ptr->next;
- }
+ fortprintf(fd, " end subroutine allocate_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+ group_ptr = group_ptr->next;
+ }
fclose(fd);
+
+ /* Definitions of deallocate subroutines */
+ fd = fopen("group_dealloc_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " subroutine deallocate_%s(%s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), intent(inout) :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="red">");
-
- /*
- * Generate grid metadata deallocations
- */
- fd = fopen("grid_meta_deallocs.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 0) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
memcpy(super_array, var_ptr->super_array, 1024);
memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ var_list_ptr2 = var_list_ptr;
+ var_list_ptr = var_list_ptr->next;
}
- fortprintf(fd, " deallocate(g %% %s %% array)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " deallocate(%s %% %s %% array)</font>
<font color="blue">", group_ptr->name, var_list_ptr2->var->super_array);
+ fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_list_ptr2->var->super_array);
+ fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">", group_ptr->name, var_list_ptr2->var->super_array);
}
else {
if (var_ptr->ndims > 0) {
- fortprintf(fd, " deallocate(g %% %s %% array)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s %% array)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
}
else {
- fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
}
- var_ptr = var_ptr->next;
+ var_list_ptr = var_list_ptr->next;
}
}
- else
- var_ptr = var_ptr->next;
- }
- fclose(fd);
-
-
- /*
- * Generate grid state allocations
- */
- fd = fopen("grid_state_allocs.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1 && var_ptr->ndims > 0) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
- }
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% array(%i, ", var_ptr2->super_array, i);
- dimlist_ptr = var_ptr2->dimlist;
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, "b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- dimlist_ptr = dimlist_ptr->next;
- while (dimlist_ptr) {
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, ", b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- dimlist_ptr = dimlist_ptr->next;
- }
- fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, "</font>
<font color="red">");
- }
- else {
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(s %% %s %% array(", var_ptr->name_in_code);
- dimlist_ptr = var_ptr->dimlist;
- if (dimlist_ptr->dim->constant_value < 0) {
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, "b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- }
- else {
- fortprintf(fd, "%i", dimlist_ptr->dim->constant_value);
- }
- dimlist_ptr = dimlist_ptr->next;
- while (dimlist_ptr) {
- if (dimlist_ptr->dim->constant_value < 0) {
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, ", b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- }
- else {
- fortprintf(fd, ", %i", dimlist_ptr->dim->constant_value);
- }
- dimlist_ptr = dimlist_ptr->next;
- }
- fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, "</font>
<font color="red">");
- var_ptr = var_ptr->next;
- }
- }
- else if (var_ptr->timedim == 1) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
- }
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% array(%i)", var_ptr->name_in_code, i);
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, "</font>
<font color="red">");
- }
- else {
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, "</font>
<font color="red">");
- var_ptr = var_ptr->next;
- }
- }
- else
- var_ptr = var_ptr->next;
+ fortprintf(fd, " end subroutine deallocate_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">", group_ptr->name);
+ group_ptr = group_ptr->next;
}
-
fclose(fd);
-
- /*
- * Generate grid state deallocations
- */
- fd = fopen("grid_state_deallocs.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1) {
+ /* Definitions of copy subroutines */
+ fd = fopen("group_copy_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " subroutine copy_%s(dest, src)</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), intent(in) :: src</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " type (%s_type), intent(inout) :: dest</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, "</font>
<font color="red">");
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
memcpy(super_array, var_ptr->super_array, 1024);
memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ var_list_ptr2 = var_list_ptr;
+ var_list_ptr = var_list_ptr->next;
}
- fortprintf(fd, " deallocate(s %% %s %% array)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(s %% %s)</font>
<font color="black"></font>
<font color="red">", var_ptr2->super_array);
- }
- else {
- if (var_ptr->ndims > 0) fortprintf(fd, " deallocate(s %% %s %% array)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(s %% %s)</font>
<font color="black"></font>
<font color="red">", var_ptr->name_in_code);
- var_ptr = var_ptr->next;
- }
- }
- else
- var_ptr = var_ptr->next;
- }
-
- fclose(fd);
-
-
- /*
- * Generate copies of state arrays
- */
- fd = fopen("copy_state.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
- }
+ var_ptr2 = var_list_ptr2->var;
if (var_ptr2->ndims > 0)
fortprintf(fd, " dest %% %s %% array = src %% %s %% array</font>
<font color="gray">", var_ptr2->super_array, var_ptr2->super_array);
else
@@ -774,26 +705,56 @@
fortprintf(fd, " dest %% %s %% array = src %% %s %% array</font>
<font color="black">", var_ptr->name_in_code, var_ptr->name_in_code);
else
fortprintf(fd, " dest %% %s %% scalar = src %% %s %% scalar</font>
<font color="red">", var_ptr->name_in_code, var_ptr->name_in_code);
- var_ptr = var_ptr->next;
+ var_list_ptr = var_list_ptr->next;
}
}
- else
- var_ptr = var_ptr->next;
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " end subroutine copy_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+ group_ptr = group_ptr->next;
}
+ fclose(fd);
+ /* Definitions of shift_time_level subroutines */
+ fd = fopen("group_shift_level_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " subroutine shift_time_levels_%s(%s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_multilevel_type), intent(inout) :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " integer :: i</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), pointer :: sptr</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " sptr => %s %% time_levs(1) %% %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " do i=1,%s %% nTimeLevels-1</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " %s %% time_levs(i) %% %s => %s %% time_levs(i+1) %% %s</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " %s %% time_levs(%s %% nTimeLevels) %% %s => sptr</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " end subroutine shift_time_levels_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="gray">", group_ptr->name);
+ }
+ group_ptr = group_ptr->next;
+ }
fclose(fd);
+
}
-void gen_reads(struct variable * vars, struct dimension * dims)
+void gen_reads(struct group_list * groups, struct variable * vars, struct dimension * dims)
{
struct variable * var_ptr;
+ struct variable_list * var_list_ptr;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr, * lastdim;
+ struct group_list * group_ptr;
struct dtable * dictionary;
FILE * fd;
char vtype[5];
char fname[32];
+ char struct_deref[1024];
char * cp1, * cp2;
int i, j;
int ivtype;
@@ -835,124 +796,73 @@
*/
fd = fopen("io_input_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
- if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
- else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
+ group_ptr = groups;
+ while (group_ptr) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((block %% time_levs(1) %% state %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (block %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->super_array);
- }
- else {
- fortprintf(fd, " if ((block %% mesh %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (block %% mesh %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->super_array);
- }
- }
- else {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((block %% time_levs(1) %% state %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (block %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- else {
- fortprintf(fd, " if ((block %% mesh %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (block %% mesh %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- }
- vert_dim = 0;
- while (dimlist_ptr) {
- if (i < var_ptr->ndims) {
- has_vert_dim = !strcmp( "nVertLevels", dimlist_ptr->dim->name_in_code);
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- if (has_vert_dim) {
- vert_dim = i;
- fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " if (.not. config_do_restart) then</font>
<font color="red">");
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- fortprintf(fd, " else</font>
<font color="red">");
- fortprintf(fd, "#endif</font>
<font color="red">");
- }
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- if (has_vert_dim) {
- fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " end if</font>
<font color="red">");
- fortprintf(fd, "#endif</font>
<font color="red">");
- }
- }
- else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount%s</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else {
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
- }
- }
- dimlist_ptr = dimlist_ptr->next;
- i++;
- }
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ snprintf(struct_deref, 1024, "block %% %s %% time_levs(1) %% %s", group_ptr->name, group_ptr->name);
+ else
+ snprintf(struct_deref, 1024, "block %% %s", group_ptr->name);
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
i = 1;
dimlist_ptr = var_ptr->dimlist;
+ if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
+ else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
- if (i < var_ptr->ndims) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", struct_deref, var_ptr->super_array);
}
else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, "read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else
- fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_code+1);
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", struct_deref, var_ptr->name_in_code);
}
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
+ vert_dim = 0;
while (dimlist_ptr) {
- if (i < var_ptr->ndims) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
- }
- else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
+ if (i < var_ptr->ndims) {
+ has_vert_dim = !strcmp( "nVertLevels", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ if (has_vert_dim) {
+ vert_dim = i;
+ fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="blue">");
+ fortprintf(fd, " if (.not. config_do_restart) then</font>
<font color="blue">");
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, "#endif</font>
<font color="blue">");
+ }
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ if (has_vert_dim) {
+ fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="blue">");
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, "#endif</font>
<font color="red">");
+ }
}
- else
- fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
- }
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">", vtype, var_ptr->ndims, i, cp1);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount%s</font>
<font color="blue">", vtype, var_ptr->ndims, i, cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
+ }
+ }
dimlist_ptr = dimlist_ptr->next;
i++;
}
- fortprintf(fd, "))</font>
<font color="black"></font>
<font color="gray">");
-
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
i = 1;
dimlist_ptr = var_ptr->dimlist;
@@ -963,166 +873,203 @@
else
fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
}
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, "read%sCount%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_code+1);
+ }
+
dimlist_ptr = dimlist_ptr->next;
i++;
while (dimlist_ptr) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ if (i < var_ptr->ndims) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ }
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", read%sCount%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
+ }
dimlist_ptr = dimlist_ptr->next;
i++;
}
fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
- }
- }
-
- fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_file);
- if (var_ptr->timedim)
- fortprintf(fd, " call io_input_field_time(input_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- else
- fortprintf(fd, " call io_input_field(input_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
-
- if (vert_dim > 0) {
- fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " if (.not. config_do_restart) then</font>
<font color="red">");
- fortprintf(fd, " do k=2,EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " %s%id %% array(", vtype, var_ptr->ndims);
- for (i=1; i<=var_ptr->ndims; i++) {
- if (i > 1) fortprintf(fd, ",");
- fortprintf(fd, "%s", i == vert_dim ? "k" : ":");
- }
- fortprintf(fd, ") = %s%id %% array(", vtype, var_ptr->ndims);
- for (i=1; i<=var_ptr->ndims; i++) {
- if (i > 1) fortprintf(fd, ",");
- fortprintf(fd, "%s", i == vert_dim ? "1" : ":");
- }
- fortprintf(fd, ")</font>
<font color="red">");
- fortprintf(fd, " end do</font>
<font color="red">");
- fortprintf(fd, " end if</font>
<font color="red">");
- fortprintf(fd, "#endif</font>
<font color="red">");
- }
-
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " call dmpar_alltoall_field(dminfo, &</font>
<font color="red">");
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->timedim)
- fortprintf(fd, " %s%id %% array, super_%s%id, &</font>
<font color="red">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
- else
- fortprintf(fd, " %s%id %% array, super_%s%id, &</font>
<font color="red">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
- }
- else {
- if (var_ptr->timedim)
- fortprintf(fd, " %s%id %% array, block %% time_levs(1) %% state %% %s %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- else
- fortprintf(fd, " %s%id %% array, block %% mesh %% %s %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- }
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
- if (i < var_ptr->ndims)
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
- else {
- lastdim = dimlist_ptr;
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
+ if (i < var_ptr->ndims) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ }
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ while (dimlist_ptr) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+ fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
}
- else
- fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_code+1);
}
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
- while (dimlist_ptr) {
+
+ fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_file);
+ if (var_ptr->timedim)
+ fortprintf(fd, " call io_input_field_time(input_obj, %s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " call io_input_field(input_obj, %s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+
+ if (vert_dim > 0) {
+ fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="blue">");
+ fortprintf(fd, " if (.not. config_do_restart) then</font>
<font color="blue">");
+ fortprintf(fd, " do k=2,EXPAND_LEVELS</font>
<font color="blue">");
+ fortprintf(fd, " %s%id %% array(", vtype, var_ptr->ndims);
+ for (i=1; i<=var_ptr->ndims; i++) {
+ if (i > 1) fortprintf(fd, ",");
+ fortprintf(fd, "%s", i == vert_dim ? "k" : ":");
+ }
+ fortprintf(fd, ") = %s%id %% array(", vtype, var_ptr->ndims);
+ for (i=1; i<=var_ptr->ndims; i++) {
+ if (i > 1) fortprintf(fd, ",");
+ fortprintf(fd, "%s", i == vert_dim ? "1" : ":");
+ }
+ fortprintf(fd, ")</font>
<font color="blue">");
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, "#endif</font>
<font color="blue">");
+ }
+
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " call dmpar_alltoall_field(dminfo, &</font>
<font color="blue">");
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " %s%id %% array, super_%s%id, &</font>
<font color="blue">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " %s%id %% array, %s %% %s %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, struct_deref, var_ptr->name_in_code);
+
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+
if (i < var_ptr->ndims)
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
else {
lastdim = dimlist_ptr;
if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", read%sCount%s", cp1, cp2);
+ fortprintf(fd, " read%sCount%s", cp1, cp2);
free(cp1);
free(cp2);
}
else
- fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
+ fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_code+1);
}
+
dimlist_ptr = dimlist_ptr->next;
i++;
- }
- fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="red">", lastdim->dim->name_in_code);
-
- if (is_derived_dim(lastdim->dim->name_in_code)) {
- fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
- }
- else
- fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
-
-
- /* Copy from super_ array to field */
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
- while (i <= var_ptr->ndims) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " do i%i=1,%s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
-
- i++;
+ while (dimlist_ptr) {
+ if (i < var_ptr->ndims)
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ else {
+ lastdim = dimlist_ptr;
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", read%sCount%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
+ }
dimlist_ptr = dimlist_ptr->next;
+ i++;
}
-
- if (var_ptr->timedim)
- fortprintf(fd, " block %% time_levs(1) %% state %% %s %% array(index_%s,", var_ptr->super_array, var_ptr->name_in_code);
- else
- fortprintf(fd, " block %% mesh %% %s %% array(index_%s,", var_ptr->super_array, var_ptr->name_in_code);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, "i%i",i);
- if (i < var_ptr->ndims) fortprintf(fd, ",");
+ fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="blue">", lastdim->dim->name_in_code);
+
+ if (is_derived_dim(lastdim->dim->name_in_code)) {
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
}
- fortprintf(fd, ") = super_%s%id(", vtype, var_ptr->ndims);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, "i%i",i);
- if (i < var_ptr->ndims) fortprintf(fd, ",");
- }
- fortprintf(fd, ")</font>
<font color="blue">");
+ else
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
- i = 1;
- while (i <= var_ptr->ndims) {
- fortprintf(fd, " end do</font>
<font color="red">");
- i++;
+
+ /* Copy from super_ array to field */
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+ while (i <= var_ptr->ndims) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " do i%i=1,%s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+
+ i++;
+ dimlist_ptr = dimlist_ptr->next;
+ }
+
+ fortprintf(fd, " %s %% %s %% array(%s %% index_%s,", struct_deref, var_ptr->super_array, struct_deref, var_ptr->name_in_code);
+
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, "i%i",i);
+ if (i < var_ptr->ndims) fortprintf(fd, ",");
+ }
+ fortprintf(fd, ") = super_%s%id(", vtype, var_ptr->ndims);
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, "i%i",i);
+ if (i < var_ptr->ndims) fortprintf(fd, ",");
+ }
+ fortprintf(fd, ")</font>
<font color="blue">");
+
+ i = 1;
+ while (i <= var_ptr->ndims) {
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ i++;
+ }
}
+
+ fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
}
-
- fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="red">", vtype, var_ptr->ndims);
- if (strncmp(var_ptr->super_array, "-", 1024) != 0)
- fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ else {
+ fortprintf(fd, " %s %% %s %% scalar = %s%id %% scalar</font>
<font color="blue">", struct_deref, var_ptr->name_in_code, vtype, var_ptr->ndims);
+ }
+
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="red">");
+
+ var_list_ptr = var_list_ptr->next;
}
- else {
- if (var_ptr->timedim)
- fortprintf(fd, " block %% time_levs(1) %% state %% %s %% scalar = %s%id %% scalar</font>
<font color="red">", var_ptr->name_in_code, vtype, var_ptr->ndims);
- else
- fortprintf(fd, " block %% mesh %% %s %% scalar = %s%id %% scalar</font>
<font color="red">", var_ptr->name_in_code, vtype, var_ptr->ndims);
- }
-
- fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="gray">");
-
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
@@ -1253,16 +1200,19 @@
}
-void gen_writes(struct variable * vars, struct dimension * dims, struct namelist * namelists)
+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 dimension * dim_ptr;
struct dimension_list * dimlist_ptr, * lastdim;
+ struct group_list * group_ptr;
struct dtable * dictionary;
struct namelist * nl;
FILE * fd;
char vtype[5];
char fname[32];
+ char struct_deref[1024];
char * cp1, * cp2;
int i, j;
int ivtype;
@@ -1409,226 +1359,215 @@
*/
fd = fopen("io_output_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
- if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
- else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
+ group_ptr = groups;
+ while (group_ptr) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->super_array);
- }
- else {
- fortprintf(fd, " if ((domain %% blocklist %% mesh %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (domain %% blocklist %% mesh %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->super_array);
- }
- }
- else {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- else {
- fortprintf(fd, " if ((domain %% blocklist %% mesh %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (domain %% blocklist %% mesh %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- }
-
- if (var_ptr->ndims > 0) {
- while (dimlist_ptr) {
- if (i < var_ptr->ndims) {
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- }
- else {
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = n%sGlobal%s</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- }
- dimlist_ptr = dimlist_ptr->next;
- i++;
- }
-
- fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ snprintf(struct_deref, 1024, "domain %% blocklist %% %s %% time_levs(1) %% %s", group_ptr->name, group_ptr->name);
+ else
+ snprintf(struct_deref, 1024, "domain %% blocklist %% %s", group_ptr->name);
+
i = 1;
dimlist_ptr = var_ptr->dimlist;
+ if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
+ else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
- if (i < var_ptr->ndims)
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", struct_deref, var_ptr->super_array);
+ }
else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, "n%sGlobal%s", cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else
- fortprintf(fd, "%sGlobal", dimlist_ptr->dim->name_in_code);
- lastdim = dimlist_ptr;
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", struct_deref, var_ptr->name_in_code);
}
- dimlist_ptr = dimlist_ptr->next;
- i++;
- while (dimlist_ptr) {
+
+ if (var_ptr->ndims > 0) {
+ while (dimlist_ptr) {
+ if (i < var_ptr->ndims) {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ }
+ else {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = n%sGlobal%s</font>
<font color="blue">", vtype, var_ptr->ndims, i, cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ }
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+
+ fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+
if (i < var_ptr->ndims)
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
else {
if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", n%sGlobal%s", cp1, cp2);
+ fortprintf(fd, "n%sGlobal%s", cp1, cp2);
free(cp1);
free(cp2);
}
else
- fortprintf(fd, ", %sGlobal", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, "%sGlobal", dimlist_ptr->dim->name_in_code);
lastdim = dimlist_ptr;
}
dimlist_ptr = dimlist_ptr->next;
i++;
- }
- fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
-
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+ while (dimlist_ptr) {
+ if (i < var_ptr->ndims)
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", n%sGlobal%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, ", %sGlobal", dimlist_ptr->dim->name_in_code);
+ lastdim = dimlist_ptr;
+ }
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+ fortprintf(fd, "))</font>
<font color="black"></font>
<font color="blue">");
+
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+ while (dimlist_ptr) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+
+ if (i < var_ptr->ndims) fortprintf(fd, ", ");
+
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+ fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
+ }
+
+ /* Copy from field to super_ array */
i = 1;
dimlist_ptr = var_ptr->dimlist;
- while (dimlist_ptr) {
+ while (i <= var_ptr->ndims) {
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " do i%i=1,%s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
- if (i < var_ptr->ndims) fortprintf(fd, ", ");
-
+ i++;
dimlist_ptr = dimlist_ptr->next;
+ }
+
+ fortprintf(fd, " super_%s%id(", vtype, var_ptr->ndims);
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, "i%i",i);
+ if (i < var_ptr->ndims) fortprintf(fd, ",");
+ }
+ fortprintf(fd, ") = %s %% %s %% array(", struct_deref, var_ptr->super_array);
+ fortprintf(fd, "%s %% index_%s", struct_deref, var_ptr->name_in_code);
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, ",i%i",i);
+ }
+ fortprintf(fd, ")</font>
<font color="blue">");
+
+ i = 1;
+ while (i <= var_ptr->ndims) {
+ fortprintf(fd, " end do</font>
<font color="red">");
i++;
}
- fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
}
-
- /* Copy from field to super_ array */
+
+ fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_file);
+ fortprintf(fd, " call dmpar_alltoall_field(domain %% dminfo, &</font>
<font color="blue">");
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " super_%s%id, %s%id %% array, &</font>
<font color="blue">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " %s %% %s %% array, %s%id %% array, &</font>
<font color="red">", struct_deref, var_ptr->name_in_code, vtype, var_ptr->ndims);
+
i = 1;
dimlist_ptr = var_ptr->dimlist;
- while (i <= var_ptr->ndims) {
+
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
+
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ while (dimlist_ptr) {
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, " do i%i=1,%s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
-
- i++;
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+
dimlist_ptr = dimlist_ptr->next;
- }
-
- fortprintf(fd, " super_%s%id(", vtype, var_ptr->ndims);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, "i%i",i);
- if (i < var_ptr->ndims) fortprintf(fd, ",");
- }
- if (var_ptr->timedim)
- fortprintf(fd, ") = domain %% blocklist %% time_levs(1) %% state %% %s %% array(", var_ptr->super_array);
- else
- fortprintf(fd, ") = domain %% blocklist %% mesh %% %s %% array(", var_ptr->super_array);
- fortprintf(fd, "index_%s", var_ptr->name_in_code);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, ",i%i",i);
- }
- fortprintf(fd, ")</font>
<font color="red">");
-
- i = 1;
- while (i <= var_ptr->ndims) {
- fortprintf(fd, " end do</font>
<font color="blue">");
i++;
+ }
+
+ if (is_derived_dim(lastdim->dim->name_in_code)) {
+ split_derived_dim_string(lastdim->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", n%sGlobal%s, &</font>
<font color="blue">", cp1, cp2);
+ fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ free(cp1);
+ free(cp2);
}
+ else {
+ fortprintf(fd, ", %sGlobal, &</font>
<font color="blue">", lastdim->dim->name_in_code);
+ fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
+ }
}
-
- fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_file);
- fortprintf(fd, " call dmpar_alltoall_field(domain %% dminfo, &</font>
<font color="red">");
- if (strncmp(var_ptr->super_array, "-", 1024) != 0)
- fortprintf(fd, " super_%s%id, %s%id %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
else {
- if (var_ptr->timedim)
- fortprintf(fd, " domain %% blocklist %% time_levs(1) %% state %% %s %% array, %s%id %% array, &</font>
<font color="red">", var_ptr->name_in_code, vtype, var_ptr->ndims);
- else
- fortprintf(fd, " domain %% blocklist %% mesh %% %s %% array, %s%id %% array, &</font>
<font color="blue">", var_ptr->name_in_code, vtype, var_ptr->ndims);
+ fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_file);
+ fortprintf(fd, " %s%id %% scalar = %s %% %s %% scalar</font>
<font color="red">", vtype, var_ptr->ndims, struct_deref, var_ptr->name_in_code);
}
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
-
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (var_ptr->timedim)
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field_time(output_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
else
- fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
- while (dimlist_ptr) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
- }
-
- if (is_derived_dim(lastdim->dim->name_in_code)) {
- split_derived_dim_string(lastdim->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", n%sGlobal%s, &</font>
<font color="red">", cp1, cp2);
- fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
- free(cp1);
- free(cp2);
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field(output_obj, %s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
}
- else {
- fortprintf(fd, ", %sGlobal, &</font>
<font color="red">", lastdim->dim->name_in_code);
- fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
- }
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="red">");
+
+ var_list_ptr = var_list_ptr->next;
}
- else {
- fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_file);
- if (var_ptr->timedim)
- fortprintf(fd, " %s%id %% scalar = domain %% blocklist %% time_levs(1) %% state %% %s %% scalar</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- else
- fortprintf(fd, " %s%id %% scalar = domain %% blocklist %% mesh %% %s %% scalar</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- }
-
- if (var_ptr->timedim)
- fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field_time(output_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- else
- fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field(output_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="red">", vtype, var_ptr->ndims);
- if (strncmp(var_ptr->super_array, "-", 1024) != 0)
- fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- }
- fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="gray">");
-
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
Modified: branches/registry_reorg/src/registry/gen_inc.h
===================================================================
--- branches/registry_reorg/src/registry/gen_inc.h 2010-09-15 17:03:13 UTC (rev 499)
+++ branches/registry_reorg/src/registry/gen_inc.h 2010-09-16 18:44:25 UTC (rev 500)
@@ -1,4 +1,4 @@
void gen_namelists(struct namelist *);
-void gen_field_defs(struct variable *, struct dimension *);
-void gen_reads(struct variable *, struct dimension *);
-void gen_writes(struct variable *, struct dimension *, struct namelist *);
+void gen_field_defs(struct group_list * groups, struct variable *, struct dimension *);
+void gen_reads(struct group_list * groups, struct variable *, struct dimension *);
+void gen_writes(struct group_list * groups, struct variable *, struct dimension *, struct namelist *);
Modified: branches/registry_reorg/src/registry/parse.c
===================================================================
--- branches/registry_reorg/src/registry/parse.c 2010-09-15 17:03:13 UTC (rev 499)
+++ branches/registry_reorg/src/registry/parse.c 2010-09-16 18:44:25 UTC (rev 500)
@@ -4,7 +4,7 @@
#include "registry_types.h"
#include "gen_inc.h"
-int parse_reg(FILE *, struct namelist **, struct dimension **, struct variable **);
+int parse_reg(FILE *, struct namelist **, struct dimension **, struct variable **, struct group_list **);
int getword(FILE *, char *);
int is_integer_constant(char *);
void sort_vars(struct variable *);
@@ -15,6 +15,7 @@
struct namelist * nls;
struct dimension * dims;
struct variable * vars;
+ struct group_list * groups;
if (argc != 2) {
fprintf(stderr,"</font>
<font color="black">Usage: %s filename</font>
<font color="black"></font>
<font color="gray">", argv[0]);
@@ -25,7 +26,7 @@
nls = NULL;
dims = NULL;
vars = NULL;
- if (parse_reg(regfile, &nls, &dims, &vars)) {
+ if (parse_reg(regfile, &nls, &dims, &vars, &groups)) {
return 1;
}
}
@@ -37,15 +38,15 @@
sort_vars(vars);
gen_namelists(nls);
- gen_field_defs(vars, dims);
- gen_reads(vars, dims);
- gen_writes(vars, dims, nls);
+ gen_field_defs(groups, vars, dims);
+ gen_reads(groups, vars, dims);
+ gen_writes(groups, vars, dims, nls);
return 0;
}
-int parse_reg(FILE * regfile, struct namelist ** nls, struct dimension ** dims, struct variable ** vars)
+int parse_reg(FILE * regfile, struct namelist ** nls, struct dimension ** dims, struct variable ** vars, struct group_list ** groups)
{
char word[1024];
struct namelist * nls_ptr;
@@ -54,13 +55,17 @@
struct variable * var_ptr;
struct dimension_list * dimlist_ptr;
struct dimension * dimlist_cursor;
+ struct group_list * grouplist_ptr;
+ struct variable_list * vlist_cursor;
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;
while(getword(regfile, word) != EOF) {
if (strncmp(word, "namelist", 1024) == 0) {
@@ -130,7 +135,16 @@
var_ptr->timedim = 0;
var_ptr->iostreams = 0;
+ /*
+ * persistence
+ */
getword(regfile, word);
+ if (strncmp(word, "persistent", 1024) == 0)
+ var_ptr->persistence = PERSISTENT;
+ else if (strncmp(word, "scratch", 1024) == 0)
+ var_ptr->persistence = SCRATCH;
+
+ getword(regfile, word);
if (strncmp(word, "real", 1024) == 0)
var_ptr->vtype = REAL;
else if (strncmp(word, "integer", 1024) == 0)
@@ -168,14 +182,50 @@
getword(regfile, word);
}
- /* Read I/O info */
+ /*
+ * time_dim
+ */
getword(regfile, word);
+ var_ptr->ntime_levs = atoi(word);
+
+ /*
+ * I/O info
+ */
+ getword(regfile, word);
if (strchr(word, (int)'i')) var_ptr->iostreams |= INPUT0;
if (strchr(word, (int)'r')) var_ptr->iostreams |= RESTART0;
if (strchr(word, (int)'o')) var_ptr->iostreams |= OUTPUT0;
getword(regfile, var_ptr->name_in_code);
+ /*
+ * struct
+ */
+ getword(regfile, var_ptr->struct_group);
+ grouplist_ptr = *groups;
+ grouplist_ptr = grouplist_ptr->next;
+ while (grouplist_ptr && strncmp(var_ptr->struct_group, grouplist_ptr->name, 1024)) {
+ grouplist_ptr = grouplist_ptr->next;
+ }
+ if (!grouplist_ptr) {
+ grouplist_ptr = *groups;
+ while(grouplist_ptr->next) grouplist_ptr = grouplist_ptr->next;
+ NEW_GROUP_LIST(grouplist_ptr->next);
+ grouplist_ptr = grouplist_ptr->next;
+ memcpy(grouplist_ptr->name, var_ptr->struct_group, (size_t)1024);
+ NEW_VARIABLE_LIST(grouplist_ptr->vlist);
+ grouplist_ptr->vlist->var = var_ptr;
+ }
+ else {
+ vlist_cursor = grouplist_ptr->vlist;
+ while (vlist_cursor->next) vlist_cursor = vlist_cursor->next;
+ NEW_VARIABLE_LIST(vlist_cursor->next);
+ vlist_cursor->next->prev = vlist_cursor;
+ vlist_cursor = vlist_cursor->next;
+ vlist_cursor->var = var_ptr;
+ }
+
+
getword(regfile, var_ptr->super_array);
getword(regfile, var_ptr->array_class);
@@ -203,6 +253,10 @@
if ((*vars)->next) *vars = (*vars)->next;
if (var_ptr) free(var_ptr);
+ grouplist_ptr = *groups;
+ if ((*groups)->next) *groups = (*groups)->next;
+ if (grouplist_ptr) free(grouplist_ptr);
+
return 0;
}
Modified: branches/registry_reorg/src/registry/registry_types.h
===================================================================
--- branches/registry_reorg/src/registry/registry_types.h 2010-09-15 17:03:13 UTC (rev 499)
+++ branches/registry_reorg/src/registry/registry_types.h 2010-09-16 18:44:25 UTC (rev 500)
@@ -3,6 +3,9 @@
#define LOGICAL 2
#define CHARACTER 3
+#define PERSISTENT 0
+#define SCRATCH 1
+
#define INPUT0 0x00000001
#define RESTART0 0x00000002
#define OUTPUT0 0x00000004
@@ -11,6 +14,8 @@
#define NEW_DIMENSION(X) X = (struct dimension *)malloc(sizeof(struct dimension)); X->next = NULL;
#define NEW_DIMENSION_LIST(X) X = (struct dimension_list *)malloc(sizeof(struct dimension_list)); X->dim = NULL; X->prev = NULL; X->next = NULL;
#define NEW_VARIABLE(X) X = (struct variable *)malloc(sizeof(struct variable)); X->dimlist = NULL; X->next = NULL;
+#define NEW_VARIABLE_LIST(X) X = (struct variable_list *)malloc(sizeof(struct variable_list)); X->var = NULL; X->prev = NULL; X->next = NULL;
+#define NEW_GROUP_LIST(X) X = (struct group_list *)malloc(sizeof(struct group_list)); X->vlist = NULL; X->next = NULL;
union default_val {
int ival;
@@ -41,14 +46,29 @@
struct dimension_list * next;
};
+struct variable_list {
+ struct variable * var;
+ struct variable_list * prev;
+ struct variable_list * next;
+};
+
+struct group_list {
+ char name[1024];
+ struct variable_list * vlist;
+ struct group_list * next;
+};
+
struct variable {
char name_in_file[1024];
char name_in_code[1024];
+ char struct_group[1024];
char super_array[1024];
char array_class[1024];
+ int persistence;
int vtype;
int ndims;
int timedim;
+ int ntime_levs;
int iostreams;
struct dimension_list * dimlist;
struct variable * next;
</font>
</pre>