

c			bob_edit.for
c	adapted from below program to allow screen editing of the bob
c	files. you can do up to 7 channels of data as long as they are
c	all from the same station directory. please don't try to
c	edit a qplot file.
c
c	**** this program makes use of the QDOS II ascii file editor (QED.EXE).
c	if you do not have the QDOS editor, you can still use this program
c	by 1) moving the ascii editor you do have to the BOB directory
c	and 2) renaming it to QED.EXE. 
c	   line 138 of this program has the call to invoke the editor.
c----------------------------------------------------------------------
c			qplt-bob.for
c	
c	qplt-bob takes a file in qplot format and puts the data into
c	the proper spot in a bob compatible file. the bob files muat
c	already have been created and the time information must
c	contain the year (typical qplot time information is at the 
c	begginning of each line as a 5i2 - month, day, year, hour, 
c	and minute. if this is not the case, this program must be changed
c	to reflect the different time format).
c-----------------------------------------------------------------------------
c		system.inc contains the interface statement to allow a following
c		subroutine to issue dos commands through the c function SYSTEM
c-----------------------------------------------------------------------------
	INTERFACE TO INTEGER*2 FUNCTION SYSTEM [C] (STRING[REFERENCE])
	CHARACTER*1 STRING
	END
c-----------------------------------------------------------------------------
c--------------------------------------------------------------------------
c		 our cast of characters
c
c------- the time variables
	INTEGER YEAR,OLDYEAR, MONTH, DAY, HOUR, MINUTE, JUL,OLDJUL
	INTEGER MIN_INC
	CHARACTER*3 C_MON
c------- the data variables (only real * 4 accepted)
	REAL*4 DATA(8)
	REAL*4 IN_DATA(8,144),R_DATA(144)
	CHARACTER*576 C_DATA
c------- the bob file names and some varaibles
	CHARACTER*10 FILENAME(8)
	CHARACTER*13 DIR
	CHARACTER*4  STID
	CHARACTER*1 ANS
	LOGICAL EXISTS(8)
	INTEGER RATE(8)
c------- the qplot file and its format
	INTEGER COLUMNS
	CHARACTER*11 QPLTFILE
	CHARACTER*50 FRMT
	EQUIVALENCE (C_DATA,R_DATA)
	INTEGER*2 I,SYSTEM
c**************************************************************************
c		program begins
c--------------------------------------------------------------------------
	WRITE(*,*) ' THIS PROGRAM ALLOWS THE USER TO EDIT DATA IN THE'
	WRITE(*,*) ' BOB-STYLE FILES.  IT WILL TAKE THE DATA YOU WISH'
	WRITE(*,*) ' AND PUT IT INTO A QPLOT-STYLE FILE.  IT THEN PUTS'
	WRITE(*,*) ' YOU IN THE QDOS EDITOR TO EDIT THE FILE.  THE NEWLY'
	WRITE(*,*) ' EDITED DATA IS THEN READ BACK INTO THE BOB-FILES.'
	WRITE(*,*) ' '
c------- find out some information on what we are to do
c    		like the volcano
	CALL BANGERS(DIR)
c--------	get the day of interest
18	FORMAT(' ENTER DAY TO BE EDITED (i.e. 02-JAN-87) : ',$)
01	WRITE(6,18)
19	FORMAT(I2,1X,A3,1X,I2)
	READ(5,19,ERR=01)DAY,C_MON,YEAR
	CALL MON_2_INT (C_MON,MONTH,.FALSE.)
c------------
20	FORMAT(' WHAT IS THE 4-CHARACTER STATION ID ? ',$)
	WRITE(6,20)
21 	FORMAT (A4)
	READ(5,21) DIR(10:13)
	QPLTFILE='ERASEME.QPL'
	FRMT='(I2.2,.-.,A3,.-.,I2.2,1X,I2.2,.:.,I2.2,1X,8(F8.1))'
