<p><b>mpetersen@lanl.gov</b> 2012-10-25 14:46:42 -0600 (Thu, 25 Oct 2012)</p><p>branch commit, restart_reproducibility: merge trunk to branch<br>
</p><hr noshade><pre><font color="gray">Index: branches/ocean_projects/restart_reproducibility
===================================================================
--- branches/ocean_projects/restart_reproducibility 2012-10-25 20:41:41 UTC (rev 2269)
+++ branches/ocean_projects/restart_reproducibility 2012-10-25 20:46:42 UTC (rev 2270)
Property changes on: branches/ocean_projects/restart_reproducibility
___________________________________________________________________
Modified: svn:mergeinfo
## -23,4 +23,4 ##
/branches/omp_blocks/multiple_blocks:1803-2084
/branches/source_renaming:1082-1113
/branches/time_manager:924-962
-/trunk/mpas:2239-2242
+/trunk/mpas:2239-2269
\ No newline at end of property
Modified: branches/ocean_projects/restart_reproducibility/Makefile
===================================================================
--- branches/ocean_projects/restart_reproducibility/Makefile 2012-10-25 20:41:41 UTC (rev 2269)
+++ branches/ocean_projects/restart_reproducibility/Makefile 2012-10-25 20:46:42 UTC (rev 2270)
@@ -231,8 +231,9 @@
DEBUG_MESSAGE="Debug flags are not defined for this compile group. Defaulting to Optimized flags"
else # FFLAGS_DEBUG IF
FFLAGS=$(FFLAGS_DEBUG)
- CFLAGS=$(CFLAGS_DEBUG) -DMPAS_DEBUG
+ CFLAGS=$(CFLAGS_DEBUG)
LDFLAGS=$(LDFLAGS_DEBUG)
+ override CPPFLAGS += -DMPAS_DEBUG
DEBUG_MESSAGE="Debugging is on."
endif # FFLAGS_DEBUG IF
Index: branches/ocean_projects/restart_reproducibility/src/core_ocean
===================================================================
--- branches/ocean_projects/restart_reproducibility/src/core_ocean 2012-10-25 20:41:41 UTC (rev 2269)
+++ branches/ocean_projects/restart_reproducibility/src/core_ocean 2012-10-25 20:46:42 UTC (rev 2270)
Property changes on: branches/ocean_projects/restart_reproducibility/src/core_ocean
___________________________________________________________________
Modified: svn:mergeinfo
## -25,4 +25,4 ##
/branches/omp_blocks/openmp_test/src/core_ocean_elements:2161-2201
/branches/source_renaming/src/core_ocean:1082-1113
/branches/time_manager/src/core_ocean:924-962
-/trunk/mpas/src/core_ocean:2239-2242
+/trunk/mpas/src/core_ocean:2239-2269
\ No newline at end of property
Modified: branches/ocean_projects/restart_reproducibility/src/core_ocean/mpas_ocn_mpas_core.F
===================================================================
--- branches/ocean_projects/restart_reproducibility/src/core_ocean/mpas_ocn_mpas_core.F 2012-10-25 20:41:41 UTC (rev 2269)
+++ branches/ocean_projects/restart_reproducibility/src/core_ocean/mpas_ocn_mpas_core.F 2012-10-25 20:46:42 UTC (rev 2270)
@@ -559,6 +559,7 @@
real (kind=RKIND), dimension(:,:), pointer :: h
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
integer :: nVertLevels
+ logical :: consistentSSH
! Initialize z-level grid variables from h, read in from input file.
block => domain % blocklist
@@ -697,15 +698,23 @@
endif
if (config_check_ssh_consistency) then
+ consistentSSH = .true.
do iCell = 1,nCells
! Check if abs(ssh)>2m. If so, print warning.
if (abs(sum(h(1:maxLevelCell(iCell),iCell))-bottomDepth(iCell))>2.0) then
+ consistentSSH = .false.
+#ifdef MPAS_DEBUG
write (0,'(a)') ' Warning: abs(sum(h)-bottomDepth)>2m. Most likely, initial h does not match bottomDepth.'
write (0,*) ' iCell, K=maxLevelCell(iCell), bottomDepth(iCell),sum(h),bottomDepth,hZLevel(K),h(K): ', &
iCell, maxLevelCell(iCell), bottomDepth(iCell),sum(h(1:maxLevelCell(iCell),iCell)),bottomDepth(iCell), &
hZLevel(maxLevelCell(iCell)), h(maxLevelCell(iCell),iCell)
+#endif
endif
enddo
+
+ if (.not. consistentSSH) then
+ write(0,*) 'Warning: SSH is not consisntent'
+ end if
endif
if (config_check_zlevel_consistency) then
Modified: branches/ocean_projects/restart_reproducibility/src/framework/mpas_dmpar.F
===================================================================
--- branches/ocean_projects/restart_reproducibility/src/framework/mpas_dmpar.F 2012-10-25 20:41:41 UTC (rev 2269)
+++ branches/ocean_projects/restart_reproducibility/src/framework/mpas_dmpar.F 2012-10-25 20:46:42 UTC (rev 2270)
@@ -2827,6 +2827,12 @@
logical :: comm_list_found
+ do i = 1, 1
+ if(field % dimSizes(i) <= 0) then
+ return
+ end if
+ end do
+
dminfo => field % block % domain % dminfo
if(present(haloLayersIn)) then
@@ -3101,6 +3107,12 @@
logical :: comm_list_found
+ do i = 1, 2
+ if(field % dimSizes(i) <= 0) then
+ return
+ end if
+ end do
+
dminfo => field % block % domain % dminfo
if(present(haloLayersIn)) then
@@ -3376,6 +3388,12 @@
logical :: comm_list_found
+ do i = 1, 3
+ if(field % dimSizes(i) <= 0) then
+ return
+ end if
+ end do
+
dminfo => field % block % domain % dminfo
if(present(haloLayersIn)) then
@@ -3657,6 +3675,12 @@
logical :: comm_list_found
+ do i = 1, 1
+ if(field % dimSizes(i) <= 0) then
+ return
+ end if
+ end do
+
dminfo => field % block % domain % dminfo
if(present(haloLayersIn)) then
@@ -3928,7 +3952,13 @@
integer, dimension(:), pointer :: haloLayers
logical :: comm_list_found
-
+
+ do i = 1, 2
+ if(field % dimSizes(i) <= 0) then
+ return
+ end if
+ end do
+
dminfo => field % block % domain % dminfo
if(present(haloLayersIn)) then
@@ -4206,6 +4236,12 @@
logical :: comm_list_found
+ do i = 1, 3
+ if(field % dimSizes(i) <= 0) then
+ return
+ end if
+ end do
+
dminfo => field % block % domain % dminfo
if(present(haloLayersIn)) then
Modified: branches/ocean_projects/restart_reproducibility/src/framework/mpas_grid_types.F
===================================================================
--- branches/ocean_projects/restart_reproducibility/src/framework/mpas_grid_types.F 2012-10-25 20:41:41 UTC (rev 2269)
+++ branches/ocean_projects/restart_reproducibility/src/framework/mpas_grid_types.F 2012-10-25 20:46:42 UTC (rev 2270)
@@ -363,6 +363,26 @@
type (dm_info), pointer :: dminfo
end type domain_type
+ interface mpas_allocate_scratch_field
+ module procedure mpas_allocate_scratch_field1d_integer
+ module procedure mpas_allocate_scratch_field2d_integer
+ module procedure mpas_allocate_scratch_field3d_integer
+ module procedure mpas_allocate_scratch_field1d_real
+ module procedure mpas_allocate_scratch_field2d_real
+ module procedure mpas_allocate_scratch_field3d_real
+ module procedure mpas_allocate_scratch_field1d_char
+ end interface
+
+ interface mpas_deallocate_scratch_field
+ module procedure mpas_deallocate_scratch_field1d_integer
+ module procedure mpas_deallocate_scratch_field2d_integer
+ module procedure mpas_deallocate_scratch_field3d_integer
+ module procedure mpas_deallocate_scratch_field1d_real
+ module procedure mpas_deallocate_scratch_field2d_real
+ module procedure mpas_deallocate_scratch_field3d_real
+ module procedure mpas_deallocate_scratch_field1d_char
+ end interface
+
interface mpas_deallocate_field
module procedure mpas_deallocate_field0d_integer
module procedure mpas_deallocate_field1d_integer
@@ -444,6 +464,406 @@
end subroutine mpas_deallocate_domain!}}}
+ subroutine mpas_allocate_scratch_field1d_integer(f, single_block_in)!{{{
+ type (field1dInteger), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field1dInteger), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not. single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(.not.associated(f_cursor % array)) then
+ allocate(f_cursor % array(f_cursor % dimSizes(1)))
+ end if
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(.not.associated(f % array)) then
+ allocate(f % array(f % dimSizes(1)))
+ end if
+ end if
+
+ end subroutine mpas_allocate_scratch_field1d_integer!}}}
+
+ subroutine mpas_allocate_scratch_field2d_integer(f, single_block_in)!{{{
+ type (field2dInteger), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field2dInteger), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not. single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(.not.associated(f_cursor % array)) then
+ allocate(f_cursor % array(f_cursor % dimSizes(1), f_cursor % dimSizes(2)))
+ end if
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(.not.associated(f % array)) then
+ allocate(f % array(f % dimSizes(1), f % dimSizes(2)))
+ end if
+ end if
+
+ end subroutine mpas_allocate_scratch_field2d_integer!}}}
+
+ subroutine mpas_allocate_scratch_field3d_integer(f, single_block_in)!{{{
+ type (field3dInteger), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field3dInteger), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not. single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(.not.associated(f_cursor % array)) then
+ allocate(f_cursor % array(f_cursor % dimSizes(1), f_cursor % dimSizes(2), f_cursor % dimSizes(3)))
+ end if
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(.not.associated(f % array)) then
+ allocate(f % array(f % dimSizes(1), f % dimSizes(2), f % dimSizes(3)))
+ end if
+ end if
+
+ end subroutine mpas_allocate_scratch_field3d_integer!}}}
+
+ subroutine mpas_allocate_scratch_field1d_real(f, single_block_in)!{{{
+ type (field1dReal), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field1dReal), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not. single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(.not.associated(f_cursor % array)) then
+ allocate(f_cursor % array(f_cursor % dimSizes(1)))
+ end if
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(.not.associated(f % array)) then
+ allocate(f % array(f % dimSizes(1)))
+ end if
+ end if
+
+ end subroutine mpas_allocate_scratch_field1d_real!}}}
+
+ subroutine mpas_allocate_scratch_field2d_real(f, single_block_in)!{{{
+ type (field2dReal), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field2dReal), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not. single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(.not.associated(f_cursor % array)) then
+ allocate(f_cursor % array(f_cursor % dimSizes(1), f_cursor % dimSizes(2)))
+ end if
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(.not.associated(f % array)) then
+ allocate(f % array(f % dimSizes(1), f % dimSizes(2)))
+ end if
+ end if
+
+ end subroutine mpas_allocate_scratch_field2d_real!}}}
+
+ subroutine mpas_allocate_scratch_field3d_real(f, single_block_in)!{{{
+ type (field3dReal), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field3dReal), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not. single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(.not.associated(f_cursor % array)) then
+ allocate(f_cursor % array(f_cursor % dimSizes(1), f_cursor % dimSizes(2), f_cursor % dimSizes(3)))
+ end if
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(.not.associated(f % array)) then
+ allocate(f % array(f % dimSizes(1), f % dimSizes(2), f % dimSizes(3)))
+ end if
+ end if
+
+ end subroutine mpas_allocate_scratch_field3d_real!}}}
+
+ subroutine mpas_allocate_scratch_field1d_char(f, single_block_in)!{{{
+ type (field1dChar), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field1dChar), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not. single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(.not.associated(f_cursor % array)) then
+ allocate(f_cursor % array(f_cursor % dimSizes(1)))
+ end if
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(.not.associated(f % array)) then
+ allocate(f % array(f % dimSizes(1)))
+ end if
+ end if
+
+ end subroutine mpas_allocate_scratch_field1d_char!}}}
+
+ subroutine mpas_deallocate_scratch_field1d_integer(f, single_block_in)!{{{
+ type (field1dInteger), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field1dInteger), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not.single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(associated(f % array)) then
+ deallocate(f % array)
+ end if
+ end if
+
+ end subroutine mpas_deallocate_scratch_field1d_integer!}}}
+
+ subroutine mpas_deallocate_scratch_field2d_integer(f, single_block_in)!{{{
+ type (field2dInteger), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field2dInteger), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not.single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(associated(f % array)) then
+ deallocate(f % array)
+ end if
+ end if
+
+ end subroutine mpas_deallocate_scratch_field2d_integer!}}}
+
+ subroutine mpas_deallocate_scratch_field3d_integer(f, single_block_in)!{{{
+ type (field3dInteger), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field3dInteger), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not.single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(associated(f % array)) then
+ deallocate(f % array)
+ end if
+ end if
+
+ end subroutine mpas_deallocate_scratch_field3d_integer!}}}
+
+ subroutine mpas_deallocate_scratch_field1d_real(f, single_block_in)!{{{
+ type (field1dReal), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field1dReal), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not.single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(associated(f % array)) then
+ deallocate(f % array)
+ end if
+ end if
+
+ end subroutine mpas_deallocate_scratch_field1d_real!}}}
+
+ subroutine mpas_deallocate_scratch_field2d_real(f, single_block_in)!{{{
+ type (field2dReal), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field2dReal), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not.single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(associated(f % array)) then
+ deallocate(f % array)
+ end if
+ end if
+
+ end subroutine mpas_deallocate_scratch_field2d_real!}}}
+
+ subroutine mpas_deallocate_scratch_field3d_real(f, single_block_in)!{{{
+ type (field3dReal), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field3dReal), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not.single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(associated(f % array)) then
+ deallocate(f % array)
+ end if
+ end if
+
+ end subroutine mpas_deallocate_scratch_field3d_real!}}}
+
+ subroutine mpas_deallocate_scratch_field1d_char(f, single_block_in)!{{{
+ type (field1dChar), pointer :: f
+ logical, intent(in), optional :: single_block_in
+ logical :: single_block
+ type (field1dChar), pointer :: f_cursor
+
+ if(present(single_block_in)) then
+ single_block = single_block_in
+ else
+ single_block = .false.
+ end if
+
+ if(.not.single_block) then
+ f_cursor => f
+ do while(associated(f_cursor))
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
+ f_cursor => f_cursor % next
+ end do
+ else
+ if(associated(f % array)) then
+ deallocate(f % array)
+ end if
+ end if
+
+ end subroutine mpas_deallocate_scratch_field1d_char!}}}
+
+
subroutine mpas_deallocate_field0d_integer(f)!{{{
type (field0dInteger), pointer :: f
type (field0dInteger), pointer :: f_cursor
Modified: branches/ocean_projects/restart_reproducibility/src/framework/mpas_io.F
===================================================================
--- branches/ocean_projects/restart_reproducibility/src/framework/mpas_io.F 2012-10-25 20:41:41 UTC (rev 2269)
+++ branches/ocean_projects/restart_reproducibility/src/framework/mpas_io.F 2012-10-25 20:46:42 UTC (rev 2270)
@@ -366,6 +366,7 @@
if (present(ierr)) ierr = MPAS_IO_ERR_PIO
deallocate(new_dimlist_node % dimhandle)
deallocate(new_dimlist_node)
+ write(0,*) 'WARNING: Dimension ', trim(dimname), ' not in input file.'
dimsize = -1
return
end if
@@ -551,6 +552,7 @@
if (present(ierr)) ierr = MPAS_IO_ERR_PIO
deallocate(new_fieldlist_node % fieldhandle)
deallocate(new_fieldlist_node)
+ write(0,*) 'WARNING: Variable ', trim(fieldname), ' not in input file.'
return
end if
!write(0,*) 'Inquired about variable ID', new_fieldlist_node % fieldhandle % fieldid
Modified: branches/ocean_projects/restart_reproducibility/src/registry/gen_inc.c
===================================================================
--- branches/ocean_projects/restart_reproducibility/src/registry/gen_inc.c 2012-10-25 20:41:41 UTC (rev 2269)
+++ branches/ocean_projects/restart_reproducibility/src/registry/gen_inc.c 2012-10-25 20:46:42 UTC (rev 2270)
@@ -813,6 +813,10 @@
fortprintf(fd, " %s %% %s %% fieldName = \'%s\'</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code, var_ptr->name_in_file);
fortprintf(fd, " %s %% %s %% isSuperArray = .false.</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->ndims > 0) {
+ if(var_ptr->persistence == SCRATCH){
+ fortprintf(fd, " ! SCRATCH VARIABLE</font>
<font color="blue">");
+ fortprintf(fd, " nullify(%s %% %s %% array)</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code);
+ } else if(var_ptr->persistence == PERSISTENT){
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) ||
@@ -843,6 +847,7 @@
else if (var_ptr->vtype == CHARACTER)
fortprintf(fd, " %s %% %s %% array = \'\'</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code ); /* initialize field to zero */
+ }
dimlist_ptr = var_ptr->dimlist;
i = 1;
while (dimlist_ptr) {
@@ -869,7 +874,7 @@
i++;
dimlist_ptr = dimlist_ptr->next;
}
- }
+ }
if (var_ptr->timedim) fortprintf(fd, " %s %% %s %% hasTimeDimension = .true.</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
else fortprintf(fd, " %s %% %s %% hasTimeDimension = .false.</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code);
@@ -934,14 +939,18 @@
var_list_ptr2 = var_list_ptr;
var_list_ptr = var_list_ptr->next;
}
- fortprintf(fd, " deallocate(%s %% %s %% array)</font>
<font color="blue">", group_ptr->name, var_list_ptr2->var->super_array);
+ fortprintf(fd, " if(associated(%s %% %s %% array)) then</font>
<font color="blue">", group_ptr->name, var_list_ptr2->var->super_array);
+ fortprintf(fd, " deallocate(%s %% %s %% array)</font>
<font color="blue">", group_ptr->name, var_list_ptr2->var->super_array);
+ fortprintf(fd, " end if</font>
<font color="black">");
fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="black">", group_ptr->name, var_list_ptr2->var->super_array);
fortprintf(fd, " call mpas_deallocate_attlist(%s %% %s %% attList)</font>
<font color="black">", 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(%s %% %s %% array)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " if(associated(%s %% %s %% array)) then</font>
<font color="blue">", group_ptr->name, 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, " end if</font>
<font color="black">");
fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " call mpas_deallocate_attlist(%s %% %s %% attList)</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code);
@@ -1110,8 +1119,10 @@
{
var_list_ptr = group_ptr->vlist;
var_list_ptr = var_list_ptr->next;
+
+ if (!var_list_ptr) break;
+
var_ptr = var_list_ptr->var;
-
int ntime_levs = 1;
@@ -2126,6 +2137,7 @@
dimlist_ptr = var_ptr->dimlist;
i = 1;
+ if(var_ptr->persistence == PERSISTENT){
while (dimlist_ptr) {
if (i == var_ptr->ndims) {
@@ -2172,6 +2184,7 @@
i++;
dimlist_ptr = dimlist_ptr -> next;
}
+ }
if (var_list_ptr) var_list_ptr = var_list_ptr->next;
}
</font>
</pre>