! bof
! **********************************************************************
! Fortran 2000 module iterator

! **********************************************************************
! Source Control Strings

! $Id: iterator.f90 1.1 2003/05/10 13:24:25Z Dan Exp $

! **********************************************************************
!  Copyright 2003 Purple Sage Computing Solutions, Inc.

!   This library is free software; you can redistribute it and/or
!   modify it under the terms of the GNU Library General Public
!   License as published by the Free Software Foundation; either
!   version 2 of the License, or (at your option) any later version.

!   This library is distributed in the hope that it will be useful,
!   but WITHOUT ANY WARRANTY; without even the implied warranty of
!   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
!   Library General Public License for more details.

!   You should have received a copy of the GNU Library General Public
!   License along with this library; if not, write to the Free
!   Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

! To report bugs, suggest enhancements, etc. to the Authors,
! Contact:
!    Purple Sage Computing Solutions, Inc.
!                               send email to dnagle@erols.com
!                                   or fax to 703 471 0684 (USA)
!                                  or mail to 12142 Purple Sage Ct.
!                                             Reston, VA 20194-5621 USA

!  This file contains three program units, two modules and a program.

!  module iterator- type iterator_t

!  The first module defines an "iterator type", which names the basic
!  services needed by any floating point based calculation requiring
!  iteration for its solution.

!  module field_iterator- type field_t

!  The second module adds data which needs to be iterated and procedures
!  to provide the iteration.  (In this example, a simple 2-d field
!  to be solved for boundary conditions via nearest neighbor smoothing.)

!  program heat_iteration- compute heat distribution

!  The program initializes the iteration and computes the iteration using
!  the procedures supplied.  Since "all the work" is specified within
!  the iterator_t and the field_t, the program itself is especially simple.

!  Not too much attention has been spent with nonessential details,
!  such as input/output.

! **********************************************************************
! iterator description

!  This module defines an abstract type which may be extended
!  to form another type which supports simple iteration.  That is,
!  iteration may be done by type bound procedures of the extended
!  type.  Note that no variables of this type may be declared;
!  it may only be extended.

!  The iteration supported is a simple iteration as seen in many
!  floating point calculations, it is designed so that either achieving
!  a prescribed tolerance or exceeding a maximum number of iterations
!  without achieving a tolerance may be detected.

! **********************************************************************

!  iterator

! **********************************************************************

module iterator

! **********************************************************************

!  iterator uses modules

use standard_types

! **********************************************************************

!  explicit names

implicit none

! **********************************************************************

!  explicit exports

private

! **********************************************************************

!  static module data

save

! **********************************************************************

!  iterator RCS strings

! **********************************************************************

!  module source filename supplied by RCS

character( len= *), public, parameter :: iterator_rcs_id = &
   '$Id: iterator.f90 1.1 2003/05/10 13:24:25Z Dan Exp $'

! **********************************************************************

!  iterator types

! **********************************************************************

!  define the abstract type

!  The name of the type is iterator_t.
!  Public means (after the private above, which applies to the entire module),
!  that the name is visible outside this module.
!  Abstract means no variable of this type may be declared,
!  the only purpose of this type is to be extended by other types.

type, public, abstract :: iterator_t

!  any iteration will have an iteration count

!  by default, at the beginning, there are zero iterations

   integer :: iteration_count = 0                                    ! default initial value

!  any iteration will have a maximum number of iterations allowed

!  also sets fifty as the default maximum (see the setup procedure)

   integer :: maximum_count = 50                                     ! default maximum count

!  any iteration will have a tolerance indicating convergence

!  again, see the setup procedure

   real( kind= double_k) :: tolerance = 0.0_double_k                 ! setup must set this

!  these are procedures which must be supplied by any iteration

contains

!  The name in parenthesis following the procedure keyword
!  is the name of an abstract interface,
!  any actual procedure purporting to fulfill the role
!  of the deferred procedure must match the abstract interface.

!  deferred means that this type does not actually have such a procedure,
!  but that any type which is going to be used to actually declare variables
!  must supply such a procedure

!  pass means that the procedure may be referenced similarly to a component,
!  that is, using the variable% name[( args)] syntax where variable is passed
!  as the pass argument

!  any iteration must be initialized

   procedure( iteration_setup), deferred, pass( iterator_t) :: setup

!  any iteration must define one step of the iteration

   procedure( iteration_step), deferred, pass( iterator_t) :: iterate_once

!  any iteration must define its convergence criteria

   procedure( iteration_converged), deferred, pass( iterator_t) :: converged

end type iterator_t

!  the abstract interfaces do not represent actual procedures
!  (as would interfaces) but rather they are the template
!  which any actual procedure must match in order to be
!  a procedure fulfilling the role of the deferred procedure

