Skip to content

Commit 82bb60a

Browse files
weiyuan-jiangweiyuan-jiang
committed
refactoring getids
1 parent c7063d0 commit 82bb60a

File tree

10 files changed

+82
-148
lines changed

10 files changed

+82
-148
lines changed

‎GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/CMakeLists.txt‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,6 @@ if (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_SurfaceGridComp.F90)
1818
else ()
1919

2020
esma_add_subdirectories (${alldirs} Shared)
21-
2221
endif()
2322

2423
esma_add_subdirectories(Utils)

‎GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -807,10 +807,10 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc)
807807
if (root_proc) then
808808
allocate (long (out_ntiles))
809809
allocate (latg (out_ntiles))
810-
call ReadTileFile_RealLatLon ( OutTileFile, n, long, latg)
810+
call ReadTileFile_RealLatLon ( OutTileFile, n, xlon=long, xlat=latg)
811811
_ASSERT( n == out_ntiles, "Out tile number should match")
812812
this%latg = latg
813-
call ReadTileFile_RealLatLon ( InTileFile, n, lonc, latc)
813+
call ReadTileFile_RealLatLon ( InTileFile, n, xlon=lonc, xlat=latc)
814814
_ASSERT( n == in_ntiles, "In tile number should match")
815815
endif
816816

‎GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90‎

Lines changed: 2 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ program SaltImpConverter
66
use MAPL_ConstantsMod,only: MAPL_PI, MAPL_radius
77
use netcdf
88
use MAPL
9-
use mk_restarts_getidsMod, only: ReadTileFile_IntLatLon
9+
use mk_restarts_getidsMod, only: ReadTileFile_RealLatLon
1010
use gFTL_StringVector
1111
implicit none
1212

@@ -18,8 +18,6 @@ program SaltImpConverter
1818
character*256 :: arg
1919

2020
integer :: i, rc, jc, iostat, iargc, n, mask,j,k,otiles,nsubtiles,l,itiles,nwords
21-
integer, pointer :: Lono(:), Lato(:), Id(:), Pf(:)
22-
integer, pointer :: Loni(:), Lati(:)
2321
real, allocatable :: varIn(:),varOut(:)
2422
real, allocatable :: TW(:),SW(:)
2523
real*8, allocatable :: varInR8(:),varOutR8(:)
@@ -113,13 +111,7 @@ program SaltImpConverter
113111
! Read Output Tile File .til file
114112
! to get the index into the pfafsttater table
115113

116-
call ReadTileFile_IntLatLon(InTileFile ,Pf,Id,loni,lati,zoom, 0)
117-
deallocate(Pf,Id)
118-
119-
nullify(Pf)
120-
nullify(Id)
121-
122-
itiles = size(loni) ! Input Tile Size
114+
call ReadTileFile_RealLatLon(InTileFile , itiles, mask = 0)
123115

124116
allocate( varIn(itiles) )
125117
allocate( varOut(itiles) )

‎GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90‎

Lines changed: 2 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ program SaltIntSplitter
55
use MAPL_ConstantsMod,only: MAPL_PI, MAPL_radius
66
use netcdf
77
use MAPL
8-
use mk_restarts_getidsMod, only: ReadTileFile_IntLatLon
8+
use mk_restarts_getidsMod, only: ReadTileFile_RealLatLon
99
use gFTL_StringVector
1010
use gFTL_StringIntegerMap
1111

@@ -17,8 +17,6 @@ program SaltIntSplitter
1717
character*256 :: arg
1818

1919
integer :: i, rc, jc, iostat, iargc, n, mask,j,k,otiles,nsubtiles,l,itiles,nwords
20-
integer, pointer :: Lono(:), Lato(:), Id(:), Pf(:)
21-
integer, pointer :: Loni(:), Lati(:)
2220
real, allocatable :: varIn(:),varOut(:)
2321
real*8, allocatable :: varInR8(:),varOutR8(:)
2422
real, allocatable :: var2(:,:)
@@ -66,16 +64,8 @@ program SaltIntSplitter
6664
call getarg(1,InTileFile)
6765
call getarg(2,InRestart)
6866

69-
! Read Output Tile File .til file
70-
! to get the index into the pfafsttater table
7167

72-
call ReadTileFile_IntLatLon(InTileFile ,Pf,Id,loni,lati,zoom,0)
73-
deallocate(Pf,Id)
74-
75-
nullify(Pf)
76-
nullify(Id)
77-
78-
itiles = size(loni) ! Input Tile Size
68+
call ReadTileFile_RealLatLon(InTileFile, itiles, mask=0)
7969

8070
allocate( varIn(itiles), source = 0. )
8171
allocate( varOut(itiles), source = 0. )

‎GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90‎

