<p><b>duda</b> 2012-04-26 18:24:48 -0600 (Thu, 26 Apr 2012)</p><p>To correct an issue with reading and writing fields with multiple time levels, generate code <br>
to shift time levels below the field DDT level, such that a pointer to, e.g., state % time_levs(1) % state % xtime <br>
will always point to the current value for a field after a call to mpas_shift_time_levels_state().<br>
<br>
<br>
M src/registry/gen_inc.c<br>
</p><hr noshade><pre><font color="gray">Modified: trunk/mpas/src/registry/gen_inc.c
===================================================================
--- trunk/mpas/src/registry/gen_inc.c 2012-04-26 22:00:31 UTC (rev 1821)
+++ trunk/mpas/src/registry/gen_inc.c 2012-04-27 00:24:48 UTC (rev 1822)
@@ -187,6 +187,7 @@
int i;
int class_start, class_end;
int vtype;
+ char type_str[7];
/*
@@ -888,13 +889,70 @@
fortprintf(fd, " type (%s_multilevel_type), intent(inout) :: %s</font>
<font color="black">", group_ptr->name, group_ptr->name);
fortprintf(fd, "</font>
<font color="black">");
fortprintf(fd, " integer :: i</font>
<font color="red">");
- fortprintf(fd, " type (%s_type), pointer :: sptr</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " real (kind=RKIND) :: real0d</font>
<font color="blue">");
+ fortprintf(fd, " real (kind=RKIND), dimension(:), pointer :: real1d</font>
<font color="blue">");
+ fortprintf(fd, " real (kind=RKIND), dimension(:,:), pointer :: real2d</font>
<font color="blue">");
+ fortprintf(fd, " real (kind=RKIND), dimension(:,:,:), pointer :: real3d</font>
<font color="blue">");
+ fortprintf(fd, " integer :: int0d</font>
<font color="blue">");
+ fortprintf(fd, " integer, dimension(:), pointer :: int1d</font>
<font color="blue">");
+ fortprintf(fd, " integer, dimension(:,:), pointer :: int2d</font>
<font color="blue">");
+ fortprintf(fd, " integer, dimension(:,:,:), pointer :: int3d</font>
<font color="blue">");
+ fortprintf(fd, " character (len=64) :: char0d</font>
<font color="blue">");
+ fortprintf(fd, " character (len=64), dimension(:), pointer :: char1d</font>
<font color="black">");
fortprintf(fd, "</font>
<font color="red">");
- fortprintf(fd, " sptr => %s %% time_levs(1) %% %s</font>
<font color="red">", group_ptr->name, group_ptr->name);
- fortprintf(fd, " do i=1,%s %% nTimeLevels-1</font>
<font color="red">", group_ptr->name);
- fortprintf(fd, " %s %% time_levs(i) %% %s => %s %% time_levs(i+1) %% %s</font>
<font color="red">", group_ptr->name, group_ptr->name, group_ptr->name, group_ptr->name);
- fortprintf(fd, " end do</font>
<font color="red">");
- fortprintf(fd, " %s %% time_levs(%s %% nTimeLevels) %% %s => sptr</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name);
+ 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->vtype == INTEGER) sprintf(type_str, "int%id", var_ptr->ndims+1);
+ else if (var_ptr->vtype == REAL) sprintf(type_str, "real%id", var_ptr->ndims+1);
+ else if (var_ptr->vtype == CHARACTER) sprintf(type_str, "char%id", var_ptr->ndims+1);
+
+ memcpy(super_array, var_ptr->super_array, 1024);
+
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0)
+ {
+ var_list_ptr2 = var_list_ptr;
+ var_list_ptr = var_list_ptr->next;
+ }
+ var_ptr2 = var_list_ptr2->var;
+
+ fortprintf(fd, " %s => %s %% time_levs(1) %% %s %% %s %% array</font>
<font color="blue">", type_str, group_ptr->name, group_ptr->name, var_ptr2->super_array);
+
+ fortprintf(fd, " do i=1,%s %% nTimeLevels-1</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " %s %% time_levs(i) %% %s %% %s %% array => %s %% time_levs(i+1) %% %s %% %s %% array</font>
<font color="blue">", group_ptr->name, group_ptr->name, var_ptr2->super_array, group_ptr->name, group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+
+ fortprintf(fd, " %s %% time_levs(%s %% nTimeLevels) %% %s %% %s %% array=> %s</font>
<font color="black"></font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name, var_ptr2->super_array, type_str);
+ }
+ else {
+
+ if (var_ptr->vtype == INTEGER) sprintf(type_str, "int%id", var_ptr->ndims);
+ else if (var_ptr->vtype == REAL) sprintf(type_str, "real%id", var_ptr->ndims);
+ else if (var_ptr->vtype == CHARACTER) sprintf(type_str, "char%id", var_ptr->ndims);
+
+ if (var_ptr->ndims > 0)
+ fortprintf(fd, " %s => %s %% time_levs(1) %% %s %% %s %% array</font>
<font color="blue">", type_str, group_ptr->name, group_ptr->name, var_ptr->name_in_code);
+ else
+ fortprintf(fd, " %s = %s %% time_levs(1) %% %s %% %s %% scalar</font>
<font color="blue">", type_str, group_ptr->name, group_ptr->name, var_ptr->name_in_code);
+
+ fortprintf(fd, " do i=1,%s %% nTimeLevels-1</font>
<font color="blue">", group_ptr->name);
+ if (var_ptr->ndims > 0)
+ fortprintf(fd, " %s %% time_levs(i) %% %s %% %s %% array => %s %% time_levs(i+1) %% %s %% %s %% array</font>
<font color="blue">", group_ptr->name, group_ptr->name, var_ptr->name_in_code, group_ptr->name, group_ptr->name, var_ptr->name_in_code);
+ else
+ fortprintf(fd, " %s %% time_levs(i) %% %s %% %s %% scalar = %s %% time_levs(i+1) %% %s %% %s %% scalar</font>
<font color="blue">", group_ptr->name, group_ptr->name, var_ptr->name_in_code, group_ptr->name, group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+
+ if (var_ptr->ndims > 0)
+ fortprintf(fd, " %s %% time_levs(%s %% nTimeLevels) %% %s %% %s %% array=> %s</font>
<font color="black"></font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name, var_ptr->name_in_code, type_str);
+ else
+ fortprintf(fd, " %s %% time_levs(%s %% nTimeLevels) %% %s %% %s %% scalar = %s</font>
<font color="black"></font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name, var_ptr->name_in_code, type_str);
+
+ var_list_ptr = var_list_ptr->next;
+ }
+ }
fortprintf(fd, "</font>
<font color="black">");
fortprintf(fd, " end subroutine mpas_shift_time_levels_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="black">", group_ptr->name);
}
</font>
</pre>