ode_problem_mod.f90

Go to the documentation of this file.

module ode_problem_mod

  use choral_constants
  use choral_variables
  use real_type
  use basic_tools
  use abstract_interfaces, only: rntorn
  use ode_def

  implicit none
  private

  public :: ode_problem

  public :: clear, valid, print
  public :: name_ode_problem


  !       %----------------------------------------%
  !       |                                        |
  !       |          DERIVED TYPE                  |
  !       |                                        |
  !       %----------------------------------------%
  type :: ode_problem

     integer :: type = -1

     integer :: n = 1

     integer :: na = 0

     integer :: dim = 3

     integer :: dof = 1

     real(RP), dimension(:,:), allocatable :: x 

     procedure(ode_reaction),nopass, pointer:: ab  =>null()

     procedure(rntorn), nopass, pointer :: m   =>null()

     procedure(rntorn), nopass, pointer :: s   =>null()
     
   contains

     final :: ode_problem_clear

  end type ode_problem


  !       %----------------------------------------%
  !       |                                        |
  !       |       GENERIc SUBROUTINES              |
  !       |                                        |
  !       %----------------------------------------%
  interface clear
     module procedure ode_problem_clear
  end interface clear

  interface ode_problem
     module procedure ode_problem_create
  end interface ode_problem

  interface valid
     module procedure ode_problem_valid
  end interface valid

  interface print
     module procedure ode_problem_print
  end interface print

contains

  subroutine ode_problem_clear(pb)
    type(ode_problem), intent(inout) :: pb

    pb%AB  =>null()
    pb%M   =>null()
    pb%S   =>null()
    
    pb%type = -1
    pb%dim  = 3
    pb%N    = 1
    pb%Na   = 0
    pb%dof  = 1

  end subroutine ode_problem_clear



  function ode_problem_create(type, dim, dof, X, M, S, AB, N, Na) &
       & result(pb)
    type(ode_problem) :: pb
    integer                  , intent(in) :: type
    integer                  , optional   :: dim   
    integer                  , optional   :: dof, N, Na
    procedure(rntorn)        , optional   :: M, S
    real(RP), dimension(:,:) , optional   :: X
    procedure(ode_reaction)  , optional   :: AB

    if (choral_verb>0) write(*,*) &
         & "ode_problem_mod : ode_problem_create"
    call clear(pb)

    pb%type = type
    if (present(dim)) then
       pb%dim = dim
       if (dim==0) call allocmem(pb%x, 3, 1)
    end if

    if (present(dof))     pb%dof     = dof 
    if (present(n ))      pb%N       = n
    if (present(na))      pb%Na      = na

    if (present(x))  then
       call allocmem(pb%X, size(x,1), size(x,2))
       pb%X = x 
    end if
    if (present(m))  pb%M  => m
    if (present(s))  pb%S  => s
    if (present(ab)) pb%AB => ab

    if (.NOT.valid(pb)) call quit(&
         & "ode_problem_mod: ode_problem_create: not valid")

  end function ode_problem_create


  function ode_problem_valid(pb) result(bool)
    type(ode_problem), intent(in)  :: pb
    logical :: bool

    !! Ode problem type
    bool = (pb%type>0) .AND. (pb%type<=ode_pb_tot_nb)
    if (.NOT.bool) return

    !! ODE problem characteristics
    bool = (pb%N>=1) .AND. (pb%Na>=0) .AND. (pb%Na<=pb%N)
    bool = bool      .AND. (pb%dof >= 1)
    if (.NOT.bool) return

    !! ODE problem where X is needed
    select case(pb%type)
    case(ode_pb_nl, ode_pb_sl, ode_pb_sl_nl)

       bool = (allocated(pb%X))
       if (.NOT.bool) return

       bool = (size(pb%X,1)==3).AND.(size(pb%X,2)==pb%dof)
       if (.NOT.bool) return

       if (pb%dim == 0) then
          bool = (pb%dof==1)
       end if
       if (.NOT.bool) return

    end select

    !! problem specific requirements
    select case(pb%type)

    case(ode_pb_lin)
       bool = associated(pb%M) .AND. associated(pb%S)

    case(ode_pb_nl)
       bool = associated(pb%AB)
       
    case(ode_pb_sl)
       bool = associated(pb%M) .AND. associated(pb%S)
       bool = bool             .AND. associated(pb%AB) 

       !! semilinear problems have size N=1
       bool = bool .AND. (pb%N==1) 

    case(ode_pb_sl_nl)
       bool = associated(pb%M) .AND. associated(pb%S)
       bool = bool             .AND. associated(pb%AB) 

    end select

  end function ode_problem_valid

  function name_ode_problem(type) result(name)
    integer, intent(in) :: type
    character(len=15)   :: name

    select case(type)
    case(ode_pb_lin)
       name = "ODE_PB_LIN"

    case(ode_pb_nl)
       name = "ODE_PB_NL"

    case(ode_pb_sl)
       name = "ODE_PB_SL"

    case(ode_pb_sl_nl)
       name = "ODE_PB_SL_NL"

    case default
       name = 'invalid'

    end select

  end function name_ode_problem


  subroutine ode_problem_print(pb)
    type(ode_problem) , intent(in) :: pb

    character(len=15) :: name

    write(*,*)"ode_problem_mod : ode_problem_print"
    name = name_ode_problem(pb%type)

    write(*,*)"  Problem type                   = ", name
    write(*,*)"  Problem sizes N, Na            =", pb%N, pb%Na

    if (pb%dim == 0) then
       write(*,*)"  0D problem, No disc. nodes in space"
    else
       write(*,*)"  Number of nodes in space       =", pb%dof
    end if

    if ( valid(pb)) then
       write(*,*)"  Status                         = valid"

    else
       write(*,*)"  Status                         = invalid"
       write(*,*)"  Associated M                   =", associated(pb%M)
       write(*,*)"  Associated S                   =", associated(pb%S)
       write(*,*)"  Associated AB                  =", associated(pb%AB)
       write(*,*)"  Allocated  X                   =", allocated(pb%X)
       if (allocated(pb%X)) then
          write(*,*)"  Shape of the array X           =", shape(pb%X)
       end if
    end if

  end subroutine ode_problem_print

end module ode_problem_mod