30
31
32
34
35
36
37#include "implicit_f.inc"
38
39
40
41#include "param_c.inc"
42#include "com04_c.inc"
43
44
45
46 INTEGER, INTENT(IN) :: IXS(NIXS,NUMELS), NFT, NEL
47 my_real :: geo(npropg,numgeo),veul(lveul,*)
48 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
49
50
51
52 INTEGER :: I,II,J,NG,JAD,JVOI,IGT,,IAD1
54
55
56
57 DO i=1,nel
58 ii=nft+i
59 iad1 = ale_connectivity%ee_connect%iad_connect(ii)
60 DO j=1,6
61 jad=13+j
62 nx=veul(jad ,ii)
63 ny=veul(jad+6,ii)
64 nz=veul(jad+12,ii)
66 ng=ixs(10,ii)
67 IF(geo(12,ng) == 15)THEN
68
73 ENDIF
74 jvoi = ale_connectivity%ee_connect%connected(iad1 + j - 1)
75
76 IF(jvoi > 0)THEN
77 ng1=ixs(10,jvoi)
78 IF(ng1 /= 0.AND.ng1 /= ng)THEN
79 igt=int(geo(12,ng1))
80 IF(igt == 15.AND.geo(21,ng1) <
poro)
THEN
81 nx=nx*geo(21,ng1)
82 ny=ny*geo(21,ng1)
83 nz=nz*geo(21,ng1)
84 ENDIF
85 ENDIF
86 ENDIF
87 veul(jad,ii)=nx
88 veul(jad+6,ii)=ny
89 veul(jad+12,ii)=nz
90 END DO
91 END DO
92
93 RETURN
subroutine poro(geo, nodpor, ms, x, v, w, af, am, skew, weight, nporgeo)