37 SUBROUTINE i25surfi(IALLO ,IPARI ,IGRNOD ,IGRSURF ,
40 3 NBINFLG ,MBINFLG ,MSEGTYP ,ISEADD ,
41 4 ISEDGE ,ITAG ,INTPLY ,IXC ,
42 5 IXTG ,KNOD2ELC,KNOD2ELTG,NOD2ELC,
43 6 NOD2ELTG,KNOD2ELS,NOD2ELS ,IXS ,
44 7 IXS10 ,IXS16 ,IXS20 ,IRTSE ,
45 8 IS2SE ,IS2PT ,IS2ID ,PARAMETERS,
46 A NIN25 ,FLAG_ELEM_INTER25 )
54 USE format_mod ,
ONLY : fmw_10i, fmw_4i
55 use element_mod ,
only :nixs,nixc,nixtg
59#include "implicit_f.inc"
70 INTEGER IALLO,NBINFLG(*)
72 . IRECT(4,*), NSV(*),MSEGTYP(*),
73 . MSR(*),ITAB(*),MBINFLG(*),
74 . ISEADD(*) ,ISEDGE(*),ITAG(*),INTPLY,
75 . IXC(NIXC,*),IXTG(NIXTG,*),KNOD2ELC(*),KNOD2ELTG(*),
76 . NOD2ELC(*),NOD2ELTG(*),KNOD2ELS(*),NOD2ELS(*),
77 . IRTSE(5,*) ,IS2SE(*),IS2PT(*) ,IS2ID(*)
78 INTEGER IXS(NIXS,*),IXS10(6,*), IXS16(8,*), IXS20(12,*)
79 INTEGER MODE, WORK(70000), NRTMP, I1, I2
80 INTEGER,
DIMENSION(:),
ALLOCATABLE :: INDEX
81 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: IRECTMP
82 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: IRECTMP_SAV
83 INTEGER,
INTENT(IN) :: NIN25
84 INTEGER,
INTENT(INOUT) :: FLAG_ELEM_INTER25(NINTER25,NUMELS)
88 TYPE (GROUP_) ,
DIMENSION(NGRNOD) :: IGRNOD
89 TYPE (SURF_) ,
DIMENSION(NSURF) :: IGRSURF
90 TYPE () ,
INTENT(INOUT) :: PARAMETERS
94 INTEGER I,J,K,L,ISU1,ISU2,NOD1,NRTM,NRTS,NSN,NMN,
96 INTEGER,
DIMENSION(:),
ALLOCATABLE :: TAG,TAGS
98 INTEGER NSU1,NLS1,NLS2,NRTM_SH,NRTM0,
100 LOGICAL :: NEED_SOLID_EROSION
101 INTEGER :: IDEL,SOLID_SEGMENT,ELEM
109 DATA mess/
'INTERFACE INPUT '/
123 IF(iallo == 2 .AND. ilev == 2 )
THEN
140 nrtm = igrsurf(isu1)%NSEG
142 nrtm = igrsurf(isu1)%NSEG
143 nrts = igrsurf(isu2)%NSEG
146 nrtm = igrsurf(isu2)%NSEG
149 ALLOCATE(index(2*nrtm),irectmp(6,nrtm),stat=stat)
150 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,
153 irectmp(1:6,1:nrtm)=0
160 DO j=1,igrsurf(isu1)%NSEG
163 irectmp(k,l) = igrsurf(isu1)%NODES(j,k)
165 irectmp(5,l) = igrsurf(isu1)%ELTYP(j)
166 CALL in24coq_sol3(irectmp(1,l) ,ixc ,ixtg ,irectmp(5,l) ,x ,
167 . knod2elc ,knod2eltg ,nod2elc ,nod2eltg,
168 . knod2els,nod2els,ixs ,ixs10 ,ixs16 ,ixs20 )
169 IF(imbin /= 0)irectmp(6,l) = bitset(irectmp(6,l),0)
170 IF(ilev==1.OR.ilev==2)
THEN
171 elem = igrsurf(isu1)%ELEM(j)
172 IF(elem/=0.AND.igrsurf(isu1)%ELTYP(j)==1) flag_elem_inter25(nin25,elem) = 1
177 IF(isu2 /= 0 .AND.ilev /=1)
THEN
178 DO j=1,igrsurf(isu2)%NSEG
181 irectmp(k,l) = igrsurf(isu2)%NODES(j,k)
185 irectmp(5,l) = igrsurf(isu2)%ELTYP(j)
186 CALL in24coq_sol3(irectmp(1,l) ,ixc ,ixtg ,irectmp(5,l) ,x ,
188 . knod2els,nod2els,ixs ,ixs10 ,ixs16 ,ixs20 )
189 IF(imbin /= 0) irectmp(6,l) = bitset(irectmp(6,l),1)
190 elem = igrsurf(isu2)%ELEM(j)
191 IF(elem/=0.AND.igrsurf(isu2)%ELTYP(j)==1) flag_elem_inter25(nin25,elem) = 1
198 ALLOCATE(irectmp_sav(6,nrtm),stat=stat)
201 irectmp_sav(1:6,1:nrtm) = irectmp(1:6,1:nrtm)
203 IF(irectmp(5,i)==0.OR.irectmp(5,i)==1)
THEN
204 IF(irectmp(4,i)==irectmp(3,i)) irectmp(4,i) = 0
209 IF(irectmp(k,i)<imin.AND.irectmp(k,i) /= 0)
THEN
215 irectmp(ij,i) = irectmp(j,i)
223 CALL my_orders( mode, work, irectmp, index, nrtm , 6)
231 DO WHILE(irectmp(1,i1)==0)
237 IF(irectmp(5,i1)/=0 .AND. irectmp(5,i1)/=1) nrtm_sh=nrtm_sh+1
243 IF(irectmp(1,i2)/=irectmp(1,i1).OR.
244 . irectmp(2,i2)/=irectmp(2,i1).OR.
245 . irectmp(3,i2)/=irectmp(3,i1).OR.
246 . irectmp(4,i2)/=irectmp(4,i1).OR.
247 . irectmp(5,i2)/=irectmp(5,i1))
THEN
250 IF(irectmp(5,i2)/=0 .AND. irectmp(5,i2)/=1) nrtm_sh=nrtm_sh+1
258 DO WHILE(irectmp(1,i1)==0)
264 irect(1,nrtm)=irectmp_sav(1,i1)
265 irect(2,nrtm)=irectmp_sav(2,i1)
266 irect(3,nrtm)=irectmp_sav(3,i1)
267 irect(4,nrtm)=irectmp_sav(4,i1)
268 msegtyp(nrtm)=irectmp_sav(5,i1)
269 IF(imbin/=0) mbinflg(nrtm)=irectmp_sav(6,i1)
274 IF(irectmp(1,i2)/=irectmp(1,i1).OR.
275 . irectmp(2,i2)/=irectmp(2,i1).OR.
276 . irectmp(3,i2)/=irectmp(3,i1).OR.
277 . irectmp(4,i2)/=irectmp(4,i1).OR.
278 . irectmp(5,i2)/=irectmp(5,i1))
THEN
281 irect(1,nrtm)=irectmp_sav(1,i2)
282 irect(2,nrtm)=irectmp_sav(2,i2)
283 irect(3,nrtm)=irectmp_sav(3,i2)
284 irect(4,nrtm)=irectmp_sav(4,i2)
285 msegtyp(nrtm)=irectmp_sav(5,i2)
286 IF(imbin/=0) mbinflg(nrtm)=irectmp_sav(6,i2)
288 ELSEIF(irectmp(6,i1)/=irectmp(6,i2))
THEN
289 IF(imbin/=0) mbinflg(nrtm)=1+2
295 DEALLOCATE(index,irectmp)
296 IF(
ALLOCATED(irectmp_sav))
DEALLOCATE(irectmp_sav)
302 ALLOCATE(tag(numnod),tags(numnod))
308 DO j=1,igrsurf(isu2)%NSEG
310 tag(igrsurf(isu2)%NODES(j,k)) = 2
315 DO j=1,igrsurf(isu1)%NSEG
317 i=igrsurf(isu1)%NODES(j,k)
320 ELSEIF(tag(i) == 2)
THEN
329 DO j=1,igrsurf(isu2)%NSEG
339 DO j=1,igrsurf(isu1)%NSEG
341 i=igrsurf(isu1)%NODES(j,k)
353 DO j=1,igrsurf(isu2)%NSEG
355 i=igrsurf(isu2)%NODES(j,k)
358 IF(iallo == 2)msr(nmn) = i
361 IF(tag(i) == 2 .OR. tag(i) == 3)
THEN
363 IF ( ilev == 2.AND.tags(i) == 0 )
THEN
368 IF(ilev == 2)nbinflg(nsn) = bitset(nbinflg(nsn),1)
379 DO j=1,igrsurf(isu1)%NSEG
381 i=igrsurf(isu1)%NODES(j,k)
382 IF(tags(i) == 0 .AND. ilev /= 3 )
THEN
387 IF(ilev == 2)nbinflg(nsn) = bitset(nbinflg(nsn),0)
392 nbinflg(isn) = bitset(nbinflg(isn),0)
396 IF(tag(i) == 1 .or. tag(i) == -3)
THEN
399 IF(iallo == 2)msr(nmn) = i
408 DO j=1,igrnod(nod1)%NENTITY
409 i = igrnod(nod1)%ENTITY(j)
415 IF(ilev == 2)nbinflg(nsn) = bitset(nbinflg(nsn),2)
421 IF(iallo == 2 .and. ipri >= 5)
THEN
422 WRITE(iout,
'(/,A,I10,/)')
' NODES USED FOR SECONDARY SIDE, INTERFACE ID='
423 WRITE(iout,fmt=fmw_10i)(itab(nsv(i)),i=1,nsn)
437 CALL sh2surf25(nrtm0,irect,imbin,mbinflg,msegtyp,ipari(4))
440 WRITE(iout,
'(/,A,I10,/)')
' SEGMENTS USED FOR MAIN SURFACE, INTERFACE ID=',ipari(15)
442 WRITE(iout,fmt=fmw_4i)(itab(irect(k,i)),k=1,4)
456 solid_segment = nrtm - nrtm_sh
457 need_solid_erosion = .false.
462 IF(idel/=0.AND.solid_segment>0)
THEN
464 IF(igrsurf(isu1)%EXT_ALL==2) need_solid_erosion = .true
467 IF(igrsurf(isu2)%EXT_ALL==2) need_solid_erosion = .true.
470 IF(idel > 0.AND.solid_segment>0)
THEN
472 parameters%INT25_EROSION_SOLID = 1