Merge pull request #153 from GEOS-ESM/feature/bmauer/ncread_2d_r8_interface

Update so that interp_restarts.x will build when FV_PRECISION=R8

Author: mathomp4

fv_regrid_c2c.F90

@@ -59,7 +59,48 @@ module fv_regrid_c2c
    integer :: IUNIT=15
    integer :: OUNIT=16
 
+   interface read_topo_file
+      module procedure read_topo_file_r4
+      module procedure read_topo_file_r8
+   end interface
+                        
 contains
+                        
+   subroutine read_topo_file_r4(fname,output,grid,rc)
+      character(len=*), intent(in) :: fname
+      type(ESMF_Grid), intent(in) :: grid
+      real(real4), intent(inout) :: output(:,:)
+      integer, intent(out), optional :: rc
+      
+      integer :: status,dims(3),funit
+      real, allocatable :: input(:,:)
+      call MAPL_GridGet(grid,globalCellCountPerDim=dims,_RC)
+      allocate(input(dims(1),dims(2)))
+      open(newunit=funit,file=trim(fname),form='unformatted',iostat=status)
+      _VERIFY(status)
+      read(funit)input
+      call ArrayScatter(local_array=output,global_array=input,grid=grid,_RC)
+      _RETURN(_SUCCESS)
+   end subroutine read_topo_file_r4
+
+   subroutine read_topo_file_r8(fname,output,grid,rc)
+      character(len=*), intent(in) :: fname
+      type(ESMF_Grid), intent(in) :: grid
+      real(real8), intent(inout) :: output(:,:)
+      integer, intent(out), optional :: rc
+      
+      integer :: status,dims(3),funit
+      real, allocatable :: input(:,:)
+      real(real8), allocatable :: input_r8(:,:)
+      call MAPL_GridGet(grid,globalCellCountPerDim=dims,_RC)
+      allocate(input(dims(1),dims(2)),input_r8(dims(2),dims(2)))
+      open(newunit=funit,file=trim(fname),form='unformatted',iostat=status)
+      _VERIFY(status)
+      read(funit)input
+      input_r8 = input      
+      call ArrayScatter(local_array=output,global_array=input_r8,grid=grid,_RC)
+      _RETURN(_SUCCESS)
+   end subroutine read_topo_file_r8
 
    subroutine get_geos_ic( Atm, extra_rst, rstcube, gridOut)
 
@@ -1880,23 +1921,6 @@ end subroutine mpp_domain_decomp
 !
 ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
 !-------------------------------------------------------------------------------
-
-                     subroutine read_topo_file(fname,output,grid,rc)
-                        character(len=*), intent(in) :: fname
-                        type(ESMF_Grid), intent(in) :: grid
-                        real(real4), intent(inout) :: output(:,:)
-                        integer, intent(out), optional :: rc
 
-                        integer :: status,dims(3),funit
-                        real, allocatable :: input(:,:)
-                        call MAPL_GridGet(grid,globalCellCountPerDim=dims,_RC)
-                        allocate(input(dims(1),dims(2)))
-                        open(newunit=funit,file=trim(fname),form='unformatted',iostat=status)
-                        _VERIFY(status)
-                        read(funit)input
-                        call ArrayScatter(local_array=output,global_array=input,grid=grid,_RC)
-                        _RETURN(_SUCCESS)
-                     end subroutine read_topo_file
-
                   end module fv_regrid_c2c
 

fv_regrid_c2c_bin.F90

@@ -97,14 +97,14 @@ subroutine get_geos_ic_bin( Atm, extra_rst, rstcube, gridOut)
          if (extra_rst(i)%have_descriptor) then
             do j=1,size(extra_rst(i)%vars)
                if (extra_rst(i)%vars(j)%nLev/=1) then
-                  allocate(extra_rst(i)%vars(j)%ptr3d(isd:ied,jsd:jed,extra_rst(i)%vars(j)%nLev),source=0.0 )
+                  allocate(extra_rst(i)%vars(j)%ptr3d(isd:ied,jsd:jed,extra_rst(i)%vars(j)%nLev),source=0.0_FVPRC )
                else
-                  allocate(extra_rst(i)%vars(j)%ptr2d(isd:ied,jsd:jed), source=0.0 )
+                  allocate(extra_rst(i)%vars(j)%ptr2d(isd:ied,jsd:jed), source=0.0_FVPRC )
                end if
             enddo
          else
             do j=1,size(extra_rst(i)%vars) 
-               allocate(extra_rst(i)%vars(j)%ptr3d(isd:ied,jsd:jed,extra_rst(i)%vars(j)%nLev),source=0.0 )
+               allocate(extra_rst(i)%vars(j)%ptr3d(isd:ied,jsd:jed,extra_rst(i)%vars(j)%nLev),source=0.0_FVPRC )
             enddo 
          end if
       enddo

fv_regridding_utils.F90

@@ -73,25 +73,25 @@ subroutine alloc_var(this,is,ie,js,je,km,rc)
     integer :: km_use
 
     if (this%rank==2) then
-       allocate(this%ptr2d(is:ie,js:je),source=0.0)
+       allocate(this%ptr2d(is:ie,js:je),source=0.0_FVPRC)
     else if (this%rank==3) then
        if (this%n_ungrid > 0) then
-          allocate(this%ptr3d(is:ie,js:je,this%n_ungrid),source=0.0)
+          allocate(this%ptr3d(is:ie,js:je,this%n_ungrid),source=0.0_FVPRC)
        else if (this%n_ungrid == 0) then
           if (present(km)) then 
              km_use = km
           else
              km_use = this%nlev
           end if
-          allocate(this%ptr3d(is:ie,js:je,km_use),source=0.0)
+          allocate(this%ptr3d(is:ie,js:je,km_use),source=0.0_FVPRC)
        end if
     else if (this%rank == 4) then
        if (present(km)) then 
           km_use = km
        else
           km_use = this%nlev
        end if
-       allocate(this%ptr4d(is:ie,js:je,km_use,this%n_ungrid),source=0.0)
+       allocate(this%ptr4d(is:ie,js:je,km_use,this%n_ungrid),source=0.0_FVPRC)
     end if
     _RETURN(_SUCCESS)