subroutine check_grw_array( valname )
! -------------------------------------------------------------------------!
character(len=*), intent(in) :: valname
! -------------------------------------------------------------------------!
type(grw_dtint2darray_type) :: ga_2dint
type(grw_longarray_type) :: ga_long
type(grw_intarray_type ) :: ga_int
type(grw_realarray_type) :: ga_real
type(grw_labelarray_type) :: ga_label
type(grw_logicalarray_type) :: ga_logical
type(grw_chararray_type) :: ga_char
type(intArray2d_type) :: val2d
character(len=labelLen),allocatable :: label(:)
logical :: logic
! -------------------------------------------------------------------------!
select case (trim(valname))
case ('char_values')
! init growing array with size 2
call init( me = ga_char, &
& length = 2 )
if (ga_char%containersize /= 2) then
write(*,*) 'Unexpected containersize after init!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place character at pos 1
call placeat( me = ga_char, &
& val = 'ho', &
& pos = 1)
if (ga_char%val(1) /= 'h') then
write(*,*) 'Unexpected character after placeat!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! expand growing array with length 3
call expand( me = ga_char, &
& length = 3 )
if (ga_char%containersize /= 5) then
write(*,*) 'Unexpected containersize after expand!'
write(*,*) 'Expected 5, got ', ga_char%containersize
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place ['h', 'e', 'l', 'l', 'o'] at pos (2:6)
call placeat( me = ga_char, &
& val = ['h', 'e', 'l', 'l', 'o'], &
& pos = 2 )
if (ga_char%val(3) /= 'e') then
write(*,*) 'Unexpected character after placeat!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! ! append growing array with 'octree'
! call append( me = ga_logical, &
! & val = .FALSE. )
! if (ga_logical%val(6) .NEQV. .FALSE.) then
! write(*,*) 'Unexpected logical after append!'
! write(*,*) 'Expected .FALSE. at pos 6, got ', ga_logical%val(6)
! write(*,*) 'FAILED'
! else
! write(*,*) 'PASSED'
! end if
! ! truncate growing array
! call truncate( me = ga_logical )
! if (ga_logical%nvals /= ga_logical%containersize) then
! write(*,*) 'Containersize /= nvals after truncate!'
! write(*,*) 'FAILED'
! else
! write(*,*) 'PASSED'
! end if
! ! empty growing array
! call empty( me = ga_logical )
! if (ga_logical%nvals /= 0) then
! write(*,*) 'Unexpected nvals after empty!'
! write(*,*) 'Expected 0, got ', ga_logical%nvals
! write(*,*) 'FAILED'
! else
! write(*,*) 'PASSED'
! end if
! ! destroy growing array
! call destroy( me = ga_logical )
! if (ga_logical%containersize /= 0) then
! write(*,*) 'Unexpected containersize after destroy!'
! write(*,*) 'Expected 0, got ', ga_logical%containersize
! write(*,*) 'FAILED'
! elseif (ga_logical%nvals /= 0) then
! write(*,*) 'Unexpected nvals after destroy!'
! write(*,*) 'Expected 0, got ', ga_logical%nvals
! write(*,*) 'FAILED'
! else
! write(*,*) 'PASSED'
! end if
case ('logical_values')
! init growing array with size 2
call init( me = ga_logical, &
& length = 2 )
if (ga_logical%containersize /= 2) then
write(*,*) 'Unexpected containersize after init!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place logical at pos 1
logic = .TRUE.
call placeat( me = ga_logical, &
& val = logic, &
& pos = 1)
if (ga_logical%val(1) .NEQV. .TRUE.) then
write(*,*) 'Unexpected logical after placeat!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! expand growing array with length 3
call expand( me = ga_logical, &
& length = 3 )
if (ga_logical%containersize /= 5) then
write(*,*) 'Unexpected containersize after expand!'
write(*,*) 'Expected 5, got ', ga_logical%containersize
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place ['.TRUE.', '.FALSE.', '.TRUE.'] at pos (3:5)
call placeat( me = ga_logical, &
& val = [.TRUE., .FALSE., .TRUE.], &
& pos = 3 )
if (ga_logical%val(3) .NEQV. .TRUE.) then
write(*,*) 'Unexpected logical after placeat!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! append growing array with 'octree'
call append( me = ga_logical, &
& val = .FALSE. )
if (ga_logical%val(6) .NEQV. .FALSE.) then
write(*,*) 'Unexpected logical after append!'
write(*,*) 'Expected .FALSE. at pos 6, got ', ga_logical%val(6)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! truncate growing array
call truncate( me = ga_logical )
if (ga_logical%nvals /= ga_logical%containersize) then
write(*,*) 'Containersize /= nvals after truncate!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! empty growing array
call empty( me = ga_logical )
if (ga_logical%nvals /= 0) then
write(*,*) 'Unexpected nvals after empty!'
write(*,*) 'Expected 0, got ', ga_logical%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! destroy growing array
call destroy( me = ga_logical )
if (ga_logical%containersize /= 0) then
write(*,*) 'Unexpected containersize after destroy!'
write(*,*) 'Expected 0, got ', ga_logical%containersize
write(*,*) 'FAILED'
elseif (ga_logical%nvals /= 0) then
write(*,*) 'Unexpected nvals after destroy!'
write(*,*) 'Expected 0, got ', ga_logical%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
case ('label_values')
! init growing array with size 2
call init( me = ga_label, &
& length = 2 )
if (ga_label%containersize /= 2) then
write(*,*) 'Unexpected containersize after init!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place hellotest at pos 2
allocate(label(1))
label = 'hellotest'
call placeat( me = ga_label, &
& val = label, &
& pos = 1)
deallocate(label)
if (ga_label%val(1) /= 'hellotest') then
write(*,*) 'Unexpected label after placeat!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! expand growing array with length 3
call expand( me = ga_label, &
& length = 3 )
if (ga_label%containersize /= 5) then
write(*,*) 'Unexpected containersize after expand!'
write(*,*) 'Expected 5, got ', ga_label%containersize
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place ['tr', 'ee', 'lm'] at pos (3:5)
allocate(label(3))
label = ['tr', 'ee', 'lm']
call placeat( me = ga_label, &
& val = label, &
& pos = 3 )
deallocate(label)
if (ga_label%val(3) /= 'tr') then
write(*,*) 'Unexpected label after placeat!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! append growing array with 'octree'
allocate(label(1))
label = 'octree'
call append( me = ga_label, &
& val = label )
if (ga_label%val(6) /= 'octree') then
write(*,*) 'Unexpected label after append!'
write(*,*) 'Expected "octree" at pos 6, got ', ga_label%val(6)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! truncate growing array
call truncate( me = ga_label )
if (ga_label%nvals /= ga_label%containersize) then
write(*,*) 'Containersize /= nvals after truncate!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! empty growing array
call empty( me = ga_label )
if (ga_label%nvals /= 0) then
write(*,*) 'Unexpected nvals after empty!'
write(*,*) 'Expected 0, got ', ga_label%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! destroy growing array
call destroy( me = ga_label )
if (ga_label%containersize /= 0) then
write(*,*) 'Unexpected containersize after destroy!'
write(*,*) 'Expected 0, got ', ga_label%containersize
write(*,*) 'FAILED'
elseif (ga_label%nvals /= 0) then
write(*,*) 'Unexpected nvals after destroy!'
write(*,*) 'Expected 0, got ', ga_label%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
case ('2dint_values')
! init growing array with size 2
call init( me = ga_2dint, &
& length = 2 )
if (ga_2dint%containersize /= 2) then
write(*,*) 'Unexpected containersize after init!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place 1013 at pos 2
allocate(val2d%val(1,1) )
val2d%val(1,1) = 1013
call placeat( me = ga_2dint, &
& val = val2d, &
& pos = 2 )
deallocate(val2d%val)
if (ga_2dint%val(2)%val(1,1) /= 1013) then
write(*,*) 'Unexpected value after placeat!'
write(*,*) 'Expected 1013, got ', ga_2dint%val(2)%val(1,1)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! expand growing array with length 3
call expand( me = ga_2dint, &
& length = 3 )
if (ga_2dint%containersize /= 5) then
write(*,*) 'Unexpected containersize after expand!'
write(*,*) 'Expected 5, got ', ga_2dint%containersize
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place [1, 2, 3] at pos 1
allocate(val2d%val(1,3) )
val2d%val(1,1) = 1
val2d%val(1,2) = 2
val2d%val(1,3) = 3
call placeat( me = ga_2dint, &
& val = val2d, &
& pos = 1 )
deallocate(val2d%val)
if (ga_2dint%val(1)%val(1,3) /= 3) then
write(*,*) 'Unexpected value after placeat!'
write(*,*) 'Expected 3, got ', ga_2dint%val(1)%val(1,3)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! append growing array with 4, ga_2dint%val is an allocatable type
allocate(val2d%val(1,1) )
val2d%val(1,1) = 4
call append( me = ga_2dint, &
& val = val2d )
deallocate(val2d%val)
if (ga_2dint%val(3)%val(1,1) /= 4) then
write(*,*) 'Unexpected value after append!'
write(*,*) 'Expected 4 at pos 3, got ', ga_2dint%val(3)%val(1,1)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! truncate growing array
call truncate( me = ga_2dint )
if (ga_2dint%nvals /= ga_2dint%containersize) then
write(*,*) 'Containersize /= nvals after truncate!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! empty growing array
call empty( me = ga_2dint )
if (ga_2dint%nvals /= 0) then
write(*,*) 'Unexpected nvals after empty!'
write(*,*) 'Expected 0, got ', ga_2dint%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! destroy growing array
call destroy( me = ga_2dint )
if (ga_2dint%containersize /= 0) then
write(*,*) 'Unexpected containersize after destroy!'
write(*,*) 'Expected 0, got ', ga_2dint%containersize
write(*,*) 'FAILED'
elseif (ga_2dint%nvals /= 0) then
write(*,*) 'Unexpected nvals after destroy!'
write(*,*) 'Expected 0, got ', ga_2dint%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
case ('long_values')
! init growing array with size 2
call init( me = ga_long, &
& length = 2 )
if (ga_long%containersize /= 2) then
write(*,*) 'Unexpected containersize after init!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place 1013_long_k at pos 2
call placeat( me = ga_long, &
& val = 1013_long_k, &
& pos = 2 )
if (ga_long%val(2) /= 1013_long_k) then
write(*,*) 'Unexpected value after placeat!'
write(*,*) 'Expected 1013_long_k, got ', ga_long%val(2)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! expand growing array with length 3
call expand( me = ga_long, &
& length = 3 )
if (ga_long%containersize /= 5) then
write(*,*) 'Unexpected containersize after expand!'
write(*,*) 'Expected 5, got ', ga_long%containersize
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place [1_long_k, 2_long_k, 3_long_k] at pos 1
call placeat( me = ga_long, &
& val = [1_long_k, 2_long_k, 3_long_k], &
& pos = 1 )
if (ga_long%val(3) /= 3_long_k) then
write(*,*) 'Unexpected value after placeat!'
write(*,*) 'Expected 3_long_k at pos 3, got ', ga_long%val(3)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! append growing array with 4_long_k
call append( me = ga_long, &
& val = [4_long_k,5_long_k,6_long_k] )
if (ga_long%val(6) /= 6_long_k) then
write(*,*) 'Unexpected value after append!'
write(*,*) 'Expected 6_long_k at pos 6, got ', ga_long%val(6)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! truncate growing array
call truncate( me = ga_long )
if (ga_long%nvals /= ga_long%containersize) then
write(*,*) 'Containersize /= nvals after truncate!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! empty growing array
call empty( me = ga_long )
if (ga_long%nvals /= 0) then
write(*,*) 'Unexpected nvals after empty!'
write(*,*) 'Expected 0, got ', ga_long%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! destroy growing array
call destroy( me = ga_long )
if (ga_long%containersize /= 0) then
write(*,*) 'Unexpected containersize after destroy!'
write(*,*) 'Expected 0, got ', ga_long%containersize
write(*,*) 'FAILED'
elseif (ga_long%nvals /= 0) then
write(*,*) 'Unexpected nvals after destroy!'
write(*,*) 'Expected 0, got ', ga_long%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
case ('int_values')
! init growing array with size 2
call init( me = ga_int, &
& length = 2 )
if (ga_int%containersize /= 2) then
write(*,*) 'Unexpected containersize after init!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place 1013 at pos 2
call placeat( me = ga_int, &
& val = 1013, &
& pos = 2 )
if (ga_int%val(2) /= 1013) then
write(*,*) 'Unexpected value after placeat!'
write(*,*) 'Expected 1013, got ', ga_int%val(2)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! expand growing array with length 3
call expand( me = ga_int, &
& length = 3 )
if (ga_int%containersize /= 5) then
write(*,*) 'Unexpected containersize after expand!'
write(*,*) 'Expected 5, got ', ga_int%containersize
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place [1, 2, 3] at pos 1
call placeat( me = ga_int, &
& val = [1, 2, 3], &
& pos = 1 )
if (ga_int%val(3) /= 3) then
write(*,*) 'Unexpected value after placeat!'
write(*,*) 'Expected 3 at pos 3, got ', ga_int%val(3)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! append growing array with 4
call append( me = ga_int, &
& val = [4,5,6] )
if (ga_int%val(6) /= 6) then
write(*,*) 'Unexpected value after append!'
write(*,*) 'Expected 6 at pos 6, got ', ga_int%val(6)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! truncate growing array
call truncate( me = ga_int )
if (ga_int%nvals /= ga_int%containersize) then
write(*,*) 'Containersize /= nvals after truncate!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! empty growing array
call empty( me = ga_int )
if (ga_int%nvals /= 0) then
write(*,*) 'Unexpected nvals after empty!'
write(*,*) 'Expected 0, got ', ga_int%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! destroy growing array
call destroy( me = ga_int )
if (ga_int%containersize /= 0) then
write(*,*) 'Unexpected containersize after destroy!'
write(*,*) 'Expected 0, got ', ga_int%containersize
write(*,*) 'FAILED'
elseif (ga_int%nvals /= 0) then
write(*,*) 'Unexpected nvals after destroy!'
write(*,*) 'Expected 0, got ', ga_int%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
case ('real_values')
! init growing array with size 2
call init( me = ga_real, &
& length = 2 )
if (ga_real%containersize /= 2) then
write(*,*) 'Unexpected containersize after init!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place 1013._rk at pos 2
call placeat( me = ga_real, &
& val = 1013._rk, &
& pos = 2 )
if (ga_real%val(2) .fne. 1013._rk) then
write(*,*) 'Unexpected value after placeat!'
write(*,*) 'Expected 1013._rk, got ', ga_real%val(2)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! expand growing array with length 3
call expand( me = ga_real, &
& length = 3 )
if (ga_real%containersize /= 5) then
write(*,*) 'Unexpected containersize after expand!'
write(*,*) 'Expected 5, got ', ga_real%containersize
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! place [1._rk, 2._rk, 3._rk] at pos 1
call placeat( me = ga_real, &
& val = [1._rk, 2._rk, 3._rk], &
& pos = 1 )
if (ga_real%val(3) .fne. 3._rk) then
write(*,*) 'Unexpected value after placeat!'
write(*,*) 'Expected 3._rk at pos 3, got ', ga_int%val(3)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! append growing array with 4._rk
call append( me = ga_real, &
& val = [4._rk,5._rk,6._rk] )
if (ga_real%val(6) .fne. 6._rk) then
write(*,*) 'Unexpected value after append!'
write(*,*) 'Expected 6._rk at pos 6, got ', ga_real%val(6)
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! truncate growing array
call truncate( me = ga_real )
if (ga_real%nvals /= ga_real%containersize) then
write(*,*) 'Containersize /= nvals after truncate!'
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! empty growing array
call empty( me = ga_real )
if (ga_real%nvals /= 0) then
write(*,*) 'Unexpected nvals after empty!'
write(*,*) 'Expected 0, got ', ga_real%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
! destroy growing array
call destroy( me = ga_real )
if (ga_real%containersize /= 0) then
write(*,*) 'Unexpected containersize after destroy!'
write(*,*) 'Expected 0, got ', ga_real%containersize
write(*,*) 'FAILED'
elseif (ga_real%nvals /= 0) then
write(*,*) 'Unexpected nvals after destroy!'
write(*,*) 'Expected 0, got ', ga_real%nvals
write(*,*) 'FAILED'
else
write(*,*) 'PASSED'
end if
end select
end subroutine check_grw_array