The TELEMAC-MASCARET system  trunk
mod_numbering_open_boundaries.f
Go to the documentation of this file.
1 ! ************************************
3 ! ************************************
4 !
5 !***********************************************************************
6 ! PARTEL
7 !***********************************************************************
8 !
9 !BRIEF Numbering of open boundaries for partel
10 !
11  IMPLICIT NONE
12  CONTAINS
13 !***********************************************************************
14  SUBROUTINE numbering_open_boundaries
15 !***********************************************************************
16  & (nameinp, ikle, ikles,
17  & kp1bor, numliq, dim_mesh, npoin2, nptfr, npoin, nelem2,
18  & nelbor, liubor, lihbor, nbor, ifabor, f, listin)
19 !
20 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
21 !| NAMEINP |<--| Name of the geometry file
22 !| IKLE |-->| Connectivity array
23 !| IKLES |<--| Connectivity array 1D form
24 !| KP1BOR |-->| Neigbouring boundary nodes array
25 !| NUMLIQ |-->| Array for liquid boundaries
26 !| DIM_MESH |<--| Dimension of the mesh
27 !| NPOIN2 |<--| Number of 2D points
28 !| NPTFR |<->| Number of boundary points
29 !| NPOIN |<--| Number of points
30 !| NELEM2 |<->| Number of 2D elements
31 !| NELBOR |-->| Number of boundary elements
32 !| LIUBOR |<--| Boundary value for velocity
33 !| LIHBOR |<--| Boundary value for height
34 !| NBOR |<->| Boundary numbering array
35 !| IFABOR |-->| Array for boundaries
36 !| F |<--| Coordinates
37 !| LISTIN |<--| If True display front2 listin
38 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
39 !
41  USE bief, ONLY : nptir, nbmaxnshare
43 !
44 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
45 !
46  INTEGER, INTENT(IN) :: DIM_MESH, NPOIN2, NPOIN
47  INTEGER, INTENT(INOUT)::NPTFR,NELEM2
48  INTEGER, INTENT(INOUT) :: NBOR(nptfr)
49 !
50  INTEGER, ALLOCATABLE, INTENT(OUT) :: NELBOR(:), IKLE(:,:),
51  & kp1bor(:,:),ifabor(:,:),numliq(:)
52 !
53  DOUBLE PRECISION, INTENT(IN) :: F(npoin,2)
54  INTEGER, INTENT(IN) :: IKLES(nelem2*3)
55  INTEGER, INTENT(IN) :: LIUBOR(nptfr), LIHBOR(nptfr)
56  CHARACTER(LEN=PATH_LEN), INTENT(IN) :: NAMEINP
57  LOGICAL, INTENT(IN) :: LISTIN
58 !
59 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
60 !
61  INTEGER, ALLOCATABLE :: IFANUM(:,:),IKLBOR(:,:),NULONE(:,:),
62  & nachb(:,:)
63  INTEGER, ALLOCATABLE ::IT1(:),IT2(:),IT3(:),DEJAVU(:),ISEGF(:)
64  INTEGER :: NFRLIQ, I, J, K, IERR, ID
65  INTEGER, PARAMETER :: MAXFRO = 30
66  INTEGER :: NELEBD
67 !
68  !THESE ARRAYS WILL LIVE OUTSIDE THIS SUBROUTINE
69  ALLOCATE (kp1bor(nptfr,2),stat=ierr)
70  CALL check_allocate(ierr, 'KP1BOR')
71  ALLOCATE (ifabor(nelem2,3),stat=ierr)
72  CALL check_allocate(ierr, 'IFABOR')
73  ALLOCATE (nelbor(nptfr),stat=ierr)
74  CALL check_allocate(ierr, 'NELBOR')
75  ALLOCATE (ikle(nelem2,3),stat=ierr)
76  CALL check_allocate(ierr, 'IKLE')
77  ALLOCATE (numliq(nptfr),stat=ierr)
78  CALL check_allocate(ierr, 'NUMLIQ')
79 !
80  !LOCAL ARRAYS
81  ALLOCATE (dejavu(nptfr),stat=ierr)
82  CALL check_allocate(ierr, 'DEJAVU')
83 ! CHANGED NELEM TO NELEM2, NDP TO 3 HUH!
84 ! CAUSING ERRORS WHEN 3D RESTART/REFERENCE FILES ARE PARTITIONED
85 ! AND BC FILE IS WRITTEN AGAIN (WHAT FOR, ACTUALLY???)
86 ! CAUSE: CALLING VOISIN WITH NELEM2 BUT IFABOR(NELEM=NELEM3,NDP=6)
87  ALLOCATE (ifanum(nelem2,3),stat=ierr)
88  CALL check_allocate(ierr, 'IFANUM')
89  ALLOCATE (iklbor(nptfr,2),stat=ierr)
90  CALL check_allocate(ierr, 'IKLBOR')
91  ALLOCATE (nulone(nptfr,2),stat=ierr)
92  CALL check_allocate(ierr, 'NULONE')
93  ALLOCATE (isegf(nptfr),stat=ierr)
94  CALL check_allocate(ierr, 'ISEGF')
95  ALLOCATE (it1(npoin),stat=ierr)
96  CALL check_allocate(ierr, 'IT1')
97  ALLOCATE (it2(npoin),stat=ierr)
98  CALL check_allocate(ierr, 'IT2')
99  ALLOCATE (it3(npoin),stat=ierr)
100  CALL check_allocate(ierr, 'IT3')
101  nptir = 1
102  ALLOCATE (nachb(nbmaxnshare,nptir),stat=ierr)
103  CALL check_allocate(ierr, 'NACHB')
104 !
105 ! TRANSFORM IKLES--> IKLE FOR 2D ROUTINES (AN OLD TELEMAC DISEASE)
106 !
107  DO i = 1,3
108  DO j = 1,nelem2
109  ikle(j,i) = ikles((j-1)*3+i)
110  ENDDO
111  ENDDO
112 !
113  CALL voisin(ifabor, nelem2, nelem2, 11, ikle, nelem2,
114  & npoin2, nachb, nbor, nptfr, it1, it2)
115  DEALLOCATE(nachb)
116 !
117  CALL elebd (nelbor, nulone, kp1bor, ifabor, nbor, ikle,
118  & nelem2, iklbor, nelem2, nelem2,
119  & npoin2, nptfr, 11, lihbor, 2,
120  & isegf, it1, it2, it3 ,
121  & nptfr ,nelebd)
122 !
123  IF (nameinp(1:3)== 'ART') THEN
124  CALL get_free_id(id)
125  OPEN(unit=id,file='FRONT_GLOB.DAT')
126  WRITE(id,*) npoin
127  WRITE(id,*) nptfr
128  DO k=1,nptfr
129  WRITE(id,*) nbor(k)
130  END DO
131  DO k=1,nptfr
132  WRITE(id,*) kp1bor(k,1)
133  END DO
134  DO k=1,nptfr
135  WRITE(id,*) kp1bor(k,2)
136  END DO
137  CLOSE(id)
138  END IF
139  nfrliq = 0
140  IF(dim_mesh.NE.3) THEN
141  CALL front2
142  & (nfrliq,
143  & lihbor,liubor,f(:,1),f(:,2),
144  & nbor,kp1bor(1:nptfr,1),dejavu,npoin2,nptfr,
145  & 2,listin,numliq,maxfro)
146  ENDIF
147 !
148  DEALLOCATE (dejavu)
149 !JAJ // IFABOR APPLIED LATER FOR FINDING HALO CELL NEIGHBOURHOODS
150 ! DEALLOCATE (IFABOR)
151  DEALLOCATE (ifanum)
152  DEALLOCATE (iklbor)
153  DEALLOCATE (nulone)
154  DEALLOCATE (isegf)
155  DEALLOCATE (it1)
156  DEALLOCATE (it2)
157  DEALLOCATE (it3)
158  END SUBROUTINE
subroutine numbering_open_boundaries(NAMEINP, IKLE, IKLES, KP1BOR, NUMLIQ, DIM_MESH, NPOIN2, NPTFR, NPOIN, NELEM2, NELBOR, LIUBOR, LIHBOR, NBOR, IFABOR, F, LISTIN)
subroutine front2(NFRLIQ, LIHBOR, LIUBOR, X, Y, NBOR, KP1BOR, DEJAVU, NPOIN, NPTFR, KLOG, LISTIN, NUMLIQ, MAXFRO)
Definition: front2.f:8
subroutine voisin(IFABOR, NELEM, NELMAX, IELM, IKLE, SIZIKL, NPOIN, NACHB, NBOR, NPTFR, IADR, NVOIS)
Definition: voisin.f:8
subroutine elebd(NELBOR, NULONE, KP1BOR, IFABOR, NBOR, IKLE, SIZIKL, IKLBOR, NELEM, NELMAX, NPOIN, NPTFR, IELM, LIHBOR, KLOG, ISEG, T1, T2, T3, NELEBX, NELEB)
Definition: elebd.f:9
Definition: bief.f:3