1 | include(dom.inc)
   2 |       SUBROUTINE testlinking
   3 |         USE datas
   4 |         IMPLICIT NONE
   5 | 
   6 |         type(cell), pointer :: pt_cell
   7 |         type(face), pointer :: pt_face
   8 |         DOM_INT             :: nb_faces, i, j
   9 |         DOM_INT             :: thiscell_id, thisface_id
  10 | 
  11 |         pt_cell => cell_list
  12 | 
  13 |         WRITE(*,*) " Testing the data structure..."
  14 |         DO i=1, i_ncells
  15 | 
  16 |           nb_faces    = pt_cell%i_nbfaces
  17 |           thiscell_id = pt_cell%cell_id
  18 | 
  19 |           DO j=1, nb_faces
  20 | 
  21 |             pt_face => pt_cell%cell_face(j)%face_ptr
  22 |             thisface_id = pt_face%face_id
  23 | !             WRITE(*,*,advance='NO') '.'
  24 | 
  25 |             IF (pt_face%i_nbparents.eq.2) THEN
  26 |               IF (pt_face%parent2_ptr%cell_id.eq.0) THEN
  27 |                 WRITE(*,*) " Cell id: ", thiscell_id
  28 |                 WRITE(*,*) " Face id: ", thisface_id
  29 |                 WRITE(*,*) " Fatal error: face  ",pt_face%face_id,      &
  30 |      &                     " has lost one parent"
  31 |                 STOP
  32 |               ENDIF
  33 |             ENDIF
  34 | 
  35 |           ENDDO
  36 | 
  37 |           pt_cell => pt_cell%next_cell
  38 | 
  39 |         ENDDO
  40 | 
  41 |       END SUBROUTINE testlinking