test_grid2.f

Go to the documentation of this file.

C> @file tests/test_grid2.f
C> Unit test for the data type GRIDMAN_GRID and it's methods
C GRIDMAN, grid managment library. Author: Vladislav Kotov, v.kotov@fz-juelich.de

!    Copyright (c) 2017  Forschungszentrum Juelich GmbH
!                        Vladislav Kotov 
!
!    This file is part of GRIDMAN.
!
!    GRIDMAN is free software: you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation, either version 3 of the License, or
!    (at your option) any later version.
!
!    GRIDMAN is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with GRIDMAN.  If not, see <http://www.gnu.org/licenses/>.

      PROGRAM test_grid2
      USE gridman
      USE gridman_lib
      IMPLICIT NONE

      gridman_check=.true.

      CALL test_combine

      CALL test_cells

      CALL test_points

      CALL test_eliminate_cells
     
      CALL test_eliminate_edges


      WRITE(*,*) "TEST_GRID2 COMPLETED"

      END PROGRAM test_grid2

C
C
C
      SUBROUTINE test_eliminate_edges
       USE gridman
       USE gridman_lib
       IMPLICIT NONE 
       INTRINSIC abs
       INTEGER :: ierr,res
       TYPE(gridman_grid) :: grid,gride
       LOGICAL,ALLOCATABLE :: ltake(:)
       INTEGER :: ii
       INTEGER(GRIDMAN_SP) :: iedge,iedge1,ipoint,ie
       REAL(GRIDMAN_DP) :: x1,y1,x2,y2,ld,ld1
 