!  define the interfaces the iterator_t deferred procedures must have

abstract interface

!  any procedure fulfilling the role of the setup procedure
!  must match this interface

!  this subroutine initializes the iteration

   subroutine iteration_setup( object, maximum_steps, set_tolerance)

!  class means any variable of a type extended from iterator_t

      class( iterator_t), intent( inout) :: object

!  might want to change the default maximum number of iterations

      integer, optional, intent( in) :: maximum_steps

!  might want to change the tolerance

      real( kind= double_k), optional, intent( in) :: set_tolerance

   end subroutine iteration_setup

!  any procedure fulfilling the role of the iterate_once procedure
!  must match this interface

!  this subroutine computes one step of the iteration

   subroutine iteration_step( object)

!  class means any variable of a type extended from iterator_t

      class( iterator_t), intent( inout) :: object

   end subroutine iteration_setup

!  any procedure fulfilling the role of the converged procedure
!  must match this interface

!  this function returns true when the iteration has converged

   logical function iteration_converged( object)

!  class means any variable of a type extended from iterator_t

      class( iterator_t), intent( in) :: object

   end function iteration_converged

end interface

! **********************************************************************

!  iterator

! $Id: iterator.f90 1.1 2003/05/10 13:24:25Z Dan Exp $
! **********************************************************************

end module iterator

! **********************************************************************
! Fortran 2000 module field_iterator

! **********************************************************************
! field_iterator description

!  This module defines a type which is an extension of the iterator_t
!  defined in module iterator.  This type is a 2 dimensional field,
!  with boundary conditions along the four edges.  The iteration defined
!  for this type is a simple Poisson iteration, that is,
!  a_i,j = 0.25 * ( a_i-1,j + a_i+1,j + a_i,j-1 + a_i,j+1 )
!  This could be any 2-d diffusion calculation.

! **********************************************************************

!  field_iterator

! **********************************************************************

module field_iterator

! **********************************************************************

!  field_iterator uses modules

use standard_types

!  abstract iteration type

use iterator

! **********************************************************************

!  explicit names

implicit none

! **********************************************************************

!  explicit exports

private

! **********************************************************************

!  static module data

save

! **********************************************************************

!  field_iterator RCS strings

! **********************************************************************

!  module source filename supplied by RCS

character( len= *), public, parameter :: field_iterator_rcs_id = &
   '$Id: iterator.f90 1.1 2003/05/10 13:24:25Z Dan Exp $'

! **********************************************************************

!  field_iterator constants

! **********************************************************************

integer, parameter :: nsize = 100                                    ! not know outside this module

! **********************************************************************

!  field_iterator types

! **********************************************************************

!  this type adds to the iterator_t the components needed for the 2-d field

type, public, extends( iterator_t) :: field_t

!  the values of interest

   real( kind= double_k), dimension( nsize, nsize, 2) :: values

!  keep track of which direction ( 1 -> 2 or 2 -> 1)

   integer :: which_half = 1

contains

!  initialize the iteration

   procedure, pass( field_t) :: setup => setup_field

!  one step

   procedure, pass( field_t) :: iterate_once => iterate_field

!  compute convergence or not

   procedure, pass( field_t) :: converged => converged_field

end type field_t

! **********************************************************************

!  module procedures

! **********************************************************************

!  since field_t extends iterator_t, it must define the procedures
!  deferred in the definition of iterator_t

contains                                                             ! field_iterator

! **********************************************************************

!  initialize the field variable

subroutine setup_field( field, maximum_steps, set_tolerance)

!  heat is the pass argument, it is the "this" variable
!  the intent is not out because the default initial values might be wanted

class( field_t), intent( inout) :: field

integer, optional, intent( in) :: maximum_steps

real( kind= double_k), optional, intent( in) :: set_tolerance

! **********************************************************************

!  initialize the iteration

continue

!  a default value for maximum_count was specified
!  in the definition of iterator_t so it will be overridden
!  only if a maximum_steps argument is present

!  if a maximum iteration count was passed, test it

   set_max: if( present( maximum_steps) )then

!  if maximum iteration count is valid, use it

      valid_max: if( maximum_steps > 0 )then

         field% maximum_count = maximum_steps

      endif valid_max

   endif set_max

!  the current iteration count is zero by default
!  so this procedure needn't set it

! ----------------------------------------------------------------------

!  a default value for tolerance was not specified
!  in the definition of iterator_t so it must be set here
!  the valus of set_tolerance is used if present present
!  otherwise the default value is supplied here

!  if a tolerance was passed, test it

   set_tol: if( present( set_tolerance) )then

!  if tolerance is valid, use it

      valid_tol: if( set_tolerance > 0.0_double_k )then

         field% tolerance = max( set_tolerance, epsilon( set_tolerance))

      endif valid_tol

   else set_tol

      field% tolerance = epsilon( set_tolerance)

   endif set_tol

