Advanced Fortran 90

Timothy H. Kaiser,Ph.D.

SDSC/NPACI
tkaiser@scsd.edu
http://www.sdsc.edu/~tkaiser/f90.html


Introduction


Who am I?

  • Wide experience background
  • 20 years programming
  • Languages
  • Beta tester of several Fortran compilers
  • I have had the chance to make just about every mistake in the book and some that ain't

  • The mind of the language writers

    What were they thinking?
     
  • Enable portable codes
  • More reliable programs
  • Getting away from underlying hardware
  • Move toward parallel programming
  • Run old programs
  • Ease of programming
  • Recover C and C++ users

  •  

    Why Fortran?

    "I don't know what the technical characteristics of
    the standard language for scientific and engineering
    computation in the year 2000 will be... but I know it
    will be called Fortran."  John Backus
  • Language of choice for Scientific programming
  • Large installed user base.
  • Fortran 90 has most of the features of C . . . and then some
  • Principal language on the IBM SP Supercomputer and all Cray machines
  • The compilers produce better programs

  •  


    Justification of topics


    Classification of topics


    Listing of topics covered

    1. Listing of topics covered
    2. Format for our talk
    3. What is a Genetic Algorithm
    4. Simple algorithm for a GA
    5. Our example problem
    6. Start of real Fortran 90 discussion
    7. Comparing a FORTRAN 77 routine to a Fortran 90 routine
    8. Obsolescent features
    9. New source Form (and related things)
    10. New data declaration method
    11. Kind facility
    12. Modules
    13. Module functions and subroutines
    14. Allocatable arrays (the basics)
    15. Passing arrays to subroutines
    16. Interface for passing arrays
    17. Optional arguments and intent
    18. Derived data types
    19. Using defined types
    20. User defined operators
    21. Recursive functions introduction
    22. Fortran 90 recursive functions
    23. Pointers
    24. Function and subroutine overloading
    25. Fortran Minval and Minloc routines
    26. Pointer assignment
    27. More pointer usage, association and nullify
    28. Pointer usage to reference an array
    29. Data assignment with structures
    30. Using the user defined operator
    31. Passing arrays with a given arbitrary lower bounds
    32. Using pointers to access sections of arrays
    33. Allocating an array inside a subroutine
    34. Our fitness function
    35. Linked lists
    36. Linked list usage
    37. Our map representation
    38. Non advancing and character I/O
    39. Date and time functions
    40. Internal I/O
    41. Inquire function
    42. Namelist
    43. Vector valued functions
    44. Complete source for recent discussions
    45. Some array specific intrinsic functions
    46. The rest of our GA
    47. Compiler Information
    48. Fortan 95
    49. Summary
    50. References


    Format for our talk


    What is a Genetic Algorithm

  • A "suboptimization" system
  • Requirements
  • Find solutions to problems by Darwinian evolution
    Potential solutions ar though of as living entities in a population
    The strings are the genetic codes for the individuals
    Fittest individuals are allowed to survive to reproduce


    Simple algorithm for a GA

  • Generate a initial population, a collection of strings
  • do for some time
  • end do



  •  

    Our example problem

  • Instance
  • Notes

  • Start of real Fortran 90 discussion

     

    A preview:  Comparing a FORTRAN 77 routine to a Fortran 90 routine

  • The routine is one of the random number generators from:  Numerical Recipes, The Art of Scientific Computing. Press, Teukolsky, Vetterling and Flannery.  Cambridge University Press 1986.
  • Changes
  •  
     
        function ran1(idum) 
            real ran1 
            integer idum  
            real r(97) 
            parameter ( m1=259200,ia1=7141,ic1=54773) 
            parameter ( m2=134456,ia2=8121,ic2=28411) 
            parameter ( m3=243000,ia3=4561,ic3=51349) 
            integer j 
            integer iff,ix1,ix2,ix3 
            data iff /0/ 
            if (idum<0.or.iff.eq.0)then 
                rm1=1.0/m1 
                rm2=1.0/m2 
                iff=1 
                ix1=mod(ic1-idum,m1) 
                ix1=mod(ia1*ix1+ic1,m1) 
                ix2=mod(ix1,m2) 
                ix1=mod(ia1*ix1+ic1,m1) 
                ix3=mod(ix1,m3) 
                do 11 j=1,97 
                    ix1=mod(ia1*ix1+ic1,m1) 
                    ix2=mod(ia2*ix2+ic2,m2) 
                    r(j)=(real(ix1)+real(ix2)*rm2)*rm1 
     11           continue 
                idum=1 
            endif 
            ix1=mod(ia1*ix1+ic1,m1) 
            ix2=mod(ia2*ix2+ic2,m2) 
            ix3=mod(ia3*ix3+ic3,m3) 
            j=1+(97*ix3)/m3 
            if(j>97.or.j<1)then 
                write(*,*)' error in ran1 j=',j 
                stop 
            endif 
            ran1=r(j) 
            r(j)=(real(ix1)+real(ix2)*rm2)*rm1 
            return 
         end
    module ran_mod  
    contains  
         function ran1(idum) 
            use numz 
            implicit none  !note after use statement 
            real(b8) ran1 
            integer, intent(inout), optional :: idum 
            real(b8) r(97),rm1,rm2 
            integer, parameter :: m1=259200,ia1=7141,ic1=54773 
            integer, parameter :: m2=134456,ia2=8121,ic2=28411 
            integer, parameter :: m3=243000,ia3=4561,ic3=51349 
            integer j 
            integer iff,ix1,ix2,ix3 
            data iff /0/ 
            save ! corrects a bug in the original routine 
            if(present(idum))then 
              if (idum<0.or.iff.eq.0)then 
                rm1=1.0_b8/m1 
                rm2=1.0_b8/m2 
                iff=1 
                ix1=mod(ic1-idum,m1) 
                ix1=mod(ia1*ix1+ic1,m1) 
                ix2=mod(ix1,m2) 
                ix1=mod(ia1*ix1+ic1,m1) 
                ix3=mod(ix1,m3) 
                do j=1,97 
                    ix1=mod(ia1*ix1+ic1,m1) 
                    ix2=mod(ia2*ix2+ic2,m2) 
                    r(j)=(real(ix1,b8)+real(ix2,b8)*rm2)*rm1 
                enddo 
                idum=1 
              endif 
            endif 
            ix1=mod(ia1*ix1+ic1,m1) 
            ix2=mod(ia2*ix2+ic2,m2) 
            ix3=mod(ia3*ix3+ic3,m3) 
            j=1+(97*ix3)/m3 
            if(j>97.or.j<1)then 
                write(*,*)' error in ran1 j=',j 
                stop 
            endif 
            ran1=r(j) 
            r(j)=(real(ix1,b8)+real(ix2,b8)*rm2)*rm1 
            return 
         end function ran1 
     

    Obsolescent features

    The following are available in Fortran 90. On the other hand, the concept "obsolescence" is introduced. This means that some constructs may be removed in the future.
  •      Arithmetic IF-statement
  •      Control variables in a DO-loop which are floating point or double-precision floating-point
  •      Terminating several DO-loops on the same statement
  •      Terminating the DO-loop in some other way than with CONTINUE or END DO
  •      Alternate return
  •      Jump to END IF from an outer block
  •      PAUSE
  •      ASSIGN and assigned GOTO and assigned FORMAT , that is the whole "statement number variable" concept.
  •      Hollerith editing in FORMAT.
  •  


    New source form (and related things)

    !23456789
    program darwin
         real a(10), b(10), c(10), d(10), e(10), x, y
         integer odd(5),even(5)
         write(*,*)"starting ",&  ! this line is continued by using "&"
                   "darwin"       ! this line in a continued from above
         x=1; y=2; write(*,*)x,y  ! multiple statement per line -- rarely a good idea
         do i=1,10    ! statement lable is not required for do
            e(i)=i
         enddo
         odd= (/ 1,3,5,7,9 /)  ! array assignment
         even=(/ 2,4,6,8,10 /) ! array assignment
         a=1          ! array assignment, every element of a = 1
         b=2
         c=a+b+e      ! element by element assignment
         c(odd)=c(even)-1  ! can use arrays of indices on both sides
         d=sin(c)     ! element by element application of intrinsics
         write(*,*)d
         write(*,*)abs(d)  ! many intrinsic functions are generic
     a_do_loop : do i=1,10
                   write(*,*)i,c(i),d(i)
                 enddo a_do_loop
         do
            if(c(10) < 0.0 ) exit
            c(10)=c(10)-1
         enddo
         write(*,*)c(10)
         do while (c(9) > 0)
            c(9)=c(9)-1
         enddo
         write(*,*)c(9)
    end program

    New data declaration method

  • Motivation
  • One variable can have several attributes
  • Requires Fortran 90 to  have a new statement form

  •  
        integer, parameter :: in2 = 14
        real, parameter :: pi = 3.141592653589793239
        real, save, dimension(10) :: cpu_times,wall_times
    !****    the old way of doing the same    ****!
    !****    real cpu_times(10),wall_times(10) ****!
    !****    save cpu_times, wall_times        ****!
     
  • Other Attributes

  • Kind facility

  • Motivation
  • Digits of precision for machine and data type
     
    Machine/Data Type     Real       Double Precision
    IBM (SP)       6           15
    Cray (T90)     15           33
    Cray (T3E)     15            15
    ********* or *********
     

    sp001 % cat darwin.f
    program darwin
    ! e has at least 4 significant digits
      real(selected_real_kind(4))e
    ! b8 will be used to define reals with 14 digits
      integer, parameter:: b8 = selected_real_kind(14)
      real(b8), parameter :: pi = 3.141592653589793239_b8 ! note usage of _b8
                                                          ! with  a constant
                                                          ! to force precision
     e= 2.71828182845904523536
      write(*,*)"starting ",&  ! this line is continued by using "&"
                "darwin"       ! this line in a continuation from above
      write(*,*)"pi has ",precision(pi)," digits precision ",pi
      write(*,*)"e has   ",precision(e)," digits precision ",e
    end program

      % darwin
     starting darwin
     pi has  15  digits precision  3.14159265358979312
     e has    6  digits precision  2.718281746
    sp001 %
     


    Modules

  • Motivation:
  • Modules can contain:
  • You "include" a module with a "use" statement

  •  

    module numz
      integer, parameter:: b8 = selected_real_kind(14)
      real(b8), parameter :: pi = 3.141592653589793239_b8
      integer gene_size
    end module

    program darwin
      use numz
      implicit none   ! now part of the standard, put it after the use statements
      write(*,*)"pi has ",precision(pi)," digits precision ",pi
      call set_size()
      write(*,*)"gene_size=",gene_size
    end program

    subroutine set_size
      use numz
      gene_size=10
    end subroutine set_size
     

     pi has  15  digits precision  3.14159265358979312
     gene_size= 10

     


    Module functions and subroutines

  • Motivation:
  • Example is a random number package:
  • module ran_mod
    ! module contains three functions
    ! ran1 returns a uniform random number between 0-1
    ! spread returns random number between min - max
    ! normal returns a normal distribution

    contains
        function ran1()  !returns random number between 0 - 1
            use numz
            implicit none
            real(b8) ran1,x
            call random_number(x) ! built in fortran 90 random number function
            ran1=x
        end function ran1

        function spread(min,max)  !returns random number between min - max
            use numz
            implicit none
            real(b8) spread
            real(b8) min,max
            spread=(max - min) * ran1() + min
        end function spread

        function normal(mean,sigma) !returns a normal distribution
            use numz
            implicit none
            real(b8) normal,tmp
            real(b8) mean,sigma
            integer flag
            real(b8) fac,gsave,rsq,r1,r2
            save flag,gsave
            data flag /0/
            if (flag.eq.0) then
            rsq=2.0_b8
                do while(rsq.ge.1.0_b8.or.rsq.eq.0.0_b8) ! new from for do
                    r1=2.0_b8*ran1()-1.0_b8
                    r2=2.0_b8*ran1()-1.0_b8
                    rsq=r1*r1+r2*r2
                enddo
                fac=sqrt(-2.0_b8*log(rsq)/rsq)
                gsave=r1*fac
                tmp=r2*fac
                flag=1
            else
                tmp=gsave
                flag=0
            endif
            normal=tmp*sigma+mean
            return
        end function normal

    end module ran_mod
     



     Exersize 1:  Write a program that returns 10 uniform random numbers.

    Allocatable arrays (the basics)

  • Motivation:
  • Allocatable arrays allow us to set the size at run time
  • We set the size of the array using the allocate statement
  • We may want to change the lower bound for an array

  •  
  • A simple example:

  •  
    module numz
      integer, parameter:: b8 = selected_real_kind(14)
      integer gene_size,num_genes
      integer,allocatable :: a_gene(:),many_genes(:,:)
    end module

    program darwin
        use numz
        implicit none
        integer ierr
        call set_size()
        allocate(a_gene(gene_size),stat=ierr) !stat= allows for an error code return
        if(ierr /= 0)write(*,*)"allocation error"  ! /= is .ne.
        allocate(many_genes(gene_size,num_genes),stat=ierr)  !2d array
        if(ierr /= 0)write(*,*)"allocation error"
        write(*,*)lbound(a_gene),ubound(a_gene) ! get lower and upper bound
                                                ! for the array
        write(*,*)size(many_genes),size(many_genes,1) !get total size and size
                                                      !along 1st dimension
        deallocate(many_genes) ! free the space for the array and matrix
        deallocate(a_gene)
        allocate(a_gene(0:gene_size)) ! now allocate starting at 0 instead of 1
        write(*,*)allocated(many_genes),allocated(a_gene) ! shows if allocated
        write(*,*)lbound(a_gene),ubound(a_gene)
    end program
     

    subroutine set_size
        use numz
        write(*,*)'enter gene size:'
        read(*,*)gene_size
        write(*,*)'enter number of genes:'
        read(*,*)num_genes
    end subroutine set_size
     

      enter gene size:
    10
     enter number of genes:
    20
               1          10
             200          10
     F T
               0          10
      



     

    Passing arrays to subroutines

  • There are several ways to specify arrays for subroutines
  • Example
  • subroutine arrays(an_explicit_shape_array,&
                      i                      ,& !note we pass all bounds except the last
                      an_assumed_size_array  ,&
                      an_assumed_shape_array)
    ! Explicit shape
        integer, dimension(8,8)::an_explicit_shape_array
    ! Assumed size
        integer, dimension(i,*)::an_assumed_size_array
    ! Assumed Shape
        integer, dimension(:,:)::an_assumed_shape_array
        write(*,*)sum(an_explicit_shape_array)
        write(*,*)lbound(an_assumed_size_array) ! why does sum not work here?
        write(*,*)sum(an_assumed_shape_array)
    end subroutine
     


    Interface for passing arrays

  • Warning!!  When passing assumed shape arrays as arguments you must provide an interface
  • !!!!Warning!!!!  The compiler may not tell you that you need an interface

  •  

    module numz
        integer, parameter:: b8 = selected_real_kind(14)
        integer,allocatable :: a_gene(:),many_genes(:,:)
    end module

    module face
        interface fitness
            function fitness(vector)
            use numz
            implicit none
            real(b8) fitness
            integer, dimension(:) ::  vector
            end function fitness
        end interface
    end module

    program darwin
        use numz
        use face
        implicit none
        integer i
        integer vect(10) ! just a regular array
        allocate(a_gene(10));allocate(many_genes(3,10))
        a_gene=1  !sets every element of a_gene to 1
        write(*,*)fitness(a_gene)
        vect=8
        write(*,*)fitness(vect) ! also works with regular arrays
        many_genes=3  !sets every element to 3
        many_genes(1,:)=a_gene  !sets column 1 to a_gene
        many_genes(2,:)=2*many_genes(1,:)
        do i=1,3
            write(*,*)fitness(many_genes(i,:))
        enddo
        write(*,*)fitness(many_genes(:,1))  !go along other dimension
    !!!!write(*,*)fitness(many_genes)!!!!does not work
    end program

    function fitness(vector)
        use numz
        implicit none
        real(b8) fitness
        integer, dimension(:)::  vector ! must match interface
        fitness=sum(vector)
    end function



    Exersize 2:  Run this program using the "does not work line".  Why?  Using intrinsic functions make it work?
    Exersize 3:  Prove that f90 does not "pass by address".

    Optional arguments and intent

  • Motivation:
  • Two examples
  • module ran_mod
    ! ran1 returns a uniform random number between 0-1
    ! the seed is optional and used to reset the generator
    contains
       function ran1(my_seed)
          use numz
          implicit none
          real(b8) ran1,r
          integer, optional ,intent(in) :: my_seed  ! optional argument not changed in the routine
          integer,allocatable :: seed(:)
          integer the_size,j
          if(present(my_seed))then            ! use the seed if present
              call random_seed(size=the_size) ! how big is the intrisic seed?
              allocate(seed(the_size))        ! allocate space for seed
              do j=1,the_size                 ! create the seed
                 seed(j)=abs(my_seed)+(j-1)   ! abs is generic
              enddo
              call random_seed(put=seed)      ! assign the seed
              deallocate(seed)                ! deallocate space
          endif
          call random_number(r)
          ran1=r
      end function ran1
    end module

    program darwin
        use numz
        use ran_mod          ! interface required if we have
                             ! optional or intent arguments
        real(b8) x,y
        x=ran1(my_seed=12345) ! we can specify the name of the argument
        y=ran1()
        write(*,*)x,y
        x=ran1(12345)         ! with only one optional argument we don't need to
        y=ran1()
        write(*,*)x,y
    end program
     

  • Intent is a hint to the compiler to enable optimization

  • Derived data types

  • Motivation:
  • Example
  •   Again modules are a good place for data type definitions
  • module galapagos
        use numz
        type thefit !the name of the type
          sequence  ! sequence forces the data elements
                    ! to be next to each other in memory
                    ! where might this be useful?
          real(b8) val   ! our result from the fitness function
          integer index  ! the index into our collection of genes
        end type thefit
    end module

     

    Using defined types

  • Use the % to reference various components of the derived data type
  • program darwin
        use numz
        use galapagos ! the module that contains the type definition
        use face      ! contains various interfaces
     implicit none
    ! define an allocatable array of the data type
    ! than contains an index and a real value
        type (thefit),allocatable ,target :: results(:)
    ! create a single instance of the data type
        type (thefit) best
        integer,allocatable :: genes(:,:) ! our genes for the genetic algorithm
        integer j
        integer num_genes,gene_size
        num_genes=10
        gene_size=10
        allocate(results(num_genes))         ! allocate the data type
                                             ! to hold fitness and index
        allocate(genes(num_genes,gene_size)) ! allocate our collection of genes
        call init_genes(genes)               ! starting data
        write(*,'("input")') ! we can put format in write statement
        do j=1,num_genes
           results(j)%index=j
           results(j)%val=fitness(genes(j,:)) ! just a dummy routine for now
           write(*,"(f10.8,i4)")results(j)%val,results(j)%index
        enddo
    end program
     


    User defined operators

  • Motivation
  • Example:
  • Two step process to define operators
  • module sort_mod
    !defining the interfaces
      interface operator (.lt.)  ! overloads standard .lt.
        module procedure theless ! the function that does it
      end interface

      interface operator (.gt.)   ! overloads standard .gt.
        module procedure thegreat ! the function that does it
      end interface

      interface operator (.ge.)  ! overloads standard .ge.
        module procedure thetest ! the function that does it
      end interface

      interface operator (.converged.)  ! new operator
        module procedure index_test     ! the function that does it
      end interface

    contains      ! our module will contain
                  ! the required functions
     

      function theless(a,b) ! overloads < for the type (thefit)
        use galapagos
        implicit none
        type(thefit), intent (in) :: a,b
        logical theless           ! what we return
        if(a%val < b%val)then     ! this is where we do the test
            theless=.true.
        else
            theless=.false.
        endif
        return
      end function theless

      function thegreat(a,b) ! overloads > for the type (thefit)
        use galapagos
        implicit none
        type(thefit), intent (in) :: a,b
        logical thegreat
        if(a%val > b%val)then
            thegreat=.true.
        else
            thegreat=.false.
        endif
        return
      end function thegreat
     

    function thetest(a,b)   ! overloads >= for the type (thefit)
        use galapagos
        implicit none
        type(thefit), intent (in) :: a,b
        logical thetest
        if(a%val >= b%val)then
            thetest=.true.
        else
            thetest=.false.
        endif
        return
    end function thetest
     

    function index_test(a,b) ! defines a new operation for the type (thefit)
        use galapagos
        implicit none
        type(thefit), intent (in) :: a,b
        logical index_test
        if(a%index > b%index)then   ! check the index value for a difference
            index_test=.true.
        else
            index_test=.false.
        endif
        return
    end function index_test



     

    Recursive functions introduction

  • Notes
  • Motivation
  • Algorithm of searching for minimum of an array
        function findmin(array)
            is size of array 1?
               min in the array is first element
            else
               find minimum in left half of array using findmin function
               find minimum in right half of array using findmin function
               global minimum is min of left and right half
        end function

    Fortran 90 recursive functions

  • Recursive functions should have an interface
  • The result and recursive keywords are required as part of the function definition

  •  
     
  • Example is a function finds the minimum value for an array
  • recursive function realmin(ain) result (themin)
    ! recursive and result are required for recursive functions
        use numz
        implicit none
        real(b8) themin,t1,t2
        integer n,right
        real(b8) ,dimension(:) :: ain
        n=size(ain)
        if(n == 1)then
           themin=ain(1) ! if the size is 1 return value
        return
        else
          right=n/2
          t1=realmin(ain(1:right))   ! find min in left half
          t2=realmin(ain(right+1:n)) ! find min in right half
          themin=min(t1,t2)          ! find min of the two sides
         endif
    end function
     

  • Example 2 is the same except the input data is our derived data type

  • !this routine works with the data structure thefit not reals
    recursive function typemin(ain) result (themin)
        use numz
     use sort_mod
     use galapagos
     implicit none
     real(b8) themin,t1,t2
     integer n,right
        type (thefit) ,dimension(:) :: ain ! this line is different
     n=size(ain)
     if(n == 1)then
         themin=ain(1)%val  ! this line is different
      return
     else
      right=n/2
      t1=typemin(ain(1:right))
      t2=typemin(ain(right+1:n))
      themin=min(t1,t2)
     endif
    end function
     

    Pointers

     
  • Motivation
  • Notes
  •  
  • First pointer example
  • recursive function pntmin(ain) result (themin) ! return a pointer
     use numz
     use galapagos
     use sort_mod ! contains the < operator for thefit type
     implicit none
     type (thefit),pointer:: themin,t1,t2
     integer n,right
        type (thefit) ,dimension(:),target :: ain
     n=size(ain)
     if(n == 1)then
         themin=>ain(1) !this is how we do pointer assignment
      return
     else
      right=n/2
      t1=>pntmin(ain(1:right))
      t2=>pntmin(ain(right+1:n))
      if(t1 < t2)then; themin=>t1; else; themin=>t2; endif
     endif
    end function


    Exercise 4:  Carefully write a recursive N! program. 

    Function and subroutine overloading

  • Motivation
  • Notes:
  • Example
  •  

    ! note we have two functions within the same interface
    ! this is how we indicate function overloading
    ! both functions are called "findmin" in the main program
    interface findmin

    !
    ! the first is called with an array of reals as input
            recursive function realmin(ain) result (themin)
              use numz
           real(b8) themin
              real(b8) ,dimension(:) :: ain
            end function

    ! the second is called with a array of data structures as input
         recursive function typemin(ain) result (themin)
              use numz
        use galapagos
           real(b8) themin
              type (thefit) ,dimension(:) :: ain
         end function
        end interface
     
     

  • Example usage

  • program darwin
        use numz
        use ran_mod
        use galapagos ! the module that contains the type definition
        use face      ! contains various interfaces
        use sort_mod  ! more about this later it
                      ! contains our sorting routine
          ! and a few other tricks
        implicit none
    ! create an allocatable array of the data type
    ! than contains an index and a real value
        type (thefit),allocatable ,target :: results(:)
    ! create a single instance of the data type
        type (thefit) best
    ! pointers to our type
        type (thefit) ,pointer :: worst,tmp
        integer,allocatable :: genes(:,:) ! our genes for the ga
        integer j
        integer num_genes,gene_size
        real(b8) x
        real(b8),allocatable :: z(:)
        real(b8),pointer :: xyz(:) ! we'll talk about this next
        num_genes=10
        gene_size=10
        allocate(results(num_genes))         ! allocate the data type to
        allocate(genes(num_genes,gene_size)) ! hold our collection of genes
        call init_genes(genes)               ! starting data
        write(*,'("input")')
        do j=1,num_genes
           results(j)%index=j
           results(j)%val=fitness(genes(j,:)) ! just a dummy routine
           write(*,"(f10.8,i4)")results(j)%val,results(j)%index
        enddo

        allocate(z(size(results)))
        z=results(:)%val ! copy our results to a real array

    ! use a recursive subroutine operating on the real array
        write(*,*)"the lowest fitness: ",findmin(z)
    ! use a recursive subroutine operating on the data structure
        write(*,*)"the lowest fitness: ",findmin(results)


    Fortran Minval and Minloc routines

  • Fortran has routines for finding minimum and maximum values in arrays and the locations
  • ! we show two other methods of getting the minimum fitness
    ! use the built in f90 routines on a real array
        write(*,*)"the lowest fitness: ",minval(z),minloc(z)
     

     Pointer assignment

  • This is how we use the pointer function defined above
  • ! use a recursive subroutine operating on the data
    ! structure and returning a pointer to the result
        worst=>pntmin(results) ! note pointer assignment
    ! what will this line write?
     write(*,*)"the lowest fitness: ",worst


    More pointer usage, association and nullify

  • Motivation
  • Usage
  •  

    ! This code will print "true" when we find a match,
    ! that is the pointers point to the same object
        do j=1,num_genes
         tmp=>results(j)
            write(*,"(f10.8,i4,l3)")results(j)%val,   &
                                    results(j)%index, &
               associated(tmp,worst)
        enddo
        nullify(tmp)
     

  • Notes:
  •  

    Pointer usage to reference an array without copying

     
  • Motivation
  • Solution
  • module Merge_mod_types
        use galapagos
        type(thefit),allocatable :: work(:) ! a "global" work array
        type(thefit), pointer:: a_pntr(:)   ! this will be the pointer to our input array
    end module Merge_mod_types
     

    subroutine Sort(ain, n)
        use Merge_mod_types
        implicit none
        integer n
        type(thefit), target:: ain(n)
        allocate(work(n))
        nullify(a_pntr)
        a_pntr=>ain  ! we assign the pointer to our array
                     ! in RecMergeSort we reference it just like an array
        call RecMergeSort(1,n) ! very similar to the findmin functions
        deallocate(work)
        return
    end subroutine Sort
     

  • In our main program sort is called like this:
  • ! our sort routine is also recursive but
    ! also shows a new usage for pointers
        call sort(results,num_genes)
        do j=1,num_genes
           write(*,"(f10.8,i4)")results(j)%val,   &
                                results(j)%index
        enddo


    Data assignment with structures

    ! we can copy a whole structure
    ! with a single assignment
        best=results(1)
        write(*,*)"best result ",best

    Using the user defined operator

    Click here to see how this routine is defined

    ! using the user defined operator to see if best is worst
    ! recall that the operator .converged. checks to see if %index matches
        worst=>pntmin(results)
        write(*,*)"worst result ",worst
        write(*,*)"converged=",(best .converged. worst)


    Passing arrays with a given arbitrary lower bounds

  • Motivation
  •     if(allocated(z))deallocate(z)
        allocate(z(-10:10)) ! a 21 element array
        do j=-10,10
           z(j)=j
        enddo

    ! pass z and its lower bound
    ! in this routine we give the array a specific lower
    ! bound and show how to use a pointer to reference
    ! different parts of an array using different indices
      call boink1(z,lbound(z,1)) ! why not just lbound(z) instead of lbound(z,1)?
                                 ! lbound(z) returns a rank 1 array
     

       subroutine boink1(a,n)
         use numz
         implicit none
         integer,intent(in) :: n
         real(b8),dimension(n:):: a ! this is how we set lower bounds in a subroutine
         write(*,*)lbound(a),ubound(a)
       end subroutine
     
    Warning:  because we are using an assumed shape array we need an interface

    Using pointers to access sections of arrays

  • Motivation
  •   call boink2(z,lbound(z,1))
     

    Allocating an array inside a subroutine and passing it back

  • Motivation
  • module numz 
        integer, parameter:: b8 = selected_real_kind(14)
    end module
    
    program bla
       use numz
       real(b8), dimension(:) ,pointer :: xyz 
    
       interface boink 
         subroutine boink(a) 
         use numz
         implicit none 
         real(b8), dimension(:), pointer :: a 
         end subroutine 
       end interface 
    
       
       nullify(xyz) ! nullify sets a pointer to null 
       write(*,'(l5)')associated(xyz) ! is a pointer null, should be 
       call boink(xyz) 
       write(*,'(l5)',advance="no")associated(xyz) 
       if(associated(xyz))write(*,'(i5)')size(xyz) 
    end program  
    
    subroutine boink(a) 
        use numz 
        implicit none 
        real(b8),dimension(:),pointer:: a 
        if(associated(a))deallocate(a) 
        allocate(a(10)) 
    end subroutine 
    

         F
         T     10


    Our fitness function

    Given a fixed number of colors, M, and a description of a map of a collection of  N states.
    Find a coloring of the map such that no two states that share a boarder have the same coloring.

    Example input is a sorted list of 22 western states
    22
    ar ok tx la mo xx
    az ca nm ut nv xx
    ca az nv or xx
    co nm ut wy ne ks xx
    ia mo ne sd mn xx
    id wa or nv ut wy mt xx
    ks ne co ok mo xx
    la tx ar xx
    mn ia sd nd xx
    mo ar ok ks ne ia xx
    mt wy id nd xx
    nd mt sd wy xx
    ne sd wy co ks mo ia xx
    nm az co ok tx mn xx
    nv ca or id ut az xx
    ok ks nm tx ar mo xx
    or ca wa id xx
    sd nd wy ne ia mn xx
    tx ok nm la ar xx
    ut nv az co wy id xx
    wa id or mt xx
    wy co mt id ut nd sd ne xx

    Our fitness function takes a potential coloring, that is, an integer vector of length N and a returns the number of boarders that have states of the same coloring
     

  • How do we represent the map in memory?

  • Linked lists

  • Motivation
  • Solution

  • Linked list usage

    One way to fill a linked list is to use a recursive function
        recursive subroutine insert (item, root)
        use list_stuff
        implicit none
        type(llist), pointer :: root
        integer item
        if (.not. associated(root)) then
            allocate(root)
            nullify(root%next)
            root%index = item
        else
            call insert(item,root%next)
        endif
    end subroutine

    Our map representation

  • An array of the derived data type states
  • Notes:

  • Non advancing and character I/O

  • Motivation
  • Note:  Our list of states is presorted

  •       character(len=2) a     ! we have a character variable of length 2
          read(12,*)nstates      ! read the number of states
          allocate(map(nstates)) ! and allocate our map
          do i=1,nstates
            read(12,"(a2)",advance="no")map(i)%name ! read the name
            !write(*,*)"state:",map(i)%name
            nullify(map(i)%list)                    ! "zero out" our list
            do
            read(12,"(1x,a2)",advance="no")a      ! read list of states
                                                  ! without going to the
                                                  ! next line
                if(lge(a,"xx") .and. lle(a,"xx"))then  ! if state == xx
                    backspace(12)                ! go to the next line
                    read(12,"(1x,a2)",end=1)a    ! go to the next line
                    exit
                endif
              1 continue
                if(llt(a,map(i)%name))then   ! we only add a state to
                                             ! our list if its name
                                             ! is before ours thus we
                                             ! only count boarders 1 time
    ! what we want put into  our linked list is an index
    ! into our map where we find the bordering state
    ! thus we do the search here
    ! any ideas on a better way of doing this search?
                    found=-1
                    do j=1,i-1
                        if(lge(a,map(j)%name) .and. lle(a,map(j)%name))then
                            !write(*,*)a
                            found=j
                            exit
                        endif
                    enddo
                    if(found == -1)then
                        write(*,*)"error"
                        stop
                    endif
    ! found the index of the boarding state insert it into our list
    ! note we do the insert into the linked list for a particular state
                    call insert(found,map(i)%list)
                endif
            enddo
           enddo

    Date and time functions

  • Motivation
  •    ! all arguments are optional
       call date_and_time(date=c_date, &  ! character(len=8) ccyymmdd
                          time=c_time, &  ! character(len=10) hhmmss.sss
                          zone=c_zone, &  ! character(len=10) +/-hhmm (time zone)
                          values=ivalues) ! integer ivalues(8) all of the above
       call system_clock(count=ic,        &  ! count of system clock (clicks)
                         count_rate=icr,  &  ! clicks / second
                         count_max=max_c)    ! max value for count
       

    Internal I/O

  • Motivation
  • How it works
  • Example 1: creating a date and time stamped file name

  •  

         character (len=12)tmpstr
     
         write(tmpstr,"(a12)")(c_date(5:8)//c_time(1:4)//".dat") ! // does string concatination
         write(*,*)"name of file= ",tmpstr
         open(14,file=tmpstr)

         name of file= 03271114.dat

     

  • Example 2: Creating a format statement at run time (array of integers and a real)

  •      ! test_vect is an array that we do not know its length until run time
         nstate=9 ! the size of the array
         write(fstr,'("(",i4,"i1,1x,f10.5)")')nstates
         write(*,*)"format= ",fstr
         write(*,fstr)test_vect,result

         format= (   9i1,1x,f10.5)

    Any other ideas for writing an array when you do not know its length?
     

  • Example 3: Reading from a string

  •     integer ht,minut,sec
        read(c_time,"(3i2)")hr,minut,sec

    Inquire function

  • Motivation
  • Inquire statement has two forms
  • Example: find the size of your real relative to the "standard" real
  •         inquire(iolength=len_real)1.0
            inquire(iolength=len_b8)1.0_b8
            write(*,*)"len_b8  ",len_b8
            write(*,*)"len_real",len_real
            iratio=len_b8/len_real
            select case (iratio)
              case (1)
                my_mpi_type=mpi_real
              case(2)
                 my_mpi_type=mpi_double_precision
              case default
                write(*,*)"type undefined"
                my_mpi_type=0
            end select

     

     len_b8             2
     len_real           1


    Namelist

  • Now part of the standard
  • Motivation
  • Notes:
  • Example:

  •    integer ncolor
       logical force
       namelist /the_input/ncolor,force
          ncolor=4
       force=.true.
       read(13,the_input)
       write(*,the_input)
     
  • On input:
  • &THE_INPUT NCOLOR=4,FORCE   = F /
     

  • Output is
  •  &THE_INPUT
     NCOLOR  =           4,
     FORCE   = F
     /
     


    Vector valued functions

     
  • Motivation
  • Notes
  • Example:
  • function add1(vector,max) result (rtn)
      integer, dimension(:),intent(in) ::  vector
      integer,dimension(size(vector)) :: rtn
      integer max
      integer len
      logical carry
      len=size(vector)
      rtn=vector
      i=0
      carry=.true.
      do while(carry)         ! just continue until we do not do a carry
          i=i+1
       rtn(i)=rtn(i)+1
       if(rtn(i) .gt. max)then
           if(i == len)then   ! role over set everything back to 0
            rtn=0
        else
            rtn(i)=0
           endif
       else
           carry=.false.
       endif
      enddo
    end function
     

    Usage

            test_vect=0
            do
               test_vect=add1(test_vect,3)
               result=fitness(test_vect)
               if(result < 1.0_b8)then
                   write(*,*)test_vect
                   stop
               endif
            enddo
     



     

    Complete source for recent discussions

  • recent.f90
  • fort.13

  •  
     
    Exersize 5  Modify the program to use the random number generator given earlier.


    Some array specific intrinsic functions

     
  • ALL True if all values are true (LOGICAL)
  • ANY True if any value is true (LOGICAL)
  • COUNT Number of true elements in an array (LOGICAL)
  • DOT_PRODUCT Dot product of two rank one arrays
  • MATMUL Matrix multiplication
  • MAXLOC Location of a maximum value in an array
  • MAXVAL Maximum value in an array
  • MINLOC Location of a minimum value in an array
  • MINVAL Minimum value in an array
  • PACK Pack an array into an array of rank one
  • PRODUCT Product of array elements
  • RESHAPE  Reshape an array
  • SPREAD Replicates array by adding a dimension
  • SUM Sum of array elements
  • TRANSPOSE Transpose an array of rank two
  • UNPACK Unpack an array of rank one into an array under a mask

  •  
     
  • Examples
  •  program matrix
           real w(10),x(10),mat(10,10)
           call random_number(w)
           call random_number(mat)
           x=matmul(w,mat)   ! regular matrix multiply  USE IT
          write(*,'("dot(x,x)=",f10.5)'),dot_product(x,x)
    end program

     program allit
         character(len=10):: f1="(3l1)"
         character(len=10):: f2="(3i2)"
         integer b(2,3),c(2,3),one_d(6)
         logical l(2,3)
         one_d=(/ 1,3,5 , 2,4,6 /)
         b=transpose(reshape((/ 1,3,5 , 2,4,6 /),shape=(/3,2/)))
         C=transpose(reshape((/ 0,3,5 , 7,4,8 /),shape=(/3,2/)))
         l=(b.ne.c)
         write(*,f2)((b(i,j),j=1,3),i=1,2)
         write(*,*)
         write(*,f2)((c(i,j),j=1,3),i=1,2)
         write(*,*)
         write(*,f1)((l(i,j),j=1,3),i=1,2)
         write(*,*)
         write(*,f1)all ( b .ne. C ) !is .false.
         write(*,f1)all ( b .ne. C, DIM=1) !is [.true., .false., .false.]
         write(*,f1)all ( b .ne. C, DIM=2) !is [.false., .false.]
    end
     

  • The output is:

  •  1 3 5
     2 4 6
     
     0 3 5
     7 4 8
     
    TFF
    TFT
     
    F
    TFF
    FF


    The rest of our GA

  • Includes
  • Nothing new in either of these files
  •  Source and makefile


  • Compiler Information

  • SGI
  • Cray T90
  • Cray T3e
  • IBM SP2

  • Fortran 95

  • New Features
  • The statement FORALL as an alternative to the DO-statement
  • Partial nesting of FORALL and WHERE statements
  • Masked ELSEWHERE
  • Pure procedures
  • Elemental procedures
  • Pure procedures in specification expressions
  • Revised MINLOC and MAXLOC
  • Extensions to CEILING and FLOOR with the KIND keyword argument
  • Pointer initialization
  • Default initialization of derived type objects
  • Increased compatibility with IEEE arithmetic
  • A CPU_TIME intrinsic subroutine
  • A function NULL to nullify a pointer
  • Automatic deallocation of allocatable arrays at exit of scoping unit
  • Comments in NAMELIST at input
  • Minimal field at input
  • Complete version of END INTERFACE
  • Deleted Features
  • real and double precision DO loop index variables
  • branching to END IF from an outer block
  • PAUSE statements
  • ASSIGN statements and assigned GO TO statements and the use of an assigned integer as a FORMAT specification
  • Hollerith editing in FORMAT
  •  See http://www.nsc.liu.se/~boein/f77to90/f95.html#17.5


  • Summary

  • Fortran 90 has features to:
  • Fortran 90 has new language elements
  • Examples
  •  
     


    References

    http://www.fortran.com/fortran/   Pointer to everything Fortran
    http://www.arc.unm.edu/~jabed/list.html  Pointer to a list of tutorials
    http://dynaweb.sdsc.edu:8080/library/t90_c90_y90_cray_fp?DWEB_COLLECTION=DWEB_COLLECTIONS Cray's Manual
    http://www.software.ibm.com/ad/fortran/xlfortran/optim.html Short optimization guide from IBM
    http://www.digital.com/fortran/dvf.html DEC's Digital Visual Fortran Page
    ftp://mycroft.plk.af.mil/pub/Fortran_90/Tutorial A tutorial by Zane Dodson
    http://www.nova.edu/ocean/psplot.html Postscript plotting library
    http://meteora.ucsd.edu/~pierce/fxdr_home_page.html Subroutines to do unformatted I/O across platforms, provided by David Pierce at UCSD
     http://www.nsc.liu.se/~boein/f77to90/a5.html A good reference for intrinsic functions
     http://www.nsc.liu.se/~boein/f77to90/ Fortran 90 for the Fortran 77 Programmer
     
     Fortran 90 Handbook Complete ANSI/ISO Reference. Jeanne Adams, Walt Brainerd, Jeanne Martin, Brian Smith, Jerrold Wagener
    Fortran 90 Programming. T. Ellis, Ivor Philips, Thomas Lahey