C      CREATE GRID
       CALL grid_example1(grid,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"

C      TRIVIAL TEST: TAKE ALL EDGES
       ALLOCATE(ltake(grid%NEDGES))
       ltake=.true.
       CALL gridman_grid_eliminate_edges(gride,grid,ltake,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_CELLS) TERMINATED"
       gride%DESCRIPTION=grid%DESCRIPTION

       CALL gridman_grid_compare(grid,gride,res,ierr)
       IF(res.NE.0) THEN
        WRITE(*,*) "ERROR detected after GRIDMAN_GRID_COMPARE"
        WRITE(*,*) "Expected value 0, RES ",res
        stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"
       END IF

C      FREE EDGES WHICH DO NOT BELONG TO CELLS
       grid%CELLS(:,21)=0
       grid%CELLS(:,22)=0
       grid%CELLS(:,23)=0
       IF(grid%CELLS(1,19).EQ.10) grid%CELLS(1,19)=0
       IF(grid%CELLS(2,19).EQ.10) grid%CELLS(2,19)=0
       IF(grid%CELLS(1,20).EQ.10) grid%CELLS(1,20)=0
       IF(grid%CELLS(2,20).EQ.10) grid%CELLS(2,20)=0
       grid%NCELLS=grid%NCELLS-1
       CALL gridman_index_create121(grid%CELLINDEX(1),grid%NCELLS,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"
       CALL gridman_index_create121(grid%CELLINDEX(2),grid%NCELLS,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"     

       CALL gridman_grid_remove_free_edges(gride,grid,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"    

       IF(gride%NCELLS.NE.grid%NCELLS.OR.
     f    gride%NEDGES.NE.grid%NEDGES-3) THEN
        WRITE(*,*) "ERROR in GRIDMAN_GRID_REMOVE_FREE_EDGES: ",
     w             "unexpected dimensions"
        WRITE(*,*) "Expected NCELLS, NEDGES ",gride%NCELLS,grid%NEDGES
        WRITE(*,*) "         NCELLS, NEDGES ",gride%NCELLS,grid%NEDGES-2
        stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"    
       END IF
  
       DO ii=1,grid%NCELLINDEX
        CALL gridman_index_compare(grid%CELLINDEX(ii), 
     c                             gride%CELLINDEX(ii),res,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"
        IF(res.NE.0) THEN
         WRITE(*,*) "ERROR detected after GRIDMAN_INDEX_COMPARE"
         WRITE(*,*) "Expected value 0, RES ",res
         stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"
        END IF
       END DO

       IF(gride%EDGEINDEX(1)%NELEMENTS.NE.gride%NEDGES) THEN
         WRITE(*,*) "ERROR in GRIDMAN_ELIMINATE_EDGES: ",
     w              "number of elements =/= number of edges"
         WRITE(*,*) " NEGDES, NELEMENTS ",
     w                gride%NEDGES,gride%EDGEINDEX(1)%NELEMENTS
         stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"
       END IF

       DO ie=1,gride%EDGEINDEX(1)%NELEMENTS
        iedge1=grid%EDGEINDEX(1)%INDEXES(0,ie)
        ipoint=gride%POINTS(1,iedge1)
        x1=gride%X(1,ipoint)
        y1=gride%X(2,ipoint)
        ipoint=gride%POINTS(2,iedge1)
        x2=gride%X(1,ipoint)
        y2=gride%X(2,ipoint)
        ld1=(x1-x2)**2+(y1-y2)**2
        iedge=grid%EDGEINDEX(1)%INDEXES(1,ie)
        ipoint=grid%POINTS(1,iedge)
        x1=grid%X(1,ipoint)
        y1=grid%X(2,ipoint)
        ipoint=gride%POINTS(2,iedge1)
        x2=grid%X(1,ipoint)
        y2=grid%X(2,ipoint)
        ld=(x1-x2)**2+(y1-y2)**2
        IF(abs(ld-ld1).GT.gridman_tol**2) THEN
         WRITE(*,*) "ERROR in GRIDMAN_ELIMINATE_EDGES: ",
     w              "mismatch of the edge lengths" 
         WRITE(*,*) " IEDGE1, IEDGE0 ",iedge1, iedge
         WRITE(*,*) " LD1, LD0 ",ld1,ld
         stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"
        END IF
       END DO
 
       CALL gridman_index_compare(gride%EDGEINDEX(1),
     c                            gride%EDGEINDEX(2),res,ierr)
       IF(res.NE.0) THEN
        WRITE(*,*) "ERROR in GRIDMAN_ELIMINATE_EDGES: ",
     w             "edge indexes must be same"
        stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"
       END IF

       CALL gridman_grid_write(gride,'eliminate_edges.grd',ierr)

       CALL gridman_grid_deallocate(grid,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"
       CALL gridman_grid_deallocate(gride,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_EDGES) TERMINATED"

      END SUBROUTINE test_eliminate_edges

C
C
C
      SUBROUTINE test_eliminate_cells
       USE gridman
       USE gridman_lib
       IMPLICIT NONE 
       INTRINSIC abs
       INTEGER :: ierr,res
       TYPE(gridman_grid) :: grid,gride
       LOGICAL,ALLOCATABLE :: ltake(:)
       INTEGER(GRIDMAN_SP) :: ie,iedge0,iedge1,ipoint
       REAL(GRIDMAN_DP) :: x10,y10,x20,y20,x11,y11,x21,y21

C      CREATE GRID
       CALL grid_example1(grid,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_CELLS) TERMINATED"

C      TRIVIAL TEST: TAKE ALL CELLS
       ALLOCATE(ltake(grid%NCELLS))
       ltake=.true.
       CALL gridman_grid_eliminate_cells(gride,grid,ltake,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_CELLS) TERMINATED"
       gride%DESCRIPTION=grid%DESCRIPTION

       CALL gridman_grid_compare(grid,gride,res,ierr)
       IF(res.NE.0) THEN
        WRITE(*,*) "ERROR detected after GRIDMAN_GRID_COMPARE"
        WRITE(*,*) "Expected value 0, RES ",res
        stop "TEST_GRID2 (TEST_ELIMINATE_CELLS) TERMINATED"
       END IF

C      MODIFY GRID FOR SECOND TEST
C      FREE EDGES WHICH DO NOT BELONG TO CELLS
       grid%CELLS(:,21)=0
       grid%CELLS(:,22)=0
       grid%CELLS(:,23)=0
       IF(grid%CELLS(1,19).EQ.10) grid%CELLS(1,19)=0
       IF(grid%CELLS(2,19).EQ.10) grid%CELLS(2,19)=0
       IF(grid%CELLS(1,20).EQ.10) grid%CELLS(1,20)=0
       IF(grid%CELLS(2,20).EQ.10) grid%CELLS(2,20)=0
       grid%NCELLS=grid%NCELLS-1
       ltake(1)=.false.
       ltake(2)=.false.
       ltake(7)=.false.
       ltake(9)=.false.
       CALL gridman_index_create121(grid%CELLINDEX(1),grid%NCELLS,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_CELLS) TERMINATED"
       CALL gridman_index_create121(grid%CELLINDEX(2),grid%NCELLS,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_CELLS) TERMINATED"      
       CALL gridman_grid_eliminate_cells(gride,grid,ltake,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_CELLS) TERMINATED"
C      CHECK DIMENSIONS
       IF(gride%NCELLS.NE.5.OR.gride%NEDGES.NE.18.OR.
     f    gride%NPOINTS.NE.13) THEN
        WRITE(*,*) "ERROR after TEST_ELIMINATE_CELLS: ",
     w             "mismatch of dimensions"
        WRITE(*,*) "Expected value 5, NCELLS ",gride%NCELLS
        WRITE(*,*) "Expected value 18, NCELLS ",gride%NEDGES
        WRITE(*,*) "Expected value 13, NPOINTS ",gride%NPOINTS
        stop "TEST_GRID2 (TEST_ELIMINATE_CELLS) TERMINATED"
       END IF
C      CHECK THE EDGE INDEX MAPPING
       DO ie=1,gride%EDGEINDEX(1)%NELEMENTS
        iedge1=gride%EDGEINDEX(1)%INDEXES(0,ie)
        iedge0=gride%EDGEINDEX(1)%INDEXES(1,ie)
        ipoint=gride%POINTS(1,iedge1)        
        x11=gride%X(1,ipoint)    
        y11=gride%X(2,ipoint)        
        ipoint=gride%POINTS(2,iedge1)        
        x21=gride%X(1,ipoint)    
        y21=gride%X(2,ipoint)        
        ipoint=grid%POINTS(1,iedge0)        
        x10=grid%X(1,ipoint)    
        y10=grid%X(2,ipoint)  
        ipoint=grid%POINTS(2,iedge0)        
        x20=grid%X(1,ipoint)    
        y20=grid%X(2,ipoint)  
        IF( ( abs(x10-x11).LT.gridman_tol.AND. 
     f        abs(y10-y11).LT.gridman_tol.AND. 
     f        abs(x20-x21).LT.gridman_tol.AND. 
     f        abs(y20-y21).LT.gridman_tol ) .OR.
     f      ( abs(x20-x11).LT.gridman_tol.AND. 
     f        abs(y20-y11).LT.gridman_tol.AND. 
     f        abs(x10-x21).LT.gridman_tol.AND. 
     f        abs(y10-y21).LT.gridman_tol ) ) THEN
C         EDGES MATCH     
         ELSE     
          WRITE(*,*) "ERROR after TEST_ELIMINATE_CELLS: ",
     w               "edge index mismatch"
          WRITE(*,*) " IE, IEDGE0, IEDGE1 ",ie,iedge0,iedge1
          WRITE(*,*) " OLD: X1, Y1, X2, Y2  ", x10,y10,x20,y20
          WRITE(*,*) " NEW: X1, Y1, X2, Y2  ", x11,y11,x21,y21
          stop "TEST_GRID2 (TEST_ELIMINATE) TERMINATED"
         END IF
       END DO
       CALL gridman_index_compare(gride%EDGEINDEX(1),
     c                            gride%EDGEINDEX(2),res,ierr)
       IF(res.NE.0.OR.ierr.NE.0) THEN
         WRITE(*,*) "ERROR after TEST_ELIMINATE_CELLS: ",
     w              "edge indices are not equal"
         stop "TEST_GRID2 (TEST_ELIMINATE) TERMINATED"
       END IF 
C      CHECK THE CELL INDEX MAPPING
       IF( gride%CELLINDEX(1)%INDEXES(0,1).NE.1.OR.
     f     gride%CELLINDEX(1)%INDEXES(1,1).NE.3.OR.
     f     gride%CELLINDEX(1)%INDEXES(0,2).NE.2.OR.
     f     gride%CELLINDEX(1)%INDEXES(1,2).NE.4.OR.
     f     gride%CELLINDEX(1)%INDEXES(0,3).NE.3.OR.
     f     gride%CELLINDEX(1)%INDEXES(1,3).NE.5.OR.
     f     gride%CELLINDEX(1)%INDEXES(0,4).NE.4.OR.
     f     gride%CELLINDEX(1)%INDEXES(1,4).NE.6.OR.
     f     gride%CELLINDEX(1)%INDEXES(0,5).NE.5.OR.
     f     gride%CELLINDEX(1)%INDEXES(1,5).NE.8 ) THEN
        WRITE(*,*) "ERROR after TEST_ELIMINATE: wrong cell index"
        stop "TEST_GRID2 (TEST_ELIMINATE) TERMINATED"
       END IF 
       CALL gridman_index_compare(gride%CELLINDEX(1),
     c                            gride%CELLINDEX(2),res,ierr)
       IF(res.NE.0.OR.ierr.NE.0) THEN
         WRITE(*,*) "ERROR after TEST_ELIMINATE_CELLS: ",
     w              "cell indices are not equal"
         stop "TEST_GRID2 (TEST_ELIMINATE) TERMINATED"
       END IF 

       CALL gridman_grid_write(gride,'eliminate_cells.grd',ierr)

       CALL gridman_grid_deallocate(grid,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_CELLS) TERMINATED"
       CALL gridman_grid_deallocate(gride,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_ELIMINATE_CELLS) TERMINATED"

      END SUBROUTINE test_eliminate_cells
C
C
C
      SUBROUTINE test_points
       USE gridman
       USE gridman_lib
       IMPLICIT NONE
       TYPE(gridman_grid) :: grid
       TYPE(gridman_indlist) :: points
       INTEGER(GRIDMAN_SP) :: ipoint
       INTEGER :: ierr,res

       CALL grid_example1(grid,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_POINTS) TERMINATED"
       CALL gridman_grid_check(grid,res,ierr)
       IF(res.NE.0) stop "TEST_POINTS TERMINATED"
 
       CALL gridman_grid_points(points,grid,ierr)
       IF(res.NE.0) stop "TEST_GRID2 (TEST_POINTS) TERMINATED"
       WRITE(*,*) "IPOINT, IND"
       DO ipoint=1,points%N 
        WRITE(*,*) ipoint,
     w  points%IND(points%IFIRST(ipoint):points%ILAST(ipoint))
       END DO 

       CALL gridman_grid_deallocate(grid,ierr) 
       IF(ierr.NE.0)  stop "TEST_GRID2 (TEST_POINTS) TERMINATED"
       CALL gridman_indlist_deallocate(points,ierr)
       IF(ierr.NE.0)  stop "TEST_GRID2 (TEST_POINTS) TERMINATED"

      END SUBROUTINE test_points

C
C
C
      SUBROUTINE test_cells
       USE gridman
       USE gridman_lib
       IMPLICIT NONE

       TYPE(gridman_grid) :: grid
       TYPE(gridman_indlist) :: cells       
       INTEGER(GRIDMAN_SP) :: icell
       INTEGER :: ierr,res

       CALL grid_example1(grid,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_CELLS) TERMINATED"
       CALL gridman_grid_check(grid,res,ierr)
       IF(res.NE.0) stop "TEST_GRID2 (TEST_CELLS) TERMINATED"
 
       CALL gridman_grid_cells(cells,grid,ierr)
       IF(res.NE.0) stop "TEST_GRID2 (TEST_CELLS) TERMINATED"
       WRITE(*,*) "ICELL, IND"
       DO icell=1,cells%N 
        WRITE(*,*) icell,
     w             cells%IND(cells%IFIRST(icell):cells%ILAST(icell))
       END DO 

C      CASE WITH EDGES WHICH DO NOT BELONG TO ANY CELL     
       CALL gridman_indlist_deallocate(cells,ierr)
       IF(ierr.NE.0)  stop "TEST_GRID2 (TEST_CELLS) TERMINATED"

       grid%CELLS(1:2,13)=(/0,0/)
       grid%CELLS(1:2,15)=(/0,0/)
       grid%CELLS(1:2,17)=(/8,0/)
       CALL gridman_grid_check(grid,res,ierr)
       IF(res.NE.0) stop "TEST_GRID2 (TEST_CELLS) TERMINATED"

       CALL gridman_grid_cells(cells,grid,ierr)
       IF(res.NE.0) stop "TEST_GRID2 (TEST_CELLS) TERMINATED"
       WRITE(*,*) "ICELL, IND"
       DO icell=1,cells%N 
        WRITE(*,*) icell,
     w             cells%IND(cells%IFIRST(icell):cells%ILAST(icell))
       END DO 

       CALL gridman_grid_deallocate(grid,ierr) 
       IF(ierr.NE.0)  stop "TEST_GRID2 (TEST_CELLS) TERMINATED"
       CALL gridman_indlist_deallocate(cells,ierr)
       IF(ierr.NE.0)  stop "TEST_GRID2 (TEST_CELLS) TERMINATED"

      END SUBROUTINE test_cells

C
C
C
      SUBROUTINE test_combine
       USE gridman
       USE gridman_lib      
       IMPLICIT NONE
       TYPE(gridman_grid) :: grid,grid1,grid2,
     t                       grid1_save,grid2_save     
       INTEGER :: ierr,res

       gridman_check=.true.
     
       CALL grid_example1(grid1,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"
       CALL grid_example2(grid2,ierr)
       IF(ierr.GT.0) stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"
    
       CALL gridman_grid_combine(grid,grid1,grid2,ierr)
       IF(ierr.GT.0) stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"   

       CALL gridman_grid_copy(grid1_save,grid1,ierr)         
       IF(ierr.NE.0)  stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"
       CALL gridman_grid_copy(grid2_save,grid2,ierr)         
       IF(ierr.NE.0)  stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"

       grid1%NCELLS=-1 !DAMAGE GRID1
       CALL gridman_grid_combine(grid,grid1,grid2,ierr)
       IF(ierr.NE.100) THEN
        WRITE(*,*) "ERORR in GRIDMAN_GRID_COMBINE"
        WRITE(*,*) " expected value 100, IERR ",ierr
        stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"
       END IF 
       CALL gridman_grid_copy(grid1,grid1_save,ierr) !RESTORING GRID

       grid2%NEDGES=-1 !DAMAGE GRID2
       CALL gridman_grid_combine(grid,grid1,grid2,ierr)
       IF(ierr.NE.100) THEN
        WRITE(*,*) "ERORR in GRIDMAN_GRID_COMBINE"
        WRITE(*,*) " expected value 100, IERR ",res
        stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"
       END IF 
       CALL gridman_grid_copy(grid2,grid2_save,ierr) !RESTORING GRID

       grid1%TYPE=3
       CALL gridman_grid_combine(grid,grid1,grid2,ierr)
       IF(ierr.NE.100) THEN
        WRITE(*,*) "ERORR in GRIDMAN_GRID_COMBINE"
        WRITE(*,*) " expected value 100, IERR ",res
        stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"
       END IF 
       CALL gridman_grid_copy(grid1,grid1_save,ierr) !RESTORING GRID

       CALL gridman_grid_deallocate(grid,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"
       CALL gridman_grid_deallocate(grid1,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"
       CALL gridman_grid_deallocate(grid2,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"
       CALL gridman_grid_deallocate(grid1_save,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"
       CALL gridman_grid_deallocate(grid2_save,ierr)
       IF(ierr.NE.0) stop "TEST_GRID2 (TEST_COMBINE) TERMINATED"

       gridman_check=.false.

      END SUBROUTINE test_combine