Defend us from VMS! (etc)

[Mike A. Gigante]

I'm very quick to criticize the quality of the standard f77, many of
the fortran programs we have hanging around here cause most vanilla
f77s to page themselves to death, take forever to compile and run
(relatively) slowly.  However there *ARE* good unix f77 compilers
available; we use SVS (Silicon Valley Software) here and there are
others (such as ABSOFT).  I have previously posted some comparisons
b/n SVS and f77 (a long time ago), suffice to say they are stunning.
However, I should point out that we personally don't write much in 
fortran here and haven't for a long time...

But now, to show those unix programmers what wonderful things are missing from
f77 and friends, we have a VMS fortran programmers masterpiece.  

I expect that this will cause campuses all over the world to chuck out those
Unix tapes, purge those disks, trade in all those suns/apollos/irises etc
so as to buy vaxes to run VMS fortran on :-)


-----------------------------

C------------------------------------------------------------------
C Contains only one subroutine  ACCESS
C------------------------------------------------------------------
	SUBROUTINE ACCESS(I7)
	IMPLICIT INTEGER*4(A-Z)
	INCLUDE  '($SMGDEF)'
	CHARACTER*18 CMPF,MNS
	CHARACTER*40 AVAL,K
	CHARACTER*12 ID,bns,AVIND
	CHARACTER*3 GOID,GO
	CHARACTER*10 bmpf
	CHARACTER*5 ART_QUAN,ART_LEVEL
	REAL*8 DECVAL,DECVAL1
	INCLUDE  'COMMON.FOR'
	DIMENSION K(100,1)
	STRUCTURE/FILE_STRUC/
		CHARACTER*12 ART_NO
		CHARACTER*12 ART_DESC
		INTEGER*4  ART_QUAN
		INTEGER*4  ART_LEVEL
		CHARACTER*8  DUMMY
	END STRUCTURE
	RECORD/FILE_STRUC/FILEREC
	STATUS = SMG$CREATE_PASTEBOARD(PI,,,,)
	STATUS = SMG$CREATE_VIRTUAL_DISPLAY(20,78,SED,SMG$M_BORDER,,)
	STATUS = SMG$CREATE_VIRTUAL_KEYBOARD(KEY)
	STATUS = SMG$PASTE_VIRTUAL_DISPLAY(SED,PI,2,2)
	OPEN(UNIT = 26,
	1	FILE = 'SEARCH.DAT',
	1	ORGANIZATION = 'INDEXED',
	1	ACCESS = 'KEYED',
	1	STATUS = 'UNKNOWN',
	1	RECL = 40, 
	1	KEY = (1:12:CHARACTER),
	1	RECORDTYPE = 'VARIABLE')
  40	STATUS = SMG$PUT_CHARS(SED,'WHAT IS THE ARTICLE NUMBER OF THE PART 
	1 PLEASE?',4,10,,,,)
	STATUS = SMG$SET_CURSOR_ABS(SED,5,15)
	STATUS = SMG$READ_STRING(KEY,ID,'->>',12,,,,TEXT_SIZE,,SED)
	READ(UNIT=26,KEY= ID,KEYID = 0,IOSTAT=IER,ERR=22)FILEREC
	DECVAL = FLOAT(FILEREC.ART_QUAN)
	call onvrt(art_quan,decval,2)
	DECVAL1 = FLOAT(FILEREC.ART_LEVEL)
	call onvrt(art_LEVEL,decval1,2)
	STATUS = SMG$PUT_CHARS(SED,'ARTICLE NUMBER :',6,10,,,,)
	STATUS = SMG$PUT_CHARS(SED,FILEREC.ART_NO,6,30,,,,)
	STATUS = SMG$PUT_CHARS(SED,'DESCRIPTION :',8,10,,,,)
	STATUS = SMG$PUT_CHARS(SED,FILEREC.ART_DESC,8,30,,,,)
	STATUS = SMG$PUT_CHARS(SED,'QUANTITY PER PART :',10,10,,,,)
	STATUS = SMG$PUT_CHARS(SED,ART_QUAN,10,30,,,,)
	STATUS = SMG$PUT_CHARS(SED,'ASSEMBLY LEVEL :',12,10,,,,)
	STATUS = SMG$PUT_CHARS(SED,ART_LEVEL,12,30,,,,)
 22	IF(IER.EQ.36)THEN
	STATUS = SMG$PUT_CHARS(SED,'ARTICLE NUMBER IS NOT ON FILE,SORRY !'
	1,8,10,,,,)
	STATUS = SMG$PUT_CHARS(SED,'DO YOU WISH TO GO AGAIN (Y/N)'
	1,9,10,,,,)
	STATUS = SMG$SET_CURSOR_ABS(SED,10,15)
	STATUS = SMG$READ_STRING(KEY,GOID,'->>',3,,,,TEXT_SIZE,,SED)
	STATUS = STR$UPCASE(GO,GOID)
	STATUS = SMG$ERASE_DISPLAY(SED)
	IF(GO.EQ.'Y')GO TO 40
	GO TO 60
	END IF
   50   STATUS = SMG$PUT_CHARS(SED,'DO YOU WISH TO GO AGAIN (Y/N)'
	1,14,10,,,,)
	STATUS = SMG$SET_CURSOR_ABS(SED,15,15)
	STATUS = SMG$READ_STRING(KEY,GOID,'->>',3,,,,TEXT_SIZE,,SED)
	STATUS = SMG$ERASE_DISPLAY(SED)
	STATUS = STR$UPCASE(GO,GOID)
	IF(GO.EQ.'Y')GO TO 40
   60	STATUS = SMG$DELETE_PASTEBOARD(PI)
	STATUS = SMG$DELETE_VIRTUAL_DISPLAY(SED)
	STATUS = SMG$DELETE_VIRTUAL_KEYBOARD(KEY)
 9999	CLOSE(UNIT= 26)
	RETURN
	END
*
*
------------------------------

I think I'll g and read some JCL tonight, it'll put me in the mood
to appreciate more of this wonderful VMS fortran.

(seriously, give an engineer enough rope and they'll hang themselves!
 This rather extreme example illustrates just how far from standard
 fortran you  can go...)