scale_model_var_manager.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module scale_model_var_manager
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use scale_precision
  use scale_io
 
  use scale_file_history, only: file_history_reg
  use scale_file_monitor_meshfield, only: file_monitor_meshfield_reg
 
 
  use scale_meshfield_base, only: &
    meshfieldbase, meshfield1d, meshfield2d, meshfield3d
  use scale_linkedlist, only: &
    linkedlist
  use scale_meshfieldcomm_base, only: &
    meshfieldcommbase, meshfieldcontainer
  
  use scale_variableinfo, only: &
    variableinfo
  
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedures
  !
  type, public :: modelvarmanager
    type(linkedlist) :: list
    class(meshfieldcommbase), pointer :: ptr_comm
    type(meshfieldcontainer), allocatable :: comm_list(:)  
  contains
    procedure, public :: init => modelvarmanager_init
    procedure, public :: final => modelvarmanager_final
    procedure, private :: regist1d => modelvarmanager_regist1d
    procedure, private :: regist2d => modelvarmanager_regist2d
    procedure, private :: regist3d => modelvarmanager_regist3d
    generic, public :: regist => regist1d, regist2d, regist3d
    procedure, public :: get => modelvarmanager_get
    procedure, public :: get2d => modelvarmanager_get2d
    procedure, public :: get3d => modelvarmanager_get3d
    procedure, public :: getlocalmeshfield => modelvarmanager_getlocalmeshfield
    procedure, public :: getlocalmeshfieldlist => modelvarmanager_getlocalmeshfieldlist
 
    !--
    procedure, public :: meshfieldcomm_prepair => modelvarmanager_meshfiled_comm_prepare
    procedure, public :: meshfieldcomm_exchange => modelvarmanager_meshfiled_comm_exchange
    procedure, public :: meshfieldcomm_get => modelvarmanager_meshfiled_comm_get
  end type modelvarmanager
 
  public :: variableinfo ! Cascade
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures & variables
  !
  !------------------
 
contains
 
!OCL SERIAL
  subroutine modelvarmanager_init( this )
    implicit none
    class(modelvarmanager), intent(inout) :: this
    !------------------------------------------------
 
    call this%list%Init()
    nullify( this%ptr_comm )
 
    return
  end subroutine modelvarmanager_init
 
!OCL SERIAL
  subroutine modelvarmanager_final( this )
    implicit none
    class(modelvarmanager), intent(inout) :: this
    !------------------------------------------------
 
    call this%list%Traverse( field_release )
 
    call this%list%Final()
 
    nullify( this%ptr_comm )
    if ( allocated(this%comm_list) ) deallocate(this%comm_list)
 
    return
  end subroutine modelvarmanager_final
 
!OCL SERIAL
  subroutine field_release( key, pField, done)
    implicit none
    class(*), intent(in) :: key
    class(*), pointer    :: pField
    logical, intent(out) :: done
    !------------------------------------------------
 
    select type( pfield )
    type is ( meshfield1d )
      call pfield%Final()
    type is ( meshfield2d )
      call pfield%Final() 
    type is ( meshfield3d )
      call pfield%Final()            
    end select
 
    return
  end subroutine field_release
 
!OCL SERIAL
  subroutine modelvarmanager_regist1d( this,       &
      varinfo, mesh, field, reg_file_history_flag, &
      monitor_flag, fill_zero                      )
    
    use scale_mesh_base1d, only: meshbase1d
    implicit none
 
    class(modelvarmanager), intent(inout) :: this
    type(variableinfo), intent(in) :: varinfo
    class(meshbase1d), intent(in) :: mesh
    class(meshfield1d), intent(inout), target :: field
    logical, intent(in) :: reg_file_history_flag
    logical, intent(in), optional :: monitor_flag
    logical, intent(in), optional :: fill_zero
 
    class(*), pointer :: ptr_field
 
    integer :: domID, ke
    logical :: fill_zero_
    !------------------------------------------------
 
    if (present(fill_zero)) then
      fill_zero_ = fill_zero
    else
      fill_zero_ = .true.
    end if
 
    call field%Init( varinfo%NAME, varinfo%UNIT, mesh )
    if (reg_file_history_flag) then
      call file_history_reg( varinfo%NAME, varinfo%DESC, varinfo%UNIT, field%hist_id, dim_type=varinfo%dim_type )
    end if
    if ( present(monitor_flag) ) then
      if (monitor_flag) then
        call file_monitor_meshfield_reg( &
          varinfo%NAME, varinfo%DESC, trim(varinfo%UNIT)//'*m',        & ! (in)
          field%monitor_id, dim_type='ATM1D', is_tendency=.false.      ) ! (in)
      end if
    end if
     
    ptr_field => field
    call this%list%AddByPointer( varinfo%keyID, ptr_field )
 
    if ( fill_zero_ ) then
      do domid=1, mesh%LOCAL_MESH_NUM
        !$omp parallel do
        do ke=mesh%lcmesh_list(domid)%NeS, mesh%lcmesh_list(domid)%NeE
          field%local(domid)%val(:,ke) = 0.0_rp
        end do
      end do
    end if
 
    return
  end subroutine modelvarmanager_regist1d
 