Lines changed: 50 additions & 81 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ module mk_restarts_getidsMod
1818

1919
contains
2020

21-
subroutine ReadTileFile_IntLatLon(Tf,Pf,Id,lon,lat,zoom,mask)
21+
subroutine ReadTileFile_IntLatLon(Tf, ntiles, zoom, lon_int, lat_int, mask)
2222

2323
! Read *.til tile definition file, return integer lat/lon for fast but inaccurate processing.
2424
! 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)
2727
! that is read into "Pf" depends on whether the file is for EASE or cube-sphere grid tiles!
2828
! - reichle, 4 Mar 2020
2929

30-
character*(*), intent(IN) :: Tf
31-
integer, pointer :: Pf(:), Id(:), lon(:), lat(:)
32-
integer, intent(in) :: zoom
30+
character*(*), intent(IN) :: Tf
31+
integer, intent(out) :: ntiles
32+
integer, intent(in) :: zoom
33+
integer, pointer, optional :: lon_int(:), lat_int(:)
3334
integer, optional, intent(IN) :: mask
34-
35-
integer, allocatable :: Pf1(:), Id1(:), ln1(:), lt1(:)
36-
integer :: k, i, nt, pfs, ids,n,msk, umask
35+
36+
real, pointer :: xlon(:), xlat(:)
37+
3738
real :: dum(4),dum1,lnn,ltt
3839
integer :: de, ce, st
39-
logical :: old
4040

41-
de=180*zoom
42-
ce=360*zoom
43-
st=2*zoom
44-
if(present(mask)) then
45-
umask = mask
41+
42+
if (present(lon_int) .and. present(lat_int)) then
43+
de=180*zoom
44+
ce=360*zoom
45+
call ReadTileFile_RealLatLon(Tf, ntiles, xlon=xlon, xlat=xlat, mask=mask)
46+
allocate(lon_int(ntiles), lat_int(ntiles))
47+
lon_int = nint(xlon*zoom)
48+
lat_int = max(min(nint(xlat*zoom),90*zoom),-90*zoom)
49+
where(lon_int<-de) lon_int = lon_int + ce
50+
where(lon_int> de) lon_int = lon_int - ce
51+
deallocate(xlon, xlat)
4652
else
47-
umask = 100
53+
call ReadTileFile_RealLatLon(Tf, ntiles, mask=mask)
4854
endif
49-
50-
print *, "Reading tilefile ",trim(Tf)
51-
52-
open(unit=20,file=trim(Tf),form='formatted')
53-
54-
read(20,*,iostat=n) Nt,i,k
55-
old=n<0
56-
close(20)
57-
58-
open(unit=20,file=trim(Tf),form='formatted')
59-
60-
read(20,*) Nt
61-
62-
do i=1,7
63-
read(20,*)
64-
enddo
65-
66-
allocate(Pf1(Nt),Id1(Nt),ln1(Nt),lt1(Nt))
67-
68-
n=0
69-
do i=1,Nt
70-
if(old) then
71-
read(20,*,end=200) msk, Pfs, lnn, ltt
72-
ids = 0
73-
else
74-
read(20,*,end=200) msk, dum1, lnn, ltt, dum, Pfs, Ids
75-
end if
76-
if(msk/=umask) cycle
77-
n = n+1
78-
pf1(n) = pfs
79-
Id1(n) = ids
80-
ln1(n) = nint(lnn*zoom)
81-
Lt1(n)=max(min(nint(ltt*zoom),90*zoom),-90*zoom)
82-
if(ln1(n)<-de) ln1(n) = ln1(n) + ce
83-
if(ln1(n)> de) ln1(n) = ln1(n) - ce
84-
enddo
85-
86-
200 continue
87-
88-
close(20)
89-
90-
Nt=n
91-
print *, "Found ",nt," land tiles."
92-
93-
allocate(Pf(Nt),Id(Nt),lon(Nt),lat(Nt))
94-
Pf = Pf1(:Nt)
95-
Id = Id1(:Nt)
96-
lon = ln1(:Nt)
97-
lat = lt1(:Nt)
98-
deallocate(Pf1,Id1,ln1,lt1)
99-
100-
return
55+
10156
end subroutine ReadTileFile_IntLatLon
10257

10358
subroutine GetStencil(ii,jj,st)
@@ -535,20 +490,21 @@ real function haversine(deglat1,deglon1,deglat2,deglon2)
535490

536491
! *****************************************************************************
537492

538-
subroutine ReadTileFile_RealLatLon (InCNTileFile, ntiles, xlon, xlat,mask)
493+
subroutine ReadTileFile_RealLatLon (InCNTileFile, ntiles, xlon, xlat, mask)
539494

