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
58#include "implicit_f.inc"
69 INTEGER IALLO,NBINFLG(*)
71 . IRECT(4,*), NSV(*),MSEGTYP(*),
72 . MSR(*),ITAB(*),MBINFLG(*),
73 . ISEADD(*) ,ISEDGE(*),ITAG(*),INTPLY,
74 . IXC(NIXC,*),IXTG(NIXTG,*),KNOD2ELC(*),KNOD2ELTG(*),
75 . NOD2ELC(*),NOD2ELTG(*),KNOD2ELS(*)
77INTEGER IXS(NIXS,*),IXS10(6,*), IXS16(8,*), IXS20(12,*)
78 INTEGER MODE, (70000), NRTMP, I1, I2
79 INTEGER,
DIMENSION(:),
ALLOCATABLE :: INDEX
80 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: IRECTMP
81 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: IRECTMP_SAV
82 INTEGER,
INTENT(IN) :: NIN25
83 INTEGER,
INTENT(INOUT) :: FLAG_ELEM_INTER25(NINTER25
87 TYPE (GROUP_) ,
DIMENSION(NGRNOD) ::
88 TYPE (SURF_) ,
DIMENSION(NSURF) :: IGRSURF
93 INTEGER I,J,K,L,LL,NL,ISU1,ISU2,NOD1,NRTM,NRTS,NSN,NMN,
94 . NLINSA,NLINMA,ILEV,NLN,ISYM
95 INTEGER,
DIMENSION(:),
ALLOCATABLE :: TAG,TAGS
96 INTEGER NLINS,NLINM,LINE1,LINE2,STAT,IL,IG,N,II,IJ,IMIN
97 INTEGER NSU1,NLS1,NLS2,NRTM_SH,ETYP
99 LOGICAL :: NEED_SOLID_EROSION
100 INTEGER :: IDEL,SOLID_SEGMENT,ELEM
108 DATA mess/
'INTERFACE INPUT '/
122 IF(iallo == 2 .AND. ilev == 2 )
THEN
139 nrtm = igrsurf(isu1)%NSEG
141 nrtm = igrsurf(isu1)%NSEG
142 nrts = igrsurf(isu2)%NSEG
145 nrtm = igrsurf(isu2)%NSEG
148 ALLOCATE(index(2*nrtm),irectmp(6,nrtm),stat=stat)
149 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,
152 irectmp(1:6,1:nrtm)=0
159 DO j=1,igrsurf(isu1)%NSEG
162 irectmp(k,l) = igrsurf(isu1)%NODES(j,k)
164 irectmp(5,l) = igrsurf(isu1)%ELTYP(j)
165 CALL in24coq_sol3(irectmp(1,l) ,ixc ,ixtg ,irectmp(5,l) ,x ,
166 . knod2elc ,knod2eltg ,nod2elc ,nod2eltg,
167 . knod2els,nod2els,ixs ,ixs10 ,ixs16 ,ixs20 )
168 IF(imbin /= 0)irectmp(6,l) = bitset(irectmp(6,l),0)
169 IF(ilev==1.OR.ilev==2)
THEN
170 elem = igrsurf(isu1)%ELEM(j)
171 IF(elem/=0.AND.igrsurf(isu1)%ELTYP(j)==1) flag_elem_inter25(nin25,elem) = 1
176 IF(isu2 /= 0 .AND.ilev /=1)
THEN
177 DO j=1,igrsurf(isu2)%NSEG
180 irectmp(k,l) = igrsurf(isu2)%NODES(j,k)
184 irectmp(5,l) = igrsurf(isu2)%ELTYP(j)
185 CALL in24coq_sol3(irectmp(1,l) ,ixc ,ixtg ,irectmp(5,l) ,x ,
186 . knod2elc ,knod2eltg ,nod2elc ,nod2eltg,
187 . knod2els,nod2els,ixs ,ixs10 ,ixs16 ,ixs20 )
188 IF(imbin /= 0) irectmp(6,l) = bitset(irectmp(6,l),1)
189 elem = igrsurf(isu2)%ELEM(j)
190 IF(elem/=0.AND.igrsurf(isu2)%ELTYP(j)==1) flag_elem_inter25(nin25,elem) = 1
197 ALLOCATE(irectmp_sav(6,nrtm),stat=stat)
200 irectmp_sav(1:6,1:nrtm) = irectmp(1:6,1:nrtm)
202 IF(irectmp(5,i)==0.OR.irectmp(5,i)==1)
THEN
203 IF(irectmp(4,i)==irectmp(3,i)) irectmp(4,i) = 0
208 IF(irectmp(k,i)<imin.AND.irectmp(k,i) /= 0)
THEN
214 irectmp(ij,i) = irectmp(j,i)
222 CALL my_orders( mode, work, irectmp, index, nrtm , 6)
230 DO WHILE(irectmp(1,i1)==0)
236 IF(irectmp(5,i1)/=0 .AND. irectmp(5,i1)/=1) nrtm_sh=nrtm_sh+1
242 IF(irectmp(1,i2)/=irectmp(1,i1).OR.
243 . irectmp(2,i2)/=irectmp(2,i1).OR.
244 . irectmp(3,i2)/=irectmp(3,i1).OR.
245 . irectmp(4,i2)/=irectmp(4,i1).OR.
246 . irectmp(5,i2)/=irectmp(5,i1))
THEN
249 IF(irectmp(5,i2)/=0 .AND. irectmp(5,i2
257 DO WHILE(irectmp(1,i1)==0)
263 irect(1,nrtm)=irectmp_sav(1,i1)
264 irect(2,nrtm)=irectmp_sav(2,i1)
265 irect(3,nrtm)=irectmp_sav(3,i1)
266 irect(4,nrtm)=irectmp_sav(4,i1)
267 msegtyp(nrtm)=irectmp_sav(5,i1)
268 IF(imbin/=0) mbinflg(nrtm)=irectmp_sav(6,i1)
273 IF(irectmp(1,i2)/=irectmp(1,i1).OR.
274 . irectmp(2,i2)/=irectmp(2,i1).OR.
275 . irectmp(3,i2)/=irectmp(3,i1).OR.
276 . irectmp(4,i2)/=irectmp(4,i1).OR.
277 . irectmp(5,i2)/=irectmp(5,i1))
THEN
280 irect(1,nrtm)=irectmp_sav(1,i2)
281 irect(2,nrtm)=irectmp_sav(2,i2)
282 irect(3,nrtm)=irectmp_sav
283 irect(4,nrtm)=irectmp_sav(4,i2)
284 msegtyp(nrtm)=irectmp_sav(5,i2)
285 IF(imbin/=0) mbinflg(nrtm)=irectmp_sav(6,i2)
287 ELSEIF(irectmp(6,i1)/=irectmp(6,i2))
THEN
288 IF(imbin/=0) mbinflg(nrtm)=1+2
294 DEALLOCATE(index,irectmp)
295 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)
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=',ipari
423 WRITE(iout,fmt=fmw_10i)(itab(nsv(i)),i=1,nsn)
436 nrtm0 = ipari(4) - nrtm_sh
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)
455 idel = ipari(17) ! get
the idel option(/=0 --> erosion is on)
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