c		substitute an ' for . in frmt
	FRMT(7:7)=CHAR(39)
	FRMT(9:9)=CHAR(39)
	FRMT(14:14)=CHAR(39)
	FRMT(16:16)=CHAR(39)
	FRMT(31:31)=CHAR(39)
	FRMT(33:33)=CHAR(39)
30	FORMAT(' HOW MANY CHANNELS ARE TO BE EDITED (MAX. OF 8) ? ',$)
35	WRITE(6,30)
	READ(5,*,ERR=35) COLUMNS
	IF (COLUMNS .GT. 8) GOTO 35
c------- find out which files the data is supposed to go to
	DO 100 I=1,COLUMNS
43		FORMAT(' ENTER 4 CHARACTER CHANNEL ID FOR COLUMN ',I2,' ? ',$)
		WRITE(6,43) I
44		FORMAT(A4)
		FILENAME(I)='chidYR.DAT'
		READ(5,44) FILENAME(I)(1:4)  
100		CONTINUE
c---------------------------------------------------------------------------
c		open the files
	DO 105 I=1,8
		EXISTS(I)=.FALSE.
105		CONTINUE
	CALL GETJUL(JUL,YEAR,MONTH,DAY)
	CALL OPENEM (FILENAME,DIR,YEAR,RATE,COLUMNS,EXISTS)
c		read the data into the 8 arrays
c-------- loop through to columns, only doing those that exist
	DO 109 I=1,COLUMNS
		IF (.NOT. EXISTS(I)) GOTO 109
c-------- read the days worth of data out of the file
		READ(UNIT=(7+I),REC=(JUL+1)) C_DATA(1:(RATE(I)*4))
c--------		put it into the large buffer arrays
		DO 108 K=1,RATE(1)
			IN_DATA(I,K)=R_DATA(K)
108			CONTINUE
109		CONTINUE
	CALL CLOSEM(COLUMNS,EXISTS)
c----------
c		open the qplot file
	OPEN(UNIT=3,FILE=QPLTFILE,STATUS='UNKNOWN',MODE='WRITE',ERR=400)
c		and write the data out
	HOUR=0
	MINUTE=0
	MIN_INC=1440/RATE(1)
	CALL MON_2_INT (C_MON,MONTH,.TRUE.)
	DO 115 I=1,RATE(1)
		WRITE(3,FMT=FRMT,ERR=410) DAY,C_MON,YEAR,HOUR,MINUTE,
     2		(IN_DATA(H,I),H=1,COLUMNS)
		MINUTE=MINUTE+MIN_INC
		HOUR=HOUR+MINUTE/60
		MINUTE=MOD(MINUTE,60)
115		CONTINUE
	CLOSE(3)