540495
! read *.til tile definition file, return *real* lat/lon for slow but accurate processing
541496

542497
implicit none
543498
character(*), intent (in) :: InCNTileFile
544-
integer , intent (inout) :: ntiles
545-
real, pointer, dimension (:) :: xlon, xlat
499+
integer , intent (out) :: ntiles
500+
real, pointer, optional, dimension (:) :: xlon, xlat
546501
integer, optional, intent(IN) :: mask
547502
integer :: n,icnt,ityp, nt, umask, i, header
548503
real :: xval,yval, pf
549-
real, allocatable :: ln1(:), lt1(:)
550-
real, pointer :: AVR(:,:)
551-
integer :: filetype
504+
real, allocatable :: ln1(:), lt1(:)
505+
real, pointer :: AVR(:,:)
506+
integer :: filetype, k
507+
integer, allocatable :: indices(:), indices_tmp(:)
552508
logical :: isNC4
553509

554510
if(present(mask)) then
@@ -562,11 +518,22 @@ subroutine ReadTileFile_RealLatLon (InCNTileFile, ntiles, xlon, xlat,mask)
562518

563519
if (isNC4) then
564520
call MAPL_ReadTilingNC4(InCNTileFile, AVR=AVR)
565-
Ntiles = count(int(AVR(:,1)) == umask)
566-
if(.not.associated (xlon)) allocate(xlon(Ntiles))
567-
if(.not.associated (xlat)) allocate(xlat(Ntiles))
568-
xlon = AVR(:Ntiles, 3)
569-
xlat = AVR(:Ntiles, 4)
521+
allocate(indices_tmp(size(AVR,1)))
522+
k = 0
523+
do i = 1, size(AVR,1)
524+
if( int(AVR(i,1)) == umask) then
525+
k = k+1
526+
indices_tmp(k) = i
527+
endif
528+
enddo
529+
indices = indices_tmp(1:k)
530+
Ntiles = k
531+
if ( present(xlon) .and. present(xlat)) then
532+
if(.not.associated (xlon)) allocate(xlon(Ntiles))
533+
if(.not.associated (xlat)) allocate(xlat(Ntiles))
534+
xlon = AVR(indices, 3)
535+
xlat = AVR(indices, 4)
536+
endif
570537
deallocate(AVR)
571538
else
572539

@@ -608,10 +575,12 @@ subroutine ReadTileFile_RealLatLon (InCNTileFile, ntiles, xlon, xlat,mask)
608575
close(11)
609576

610577
Ntiles = icnt
611-
if(.not.associated (xlon)) allocate(xlon(Ntiles))
612-
if(.not.associated (xlat)) allocate(xlat(Ntiles))
613-
xlon = ln1(:Ntiles)
614-
xlat = lt1(:Ntiles)
578+
if ( present(xlon) .and. present(xlat)) then
579+
if(.not.associated (xlon)) allocate(xlon(Ntiles))
580+
if(.not.associated (xlat)) allocate(xlat(Ntiles))
581+
xlon = ln1(:Ntiles)
582+
xlat = lt1(:Ntiles)
583+
endif
615584
endif !isNC4
616585

617586
end subroutine ReadTileFile_RealLatLon

‎GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CICERestart.F90‎

Lines changed: 9 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -15,8 +15,8 @@ program mk_CiceRestart
1515
character*128 :: InRestart
1616
character*128 :: arg
1717

18-
integer :: i, iargc, n,j,ntiles,k
19-
integer, pointer :: Lono(:), Lato(:), Id(:), Pf(:)
18+
integer :: i, iargc, n,j, otiles,k, itiles
19+
integer, pointer :: Lono(:), Lato(:), Id(:)
2020
integer, pointer :: Loni(:), Lati(:)
2121
real*4, allocatable :: var4(:)
2222
real*8, allocatable :: var8(:)
@@ -40,16 +40,8 @@ program mk_CiceRestart
4040
! Read Output Tile File .til file
4141
! to get the index into the pfafsttater table
4242

43-
call ReadTileFile_IntLatLon(OutTileFile,Pf,Id,lono,lato,zoom,0)
44-
deallocate(Pf,Id)
45-
46-
call ReadTileFile_IntLatLon(InTileFile ,Pf,Id,loni,lati,zoom,0)
47-
deallocate(Pf,Id)
48-
49-
nullify(Pf)
50-
nullify(Id)
51-
52-
ntiles = size(lono)
43+
call ReadTileFile_IntLatLon(OutTileFile, otiles, zoom, lon_int=lono, lat_int=lato, mask = 0)
44+
call ReadTileFile_IntLatLon(InTileFile, itiles, zoom, lon_int=loni, lat_int=lati, mask = 0)
5345

5446
i = index(InRestart,'/',back=.true.)
5547

