ObserverInterpolateSol Subroutine

public subroutine ObserverInterpolateSol(self, tsource, no_of_lines)

Type Bound

ObserverClass

Arguments

Type IntentOptional Attributes Name
class(ObserverClass) :: self
real(kind=RP), intent(in), dimension(:) :: tsource
integer, intent(in) :: no_of_lines

Source Code

   Subroutine ObserverInterpolateSol(self, tsource, no_of_lines)

      implicit none  

      class(ObserverClass)                                 :: self
      real(kind=RP), dimension(:), intent(in)              :: tsource
      integer, intent(in)                                  :: no_of_lines

      !local variables
      real(kind=RP), dimension(:), allocatable             :: tobserver
      integer                                              :: i, n, k, m
      integer, dimension(self % numberOfFaces)             :: nDiscard
      logical                                              :: sameDelay

      allocate(tobserver(no_of_lines))
      tobserver = tsource(1:no_of_lines) + self % tdelay

      ! get max tobserver that can be interpolated
      do k =1, no_of_lines
          if ( tobserver(k) .ge. (self % tDelayMax + tsource(1)) ) exit
      end do
      n = no_of_lines - k + 1 ! k is the min tobserver index

      safedeallocate(tobserver)
      allocate(tobserver(n))
      tobserver(1:n) = tsource(k:no_of_lines) + self % tdelay

!$omp parallel shared(self, nDiscard, n, no_of_lines, tobserver, tsource,k)
!$omp do schedule(runtime)
      do i = 1, self % numberOfFaces
          ! call interp of each pair that are not the minimum
          ! if (almostequal(self % sourcepair(i) % tdelay, self % tdelay)) then
          if (self % sourcepair(i) % tdelay .eq. self % tdelay) then
              nDiscard(i) = k-1
          else
              call self % sourcePair(i) % interpolateSolF(n, no_of_lines, tobserver, tsource(1:no_of_lines), nDiscard(i))
          end if
      end do
!$omp end do
!$omp end parallel

      ! set to 0 the first part of the solution, which cannot be interpolated
      ! in this case Pacc is written from 1:no_of_lines, which have a value of 0 at first positions, not need to change obs write proc
      self % pac(1:k-1,:) = 0.0_RP

      ! sum all values from k to no_of_lines
      call self % sumIntegrals(nDiscard, n, k, no_of_lines)

      ! update all the solution of the pair to save the future ones
      do i = 1, self % numberOfFaces
          ! sameDelay = almostequal(self % sourcepair(i) % tdelay, self % tdelay)
          sameDelay = self % sourcepair(i) % tdelay .eq. self % tdelay
          call self % sourcePair(i) % newUpdate(n, nDiscard(i), no_of_lines, tsource(1:no_of_lines), sameDelay)
      end do

   End Subroutine ObserverInterpolateSol