sGrid_test Subroutine

private subroutine sGrid_test(sf)

Uses

  • proc~~sgrid_test~~UsesGraph proc~sgrid_test sGrid_test module~modgvec_globals MODgvec_Globals proc~sgrid_test->module~modgvec_globals iso_fortran_env iso_fortran_env module~modgvec_globals->iso_fortran_env

test sgrid variable

Arguments

Type IntentOptional Attributes Name
class(t_sGrid), intent(inout) :: sf

self

Calls

proc~~sgrid_test~~CallsGraph proc~sgrid_test sGrid_test proc~sgrid_compare t_sGrid%sGrid_compare proc~sgrid_test->proc~sgrid_compare proc~sgrid_find_elem t_sGrid%sGrid_find_elem proc~sgrid_test->proc~sgrid_find_elem proc~sgrid_init t_sGrid%sGrid_init proc~sgrid_test->proc~sgrid_init swrite swrite proc~sgrid_test->swrite proc~sgrid_init->proc~sgrid_test proc~sgrid_init->swrite

Called by

proc~~sgrid_test~~CalledByGraph proc~sgrid_test sGrid_test proc~sgrid_init t_sGrid%sGrid_init proc~sgrid_test->proc~sgrid_init proc~sgrid_init->proc~sgrid_test proc~initmhd3d t_functional_mhd3d%InitMHD3D proc~initmhd3d->proc~sgrid_init proc~readstatefilefromascii ReadStateFileFromASCII proc~readstatefilefromascii->proc~sgrid_init proc~sgrid_copy t_sGrid%sGrid_copy proc~sgrid_copy->proc~sgrid_init interface~readstate ReadState interface~readstate->proc~readstatefilefromascii proc~transform_sfl_new transform_sfl_new proc~transform_sfl_new->proc~sgrid_copy proc~init_gvec_to_jorek init_gvec_to_jorek proc~init_gvec_to_jorek->interface~readstate proc~restartfromstate RestartFromState proc~restartfromstate->interface~readstate

Source Code

SUBROUTINE sGrid_test( sf )
! MODULES
USE MODgvec_GLobals, ONLY: UNIT_StdOut,testdbg,testlevel,nfailedMsg,nTestCalled,testUnit
IMPLICIT NONE
!-----------------------------------------------------------------------------------------------------------------------------------
! INPUT VARIABLES
!-----------------------------------------------------------------------------------------------------------------------------------
! OUTPUT VARIABLES
  CLASS(t_sgrid), INTENT(INOUT) :: sf !! self
!-----------------------------------------------------------------------------------------------------------------------------------
! LOCAL VARIABLES
  INTEGER            :: iTest,iElem,jElem
  REAL(wp)           :: x
  CHARACTER(LEN=10)  :: fail
  REAL(wp),PARAMETER :: realtol=1.0E-11_wp
  TYPE(t_sgrid)      :: testgrid
  LOGICAL            :: check
