home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.update.uu.se
/
ftp.update.uu.se.2014.03.zip
/
ftp.update.uu.se
/
pub
/
rainbow
/
msdos
/
decus
/
RB101
/
strip.for
< prev
next >
Wrap
Text File
|
1995-05-19
|
3KB
|
153 lines
$STORAGE: 2
$NOFLOATCALLS
c-----------------------------------------------------------------------
c
c Strip Daily Appointment subroutine
c
c part of GLENN EVERHART'S MODS TO DTC program
c
c Input:
c line - 72 characters; Format: P [mmddyy]
c
c Output:
c Strips old appointments (before date) from dtc.dat
c and builds new dtc.dat.
c
c-----------------------------------------------------------------------
c
SUBROUTINE strip(line)
c
c Declarations:
c
character line(1)
c input line
CHARACTER*2 TMP2
character temp(2)
EQUIVALENCE(TMP2,TEMP(1))
c temporary string converting array
character appoin(60)
c appointment string
character esc
c escape character
integer id
c Julian Day
integer im
c Julian Month
integer iye
c Julian Year
integer rdspfg
c flag to reverse sense of display of time
integer ctlfg
c misc control flags here
common/ctls/rdspfg,ctlfg
character fname(60)
CHARACTER*20 FNAM60
EQUIVALENCE (FNAME(1),FNAM60)
integer fnsz
common/fn/fnsz,fname
c
c Initialize:
c
iterm = 0
c Output terminal unit number
esc = 27
c Escape character
call idate(im,id,iye)
c initialize to today's date
c
c Parse that line
c
c
c
c Was there a P on the front? If so, trim it off:
c
IDMX=0
If ( line(1) .eq. 'P' .or.line(1).eq.'p') then
Do 1 i=1,70
line(i) = line(i+2)
1 Continue
End If
c
c If the date was specified in command line then
c set id, im and iye to the right values:
c
CALL DATMUN(LINE)
Do 22 i=1,6
IDL=I
If ( ( line(i) .gt. '9' ) .or. ( line(i) .lt. '0' ) ) goto 33
22 Continue
c Six numbers in a row, so decode into numeric date:
temp(1) = line(1)
temp(2) = line(2)
read(tmp2,2)im
c decode ( 2 , 2 , temp ) im
temp(1) = line(3)
temp(2) = line(4)
read(tmp2,2)id
c decode ( 2 , 2 , temp ) id
temp(1) = line(5)
temp(2) = line(6)
read(tmp2,2)iye
c decode ( 2 , 2 , temp ) iye
2 Format(i2)
c
c Now discard the date part from line string:
c
Do 3 i=1,63
line(i) = line(i+7)
3 continue
GOTO 3307
33 continue
C GOT A DELIMITER NOT A NUMERIC IN 1ST 6 COLS SO MAKE THAT THE START OF LINE
C BY CHOPPING OFF ALL THAT'S EARLIER
IF(IDL.LE.0.OR.IDL.GT.6)GOTO 3307
DO 3308 I=1,63
LINE(I)=LINE(I+IDL)
3308 CONTINUE
3307 CONTINUE
KHSH=ID+32*(IM+12*(IYE-81))
C ADD CLOSE TO GUARANTEE NO FAILURES...
CLOSE(1)
Open (1, file=FNAM60,status='OLD',form='FORMATTED')
close(2)
OPEN(2,FILE=FNAM60,STATUS='NEW',FORM='FORMATTED')
100 continue
c loop back up here to continue reading and
c processing input file:
read(1,200,end=400) ihy,ihm,ihd,iht,(line(k),k=1,60)
200 format(3i2,i3,60a1)
LHSH=IHD+32*(IHM+12*(IHY-81))
IF(LHSH.LT.KHSH)GOTO 100
WRITE(2,200)IHY,IHM,IHD,IHT,(LINE(K),K=1,60)
goto 100
400 continue
c no more appointments left in file.
close(1)
CLOSE(2)
return
end