PROGRAM dir30sec,1
!##################################################################
!##################################################################
!###### ######
!###### PROGRAM DIR30SEC ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
!
!-----------------------------------------------------------------------
!
!
! PURPOSE:
!
! A stand alone program which rewrites 30 second terrain elevation data
! from dma_elev.dat recieved from NCAR DATA SERVICES into a direct access
! file using either 2 of 8 byte integer format depending upon the type
! of machine used. The purpose of writing a direct access data format
! is to expedite the run time of the ARPSTERN11.F terrain processing
! program for initializing the ARPS terrain field.
! In addition, a dir1km.hdr file will be created and needs to be used
!
! INPUT:
! dma_elev.dat (NCAR DATA FILE 30 SECOND RESOLUTION)
!
! arpstern.input ARPSTERN11.F input file
!
!
!
!
! OUTPUT:
! dir30sec.dat direct access 30 second unformatted
! data file with 1099 seperate records.
!
! dir30sec.hdr header file which has record numbers
! corresponding to specific blocks or
! 1 degree by 1 degree lat/lon areas.
!
! This program reads the ascii version of the 30 second resolution
! terrain data set for the continental US (NCAR FILE ds756.1).
!
!-----------------------------------------------------------------------
!
! AUTHOR: Dan Weber
! 1/12/94
!
! Modification history:
!
! Dan Weber 6/22/94.
! Added documentation.
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!
! Variable Declarations
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!
! INPUT:
!
INTEGER :: ndx ! Number of data points in the longitudinal
! direction
INTEGER :: ndy ! Number of data points in the latitudinal
! direction
PARAMETER (ndx=120,ndy=120)
CHARACTER (LEN=11 ) :: desc ! Character string for reading the header
! portion of the dma_elev.dat file
INTEGER :: id(5) ! Array used to read the header portion of
! dma_elev.dat NCAR file.
INTEGER*2 nlval(121,121) ! array used to read initial NCAR data file
INTEGER*2 nval(120,120) ! Array used to write unformatted terrain
! data block to dir30sec.dat file
!
! COMMON BLOCK VARIABLES:
!
!
! LOCAL VARIABLES:
!
INTEGER :: comtype ! Computer type for program to run on...
! for IBM, comtype = 1
! CRAY, = 4
INTEGER :: i,j,n
INTEGER :: ltdir ! Dummy variable used for namelist data
CHARACTER (LEN=80 ) :: tdatadir ! Directory in which the data file
! dma_elev.dat is stored.
CHARACTER (LEN=80 ) :: terndir ! Directory in which the original ASCII terrain
! data files are stored.
INTEGER :: lterndir ! Length of the non-blank part of string terndir.
INTEGER :: temi ! Dummy variable used for namelist data
INTEGER :: analtype ! Dummy variable used for namelist data
INTEGER :: mapproj ! Dummy variable used for namelist data
INTEGER :: itertype ! Dummy variable used for namelist data
INTEGER :: rmsopt ! Dummy variable used for namelist data
!
! OUTPUT:
!
REAL :: aval(120,120) ! Array used to write unformatted terrain
! data block to dir30sec.dat file
!-----------------------------------------------------------------------
!
! Defining namelist:
!
!-----------------------------------------------------------------------
NAMELIST /terraind/analtype,mapproj,itertype,rmsopt, &
comtype,tdatadir,terndir
!-----------------------------------------------------------------------
!
! Begin executable portion of the code.
!
!-----------------------------------------------------------------------
READ(5,terraind)
!
! open dma_elev.dat, dir30sec.dat and dir30sec.hdr files...
!
lterndir = LEN(terndir)
CALL strlnth
( terndir, lterndir )
IF( lterndir == 0 ) THEN
terndir = '.'
lterndir=1
END IF
!
! open elev.dat, dir1deg.dat and dir1deg.hdr files...
!
OPEN(10,FILE=terndir(1:lterndir)//'/dma_elev.dat',STATUS='old')
OPEN(11,FILE='dir30sec.dat',ACCESS='direct',FORM='unformatted', &
STATUS='unknown',RECL=28800*comtype)
OPEN(12,FILE='dir30sec.hdr',FORM='formatted',STATUS='unknown')
!
! Read in the initial record from the dma_elev.dat file.
! Setting the record counter n=1.
!
n=1
5 READ(10,'(5i6,1x,a11)',END=90)(id(i),i=1,5),desc
READ(10,'(30i4)')((nlval(i,j),i=1,121),j=1,121)
!
! Convert from feet to meters...
! Writing (120,120) from the (121,121) array.
! The extra data was found to be a source of bogus
! data after inspection of the data squares which were flagged
! in a seperate program.
!
DO i=1,ndx
DO j=1,ndy
nval(i,j)=nlval(i,j)*20-4000 ! unpacking the data
aval(i,j)=nval(i,j)
aval(i,j)=aval(i,j)*0.3048+0.5 ! converting from feet to meters..
nval(i,j)=INT(aval(i,j))
nval(i,j)=(nval(i,j)+4000)/20 ! putting in packed form....
END DO
END DO
!
! Setting the remaining area over Lake Huron to 580 feet
!
IF(id(1) == 134.AND.id(2) == 277)THEN ! id(1) = lat(N)+90., id(2)=lon (E)
DO i=1,121
DO j=1,121
IF(nlval(i,j) == 0)nlval(i,j)=209 ! 209 meters = 580 feet ....
END DO
END DO
ELSE
END IF
!
! write the 1 degree by 1 degree box header to dir30sec.hdr and
! the 120,120 data array to dir30sec.dat
!
WRITE(11,REC=n) nval
WRITE(12,'(i6,i6,i6)') id(1)-90,id(2),n
PRINT *,'DATA WRITTEN FOR RECORD NUMBER = ',n
n=n+1
GO TO 5
90 CLOSE (10)
CLOSE (11)
CLOSE (12)
STOP
END PROGRAM dir30sec
!
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE STRLNTH ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE strlnth( string, length ) 176
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Return the length of the non-blank part of a character string.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Ming Xue
! 11/20/91
!
! MODIFICATION HISTORY:
!
! 5/05/92 (M. Xue)
! Added full documentation.
!
!-----------------------------------------------------------------------
!
! INPUT:
!
! string A character string
! length The declared length of the character string 'string'.
!
! OUTPUT:
!
! length The length of the non-blank part of the string.
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Variable Declarations.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
CHARACTER (LEN=* ) :: string ! A character string for the name of
! this run.
INTEGER :: length ! The length of the non-blank part
! of a string.
INTEGER :: i
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
DO i = length,1,-1
IF(string(i:i) /= ' ') EXIT
END DO
! 200 CONTINUE
length = MAX(1,i)
RETURN
END SUBROUTINE strlnth