Category : Miscellaneous Language Source Code
Archive   : FORTRAN.ZIP
Filename : TESTALL.FOR

- Program to test SBM Fortran compiler.
/ exclude rtl
- Here we declare a character array and initialize it to whatever size the
- data requires.

character outbuf/esc,'[2J',cr,lf,' -- Testing ---',cr,lf
'1. UNFORMATTED OUTPUT: write(*) outbuf',cr,lf
' (also data statement to set the output)',cr,lf,lf,0/
write(*) outbuf ; display the array.

data command/'now is the-time',0/
parse_only command,outbuf,'-'

write(*,*) '2. This is LIST DIRECTED OUTPUT TO CONSOLE'
write(*,*) '' ; line-feed
- now test formatted output.
integer*2 int2_1, int2_2, int2_3, int2_4, int2_5
- Since the variables were declared without any intervening data, they
- can be initialized as though they were an array.
data int2_1 /1,23,456,7890,32767/
write(*,1012) int2_1, int2_2, int2_3, int2_4, int2_5
1012 format('3. FORMATTED OUTPUT ',i2,i3,i4,i5, i30, ' maximum')

- notice how we can insert long skips ^.
- one should never need the 'x' descriptor on output.
- Standard fortran works this way too.

- try some tricky subscripting and display max negative number.
data int2_5/-32768/
m=1
write(*,1012) int2_1(m), int2_2, int2_1(m+2), int2_5(m-1), int2_5
write(*,*) '' ; xtra line-feed

- disk output....
write(*,*) '4. Testing disk output.'
write(*,*) ' Do-loops are also tested here.'
open(16,file='testall.dat',status='new',alias=memfile)
if(cy) call exit
do 809 counter=1,10
write(16,309) counter
309 format('test output record',i3)
809 continue
write(*,*) ' 10 records written to "testall.dat".'
close 16
write(*,*) ' "testall.dat" closed.'
write(*,*) '' ; line-feed

- appending disk data to an existing file.
open(17,file='e:testall.dat',status='append')
write(*,*) ' "testall.dat" re-opened for appending.'
do 909 counter=1,4
write(17,409) counter
409 format('appended record',i3)
909 continue
write(*,*) ' 4 records appended.'
write(*,*) '' ; line-feed
--------------------------------------------------------

- read from an internal file.
- also called a re-read. with it you can read a record as many times
- as you wish, using a different format each time. above, notice that
- we assigned an alias to unit 16. In this buffer area, we still have
- the last record that was written with format 309.

integer lastnum
read(memfile,160) lastnum
160 format(19x,i3)
add lastnum,2000 ; test the 'add' statement.
write(*,161) lastnum
161 format('5. Reading from internal file, should be 2010, have',i5/)

- using the dollar descriptor for console message.
write(*,*) 'press any key to continue ',$

- get next character from console
wait (you could also use 'nexchar' here)
data outbuf/esc,'[2J',0/
write(*) outbuf ; clear the screen

write(*,*) '6. Testing assign statements and subscripts'
- also notice the nested 'do'.
data outbuf/' abcdefghijklmnopqrstuvwxyz 0123456789',cr,lf,0/
counter=4
do 211 k=1,4
do 200 j=4,100
outbuf(j)=outbuf(j+1)
if(al.eq.0) goto 201
200 continue
201 write(*) outbuf
211 continue
write(*,*) '' ; line-feed

data outbuf/cr,lf,' -- Testing Completed ---',cr,lf,lf,0/
write(*) outbuf
call exit
end