1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE addface(parent,nb_nodes,nodelist,faceid,patch)
   4 | 
   5 | !       ================================================================!
   6 | !                                                                       !
   7 | !       addface.F : Adds a face to the 'face_list'                      !
   8 | !                                                                       !
   9 | !       in        : The parent cell id 'parent'                         !
  10 | !                   The number of nodes of the face 'nb_nodes'          !
  11 | !                   The id list of the nodes 'nodelist'                 !
  12 | !                   'current_cell' must point to the parent cell        !
  13 | !       out       : The id number of the new face 'faceid'              !
  14 | !                   The 'current_face' and 'last_face' pointers will    !
  15 | !                   point at this face                                  !
  16 | !                                                                       !
  17 | !       author    : J. AMAYA (avril 2007)                               !
  18 | !                                                                       !
  19 | !       ================================================================!
  20 | 
  21 |         USE datas
  22 |         IMPLICIT NONE
  23 | 
  24 | !       IN
  25 |         DOM_INT :: parent, nb_nodes, patch
  26 |         DOM_INT, DIMENSION(nb_nodes) :: nodelist
  27 | 
  28 | !       OUT
  29 |         DOM_INT :: faceid
  30 | 
  31 | !       LOCAL
  32 |         type(face), pointer :: new_face
  33 |         DOM_INT             :: ierr, foundface, i, idx
  34 |         DOM_INT             :: iparent
  35 |         DOM_REAL            :: x, y, z
  36 |         DOM_REAL            :: area
  37 |         DOM_REAL            :: norm
  38 | 
  39 | !       print*, " cell:", parent
  40 | !       print*, parent,":",patch
  41 | !       print*, " -- this face: ", nodelist
  42 | 
  43 |         CALL lookforface(nb_nodes, nodelist, foundface)
  44 | 
  45 | !       -----------------------------------!
  46 | !       If the face doesn't exists already !
  47 | !       -----------------------------------!
  48 |         IF (foundface.eq.0) THEN
  49 |           iparent = 1
  50 |           ALLOCATE(new_face)
  51 |           NULLIFY(new_face%next_face)
  52 |           NULLIFY(new_face%prev_face)
  53 |           NULLIFY(new_face%parent2_ptr)
  54 |           new_face%i_nbparents = 1
  55 |           new_face%i_patchnb   = patch
  56 |           new_face%parent1_ptr => current_cell
  57 | 
  58 |           IF (i_nfaces.eq.0) THEN
  59 | 
  60 |             face_list => new_face
  61 |             last_face => new_face
  62 |             new_face%face_id = 1
  63 | 
  64 |           ELSE
  65 | 
  66 |             new_face%prev_face => last_face
  67 |             last_face%next_face => new_face
  68 |             new_face%face_id = last_face%face_id + 1
  69 |             last_face => new_face
  70 | 
  71 |           ENDIF
  72 | 
  73 |           idx = new_face%face_id
  74 |           new_face%parent_cell(1) = parent 
  75 |           new_face%parent_cell(2) = 0
  76 |           ALLOCATE(new_face%face_point(nb_nodes,2))
  77 |           new_face%i_nbnodes = nb_nodes
  78 | 
  79 |           faceidx(idx)%face_ptr => new_face
  80 |           current_face => new_face
  81 | 
  82 | !       ---------------------------!
  83 | !       If the face exists already !
  84 | !       ---------------------------!
  85 |         ELSE
  86 |           current_face%i_nbparents = 2
  87 |           iparent = 2
  88 |           current_face%parent_cell(2) = parent
  89 |           current_face%parent2_ptr => current_cell
  90 |           IF (current_face%parent2_ptr%cell_id.eq.0) THEN
  91 |             WRITE(*,*) " Fatal error in addface.F: no parent cell."
  92 |             STOP
  93 |           ENDIF
  94 | 
  95 |         ENDIF
  96 | 
  97 | !       ---------------------------------!
  98 | !       Set the nodes in the given order !
  99 | !       ---------------------------------!
 100 | 
 101 |         faceid = current_face%face_id
 102 | 
 103 |         DO i=1, nb_nodes
 104 |           IF (nodelist(i).gt.i_nnodes) THEN
 105 |             WRITE(*,*) "Error in addface.f:node not found:",nodelist(i)
 106 |             STOP
 107 |           ELSE
 108 |             current_face%face_point(i,iparent) = nodelist(i)
 109 |             CALL addfatnode(nodelist(i))
 110 |           ENDIF
 111 |         ENDDO
 112 | 
 113 |         IF (foundface.eq.0) THEN
 114 | !         ---------------------------!
 115 | !         Compute this faces' normal !
 116 | !         ---------------------------!
 117 |           CALL calculatenormal(nb_nodes, nodelist, x, y, z, norm)
 118 |           current_face%face_normal(1,1) = x
 119 |           current_face%face_normal(2,1) = y
 120 |           current_face%face_normal(3,1) = z
 121 |           current_face%face_normal(4,1) = norm
 122 | 
 123 | !         ---------------------!
 124 | !         Compute face's area: !
 125 | !         ---------------------!
 126 |           CALL calculatearea(nb_nodes, nodelist, area)
 127 |           current_face%area = area
 128 |           i_nfaces = i_nfaces + 1
 129 | 
 130 | !         ------------------!
 131 | !         Set BC properties !
 132 | !         ------------------!
 133 |           current_face%bndyface                  = .FALSE.
 134 |           IF (patch.ne.0.) current_face%bndyface = .TRUE.
 135 | 
 136 | !         ----------------------!
 137 | !         Compute face's center !
 138 | !         ----------------------!
 139 |           CALL calculatecenter(nb_nodes, nodelist, x, y, z)
 140 |           current_face%x = x
 141 |           current_face%y = y
 142 |           current_face%z = z
 143 |         ELSE
 144 |           current_face%face_normal(1,2)=-current_face%face_normal(1,1)
 145 |           current_face%face_normal(2,2)=-current_face%face_normal(2,1)
 146 |           current_face%face_normal(3,2)=-current_face%face_normal(3,1)
 147 |           current_face%face_normal(4,2)= current_face%face_normal(4,1)
 148 |         ENDIF
 149 | 
 150 |       END SUBROUTINE addface