propagator_data_classical_particles.F90

Go to the documentation of this file.

!! Copyright (C) 2021 S. Ohlmann, I. Albar, A. Obzhirov, A. Geondzhian, M. Lawan
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program 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 General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
module propagator_data_classical_particles_oct_m
  use algorithm_oct_m
  use debug_oct_m
  use global_oct_m
  use io_oct_m
  use messages_oct_m
  use namespace_oct_m
  use profiling_oct_m
  use propagator_beeman_oct_m
  use propagator_exp_mid_2step_oct_m
  use propagator_oct_m
  use propagator_verlet_oct_m
 
  implicit none
 
  private
  public ::                                      &
    propagator_data_t
 
  type :: propagator_data_t
    real(real64), allocatable :: acc(:,:)
    real(real64), allocatable :: prev_acc(:,:,:)
    real(real64), allocatable :: save_pos(:,:)
    real(real64), allocatable :: save_vel(:,:)
    real(real64), allocatable :: prev_tot_force(:,:)
    real(real64), allocatable :: prev_pos(:,:,:)
    real(real64), allocatable :: prev_vel(:,:,:)
    real(real64), allocatable :: hamiltonian_elements(:,:)
    logical :: initialized = .false.
  contains
    procedure :: restart_write => propagator_data_restart_write
    procedure :: restart_read => propagator_data_restart_read
    procedure :: initialize => propagator_data_initialize
    procedure :: end => propagator_data_end
    procedure :: propagator_data_copy
    generic   :: assignment(=) => propagator_data_copy
  end type propagator_data_t
 