@@ -59,7 +51,7 @@ program mk_CiceRestart
5951
open(unit=50,FILE=InRestart,form='unformatted',&
6052
status='old',convert='little_endian')
6153

62-
allocate(var4(size(loni)),var8(size(loni)))
54+
allocate(var4(itiles),var8(itiles))
6355

6456
do n=1,124
6557
read (50)
@@ -69,23 +61,23 @@ program mk_CiceRestart
6961

7062
rewind 50
7163

72-
allocate(Id (ntiles))
64+
allocate(Id (otiles))
7365

7466
call GetIds(loni,lati,lono,lato,zoom,Id)
7567

7668
do n=1,18
7769
read (50) var4(:)
78-
write(40)(var4(id(i)),i=1,ntiles)
70+
write(40)(var4(id(i)),i=1,otiles)
7971
end do
8072

8173
do n=19,74
8274
read (50) var8(:)
83-
write(40)(var8(id(i)),i=1,ntiles)
75+
write(40)(var8(id(i)),i=1,otiles)
8476
end do
8577

8678
do n=75,125
8779
read (50) var4(:)
88-
write(40)(var4(id(i)),i=1,ntiles)
80+
write(40)(var4(id(i)),i=1,otiles)
8981
end do
9082

9183
deallocate(var4,var8)

‎GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -326,8 +326,8 @@ program mk_CatchCNRestarts
326326
MPI_PROC0 : if (root_proc) then
327327

328328
! Read Output/Input .til files
329-
call ReadTileFile_RealLatLon(OutTileFile, ntiles, lono, lato)
330-
call ReadTileFile_RealLatLon(InTileFile,ntiles_in,loni,lati)
329+
call ReadTileFile_RealLatLon(OutTileFile, ntiles, xlon=lono, xlat=lato)
330+
call ReadTileFile_RealLatLon(InTileFile,ntiles_in,xlon=loni, xlat=lati)
331331
allocate(Id (ntiles))
332332

333333
! ------------------------------------------------
@@ -1154,7 +1154,7 @@ SUBROUTINE regrid_carbon_vars ( &
11541154
allocate (latg (ntiles))
11551155
allocate (DAYX (NTILES))
11561156

1157-
call ReadTileFile_RealLatLon (OutTileFile, i, long, latg)
1157+
call ReadTileFile_RealLatLon (OutTileFile, i, xlon=long, xlat=latg)
11581158

11591159
!-----------------------
11601160
! COMPUTE DAYX
@@ -1201,7 +1201,7 @@ SUBROUTINE regrid_carbon_vars ( &
12011201
! Read exact lonc, latc from offline .til File
12021202
! ---------------------------------------------
12031203

1204-
call ReadTileFile_RealLatLon(InCNTilFile,i,lonc,latc)
1204+
call ReadTileFile_RealLatLon(InCNTilFile,i,xlon=lonc,xlat=latc)
12051205

12061206
endif
12071207

@@ -1921,13 +1921,13 @@ SUBROUTINE regrid_hyd_vars (NTILES, OutFMT)
19211921
allocate (latg (ntiles))
19221922
allocate (ld_reorder(ntiles_cn))
19231923

1924-
call ReadTileFile_RealLatLon (OutTileFile, i, long, latg)
1924+
call ReadTileFile_RealLatLon (OutTileFile, i, xlon=long, xlat=latg)
19251925

19261926
! ---------------------------------------------
19271927
! Read exact lonc, latc from offline .til File
19281928
! ---------------------------------------------
19291929

1930-
call ReadTileFile_RealLatLon(trim(InCNTilFile), i,lonc,latc)
1930+
call ReadTileFile_RealLatLon(trim(InCNTilFile), i,xlon=lonc,xlat=latc)
19311931

19321932
STATUS = NF_OPEN (trim(InCNRestart),NF_NOWRITE,NCFID)
19331933
STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TILE_ID' ), (/1/), (/NTILES_CN/),tmp_var)

‎GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -75,8 +75,8 @@ program mk_CatchRestarts
7575
if (root_proc) then
7676

7777
! Read Output/Input .til files
78-
call ReadTileFile_RealLatLon(OutTileFile, ntiles, lono, lato)
79-
call ReadTileFile_RealLatLon(InTileFile,ntiles_in,loni,lati)
78+
call ReadTileFile_RealLatLon(OutTileFile, ntiles, xlon=lono, xlat=lato)
79+
call ReadTileFile_RealLatLon(InTileFile,ntiles_in,xlon=loni, xlat=lati)
8080
allocate(Id (ntiles))
8181
! allocate(mask (ntiles_in))
8282
! allocate(tid_in (ntiles_in))

0 commit comments

Comments
 (0)