!OCL SERIAL
  subroutine modelvarmanager_regist2d( this,     &
    varinfo, mesh, field, reg_file_history_flag, &
    monitor_flag, fill_zero                      )
    use scale_mesh_base2d, only: meshbase2d
    implicit none
 
    class(modelvarmanager), intent(inout) :: this
    type(variableinfo), intent(in) :: varinfo
    class(meshbase2d), intent(in) :: mesh
    class(meshfield2d), intent(inout), target :: field
    logical, intent(in) :: reg_file_history_flag
    logical, intent(in), optional :: monitor_flag
    logical, intent(in), optional :: fill_zero
 
    class(*), pointer :: ptr_field    
 
    integer :: domID, ke
    logical :: fill_zero_
    !------------------------------------------------
 
    if (present(fill_zero)) then
      fill_zero_ = fill_zero
    else
      fill_zero_ = .false.
    end if
 
    call field%Init( varinfo%NAME, varinfo%UNIT, mesh )
    if (reg_file_history_flag) then
      call file_history_reg( varinfo%NAME, varinfo%DESC, varinfo%UNIT, field%hist_id, dim_type=varinfo%dim_type)
    end if
    if ( present(monitor_flag) ) then
      if (monitor_flag) then
        call file_monitor_meshfield_reg( &
          varinfo%NAME, varinfo%DESC, trim(varinfo%UNIT)//'*m2',       & ! (in)
          field%monitor_id, dim_type='ATM2D', is_tendency=.false.      ) ! (in)
      end if
    end if
 
    ptr_field => field
    call this%list%AddByPointer( varinfo%keyID, ptr_field )
 
    if ( fill_zero_ ) then
      do domid=1, mesh%LOCAL_MESH_NUM
        !$omp parallel do
        do ke=mesh%lcmesh_list(domid)%NeS, mesh%lcmesh_list(domid)%NeE
          field%local(domid)%val(:,ke) = 0.0_rp
        end do
      end do
    end if
 
    return
  end subroutine modelvarmanager_regist2d
 
!OCL SERIAL
  subroutine modelvarmanager_regist3d( this,     &
    varinfo, mesh, field, reg_file_history_flag, &
    monitor_flag, fill_zero                      )
    use scale_mesh_base3d, only: meshbase3d
    implicit none
 
    class(modelvarmanager), intent(inout) :: this
    type(variableinfo), intent(in) :: varinfo
    class(meshbase3d), intent(in) :: mesh
    class(meshfield3d), intent(inout), target :: field
    logical, intent(in) :: reg_file_history_flag
    logical, intent(in), optional :: monitor_flag
    logical, intent(in), optional :: fill_zero
 
    class(*), pointer :: ptr_field 
    
    integer :: domID, ke
    logical :: fill_zero_    
    !------------------------------------------------
 
    if (present(fill_zero)) then
      fill_zero_ = fill_zero
    else
      fill_zero_ = .false.
    end if
 
    call field%Init( varinfo%NAME, varinfo%UNIT, mesh )
    if (reg_file_history_flag) then
      call file_history_reg( field%varname, varinfo%DESC, field%unit, field%hist_id, &
                             dim_type=varinfo%dim_type )
    end if
    if ( present(monitor_flag) ) then
      if (monitor_flag) then
        call file_monitor_meshfield_reg( &
          varinfo%NAME, varinfo%DESC, trim(varinfo%UNIT)//'*m3',       & ! (in)
          field%monitor_id, dim_type='ATM3D', is_tendency=.false.      ) ! (in)
      end if
    end if
 
    ptr_field => field
    call this%list%AddByPointer( varinfo%keyID, ptr_field )
 
    if ( fill_zero_ ) then
      do domid=1, mesh%LOCAL_MESH_NUM
        !$omp parallel do
        do ke=mesh%lcmesh_list(domid)%NeS, mesh%lcmesh_list(domid)%NeE
          field%local(domid)%val(:,ke) = 0.0_rp
        end do
      end do
    end if
        
    return
  end subroutine modelvarmanager_regist3d
 
!OCL SERIAL
  subroutine modelvarmanager_get( this, keyID, pField )
    use scale_meshfield_base, only: meshfieldbase
    implicit none
 
    class(modelvarmanager), intent(inout) :: this
    integer, intent(in) :: keyID
    class(meshfieldbase), pointer, intent(out) :: pField
 
    class(*), pointer :: ptr_field    
    !------------------------------------------------
 
    call this%list%Get(keyid, ptr_field)
 
    nullify( pfield )
    select type( ptr_field )
    type is (meshfield1d)
      pfield => ptr_field
    type is (meshfield2d)
      pfield => ptr_field
    type is (meshfield3d)
      pfield => ptr_field          
    end select
 
    return
  end subroutine modelvarmanager_get
 