contains
  ! ---------------------------------------------------------
  subroutine propagator_data_restart_write(this, namespace, prop)
    class(propagator_data_t), intent(inout) :: this
    type(namespace_t),        intent(in)    :: namespace
    class(algorithm_t),       intent(in)    :: prop
 
    integer                                 :: restart_file_unit
 
    push_sub(propagator_data_restart_write)
    call io_mkdir('restart/'//td_dir, namespace, parents=.true.)
    restart_file_unit = io_open('restart/'//td_dir// 'restart_classical_particles_propagation', &
      namespace, action='write')
 
    select type(prop)
    type is (propagator_verlet_t)
      write(restart_file_unit,*) this%acc(:,:)
      write(restart_file_unit,*) this%prev_acc(:,:,:)
    type is (propagator_beeman_t)
      write(restart_file_unit,*) this%acc(:,:)
      write(restart_file_unit,*) this%prev_acc(:,:,:)
      if (prop%predictor_corrector) then
        write(restart_file_unit,*) this%prev_tot_force(:,:)
        write(restart_file_unit,*) this%save_vel(:,:)
        write(restart_file_unit,*) this%save_pos(:,:)
      end if
    type is (propagator_exp_mid_2step_t)
      write(restart_file_unit,*) this%prev_vel(:,:,:)
      write(restart_file_unit,*) this%prev_pos(:,:,:)
      write(restart_file_unit,*) this%save_vel(:,:)
      write(restart_file_unit,*) this%save_pos(:,:)
    end select
 
    call io_close(restart_file_unit)
 
    pop_sub(propagator_data_restart_write)
  end subroutine propagator_data_restart_write
 
  ! ---------------------------------------------------------
  logical function propagator_data_restart_read(this, namespace, prop)
    class(propagator_data_t), intent(inout) :: this
    type(namespace_t),        intent(in)    :: namespace
    class(algorithm_t),       intent(in)    :: prop
 
    integer                                 :: restart_file_unit
 
    push_sub(propagator_data_restart_read)
 
    call io_mkdir('restart/'//td_dir, namespace, parents=.true.)
    restart_file_unit = io_open('restart/'//td_dir// 'restart_classical_particles_propagation', namespace, &
      action='read', die=.false.)
    if (restart_file_unit > 0) then
      select type(prop)
      type is (propagator_verlet_t)
        read(restart_file_unit,*) this%acc(:,:)
        read(restart_file_unit,*) this%prev_acc(:,:,:)
 
      type is (propagator_beeman_t)
        read(restart_file_unit,*) this%acc(:,:)
        read(restart_file_unit,*) this%prev_acc(:,:,:)
        if (prop%predictor_corrector) then
          read(restart_file_unit,*) this%prev_tot_force(:,:)
          read(restart_file_unit,*) this%save_vel(:,:)
          read(restart_file_unit,*) this%save_pos(:,:)
        end if
      type is (propagator_exp_mid_2step_t)
        read(restart_file_unit,*) this%prev_vel(:,:,:)
        read(restart_file_unit,*) this%prev_pos(:,:,:)
        read(restart_file_unit,*) this%save_vel(:,:)
        read(restart_file_unit,*) this%save_pos(:,:)
      end select
 
      call io_close(restart_file_unit)
      propagator_data_restart_read = .true.
    else
      ! error opening file
      propagator_data_restart_read = .false.
    end if
 
    pop_sub(propagator_data_restart_read)
  end function propagator_data_restart_read
 
  ! ---------------------------------------------------------
  subroutine propagator_data_initialize(this, prop, dim, np)
    class(propagator_data_t), intent(inout) :: this
    class(algorithm_t),       intent(in)    :: prop
    integer,                  intent(in)    :: dim
    integer,                  intent(in)    :: np
 
    push_sub(propagator_data_initialize)
 
    if (.not. this%initialized) then
      select type(prop)
      type is (propagator_verlet_t)
        safe_allocate(this%acc(1:dim, 1:np))
        safe_allocate(this%prev_acc(1:dim, 1:np, 1))
      type is (propagator_beeman_t)
        if (prop%predictor_corrector) then
          safe_allocate(this%save_pos(1:dim, 1:np))
          safe_allocate(this%save_vel(1:dim, 1:np))
          safe_allocate(this%prev_tot_force(1:dim, 1:np))
        end if
        safe_allocate(this%acc(1:dim, 1:np))
        safe_allocate(this%prev_acc(1:dim, 1:np, 1:2))
      type is (propagator_exp_mid_2step_t)
        safe_allocate(this%save_pos(1:dim, 1:np))
        safe_allocate(this%save_vel(1:dim, 1:np))
        safe_allocate(this%hamiltonian_elements(1:dim, 1:np))
        safe_allocate(this%prev_pos(1:dim, 1:np, 1))
        safe_allocate(this%prev_vel(1:dim, 1:np, 1))
      end select
      this%initialized = .true.
    end if
 
    pop_sub(propagator_data_initialize)
  end subroutine propagator_data_initialize
 
  ! ---------------------------------------------------------
  subroutine propagator_data_end(this)
    class(propagator_data_t),     intent(inout) :: this
 
    push_sub(propagator_data_end)
 
    safe_deallocate_a(this%acc)
    safe_deallocate_a(this%prev_acc)
    safe_deallocate_a(this%prev_tot_force)
    safe_deallocate_a(this%save_pos)
    safe_deallocate_a(this%save_vel)
    safe_deallocate_a(this%hamiltonian_elements)
    safe_deallocate_a(this%prev_pos)
    safe_deallocate_a(this%prev_vel)
 
    pop_sub(propagator_data_end)
  end subroutine propagator_data_end
 
  ! ---------------------------------------------------------
  subroutine propagator_data_copy(this, prop_data_in)
    class(propagator_data_t), intent(inout) :: this
    class(propagator_data_t), intent(in)    :: prop_data_in
 
    push_sub(propagator_data_copy)
 
    safe_allocate_source_a(this%acc,                  prop_data_in%acc)
    safe_allocate_source_a(this%prev_acc,             prop_data_in%prev_acc)
    safe_allocate_source_a(this%save_pos,             prop_data_in%save_pos)
    safe_allocate_source_a(this%save_vel,             prop_data_in%save_vel)
    safe_allocate_source_a(this%prev_tot_force,       prop_data_in%prev_tot_force)
    safe_allocate_source_a(this%prev_pos,             prop_data_in%prev_pos)
    safe_allocate_source_a(this%prev_vel,             prop_data_in%prev_vel)
    safe_allocate_source_a(this%hamiltonian_elements, prop_data_in%hamiltonian_elements)
 
    pop_sub(propagator_data_copy)
  end subroutine propagator_data_copy
end module propagator_data_classical_particles_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: