<p><b>dwj07@fsu.edu</b> 2012-06-06 09:18:54 -0600 (Wed, 06 Jun 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Making registry changes to support the provis pointer inside of a block.<br>
Registry changes to support transferring non-decomposed fields to multiple blocks.<br>
<br>
Using the new registry changes in io_input.<br>
Adding routines to copy a non-decomposed field from a header field to the other nodes in the field linked list.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-06-06 14:09:14 UTC (rev 1964)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-06-06 15:18:54 UTC (rev 1965)
@@ -19,7 +19,6 @@
integer, parameter :: IO_NODE = 0
integer, parameter :: BUFSIZE = 6000
-
interface mpas_dmpar_alltoall_field
module procedure mpas_dmpar_alltoall_field1d_integer
module procedure mpas_dmpar_alltoall_field2d_integer
@@ -51,6 +50,22 @@
private :: mpas_dmpar_exch_halo_field2d_real
private :: mpas_dmpar_exch_halo_field3d_real
+ interface mpas_dmpar_copy_field
+ module procedure mpas_dmpar_copy_field1d_integer
+ module procedure mpas_dmpar_copy_field2d_integer
+ module procedure mpas_dmpar_copy_field3d_integer
+ module procedure mpas_dmpar_copy_field1d_real
+ module procedure mpas_dmpar_copy_field2d_real
+ module procedure mpas_dmpar_copy_field3d_real
+ end interface
+
+ private :: mpas_dmpar_copy_field1d_integer
+ private :: mpas_dmpar_copy_field2d_integer
+ private :: mpas_dmpar_copy_field3d_integer
+ private :: mpas_dmpar_copy_field1d_real
+ private :: mpas_dmpar_copy_field2d_real
+ private :: mpas_dmpar_copy_field3d_real
+
contains
subroutine mpas_dmpar_init(dminfo, mpi_comm)!{{{
@@ -3678,8 +3693,6 @@
dminfo => field % block % domain % dminfo
- write(6,*) 'Halo exchange on....', field % fieldName
-
if(present(haloLayersIn)) then
nHaloLayers = size(haloLayersIn)
allocate(haloLayers(nHaloLayers))
@@ -4252,4 +4265,83 @@
end subroutine mpas_dmpar_destroy_exchange_list!}}}
+ subroutine mpas_dmpar_copy_field1d_integer(field)!{{{
+ type (field1dInteger), pointer :: field
+ type (field1dInteger), pointer :: fieldCursor
+
+ if(associated(field % next)) then
+ fieldCursor => field % next
+ do while(associated(fieldCursor))
+ fieldCursor % array = field % array
+ fieldCursor => fieldCursor % next
+ end do
+ end if
+ end subroutine mpas_dmpar_copy_field1d_integer!}}}
+
+ subroutine mpas_dmpar_copy_field2d_integer(field)!{{{
+ type (field2dInteger), pointer :: field
+ type (field2dInteger), pointer :: fieldCursor
+
+ if(associated(field % next)) then
+ fieldCursor => field % next
+ do while(associated(fieldCursor))
+ fieldCursor % array = field % array
+ fieldCursor => fieldCursor % next
+ end do
+ end if
+ end subroutine mpas_dmpar_copy_field2d_integer!}}}
+
+ subroutine mpas_dmpar_copy_field3d_integer(field)!{{{
+ type (field3dInteger), pointer :: field
+ type (field3dInteger), pointer :: fieldCursor
+
+ if(associated(field % next)) then
+ fieldCursor => field % next
+ do while(associated(fieldCursor))
+ fieldCursor % array = field % array
+ fieldCursor => fieldCursor % next
+ end do
+ end if
+ end subroutine mpas_dmpar_copy_field3d_integer!}}}
+
+ subroutine mpas_dmpar_copy_field1d_real(field)!{{{
+ type (field1dReal), pointer :: field
+ type (field1dReal), pointer :: fieldCursor
+
+
+ if(associated(field % next)) then
+ fieldCursor => field
+ do while(associated(fieldCursor))
+ fieldCursor % array(:) = field % array(:)
+ fieldCursor => fieldCursor % next
+ end do
+ end if
+ end subroutine mpas_dmpar_copy_field1d_real!}}}
+
+ subroutine mpas_dmpar_copy_field2d_real(field)!{{{
+ type (field2dReal), pointer :: field
+ type (field2dReal), pointer :: fieldCursor
+
+ if(associated(field % next)) then
+ fieldCursor => field % next
+ do while(associated(fieldCursor))
+ fieldCursor % array = field % array
+ fieldCursor => fieldCursor % next
+ end do
+ end if
+ end subroutine mpas_dmpar_copy_field2d_real!}}}
+
+ subroutine mpas_dmpar_copy_field3d_real(field)!{{{
+ type (field3dReal), pointer :: field
+ type (field3dReal), pointer :: fieldCursor
+
+ if(associated(field % next)) then
+ fieldCursor => field % next
+ do while(associated(fieldCursor))
+ fieldCursor % array = field % array
+ fieldCursor => fieldCursor % next
+ end do
+ end if
+ end subroutine mpas_dmpar_copy_field3d_real!}}}
+
end module mpas_dmpar
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-06-06 14:09:14 UTC (rev 1964)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-06-06 15:18:54 UTC (rev 1965)
@@ -881,6 +881,8 @@
#include "exchange_input_field_halos.inc"
+#include "non_decomp_copy_input_fields.inc"
+
end subroutine mpas_exch_input_field_halos!}}}
subroutine mpas_io_input_finalize(input_obj, dminfo)!{{{
Modified: branches/omp_blocks/multiple_blocks/src/registry/gen_inc.c
===================================================================
--- branches/omp_blocks/multiple_blocks/src/registry/gen_inc.c 2012-06-06 14:09:14 UTC (rev 1964)
+++ branches/omp_blocks/multiple_blocks/src/registry/gen_inc.c 2012-06-06 15:18:54 UTC (rev 1965)
@@ -478,10 +478,12 @@
group_ptr = groups;
while (group_ptr) {
- if (group_ptr->vlist->var->ntime_levs > 1)
+ if (group_ptr->vlist->var->ntime_levs > 1) {
fortprintf(fd, " type (%s_multilevel_type), pointer :: %s</font>
<font color="red">", group_ptr->name, group_ptr->name);
- else
+ fortprintf(fd, " type (%s_type), pointer :: provis</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ } else {
fortprintf(fd, " type (%s_type), pointer :: %s</font>
<font color="gray">", group_ptr->name, group_ptr->name);
+ }
group_ptr = group_ptr->next;
}
@@ -1076,7 +1078,22 @@
fortprintf(fd, " else</font>
<font color="black">");
fortprintf(fd, " nullify(%s %% %s %% next)</font>
<font color="black">", group_ptr->name, var_ptr2->super_array);
fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="red">");
- }
+ } else {
+ fortprintf(fd, " nullify(%s %% %s %% sendList)</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " nullify(%s %% %s %% recvList)</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " nullify(%s %% %s %% copyList)</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " if(present(prev)) then</font>
<font color="blue">");
+ fortprintf(fd, " %s %% %s %% prev => prev %% %s</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, var_ptr2->super_array);
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " nullify(%s %% %s %% prev)</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, " if(present(next)) then</font>
<font color="blue">");
+ fortprintf(fd, " %s %% %s %% next => next %% %s</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, var_ptr2->super_array);
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " nullify(%s %% %s %% next)</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="blue">");
+
+ }
fortprintf(fd, "</font>
<font color="gray">");
}
else
@@ -1129,7 +1146,21 @@
fortprintf(fd, " else</font>
<font color="black">");
fortprintf(fd, " nullify(%s %% %s %% next)</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="red">");
- }
+ } else {
+ fortprintf(fd, " nullify(%s %% %s %% sendList)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " nullify(%s %% %s %% recvList)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " nullify(%s %% %s %% copyList)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " if(present(prev)) then</font>
<font color="blue">");
+ fortprintf(fd, " %s %% %s %% prev => prev %% %s</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code, var_ptr->name_in_code);
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " nullify(%s %% %s %% prev)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, " if(present(next)) then</font>
<font color="blue">");
+ fortprintf(fd, " %s %% %s %% next => next %% %s</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code, var_ptr->name_in_code);
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " nullify(%s %% %s %% next)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="blue">");
+ }
fortprintf(fd, "</font>
<font color="gray">");
}
var_list_ptr = var_list_ptr->next;
@@ -1153,7 +1184,7 @@
struct dimension_list * dimlist_ptr, * lastdim;
struct group_list * group_ptr;
struct dtable * dictionary;
- FILE * fd;
+ FILE * fd, *fd2;
char vtype[5];
char fname[32];
char super_array[1024];
@@ -1903,6 +1934,7 @@
* MGD NEW CODE
*/
fd = fopen("exchange_input_field_halos.inc", "w");
+ fd2 = fopen("non_decomp_copy_input_fields.inc", "w");
group_ptr = groups;
while (group_ptr) {
@@ -1918,10 +1950,11 @@
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024)) {
- if (var_ptr->ntime_levs > 1)
+ if (var_ptr->ntime_levs > 1) {
snprintf(struct_deref, 1024, "domain %% blocklist %% %s %% time_levs(1) %% %s", group_ptr->name, group_ptr->name);
- else
+ } else {
snprintf(struct_deref, 1024, "domain %% blocklist %% %s", group_ptr->name);
+ }
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. input_obj %% stream == STREAM_INPUT) .or. &</font>
<font color="gray">", struct_deref, var_ptr->super_array);
@@ -1944,7 +1977,13 @@
fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="red">");
- }
+ } else {
+ fortprintf(fd2, " if ((%s %% %s %% ioinfo %% input .and. input_obj %% stream == STREAM_INPUT) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd2, " (%s %% %s %% ioinfo %% restart .and. input_obj %% stream == STREAM_RESTART) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd2, " (%s %% %s %% ioinfo %% sfc .and. input_obj %% stream == STREAM_SFC)) then</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd2, " call mpas_dmpar_copy_field(%s %% %s)</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd2, " end if</font>
<font color="black"></font>
<font color="gray">");
+ }
}
i++;
@@ -1957,6 +1996,7 @@
}
fclose(fd);
+ fclose(fd2);
#ifdef LEGACY_CODE
Modified: branches/omp_blocks/multiple_blocks/src/registry/registry_types.h
===================================================================
--- branches/omp_blocks/multiple_blocks/src/registry/registry_types.h 2012-06-06 14:09:14 UTC (rev 1964)
+++ branches/omp_blocks/multiple_blocks/src/registry/registry_types.h 2012-06-06 15:18:54 UTC (rev 1965)
@@ -71,6 +71,7 @@
int timedim;
int ntime_levs;
int iostreams;
+ int decomposed;
struct dimension_list * dimlist;
struct variable * next;
};
</font>
</pre>