#!/usr/bin/perl

$t="
c-------------------------------------------------
      program test1
c23456789-----------------------------------------
c      implicit none
c        10        20        30        40        50        60         71COMMENT
      real xa(9),a(9),b(9)
      real xb(1)
      real xc(3,3)
      equivalence (xb(1),xa(3))
      common /comblk1/ zz(10)

100   continue

c...... input icode
      write(6,'(a,\$)')' icode=? (9 to stop) '
      read(5,*) icode
      if(icode.ge.9) stop

c..... another way to print the bits
      if(icode.eq.1) then
      a=5.0
      call printbits(a,a)
      b=-123.456
      call printbits(b,b)
      i=12345678
      call printbits(i,i)
      endif

c..... show memory mapping
      if(icode.eq.2) then
      do i=1,9
      xa(i)=i
      enddo
      call pmat(xa,3)
      call pmat(xa,2)
      write(0,*)' call pmat(xb,2) --> equivalence'
      call pmat(xb,2)     !..... demo equivalence
      call pmat(ax,2)     !..... force garbage or crash
      endif

c.....  crash1
      if(icode.eq.3) then
      call xcopy(a,b,9)
      call xcopy(a,b,99)
      call xcopy(a,b,999)
      endif

c.....  crash2
      if(icode.eq.4) then
      call xcopy(a,b,c,9)
      endif

c.....  crash3
      if(icode.eq.5) then
      call xcopy(a,9)
      endif

c.....  common block
      if(icode.eq.6) then
      do i=1,10
      zz(i)=i
      enddo
      call pcommon()  
      endif

c.....  f90 reshaping
      if(icode.eq.7) then
      do i=1,3
      do j=1,3
      xc(j,i)=0.0
      enddo
      enddo
      xc(1,1)=11.0
      xc(2,1)=21.0
      xc(1,2)=12.0
      xc(2,2)=22.0
      write(0,*)'with right dimensions '
      call pmat(xc,3)
      write(0,*)'wrong way to pass to smaller array'
      call pmat(xc,2)
      write(0,*)'with f90 reshaping'
      call pmat(xc(1:2,1:2),2)
      endif

      goto 100

      end
c-------------------------------------------------
      subroutine pcommon()
c-------------------------------------------------
      common /comblk1/ z1(5),z2(5)
      do i=1,5
      write(6,*)' z1(',i,')= ',z1(i),'  z2(',i,')= ',z2(i)
      enddo
      return
      end
c-------------------------------------------------
      subroutine xcopy(a,b,n)
c-------------------------------------------------
      real a(n),b(n)
      write(0,*)' xcopy n= ',n
      do i=1,n
      b(i)=a(i)
      enddo
      return
      end
c-------------------------------------------------
      subroutine pmat(a,n)
c-------------------------------------------------
      real a(n,n)
      write(6,*)'pmat n= ',n

      if(n.eq.2) then
      write(6,*)' a(1,1)  ',a(1,1)
      write(6,*)' a(2,1)  ',a(2,1)
      write(6,*)' a(1,2)  ',a(1,2)
      write(6,*)' a(2,2)  ',a(2,2)
      endif

      if(n.eq.3) then
      write(6,*)' a(1,1)  ',a(1,1)
      write(6,*)' a(2,1)  ',a(2,1)
      write(6,*)' a(3,1)  ',a(3,1)
      write(6,*)' a(1,2)  ',a(1,2)
      write(6,*)' a(2,2)  ',a(2,2)
      write(6,*)' a(3,2)  ',a(3,2)
      write(6,*)' a(1,3)  ',a(1,3)
      write(6,*)' a(2,3)  ',a(2,3)
      write(6,*)' a(3,3)  ',a(3,3)
      endif

      return
      end
c-------------------------------------------------
      subroutine printbits(a,k)
c-------------------------------------------------
      implicit none
      real a,aa
      integer k,i,m,l,kk
      character*32 cstring

      write(6,'(a,1x,i20,1x,g20.10)')'k,a ',k,a

      !..... get sign
      cstring(1:1)='0'
      if(k.lt.0) then
      k=-k
      cstring(1:1)='1'
      endif

      do i=1,31
      m=mod(k,2)    !.... modulus function returns the remainder
      l=32-i+1
      cstring(l:l)='0'
      if(m.eq.1)cstring(l:l)='1'
      k=k/2    !....... all integers, so its truncated
      enddo
      write(6,*)' printbits ',cstring
      write(6,*)' ',cstring(1:1),' ',cstring(2:9),' ',cstring(10:32)

      return
      end
      ";

system("/bin/rm -vf a.out tmp.f");   #...... remove stale files
open(FF,">tmp.f");  print FF $t; close(FF);
system("gfortran -w tmp.f");
if( -e "a.out"){  system("./a.out"); }