c---------------------------------------------------------------------------
c		now spawn out to edit the file. when we return we will 
c		save it
138	I=SYSTEM('QED ERASEME.QPL'//CHAR(0))
c----------------------------------------------------------------------------
c		now save it
c	but only if they really, really want to
	WRITE(*,*)' '
	WRITE(*,*)' '
	WRITE(*,*)'----------------------------------------------------'
116	FORMAT(' DO YOU WANT TO SAVE YOUR CHANGES ?? (Y OR N) ',$)
	WRITE(*,116)
117	FORMAT (A)
	READ(*,117) ANS
	IF (ANS .NE. 'Y') THEN
		I=SYSTEM('DEL ERASEME.QPL'//CHAR(0))
		STOP
		END IF
118	FORMAT(' YOU REALIZE YOU WILL BE OVERWRITING THE OLD DATA ?? ',$)
	WRITE(*,118)
	READ(*,117) ANS
	IF (ANS .NE. 'Y') THEN
		I=SYSTEM('DEL ERASEME.QPL'//CHAR(0))
		STOP
		END IF
	WRITE(*,*) ' OK - CONSIDER IT DONE'
c-----------------------------------------------------------------------------
c--------    set the oldyear to -1 so we know the first time through.
	OLDYEAR=-1
c---------------------------------------------------------------------------
c		see if we can open the qplot file
	OPEN(UNIT=3,FILE=QPLTFILE,STATUS='OLD',MODE='READ',ERR=400)
119	FORMAT (I2.2,1X,A3,1X,3(I2.2,1X),8(F8.1))
120	READ(3,FMT=119,ERR=410,END=150) DAY,C_MON,YEAR,HOUR,MINUTE,
     2	(DATA(H),H=1,COLUMNS)
	CALL MON_2_INT (C_MON,MONTH,.FALSE.)
c---------- we got some data so first calculate the julian day
	CALL GETJUL(JUL,YEAR,MONTH,DAY)
121	FORMAT(' JULIAN DAY ',I3)
	IF (JUL .NE. OLDJUL) THEN
		WRITE(*,121) JUL
		OLDJUL=JUL
		END IF
c--------- see if we have to open a new file because of the new year
	IF (YEAR .NE. OLDYEAR) THEN
		IF (OLDYEAR .NE. -1) CALL CLOSEM (COLUMNS,EXISTS)
		CALL OPENEM (FILENAME,DIR,YEAR,RATE,COLUMNS,EXISTS)
		OLDYEAR=YEAR
		END IF
c---------- insert the data
	CALL INSERT(JUL,HOUR,MINUTE,DATA,EXISTS,RATE,COLUMNS,FILENAME)
c---------- get the next line
	GOTO 120
c-----------------------------------------------------------------------------
c--------- all done
150	CALL CLOSEM (COLUMNS,EXISTS)
	CLOSE(3)
	WRITE(*,*) ' ALL DONE'
	I=SYSTEM('DEL ERASEME.QPL'//CHAR(0))
	STOP
c**************************************************************************
c		error messages
400	WRITE(*,*) ' ERROR IN OPENING QPLOT FILE ',QPLTFILE
	I=SYSTEM('DEL ERASEME.QPL'//CHAR(0))
	STOP
410	WRITE(*,*)' ERROR IN READING DATA LINE, WILL TRY THE NEXT '
	GOTO 120
	END
c---------------------------------------------------------------------------
c
c***************************************************************************
c		openem opens the bob target file
c--------------------------------------------------------------------------
	SUBROUTINE OPENEM (FILENAME,DIR,YEAR,RATE,COLUMNS,EXISTS)
c--------------------------------------------------------------------------
	CHARACTER*10 FILENAME(8)
	CHARACTER*2 YR
	CHARACTER*13 DIR
	CHARACTER*24 DESIG
	INTEGER YEAR,DUM1,RATE(8),COLUMNS
	LOGICAL EXISTS(8)
c-------------------------------------------------------------------------
c-------- there are only COLUMNS possible files. if the stid in them equals
c-------- '    ' then no file is assocated with that column
	DESIG(1:13)=DIR
	DESIG(14:14)=':'
	DO 200 I=1,COLUMNS
		DESIG(
15:24)=FILENAME(I)
		CALL OPFILE(7+I,DESIG,YEAR,RATE(I),EXISTS(I),*420)
		IF ((I .NE. 1) .AND. (RATE(I) .NE. RATE(I-1))) GOTO 410
200		CONTINUE
c--------------------------------------------------------------------------
	RETURN
c--------------------------------------------------------------------------
c 		error message
405	FORMAT(' FILE RATES NOT EQUAL, MUST DO SEPARATE EDITING')
410	WRITE(6,405)
420	CALL CLOSEM(COLUMNS,EXISTS)
	STOP
c---------------------------------------------------------------------------
	END
c-------------------------------------------------------------------------
c
c
c***************************************************************************
c		closem closes all opened bob files
c--------------------------------------------------------------------------
	SUBROUTINE CLOSEM (COLUMNS,EXISTS)
c--------------------------------------------------------------------------
	LOGICAL EXISTS(16)
	INTEGER COLUMNS
c-------------------------------------------------------------------------
c         no explanantion needed
	DO 100 I=1,COLUMNS
		IF (EXISTS(I)) CLOSE(7+I)
100		CONTINUE
	RETURN
	END
c---------------------------------------------------------------------------
c
c***************************************************************************
c  		insert inserts the new data points into the files
c--------------------------------------------------------------------------
	SUBROUTINE INSERT(JUL,HOUR,MINUTE,DATA,EXISTS,RATE,COLUMNS,
     2	FILENAME)
c--------------------------------------------------------------------------
	INTEGER COLUMNS,JUL,HOUR,MINUTE,RATE(16),DUM1,DUM2
	LOGICAL EXISTS(16)
	REAL*4 DATA(16)
	CHARACTER*10 FILENAME(16)
c-------- those are easy. next however, data is read and written into a
c-------- a large character string that is equivalenced with a real*4 array
	CHARACTER*5760 INOUT
	REAL*4 DATAR(1440)
	EQUIVALENCE (INOUT,DATAR)
c---------------------------------------------------------------------------
c-------- loop through to columns, only doing those that exist
	DO 200 I=1,COLUMNS
		IF (.NOT. EXISTS(I)) GOTO 200
c-------- read the days worth of data out of the file
		READ(UNIT=(7+I),REC=(JUL+1),ERR=400) INOUT(1:(RATE(I)*4))
c-------- find the new pointer into the array for the new data point
		DUM1=(HOUR*60+MINUTE)*RATE(I)/1440 + 1
c-------- note: when the data is put into the array, it over writes any
c--------       old data. this means if two or more data points were taken
c--------       in the same interval, only the last one would be recorded.
		DATAR(DUM1)=DATA(I)
		WRITE(UNIT=(7+I),REC=(JUL+1),ERR=410) 
     2		INOUT(1:RATE(I)*4)
     	GOTO 200
390		FORMAT(' ERROR IN READING RECORD ',I3,' OF FILE ',A23)
400		WRITE(*,390) (JUL+1),FILENAME(I)
		GOTO 200
405		FORMAT(' ERROR IN WRITING TO RECORD ',I3,' OF FILE ',A23)
410		WRITE(*,405) (JUL+1),FILENAME(I)
		GOTO 200
200		CONTINUE
c--------------------------------------------------------------------------
	RETURN
c--------------------------------------------------------------------------
	END
c-----------------------------------------------------------------------
c
c***************************************************************************
c		getjul converts the month day year to a julian day (JL)
c--------------------------------------------------------------------------- 
	SUBROUTINE GETJUL(JL,YR,MON,DAY)
c---------------------------------------------------------------------------
	INTEGER JL,MON,YR,DAY
c---------------------------------------------------------------------------
c--------- fairly straight forward. assume each month has 31 days and
c--------- make the appropriate correction for the true number of days
c--------- in the month.
	JL=0
	DO 100 I=1,(MON-1)
	  JL=JL+31
	  IF (I.EQ.2) THEN
	    JL=JL-3
c---------   the ever problem leap year
	    IF ((MOD(YR,4)) .EQ. 0) JL=JL+1
	    END IF
	  IF (I .EQ. 4) JL=JL-1
	  IF (I .EQ. 6) JL=JL-1
	  IF (I .EQ. 9) JL=JL-1
	  IF (I .EQ. 11) JL=JL-1
100	  CONTINUE
	JL=JL+DAY
	RETURN
	END

***********************************************************************
*		get_dir
***********************************************************************
c	get_dir gets the directory of a certain file by matching up the
c	stid and volcano with one in the file BOB_DIRS.  when a match is
c	found, the directory is read from the file and placed in the variable
c	STID_DIR.  the integer END tells where the end of the directory
c	designation is in the chartactere string STID_DIR.
c----------------------------------------------------------------------
	SUBROUTINE GET_DIR (DESIG,STID_DIR,FULL_FILENM,END,*)
c-----------------------------------------------------------------------
c		the files's bob designation
	CHARACTER*24 DESIG
c		the true directory
	CHARACTER*60 STID_DIR
c		the last character's spot
	INTEGER END
c		the stuff to make the true file name
	CHARACTER*70 FULL_FILENM
c		the input line from the file and some pointers
	CHARACTER*80 LINE
	INTEGER DUM1
	CHARACTER*1 CHARA
c-------------------------------------------------------------------------
c				program starts
c		first open the directory file
	OPEN (UNIT=1,FILE='BOB_DIRS.LST',MODE='READ',STATUS='OLD',ERR=400)
c		read down until we get a match
100	FORMAT(A80)
110	READ(1,100,END=420) LINE
c		check for match - if not then read another line
	IF (DESIG(1:13) .NE. LINE(1:13)) GOTO 110
c		we got it. the directory begins spot #20 and continues until
c		a blank is reached
	END=1
	DUM1=20
120	CHARA=LINE(DUM1:DUM1)
	CHARA=CHARA
	IF ((CHARA .EQ. ' ').OR.(END .EQ. 61)) GOTO 150
	STID_DIR(END:END)=CHARA
	END=END+1
	DUM1=DUM1+1
	GOTO 120
c-------------------------------------------------------------------------
c		got it
150	END=END-1
	DO 155 I=1,70,10
		FULL_FILENM(I:I+9)='          '
155		CONTINUE
	FULL_FILENM(1:END)=STID_DIR(1:END)
	FULL_FILENM(END+1:END+10)=DESIG(15:24)
	CLOSE(1)
	RETURN
c--------------------------------------------------------------------------
c		error messages
400	WRITE(*,*)' NO BOB DIRECTORY FILE (BOB_DIRS.LST)'
	RETURN(1)
420	CLOSE(1)
	RETURN(1)
	END
c--------------------------------------------------------------------------c***************************************************************************
c			bangers
c----------------------------------------------------------------------------
c	bangers lets you select which volcano's data set you want to look at
c----------------------------------------------------------------------------
	SUBROUTINE BANGERS(DIR)
c----------------------------------------------------------------------------
	CHARACTER*75 LINE
c-----------------------------------------------------------------------------
	CHARACTER*9 DIR
c------------------------------------------------------------------------------
90	WRITE(*,*)' YOUR CHOICES ARE:'
c		get the choices from volcanos.lst
	OPEN (UNIT=2,STATUS='OLD',MODE='READ',FILE='VOLCANOS.LST')
100	FORMAT(A75)
110	READ(2,100,END=200)LINE
	IF (LINE(1:2) .EQ. '**') WRITE(*,*) LINE
	GOTO 110
c		prompt for the choice
200	CLOSE(2)
	WRITE(*,*) ' '
120	FORMAT (' ENTER THE 9 CHARACTER VOLCANO ID: ',$)
	WRITE(*,120)
125	FORMAT (A9)
	READ(*,125) DIR
c		good enough.  lets hope they typed it right
	RETURN
	END
c-----------------------------------------------------------------------------
*******************************************************************************
*			opfile
c-----------------------------------------------------------------------------
c-----opfile gets a filename as per its arguments. it then sees if the file
c-----exists, what the data rate is, and whether a fill from it of the assigned
c-----number of days will overflow the data array. finally, if all is ok, the
c------------------------------------------------------------------------------
	SUBROUTINE OPFILE(F_UNIT,DESIG,YR,RATE,OPENED,*)
c-----------------------------------------------------------------------------
	INTEGER YR,RATE,REC,F_UNIT
	CHARACTER*70 FULL_FILENM
	CHARACTER*4 C_REC
	EQUIVALENCE (C_REC,REC)
	CHARACTER*5 ABORT
	LOGICAL EXST
,OPENED
	CHARACTER*3 ORG
c--------	the directory and file
	CHARACTER*24 DESIG
	CHARACTER*60 STID_DIR
	INTEGER PTR2
c-----------------------------------------------------------------------------
c		program begins
******************************************************************************
c---------------construct the filename
	CALL ICONVERT(YR,DESIG(19:20),2)
	DESIG(21:21)='.'
	DESIG(22:24)='DAT'
	EXST=.FALSE.
	OPENED=.FALSE.	
c		go get the true directory location for this station
	CALL GET_DIR (DESIG,STID_DIR,FULL_FILENM,PTR2,*90)
c------------------------------------------------------------------------------
c		check for the files existence
	INQUIRE(FILE=FULL_FILENM,EXIST=EXST)
c		if its not there, it might be archived
90	IF (.NOT. EXST) THEN
		DESIG(9:9)='a'
		CALL GET_DIR (DESIG,STID_DIR,FULL_FILENM,PTR2,*91)
		INQUIRE(FILE=FULL_FILENM,EXIST=EXST)
		END IF
91	IF (.NOT. EXST) GOTO 200
c		having got to this point indicates a direct access file
c		see what its data rate is (record length/4)
	OPEN(UNIT=2,FILE=FULL_FILENM,STATUS='OLD',MODE='READ',RECL=4,
     2	FORM='UNFORMATTED',ACCESS='DIRECT',ERR=175)
	READ(UNIT=2,REC=1,ERR=175) C_REC
	CLOSE(2)
	RATE=REC/4
c--------------------------------------------------------------------------
c		open the file
	OPEN (UNIT=F_UNIT,STATUS='OLD',ACCESS='DIRECT',
     2	FILE=FULL_FILENM,RECL=(RATE*4),ERR=175,
     3	FORM='UNFORMATTED',MODE='READWRITE')
	OPENED=.TRUE.
175	RETURN
c--------------------------------------------------------------------------
195	FORMAT(1X,A24,' DOES NOT EXIST. EXITING')
200	WRITE(*,195) DESIG
	RETURN(1)
c---------------------------------------------------------------------------
	END
**************************************************************************
	SUBROUTINE ICONVERT(N,STR,LNG)
c	      **iconvert converts an integer n composed of lng digits
c	      **into a string str of length lng
	INTEGER LNG,N,N1,N2,PTR
	CHARACTER*(*) STR
	N1=N
	PTR=1
	DO 200 I=(LNG-1),0,-1
		N2=INT(N1/10**I)
		STR(PTR:PTR)=CHAR(N2+48)
		N1=N1-(N2*10**I)
		PTR=PTR+1
200		CONTINUE
	RETURN
	END
c--------------------------------------------------------------------------c***************************************************************
c			mon_2_int
c--------------------------------------------------------------
c		returns the corresponding integer value for the
c	3 character value for the month. for the integer inputs for
c	the month you must read it A2, not A3.
c--------------------------------------------------------------
	SUBROUTINE MON_2_INT (MONTH,IMON,GET_MONTH)
c--------------------------------------------------------------
	CHARACTER*3 MONTH
	INTEGER IMON
	CHARACTER*3 UP_MON(12)
	LOGICAL GET_MONTH
c------------------------------------------------------------
c		the search begins
c------------------------------------------------------------
	DATA UP_MON /'JAN','FEB','MAR','APR','MAY','JUN','JUL',
     2	'AUG','SEP','OCT','NOV','DEC'/
c--------------------------------------------------------------
	IF (GET_MONTH) THEN
		MONTH=UP_MON(IMON)
		RETURN
		END IF
	IMON=0
	DO 100 I=1,12
		IF (MONTH .EQ. UP_MON(I)) THEN
			IMON=I
			GOTO 110
			END IF
100		CONTINUE
110	RETURN
	END
c----------------------------------------------------------------