PROGRAM rdrdapstrn,6
!
!-----------------------------------------------------------------------
!
! Reads KMA RDAPS terrain file and converts it to an arps terrain
! file at the same resolution and map projection of the
! original KMA RDAPS grid.
!
! Compile:
!
! f77 -o rdrdapstrn rdrdapstrn.f maproj3d.f genlib3d.f outlib3d.f
!
! The output can then be used in PROGRAM MRGTRN
!
! Keith Brewster, July, 1996
!
! MODIFICATIONS
!
! 06/10/97 Keith Brewster
! Version for RDAPS based on RUC version.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx,ny
PARAMETER (nx=120,ny=104)
INTEGER :: mapproj
REAL :: trulat1,trulat2
REAL :: trulon, sclfct
REAL :: dx,dy
PARAMETER ( mapproj = 2, & ! Lambert Conformal Conic
trulat1 = 30., &
trulat2 = 60., &
trulon = 125., &
sclfct = 1., &
dx = 40000., &
dy = 40000.)
CHARACTER (LEN=80) :: rdapstrn
PARAMETER( rdapstrn='rgm_topo40.dat')
CHARACTER (LEN=80) :: rdapslatlon
PARAMETER( rdapslatlon= 'rgm40_crosspnt_latlon.dat')
CHARACTER (LEN=80) :: rdapsout
PARAMETER( rdapsout = 'arpsrdapstrn.dat')
!
REAL :: hterain(nx,ny)
REAL :: lat(nx,ny)
REAL :: lon(nx,ny)
!
! Misc local variables
!
CHARACTER (LEN=80) :: head
REAL :: x0,y0,x1,y1,xctr,yctr,dxin,dyin
REAL :: ctrlat,ctrlon
REAL :: latnot(2)
REAL :: gamma,knot,tol,rdnot,wdn,rdummy
INTEGER :: i,j,ierr
INTEGER :: analtype,ipass,itertype,idummy
!
!-----------------------------------------------------------------------
!
! Set terrain analysis variables to dummy numbers
!
!-----------------------------------------------------------------------
!
gamma=0.
knot=0.
tol=0.
rdnot=0.
wdn=0.
rdummy=0.
analtype=0.
ipass=0
itertype=0
idummy=0
!
!-----------------------------------------------------------------------
!
! Set map projection according to the parameters set above.
!
!-----------------------------------------------------------------------
!
latnot(1)=trulat1
latnot(2)=trulat2
CALL setmapr
(mapproj,sclfct,latnot,trulon)
!
!-----------------------------------------------------------------------
!
! Read the terrain, lat and lon from the maps terrain file,
! this was obtained from FSL.
!
!-----------------------------------------------------------------------
!
! CALL asnctl ('NEWLOCAL', 1, ierr)
! CALL asnfile(rdapslatlon, '-F f77 -N ieee', ierr)
OPEN(31,FILE=trim(rdapslatlon),STATUS='old',FORM='formatted')
READ(31,122) head
READ(31,123)((lat(i,j),i=1,nx),j=1,ny)
READ(31,122) head
READ(31,123)((lon(i,j),i=1,nx),j=1,ny)
122 FORMAT(a80)
123 FORMAT(20F8.3)
CLOSE(31)
! CALL asnctl ('NEWLOCAL', 1, ierr)
! CALL asnfile(rdapstrn, '-F f77 -N ieee', ierr)
OPEN(31,FILE=trim(rdapstrn),STATUS='old',FORM='unformatted')
READ(31)((hterain(i,j),j=1,ny),i=1,nx)
CLOSE(31)
!
!-----------------------------------------------------------------------
!
! Calculate ctrlat and ctrlon
! This definition of "center" is to be consistent with ARPS
! where the scalar grid runs from 1 to nx-1.
!
!-----------------------------------------------------------------------
!
CALL lltoxy
(1,1,lat(1,1),lon(1,1),x0,y0)
CALL lltoxy
(1,1,lat(2,2),lon(2,2),x1,y1)
xctr=x0+0.5*FLOAT(nx-3)*dx
yctr=y0+0.5*FLOAT(ny-3)*dy
CALL xytoll
(1,1,xctr,yctr,ctrlat,ctrlon)
WRITE(6,'(a,2f11.4)') ' LL RDAPS corner ',lat(1,1),lon(1,1)
WRITE(6,'(a,2f11.4)') ' UR RDAPS corner ',lat(nx,ny),lon(nx,ny)
WRITE(6,'(a,2f11.4)') ' RDAPS center ',ctrlat,ctrlon
!
dxin=x1-x0
dyin=y1-y0
WRITE(6,'(a,2f11.4)') ' dx from latlon grid',dxin
WRITE(6,'(a,2f11.4)') ' dy from latlon grid',dyin
!
!-----------------------------------------------------------------------
!
! Write the analyzed terrain data (model grid data) into file
! arpstern.dat.
!
!-----------------------------------------------------------------------
!
CALL asnctl
('NEWLOCAL', 1, ierr)
CALL asnfile
(rdapsout, '-F f77 -N ieee', ierr)
OPEN(11,FILE=trim(rdapsout),FORM='unformatted', &
STATUS='unknown')
WRITE(11) nx,ny
idummy = 0
rdummy = 0.0
WRITE(11) analtype,mapproj,itertype,ipass,idummy, &
idummy,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy
WRITE(11) dx ,dy ,ctrlat,ctrlon,knot , &
gamma ,trulat1,trulat2,trulon,sclfct, &
tol ,wdn ,rdnot ,rdummy,rdummy, &
rdummy,rdummy,rdummy,rdummy,rdummy
WRITE(11) hterain
CLOSE(11)
STOP
END PROGRAM rdrdapstrn