fm_check_an Subroutine

private subroutine fm_check_an(self, antot, tempantot, antota, tempantota, antotp, tempantotp)

Type Bound

fieldmat_type

Arguments

Type IntentOptional Attributes Name
class(fieldmat_type), intent(in) :: self
complex, intent(in), dimension (-ntgrid:,:,:) :: antot
complex, intent(in), dimension (-ntgrid:,:,:) :: tempantot
complex, intent(in), dimension (-ntgrid:,:,:) :: antota
complex, intent(in), dimension (-ntgrid:,:,:) :: tempantota
complex, intent(in), dimension (-ntgrid:,:,:) :: antotp
complex, intent(in), dimension (-ntgrid:,:,:) :: tempantotp

Contents

Source Code


Source Code

  subroutine fm_check_an (self,antot, tempantot, antota, tempantota, antotp, tempantotp)
    use mp, only: broadcast_sub, iproc, sum_allreduce_sub, mp_abort
    use theta_grid, only: ntgrid
    use run_parameters, only: has_phi, has_apar, has_bpar
    use gs2_layouts, only: proc_id, idx
    use kt_grids, only: kwork_filter
    implicit none
    class(fieldmat_type), intent(in) :: self
    complex, dimension (-ntgrid:,:,:), intent (in) :: antot, antota, antotp, tempantot, tempantota, tempantotp
    complex :: tol = (1e-14,1e-14)
    integer :: ik, it, is, ic, ig

    loop1: do ik=1,self%naky
       !Skip empty cells, note this is slightly different to skipping
       !.not.is_local. Skipping empty is probably faster but may be more dangerous
       if(self%kyb(ik)%is_empty) cycle
       do is=1,self%kyb(ik)%nsupercell
          if(self%kyb(ik)%supercells(is)%is_empty) cycle
          do ic=1,self%kyb(ik)%supercells(is)%ncell
             if(self%kyb(ik)%supercells(is)%cells(ic)%is_empty) cycle

             it=self%kyb(ik)%supercells(is)%cells(ic)%it_ind
             if(kwork_filter(it,ik)) cycle
             
             if(has_phi) then
                do ig=-ntgrid,ntgrid
                   if(abs(aimag(antot(ig,it,ik)-tempantot(ig,it,ik))).gt.aimag(tol) .or. abs(real(antot(ig,it,ik)-tempantot(ig,it,ik))).gt.real(tol)) then
                      write(*,*) iproc,'problem with antot',it,ik,antot(ig,it,ik),tempantot(ig,it,ik)
                      call mp_abort('Problem with antot')
                      exit loop1
                   end if
                end do
             endif
             
             if(has_apar) then
                do ig=-ntgrid,ntgrid
                   if(abs(aimag(antota(ig,it,ik)-tempantota(ig,it,ik))).gt.aimag(tol) .or. abs(real(antota(ig,it,ik)-tempantota(ig,it,ik))).gt.real(tol)) then
                      write(*,*) iproc,'problem with antota',it,ik,antota(ig,it,ik),tempantota(ig,it,ik)
                      call mp_abort('Problem with antota')
                       exit loop1
                   end if
                end do
             endif
             
             if(has_bpar)then
                do ig=-ntgrid,ntgrid
                   if(abs(aimag(antotp(ig,it,ik)-tempantotp(ig,it,ik))).gt.aimag(tol) .or. abs(real(antotp(ig,it,ik)-tempantotp(ig,it,ik))).gt.real(tol)) then
                      write(*,*) iproc,'problem with antotp',it,ik,antotp(ig,it,ik),tempantotp(ig,it,ik)
                      call mp_abort('Problem with antotp')
                      exit loop1
                   end if
                end do
             end if
          end do
       enddo
    enddo loop1


  end subroutine fm_check_an