From 18855905483a408cfc2f8528edae2c8fd0358969 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 14 Oct 2020 12:55:01 -0400 Subject: [PATCH] fix coarse grid IO in history and extdata --- CHANGELOG.md | 2 + base/MAPL_newCFIO.F90 | 140 +++++++++++++++++++++++++++++++----------- 2 files changed, 105 insertions(+), 37 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0585d5a14d13..4a3b3f19222f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] +- Fix bug with using coarse grids in History and ExtData + ### Added ### Changed ### Fixed diff --git a/base/MAPL_newCFIO.F90 b/base/MAPL_newCFIO.F90 index 933b82eed748..d0e3c371ec49 100644 --- a/base/MAPL_newCFIO.F90 +++ b/base/MAPL_newCFIO.F90 @@ -411,9 +411,18 @@ subroutine RegridScalar(this,itemName,rc) real, pointer :: ptr2d(:,:), outptr2d(:,:) real, allocatable, target :: ptr3d_inter(:,:,:) type(ESMF_Grid) :: gridIn,gridOut + logical :: hasDE_in, hasDE_out call ESMF_FieldBundleGet(this%output_bundle,itemName,field=outField,rc=status) _VERIFY(status) + call ESMF_FieldBundleGet(this%input_bundle,grid=gridIn,rc=status) + _VERIFY(status) + call ESMF_FieldBundleGet(this%output_bundle,grid=gridOut,rc=status) + _VERIFY(status) + hasDE_in = MAPL_GridHasDE(gridIn,rc=status) + _VERIFY(status) + hasDE_out = MAPL_GridHasDE(gridOut,rc=status) + _VERIFY(status) if (this%doVertRegrid) then call ESMF_FieldBundleGet(this%input_bundle,itemName,field=field,rc=status) @@ -421,8 +430,12 @@ subroutine RegridScalar(this,itemName,rc) call ESMF_FieldGet(Field,rank=fieldRank,rc=status) _VERIFY(status) if (fieldRank==3) then - call ESMF_FieldGet(field,farrayPtr=ptr3d,rc=status) - _VERIFY(status) + if (hasDE_in) then + call ESMF_FieldGet(field,farrayPtr=ptr3d,rc=status) + _VERIFY(status) + else + allocate(ptr3d(0,0,0)) + end if allocate(ptr3d_inter(size(ptr3d,1),size(ptr3d,2),this%vdata%lm),stat=status) _VERIFY(status) if (this%vdata%regrid_type==VERTICAL_METHOD_SELECT) then @@ -438,19 +451,23 @@ subroutine RegridScalar(this,itemName,rc) if (associated(ptr3d)) nullify(ptr3d) end if - call ESMF_FieldBundleGet(this%input_bundle,grid=gridIn,rc=status) - _VERIFY(status) - call ESMF_FieldBundleGet(this%output_bundle,grid=gridOut,rc=status) - _VERIFY(status) call ESMF_FieldBundleGet(this%input_bundle,itemName,field=field,rc=status) _VERIFY(status) call ESMF_FieldGet(field,rank=fieldRank,rc=status) _VERIFY(status) if (fieldRank==2) then - call MAPL_FieldGetPointer(field,ptr2d,rc=status) - _VERIFY(status) - call MAPL_FieldGetPointer(OutField,outptr2d,rc=status) - _VERIFY(status) + if (hasDE_in) then + call MAPL_FieldGetPointer(field,ptr2d,rc=status) + _VERIFY(status) + else + allocate(ptr2d(0,0)) + end if + if (hasDE_out) then + call MAPL_FieldGetPointer(OutField,outptr2d,rc=status) + _VERIFY(status) + else + allocate(outptr2d(0,0)) + end if if (gridIn==gridOut) then outPtr2d=ptr2d else @@ -460,11 +477,19 @@ subroutine RegridScalar(this,itemName,rc) end if else if (fieldRank==3) then if (.not.associated(ptr3d)) then - call MAPL_FieldGetPointer(field,ptr3d,rc=status) + if (hasDE_in) then + call ESMF_FieldGet(field,farrayPtr=ptr3d,rc=status) + _VERIFY(status) + else + allocate(ptr3d(0,0,0)) + end if + end if + if (hasDE_out) then + call MAPL_FieldGetPointer(OutField,outptr3d,rc=status) _VERIFY(status) + else + allocate(outptr3d(0,0,0)) end if - call MAPL_FieldGetPointer(OutField,outptr3d,rc=status) - _VERIFY(status) if (gridIn==gridOut) then outPtr3d=Ptr3d else @@ -498,11 +523,20 @@ subroutine RegridVector(this,xName,yName,rc) real, pointer :: yptr2d(:,:), youtptr2d(:,:) real, allocatable, target :: yptr3d_inter(:,:,:) type(ESMF_Grid) :: gridIn, gridOut + logical :: hasDE_in, hasDE_out call ESMF_FieldBundleGet(this%output_bundle,xName,field=xoutField,rc=status) _VERIFY(status) call ESMF_FieldBundleGet(this%output_bundle,yName,field=youtField,rc=status) _VERIFY(status) + call ESMF_FieldBundleGet(this%input_bundle,grid=gridIn,rc=status) + _VERIFY(status) + call ESMF_FieldBundleGet(this%output_bundle,grid=gridOut,rc=status) + _VERIFY(status) + hasDE_in = MAPL_GridHasDE(gridIn,rc=status) + _VERIFY(status) + hasDE_out = MAPL_GridHasDE(gridOut,rc=status) + _VERIFY(status) if (this%doVertRegrid) then call ESMF_FieldBundleGet(this%input_bundle,xName,field=xfield,rc=status) @@ -510,8 +544,12 @@ subroutine RegridVector(this,xName,yName,rc) call ESMF_FieldGet(xField,rank=fieldRank,rc=status) _VERIFY(status) if (fieldRank==3) then - call ESMF_FieldGet(xfield,farrayPtr=xptr3d,rc=status) - _VERIFY(status) + if (hasDE_in) then + call ESMF_FieldGet(xfield,farrayPtr=xptr3d,rc=status) + _VERIFY(status) + else + allocate(xptr3d(0,0,0)) + end if allocate(xptr3d_inter(size(xptr3d,1),size(xptr3d,2),this%vdata%lm),stat=status) _VERIFY(status) if (this%vdata%regrid_type==VERTICAL_METHOD_SELECT) then @@ -528,8 +566,12 @@ subroutine RegridVector(this,xName,yName,rc) call ESMF_FieldGet(yField,rank=fieldRank,rc=status) _VERIFY(status) if (fieldRank==3) then - call ESMF_FieldGet(yfield,farrayPtr=yptr3d,rc=status) - _VERIFY(status) + if (hasDE_in) then + call ESMF_FieldGet(yfield,farrayPtr=yptr3d,rc=status) + _VERIFY(status) + else + allocate(yptr3d(0,0,0)) + end if allocate(yptr3d_inter(size(yptr3d,1),size(yptr3d,2),this%vdata%lm),stat=status) _VERIFY(status) if (this%vdata%regrid_type==VERTICAL_METHOD_SELECT) then @@ -546,10 +588,6 @@ subroutine RegridVector(this,xName,yName,rc) if (associated(yptr3d)) nullify(yptr3d) end if - call ESMF_FieldBundleGet(this%input_bundle,grid=gridIn,rc=status) - _VERIFY(status) - call ESMF_FieldBundleGet(this%output_bundle,grid=gridOut,rc=status) - _VERIFY(status) call ESMF_FieldBundleGet(this%input_bundle,xname,field=xfield,rc=status) _VERIFY(status) call ESMF_FieldBundleGet(this%input_bundle,yname,field=yfield,rc=status) @@ -557,15 +595,26 @@ subroutine RegridVector(this,xName,yName,rc) call ESMF_FieldGet(xfield,rank=fieldRank,rc=status) _VERIFY(status) if (fieldRank==2) then - call MAPL_FieldGetPointer(xfield,xptr2d,rc=status) - _VERIFY(status) - call MAPL_FieldGetPointer(xOutField,xoutptr2d,rc=status) - _VERIFY(status) + if (hasDE_in) then + call MAPL_FieldGetPointer(xfield,xptr2d,rc=status) + _VERIFY(status) + call MAPL_FieldGetPointer(yfield,yptr2d,rc=status) + _VERIFY(status) + else + allocate(xptr2d(0,0)) + allocate(yptr2d(0,0)) + end if + + if (hasDE_in) then + call MAPL_FieldGetPointer(xOutField,xoutptr2d,rc=status) + _VERIFY(status) + call MAPL_FieldGetPointer(yOutField,youtptr2d,rc=status) + _VERIFY(status) + else + allocate(xoutptr2d(0,0)) + allocate(youtptr2d(0,0)) + end if - call MAPL_FieldGetPointer(yfield,yptr2d,rc=status) - _VERIFY(status) - call MAPL_FieldGetPointer(yOutField,youtptr2d,rc=status) - _VERIFY(status) if (gridIn==gridOut) then xoutPtr2d=xptr2d @@ -576,18 +625,31 @@ subroutine RegridVector(this,xName,yName,rc) end if else if (fieldRank==3) then if (.not.associated(xptr3d)) then - call MAPL_FieldGetPointer(xfield,xptr3d,rc=status) - _VERIFY(status) + if (hasDE_in) then + call MAPL_FieldGetPointer(xfield,xptr3d,rc=status) + _VERIFY(status) + else + allocate(xptr3d(0,0,0)) + end if end if - call MAPL_FieldGetPointer(xOutField,xoutptr3d,rc=status) - _VERIFY(status) - if (.not.associated(yptr3d)) then - call MAPL_FieldGetPointer(yfield,yptr3d,rc=status) + if (hasDE_in) then + call MAPL_FieldGetPointer(yfield,yptr3d,rc=status) + _VERIFY(status) + else + allocate(yptr3d(0,0,0)) + end if + end if + + if (hasDE_out) then + call MAPL_FieldGetPointer(xOutField,xoutptr3d,rc=status) _VERIFY(status) + call MAPL_FieldGetPointer(yOutField,youtptr3d,rc=status) + _VERIFY(status) + else + allocate(xoutptr3d(0,0,0)) + allocate(youtptr3d(0,0,0)) end if - call MAPL_FieldGetPointer(yOutField,youtptr3d,rc=status) - _VERIFY(status) if (gridIn==gridOut) then xoutPtr3d=xptr3d @@ -717,6 +779,8 @@ subroutine stageData(this, field, fileName, tIndex, oClients, rc) call pFIO_DownBit(ptr2d,ptr2d,this%nbits,undef=MAPL_undef,rc=status) _VERIFY(status) end if + else + allocate(ptr2d(0,0)) end if ref = factory%generate_file_reference2D(Ptr2D) allocate(localStart,source=[gridLocalStart,1]) @@ -730,6 +794,8 @@ subroutine stageData(this, field, fileName, tIndex, oClients, rc) call pFIO_DownBit(ptr3d,ptr3d,this%nbits,undef=MAPL_undef,rc=status) _VERIFY(status) end if + else + allocate(ptr3d(0,0,0)) end if ref = factory%generate_file_reference3D(Ptr3D) allocate(localStart,source=[gridLocalStart,1,1])