diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 index 4d07ddf7e..e0cf3f7bf 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 @@ -807,10 +807,10 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) if (root_proc) then allocate (long (out_ntiles)) allocate (latg (out_ntiles)) - call ReadTileFile_RealLatLon ( OutTileFile, n, long, latg) + call ReadTileFile_RealLatLon ( OutTileFile, n, xlon=long, xlat=latg) _ASSERT( n == out_ntiles, "Out tile number should match") this%latg = latg - call ReadTileFile_RealLatLon ( InTileFile, n, lonc, latc) + call ReadTileFile_RealLatLon ( InTileFile, n, xlon=lonc, xlat=latc) _ASSERT( n == in_ntiles, "In tile number should match") endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 index 6a6df0672..39976ff86 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 @@ -6,7 +6,7 @@ program SaltImpConverter use MAPL_ConstantsMod,only: MAPL_PI, MAPL_radius use netcdf use MAPL - use mk_restarts_getidsMod, only: ReadTileFile_IntLatLon + use mk_restarts_getidsMod, only: ReadTileFile_RealLatLon use gFTL_StringVector implicit none @@ -18,8 +18,6 @@ program SaltImpConverter character*256 :: arg integer :: i, rc, jc, iostat, iargc, n, mask,j,k,otiles,nsubtiles,l,itiles,nwords - integer, pointer :: Lono(:), Lato(:), Id(:), Pf(:) - integer, pointer :: Loni(:), Lati(:) real, allocatable :: varIn(:),varOut(:) real, allocatable :: TW(:),SW(:) real*8, allocatable :: varInR8(:),varOutR8(:) @@ -113,13 +111,7 @@ program SaltImpConverter ! Read Output Tile File .til file ! to get the index into the pfafsttater table - call ReadTileFile_IntLatLon(InTileFile ,Pf,Id,loni,lati,zoom, 0) - deallocate(Pf,Id) - - nullify(Pf) - nullify(Id) - - itiles = size(loni) ! Input Tile Size + call ReadTileFile_RealLatLon(InTileFile , itiles, mask = 0) allocate( varIn(itiles) ) allocate( varOut(itiles) ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 index 16eab40d7..5ea5824ed 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 @@ -5,7 +5,7 @@ program SaltIntSplitter use MAPL_ConstantsMod,only: MAPL_PI, MAPL_radius use netcdf use MAPL - use mk_restarts_getidsMod, only: ReadTileFile_IntLatLon + use mk_restarts_getidsMod, only: ReadTileFile_RealLatLon use gFTL_StringVector use gFTL_StringIntegerMap @@ -17,8 +17,6 @@ program SaltIntSplitter character*256 :: arg integer :: i, rc, jc, iostat, iargc, n, mask,j,k,otiles,nsubtiles,l,itiles,nwords - integer, pointer :: Lono(:), Lato(:), Id(:), Pf(:) - integer, pointer :: Loni(:), Lati(:) real, allocatable :: varIn(:),varOut(:) real*8, allocatable :: varInR8(:),varOutR8(:) real, allocatable :: var2(:,:) @@ -66,16 +64,8 @@ program SaltIntSplitter call getarg(1,InTileFile) call getarg(2,InRestart) -! Read Output Tile File .til file -! to get the index into the pfafsttater table - call ReadTileFile_IntLatLon(InTileFile ,Pf,Id,loni,lati,zoom,0) - deallocate(Pf,Id) - - nullify(Pf) - nullify(Id) - - itiles = size(loni) ! Input Tile Size + call ReadTileFile_RealLatLon(InTileFile, itiles, mask=0) allocate( varIn(itiles), source = 0. ) allocate( varOut(itiles), source = 0. ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 index 9212dc919..814ed551d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 @@ -18,7 +18,7 @@ module mk_restarts_getidsMod contains - subroutine ReadTileFile_IntLatLon(Tf,Pf,Id,lon,lat,zoom,mask) + subroutine ReadTileFile_IntLatLon(Tf, ntiles, zoom, lon_int, lat_int, mask) ! Read *.til tile definition file, return integer lat/lon for fast but inaccurate processing. ! Can handle "old" format of *.til files, but that is probably obsolete as of March 2020 and @@ -27,77 +27,32 @@ subroutine ReadTileFile_IntLatLon(Tf,Pf,Id,lon,lat,zoom,mask) ! that is read into "Pf" depends on whether the file is for EASE or cube-sphere grid tiles! ! - reichle, 4 Mar 2020 - character*(*), intent(IN) :: Tf - integer, pointer :: Pf(:), Id(:), lon(:), lat(:) - integer, intent(in) :: zoom + character*(*), intent(IN) :: Tf + integer, intent(out) :: ntiles + integer, intent(in) :: zoom + integer, pointer, optional :: lon_int(:), lat_int(:) integer, optional, intent(IN) :: mask - - integer, allocatable :: Pf1(:), Id1(:), ln1(:), lt1(:) - integer :: k, i, nt, pfs, ids,n,msk, umask + + real, pointer :: xlon(:), xlat(:) + real :: dum(4),dum1,lnn,ltt integer :: de, ce, st - logical :: old - de=180*zoom - ce=360*zoom - st=2*zoom - if(present(mask)) then - umask = mask + + if (present(lon_int) .and. present(lat_int)) then + de=180*zoom + ce=360*zoom + call ReadTileFile_RealLatLon(Tf, ntiles, xlon=xlon, xlat=xlat, mask=mask) + allocate(lon_int(ntiles), lat_int(ntiles)) + lon_int = nint(xlon*zoom) + lat_int = max(min(nint(xlat*zoom),90*zoom),-90*zoom) + where(lon_int<-de) lon_int = lon_int + ce + where(lon_int> de) lon_int = lon_int - ce + deallocate(xlon, xlat) else - umask = 100 + call ReadTileFile_RealLatLon(Tf, ntiles, mask=mask) endif - - print *, "Reading tilefile ",trim(Tf) - - open(unit=20,file=trim(Tf),form='formatted') - - read(20,*,iostat=n) Nt,i,k - old=n<0 - close(20) - - open(unit=20,file=trim(Tf),form='formatted') - - read(20,*) Nt - - do i=1,7 - read(20,*) - enddo - - allocate(Pf1(Nt),Id1(Nt),ln1(Nt),lt1(Nt)) - - n=0 - do i=1,Nt - if(old) then - read(20,*,end=200) msk, Pfs, lnn, ltt - ids = 0 - else - read(20,*,end=200) msk, dum1, lnn, ltt, dum, Pfs, Ids - end if - if(msk/=umask) cycle - n = n+1 - pf1(n) = pfs - Id1(n) = ids - ln1(n) = nint(lnn*zoom) - Lt1(n)=max(min(nint(ltt*zoom),90*zoom),-90*zoom) - if(ln1(n)<-de) ln1(n) = ln1(n) + ce - if(ln1(n)> de) ln1(n) = ln1(n) - ce - enddo - - 200 continue - - close(20) - - Nt=n - print *, "Found ",nt," land tiles." - - allocate(Pf(Nt),Id(Nt),lon(Nt),lat(Nt)) - Pf = Pf1(:Nt) - Id = Id1(:Nt) - lon = ln1(:Nt) - lat = lt1(:Nt) - deallocate(Pf1,Id1,ln1,lt1) - - return + end subroutine ReadTileFile_IntLatLon subroutine GetStencil(ii,jj,st) @@ -535,69 +490,99 @@ real function haversine(deglat1,deglon1,deglat2,deglon2) ! ***************************************************************************** - subroutine ReadTileFile_RealLatLon (InCNTileFile, ntiles, xlon, xlat,mask) + subroutine ReadTileFile_RealLatLon (InCNTileFile, ntiles, xlon, xlat, mask) ! read *.til tile definition file, return *real* lat/lon for slow but accurate processing implicit none character(*), intent (in) :: InCNTileFile - integer , intent (inout) :: ntiles - real, pointer, dimension (:) :: xlon, xlat + integer , intent (out) :: ntiles + real, pointer, optional, dimension (:) :: xlon, xlat integer, optional, intent(IN) :: mask integer :: n,icnt,ityp, nt, umask, i, header real :: xval,yval, pf - real, allocatable :: ln1(:), lt1(:) - - if(present(mask)) then - umask = mask - else - umask = 100 - endif - - open(11,file=InCNTileFile, & - form='formatted',action='read',status='old') + real, allocatable :: ln1(:), lt1(:) + real, pointer :: AVR(:,:) + integer :: filetype, k + integer, allocatable :: indices(:), indices_tmp(:) + logical :: isNC4 + + if(present(mask)) then + umask = mask + else + umask = 100 + endif + + call MAPL_NCIOGetFileType(InCNTileFile, filetype) + isNC4 = (filetype == MAPL_FILETYPE_NC4) + + if (isNC4) then + call MAPL_ReadTilingNC4(InCNTileFile, AVR=AVR) + allocate(indices_tmp(size(AVR,1))) + k = 0 + do i = 1, size(AVR,1) + if( int(AVR(i,1)) == umask) then + k = k+1 + indices_tmp(k) = i + endif + enddo + indices = indices_tmp(1:k) + Ntiles = k + if ( present(xlon) .and. present(xlat)) then + if(.not.associated (xlon)) allocate(xlon(Ntiles)) + if(.not.associated (xlat)) allocate(xlat(Ntiles)) + xlon = AVR(indices, 3) + xlat = AVR(indices, 4) + endif + deallocate(AVR) + else - ! first read number of lines in the til file header - ! ------------------------------------------------- - header = 5 - read (11,*, iostat=n) Nt - do i = 1, header -1 - read (11,*) - end do - read (11,*,IOSTAT=n)ityp,pf,xval, yval - if(n /= 0) header = 8 + open(11,file=InCNTileFile, form='formatted',action='read',status='old') - rewind (11) + ! first read number of lines in the til file header + ! ------------------------------------------------- + header = 5 + read (11,*, iostat=n) Nt + do i = 1, header -1 + read (11,*) + end do + read (11,*,IOSTAT=n)ityp,pf,xval, yval + if(n /= 0) header = 8 - ! read the tile file - !------------------- - read (11,*, iostat=n) Nt + rewind (11) + + ! read the tile file + !------------------- + read (11,*, iostat=n) Nt - allocate(ln1(Nt),lt1(Nt)) + allocate(ln1(Nt),lt1(Nt)) - do n = 1,header-1 ! skip header - read(11,*) - end do + do n = 1,header-1 ! skip header + read(11,*) + end do - icnt = 0 - - do i=1,Nt - read(11,*) ityp,pf,xval,yval - if(ityp == umask) then - icnt = icnt + 1 - ln1(icnt) = xval - Lt1(icnt) = yval - endif - end do - - close(11) - - Ntiles = icnt - if(.not.associated (xlon)) allocate(xlon(Ntiles)) - if(.not.associated (xlat)) allocate(xlat(Ntiles)) - xlon = ln1(:Ntiles) - xlat = lt1(:Ntiles) - + icnt = 0 + + do i=1,Nt + read(11,*) ityp,pf,xval,yval + if(ityp == umask) then + icnt = icnt + 1 + ln1(icnt) = xval + Lt1(icnt) = yval + endif + end do + + close(11) + + Ntiles = icnt + if ( present(xlon) .and. present(xlat)) then + if(.not.associated (xlon)) allocate(xlon(Ntiles)) + if(.not.associated (xlat)) allocate(xlat(Ntiles)) + xlon = ln1(:Ntiles) + xlat = lt1(:Ntiles) + endif + endif !isNC4 + end subroutine ReadTileFile_RealLatLon end module mk_restarts_getidsMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CICERestart.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CICERestart.F90 index a6deac791..71e1294cc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CICERestart.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CICERestart.F90 @@ -15,8 +15,8 @@ program mk_CiceRestart character*128 :: InRestart character*128 :: arg - integer :: i, iargc, n,j,ntiles,k - integer, pointer :: Lono(:), Lato(:), Id(:), Pf(:) + integer :: i, iargc, n,j, otiles,k, itiles + integer, pointer :: Lono(:), Lato(:), Id(:) integer, pointer :: Loni(:), Lati(:) real*4, allocatable :: var4(:) real*8, allocatable :: var8(:) @@ -40,16 +40,8 @@ program mk_CiceRestart ! Read Output Tile File .til file ! to get the index into the pfafsttater table - call ReadTileFile_IntLatLon(OutTileFile,Pf,Id,lono,lato,zoom,0) - deallocate(Pf,Id) - - call ReadTileFile_IntLatLon(InTileFile ,Pf,Id,loni,lati,zoom,0) - deallocate(Pf,Id) - - nullify(Pf) - nullify(Id) - - ntiles = size(lono) + call ReadTileFile_IntLatLon(OutTileFile, otiles, zoom, lon_int=lono, lat_int=lato, mask = 0) + call ReadTileFile_IntLatLon(InTileFile, itiles, zoom, lon_int=loni, lat_int=lati, mask = 0) i = index(InRestart,'/',back=.true.) @@ -59,7 +51,7 @@ program mk_CiceRestart open(unit=50,FILE=InRestart,form='unformatted',& status='old',convert='little_endian') - allocate(var4(size(loni)),var8(size(loni))) + allocate(var4(itiles),var8(itiles)) do n=1,124 read (50) @@ -69,23 +61,23 @@ program mk_CiceRestart rewind 50 - allocate(Id (ntiles)) + allocate(Id (otiles)) call GetIds(loni,lati,lono,lato,zoom,Id) do n=1,18 read (50) var4(:) - write(40)(var4(id(i)),i=1,ntiles) + write(40)(var4(id(i)),i=1,otiles) end do do n=19,74 read (50) var8(:) - write(40)(var8(id(i)),i=1,ntiles) + write(40)(var8(id(i)),i=1,otiles) end do do n=75,125 read (50) var4(:) - write(40)(var4(id(i)),i=1,ntiles) + write(40)(var4(id(i)),i=1,otiles) end do deallocate(var4,var8) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 index abf5e507e..e4ab880c8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 @@ -326,8 +326,8 @@ program mk_CatchCNRestarts MPI_PROC0 : if (root_proc) then ! Read Output/Input .til files - call ReadTileFile_RealLatLon(OutTileFile, ntiles, lono, lato) - call ReadTileFile_RealLatLon(InTileFile,ntiles_in,loni,lati) + call ReadTileFile_RealLatLon(OutTileFile, ntiles, xlon=lono, xlat=lato) + call ReadTileFile_RealLatLon(InTileFile,ntiles_in,xlon=loni, xlat=lati) allocate(Id (ntiles)) ! ------------------------------------------------ @@ -1154,7 +1154,7 @@ SUBROUTINE regrid_carbon_vars ( & allocate (latg (ntiles)) allocate (DAYX (NTILES)) - call ReadTileFile_RealLatLon (OutTileFile, i, long, latg) + call ReadTileFile_RealLatLon (OutTileFile, i, xlon=long, xlat=latg) !----------------------- ! COMPUTE DAYX @@ -1201,7 +1201,7 @@ SUBROUTINE regrid_carbon_vars ( & ! Read exact lonc, latc from offline .til File ! --------------------------------------------- - call ReadTileFile_RealLatLon(InCNTilFile,i,lonc,latc) + call ReadTileFile_RealLatLon(InCNTilFile,i,xlon=lonc,xlat=latc) endif @@ -1921,13 +1921,13 @@ SUBROUTINE regrid_hyd_vars (NTILES, OutFMT) allocate (latg (ntiles)) allocate (ld_reorder(ntiles_cn)) - call ReadTileFile_RealLatLon (OutTileFile, i, long, latg) + call ReadTileFile_RealLatLon (OutTileFile, i, xlon=long, xlat=latg) ! --------------------------------------------- ! Read exact lonc, latc from offline .til File ! --------------------------------------------- - call ReadTileFile_RealLatLon(trim(InCNTilFile), i,lonc,latc) + call ReadTileFile_RealLatLon(trim(InCNTilFile), i,xlon=lonc,xlat=latc) STATUS = NF_OPEN (trim(InCNRestart),NF_NOWRITE,NCFID) STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TILE_ID' ), (/1/), (/NTILES_CN/),tmp_var) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 index 4e6b2d94f..26884ad03 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 @@ -75,8 +75,8 @@ program mk_CatchRestarts if (root_proc) then ! Read Output/Input .til files - call ReadTileFile_RealLatLon(OutTileFile, ntiles, lono, lato) - call ReadTileFile_RealLatLon(InTileFile,ntiles_in,loni,lati) + call ReadTileFile_RealLatLon(OutTileFile, ntiles, xlon=lono, xlat=lato) + call ReadTileFile_RealLatLon(InTileFile,ntiles_in,xlon=loni, xlat=lati) allocate(Id (ntiles)) ! allocate(mask (ntiles_in)) ! allocate(tid_in (ntiles_in)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 index dd2b5c266..5e3da8d3a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 @@ -445,7 +445,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MOD allocate (lon_rst (1:ntiles_rst)) allocate (lat_rst (1:ntiles_rst)) - call ReadTileFile_RealLatLon ('InData/OutTileFile', i, long, latg); VERIFY_(i-ntiles) + call ReadTileFile_RealLatLon ('InData/OutTileFile', i, xlon=long, xlat=latg); VERIFY_(i-ntiles) read (10) LDAS2BCS read (10) tile_id @@ -1187,17 +1187,17 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) allocate (latg (ntiles)) allocate (ld_reorder(ntiles_smap)) - call ReadTileFile_RealLatLon ('InData/OutTileFile', i, long, latg); VERIFY_(i-ntiles) + call ReadTileFile_RealLatLon ('InData/OutTileFile', i, xlon=long, xlat=latg); VERIFY_(i-ntiles) ! --------------------------------------------- ! Read exact lonc, latc from offline .til File ! --------------------------------------------- if(index(MODEL,'catchcn') /=0) then - call ReadTileFile_RealLatLon(trim(InCNTilFile ),i,lonc,latc) + call ReadTileFile_RealLatLon(trim(InCNTilFile ),i,xlon=lonc,xlat=latc) VERIFY_(i-ntiles_smap) endif if(trim(MODEL) == 'catch' ) then - call ReadTileFile_RealLatLon(trim(InCatTilFile),i,lonc,latc) + call ReadTileFile_RealLatLon(trim(InCatTilFile),i,xlon=lonc,xlat=latc) VERIFY_(i-ntiles_smap) endif if(index(MODEL,'catchcn') /=0) then @@ -1852,7 +1852,7 @@ SUBROUTINE regrid_carbon_vars (NTILES, model) allocate (latg (ntiles)) allocate (DAYX (NTILES)) - call ReadTileFile_RealLatLon (OutTileFile, i, long, latg); VERIFY_(i-ntiles) + call ReadTileFile_RealLatLon (OutTileFile, i, xlon=long, xlat=latg); VERIFY_(i-ntiles) ! Compute DAYX ! ------------ @@ -1865,7 +1865,7 @@ SUBROUTINE regrid_carbon_vars (NTILES, model) ! Read exact lonc, latc from offline .til File ! --------------------------------------------- - call ReadTileFile_RealLatLon(trim(InCNTilFile),i,lonc,latc); VERIFY_(i-ntiles_cn) + call ReadTileFile_RealLatLon(trim(InCNTilFile),i,xlon=lonc,xlat=latc); VERIFY_(i-ntiles_cn) endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 index b499074d3..478b6f3f9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 @@ -18,7 +18,7 @@ program mk_LakeLandiceSaltRestarts character*256 :: arg integer :: i, rc, jc, iostat, iargc, n, mask,j,k,otiles,nsubtiles,l,itiles,nwords - integer, pointer :: Lono(:), Lato(:), Id(:), Pf(:) + integer, pointer :: Lono(:), Lato(:), Id(:) integer, pointer :: Loni(:), Lati(:) real, allocatable :: varIn(:),varOut(:) real*8, allocatable :: varIn8(:),varOut8(:) @@ -67,17 +67,9 @@ program mk_LakeLandiceSaltRestarts ! Read Output Tile File .til file ! to get the index into the pfafsttater table - call ReadTileFile_IntLatLon(OutTileFile,Pf,Id,lono,lato,zoom,mask) - deallocate(Pf,Id) + call ReadTileFile_IntLatLon(OutTileFile, otiles, zoom, lon_int=lono, lat_int=lato, mask=mask) + call ReadTileFile_IntLatLon(InTileFile, itiles, zoom, lon_int=loni, lat_int=lati, mask=mask) - call ReadTileFile_IntLatLon(InTileFile ,Pf,Id,loni,lati,zoom,mask) - deallocate(Pf,Id) - - nullify(Pf) - nullify(Id) - - itiles = size(loni) ! Input Tile Size - otiles = size(lono) ! Output Tile Size allocate(Id (otiles)) call GetIds(loni,lati,lono,lato,zoom,Id)