hydro/Routing/Overland/overland_tests.F

   1 ! overland_tests.F
   2 ! Purpose: This program contains unit tests for the module overland_data
   3 ! National Water Center
   4 ! Responsibility: Donald W Johnson donald.w.johnson@noaa.gov
   5 ! Authors: Donald W Johnson
   6
   7 program overland_tests
   8     use overland_data
   9     implicit none
  10
  11     logical :: rv
  12
  13     write(6,*) "Running Test 1"
  14     write(6,*) "Test that the allocation and deallocation functions work correctly"
  15     rv = init_delete_test(100,100)
  16     write(6,*) "Test Complete"
  17
  18     write(6,*) "Running Test 2"
  19     write(6,*) "Testing scaling"
  20     rv = scale_tests()
  21     write(6,*) "Test Complete"
  22
  23     write(6,*) "Running Test 3"
  24     write(6,*) "Testing double init"
  25     rv = double_init_test()
  26     write(6,*) "Test Complete"
  27
  28     write(6,*) "Running Test 4"
  29     write(6,*) "Testing double destroy"
  30     rv = double_destroy_test()
  31     write(6,*) "Test Complete"
  32     contains
  33
  34     function init_delete_test(ix,jx) result(rv)
  35         implicit none
  36
  37         integer, intent(in) :: ix
  38         integer, intent(in) :: jx
  39         logical:: rv
  40
  41         logical :: status = .true.
  42
  43         type (overland_struct) :: overland_data
  44
  45         ! initalize the structure
  46         call overland_data%init(ix,jx,ix,jx)
  47
  48         ! test to see if control was associated
  49         if ( associated(overland_data%control) ) then
  50             !write(6,*) "control type was associated"
  51         else
  52             !write(6,*) "control type not associated"
  53             status = .false.
  54         end if
  55
  56         ! test to see if streams_and_lakes was associated
  57         if ( associated(overland_data%streams_and_lakes) ) then
  58             !write(6,*) "streams and lakes type was associated"
  59         else
  60             !write(6,*) "streams and lakes type not associated"
  61             status = .false.
  62         end if
  63
  64         ! test to see if streams_and_lakes was associated
  65         if ( associated(overland_data%properties) ) then
  66             !write(6,*) "properties type was associated"
  67         else
  68             !write(6,*) "properties type not associated"
  69             status = .false.
  70         end if
  71
  72         ! test to see if streams_and_lakes was associated
  73         if ( associated(overland_data%mass_balance) ) then
  74             !write(6,*) "mass_balance type was associated"
  75         else
  76             !write(6,*) "mass_balance type not associated"
  77             status = .false.
  78         end if
  79
  80         ! destroy the structure
  81         call overland_data%destroy
  82
  83         ! test to see if control was associated
  84         if ( .not. associated(overland_data%control) ) then
  85             !write(6,*) "control type was disassociated"
  86         else
  87             !write(6,*) "control type not disassociated"
  88             status = .false.
  89         end if
  90
  91         ! test to see if streams_and_lakes was associated
  92         if ( .not. associated(overland_data%streams_and_lakes) ) then
  93             !write(6,*) "streams and lakes type was disassociated"
  94         else
  95             !write(6,*) "streams and lakes type not disassociated"
  96             status = .false.
  97         end if
  98
  99         ! test to see if streams_and_lakes was associated
 100         if ( .not. associated(overland_data%properties) ) then
 101             !write(6,*) "properties type was disassociated"
 102         else
 103             !write(6,*) "properties type not disassociated"
 104             status = .false.
 105         end if
 106
 107         ! test to see if streams_and_lakes was associated
 108         if ( .not. associated(overland_data%mass_balance) ) then
 109             !write(6,*) "mass_balance type was disassociated"
 110         else
 111             !write(6,*) "mass_balance type not disassociated"
 112             status = .false.
 113         end if
 114
 115         ! write final test results
 116         if ( status ) then
 117             write(6,*) "Test Passed"
 118         else
 119             write(6,*) "Test Failed"
 120         end if
 121
 122         rv = status
 123     end function init_delete_test
 124
 125     function scale_tests() result(rv)
 126         logical :: rv
 127
 128         logical, dimension(4) :: results
 129         results = .false.
 130
 131         write(6,*) "Running Test for (10,10)"
 132         results(1) = init_delete_test(10,10)
 133         write(6,*) "Running Test for (100,100)"
 134         results(2) = init_delete_test(100,100)
 135         write(6,*) "Running Test for (1000,1000)"
 136         results(3) = init_delete_test(1000,1000)
 137         write(6,*) "Running Test for (5000,5000)"
 138         results(4) = init_delete_test(5000,5000)
 139
 140         if ( all(results) ) then
 141             rv = .true.
 142             write(6,*) "All Sub-Test Passed"
 143         else
 144             rv = .false.
 145             write(6,*) "At Least One Sub-Test Failed"
 146         end if
 147
 148     end function scale_tests
 149
 150     function double_init_test() result(rv)
 151         implicit none
 152         logical :: rv
 153
 154         type (overland_struct) :: overland_data
 155
 156         call overland_data%init(100,100,100,100)
 157         call overland_data%init(100,100,100,100)
 158         call overland_data%destroy
 159
 160         write(6,*) "Test Passed"
 161         rv = .true.
 162     end function double_init_test
 163
 164     function double_destroy_test() result(rv)
 165         implicit none
 166         logical :: rv
 167
 168         type (overland_struct) :: overland_data
 169
 170         call overland_data%init(100,100,100,100)
 171         call overland_data%destroy
 172         call overland_data%destroy
 173
 174         write(6,*) "Test Passed"
 175         rv = .true.
 176     end function double_destroy_test
 177
 178 end program overland_tests