PROGRAM modify

c This program reads a DDAM run 1 bulk data file in, and, with
c the help of a small text file converts it into the run 2 bulk
c data deck.  

c The small text file has the following info in it:
c - filename of results files
c - .f13 file
c - run 1 MASTER file
c - output requests

c This file will be called bwm_ddam_modify.xxx

c The file format will be:

c	BULK    original bulk data file name
c       BULKR   new, restart fiel name
c	RESX    x results filename
c	RESY    y results file name
c	RESZ    z results file name
c	MASTER  restart MASTER filename
c	F13     f13 file name
c	DISP    yes/no
c	VELO    yes/no
c	ACCE    yes/no
c	STRESS  yes/no
c	FORCE   yes/no
c       SPC     yes/now

c All cards will be present, and the format will be A8,Ax
c This way, the file and this program can be moved to C++
c without too much difficulty.

c All of the lines are constructed and stored in the inserts variable
c in the following order:
c 1) post processing comment
c 2) resx file
c 3) resy file
c 4) resz file
c 5) f13 comment
c 6) f13 file
c 7) restart comment
c 8) RESTART card
c 9) MASTER assign file
c 10) Subtitle card
c 11) DISPLACEMENT output
c 12) VELOCITY output
c 13) ACCELERATION output
c 14) FORCE output
c 15) STRESS output
c 16) SPCFORCE output
c 17) SCRSPEC parameter

      PARAMETER (maxlines=100)

      CHARACTER*8 resx, resy, resz
      CHARACTER*8 master, f13
      CHARACTER*8 disp, velo, acce
      CHARACTER*8 stress, force, spc
      CHARACTER*8 bulk, bulkr

      CHARACTER*40 resx_file, resy_file, resz_file
      CHARACTER*40 master_file, f13_file
      CHARACTER*40 bulk_file, bulkr_file
      LOGICAL  disp_stat, velo_stat, acce_stat
      LOGICAL  stress_stat, force_stat, spc_stat

      CHARACTER*1  comment
      CHARACTER*3  yes, no, status
      CHARACTER*80 line
      CHARACTER*80 inserts(20)
      CHARACTER*40 control_file
      CHARACTER*10 cform3, cform2
      CHARACTER*13 cform1

      LOGICAL batch, true, false, binary
      CHARACTER*1 flag, message1, message2

c ... assign data to all of the strings

      true = .true.
      false = .false.

      yes = 'YES'
      no  = 'NO'

      resx   = 'RESX    '
      resy   = 'RESY    '
      resz   = 'RESZ    '
      master = 'MASTER  '
      f13    = 'F13     '
      bulk   = 'BULK    '
      bulkr  = 'BULKR   '
      disp   = 'DISP    '
      velo   = 'VELO    '
      acce   = 'ACCE    '
      stress = 'STRESS  '
      force  = 'FORCE   '
      spc    = 'SCP     '

c open the text file for input

      batch = true
      binary = false
      flag = 'o'
      message1 = ' '
      message2 = ' '
      iounit = 13
      control_file = 'bwm_ddam_modify.xxx'

        call openfile(iounit,control_file,message1,message2,
     +    flag,binary,batch)

c ... search through the file looking for each keyword and reading 
c the appropriate data

      DO i = 1,maxlines

        read(iounit,'(a)',end=999) line

        IF (line(1:1) .eq. comment) THEN
          GOTO 999
        ELSEIF (line(1:8) .eq. resx) THEN
          READ(line(9:48),'(a)') resx_file
        ELSEIF (line(1:8) .eq. resy) THEN
          READ(line(9:48),'(a)') resy_file
        ELSEIF (line(1:8) .eq. resz) THEN
          READ(line(9:48),'(a)') resz_file
        ELSEIF (line(1:8) .eq. master) THEN
          READ(line(9:48),'(a)') master_file
        ELSEIF (line(1:8) .eq. f13) THEN
          READ(line(9:48),'(a)') f13_file
        ELSEIF (line(1:8) .eq. bulk) THEN
          READ(line(9:48),'(a)') bulk_file
        ELSEIF (line(1:8) .eq. bulkr) THEN
          READ(line(9:48),'(a)') bulkr_file
        ELSEIF (line(1:8) .eq. disp) THEN
          READ(line(9:11),'(a)') status
            IF (index(status,yes) .ne. 0) disp_stat = true
            IF (index(status,no) .ne. 0) disp_stat = false
        ELSEIF (line(1:8) .eq. velo) THEN
          READ(line(9:11),'(a)') status
            IF (index(status,yes) .ne. 0) velo_stat = true
            IF (index(status,no) .ne. 0) velo_stat = false
        ELSEIF (line(1:8) .eq. acce) THEN
          READ(line(9:11),'(a)') status
            IF (index(status,yes) .ne. 0) acce_stat = true
            IF (index(status,no) .ne. 0) acce_stat = false
        ELSEIF (line(1:8) .eq. stress) THEN
          READ(line(9:11),'(a)') status
            IF (index(status,yes) .ne. 0) stress_stat = true
            IF (index(status,no) .ne. 0) stress_stat = false
        ELSEIF (line(1:8) .eq. force) THEN
          READ(line(9:11),'(a)') status
            IF (index(status,yes) .ne. 0) force_stat = true
            IF (index(status,no) .ne. 0) force_stat = false
        ELSEIF (line(1:8) .eq. spc) THEN
          READ(line(9:11),'(a)') status
            IF (index(status,yes) .ne. 0) spc_stat = true
            IF (index(status,no) .ne. 0) spc_stat = false
        ENDIF

      ENDDO

