c cpointers.f c c

      program pointer_test
      implicit none
c
c   Demonstrate use of pointers to manipulate sections of arrays
c   Notice that once associated, p2 and p1 are treated like normal
c   arrays in the program
c
c    John Mahaffy 4/17/96
c
c
      real, target :: a(10,10)
c
c
      real, pointer :: p2(:,:), p1(:)
c
      integer iub, i, j
c
c   Define a generic interface to permit output of information
c   for either rank 1 or rank 2 arrays.  You need such an interface
c   in any case to get some of the associated pointers to pass their
c   contents efficiently (quietly passes a skip factor (stride).
c   Without an interface our compiler allocates space and makes
c   a copy of the contents of the pointer array to guarantee that the
c   sequential elements in the passed array are in adjacent memory
c   locations
c
c
      interface parray
c
            subroutine p2array (a,title,aname)
            real a(:,:)
c
            character*(*) title,aname
c
            end subroutine
            subroutine p1array (a,title,aname)
            real a(:)
            character*(*) title,aname
            end subroutine
      end interface
c
c  Open a file to contain results printed to the screen
c
      open (9,file='pointers.out')
c
c    Set some initial values
c
      do    i=1,10
         do j=1,10
            a(i,j)=1000*i+j
         enddo
      enddo
c
      call parray(a, 'original array', 'a')
c
c   p2 becomes a rank 2 array associated with part of "a"
c
      p2 => a(3:6,7:9)
      call parray (p2,'p2 => a(3:6,7:9) ','p2')
c
c   add 800 to all elements in p2
c
      p2 = -p2 - 800
      call parray (p2,'results of p2 = -p2 - 800 ','p2')
c
c   What have we done to the array "a" ?
c
      call parray(a, 'Here''s what happened to "a" ', 'a')
c
c   Associate p1 with column 3 of "a"
c
      p1 => a(:,3)
      call parray (p1, 'Associate p1 with column 3: p1 => a(:,3)','p1')
c
c   Modify  p1
c     
      iub = ubound(p1,dim=1)
c     
      do 40 i=1,iub
   40 p1(i) = i**2
      call parray (p1,'Modify p1 with the equation: p1(i) = i**2','p1')
c
c   Now associate p1 with row 8 of "a"
c
      p1 => a(8,:)
      call parray (p1, 'Associate p1 with row 8:  p1 => a(8,:)','p1')
c
c   Modify  p1
c
      iub=ubound(p1,dim=1)
      do 60 i=1,iub
   60 p1(i) = i
      call parray (p1, 'Modify p1 with the equation: p1(i) = i ','p1')
c
c   Now what does the array "a" look like ?
c
      call parray(a, '"a" after all changes to p1 and p2 ', 'a')
c
      stop
      end
c=======================================================================
      subroutine p2array (a,title,aname)
      implicit none
c
c    Print out a 2-D array with header information
c
c    John Mahaffy 4/17/96
c
c   INPUT arguments
c
c   a     -   array to be printed
c   title -   title information for the output
c   aname -   name of the array being printed
c
c
c   The use of colons in the following type declaration is
c   necessary so that the subroutine will look for some
c   hidden arguments passed as a result of an interface statement
c   in the calling routine.   These hidden arguments provide
c   detailed information on the shape of the array.
c
      real a(:,:)
c
      character*(*) title,aname
      character*(4) clb1,cub1,clb2,cub2
      character*32 info
      integer  lb1, ub1, lb2, ub2, i
c
c   Build a header giving the array name and shape
c     
      lb1 = lbound(a ,dim=1)
c     
      ub1 = ubound(a ,dim=1)
      lb2 = lbound(a ,dim=2)
      ub2 = ubound (a ,dim=2)
      write(clb1,2001) lb1
      write(cub1,2001) ub1
      write(clb2,2001) lb2
      write(cub2,2001) ub2
c
      info= aname//'('//trim(adjustl(clb1))//':'
     &      //trim(adjustl(cub1))//','
     &      //trim(adjustl(clb2))//':'
     &      //trim(adjustl(cub2))//') ='
c
      write(*,2000) repeat('=',80)
      write(*,2000) title
      write(*,2000) repeat('-',80)
      write(*,2000) info
c
      write(9,2000) repeat('=',80)
      write(9,2000) title
      write(9,2000) repeat('-',80)
      write(9,2000) info
c
      do i = lb1,ub1
         write(*,2002) i, a(i,:)
         write( 9,2002) i, a(i,:)
      enddo
 2000 format (a)
 2001 format (i4)
 2002 format('row',i4,10f7.0,(7x,10f7.0))
      end
c=======================================================================
      subroutine p1array (a,title,aname)
      implicit none
c
c    Print out a 1-D array with header information
c
c
c    John Mahaffy 4/17/96
c
c   INPUT arguments
c
c   a     -   array to be printed
c   title -   title information for the output
c   aname -   name of the array being printed
c
c
c   The use of colon  in the following type declaration is
c   necessary so that the subroutine will look for some
c   hidden arguments passed as a result of an interface statement
c   in the calling routine. These hidden arguments provide
c   detailed information on the shape of the array
c
      real a(:)
c
      character*(*) title,aname
      character*(4) clb1,cub1
      character*32 info
      integer  lb1, ub1
c
c   Build a header giving the array name and shape
c
      lb1 = lbound(a ,dim=1)
      ub1 = ubound(a ,dim=1)
      write(clb1,2001) lb1
      write(cub1,2001) ub1
c
      info= aname//'('//trim(adjustl(clb1))//':'
     &      //trim(adjustl(cub1))//')  '
c
      write(*,2000) repeat('=',80)
      write(*,2000) title
      write(*,2000) repeat('-',80)
      write(*,2000) info
c
      write(9,2000) repeat('=',80)
      write(9,2000) title
      write(9,2000) repeat('-',80)
      write(9,2000) info
c
         write(*,2002)  a
         write( 9,2002)  a
 2000 format (a)
 2001 format (i4)
 2002 format(10f7.0)
      end
c
c c