!OCL SERIAL
  subroutine modelvarmanager_get2d( this, keyID, pField )
    use scale_meshfield_base, only: meshfieldbase
    implicit none
 
    class(modelvarmanager), intent(inout) :: this
    integer, intent(in) :: keyID
    class(meshfield2d), pointer, intent(out) :: pField
 
    class(*), pointer :: ptr_field    
    !------------------------------------------------
 
    call this%list%Get(keyid, ptr_field)
    
    nullify( pfield )
    select type( ptr_field )
    type is (meshfield2d)
      pfield => ptr_field          
    end select
 
    return
  end subroutine modelvarmanager_get2d
 
!OCL SERIAL
  subroutine modelvarmanager_get3d( this, keyID, pField )
    use scale_meshfield_base, only: meshfieldbase
    implicit none
 
    class(modelvarmanager), intent(inout) :: this
    integer, intent(in) :: keyID
    class(meshfield3d), pointer, intent(out) :: pField
 
    class(*), pointer :: ptr_field    
    !------------------------------------------------
 
    call this%list%Get(keyid, ptr_field)
 
    nullify( pfield )
    select type( ptr_field )
    type is (meshfield3d)
      pfield => ptr_field          
    end select
 
    return
  end subroutine modelvarmanager_get3d
 
!OCL SERIAL
  subroutine modelvarmanager_getlocalmeshfield( this, keyID, domID, pField_lc )
    use scale_meshfield_base, only: meshfieldbase
    use scale_localmeshfield_base, only: localmeshfieldbase
    implicit none
 
    class(modelvarmanager), intent(inout) :: this
    integer, intent(in) :: keyID
    integer, intent(in) :: domID
    class(localmeshfieldbase), pointer, intent(out) :: pField_lc
 
    class(meshfieldbase), pointer :: pField
    !------------------------------------------------
 
    call this%Get(keyid, pfield)
    call pfield%GetLocalMeshField(domid, pfield_lc)
 
    return
  end subroutine modelvarmanager_getlocalmeshfield
 
!OCL SERIAL
  subroutine modelvarmanager_getlocalmeshfieldlist( this, keyID_list, domID, lcfield_list )
    use scale_meshfield_base, only: meshfieldbase
    use scale_localmeshfield_base, only: localmeshfieldbaselist
    implicit none
 
    class(modelvarmanager), intent(inout) :: this
    integer, intent(in) :: keyID_list(:)
    integer, intent(in) :: domID
    type(localmeshfieldbaselist), intent(out) :: lcfield_list(size(keyID_list))
 
    integer :: i
    integer :: keyID
 
    class(meshfieldbase), pointer :: pField
    !------------------------------------------------
 
    do i=1, size(keyid_list)
      keyid = keyid_list(i)
      call this%Get(keyid, pfield)
      call pfield%GetLocalMeshField( domid, lcfield_list(i)%ptr )
    end do
 
    return
  end subroutine modelvarmanager_getlocalmeshfieldlist
  
!OCL SERIAL
  subroutine modelvarmanager_meshfiled_comm_prepare( this, &
      comm,  fields )
    implicit none
    class(modelvarmanager), intent(inout) :: this
    class(meshfieldcommbase), target, intent(in) :: comm
    class(meshfieldbase), target, intent(in) :: fields(:)
 
    integer :: v
    integer :: nFields
    class(meshfieldbase), pointer :: ptr_field
    !------------------------------------------------
 
    this%ptr_comm => comm
 
    nfields = size(fields)
    allocate( this%comm_list(nfields) )
 
    do v = 1, size(fields)
      ptr_field => fields(v)
      select type( ptr_field )
      type is (meshfield1d)
        this%comm_list(v)%field1d => ptr_field
      type is (meshfield2d)
        this%comm_list(v)%field2d => ptr_field
      type is (meshfield3d)
        this%comm_list(v)%field3d => ptr_field               
      end select
    end do
 
    return
  end subroutine modelvarmanager_meshfiled_comm_prepare
 
!OCL SERIAL  
  subroutine modelvarmanager_meshfiled_comm_exchange( this, do_wait )
    implicit none
    class(modelvarmanager), intent(inout) :: this
    logical, intent(in), optional :: do_wait
 
    logical :: do_wait_
    !------------------------------------------------
    
    call this%ptr_comm%Put( this%comm_list, 1 )
    call this%ptr_comm%Exchange( do_wait )
 
    if ( present(do_wait) ) then
      do_wait_ = do_wait
    else
      do_wait_ = .true.
    end if
    if ( do_wait_ ) &
      call this%ptr_comm%Get( this%comm_list, 1 )
 
    return
  end subroutine modelvarmanager_meshfiled_comm_exchange
 
!OCL SERIAL  
  subroutine modelvarmanager_meshfiled_comm_get( this )
    implicit none
    class(modelvarmanager), intent(inout) :: this
    !------------------------------------------------
    call this%ptr_comm%Get( this%comm_list, 1 )
    return
  end subroutine modelvarmanager_meshfiled_comm_get 
end module scale_model_var_manager