999   CONTINUE

c ... construct the strings to write to the file

c the OUTPUT2 for the resx, resy, and resz files
c$ ... assign results files for post-processing
cASSIGN OUTPUT2='d2.resx',UNIT=21, STATUS=UNKNOWN
cASSIGN OUTPUT2='d2.resy',UNIT=22, STATUS=UNKNOWN
cASSIGN OUTPUT2='d2.resz',UNIT=23, STATUS=UNKNOWN

      inserts(1) = '$ ... assign results files for post-processing'

      len_line = length(resx_file)
        WRITE(6,*) 'len_line = ',len_line
      num_dig = int(alog10(real(len_line))) + 1
        WRITE(6,*) 'num_dig = ',num_dig

      cform3 = '(a5,I1,A4)'

      write(cform2,cform3) '(A6,I',num_dig,',A5)'
        WRITE(6,*) cform2
      write(cform1,cform2) '(A16,A',len_line,',A26)'
        WRITE(6,*) cform1
      write(inserts(2),cform1) "ASSIGN OUTPUT2='",resx_file,
     +   "', UNIT=21, STATUS=UNKNOWN"
        WRITE(6,*) inserts(2)

      len_line = length(resy_file)
        WRITE(6,*) 'len_line = ',len_line
      num_dig = int(alog10(real(len_line))) + 1
        WRITE(6,*) 'num_dig = ',num_dig

      cform3 = '(a5,I1,A4)'

      write(cform2,cform3) '(A6,I',num_dig,',A5)'
        WRITE(6,*) cform2
      write(cform1,cform2) '(A16,A',len_line,',A26)'
        WRITE(6,*) cform1
      write(inserts(3),cform1) "ASSIGN OUTPUT2='",resy_file,
     +   "', UNIT=22, STATUS=UNKNOWN"
        WRITE(6,*) inserts(3)

      len_line = length(resz_file)
        WRITE(6,*) 'len_line = ',len_line
      num_dig = int(alog10(real(len_line))) + 1
        WRITE(6,*) 'num_dig = ',num_dig

      cform3 = '(a5,I1,A4)'

      write(cform2,cform3) '(A6,I',num_dig,',A5)'
        WRITE(6,*) cform2
      write(cform1,cform2) '(A16,A',len_line,',A26)'
        WRITE(6,*) cform1
      write(inserts(4),cform1) "ASSIGN OUTPUT2='",resz_file,
     +   "', UNIT=23, STATUS=UNKNOWN"
        WRITE(6,*) inserts(4)

c  the INPUTT4 for the .f13 file w/ comment
c$ ... assign the UHV matrix file for input
cASSIGN INPUTT4='d1.f13', UNIT=13, STATUS=UNKNOWN

      inserts(5) = '$ ... assign the UHV matrix file for input'

      len_line = length(f13_file)
	WRITE(6,*) 'len_line = ',len_line
      num_dig = int(alog10(real(len_line))) + 1
	WRITE(6,*) 'num_dig = ',num_dig

      cform3 = '(a5,I1,A4)'

      write(cform2,cform3) '(A6,I',num_dig,',A5)'
	WRITE(6,*) cform2
      write(cform1,cform2) '(A16,A',len_line,',A26)'
	WRITE(6,*) cform1
      write(inserts(6),cform1) "ASSIGN INPUTT4='",f13_file,
     +   "', UNIT=13, STATUS=UNKNOWN"
	WRITE(6,*) inserts(6)