!===================================================================================================================================
  test_called=.TRUE.
  IF(testlevel.LE.0) RETURN
  IF(testdbg) THEN
     Fail=" DEBUG  !!"
  ELSE
     Fail=" FAILED !!"
  END IF
  nTestCalled=nTestCalled+1
  SWRITE(UNIT_stdOut,'(A,I4,A)')'>>>>>>>>> RUN SGRID TEST ID',nTestCalled,'    >>>>>>>>>'
  IF(testlevel.GE.1)THEN

    iTest=101 ; IF(testdbg)WRITE(*,*)'iTest=',iTest

    IF(testdbg.OR.(.NOT.( (ABS(sf%sp(0)).LT. realtol) ))) THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),(A,E11.3))') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n =>  should be 0.0 : sp(0) = ', sf%sp(0)
    END IF !TEST

    iTest=102 ; IF(testdbg)WRITE(*,*)'iTest=',iTest

    IF(testdbg.OR.(.NOT.( (MINVAL(sf%ds).GT.realtol))))THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),(A,E11.3))') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n => should be >0 : MINVAL(ds)',MINVAL(sf%ds)
    END IF !TEST

    iTest=103 ; IF(testdbg)WRITE(*,*)'iTest=',iTest

    IF(testdbg.OR.(.NOT. ( (ABS(sf%sp(sf%nElems)-1.0_wp).LT.realtol) ))) THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),(A,E11.3))') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n =>  should be 1.0 : sp(nElems) = ', sf%sp(sf%nElems)
    END IF !TEST

    iTest=104 ; IF(testdbg)WRITE(*,*)'iTest=',iTest

    IF(testdbg.OR.(.NOT. ( (ABS(SUM(sf%ds(:))-1.0_wp).LT.realtol) ))) THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),(A,E11.3))') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n =>  should be 1.0 : SUM(ds) = ', SUM(sf%ds)
    END IF !TEST

    iTest=105 ; IF(testdbg)WRITE(*,*)'iTest=',iTest

    iElem=sf%find_elem(0.0_wp)
    IF(testdbg.OR.(.NOT.( (iElem .EQ. 1 ) ))) THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),(A,I6))') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n =>   should be 1 : findelem(0.0)= ', iElem
    END IF !TEST

    iTest=106 ; IF(testdbg)WRITE(*,*)'iTest=',iTest

    iElem=sf%find_elem(1.0_wp)
    IF(testdbg.OR.(.NOT.( (iElem .EQ. sf%nElems) ))) THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),2(A,I6))') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n => should be', sf%nElems,'  :  findelem(1.0)= ', iElem
    END IF !TEST

    iTest=107 ; IF(testdbg)WRITE(*,*)'iTest=',iTest

    jElem=(sf%nElems+1)/2
    x=0.5_wp*(sf%sp(jElem-1)+sf%sp(jElem))
    iElem=sf%find_elem(x)
    IF(testdbg.OR.(.NOT.( (iElem.EQ.jElem) )))THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),2(A,I6))') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n => should be ',jElem,': iElem= ' , iElem
    END IF !TEST

    iTest=108 ; IF(testdbg)WRITE(*,*)'iTest=',iTest

    jElem=MIN(3,sf%nElems)
    x=sf%sp(jElem-1)+0.99_wp*sf%ds(jElem)
    iElem=sf%find_elem(x)
    IF(testdbg.OR.(.NOT.( (iElem.EQ.jElem) )))THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),2(A,I6))') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n => should be ',jElem,': iElem= ' , iElem
    END IF !TEST


    !get new grid and check compare
    iTest=121 ; IF(testdbg)WRITE(*,*)'iTest=',iTest
    IF(sf%grid_type.NE.-1) THEN
      CALL testgrid%init(sf%nElems+1,sf%grid_type)
    ELSE
      CALL testgrid%init(sf%nElems+1,MERGE(1,0,(sf%grid_type.EQ.0)))
    END IF
    CALL testgrid%compare(sf,check)
    CALL testgrid%free()
    IF(check)THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),A)') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n => should be false'
    END IF !TEST

    !get new grid and check compare
    iTest=122 ; IF(testdbg)WRITE(*,*)'iTest=',iTest
    CALL testgrid%init(sf%nElems,MERGE(1,0,(sf%grid_type.EQ.0)))
    CALL testgrid%compare(sf,check)
    CALL testgrid%free()
    IF(check)THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),A)') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n => should be false'
    END IF !TEST

    !get new grid and check compare
    iTest=123 ; IF(testdbg)WRITE(*,*)'iTest=',iTest
    IF(sf%grid_type.NE.-1) THEN
      CALL testgrid%init(sf%nElems,sf%grid_type)
    ELSE
      CALL testgrid%init(sf%nElems,sf%grid_type,sf%sp)
    END IF
    CALL testgrid%compare(sf,check)
    CALL testgrid%free()
    IF(.NOT.check)THEN
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') &
      '\n!! SGRID TEST ID',nTestCalled ,': TEST ',iTest,Fail
      nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(2(A,I4),A)') &
      '   nElems = ', sf%nElems , ' grid_type = ', sf%grid_type , &
      '\n => should be true'
    END IF !TEST

  END IF !testlevel>=1
  test_called=.FALSE.

END SUBROUTINE sGrid_test