34 SUBROUTINE ani_pcont(OUTPUT, IXS ,IXC ,IXTG ,FASOLFR ,X ,
35 . CONTN ,CONTT ,IAD_ELEM,FR_ELEM,WEIGHT ,
36 . IXQ ,SEGQUADFR,IXS10 ,FNCONTP2,FTCONTP2 ,
37 . H3D_DATA,CSEFRIC,CSEFRICG,SZ_NPCONT2,NPCONT2)
43 use element_mod ,
only : nixs,nixc,nixtg
47#include "implicit_f.inc"
59 TYPE(output_),
intent(inout) :: OUTPUT
61 . IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*), FASOLFR(2,*),
62 . iad_elem(2,*), fr_elem(*), weight(*),ixq(7,*),segquadfr(2,*),
64 INTEGER ,
INTENT(IN) :: SZ_NPCONT2
66 . X(3,*), CONTN(3,*), CONTT(3,*),FNCONTP2(3,*),FTCONTP2(3,*)
67 my_real ,
INTENT(INOUT) :: csefric(output%DATA%NINEFRIC,output%DATA%S_EFRICINT),csefricg(output%DATA%S_EFRIC)
68 my_real ,
INTENT(IN) :: npcont2(3,sz_npcont2
69 TYPE (H3D_DATABASE) :: H3D_DATA
73 INTEGER N1,N2,N3,N4,NN1,NN2,NN3,J,
76 INTEGER,
DIMENSION(:),
ALLOCATABLE :: ITAGN
79 . x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,
80 . x31,y31,z31,x42,y42,z42,x32,y32,z32,e3x,e3y,e3z,
82 . areainv,normal(3),nnn,f_total(1:3),fn_proj
83 INTEGER FACES(4,6),LINES(2,4),FACES10(3,24)
84 my_real,
DIMENSION(:),
ALLOCATABLE :: NODAREA
85 my_real,
DIMENSION(:,:),
ALLOCATABLE :: NORM_N
123 ALLOCATE(nodarea(numnod))
128!
do normal dependent only
for contn(1:3)>0
129 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT /=0)
THEN
132 normal(1:3) = contn(1:3,n)
133 nnn = normal(1)**2+normal(2)**2+normal(3)**2
134 IF(nnn > em14) nnout = nnout + 1
137 ALLOCATE(itagn(numnod))
138 ALLOCATE(norm_n(3,nnout))
142 normal(1:3) = contn(1:3,n)
143 nnn = normal(1)**2+normal(2)**2+normal(3)**2
146 normal(1:3) = normal(1:3)*nnn
149 norm_n(1:3,ni) = normal(1:3)
156 IF( n <= numels8 )
THEN
158 n1=ixs(faces(1,ifac)+1,n)
159 n2=ixs(faces(2,ifac)+1,n)
160 n3=ixs(faces(3,ifac)+1,n)
161 n4=ixs(faces(4,ifac)+1,n)
162 IF((itagn(n1)+itagn(n2)+itagn(n3)+itagn(n4))==0 ) cycle
197 normal(1:3)= norm_n(1:3,ni)
198 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
199 nodarea(n1)=nodarea(n1)+area
203 normal(1:3)= norm_n(1:3,ni)
204 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
205 nodarea(n2)=nodarea(n2)+area
209 normal(1:3)= norm_n(1:3,ni)
210 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
211 nodarea(n3)=nodarea(n3)+area
215 normal(1:3)= norm_n(1:3,ni)
216 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
217 nodarea(n4)=nodarea(n4)+area
226 normal(1:3)= norm_n(1:3,ni)
227 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
228 nodarea(n1)=nodarea(n1)+area
233 normal(1:3)= norm_n(1:3,ni)
234 area = abs(normal(1)*e3x+normal
235 nodarea(n2)=nodarea(n2)+area
238 IF (n3 /= n2 .AND. n3 /= n1 )
THEN
241 normal(1:3)= norm_n(1:3,ni)
242 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
243 nodarea(n3)=nodarea(n3)+area
246 IF (n4 /= n3 .AND. n4 /= n2 .AND. n4 /= n1 )
THEN
249 normal(1:3)= norm_n(1:3,ni)
250 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
251 nodarea(n4)=nodarea(n4)+area
256 ELSEIF( n <= numels8+numels10 )
THEN
264 nn1=faces10(1,4*(ifac-1)+j)
265 nn2=faces10(2,4*(ifac-1)+j)
266 nn3=faces10(3,4*(ifac-1)+j)
269 IF(nn1 >0.AND.nn1 < 10)
THEN
272 n1=ixs10(nn1-10,n-numels8)
280 n2=ixs10(nn2-10,n-numels8)
288 n3=ixs10(nn3-10,n-numels8)
293 IF(n1 > 0 .AND. n2 > 0 .AND.n3 > 0)
THEN
294 IF((itagn(n1)+itagn(n2)+itagn(n3))==0 ) cycle
322 normal(1:3)= norm_n(1:3,ni)
323 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
324 nodarea(n1)=nodarea(n1)+area
328 normal(1:3)= norm_n(1:3,ni)
329 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
330 nodarea(n2)=nodarea(n2)+area
334 normal(1:3)= norm_n(1:3,ni)
335 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
336 nodarea(n3)=nodarea(n3)+area
348 IF((itagn(n1)+itagn(n2)+itagn(n3)+itagn(n4))==0 ) cycle
380 normal(1:3)= norm_n(1:3,ni)
381 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
382 nodarea(n1)=nodarea(n1)+area
386 normal(1:3)= norm_n(1:3,ni)
387 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
388 nodarea(n2)=nodarea(n2)+area
392 normal(1:3)= norm_n(1:3,ni)
393 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
394 nodarea(n3)=nodarea(n3)+area
398 normal(1:3)= norm_n(1:3,ni)
399 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
400 nodarea(n4)=nodarea(n4)+area
429 normal(1:3)= norm_n(1:3,ni)
430 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
431 nodarea(n1)=nodarea(n1)+area
435 normal(1:3)= norm_n(1:3,ni)
436 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
437 nodarea(n2)=nodarea(n2)+area
441 normal(1:3)= norm_n(1:3,ni)
442 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
443 nodarea(n3)=nodarea(n3)+area
477 normal(1:3)= norm_n(1:3,ni)
478 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
479 nodarea(n1)=nodarea(n1)+area
483 normal(1:3)= norm_n(1:3,ni)
484 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
485 nodarea(n2)=nodarea(n2)+area
489 normal(1:3)= norm_n(1:3,ni)
490 area = abs(normal(1)*e3x+normal(2)*e3y+normal(3)*e3z)
491 nodarea(n3)=nodarea(n3)+area
499 n1=ixq(lines(1,iline)+1,n)
500 n2=ixq(lines(2,iline)+1,n)
507 area = sqrt((y2-y1)*(y2-y1)+(z2-z1)*(z2-z1))
511 nodarea(n1)=nodarea(n1)+area
512 nodarea(n2)=nodarea(n2)+area
518 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
523 IF (nodarea(n) <= em20)
THEN
531 areainv = one/
max(em20,nodarea(n))
532 contn(1,n)=areainv*contn(1,n)
533 contn(2,n)=areainv*contn(2,n)
534 contn(3,n)=areainv*contn(3,n)
535 contt(1,n)=areainv*contt(1,n)
536 contt(2,n)=areainv*contt(2,n)
537 contt(3,n)=areainv*contt(3,n)
543 nodarea(1:numnod)=zero
551 IF( n <= numels8 )
THEN
553 n1=ixs(faces(1,ifac)+1,n)
554 n2=ixs(faces(2,ifac)+1,n)
555 n3=ixs(faces(3,ifac)+1,n)
556 n4=ixs(faces(4,ifac)+1,n)
588 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
589 nodarea(n1)=nodarea(n1)+area
590 nodarea(n2)=nodarea(n2)+area
591 nodarea(n3)=nodarea(n3)+area
592 nodarea(n4)=nodarea(n4)+area
597 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
600 nodarea(n1)=nodarea(n1)+area
602 nodarea(n3)=nodarea(n3)+area
606 nodarea(n1)=nodarea(n1)+area
607 nodarea(n2)=nodarea(n2)+area
608 nodarea(n4)=nodarea(n4)+area
612 nodarea(n2)=nodarea(n2)+area
613 nodarea(n3)=nodarea(n3)+area
614 nodarea(n4)=nodarea(n4)+area
618 nodarea(n2)=nodarea(n2)+area
619 nodarea(n3)=nodarea(n3)+area
620 nodarea(n4)=nodarea(n4)+area
625 ELSEIF( n <= numels8+numels10 )
THEN
629 nn1=faces10(1,4*(ifac-1)+j)
630 nn2=faces10(2,4*(ifac-1)+j)
631 nn3=faces10(3,4*(ifac-1)+j)
634 IF(nn1 >0.AND.nn1 < 10)
THEN
637 n1=ixs10(nn1-10,n-numels8)
645 n2=ixs10(nn2-10,n-numels8)
653 n3=ixs10(nn3-10,n-numels8)
658 IF(nn1 > 0 .AND. nn2 > 0 .AND.nn3 > 0)
THEN
683 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
685 nodarea(n1)=nodarea(n1)+area
686 nodarea(n2)=nodarea(n2)+area
687 nodarea(n3)=nodarea(n3)+area
727 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
728 nodarea(n1)=nodarea(n1)+area
729 nodarea(n2)=nodarea(n2)+area
730 nodarea(n3)=nodarea(n3)+area
731 nodarea(n4)=nodarea(n4)+area
757 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
758 nodarea(n1)=nodarea(n1)+area
759 nodarea(n2)=nodarea(n2)+area
760 nodarea(n3)=nodarea(n3)+area
791 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
792 nodarea(n1)=nodarea(n1)+area
793 nodarea(n2)=nodarea(n2)+area
794 nodarea(n3)=nodarea(n3)+area
801 n1=ixq(lines(1,iline)+1,n)
802 n2=ixq(lines(2,iline)+1,n)
809 area = sqrt((y2-y1)*(y2-y1)+(z2-z1)*(z2-z1))
813 nodarea(n1)=nodarea(n1)+area
814 nodarea(n2)=nodarea(n2)+area
819 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
823 IF(anim_v(27)+h3d_data%N_VECT_PCONT2 /=0)
THEN
825 IF (nodarea(n) == zero)
THEN
835 areainv = one/
max(em20,nodarea(n))
836 normal(1:3) = npcont2(1:3,n)
837 nnn = sqrt(
max(em20,normal(1)**2+normal(2)**2+normal(3)**2))
838 normal(1:3) = normal(1:3)/nnn
839 fn_proj = fncontp2(1,n)*normal(1)+fncontp2(2,n)*normal(2)+fncontp2(3,n)*normal(3)
840 f_total(1:3) = fncontp2(1:3,n)
841 fncontp2(1,n)=areainv*fn_proj*normal(1)
842 fncontp2(2,n)=areainv*fn_proj*normal(2)
843 fncontp2(3,n)=areainv*fn_proj*normal(3)
844 ftcontp2(1,n)=areainv*(f_total(1)-fn_proj*normal(1))
845 ftcontp2(2,n)=areainv*(f_total(2)-fn_proj*normal(2))
846 ftcontp2(3,n)=areainv*(f_total(3)-fn_proj*normal(3))
851 IF(output%DATA%NINEFRIC > 0)
THEN
852 DO ni=1,output%DATA%NINEFRIC
854 IF (nodarea(n) == zero)
THEN
857 areainv = one/
max(em30,nodarea(n))
858 csefric(ni,n)=areainv*output%DATA%EFRIC(ni,n)
864 IF(h3d_data%N_SCAL_CSE_FRIC >0)
THEN
866 IF (nodarea(n) == zero)
THEN
869 areainv = one/
max(em30,nodarea(n))
870 csefricg(n)=areainv*output%DATA%EFRICG(n)
892 . CONTN ,CONTT ,IAD_ELEM,FR_ELEM,WEIGHT ,
893 . NODGLOB ,FNCONTG ,FTCONTG,FNCONTP2,FTCONTP2 ,
894 . H3D_DATA,CSEFRIC_STAMP,CSEFRICG_STAMP,SZ_NPCONT2,NPCONT2)
900 use element_mod ,
only : nixs,nixc,nixtg
904#include "implicit_f.inc"
905#include "comlock.inc"
909#include "com01_c.inc"
910#include "com04_c.inc"
913#include "scr14_c.inc"
914#include "scr16_c.inc"
918 TYPE(output_),
intent(inout) :: OUTPUT
920 . IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*), (2,*),
921 . IAD_ELEM(2,*), FR_ELEM(*), WEIGHT(*), NODGLOB(*)
922 INTEGER ,
INTENT(IN) :: SZ_NPCONT2
924 . x(3,*), contn(3,*), contt(3,*), fncontg(3,*), ftcontg(3,*),
925 . fncontp2(3,*),ftcontp2(3,*)
926 my_real ,
INTENT(INOUT) :: csefric_stamp(output%DATA%NINEFRIC_STAMP,output%DATA%S_EFRICINTG),
927 . csefricg_stamp(output%DATA%S_EFRICG)
928 my_real ,
INTENT(IN) :: npcont2(3,sz_npcont2)
929 TYPE (H3D_DATABASE) :: H3D_DATA
938 . x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,
939 . x31,y31,z31,x42,y42,z42,x32,y32,z32,e3x,e3y,e3z,
940 . tmp,areainv,normal(3),nnn,f_total(1:3),fn_proj
942 my_real,
DIMENSION(:),
ALLOCATABLE :: nodarea,nodareag
952 ALLOCATE(nodarea(numnod))
961 n1=ixs(faces(1,ifac)+1,n)
962 n2=ixs(faces(2,ifac)+1,n)
963 n3=ixs(faces(3,ifac)+1,n)
964 n4=ixs(faces(4,ifac)+1,n)
996 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
997 nodarea(n1)=nodarea(n1)+
area
998 nodarea(n2)=nodarea(n2)+
area
999 nodarea(n3)=nodarea(n3)+
area
1000 nodarea(n4)=nodarea(n4)+
area
1005 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
1008 nodarea(n1)=nodarea(n1)+
area
1009 nodarea(n2)=nodarea(n2)+
area
1010 nodarea(n3)=nodarea(n3)+
area
1014 nodarea(n1)=nodarea(n1)+
area
1015 nodarea(n2)=nodarea(n2)+
area
1016 nodarea(n4)=nodarea(n4)+
area
1020 nodarea(n2)=nodarea(n2)+
area
1021 nodarea(n3)=nodarea(n3)+
area
1022 nodarea(n4)=nodarea(n4)+
area
1026 nodarea(n2)=nodarea(n2)+
area
1027 nodarea(n3)=nodarea(n3)+
area
1028 nodarea(n4)=nodarea(n4)+
area
1068 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
1069 nodarea(n1)=nodarea(n1)+
area
1070 nodarea(n2)=nodarea(n2)+
area
1071 nodarea(n3)=nodarea(n3)+
area
1072 nodarea(n4)=nodarea(n4)+
area
1098 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
1099 nodarea(n1)=nodarea(n1)+
area
1100 nodarea(n2)=nodarea(n2)+
area
1101 nodarea(n3)=nodarea(n3)+
area
1132 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
1133 nodarea(n1)=nodarea(n1)+
area
1134 nodarea(n2)=nodarea(n2)+
area
1135 nodarea(n3)=nodarea(n3)+
area
1139 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
1145 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT+output%DATA%NINEFRIC_STAMP
1146 . +h3d_data%N_SCAL_CSE_FRIC /=0)
THEN
1148 ALLOCATE(nodareag(numnodg))
1154 nodareag(i)=nodarea(k)*weight(k)
1159 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT/=0)
THEN
1163 IF(output%DATA%NINEFRIC_STAMP > 0)
THEN
1164 DO ni=1,output%DATA%NINEFRIC_STAMP
1166 csefric_stamp(ni,i)=output%DATA%EFRIC_STAMP(ni,i)
1172 IF(h3d_data%N_SCAL_CSE_FRIC > 0)
THEN
1174 csefricg_stamp(i)=output%DATA%EFRICG_STAMP(i)
1183 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT /=0)
THEN
1185 IF (nspmd == 1)
THEN
1188 IF (nodarea(n) == zero)
THEN
1196 tmp=one/
max(em30,nodarea(n))
1197 fncontg(1,i)=fncontg(1,i)*tmp
1198 fncontg(2,i)=fncontg(2,i)*tmp
1199 fncontg(3,i)=fncontg(3,i)*tmp
1200 ftcontg(1,i)=ftcontg(1,i)*tmp
1201 ftcontg(2,i)=ftcontg(2,i)*tmp
1202 ftcontg(3,i)=ftcontg(3,i)*tmp
1208 IF (nodareag(n) == zero)
THEN
1216 tmp=one/
max(em30,nodareag(n))
1217 fncontg(1,n)=fncontg(1,n)*tmp
1218 fncontg(2,n)=fncontg(2,n)*tmp
1219 fncontg(3,n)=fncontg(3,n)*tmp
1220 ftcontg(1,n)=ftcontg(1,n)*tmp
1221 ftcontg(2,n)=ftcontg(2,n)*tmp
1222 ftcontg(3,n)=ftcontg(3,n)*tmp
1239 IF(anim_v(27)+h3d_data%N_VECT_PCONT2 /=0)
THEN
1241 IF (nodarea(n) == zero)
THEN
1251 areainv = one/
max(em20,nodarea
1252 normal(1:3) = npcont2(1:3,n)
1253 nnn = sqrt(
max(em20,normal(1)**2+normal(2)**2+normal(3)**2))
1254 normal(1:3) = normal(1:3)/nnn
1255 fn_proj = fncontp2(1,n)*normal(1)+fncontp2(2,n)*normal(2)+fncontp2(3,n)*normal(3)
1256 f_total(1:3) = fncontp2(1:3,n)
1257 fncontp2(1,n)=areainv*fn_proj*normal(1)
1258 fncontp2(2,n)=areainv*fn_proj*normal(2)
1259 fncontp2(3,n)=areainv*fn_proj*normal(3)
1260 ftcontp2(1,n)=areainv*(f_total(1)-fn_proj*normal(1))
1261 ftcontp2(2,n)=areainv*(f_total(2)-fn_proj*normal(2))
1262 ftcontp2(3,n)=areainv*(f_total(3)-fn_proj*normal(3))
1267 IF(output%DATA%NINEFRIC_STAMP > 0)
THEN
1268 IF (nspmd == 1)
THEN
1269 DO ni=1,output%DATA%NINEFRIC_STAMP
1272 IF (nodarea(n) == zero)
THEN
1273 csefric_stamp(ni,i)=zero
1275 tmp=one/
max(em30,nodarea(n))
1276 csefric_stamp(ni,i)=tmp*output%DATA%EFRIC_STAMP(ni
1282 DO ni=1,output%DATA%NINEFRIC_STAMP
1284 IF (nodareag(n) == zero)
THEN
1285 csefric_stamp(ni,n)=zero
1287 tmp=one/
max(em30,nodareag(n))
1288 csefric_stamp(ni,n)=tmp*csefric_stamp(ni,n)
1293 DO ni=1,output%DATA%NINEFRIC_STAMP
1295 csefric_stamp(ni,n)=zero
1302 IF(h3d_data%N_SCAL_CSE_FRIC > 0)
THEN
1303 IF (nspmd == 1)
THEN
1306 IF (nodarea(n) == zero)
THEN
1307 csefricg_stamp(i)=zero
1309 tmp=one/
max(em30,nodarea(n))
1310 csefricg_stamp(i)=tmp*output%DATA%EFRICG_STAMP(i)
1316 IF (nodareag(n) == zero)
THEN
1317 csefricg_stamp(n)=zero
1319 tmp=one/
max(em30,nodareag(n))
1320 csefricg_stamp(n)=tmp*csefricg_stamp(n)
1325 csefricg_stamp(n)=zero
1332 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT+output%DATA%NINEFRIC_STAMP
1333 . +h3d_data%N_SCAL_CSE_FRIC /=0)
DEALLOCATE(nodareag)