c  the restart cards and comments
c$ ... restart the analysis from the first run
cRESTART, VERSION=1, KEEP $
cASSIGN MASTER='d1.MASTER'

      inserts(7) = '$ ... restart the analysis from the first run'
      inserts(8) = 'RESTART, VERSION=1, KEEP $'

      len_line = length(master_file)
	WRITE(6,*) 'len_line = ',len_line
      num_dig = int(alog10(real(len_line))) + 1
	WRITE(6,*) 'num_dig = ',num_dig

      cform3 = '(a5,I1,A4)'

      write(cform2,cform3) '(A6,I',num_dig,',A4)'
	WRITE(6,*) cform2
      write(cform1,cform2) '(A15,A',len_line,',A1)'
	WRITE(6,*) cform1
      write(inserts(9),cform1) "ASSIGN MASTER='",master_file,"'"
	WRITE(6,*) inserts(9)

c the subtitle card (not used yet)

      inserts(10) = 'SUBTI=RUN 2 - LOAD RECOVERY'

c the output requests

      inserts(11) = '   DISPLACEMENT(PLOT)=ALL'
      inserts(12) = '   VELOCITY(PLOT)=ALL'
      inserts(13) = '   ACCELERATION(PLOT)=ALL'
      inserts(14) = '   FORCE(PLOT)=ALL'
      inserts(15) = '   STRESS(PLOT)=ALL'
      inserts(16) = '   SPCFORCE(PLOT)=ALL'

c the SCRSPEC card

      inserts(17) = 'PARAM,SCRSPEC,1'

c ... open the bulk file and the restart bulk file

      iobulk = 11
      flag = 'o'

        call openfile(iobulk,bulk_file,message1,message2,
     +    flag,binary,batch)

      iobulkr = 12
      flag = 'n'

        call openfile(iobulkr,bulkr_file,message1,message2,
     +    flag,binary,batch)

c ... loop through all of the cards in the original bulk data file
c     looking for the tags to replace

      DO 101 iline = 1,maxlines

        READ(iobulk,'(a)',end=998) line 

        IF (index(line,'OUTPUT2') .ne. 0) THEN
          CONTINUE
        ELSEIF (index(line,'OUTPUT4') .ne. 0) THEN
          write(iobulkr,'(a)') inserts(1)
          write(iobulkr,'(a)') inserts(2)
          write(iobulkr,'(a)') inserts(3)
          write(iobulkr,'(a)') inserts(4)
          write(iobulkr,'(a)') inserts(5)
          write(iobulkr,'(a)') inserts(6)
          write(iobulkr,'(a)') inserts(7)
          write(iobulkr,'(a)') inserts(8)
          write(iobulkr,'(a)') inserts(9)
	ELSEIF (index(line,'VECTOR') .ne. 0) THEN
          IF (disp_stat) WRITE(iobulkr,'(a)') inserts(11)
          IF (velo_stat) WRITE(iobulkr,'(a)') inserts(12)
          IF (acce_stat) WRITE(iobulkr,'(a)') inserts(13)
          IF (force_stat) WRITE(iobulkr,'(a)') inserts(14)
          IF (stress_stat) WRITE(iobulkr,'(a)') inserts(15)
          IF (spc_stat) WRITE(iobulkr,'(a)') inserts(16)
	ELSEIF (index(line,'SPCFOR') .ne. 0) THEN
	  CONTINUE
        ELSEIF (line(1:5) .eq. 'BEGIN') THEN
          write(iobulkr,'(a)') line
          write(iobulkr,'(a)') inserts(17)
          write(iobulkr,'(a)') 'ENDDATA'
          GOTO 998
        ELSE
          write(iobulkr,'(a)') line
        ENDIF

101   CONTINUE

c ... wrap up the program

998   CONTINUE

      CLOSE(iounit)
      CLOSE(iobulk)
      CLOSE(iobulkr)

      STOP

      END

c ***** ------------------------------------------------------------- *****
	subroutine openfile(iounit,filedef,message1,message2,
     +    flag,binary,batch)

