hydro/Routing/Subsurface/subsurface_tests.F

   1
   2 program subsurface_tests
   3     use module_subsurface_data
   4
   5     implicit none
   6
   7     logical rv
   8
   9     write(6,*) "Running Test 1"
  10     write(6,*) "Test that the allocation and deallocation functions work correctly"
  11     rv = init_delete_test(100,100,5)
  12     write(6,*) "Test Complete"
  13
  14     write(6,*) "Running Test 2"
  15     write(6,*) "Test Scaling"
  16     rv = scale_tests()
  17     write(6,*) "Test Complete"
  18
  19     write(6,*) "Running Test 3"
  20     write(6,*) "Testing Double Delete"
  21     rv = double_delete_test()
  22     write(6,*) "Test Complete"
  23
  24     write(6,*) "Running Test 4"
  25     write(6,*) "Testing Double Init"
  26     rv = double_init_test()
  27     write(6,*) "Test Complete"
  28     contains
  29
  30     function init_delete_test(ix,jx,nsoil) result(rv)
  31         use module_subsurface_data
  32         use overland_data
  33
  34         implicit none
  35
  36         integer, intent(in) :: ix ! horizontal resolution
  37         integer, intent(in) :: jx ! vertical resolution
  38         integer, intent(in) :: nsoil ! number of soil layers
  39         logical :: rv ! test result
  40
  41         logical :: status_val = .true.
  42
  43         type (subsurface_struct) :: subsurface_data
  44         type (overland_struct) :: ov_data
  45
  46         ! end of variable declarations
  47
  48         write(0,*) "ix = ", ix
  49         write(0,*) "jx = ", jx
  50         write(0,*) "nsoil = ", nsoil
  51
  52         call ov_data%init(ix,jx,ix,jx)
  53         call subsurface_data%init(ix,jx,nsoil,ov_data)
  54
  55         ! check to see that io was allocated
  56         if ( associated(subsurface_data%io) ) then
  57             write(6,*) "io type was associated"
  58         else
  59             write(6,*) "io type was not associated"
  60             status_val = .false.
  61         end if
  62
  63         ! check to see that properties was allocated
  64         if ( associated(subsurface_data%properties) ) then
  65             write(6,*) "properties type was associated"
  66         else
  67             write(6,*) "properties type was not associated"
  68             status_val = .false.
  69         end if
  70
  71         ! check to see that grid transform was allocated
  72         if ( associated(subsurface_data%grid_transform) ) then
  73             write(6,*) "grid_transfrom type was associated"
  74         else
  75             write(6,*) "grid_transfrom type was not associated"
  76             status_val = .false.
  77         end if
  78
  79         call subsurface_data%destroy
  80
  81          ! check to see that io was deallocated
  82         if ( .not. associated(subsurface_data%io) ) then
  83             write(6,*) "io type was disassociated"
  84         else
  85             write(6,*) "io type was not disassociated"
  86             status_val = .false.
  87         end if
  88
  89         ! check to see that properties was allocated
  90         if ( .not. associated(subsurface_data%properties) ) then
  91             write(6,*) "properties type was disassociated"
  92         else
  93             write(6,*) "properties type was not disassociated"
  94             status_val = .false.
  95         end if
  96
  97         ! check to see that grid transform was allocated
  98         if ( .not. associated(subsurface_data%grid_transform) ) then
  99             write(6,*) "grid_transfrom type was disassociated"
 100         else
 101             write(6,*) "grid_transfrom type was not disassociated"
 102             status_val = .false.
 103         end if
 104
 105         ! write final test results
 106         if ( status_val ) then
 107             write(6,*) "Test Passed"
 108         else
 109             write(6,*) "Test Failed"
 110         end if
 111
 112         rv = status_val
 113
 114     end function init_delete_test
 115
 116     function scale_tests() result(rv)
 117         logical :: rv
 118
 119         logical, dimension(4) :: results
 120         results = .false.
 121
 122         write(6,*) "Running Test for (10,10,5)"
 123         results(1) = init_delete_test(10,10,5)
 124         write(6,*) "Running Test for (100,100,5)"
 125         results(2) = init_delete_test(100,100,5)
 126         write(6,*) "Running Test for (1000,1000)"
 127         results(3) = init_delete_test(1000,1000,5)
 128         write(6,*) "Running Test for (5000,5000,5)"
 129         results(4) = init_delete_test(5000,5000,5)
 130
 131         if ( all(results) ) then
 132             rv = .true.
 133             write(6,*) "All Sub-Test Passed"
 134         else
 135             rv = .false.
 136             write(6,*) "At Least One Sub-Test Failed"
 137         end if
 138
 139     end function scale_tests
 140
 141     function double_delete_test() result(rv)
 142         logical :: rv
 143
 144         type (subsurface_struct) :: subsurface_data
 145         type (overland_struct) :: ov_data
 146
 147         call ov_data%init(100,100,100,100)
 148         call subsurface_data%init(100,100,5,ov_data)
 149         call subsurface_data%destroy
 150         call subsurface_data%destroy
 151
 152         rv = .true.
 153
 154     end function double_delete_test
 155
 156     function double_init_test() result(rv)
 157         logical :: rv
 158
 159         type (subsurface_struct) :: subsurface_data
 160         type (overland_struct) :: ov_data
 161
 162         call ov_data%init(100,100,100,100)
 163         call subsurface_data%init(100,100,5,ov_data)
 164         call subsurface_data%init(100,100,5,ov_data)
 165         call subsurface_data%destroy
 166
 167         rv = .true.
 168
 169     end function double_init_test
 170
 171 end program