| 1 | ! |
|---|
| 2 | ! !INTERFACE: |
|---|
| 3 | |
|---|
| 4 | module m_GGRIDTEST |
|---|
| 5 | ! |
|---|
| 6 | ! !USES: |
|---|
| 7 | ! |
|---|
| 8 | implicit none |
|---|
| 9 | |
|---|
| 10 | private ! except |
|---|
| 11 | |
|---|
| 12 | ! !PUBLIC MEMBER FUNCTIONS: |
|---|
| 13 | |
|---|
| 14 | public :: testall |
|---|
| 15 | public :: IndexAttr |
|---|
| 16 | public :: SortPermute |
|---|
| 17 | public :: ImportExport |
|---|
| 18 | public :: Identical |
|---|
| 19 | |
|---|
| 20 | interface testall |
|---|
| 21 | module procedure testGGrid_ |
|---|
| 22 | end interface |
|---|
| 23 | interface IndexAttr |
|---|
| 24 | module procedure IndexTest_ |
|---|
| 25 | end interface |
|---|
| 26 | interface SortPermute |
|---|
| 27 | module procedure SortPermuteTest_ |
|---|
| 28 | end interface |
|---|
| 29 | interface ImportExport |
|---|
| 30 | module procedure ImportExportTest_ |
|---|
| 31 | end interface |
|---|
| 32 | interface Identical |
|---|
| 33 | module procedure Identical_ |
|---|
| 34 | end interface |
|---|
| 35 | |
|---|
| 36 | ! !REVISION HISTORY: |
|---|
| 37 | !EOP ___________________________________________________________________ |
|---|
| 38 | |
|---|
| 39 | character(len=*),parameter :: myname='m_GGridTest' |
|---|
| 40 | |
|---|
| 41 | contains |
|---|
| 42 | |
|---|
| 43 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 44 | ! Math and Computer Science Division, Argonne National Laboratory ! |
|---|
| 45 | !BOP ------------------------------------------------------------------- |
|---|
| 46 | ! |
|---|
| 47 | ! !IROUTINE: testGGRID_ - Test the functions in the GeneralGrid module |
|---|
| 48 | ! |
|---|
| 49 | ! !DESCRIPTION: |
|---|
| 50 | ! This routine writes diagnostic information about the input |
|---|
| 51 | ! {\tt GeneralGrid}. Each line of the output will be preceded by the |
|---|
| 52 | ! character argument {\tt identifier}. The output device is specified |
|---|
| 53 | ! by the integer argument {\tt device}. |
|---|
| 54 | ! |
|---|
| 55 | ! !INTERFACE: |
|---|
| 56 | |
|---|
| 57 | subroutine testGGrid_(GGrid, identifier, device) |
|---|
| 58 | |
|---|
| 59 | ! |
|---|
| 60 | ! !USES: |
|---|
| 61 | ! |
|---|
| 62 | use m_GeneralGrid, only: GeneralGrid,init,clean,dims,lsize ! Use all GeneralGrid routines |
|---|
| 63 | use m_List, only : ListExportToChar => exportToChar |
|---|
| 64 | use m_List, only : List_allocated => allocated |
|---|
| 65 | use m_AttrVect, only : AttrVect_copy => copy |
|---|
| 66 | use m_stdio |
|---|
| 67 | use m_die |
|---|
| 68 | |
|---|
| 69 | implicit none |
|---|
| 70 | |
|---|
| 71 | ! !INPUT PARAMETERS: |
|---|
| 72 | |
|---|
| 73 | type(GeneralGrid), intent(in) :: GGrid |
|---|
| 74 | character(len=*), intent(in) :: identifier |
|---|
| 75 | integer, intent(in) :: device |
|---|
| 76 | |
|---|
| 77 | ! !REVISION HISTORY: |
|---|
| 78 | ! 23Sep02 - E.T. Ong <eong@mcs.anl.gov> - initial prototype. |
|---|
| 79 | !EOP ___________________________________________________________________ |
|---|
| 80 | |
|---|
| 81 | character(len=*),parameter :: myname_=myname//'::GGridtest_' |
|---|
| 82 | type(GeneralGrid) :: GGridExactCopy1, GGridExactCopy2 |
|---|
| 83 | integer :: i,j,k |
|---|
| 84 | logical :: calledinitl_ |
|---|
| 85 | |
|---|
| 86 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
|---|
| 87 | !:::::WRITE OUT INFO ABOUT THE ATTRVECT::::::::::::::::::::::::::::::::: |
|---|
| 88 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
|---|
| 89 | |
|---|
| 90 | write(device,*) identifier, ":: TYPE CHECK" |
|---|
| 91 | |
|---|
| 92 | if(List_allocated(GGrid%coordinate_list)) then |
|---|
| 93 | write(device,*) identifier, ":: COORDINATE_LIST = ", & |
|---|
| 94 | ListExportToChar(GGrid%coordinate_list) |
|---|
| 95 | else |
|---|
| 96 | call die(myname_,"COORDINATE_LIST IS NOT INITIALIZED!") |
|---|
| 97 | endif |
|---|
| 98 | |
|---|
| 99 | if(List_allocated(GGrid%coordinate_sort_order)) then |
|---|
| 100 | write(device,*) identifier, ":: COORDINATE_SORT_ORDER = ", & |
|---|
| 101 | ListExportToChar(GGrid%coordinate_sort_order) |
|---|
| 102 | else |
|---|
| 103 | write(device,*) identifier, ":: COORDINATE_SORT_ORDER NOT INITIALIZED" |
|---|
| 104 | endif |
|---|
| 105 | |
|---|
| 106 | if(associated(GGrid%descend)) then |
|---|
| 107 | write(device,*) identifier, ":: DESCEND = ", & |
|---|
| 108 | size(GGrid%descend), GGrid%descend |
|---|
| 109 | else |
|---|
| 110 | write(device,*) identifier, ":: DESCEND NOT ASSOCIATED" |
|---|
| 111 | endif |
|---|
| 112 | |
|---|
| 113 | if(List_allocated(GGrid%weight_list)) then |
|---|
| 114 | write(device,*) identifier, ":: WEIGHT_LIST = ", & |
|---|
| 115 | ListExportToChar(GGrid%weight_list) |
|---|
| 116 | else |
|---|
| 117 | write(device,*) identifier, ":: WEIGHT_LIST NOT INITIALIZED" |
|---|
| 118 | endif |
|---|
| 119 | |
|---|
| 120 | if(List_allocated(GGrid%other_list)) then |
|---|
| 121 | write(device,*) identifier, ":: OTHER_LIST = ", & |
|---|
| 122 | ListExportToChar(GGrid%other_list) |
|---|
| 123 | else |
|---|
| 124 | write(device,*) identifier, ":: OTHER_LIST NOT INITIALIZED" |
|---|
| 125 | endif |
|---|
| 126 | |
|---|
| 127 | if(List_allocated(GGrid%index_list)) then |
|---|
| 128 | write(device,*) identifier, ":: INDEX_LIST = ", & |
|---|
| 129 | ListExportToChar(GGrid%index_list) |
|---|
| 130 | else |
|---|
| 131 | write(device,*) identifier, ":: INDEX_LIST NOT INITIALIZED" |
|---|
| 132 | endif |
|---|
| 133 | |
|---|
| 134 | if(List_allocated(GGrid%data%iList)) then |
|---|
| 135 | write(device,*) identifier, ":: DATA%ILIST = ", & |
|---|
| 136 | ListExportToChar(GGrid%data%iList) |
|---|
| 137 | else |
|---|
| 138 | write(device,*) identifier, ":: DATA%ILIST NOT INITIALIZED" |
|---|
| 139 | endif |
|---|
| 140 | |
|---|
| 141 | if(List_allocated(GGrid%data%rList)) then |
|---|
| 142 | write(device,*) identifier, ":: DATA%RLIST = ", & |
|---|
| 143 | ListExportToChar(GGrid%data%rList) |
|---|
| 144 | else |
|---|
| 145 | write(device,*) identifier, ":: DATA%RLIST NOT INITIALIZED" |
|---|
| 146 | endif |
|---|
| 147 | |
|---|
| 148 | write(device,*) identifier, ":: DIMS = ", dims(GGrid) |
|---|
| 149 | write(device,*) identifier, ":: LSIZE = ", lsize(GGrid) |
|---|
| 150 | |
|---|
| 151 | call init(GGridExactCopy1,GGrid,lsize(GGrid)) |
|---|
| 152 | call AttrVect_copy(aVin=GGrid%data,aVout=GGridExactCopy1%data) |
|---|
| 153 | |
|---|
| 154 | calledinitl_=.false. |
|---|
| 155 | |
|---|
| 156 | if( ((((List_allocated(GGrid%coordinate_sort_order).AND.& |
|---|
| 157 | List_allocated(GGrid%weight_list)).AND.& |
|---|
| 158 | List_allocated(GGrid%other_list)).AND.& |
|---|
| 159 | List_allocated(GGrid%index_list)).AND.& |
|---|
| 160 | ASSOCIATED(GGrid%descend)) ) then |
|---|
| 161 | calledinitl_=.true. |
|---|
| 162 | call init(GGrid=GGridExactCopy2,& |
|---|
| 163 | CoordList=GGrid%coordinate_list, & |
|---|
| 164 | CoordSortOrder=GGrid%coordinate_sort_order, & |
|---|
| 165 | descend=GGrid%descend, & |
|---|
| 166 | WeightList=GGrid%weight_list, & |
|---|
| 167 | OtherList=GGrid%other_list, & |
|---|
| 168 | IndexList=GGrid%index_list, & |
|---|
| 169 | lsize=lsize(GGrid)) |
|---|
| 170 | call AttrVect_copy(aVin=GGrid%data,aVout=GGridExactCopy2%data) |
|---|
| 171 | else |
|---|
| 172 | write(device,*) identifier, ":: NOT TESTING INIL_. PLEASE & |
|---|
| 173 | &CONSULT SOURCE CODE." |
|---|
| 174 | endif |
|---|
| 175 | |
|---|
| 176 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
|---|
| 177 | !:::::TESTING INDEXIA AND GETILIST:::::::::::::::::::::::::::::::::::::: |
|---|
| 178 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
|---|
| 179 | |
|---|
| 180 | call IndexTest_(GGrid,identifier,device) |
|---|
| 181 | |
|---|
| 182 | |
|---|
| 183 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! |
|---|
| 184 | !:::::TESTING SORT AND PERMUTE:::::::::::::::::::::::::::::::::::::::::! |
|---|
| 185 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! |
|---|
| 186 | |
|---|
| 187 | ! NOTE: THIS IS NOT A CHECK FOR CORRECTNESS, JUST A CHECK FOR CONSISTENCY |
|---|
| 188 | |
|---|
| 189 | call SortPermuteTest_(GGrid,identifier,device) |
|---|
| 190 | |
|---|
| 191 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! |
|---|
| 192 | !:::::TESTING EXPORT AND IMPORT FUNCTIONS::::::::::::::::::::::::::::::::! |
|---|
| 193 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! |
|---|
| 194 | |
|---|
| 195 | call ImportExportTest_(GGrid,identifier,device) |
|---|
| 196 | |
|---|
| 197 | ! Check that GGrid is unchanged! |
|---|
| 198 | |
|---|
| 199 | if(.NOT.Identical_(GGrid,GGridExactCopy1,1e-5)) then |
|---|
| 200 | call die(myname_,"GGrid has been unexpectedly altered!!!") |
|---|
| 201 | endif |
|---|
| 202 | |
|---|
| 203 | call clean(GGridExactCopy1) |
|---|
| 204 | |
|---|
| 205 | if(calledinitl_) then |
|---|
| 206 | if(.NOT.Identical_(GGrid,GGridExactCopy2,1e-5)) then |
|---|
| 207 | call die(myname_,"GGrid has been unexpectedly altered!!!") |
|---|
| 208 | endif |
|---|
| 209 | call clean(GGridExactCopy2) |
|---|
| 210 | endif |
|---|
| 211 | |
|---|
| 212 | end subroutine testGGrid_ |
|---|
| 213 | |
|---|
| 214 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
|---|
| 215 | !:::::TEST FOR INDEXIA AND GETILIST:::::::::::::::::::::::::::::::::::::: |
|---|
| 216 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
|---|
| 217 | |
|---|
| 218 | subroutine IndexTest_(GGrid,identifier,device) |
|---|
| 219 | |
|---|
| 220 | use m_GeneralGrid, only: GeneralGrid,indexIA,indexRA |
|---|
| 221 | use m_AttrVect, only : getIList, getRList |
|---|
| 222 | use m_AttrVect, only : nIAttr,nRAttr |
|---|
| 223 | use m_List, only: List_allocated => allocated |
|---|
| 224 | use m_String, only: String |
|---|
| 225 | use m_String, only: StringToChar => toChar |
|---|
| 226 | use m_String, only: String_clean => clean |
|---|
| 227 | use m_stdio |
|---|
| 228 | use m_die |
|---|
| 229 | |
|---|
| 230 | implicit none |
|---|
| 231 | |
|---|
| 232 | type(GeneralGrid), intent(in) :: GGrid |
|---|
| 233 | character(len=*), intent(in) :: identifier |
|---|
| 234 | integer, intent(in) :: device |
|---|
| 235 | |
|---|
| 236 | character(len=*),parameter :: myname_=myname//'::IndexTest_' |
|---|
| 237 | type(String) :: ItemStr |
|---|
| 238 | integer :: i,j,k,ierr |
|---|
| 239 | |
|---|
| 240 | if(nIAttr(GGrid%data)>0) then |
|---|
| 241 | write(device,*) identifier, ":: Testing indexIA and getIList::" |
|---|
| 242 | else |
|---|
| 243 | if(List_allocated(GGrid%data%iList)) then |
|---|
| 244 | call die(myname_,"iList has been allocated, :& |
|---|
| 245 | &but there are no atttributes. :& |
|---|
| 246 | &Please do not initialize a blank list.") |
|---|
| 247 | end if |
|---|
| 248 | if(associated(GGrid%data%iAttr)) then |
|---|
| 249 | if(size(GGrid%data%iAttr,1) /= 0) then |
|---|
| 250 | call die(myname_,"iAttr contains no attributes, & |
|---|
| 251 | &yet its size /= 0",size(GGrid%data%iAttr,1)) |
|---|
| 252 | endif |
|---|
| 253 | endif |
|---|
| 254 | end if |
|---|
| 255 | |
|---|
| 256 | do i=1,nIAttr(GGrid%data) |
|---|
| 257 | |
|---|
| 258 | call getIList(ItemStr,i,GGrid%data) |
|---|
| 259 | j = indexIA(GGrid,StringToChar(ItemStr)) |
|---|
| 260 | if(i/=j) call die(myname_,"Function indexIA failed!") |
|---|
| 261 | write(device,*) identifier, & |
|---|
| 262 | ":: GGrid Index = ", j, & |
|---|
| 263 | ":: Attribute Name = ", StringToChar(ItemStr) |
|---|
| 264 | call String_clean(ItemStr) |
|---|
| 265 | |
|---|
| 266 | enddo |
|---|
| 267 | |
|---|
| 268 | if(nRAttr(GGrid%data)>0) then |
|---|
| 269 | write(device,*) identifier, ":: Testing indexRA and getRList::" |
|---|
| 270 | else |
|---|
| 271 | if(List_allocated(GGrid%data%rList)) then |
|---|
| 272 | call die(myname_,"rList has been allocated, :& |
|---|
| 273 | &but there are no atttributes. :& |
|---|
| 274 | &Please do not initialize a blank list.") |
|---|
| 275 | end if |
|---|
| 276 | if(associated(GGrid%data%rAttr)) then |
|---|
| 277 | if(size(GGrid%data%rAttr,1) /= 0) then |
|---|
| 278 | call die(myname_,"rAttr contains no attributes, & |
|---|
| 279 | &yet its size /= 0",size(GGrid%data%rAttr,1)) |
|---|
| 280 | endif |
|---|
| 281 | endif |
|---|
| 282 | end if |
|---|
| 283 | |
|---|
| 284 | do i=1,nRAttr(GGrid%data) |
|---|
| 285 | |
|---|
| 286 | call getRList(ItemStr,i,GGrid%data) |
|---|
| 287 | j = indexRA(GGrid,StringToChar(ItemStr)) |
|---|
| 288 | if(i/=j) call die(myname_,"Function indexIA failed!") |
|---|
| 289 | write(device,*) identifier, & |
|---|
| 290 | "::GGrid Index = ", j, & |
|---|
| 291 | "::Attribute Name = ", StringToChar(ItemStr) |
|---|
| 292 | call String_clean(ItemStr) |
|---|
| 293 | |
|---|
| 294 | enddo |
|---|
| 295 | |
|---|
| 296 | end subroutine IndexTest_ |
|---|
| 297 | |
|---|
| 298 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! |
|---|
| 299 | !:::::TEST FOR SORT AND PERMUTE:::::::::::::::::::::::::::::::::::::::::! |
|---|
| 300 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! |
|---|
| 301 | |
|---|
| 302 | ! NOTE: THIS IS NOT A CHECK FOR CORRECTNESS, JUST A CHECK FOR CONSISTENCY |
|---|
| 303 | |
|---|
| 304 | subroutine SortPermuteTest_(GGrid,identifier,device) |
|---|
| 305 | |
|---|
| 306 | use m_GeneralGrid |
|---|
| 307 | use m_AttrVect, only: nIAttr, nRAttr, Zero |
|---|
| 308 | use m_stdio |
|---|
| 309 | use m_die |
|---|
| 310 | |
|---|
| 311 | use m_realkinds, only : FP |
|---|
| 312 | |
|---|
| 313 | implicit none |
|---|
| 314 | |
|---|
| 315 | type(GeneralGrid), intent(in) :: GGrid |
|---|
| 316 | character(len=*), intent(in) :: identifier |
|---|
| 317 | integer, intent(in) :: device |
|---|
| 318 | |
|---|
| 319 | character(len=*),parameter :: myname_=myname//'::SortPermuteTest_' |
|---|
| 320 | type(GeneralGrid) :: GGRIDCOPY1, GGRIDCOPY2 |
|---|
| 321 | logical,dimension(:), pointer :: descend |
|---|
| 322 | integer,dimension(:), pointer :: perm |
|---|
| 323 | integer :: i,j,k,ierr |
|---|
| 324 | real :: r |
|---|
| 325 | |
|---|
| 326 | if( associated(GGrid%descend) ) then |
|---|
| 327 | |
|---|
| 328 | write(device,*) identifier, ":: Testing Sort and Permute" |
|---|
| 329 | |
|---|
| 330 | call init(oGGrid=GGRIDCOPY1,iGGrid=GGrid,lsize=100) |
|---|
| 331 | call init(oGGrid=GGRIDCOPY2,iGGrid=GGrid,lsize=100) |
|---|
| 332 | |
|---|
| 333 | call Zero(GGRIDCOPY1%data) |
|---|
| 334 | call Zero(GGRIDCOPY2%data) |
|---|
| 335 | |
|---|
| 336 | if(nIAttr(GGRIDCOPY1%data)>0) then |
|---|
| 337 | |
|---|
| 338 | k=0 |
|---|
| 339 | do i=1,nIAttr(GGRIDCOPY1%data) |
|---|
| 340 | do j=1,lsize(GGRIDCOPY1) |
|---|
| 341 | k=k+1 |
|---|
| 342 | GGRIDCOPY1%data%iAttr(i,j) = k |
|---|
| 343 | GGRIDCOPY2%data%iAttr(i,j) = k |
|---|
| 344 | enddo |
|---|
| 345 | enddo |
|---|
| 346 | endif |
|---|
| 347 | if(nRAttr(GGRIDCOPY1%data)>0) then |
|---|
| 348 | |
|---|
| 349 | r=0. |
|---|
| 350 | do i=1,nRAttr(GGRIDCOPY1%data) |
|---|
| 351 | do j=1,lsize(GGRIDCOPY1) |
|---|
| 352 | r=r+1.29 |
|---|
| 353 | GGRIDCOPY1%data%rAttr(i,j) = r |
|---|
| 354 | GGRIDCOPY2%data%rAttr(i,j) = r |
|---|
| 355 | enddo |
|---|
| 356 | enddo |
|---|
| 357 | endif |
|---|
| 358 | |
|---|
| 359 | call Sort(GGrid=GGRIDCOPY1,key_List=GGRIDCOPY1%coordinate_sort_order,perm=perm,descend=GGrid%descend) |
|---|
| 360 | call Permute(GGrid=GGRIDCOPY1,perm=perm) |
|---|
| 361 | |
|---|
| 362 | call SortPermute(GGrid=GGRIDCOPY2) |
|---|
| 363 | |
|---|
| 364 | deallocate(perm,stat=ierr) |
|---|
| 365 | if(ierr /= 0) call die(myname_,"deallocate(perm)") |
|---|
| 366 | |
|---|
| 367 | if(nIAttr(GGRIDCOPY1%data)>0) then |
|---|
| 368 | |
|---|
| 369 | do i=1,nIAttr(GGRIDCOPY1%data) |
|---|
| 370 | do j=1,lsize(GGRIDCOPY1) |
|---|
| 371 | if(GGRIDCOPY1%data%iAttr(i,j) /= GGRIDCOPY2%data%iAttr(i,j)) then |
|---|
| 372 | call die(myname_,"Sort Testing FAILED!") |
|---|
| 373 | endif |
|---|
| 374 | enddo |
|---|
| 375 | enddo |
|---|
| 376 | |
|---|
| 377 | write(device,*) identifier, ":: INTEGER GGRID%DATA IN ", GGrid%descend, & |
|---|
| 378 | " ORDER:: ", GGRIDCOPY1%data%iAttr(1,1:5) |
|---|
| 379 | |
|---|
| 380 | endif |
|---|
| 381 | |
|---|
| 382 | if(nRAttr(GGRIDCOPY1%data)>0) then |
|---|
| 383 | |
|---|
| 384 | do i=1,nRAttr(GGRIDCOPY1%data) |
|---|
| 385 | do j=1,lsize(GGRIDCOPY1) |
|---|
| 386 | if(GGRIDCOPY1%data%rAttr(i,j) /= GGRIDCOPY2%data%rAttr(i,j)) then |
|---|
| 387 | call die(myname_,"Sort Testing FAILED!") |
|---|
| 388 | endif |
|---|
| 389 | enddo |
|---|
| 390 | enddo |
|---|
| 391 | |
|---|
| 392 | write(device,*) identifier, ":: REAL GGRID%DATA IN ", GGrid%descend, & |
|---|
| 393 | " ORDER:: ", GGRIDCOPY1%data%rAttr(1,1:5) |
|---|
| 394 | |
|---|
| 395 | endif |
|---|
| 396 | |
|---|
| 397 | call clean(GGRIDCOPY1) |
|---|
| 398 | call clean(GGRIDCOPY2) |
|---|
| 399 | else |
|---|
| 400 | write(device,*) identifier, ":: NOT TESTING SORTING AND PERMUTING. CONSULT & |
|---|
| 401 | &SOURCE CODE TO ENABLE TESTING." |
|---|
| 402 | endif |
|---|
| 403 | |
|---|
| 404 | end subroutine SortPermuteTest_ |
|---|
| 405 | |
|---|
| 406 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! |
|---|
| 407 | !:::::TEST FOR EXPORT AND IMPORT FUNCTIONS:::::::::::::::::::::::::::::::! |
|---|
| 408 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! |
|---|
| 409 | |
|---|
| 410 | subroutine ImportExportTest_(GGrid,identifier,device) |
|---|
| 411 | |
|---|
| 412 | use m_GeneralGrid |
|---|
| 413 | use m_AttrVect, only : exportIList, exportRList |
|---|
| 414 | use m_AttrVect, only : AttrVect_zero => zero |
|---|
| 415 | use m_AttrVect, only : nIAttr, nRAttr |
|---|
| 416 | use m_List, only : List |
|---|
| 417 | use m_List, only : List_identical => identical |
|---|
| 418 | use m_List, only : List_get => get |
|---|
| 419 | use m_List, only : List_clean => clean |
|---|
| 420 | use m_String, only : String |
|---|
| 421 | use m_String, only : StringToChar => toChar |
|---|
| 422 | use m_String, only : String_clean => clean |
|---|
| 423 | use m_stdio |
|---|
| 424 | use m_die |
|---|
| 425 | |
|---|
| 426 | use m_realkinds, only : FP |
|---|
| 427 | |
|---|
| 428 | implicit none |
|---|
| 429 | |
|---|
| 430 | type(GeneralGrid), intent(in) :: GGrid |
|---|
| 431 | character(len=*), intent(in) :: identifier |
|---|
| 432 | integer, intent(in) :: device |
|---|
| 433 | |
|---|
| 434 | character(len=*),parameter :: myname_=myname//'::ImportExportTest_' |
|---|
| 435 | type(GeneralGrid) :: importGGrid |
|---|
| 436 | type(List) :: OutIList, OutRList |
|---|
| 437 | type(String) :: ItemStr |
|---|
| 438 | integer,dimension(:),pointer :: OutIVect |
|---|
| 439 | real(FP), dimension(:),pointer :: OutRVect |
|---|
| 440 | integer :: exportsize |
|---|
| 441 | integer :: i,j,k,ierr |
|---|
| 442 | |
|---|
| 443 | write(device,*) identifier, ":: Testing import and export functions" |
|---|
| 444 | |
|---|
| 445 | if(nIAttr(GGrid%data)>0) then |
|---|
| 446 | |
|---|
| 447 | call exportIList(aV=GGrid%data,outIList=outIList) |
|---|
| 448 | |
|---|
| 449 | if(.NOT. List_identical(GGrid%data%iList,outIList)) then |
|---|
| 450 | call die(myname_, "Function exportIList failed!") |
|---|
| 451 | endif |
|---|
| 452 | |
|---|
| 453 | call List_get(ItemStr=ItemStr,ith=nIAttr(GGrid%data),aList=GGrid%data%iList) |
|---|
| 454 | |
|---|
| 455 | allocate(outIVect(lsize(GGrid)),stat=ierr) |
|---|
| 456 | if(ierr/=0) call die(myname_,"allocate(outIVect)") |
|---|
| 457 | |
|---|
| 458 | call exportIAttr(GGrid=GGrid,AttrTag=StringToChar(ItemStr), & |
|---|
| 459 | outVect=OutIVect,lsize=exportsize) |
|---|
| 460 | |
|---|
| 461 | if(exportsize /= lsize(GGrid)) then |
|---|
| 462 | call die(myname_,"(exportsize /= lsize(GGrid))") |
|---|
| 463 | endif |
|---|
| 464 | |
|---|
| 465 | do i=1,exportsize |
|---|
| 466 | if(GGrid%data%iAttr(nIAttr(GGrid%data),i) /= outIVect(i)) then |
|---|
| 467 | call die(myname_,"Function exportIAttr failed!") |
|---|
| 468 | endif |
|---|
| 469 | enddo |
|---|
| 470 | |
|---|
| 471 | call init(oGGrid=importGGrid,iGGrid=GGrid,lsize=exportsize) |
|---|
| 472 | call AttrVect_zero(importGGrid%data) |
|---|
| 473 | |
|---|
| 474 | call importIAttr(GGrid=importGGrid,AttrTag=StringToChar(ItemStr), & |
|---|
| 475 | inVect=outIVect,lsize=exportsize) |
|---|
| 476 | |
|---|
| 477 | j=indexIA(importGGrid,StringToChar(ItemStr)) |
|---|
| 478 | if(j<=0) call die(myname_,"indexIA(importGGrid,StringToChar(ItemStr))") |
|---|
| 479 | do i=1,exportsize |
|---|
| 480 | if(importGGrid%data%iAttr(j,i) /= outIVect(i)) then |
|---|
| 481 | call die(myname_,"Function importIAttr failed!") |
|---|
| 482 | endif |
|---|
| 483 | enddo |
|---|
| 484 | |
|---|
| 485 | call clean(importGGrid) |
|---|
| 486 | call List_clean(outIList) |
|---|
| 487 | call String_clean(ItemStr) |
|---|
| 488 | |
|---|
| 489 | deallocate(outIVect,stat=ierr) |
|---|
| 490 | if(ierr/=0) call die(myname_,"deallocate(outIVect)") |
|---|
| 491 | |
|---|
| 492 | endif |
|---|
| 493 | |
|---|
| 494 | if(nRAttr(GGrid%data)>0) then |
|---|
| 495 | |
|---|
| 496 | call exportRList(aV=GGrid%data,outRList=outRList) |
|---|
| 497 | |
|---|
| 498 | if(.NOT. List_identical(GGrid%data%rList,outRList)) then |
|---|
| 499 | call die(myname_, "Function exportRList failed!") |
|---|
| 500 | endif |
|---|
| 501 | |
|---|
| 502 | call List_get(ItemStr=ItemStr,ith=nRAttr(GGrid%data),aList=GGrid%data%rList) |
|---|
| 503 | |
|---|
| 504 | allocate(outRVect(lsize(GGrid)),stat=ierr) |
|---|
| 505 | if(ierr/=0) call die(myname_,"allocate(outRVect)") |
|---|
| 506 | |
|---|
| 507 | call exportRAttr(GGrid=GGrid,AttrTag=StringToChar(ItemStr), & |
|---|
| 508 | outVect=OutRVect,lsize=exportsize) |
|---|
| 509 | |
|---|
| 510 | if(exportsize /= lsize(GGrid)) then |
|---|
| 511 | call die(myname_,"(exportsize /= lsize(GGrid))") |
|---|
| 512 | endif |
|---|
| 513 | |
|---|
| 514 | do i=1,exportsize |
|---|
| 515 | if(GGrid%data%rAttr(nRAttr(GGrid%data),i) /= outRVect(i)) then |
|---|
| 516 | call die(myname_,"Function exportRAttr failed!") |
|---|
| 517 | endif |
|---|
| 518 | enddo |
|---|
| 519 | |
|---|
| 520 | call init(oGGrid=importGGrid,iGGrid=GGrid,lsize=exportsize) |
|---|
| 521 | call AttrVect_zero(importGGrid%data) |
|---|
| 522 | |
|---|
| 523 | call importRAttr(GGrid=importGGrid,AttrTag=StringToChar(ItemStr), & |
|---|
| 524 | inVect=outRVect,lsize=exportsize) |
|---|
| 525 | |
|---|
| 526 | j=indexRA(importGGrid,StringToChar(ItemStr)) |
|---|
| 527 | if(j<=0) call die(myname_,"indexRA(importGGrid,StringToChar(ItemStr))") |
|---|
| 528 | do i=1,exportsize |
|---|
| 529 | if(importGGrid%data%rAttr(j,i) /= outRVect(i)) then |
|---|
| 530 | call die(myname_,"Function importRAttr failed!") |
|---|
| 531 | endif |
|---|
| 532 | enddo |
|---|
| 533 | |
|---|
| 534 | call clean(importGGrid) |
|---|
| 535 | call List_clean(outRList) |
|---|
| 536 | call String_clean(ItemStr) |
|---|
| 537 | |
|---|
| 538 | deallocate(outRVect,stat=ierr) |
|---|
| 539 | if(ierr/=0) call die(myname_,"deallocate(outRVect)") |
|---|
| 540 | |
|---|
| 541 | endif |
|---|
| 542 | |
|---|
| 543 | end subroutine ImportExportTest_ |
|---|
| 544 | |
|---|
| 545 | logical function Identical_(GGrid1,GGrid2,Range) |
|---|
| 546 | |
|---|
| 547 | use m_GeneralGrid, only: GeneralGrid |
|---|
| 548 | use m_AVTEST,only: AttrVect_identical => Identical |
|---|
| 549 | use m_List,only : List_allocated => allocated |
|---|
| 550 | use m_List,only : List_identical => identical |
|---|
| 551 | use m_stdio |
|---|
| 552 | use m_die |
|---|
| 553 | |
|---|
| 554 | use m_realkinds, only : FP |
|---|
| 555 | |
|---|
| 556 | implicit none |
|---|
| 557 | |
|---|
| 558 | type(GeneralGrid), intent(in) :: GGrid1 |
|---|
| 559 | type(GeneralGrid), intent(in) :: GGrid2 |
|---|
| 560 | real, optional, intent(in) :: Range |
|---|
| 561 | |
|---|
| 562 | integer :: i,j,k |
|---|
| 563 | |
|---|
| 564 | Identical_=.true. |
|---|
| 565 | |
|---|
| 566 | if(present(Range)) then |
|---|
| 567 | if(.NOT. AttrVect_identical(GGrid1%data,GGrid2%data,Range)) then |
|---|
| 568 | Identical_=.false. |
|---|
| 569 | endif |
|---|
| 570 | else |
|---|
| 571 | if(.NOT. AttrVect_identical(GGrid1%data,GGrid2%data)) then |
|---|
| 572 | Identical_=.false. |
|---|
| 573 | endif |
|---|
| 574 | endif |
|---|
| 575 | |
|---|
| 576 | if(.NOT. List_identical(GGrid1%coordinate_list, & |
|---|
| 577 | GGrid2%coordinate_list) ) then |
|---|
| 578 | Identical_=.false. |
|---|
| 579 | endif |
|---|
| 580 | |
|---|
| 581 | if( List_allocated(GGrid1%coordinate_sort_order) .or. & |
|---|
| 582 | List_allocated(GGrid2%coordinate_sort_order) ) then |
|---|
| 583 | if(.NOT. List_identical(GGrid1%coordinate_sort_order, & |
|---|
| 584 | GGrid2%coordinate_sort_order) ) then |
|---|
| 585 | Identical_=.false. |
|---|
| 586 | endif |
|---|
| 587 | endif |
|---|
| 588 | |
|---|
| 589 | if( List_allocated(GGrid1%weight_list) .or. & |
|---|
| 590 | List_allocated(GGrid2%weight_list) ) then |
|---|
| 591 | if(.NOT. List_identical(GGrid1%weight_list, & |
|---|
| 592 | GGrid2%weight_list) ) then |
|---|
| 593 | Identical_=.false. |
|---|
| 594 | endif |
|---|
| 595 | endif |
|---|
| 596 | |
|---|
| 597 | if( List_allocated(GGrid1%other_list) .or. & |
|---|
| 598 | List_allocated(GGrid2%other_list) ) then |
|---|
| 599 | if(.NOT. List_identical(GGrid1%other_list, & |
|---|
| 600 | GGrid2%other_list) ) then |
|---|
| 601 | Identical_=.false. |
|---|
| 602 | endif |
|---|
| 603 | endif |
|---|
| 604 | |
|---|
| 605 | if( List_allocated(GGrid1%index_list) .or. & |
|---|
| 606 | List_allocated(GGrid2%index_list) ) then |
|---|
| 607 | if(.NOT. List_identical(GGrid1%index_list, & |
|---|
| 608 | GGrid2%index_list) ) then |
|---|
| 609 | Identical_=.false. |
|---|
| 610 | endif |
|---|
| 611 | endif |
|---|
| 612 | |
|---|
| 613 | if(associated(GGrid1%descend) .and. & |
|---|
| 614 | associated(GGrid2%descend)) then |
|---|
| 615 | |
|---|
| 616 | if(size(GGrid1%descend) == size(GGrid2%descend)) then |
|---|
| 617 | do i=1,size(GGrid1%descend) |
|---|
| 618 | if(GGrid1%descend(i).neqv.GGrid2%descend(i)) then |
|---|
| 619 | Identical_=.false. |
|---|
| 620 | endif |
|---|
| 621 | enddo |
|---|
| 622 | else |
|---|
| 623 | Identical_=.false. |
|---|
| 624 | endif |
|---|
| 625 | |
|---|
| 626 | endif |
|---|
| 627 | |
|---|
| 628 | if((associated(GGrid1%descend).and..NOT.associated(GGrid2%descend)).or.& |
|---|
| 629 | (.NOT.associated(GGrid1%descend).and.associated(GGrid2%descend)))then |
|---|
| 630 | Identical_=.false. |
|---|
| 631 | endif |
|---|
| 632 | |
|---|
| 633 | end function Identical_ |
|---|
| 634 | |
|---|
| 635 | |
|---|
| 636 | end module m_GGRIDTEST |
|---|
