multistep_storage_s.f90 Source File


Contents


Source Code

submodule (multistep_m) multistep_storage_s
    implicit none

contains
    

    pure integer module function get_ndim(self)
        class(multistep_storage_t), intent(in) :: self
        get_ndim = self%ndim
    end function
    
    pure integer module function get_nstorage(self)
        class(multistep_storage_t), intent(in) :: self
        get_nstorage = self%nstorage
    end function

    pure integer module function get_nfields(self)
        class(multistep_storage_t), intent(in) :: self
        get_nfields = self%nfields              
    end function

    module subroutine init_storage(self, ndim, nstorage, nfields, vstore_firsts)
        class(multistep_storage_t), intent(inout) :: self
        integer, intent(in) :: ndim
        integer, intent(in) :: nstorage
        integer, intent(in) :: nfields
        real(GP), dimension(ndim, nstorage, nfields), intent(in), optional :: vstore_firsts
    
        integer :: ifield, istorage, i

        self%ndim = ndim
        self%nstorage = nstorage        
        self%nfields  = nfields                    

        allocate(self%vstore(ndim, nstorage, nfields))

        !$OMP PARALLEL PRIVATE(ifield, istorage, i)
        do ifield = 1, nfields
            do istorage = 1, nstorage
                !$OMP DO
                do i = 1, ndim
                    if (present(vstore_firsts)) then
                        self%vstore(i, istorage, ifield) = vstore_firsts(i, istorage, ifield) 
                    else
                        self%vstore(i, istorage, ifield) = 0.0_GP
                    endif
                enddo
                !$OMP END DO
            enddo        
        enddo
        !$OMP END PARALLEL

    end subroutine

    module subroutine shift_storage(self, vals_new)
        class(multistep_storage_t), intent(inout) :: self
        real(GP), dimension(self%ndim, self%nfields), intent(in) :: vals_new

        integer :: ifield, istorage, i, istorage_fwd, istorage_bwd

        !$OMP PARALLEL PRIVATE(ifield, istorage, istorage_bwd, istorage_fwd, i)
        do ifield = 1, self%nfields
            do istorage = 1, self%nstorage-1
                istorage_bwd = (self%nstorage)-(istorage-1)
                istorage_fwd  = istorage_bwd - 1         
                !$OMP DO
                do i = 1, self%ndim              
                    self%vstore(i, istorage_bwd, ifield)   = self%vstore(i, istorage_fwd, ifield)
                enddo
                !$OMP END DO
            enddo

            if (self%nstorage > 0) then            
                !$OMP DO
                do i = 1, self%ndim       
                    self%vstore(i, 1, ifield) = vals_new(i, ifield)
                enddo
                !$OMP END DO
            endif

        enddo
        !$OMP END PARALLEL

    end subroutine    

    module subroutine destructor_storage(self)
        type(multistep_storage_t), intent(inout) :: self

        self%ndim = 0
        self%nstorage = 0
        if (allocated(self%vstore)) deallocate(self%vstore)

    end subroutine

end submodule