! !################################################################## !################################################################## !###### ###### !###### 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