c        call openfile(iosum,filesum,message1,message2,
c    +    flag,binary,batch)
c ----- subroutine to open a file given various values passed to it:
c	iounit = unit number to open
c	filedef = filename to use as the default filename
c	message1 = text to display asking what file to open
c	message2 = text to display if the file cannot be opened
c	flag = status flag (o = old, n = new, u = unknown)
c	binary = logical for format (T = unformatted, F = formatted)
c	batch - logical for batch execution: if T then
c		no message 1 displayed
c		existing files overwritten

	character*(*) message1,message2
	character*(*) filedef
	character*40 fileopen
	character*1 flag,answer
	integer iounit
	logical binary,batch

	if (flag .eq. 'o') then

	  if (batch) then
	    fileopen = filedef
	  else
 	    write(6,'(a)') message1
	    write(6,'(a,a)') '  Default: <CR> = ',filedef
	    read(5,'(a)') fileopen
	    if (fileopen .eq. ' ') fileopen = filedef
	  endif

1	  if (binary) then
	    open(iounit,file=fileopen,status='old',iostat=ierr,
     +        form='unformatted')
	  else
	    open(iounit,file=fileopen,status='old',iostat=ierr)
	  endif

  	  if (ierr .ne. 0) then
	    write(6,'(a)') message2
	    lname = length(fileopen)
	    write(6,'(a,a,a)') ' File ',fileopen(1:lname),
     +        ' could not be opened.'
	    if (batch) then
	      write(6,*) ' FATAL ERROR - PROGRAM STOPPING'
	      stop
	    else
	      write(6,*) ' Lets try again ...'
	      write(6,*) message1
	      read(5,'(a)') fileopen
	      goto 1
	    endif
	  endif

	elseif (flag .eq. 'n') then

  	  if (batch) then
	     fileopen = filedef
	  else
 	     write(6,'(a)') message1
	     write(6,'(a,a)') '  Default: <CR> = ',filedef
	     read(5,'(a)') fileopen
	     if (fileopen .eq. ' ') fileopen = filedef
	  endif

2	  if (binary) then
	    open(iounit,file=fileopen,status='new',iostat=ierr,
     +        form ='unformatted')
	  else
	    open(iounit,file=fileopen,status='new',iostat=ierr)
	  endif

	  if (ierr .ne. 0) then
	    if (batch) then
	      open(iounit,file=fileopen,status='old')
	      close(iounit,status='delete')
	      if (binary) then
	        open(iounit,file=fileopen,status='new',
     +            form='unformatted')
	      else
	        open(iounit,file=fileopen,status='new')
	      endif
	    else
	      write(6,*) 'That file already exists.  Ok to overwrite ?'
	      read(5,'(a1)') answer
	      if (answer .eq. 'y') then
	        open(iounit,file=fileopen,status='old')
	        close(iounit,status='delete')
                if (binary) then
	          open(iounit,file=fileopen,status='new',
     +              form='unformatted')
	        else
	          open(iounit,file=fileopen,status='new')
	        endif
	      else
	        write (6,*) ' Ok then, lets try this again ...'
	        write (6,*) message1
	        read(5,'(a)') fileopen
	        goto 2
	      endif
	    endif
	  endif

	elseif(flag .eq. 'u') then

	  if (.not. batch) then
 	    write(6,'(a)') message1
	    write(6,'(a,a)') '  Default: <CR> = ',filedef
	    read(5,'(a)') fileopen
	    if (fileopen .eq. ' ') fileopen = filedef
	  endif
	    
3	  if (binary) then
	    open(iounit,file=fileopen,status='unknown',iostat=ierr,
     +        form ='unformatted')
	  else
	    open(iounit,file=fileopen,status='unknown',iostat=ierr)
	  endif
	
	  if (ierr .ne. 0) then
	    write(6,*) ' There is something seriously wrong with your'
	    write(6,*) ' system.  Do you have permission to open files'
	    write(6,*) ' in this directory ?'
	    if (batch) then
	      write(6,*) ' FATAL ERROR - PROGRAM STOPPING '
	      stop
	    else
	      write(6,*) ' Try a different filename:'
 	      write(6,'(a)') message1
	      read(5,'(a)') fileopen
	      goto 3
	    endif
	  endif

	endif

	filedef = fileopen
	nchar = length(filedef)
	write(6,11) filedef(1:nchar)
	write(6,12) iounit
11	format( ' ... File name ',a,' opened for i/o ...')
12	format( '            (unit number ',i2,' )')
	return
	end

c ***** ------------------------------------------------------------- *****
	integer function length(string)

c ... function to find the actual non-blank length of a string by 
c	starting at the last character and searching backwards until
c	a non-blank character is found

	character*(*) string

c ... find dimensioned length of string
	ilength = len(string)

	do i = ilength,1,-1
	  if (string(i:i) .ne. ' ') then
	    length = i
	    return
	  endif
	enddo
	length = 0
	return
	end