!
!##################################################################
!##################################################################
!###### ######
!###### PROGRAM JOINWRF ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
PROGRAM joinwrf,4
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! This program joins WRF history files in patches into one large piece.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Yunheng Wang (04/25/2007)
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER, PARAMETER :: nmaxvars = 300
INTEGER, PARAMETER :: nmaxwrffil = 100
INTEGER, PARAMETER :: nmaxprocs = 1000
!-----------------------------------------------------------------------
!
! NAMLIST variables
!
!-----------------------------------------------------------------------
CHARACTER(LEN=256) :: dir_extd ! directory of external data
INTEGER :: io_form
CHARACTER(LEN=19) :: start_time_str,end_time_str
CHARACTER(LEN=11) :: history_interval
INTEGER :: grid_id
NAMELIST /wrfdfile/ dir_extd,io_form,grid_id, &
start_time_str,history_interval,end_time_str
INTEGER :: proc_sw
INTEGER :: nproc_x, nproc_y
INTEGER :: nproc_xin
NAMELIST /patches/ proc_sw, nproc_x, nproc_y,nproc_xin
CHARACTER(LEN=256) :: outdirname
CHARACTER(LEN=5) :: outfiletail
INTEGER :: nvarout
CHARACTER(LEN=20) :: varlist(NMAXVARS)
LOGICAL :: attadj
LOGICAL :: jointime
NAMELIST /output/ outdirname,outfiletail,jointime,nvarout,varlist,attadj
INTEGER :: debug
NAMELIST /debugging/ debug
!-----------------------------------------------------------------------
!
! Misc. local variables
!
!-----------------------------------------------------------------------
INTEGER :: strlen,istatus
INTEGER :: i,j,n
INTEGER :: nprocs(nmaxprocs)
CHARACTER(LEN=256) :: filenames(NMAXWRFFIL)
INTEGER :: nfiles
INTEGER :: abstimes, abstimei, abstimee
INTEGER :: ids,ide,jds,jde,idss,idse,jdss,jdse
CHARACTER(LEN=1) :: ach
INTEGER :: year,month,day,hour,minute,second
INTEGER :: ips, ipe, jps, jpe, ipss, ipse, jpss, jpse
INTEGER :: nx
INTEGER :: nguess
CHARACTER(LEN=256) :: tmpstr
!-----------------------------------------------------------------------
!
! External functions
!
!-----------------------------------------------------------------------
CHARACTER(LEN=20) :: upcase
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Begining of executable code below
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
WRITE(6,'(10(/5x,a),/)') &
'###################################################################',&
'###################################################################',&
'#### ####',&
'#### Welcome to JOINWRF ####',&
'#### ####',&
'#### A program that reads in patches of WRF history files ####',&
'#### and join them into one large piece. ####',&
'#### ####',&
'###################################################################',&
'###################################################################'
!
!-----------------------------------------------------------------------
!
! Read in namelist &wrfdfile
!
!-----------------------------------------------------------------------
!
dir_extd = './'
start_time_str = '0000-00-00_00:00:00'
history_interval = '00_00:00:00'
end_time_str = '0000-00-00_00:00:00'
io_form = 7
grid_id = 1
READ(5,wrfdfile,ERR=999)
WRITE(6,'(2x,a)') 'Namelist wrfdfile read in successfully.'
strlen = LEN_TRIM(dir_extd)
IF(strlen > 0) THEN
IF(dir_extd(strlen:strlen) /= '/') THEN
dir_extd(strlen+1:strlen+1) = '/'
strlen = strlen + 1
END IF
ELSE
dir_extd = './'
END IF
IF (io_form /= 7 ) THEN
WRITE(6,'(1x,a)') 'ERROR: Only netCDF format is supported at present.'
STOP
END IF
WRITE(6,'(5x,3a)') 'dir_extd = ''', TRIM(dir_extd),''','
WRITE(6,'(5x,a,i3,a)') 'io_form = ', io_form,','
WRITE(6,'(5x,a,i3,a)') 'grid_id = ', grid_id,','
WRITE(6,'(5x,3a)') 'start_time_str = ''', start_time_str,''','
WRITE(6,'(5x,a,8x,2a)')'history_interval = ''', history_interval,''','
WRITE(6,'(5x,3a)') 'end_time_str = ''', end_time_str,''','
!
!-----------------------------------------------------------------------
!
! Read in namelist &patches
!
!-----------------------------------------------------------------------
!
proc_sw = 0
nproc_x = 1
nproc_y = 1
nproc_xin = 0
READ(5,patches,ERR=999)
WRITE(6,'(/,2x,a)') 'Namelist arpsgrid read in successfully.'
WRITE(6,'(4(5x,a,i3,a,/))') 'proc_sw = ', proc_sw,',', &
'nproc_x = ', nproc_x,',', &
'nproc_y = ', nproc_y,',', &
'nproc_xin = ', nproc_xin,','
!
!-----------------------------------------------------------------------
!
! Read in namelist &output and &debugging
!
!-----------------------------------------------------------------------
!
outdirname = './'
outfiletail= ''
nvarout = 0
varlist(:) = ' '
attadj = .FALSE.
READ(5,output,ERR=999)
WRITE(6,'(/,2x,a)') 'Namelist output was successfully read.'
strlen = LEN_TRIM(outdirname)
IF(strlen > 0) THEN
IF(outdirname(strlen:strlen) /= '/') THEN
outdirname(strlen+1:strlen+1) = '/'
strlen = strlen + 1
END IF
ELSE
outdirname = './'
END IF
WRITE(6,'(5x,3a)' ) 'outdirname = ''', TRIM(outdirname),''','
WRITE(6,'(5x,3a)' ) 'outfiltail = ''', TRIM(outfiletail),''','
WRITE(6,'(5x,a,I3,a)') 'nvarout = ', nvarout,','
DO n = 1,nvarout-1
varlist(n) = upcase(varlist(n))
WRITE(6,'(7x,a,I3,3a)') 'varlist(',n,') = ''', TRIM(varlist(n)),''','
END DO
IF (nvarout > 0) THEN
nvarout = nvarout+1
varlist(nvarout) = 'Times'
WRITE(6,'(7x,a,I3,3a)') 'varlist(',nvarout,') = ''', TRIM(varlist(nvarout)),''','
END IF
WRITE(6,'(5x,a,L,a)') 'attadj = ', attadj,','
WRITE(6,'(5x,a,L,a)') 'jointime = ', jointime,','
debug = 0
READ(5,debugging,ERR=999)
WRITE(6,'(/,2x,a)' ) 'Namelist debugging was successfully read.'
WRITE(6,'(5x,a,i3,a,/)') 'debug = ', debug,','
istatus = 0
!-----------------------------------------------------------------------
!
! Prepare for reading WRF files
!
!-----------------------------------------------------------------------
READ(end_time_str, '(I4.4,5(a,I2.2))') &
year,ach,month,ach,day,ach,hour,ach,minute,ach,second
CALL ctim2abss
(year,month,day,hour,minute,second,abstimee)
READ(history_interval,'(I2.2,3(a,I2.2))') &
day,ach,hour,ach,minute,ach,second
abstimei = day*24*3600+hour*3600+minute*60+second
READ(start_time_str, '(I4.4,5(a,I2.2))') &
year,ach,month,ach,day,ach,hour,ach,minute,ach,second
CALL ctim2abss(year,month,day,hour,minute,second,abstimes)
IF ( nproc_xin < 1 ) THEN
IF (jointime .AND. nproc_x*nproc_y == 1) THEN
nproc_xin = 1
ELSE
WRITE(tmpstr,'(a,a,I2.2,a,I4.4,5(a,I2.2),a,I4.4)') &
TRIM(dir_extd),'wrfout_d',grid_id,'_', &
year,'-',month,'-',day,'_',hour,':',minute,':',second,'_',proc_sw
CALL get_wrf_patch_indices(TRIM(tmpstr),io_form, &
ips,ipe,ipss,ipse,jps,jpe,jpss,jpse,nx,istatus)
nguess = nx/(ipse-ipss+1)
WRITE(6,'(1x,a,/)') '*****************************'
WRITE(6,'(1x,a,/,10x,a,I4,a,/,10x,a,/)') &
'WARNING: Number of processors for WRF data in X direction was not specified ',&
'The program has guessed that it should be nproc_xin = ',nguess,'.',&
'Please check to make sure it is the right number!!!'
nproc_xin = nguess
END IF
END IF
IF ( nproc_xin < proc_sw+nproc_x ) THEN
WRITE(6,'(1x,a,/)') '*****************************'
WRITE(6,'(1x,a,I4,a,/,8x,a,I4,a,/,3(8x,a,/))') &
'ERROR: Either parameter nproc_x = ',nproc_x,' is too large ', &
'or parameter nproc_xin = ', nproc_xin,' is too small,', &
'because nproc_xin < proc_sw+nproc_x, number of patches in X direction.', &
'If you do not know the exact value of nproc_xin, you can specify 0', &
'to let the program guess for it automatically.'
STOP
END IF
n = 0
DO j = 0,nproc_y-1
DO i = 0,nproc_x-1
n = n+1
nprocs(n) = proc_sw + j*nproc_xin + i ! for merging purpose
END DO
END DO
!-----------------------------------------------------------------------
!
! Check file and get dimensions
!
!-----------------------------------------------------------------------
filenames(:) = ' '
CALL check_files_dimensions(NMAXWRFFIL,grid_id,io_form,jointime, &
nprocs,nproc_x,nproc_y,abstimes,abstimei,abstimee,dir_extd, &
filenames,nfiles,ids,ide,idss,idse,jds,jde,jdss,jdse,istatus)
IF (istatus /= 0) GO TO 100
WRITE(6,'(/,1x,a)') '*****************************'
WRITE(6,'(1x,2(2(a,I4),a,/33x,2(a,I4),a,/,24x))') &
'The joined subdomain is: stag - ids = ',ids, ', ide = ',ide,';', &
'jds = ',jds, ', jde = ',jde,'.', &
'unstag - idss= ',idss,', idse= ',idse,';',&
'jdss= ',jdss,', jdse= ',jdse,'.'
!-----------------------------------------------------------------------
!
! Join files
!
!-----------------------------------------------------------------------
IF (nvarout == 0) nvarout = nmaxvars
IF (io_form == 7) THEN
CALL joinwrfncdf(filenames,nfiles,attadj,jointime,nprocs,n, &
ids,ide,idss,idse,jds,jde,jdss,jdse, &
outdirname,outfiletail,nvarout,varlist,debug,istatus)
END IF
GO TO 100
!-----------------------------------------------------------------------
!
! Just before termination
!
!-----------------------------------------------------------------------
999 WRITE(6,'(1x, a,a)') 'Error reading NAMELIST file. Job stopped.'
STOP
100 CONTINUE
IF (istatus == 0) THEN
WRITE(6,'(/,4x,a,/)') '==== Program JOINWRF terminated normally ===='
ELSE
WRITE(6,'(/,4x,a,I3,a/)') '**** Program JOINWRF terminated with error = ',istatus,' ****'
END IF
STOP
END PROGRAM joinwrf
!
! Convert a character string to upper case
!
FUNCTION upcase(string) RESULT(upper)
IMPLICIT NONE
INTEGER, PARAMETER :: lenstr = 20
CHARACTER(LEN=lenstr), INTENT(IN) :: string
CHARACTER(LEN=lenstr) :: upper
INTEGER :: j
DO j = 1,lenstr
IF(string(j:j) >= "a" .AND. string(j:j) <= "z") THEN
upper(j:j) = ACHAR(IACHAR(string(j:j)) - 32)
ELSE
upper(j:j) = string(j:j)
END IF
END DO
END FUNCTION upcase