! ----------------------------------------------------------------------

!  read the boundary conditions

   read( unit= *, fmt= *) field% values( 1, :, 1)
   read( unit= *, fmt= *) field% values( nsize, :, 1)
   read( unit= *, fmt= *) field% values( :, 1, 1)
   read( unit= *, fmt= *) field% values( :, nsize, 1)

!  duplicate for the other half

   field% values( 1, :, 2) = field% values( 1, :, 1)
   field% values( nsize, :, 2) = field% values( nsize, :, 1)
   field% values( :, 1, 2) = field% values( :, 1, 1)
   field% values( :, nsize, 2) = field% values( :, nsize, 1)

!  initialize the internal field values

   field% values( 2: nsize - 1, 2: nsize - 1, :) = 0.0_double_k

! ----------------------------------------------------------------------

return

end subroutine setup_field

! **********************************************************************

!  compute one step of the iteration

subroutine iterate_field( field)

!  heat is the pass argument, it is the "this" variable

class( field_t), intent( inout) :: field

!  go one way or the other

   integer :: to, from

!  one step of a simple Poisson iteration

continue

!  establish the direction ( :, :, 1) <-- ( :, :, 2) or vice versa

   set_direction: if( field% which_half == 1 )then

      to = 1
      from = 2
      field% which_half = 2

   else set_direction

      to = 2
      from = 1
      field% which_half = 1

   endif set_direction

!  smooth the field one time

   field( 2: nsize - 1, 2: nsize - 1, to) = 0.25 * ( field( 1: nsize - 2, 2: nsize - 1, from) &
                                                   + field( 3: nsize, 2: nsize - 1, from) &
                                                   + field( 2: nsize - 1, 1: nsize - 2, from) &
                                                   + field( 2: nsize - 1, 3: nsize, from) )

!  count the steps

   field% iteration_count = field% iteration_count + 1

return

end subroutine iterate_field

! **********************************************************************

logical function converged_field( field)

!  heat is the pass argument, it is the "this" variable

class( field_t), intent( in) :: field

!  compute converged or not

continue

!  convergence is when the maximum delta is less than the prescribed tolerance

   converged_example = maxval( abs( field( 2: nsize - 1, 2: nsize - 1, 1)% values &
                                  - field( 2: nsize - 1, 2: nsize - 1, 2)% values)) < field% tolerance

return

end function converged_field

! $Id: iterator.f90 1.1 2003/05/10 13:24:25Z Dan Exp $
! **********************************************************************

end module field_iterator

! **********************************************************************
! Fortran 2000 program heat_iteration

! **********************************************************************
! heat_iteration describe the program

! **********************************************************************

!  heat_iteration

! **********************************************************************

program heat_iteration

! **********************************************************************

!  heat_iteration uses modules

! **********************************************************************

!  processor description

use standard_types

!  data and procedures for this problem

use field_iterator

! **********************************************************************

!  turn off implicit typing

implicit none                                              ! explicit declarations

! **********************************************************************

!  heat_iteration RCS strings

! **********************************************************************

!  program source filename supplied by RCS

character( len= *), parameter :: heat_iteration_rcs_id = &
   '$Id: iterator.f90 1.1 2003/05/10 13:24:25Z Dan Exp $'

! **********************************************************************

!  heat_iteration constants

! **********************************************************************

!  tolerance to be used for heat calculations

real( kind= double_k), parameter :: heat_tolerance = 1.0e-10

! **********************************************************************

!  heat_iteration data

! **********************************************************************

!  heat is a variable of type field
!  heat has all the components of the iterator type and the field type

type( field_t) :: heat

! **********************************************************************

!  heat_iteration text

! **********************************************************************

continue                                                             ! heat_iteration

!  initialize the iteration

   call heat% setup

!  iterate until convergence or failure

   converge: do

!  one step of the iteration

      call heat% iterate_once( heat_tolerance)                       ! set optional tolerance

!  found convergence

      iteration_converged: if( heat% converged )then

         write( unit= *, fmt= *) 'heat values'

         write( unit= *, fmt= *) heat% values

         exit converge

      endif iteration_converged

!  found failure

      iteration_failed: if( heat% iteration_count > heat% maximum_count )then

         write( unit= *, fmt= *) 'heat iteration failed to converge'

         exit converge

      endif iteration_failed

!  end iterate until convergence or failure

   enddo converge

!  day is done

stop 'heat_iteration'                                                ! heat_iteration

! **********************************************************************

!  heat_iteration

! $Id: iterator.f90 1.1 2003/05/10 13:24:25Z Dan Exp $
! **********************************************************************

end program heat_iteration                                           ! eof