=================================================================== PL/I CANT FAQ ASSERTIONS: Windows PL/I CANT translate following Fortran source, producing output values shown, or if no outputs shown, equivalent code that meets claims made for Fortran source, (ie. using 1 statement). As a result "PL/I is MORE powerful than Fortran" assertion in PL/I FAQ needs to be: "PL/I is LESS powerful than Fortran". This FAQ uses Intel/Compaq Visual Fortran for its code/output proofs. "Sacred cows make the best hamburger" -- Mark Twain =================================================================== 1. CANT specify a file contains all big-endian data. open (1,file='anyfile',form='binary',convert='big_endian') =================================================================== 2. CANT provide standard masked password input processing ! -------------------- program masks_password ! honors backspace character,external :: getcharqq character,parameter :: cr = char(13), bs = char(08) character(10) :: pw character :: ch integer :: nc = 0 do ch = getcharqq() ! does not echo keyboard input if (ch == cr) exit if (ch == bs) then ! delete last pw char processed if (nc > 0) nc = nc-1 ! nc = 0 all pw deleted write (*,'(3a\)') bs,' ',bs else nc = nc+1 ; pw(nc:nc) = ch ! accum. password write (*,'(a\)') '*' ! echo mask char * end if if (nc == 10) exit end do write (*,*) 'password = ',pw(1:nc) end program Input password: PL/I CANT Output echos mask: ********* =================================================================== 3. CANT provide varying record database support ! ----------------------- program varying_records ! 5 record database simulation integer(1) :: n, nf, date(3) ! use byte-size data character(1000) :: winners open (1,file='test.dat',form='binary') nf = 1 ; date = [ 07,20,03 ] ; write (1) nf, date ! rec. #1 nf = 1 ; date = [ 07,21,03 ] ; write (1) nf, date ! rec. #2 nf = 2 ; winners = 'john doe, anthony soprano' n = len_trim(winners) ; write (1) nf,n, winners(1:n) ! rec. #3 nf = 1 ; date = [ 07,22,03 ] ; write (1) nf, date ! rec. #4 nf = 100 ; write (1) nf, 'bad record type' ! rec. #5 rewind (1) ! 55 byte database generated do ! read and output database contents read (1,end=101) nf ! get record format select case (nf) case (1) ! process date rec. format read (1) date write (*,91) date ! outputs mm/dd/yy case (2) ! process winners rec. format read (1) n, winners(1:n) write (*,92) 'lotto winners: ',winners(1:n) case default write (*,*) 'unrecog. record format = ',nf exit end select end do 101 close (1) 91 format (2(i2.2,'/'),i2.2) 92 format (2a) end program Outputs: 07/20/03 07/21/03 lotto winners: john doe, anthony soprano 07/22/03 unrecog. record format = 100 =================================================================== 4. CANT do array element swaps using 1 statement syntax ! ------------------------- a([i,j]) = a([j,i]) =================================================================== 5. CANT specify widthless format items with left-justified values ! ---------------------------- write (*,'(i0, f0.1)') 123, 45.67 ! integer, real left-justified Outputs: 12345.7 =================================================================== 6. CANT access substrings without use of functions. ! ------------------------------- book(lines,:)(36:43) = 'page nnn' ! center bottom ALL book pages =================================================================== 7. CANT write dynamically sized array-valued functions ! -------------------------- function square(y) result(x) ! x is a output array sized by input real :: y(:), x(size(y)) x = y**2 end function =================================================================== 8. CANT parse file record text with PL/I equivalent to PACK parsing function below. ! ------------------- program parse ! strip blanks, reverse text from record inputs integer :: n character :: a(80), v(80) = ' ' character(80) :: s ; equivalence (s,a) ! share memory allocation open (1,file='test.txt') write (1,*) "the quick brown fox jumped " ! record 1 write (1,*) "over the lazy dog's back. " ! record 2 rewind (1) do read (1,'(a)',end=101) s ! input a record a = pack(a,a/=' ',v) ! strip blanks from record n = len_trim(s) ! get stripped text length a(n:1:-1) = a(1:n) ! reverse the stripped text write (*,*) a(1:n) ! output left-justified text end do 101 stop end program Outputs: depmujxofnworbkciuqeht .kcabs'godyzalehtrevo =================================================================== 9. CANT do inline array assignment indexing, a(n:1:-1) = a(1:n) ! reverse array ! ---------------- program array_assign_indexing ! + variable left-just. specifiers integer,parameter :: nv = 5 integer :: a(nv) = [1,22,333,4444,55555] integer :: nsum = 0 do n = 1,nv a(1:n) = a(1:n) +n ! add n to 1:n values a(n:1:-1) = a(1:n) ! reverse 1:n values nsum = nsum + sum(a(1:n)) ! sum 1:n values end do write (*,91) 'nsum= ',nsum, ' a= ',a 91 format (a,i0,a,(I0,','),I0) ! var, left-just, specifiers end program Output: nsum= 65640 a= 55560,345,16,36,4453 =================================================================== 10. CANT do array assignment using inline array descriptor syntax ! ----------------- a = [dog,cat,0,rat] =================================================================== 11. CANT classify record's text values using decode error handlers ! ------------- program classify_record_values ! as integer, real, unknown types character(12) :: values(3) open (1,file='test.txt') write (1,*) '123 DOG 1e-12' ! record 1 write (1,*) '123456789. 44 CAT' ! record 2 rewind (1) do read (1,*,end=101) values ! input record with 3 values do n = 1,3 ! classify the 3 values write (*,'(a\)') values(n) read (values(n),'(i12)',err=1) ival write (*,*) 'classified as integer' ; cycle 1 read (values(n),'(f12.0)',err=2) rval write (*,*) 'classified as real' ; cycle 2 write (*,*) 'not integer or real' end do end do 101 stop end program Outputs: 123 classified as integer DOG not integer or real 1e-12 classified as real 123456789. classified as real 44 classified as integer CAT not integer or real =================================================================== 12. CANT write C-compatible string function called by default-compiled C program. main() // TEST.C { int n, enclose(char *, char *); // interface Fortran function char outs[99]; n = enclose("the lazy dog ",outs); printf("%s%s\n", outs,","); // Outputs: 'the lazy dog', } ! ------------------------------------ integer function enclose [C] (is1,is2) integer :: is1, is2 ; pointer (is1,s1), (is2,s2) integer :: clen character(999) :: s1, s2 clen = len_trim(s1(1:index(s1,char(0))-1 )) ! trimmed s1 length s2(1:clen+3) = "'" // s1(1:clen) // "'" // char(0) enclose = 0 end function DF /c enclose.f90 <- CVF Fortran creates enclose.obj CL test.c enclose.obj <- MS-C compiles/links -> test.exe Output: 'the lazy dog', =================================================================== 13. CANT match the scientific data type precisions and IEEE format floating data types below. ! ------------------------------- program precisions ! supported by Intel Visual Fortran for Windows integer(1) :: i1 = 123 integer(2) :: i2 = 12345 integer :: i4 = 1234567890 integer(8) :: i8 = 1234567890123456789 real :: r4 = 12345678 real(8) :: r8 = 1234567890123456 real(16) :: r16= 123456789012345678901234567890123_16 complex :: c4 = (12345678,-12345678) complex(8) :: c8 = (1234567890123456_8,-1234567890123456_8) complex(16):: c16= (123456789012345678901234567890123_16, & -123456789012345678901234567890123_16) ! demo data can be output,input with no loss of precision open (1,file='test.dat',form='binary') write (1) i1,i2,i4,i8, r4,r8,r16, c4,c8,c16 rewind (1) read (1) i1,i2,i4,i8, r4,r8,r16, c4,c8,c16 write (*,*) i1 ; write (*,*) i2 ; write (*,*) i4 ; write (*,*) i8 write (*,*) r4 ; write (*,*) r8 ; write (*,*) r16 write (*,*) c4 ; write (*,*) c8 ; write (*,*) c16 end program Outputs: 123 12345 1234567890 1234567890123456789 1.2345678E+07 1.234567890123456E+015 1.23456789012345678901234567890123E+032 (1.2345678E+07,-1.2345678E+07) (1.234567890123456E+015,-1.234567890123456E+015) (1.23456789012345678901234567890123E+032,-1.234567890123456E8901234567890123E+0 =================================================================== 14. CANT provide generic matrix function support for ALL operations shown with matching outputs. ! ----------------------- program demo_SOME_matrix_operations integer,allocatable :: d(:), a(:,:) do n = 5,3,-1 if (n /= 3) cycle ! skip a(5,5), a(4,4) outputs allocate (d(n), a(n,n)) a = reshape( [(1:n*n)], [n,2]) ! init. 2d array with 1:n*n forall (i=1:n) d(i) = a(i,i) ! get diagonal write (*,91) 'matrix a', a write (*,91) 'transpose a', transpose(a) write (*,92) 'upper triangle a' write (*,93) (a(i:,i),i=1,n) ! output upper triangle 1 loop write (*,92) 'diagonal d= ', d write (*,94) 'dot product d x a(:,1)= ', dot_product(d,a(:,1)) write (*,92) 'matrix multiply d x a= ', matmul(d,a) write (*,94) 'sum, product matrix a= ', sum(a),', ',product(a) end do 91 format (a/,(I2/)) 92 format (a,(I0,1x)) 93 format (x,I2) 94 format (2(a,I0)) end program Outputs: matrix a 1 2 3 4 5 6 7 8 9 transpose a 1 4 7 2 5 8 3 6 9 upper triangle a 1 2 3 5 6 9 diagonal d= 1 5 9 dot product d x a(:,1)= 38 matrix multiply d x a= 38 83 128 sum, product matrix a= 45, 362880 =================================================================== 15. CANT use modules to eliminate interfacing external routines. ! ----------------------------- module user1 contains ! any number of user's precompiled routines subroutine asub(amat) real(8),allocatable :: amat(:,:) allocate ( amat(10,10) ) amat = 1234567.89_8 ! set amat to dp constant end subroutine include 'pic.f90' ! insert picture function in module end module ! ----------------------- program remote_allocation use user1 ! eliminates need to interface asub, pic real(8),allocatable :: a(:,:) call asub(a) write (*,*) a(1,10), pic(a(1,10),4,',') end program Outputs: 1234567.89000000 1,234,567.8900 =================================================================== 16. CANT declare character variable with length = 50k ! ---------------------- program show_big_string_support character(50000) :: big_string big_string(50000-10:) = 'Hello World' write (*,*) big_string(50000-10:) end program Output: you guessed it!! =================================================================== 17. CANT create generic subroutines/functions. ! ------------------------------ module qsort_1 interface qsort module procedure qsort_i4, qsort_r8 end interface qsort contains ! ----------------------------------- recursive subroutine qsort_i4(arr,l,r) integer :: arr(*), val integer :: l, r, i,j i = l ; j = r ; val = arr((l+r)/2+1) do while (i <= j) do while (arr(i+1) < val .and. i < r) i = i+1 end do do while (val < arr(j+1) .and. j > l) j = j-1 end do if (i <= j) then arr([i+1,j+1]) = arr([j+1,i+1]) ! swap chars i = i+1 j = j-1 end if end do if (l < j) call qsort_i4(arr, l, j) if (i < r) call qsort_i4(arr, i, r) end subroutine qsort_i4 ! ----------------------------------- recursive subroutine qsort_r8(arr,l,r) real(8) :: arr(*), val integer :: l, r, i,j i = l ; j = r ; val = arr((l+r)/2+1) do while (i <= j) do while (arr(i+1) < val .and. i < r) i = i+1 end do do while (val < arr(j+1) .and. j > l) j = j-1 end do if (i <= j) then arr([i+1,j+1]) = arr([j+1,i+1]) ! swap chars i = i+1 j = j-1 end if end do if (l < j) call qsort_r8(arr, l, j) if (i < r) call qsort_r8(arr, i, r) end subroutine qsort_r8 end module qsort_1 ! ------------------------- program test_qsort use qsort_1 integer :: i4(5) = [5:1:-1] real(8) :: r8(5) = [5:1:-1] call qsort(i4, 0, size(i4)-1) call qsort(r8, 0, size(r8)-1) write (*,'(5i4/,5f4.0)') i4, r8 end program Outputs: 1 2 3 4 5 1. 2. 3. 4. 5. =================================================================== 18. CANT do arithmetic with pointer arguments. ! ------------------------------ program demo_pointer_arithmetic implicit none real,pointer :: x(:) allocate (x(5)) x = [1:5] call ptr_arithmetic (x) write (*,'(a,5f5.1)') 'x =',x write (*,'(a,i0)') 'size x = ',size(x) stop contains subroutine ptr_arithmetic (arr) real,pointer :: arr(:) arr => arr(2+1:) ! ptr+2 reduces arr size by 2 end subroutine end program Outputs: x = 3.0 4.0 5.0 size x = 3 =================================================================== 19. CANT assign blank-terminated strings to exact size arrays. ! ---------------------------------- program trimmed_strings_to_exact_size_array character,allocatable :: a(:) character(80) :: lines(2) = ['The Quick Brown Fox ', & "Jumps Over The Lazy Dog's Back."] do i = 1,size(lines) write (*,'(a,i0,999a)') ' size a= ', s2a(lines(i),a), ' |',a,'|' end do stop contains ! ----------------------------- function s2a(s,a) result(nc) character(*) :: s character,allocatable :: a(:) integer :: nc if (allocated(a)) deallocate (a) nc = len_trim(s)) ; allocate (a(nc)) a = transfer(s(1:nc),[' ']) end function s2a end program Outputs: size a = 19 |The Quick Brown Fox| size a = 31 |Jumps Over The Lazy Dog's Back.| =================================================================== 20. CANT direct access command-line arguments. ! ----------------------------- program accessing_command-line integer,external :: nargs ! gets #args in command-line character(80) :: s call getarg(3,s) ! direct access 3rd arg write (*,*) trim(s) do n = 0,nargs() ! output all command line args call getarg(n,s) write (*,*) trim(s) end do end program Execute program using: >CANT20 direct access demo Outputs: demo CANT20 direct access demo =================================================================== 21. CANT support multi-byte (MB) character sets as there are no multi-byte functions, MBINDEX, MBSCAN, MBVERIFY, etc. =================================================================== 22. CANT -- asserts a severe lack of PL/I file-position syntax. . no rewind statement . no backspace statement . no open file to last position statement . no delete file at close statement ! -------------------------------- program demo_text_file_positioning character(80) :: line open (1,file='test.txt') write (1,'(a)') 'this is 1st record in file' write (1,'(a)') 'this is last record in file' close (1) open (1,file='test.txt',position='append') backspace (1) write (1,'(a)') 'this record replaces previous last record' rewind (1) do read (1,'(a)',end=101) line write (*,'(a)') trim(line) end do 101 close (1,status='delete') ! close and delete file end program Outputs: this is 1st record in file this record replaces previous last record =================================================================== 23. CANT get string AND #chars from keyboard with same function. ! ------------------------ program get_string integer,external :: getstrqq character(80) :: buf n = getstrqq(buf) ! echos, returns #chars write (*,'(2a,i0)') buf(1:n),' ',n end program Keyboard>abc Output>abc 3 =================================================================== 24. CANT do I/O with serial ports using Windows PL/I library routines, because there arent any. ! --------------------------- program output_serial_printer use dflib character(80) :: lines(2) = [' text 1 ',' text 2 '] character(5) :: control = char(027)//char(038)//char(108)// & char(049)//char(079) n = sport_connect(2,0) ! open com port 2 with default options n = sport_write_data(2,control) ! set HP printer to landscape mode do i = 1,2 n = sport_write_line(2,trim(lines(i))) ! print lines end do end program =================================================================== 25. CANT -- asserts there is no support for: . constant arrays . 64-bit constants . 64-bit variables . assigning array values using WHERE logic (only assigns values where logic is true) ! ----------------------- program more_asserts integer(1),parameter :: blue=0, green=1, red=2, not_computed=-1 integer(1),parameter :: colors(3) = [red,green,blue] ! constant array integer(8) :: c(3) = not_computed, a(3) = 100000000000 where ( colors /= 0) c = a/colors write (*,91) 'c1= ',c(1) write (*,91) 'c2= ',c(2) write (*,91) 'c3= ',c(3) 91 format (a,i0) end program Outputs: c1= 50000000000 c2= 100000000000 c3= -1 =================================================================== 26. CANT match specified outputs mandated by IEEE-754 exception standard, partially demo'ed below. ! ------------------------ program ieee_demo real :: x, y integer :: k = 0 write (*,*) 'and the answer is ',123.456/k write (*,*) 'and the answer is ',-123.456/k x = 123.456/k y = 123.456/x ! use +infinity to get CORRECT answer. write (*,*) 'and the answer is ',y end program Outputs: and the answer is Infinity and the answer is -Infinity and the answer is 0.0000000E+00 =================================================================== 27. CANT specify precision of inline constants. ! ------------------------- program constant_precisions integer(8) :: i do i = 2147483647,2147483649_8 ! mix 32,64 bit do constants write(*,'(i0)') i end do end program Outputs: 2147483647 2147483648 2147483649 =================================================================== 28. CANT -- address array slices ! ------------------------- program sub_array_addressing real(8) :: x(0:3) = [0.0d0, 1.1d0, 3.333d0, 9.999999999d0] write (*,91) 'integers 1:2 =',int(x(1:2)),' sum=',sum(int(x(1:2))) write (*,92) 'reals 2:3 =',sngl(x(2:)),' sum=',sum(sngl(x(2:))) write (*,93) 'doubles 0:3 =',x, ' sum=',sum(x) 91 format (2(a,2(1x,i0))) 92 format (2(a,2(1x,f0.3))) 93 format ( a,3(1x,f0.3),1x,f0.9, a,f0.9) end program Outputs: integers 1:2 = 1 3 sum= 4 reals 2:3 = 3.333 10.000 sum= 13.333 doubles 0:3 = 0.000 1.100 3.333 9.999999999 sum=14.432999999 =================================================================== 29. CANT write user function that passively monitors floating faults: invalid/denormal/zerodivide/overflow/underflow, because PL/I doesnt provide access to fp status register. ! -------------------------------- program monitor_fp_faults ! in program with traps disabled logical,external :: fp_faults integer :: t(8) ! date,time values character(40) :: err do ! continue simulate program execution call sleepqq(1000) ! with 1 sec suspension call random_number(x) n = x*5 ! n = 0:4 select case (n) ! randomly create 2 of 5 fault types case (2) x = x/(n-2) ! create a zero divide fault case (3) x = (x + 1e30)**2 ! create a overflow fault case default ! cases (0,1,4) invalid/denormal/underflow faults not demo'ed end select if (fp_faults(err)) then ! err msg is returned call date_and_time(values=t) write (*,91) t(5:7), err ! hh:mm:ss error message 91 format(2(i2.2,':'),i2.2,2x,a) end if ! continue program execution end do end program ! ----------------------------------- logical function fp_faults(err) use dflib integer(2) :: status character(40) :: err, faults(0:4) = & ['invalid','denormal','zerodivide','overflow','underflow'] fp_faults = .false. call getstatusfpqq(status) ! get fp status register if (iand(status,31) == 0) return ! bits 0:4 = 0 call clearstatusfpqq() ! clear status register fp_faults = .true. ! fault(s) occurred do i = 0,4 ! test status bits 0:4 if (btest(status,i)) exit end do err = trim(faults(i)) // ' occurred' end function Outputs: 13:25:38 divide by zero occurred 13:25:43 divide by zero occurred 13:25:45 overflow occurred =================================================================== 30. CANT pass routine a 1:based 2d sub-array from larger 2d array and access it as a 0:based 2d array. ! ---------------------- module user1 contains subroutine asub ( b ) integer :: b(0:,0:) ! declare array is zero-based do n = 0,ubound(b,dim=2) ! use 0 base indexing write (*,'(99i3)') b(:,n) end do end subroutine end module user1 ! ---------------------- program array_section_passing use user1 ! provides interface to asub integer :: a(10,10) = [1:100] j = 7 ; k = 2 call asub( a(j:j+2,k:k+2) ) ! pass 2d (3,3) sub-array to asub end program Outputs: 17 18 19 27 28 29 37 38 39 =================================================================== 31. CANT get caller's array bounds in routine. ! ---------------------- module user1 contains subroutine asub ( b ) ! no explicit bounds provided integer,pointer :: b(:,:) write (*,91) 'upper bounds =',ubound(b) write (*,91) 'lower bounds =',lbound(b) write (*,91) 'b(20,100) =',b(20,100) 91 format (a,2(1x,i0)) end subroutine end module user1 ! ---------------------- program accessing_arrays ! bounds in a routine use user1 integer,pointer :: a(:,:) allocate ( a(0:20,-100:100) ) a(20,100) = 20000 call asub( a ) end program Outputs: upper bounds = 20 100 lower bounds = 0 -100 b(20,100) = 20000 =================================================================== 32. CANT pass fixed array declaration bounds to routine. ! ---------------------- program fixed_array ! bounds accessed in routine via pointer use user1 ! same as CANT #31's user1 module integer,target :: a(0:20,-100:100) integer,pointer :: b(:,:) b => a ! effectively equivalences (a,b) b(20,100) = 20000 call asub( b ) ! use of pointer passes bounds on stack end program Outputs: same as CANT #31 =================================================================== 33. CANT write a SEMI-generic sort for various kinds of data equivalent to existing library sort whose use is shown, whereas Fortran user can duplicate sortqq routine. ! ------------------------------------- program sort_various ! kinds of data use dflib integer(1) :: i1(5) = [ 5,4,3,2,1] integer(2) :: i2(5) = [ 5,4,3,2,1] integer :: i4(5) = [ 5,4,3,2,1] real :: r4(5) = [ 5,4,3,2,1] real(8) :: r8(5) = [ 5,4,3,2,1] character(20) :: s(5) = [ 'z','Z','a','A','1'] call sortqq (loc(i1), 5, srt$integer1) ! bytes call sortqq (loc(i2), 5, srt$integer2) ! half-words call sortqq (loc(i4), 5, srt$integer4) ! words call sortqq (loc(r4), 5, srt$real4) ! real call sortqq (loc(r8), 5, srt$real8) ! real dp call sortqq (loc(s), 5, 20) ! strings with len=20 do n = 1,5 write (*,91) i1(n),i2(n),i4(n),r4(n),r8(n),s(n) format(3i3,2f5.1,2x,a) end do end program Outputs: 1 1 1 1.0 1.0 1 2 2 2 2.0 2.0 A 3 3 3 3.0 3.0 Z 4 4 4 4.0 4.0 a 5 5 5 5.0 5.0 z =================================================================== 34. CANT transfer data from one array to another that has different shape and order with 1 statement. ! ------------------------ program reshape_reorder_array_data ! demo Fortran -> C array integer :: f(2,3,3) = [1:18] integer :: c(3,3,2) c = reshape(source=f, shape=[3,3,2], order=[3,2,1]) write (*,91) (((c(k,j,i),i=1,2),j=1,3),k=1,3) ! verify C array 91 format (18i3) end program Output: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 =================================================================== 35. CANT pass constants var. size array argument to external routine. ! -------------------------- program pass_constants_array interface ; subroutine my_sub(v) ; integer :: v(:) ; end end interface call my_sub( [1,22] ) call my_sub( [1,22,333] ) end program ! ----------------------- subroutine my_sub(values) integer :: values(:) write (*,'(3I4)') values end subroutine Outputs: 1 22 1 22 333 =================================================================== 36. CANT input bit patterns DIRECTLY into variables. ! ----------------------- program decode_bits_input integer(1) :: i1 integer(2) :: i2 integer :: i4 open (1,file='test.dat') write (1,91) -1_1, -1_2, -1 ! 8,16,32 bit size specifiers write (*,91) -1_1, -1_2, -1 ! show record's bit patterns rewind (1) read (1,91) i1,i2,i4 ! input bit patterns into integers write (*,91) i1,i2,i4 ! show bit patterns input write (*,*) i1,i2,i4 ! show integer values input 91 format (b8,1x,b16,1x,b32) ! uses bits "b" specifier end program Outputs to console: 11111111 1111111111111111 11111111111111111111111111111111 11111111 1111111111111111 11111111111111111111111111111111 -1 -1 -1 =================================================================== 37. CANT write semi-generic binary search function for various kinds of 1D sorted data, whereas Fortran user can duplicate bsearchqq library routine demo'ed below. ! --------------------- program binary_search ! for real,integer data use dflib real(8) :: x=3001, rv(10000) = [1:20000:2] ! 1,3,5,,,, 19999 integer :: k=501, iv(500) = [1:2500:5] ! 1,6,11,,, 2496 write (*,*) bsearchqq (loc(x),loc(rv),size(rv),srt$real8) write (*,*) bsearchqq (loc(k),loc(iv),size(iv),srt$integer4) end program Outputs: 1501 101 =================================================================== 38. CANT DIRECTLY update a READ-ONLY file because there is no access to file's attributes. ! --------------------------------- program update_write_protected_file use dflib n = SetFileAccessqq('test.dat',File$Normal) ! allow write open (1,file='test.dat',position='append') do n = 1,5 write (1,*) 'record ',n ! add 5 text records to file. end do n = SetFileAccessqq('test.dat',File$ReadOnly) ! protect file close (1,status='delete') ! bravely check file cant be deleted end program Output: close error, ACCESS DENIED =================================================================== 39. CANT declare a variable as volatile, (compiler is not allowed to make any assumption about its contents at any time). ! ---------------------- integer,volatile :: timewords(8) =================================================================== 40. CANT overload existing or declare new syntax operators. Below demos overloading existing logical operator .AND. allowing its use with integers, ie: kk.and.jjj (CVF/Intel already allow ANDs with integers as an extension). ! ---------------------- module bitwise interface operator(.and.) ! overload existing .AND. operator module procedure and4 end interface contains elemental integer function and4(x,y) integer, intent(in) :: x, y and4 = iand(x, y) end function end module bitwise ! ---------------------- program demo_overload_and use bitwise write(*,*) 5.and.3 end program Output: 1