OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_skin_ixskin.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_skin_ixskin (elbuf_tab, iparg, iparts, ixs, ixs10, itab, ixskin, tag_skins6, ibcl, iloadp, lloadp, nodal_ipart, imapskp, loads, pblast)
subroutine h3d_skin_dim (iparg, numskin, numsking, tag_skins6, ibcl, iloadp, lloadp, loads, numskinp0, numskinp, iflag, pblast)
subroutine h3d_skin_tsh_dim (iparg, tag_skins6, numskin)
subroutine h3d_skin_sol_dim (iparg, tag_skins6, numskin)
subroutine h3d_skin_pre_dim (ib, iloadp, lloadp, loads, nskin0, nskin, pblast)
subroutine h3d_pre_skin_ixskin (nodal_ipart, ib, iloadp, lloadp, ixskin, nskin, imapskp, loads, pblast)
subroutine get_nodal_ipart (elbuf_tab, iparg, ipartc, iparttg, iparts, ixc, ixtg, ixs, ixs10, ixs16, ixs20, nodal_ipart)

Function/Subroutine Documentation

◆ get_nodal_ipart()

subroutine get_nodal_ipart ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
integer, dimension(*) iparts,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) nodal_ipart )

Definition at line 926 of file h3d_skin_ixskin.F.

929C-----------------------------------------------
930C M o d u l e s
931C-----------------------------------------------
932 USE initbuf_mod
933 USE elbufdef_mod
934C-----------------------------------------------
935C I m p l i c i t T y p e s
936C-----------------------------------------------
937#include "implicit_f.inc"
938C-----------------------------------------------
939C C o m m o n B l o c k s
940C-----------------------------------------------
941#include "com01_c.inc"
942#include "com04_c.inc"
943#include "param_c.inc"
944C-----------------------------------------------
945C D u m m y A r g u m e n t s
946C-----------------------------------------------
947C REAL
948 INTEGER IPARG(NPARG,*),IXS(NIXS,*),IPARTS(*),
949 . IXC(NIXC,*),IXTG(NIXTG,*),IXS10(6,*),IXS16(8,*) ,
950 . IXS20(12,*),IPARTC(*),IPARTTG(*),NODAL_IPART(*)
951 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
952C-----------------------------------------------
953C L o c a l V a r i a b l e s
954C-----------------------------------------------
955 INTEGER I,NSKIN,ISOLNOD,ICS,NG,N,J,NJ
956 INTEGER
957 . MLW ,NEL ,NFT ,IAD ,ITY ,
958 . NPT ,JALE ,ISMSTR ,JEUL ,JTUR ,
959 . JTHE ,JLAG ,JMULT ,JHBE ,JIVF ,
960 . NVAUX ,JPOR ,KCVT ,JCLOSE ,JPLASOL ,
961 . IREP ,IINT ,IGTYP ,ISRAT ,ISROT ,
962 . ICSEN ,ISORTH ,ISORTHG ,IFAILURE,JSMS ,
963 . NN,NN1,N1,IDB
964C-----------------------------------------------
965 DO ng=1,ngroup
966 isolnod = iparg(28,ng)
967 CALL initbuf(iparg ,ng ,
968 2 mlw ,nel ,nft ,iad ,ity ,
969 3 npt ,jale ,ismstr ,jeul ,jtur ,
970 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
971 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
972 6 irep ,iint ,igtyp ,israt ,isrot ,
973 7 icsen ,isorth ,isorthg ,ifailure,jsms )
974!
975 IF(mlw == 13 .OR. mlw == 0) cycle
976C-----------------------------------------------
977C COQUES 3 N 4 N
978C-----------------------------------------------
979 IF (ity == 3 ) THEN
980 DO i=1,nel
981 n = i + nft
982 nodal_ipart(ixc(2:5,n))=ipartc(n)
983 END DO
984 ELSEIF (ity == 7) THEN
985 DO i=1,nel
986 n = i + nft
987 nodal_ipart(ixtg(2:4,n))=iparttg(n)
988 END DO
989C-----------------------------------------------
990C SOLID
991C-----------------------------------------------
992 ELSEIF (ity == 1) THEN
993
994 SELECT CASE (isolnod)
995 CASE(4)
996 DO i=1,nel
997 n = i + nft
998 nodal_ipart(ixs(2,n)) =iparts(n)
999 nodal_ipart(ixs(4,n)) =iparts(n)
1000 nodal_ipart(ixs(7,n)) =iparts(n)
1001 nodal_ipart(ixs(6,n)) =iparts(n)
1002 END DO
1003 CASE(6)
1004 DO i=1,nel
1005 n = i + nft
1006 nodal_ipart(ixs(2,n)) =iparts(n)
1007 nodal_ipart(ixs(3,n)) =iparts(n)
1008 nodal_ipart(ixs(4,n)) =iparts(n)
1009 nodal_ipart(ixs(7,n)) =iparts(n)
1010 nodal_ipart(ixs(6,n)) =iparts(n)
1011 nodal_ipart(ixs(8,n)) =iparts(n)
1012 END DO
1013 CASE(8)
1014 DO i=1,nel
1015 n = i + nft
1016 nodal_ipart(ixs(2:9,n)) =iparts(n)
1017 END DO
1018 CASE(10)
1019 DO i=1,nel
1020 n = i + nft
1021 nodal_ipart(ixs(2,n)) =iparts(n)
1022 nodal_ipart(ixs(4,n)) =iparts(n)
1023 nodal_ipart(ixs(7,n)) =iparts(n)
1024 nodal_ipart(ixs(6,n)) =iparts(n)
1025 nn1 = n - numels8
1026 DO j=1,6
1027 nj=ixs10(j,nn1)
1028 IF (nj>0) nodal_ipart(nj) =iparts(n)
1029 END DO
1030 END DO
1031 CASE(16)
1032 nn1 = n - (numels8+numels10+numels20)
1033 DO i=1,nel
1034 n = i + nft
1035 nodal_ipart(ixs(2:9,n)) =iparts(n)
1036 DO j=1,8
1037 nj=ixs16(j,nn1)
1038 IF (nj>0) nodal_ipart(nj) =iparts(n)
1039 END DO
1040 END DO
1041 CASE(20)
1042 nn1 = n - (numels8+numels10)
1043 DO i=1,nel
1044 n = i + nft
1045 nodal_ipart(ixs(2:9,n)) =iparts(n)
1046 DO j=1,12
1047 nj=ixs20(j,nn1)
1048 IF (nj>0) nodal_ipart(nj) =iparts(n)
1049 END DO
1050 END DO
1051 END SELECT
1052C-----------------------------------------------
1053 ENDIF
1054 END DO ! NG=1,NGROUP
1055C-----------
1056 RETURN
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261

◆ h3d_pre_skin_ixskin()

subroutine h3d_pre_skin_ixskin ( integer, dimension(*) nodal_ipart,
integer, dimension(nibcld,*) ib,
integer, dimension(sizloadp,*) iloadp,
integer, dimension(slloadp) lloadp,
integer, dimension(nixq,*) ixskin,
integer nskin,
integer, dimension(numskinp0), intent(in) imapskp,
type (loads_), intent(in) loads,
type(pblast_), intent(in) pblast )

Definition at line 749 of file h3d_skin_ixskin.F.

751C-----------------------------------------------
752C M o d u l e s
753C-----------------------------------------------
754 USE pinchtype_mod
755 USE h3d_inc_mod
756 USE loads_mod
757 USE pblast_mod
758C-----------------------------------------------
759C I m p l i c i t T y p e s
760C-----------------------------------------------
761#include "implicit_f.inc"
762#include "param_c.inc"
763C-----------------------------------------------
764C C o m m o n B l o c k s
765C-----------------------------------------------
766#include "com04_c.inc"
767#include "tabsiz_c.inc"
768C-----------------------------------------------
769C E x t e r n a l F u n c t i o n s
770C-----------------------------------------------
771C-----------------------------------------------,
772C D u m m y A r g u m e n t s
773C-----------------------------------------------
774 INTEGER , DIMENSION(NUMSKINP0), INTENT(IN) :: IMAPSKP
775 INTEGER LLOADP(SLLOADP),NSKIN,IXSKIN(NIXQ,*)
776 INTEGER ILOADP(SIZLOADP,*),IB(NIBCLD,*),NODAL_IPART(*)
777 TYPE (LOADS_) , INTENT(IN) :: LOADS
778 TYPE(PBLAST_),INTENT(IN) :: PBLAST
779C-----------------------------------------------
780C L o c a l V a r i a b l e s
781C-----------------------------------------------
782 INTEGER NL, N1, ISK, N2, N3, N4, N5,
783 . IAD ,NP ,IFUNC ,NPRES,NSKIN0,NSKIN1,N,I,PID0,SHIFT
784C=======================================================================
785C-----IXSKIN(1,*):ipart;IXSKIN(2:5,*):N1-4,IXSKIN(6,*):pid;IXSKIN(7,*):usr_id
786 pid0 =0
787 nskin0 = nskin
788 np = 0
789C-----Force (pressure) first
790 DO nl=1,nconld-nploadpinch
791 n1 = ib(1,nl)
792 n2 = ib(2,nl)
793 n3 = ib(3,nl)
794 n4 = ib(4,nl)
795 IF (n1==0.OR.n2==0.OR.n3==0.OR.n4==-1) cycle
796C
797 np = np + 1
798 nskin = nskin0+ imapskp(np)
799 ixskin(2,nskin)=n1
800 ixskin(3,nskin)=n2
801 ixskin(4,nskin)=n3
802 IF (n4==0) THEN
803 ixskin(5,nskin)=n3
804 ELSEIF(n4>0) THEN
805 ixskin(5,nskin)=n4
806 END IF
807 ixskin(1,nskin)=nodal_ipart(n1)
808 ixskin(6,nskin)=nskin0+nl
809 END DO
810 nskin1 = nskin
811C----------load_pressure
812 shift = nloadp_f+pblast%NLOADP_B
813 DO nl=1+shift,nloadp_hyd+shift
814 iad = iloadp(4,nl)
815 DO n=1, iloadp(1,nl)/4
816 n1 = lloadp(iad+4*(n-1))
817 n2 = lloadp(iad+4*(n-1)+1)
818 n3 = lloadp(iad+4*(n-1)+2)
819 n4 = lloadp(iad+4*(n-1)+3)
820 IF (n1==0.OR.n2==0.OR.n3==0) cycle
821C
822 np = np + 1
823 IF (imapskp(np) < np) cycle
824 nskin = nskin0+ imapskp(np)
825 ixskin(2,nskin)=n1
826 ixskin(3,nskin)=n2
827 ixskin(4,nskin)=n3
828 IF (n4==0) THEN
829 ixskin(5,nskin)=n3
830 ELSEIF(n4>0) THEN
831 ixskin(5,nskin)=n4
832 END IF
833 ixskin(1,nskin)=nodal_ipart(n1)
834 ixskin(6,nskin)=nskin1+nl
835 ENDDO
836 END DO !NP=1,NLOADP_HYD
837C---------pfluid
838 nskin1 = nskin
839 DO nl=1,nloadp_f
840 iad = iloadp(4,nl)
841 DO i = 1,iloadp(1,nl)/4
842 n1=lloadp(iad+4*(i-1))
843 n2=lloadp(iad+4*(i-1)+1)
844 n3=lloadp(iad+4*(i-1)+2)
845 n4=lloadp(iad+4*(i-1)+3)
846 IF (n1==0.OR.n2==0.OR.n3==0) cycle
847C
848 np = np + 1
849 IF (imapskp(np) < np) cycle
850 nskin = nskin0+ imapskp(np)
851 ixskin(2,nskin)=n1
852 ixskin(3,nskin)=n2
853 ixskin(4,nskin)=n3
854 IF (n4==0) THEN
855 ixskin(5,nskin)=n3
856 ELSEIF(n4>0) THEN
857 ixskin(5,nskin)=n4
858 END IF
859 ixskin(1,nskin)=nodal_ipart(n1)
860 ixskin(6,nskin)=nskin1+nl
861 END DO
862 END DO
863C---------pblast
864 nskin1 = nskin
865 DO nl=1+nloadp_f,nloadp_f+pblast%NLOADP_B
866 iad = iloadp(4,nl)
867 DO i = 1,iloadp(1,nl)/4
868 n1=lloadp(iad+4*(i-1))
869 n2=lloadp(iad+4*(i-1)+1)
870 n3=lloadp(iad+4*(i-1)+2)
871 n4=lloadp(iad+4*(i-1)+3)
872 IF (n1==0.OR.n2==0.OR.n3==0) cycle
873C
874 np = np + 1
875 IF (imapskp(np) < np) cycle
876 nskin = nskin0+ imapskp(np)
877 ixskin(2,nskin)=n1
878 ixskin(3,nskin)=n2
879 ixskin(4,nskin)=n3
880 IF (n4==0) THEN
881 ixskin(5,nskin)=n3
882 ELSEIF(n4>0) THEN
883 ixskin(5,nskin)=n4
884 END IF
885 ixskin(1,nskin)=nodal_ipart(n1)
886 ixskin(6,nskin)=nskin1+nl
887 END DO
888 END DO
889C---------/LOAD/PCYL
890 nskin1 = nskin
891 DO nl=1,loads%NLOAD_CYL
892 DO i = 1,loads%LOAD_CYL(nl)%NSEG
893 n1 = loads%LOAD_CYL(nl)%SEGNOD(i,1)
894 n2 = loads%LOAD_CYL(nl)%SEGNOD(i,2)
895 n3 = loads%LOAD_CYL(nl)%SEGNOD(i,3)
896 n4 = loads%LOAD_CYL(nl)%SEGNOD(i,4)
897C
898 np = np + 1
899 IF (imapskp(np) < np) cycle
900 nskin = nskin0+ imapskp(np)
901 ixskin(2,nskin)=n1
902 ixskin(3,nskin)=n2
903 ixskin(4,nskin)=n3
904 IF (n4==0) THEN
905 ixskin(5,nskin)=n3
906 ELSEIF(n4>0) THEN
907 ixskin(5,nskin)=n4
908 END IF
909 ixskin(1,nskin)=nodal_ipart(n1)
910 ixskin(6,nskin)=nskin1+nl
911 END DO
912 END DO
913C
914 RETURN
h3d_inc_mod
Definition h3d_inc_mod.F:42
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::nploadpinch
integer nploadpinch
Definition pinchtype_mod.F:74
nl
character *2 function nl()
Definition message.F:2354

◆ h3d_skin_dim()

subroutine h3d_skin_dim ( integer, dimension(*) iparg,
integer numskin,
integer numsking,
integer, dimension(*) tag_skins6,
integer, dimension(*) ibcl,
integer, dimension(*) iloadp,
integer, dimension(*) lloadp,
type (loads_), intent(in) loads,
integer, intent(out) numskinp0,
integer numskinp,
integer iflag,
type (pblast_), intent(in) pblast )

Definition at line 273 of file h3d_skin_ixskin.F.

275C-----------------------------------------------
276C M o d u l e s
277C-----------------------------------------------
278 USE loads_mod
279 USE pblast_mod
280C-----------------------------------------------
281C I m p l i c i t T y p e s
282C-----------------------------------------------
283#include "implicit_f.inc"
284C-----------------------------------------------
285C C o m m o n B l o c k s
286C-----------------------------------------------
287#include "com01_c.inc"
288C-----------------------------------------------
289C D u m m y A r g u m e n t s
290C-----------------------------------------------
291 INTEGER ,INTENT(OUT) :: NUMSKINP0
292 INTEGER NUMSKIN, NUMSKING ,IPARG(*),TAG_SKINS6(*),
293 . IBCL(*),ILOADP(*),LLOADP(*),NUMSKINP,IFLAG
294 TYPE (LOADS_) , INTENT(IN) :: LOADS
295 TYPE (PBLAST_),INTENT(IN) :: PBLAST
296C-----------------------------------------------
297C L o c a l V a r i a b l e s
298C-----------------------------------------------
299 INTEGER I, LEN ,N0 ,NUMSKIN0
300
301C-----------------------------------------------
302 numskin = 0
303C--- thick-shell first, solid after
304 IF (iflag==1.OR.iflag==3) THEN
305 CALL h3d_skin_tsh_dim(iparg ,tag_skins6, numskin)
306 CALL h3d_skin_sol_dim(iparg ,tag_skins6, numskin)
307 END IF
308C--- followed by pressure: pblast, pfluid,force...
309 n0 = numskin
310 numskin0 = numskin
311C------!!!!create NODAL_IPART(numnod) before
312 IF (iflag>1) CALL h3d_skin_pre_dim (ibcl,iloadp,lloadp,loads, numskin0,numskin,pblast)
313 numskinp =numskin- n0
314 numskinp0=numskin0- n0
315C
316 len = 1
317 IF (nspmd>1) THEN
318 numsking = numskin
319 CALL spmd_allglob_isum9(numsking,len)
320 ELSE
321 numsking = numskin
322 END IF
323C-----------
324 RETURN
h3d_skin_tsh_dim
subroutine h3d_skin_tsh_dim(iparg, tag_skins6, numskin)
Definition h3d_skin_ixskin.F:336
h3d_skin_pre_dim
subroutine h3d_skin_pre_dim(ib, iloadp, lloadp, loads, nskin0, nskin, pblast)
Definition h3d_skin_ixskin.F:500
h3d_skin_sol_dim
subroutine h3d_skin_sol_dim(iparg, tag_skins6, numskin)
Definition h3d_skin_ixskin.F:394
spmd_allglob_isum9
subroutine spmd_allglob_isum9(v, len)
Definition spmd_allglob_isum9.F:46

◆ h3d_skin_ixskin()

subroutine h3d_skin_ixskin ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(*) iparts,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(*) itab,
integer, dimension(nixq,*) ixskin,
integer, dimension(*) tag_skins6,
integer, dimension(*) ibcl,
integer, dimension(*) iloadp,
integer, dimension(*) lloadp,
integer, dimension(*) nodal_ipart,
integer, dimension(numskinp0), intent(in) imapskp,
type (loads_), intent(in) loads,
type (pblast_), intent(in) pblast )

Definition at line 38 of file h3d_skin_ixskin.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE initbuf_mod
46 USE elbufdef_mod
47 USE h3d_inc_mod
48 USE loads_mod
49 USE pblast_mod
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "param_c.inc"
60
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER, DIMENSION(NUMSKINP0), INTENT(IN) :: IMAPSKP
65 INTEGER IPARG(NPARG,*),IXS(NIXS,*),IPARTS(*),ITAB(*),IXSKIN(NIXQ,*),
66 . IXS10(6,*) ,TAG_SKINS6(*),IBCL(*),ILOADP(*),LLOADP(*),
67 . NODAL_IPART(*)
68 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
69 TYPE (LOADS_) , INTENT(IN) :: LOADS
70 TYPE (PBLAST_),INTENT(IN) :: PBLAST
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I,NSKIN,ISOLNOD,ICS,NG,N,J
75 INTEGER
76 . MLW ,NEL ,NFT ,IAD ,ITY ,
77 . NPT ,JALE ,ISMSTR ,JEUL ,JTUR ,
78 . JTHE ,JLAG ,JMULT ,JHBE ,JIVF ,
79 . NVAUX ,JPOR ,KCVT ,JCLOSE ,JPLASOL ,
80 . IREP ,IINT ,IGTYP ,ISRAT ,ISROT ,
81 . ICSEN ,ISORTH ,ISORTHG ,IFAILURE,JSMS ,
82 . NN,NN1,N1,IDB
83C-----------------------------------------------
84 nskin =0
85 IF (numskin> numskinp) THEN
86 DO ng=1,ngroup
87 isolnod = iparg(28,ng)
88 ics = iparg(17,ng)
89 CALL initbuf(iparg ,ng ,
90 2 mlw ,nel ,nft ,iad ,ity ,
91 3 npt ,jale ,ismstr ,jeul ,jtur ,
92 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
93 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
94 6 irep ,iint ,igtyp ,israt ,isrot ,
95 7 icsen ,isorth ,isorthg ,ifailure,jsms )
96!
97 IF(mlw == 13 .OR. mlw == 0) cycle
98C-----------------------------------------------
99C THICK-SHELL
100C-----------------------------------------------
101! 8--------------7
102! / | /|
103! 5--------------|6
104! | | | |
105! | 4-----------|-3
106! | / |/
107! 1--------------2
108 IF (ity == 1.AND.(igtyp==20 .OR. igtyp==21 .OR. igtyp==22)) THEN
109
110C-------- grp skin_inf first
111 DO i=1,nel
112 n = i + nft
113 ixskin(1,nskin+i) = iparts(n)
114 ixskin(7,nskin+i) = nskin+i
115 END DO
116 IF (jhbe==14) THEN
117 SELECT CASE (ics)
118 CASE(1)
119 DO i=1,nel
120 n = i + nft
121C-----------skin_inf 1,4,8,5
122 ixskin(2,nskin+i) = itab(ixs(2,n))
123 ixskin(3,nskin+i) = itab(ixs(5,n))
124 ixskin(4,nskin+i) = itab(ixs(9,n))
125 ixskin(5,nskin+i) = itab(ixs(6,n))
126 ixskin(6,nskin+i) = ixs(nixs-1,n)
127c IXSKIN(7,NSKIN+I) = IXS(NIXS,N) +3
128 END DO
129 CASE(10)
130 DO i=1,nel
131 n = i + nft
132C-----------skin_inf 1,2,3,4
133 ixskin(2,nskin+i) = itab(ixs(2,n))
134 ixskin(3,nskin+i) = itab(ixs(3,n))
135 ixskin(4,nskin+i) = itab(ixs(4,n))
136 ixskin(5,nskin+i) = itab(ixs(5,n))
137 ixskin(6,nskin+i) = ixs(nixs-1,n)
138c IXSKIN(7,NSKIN+I) = IXS(NIXS,N) +1
139 ENDDO
140 CASE(100)
141 DO i=1,nel
142 n = i + nft
143C-----------skin_inf 1,5,6,2
144 ixskin(2,nskin+i) = itab(ixs(2,n))
145 ixskin(3,nskin+i) = itab(ixs(6,n))
146 ixskin(4,nskin+i) = itab(ixs(7,n))
147 ixskin(5,nskin+i) = itab(ixs(3,n))
148 ixskin(6,nskin+i) = ixs(nixs-1,n)
149c IXSKIN(7,NSKIN+I) = IXS(NIXS,N) +5
150 END DO
151 END SELECT
152 ELSEIF (isolnod==6) THEN ! penta
153 DO i=1,nel
154 n = i + nft
155C-----------skin_inf 1,2,3,4
156 ixskin(2,nskin+i) = itab(ixs(2,n))
157 ixskin(3,nskin+i) = itab(ixs(3,n))
158 ixskin(4,nskin+i) = itab(ixs(4,n))
159 ixskin(5,nskin+i) = itab(ixs(4,n))
160 ixskin(6,nskin+i) = ixs(nixs-1,n)
161c IXSKIN(7,NSKIN+I) = IXS(NIXS,N) + 1
162 ENDDO
163C---------
164 ELSE ! hexa 15,16
165 DO i=1,nel
166 n = i + nft
167C-----------skin_inf 1,2,3,4
168 ixskin(2,nskin+i) = itab(ixs(2,n))
169 ixskin(3,nskin+i) = itab(ixs(3,n))
170 ixskin(4,nskin+i) = itab(ixs(4,n))
171 ixskin(5,nskin+i) = itab(ixs(5,n))
172 ixskin(6,nskin+i) = ixs(nixs-1,n)
173c IXSKIN(7,NSKIN+I) = IXS(NIXS,N) + 1
174 ENDDO
175 END IF
176 nskin = nskin + nel
177C-------- grp skin_sup
178 DO i=1,nel
179 n = i + nft
180 ixskin(1,nskin+i) = iparts(n)
181 ixskin(7,nskin+i) = nskin+i
182 END DO
183 IF (jhbe==14) THEN
184 SELECT CASE (ics)
185 CASE(1)
186 DO i=1,nel
187 n = i + nft
188C-----------skin_sup 2,3,7,6
189 ixskin(2,nskin+i) = itab(ixs(3,n))
190 ixskin(3,nskin+i) = itab(ixs(4,n))
191 ixskin(4,nskin+i) = itab(ixs(8,n))
192 ixskin(5,nskin+i) = itab(ixs(7,n))
193 ixskin(6,nskin+i) = ixs(nixs-1,n)
194c IXSKIN(7,NSKIN+I) = IXS(NIXS,N) +4
195 END DO
196 CASE(10)
197 DO i=1,nel
198 n = i + nft
199C-----------skin_sup 5,6,7,8
200 ixskin(2:5,nskin+i) = itab(ixs(6:9,n))
201 ixskin(6,nskin+i) = ixs(nixs-1,n)
202c IXSKIN(7,NSKIN+I) = IXS(NIXS,N) +2
203 ENDDO
204 CASE(100)
205 DO i=1,nel
206 n = i + nft
207C-----------skin_sup 4,8,7,3
208 ixskin(2,nskin+i) = itab(ixs(5,n))
209 ixskin(3,nskin+i) = itab(ixs(9,n))
210 ixskin(4,nskin+i) = itab(ixs(8,n))
211 ixskin(5,nskin+i) = itab(ixs(4,n))
212 ixskin(6,nskin+i) = ixs(nixs-1,n)
213c IXSKIN(7,NSKIN+I) = IXS(NIXS,N) +6
214 END DO
215 END SELECT
216 ELSEIF (isolnod==6) THEN ! penta
217 DO i=1,nel
218 n = i + nft
219C-----------skin_sup 5,6,7,8
220 ixskin(2:4,nskin+i) = itab(ixs(6:8,n))
221 ixskin(5,nskin+i) = ixskin(4,nskin+i)
222 ixskin(6,nskin+i) = ixs(nixs-1,n)
223c IXSKIN(7,NSKIN+I) = IXS(NIXS,N) + IXS(NIXS,N)
224 ENDDO
225 ELSE ! 15,16
226 DO i=1,nel
227 n = i + nft
228C-----------skin_sup 5,6,7,8
229 ixskin(2:5,nskin+i) = itab(ixs(6:9,n))
230 ixskin(6,nskin+i) = ixs(nixs-1,n)
231c IXSKIN(7,NSKIN+I) = IXS(NIXS,N) + IXS(NIXS,N)
232 ENDDO
233 END IF
234 nskin = nskin + nel
235C-----------------------------------------------
236 ENDIF !IF (ITY == 1.AND.(IGTYP==20
237 END DO ! NG=1,NGROUP
238 END IF !(NUMSKIN> NUMSKINP) THEN
239C------SOLID elements
240 nft = nskin
241 IF (numskin> (nskin+numskinp)) THEN
242 CALL h3d_sol_skin_ixskin(elbuf_tab,iparg,iparts,ixs,ixs10,
243 . ixskin ,tag_skins6,nskin )
244 DO i=nft+1,nskin
245 ixskin(2:5,i) = itab(ixskin(2:5,i))
246 END DO
247 END IF !(NUMSKIN> (NSKIN+NUMSKINP)) THEN
248C------to show pressure
249 nft = nskin
250 IF (numskinp>0) THEN
251 CALL h3d_pre_skin_ixskin(nodal_ipart,ibcl ,iloadp,lloadp,
252 . ixskin ,nskin ,imapskp,loads,pblast )
253 DO i=nft+1,nskin
254 ixskin(2:5,i) = itab(ixskin(2:5,i))
255 END DO
256 END IF
257C-----------
258 RETURN
h3d_pre_skin_ixskin
subroutine h3d_pre_skin_ixskin(nodal_ipart, ib, iloadp, lloadp, ixskin, nskin, imapskp, loads, pblast)
Definition h3d_skin_ixskin.F:751
h3d_sol_skin_ixskin
subroutine h3d_sol_skin_ixskin(elbuf_tab, iparg, iparts, ixs, ixs10, ixskin, tag_skins6, nskin)
Definition h3d_sol_skin_ixskin.F:36
h3d_inc_mod::numskinp
integer numskinp
Definition h3d_inc_mod.F:44

◆ h3d_skin_pre_dim()

subroutine h3d_skin_pre_dim ( integer, dimension(nibcld,*) ib,
integer, dimension(sizloadp,*) iloadp,
integer, dimension(slloadp) lloadp,
type (loads_), intent(in) loads,
integer nskin0,
integer nskin,
type(pblast_), intent(in) pblast )

Definition at line 499 of file h3d_skin_ixskin.F.

500C-----------------------------------------------
501C M o d u l e s
502C-----------------------------------------------
503 USE pinchtype_mod
504 USE loads_mod
505 USE pblast_mod
506C-----------------------------------------------
507C I m p l i c i t T y p e s
508C-----------------------------------------------
509#include "implicit_f.inc"
510#include "param_c.inc"
511C-----------------------------------------------
512C C o m m o n B l o c k s
513C-----------------------------------------------
514#include "com04_c.inc"
515#include "tabsiz_c.inc"
516C-----------------------------------------------
517C E x t e r n a l F u n c t i o n s
518C-----------------------------------------------
519C-----------------------------------------------,
520C D u m m y A r g u m e n t s
521C-----------------------------------------------
522 INTEGER LLOADP(SLLOADP),NSKIN,NSKIN0
523 INTEGER ILOADP(SIZLOADP,*),IB(NIBCLD,*)
524 TYPE (LOADS_) , INTENT(IN) :: LOADS
525 TYPE(PBLAST_),INTENT(IN) :: PBLAST
526C-----------------------------------------------
527C L o c a l V a r i a b l e s
528C-----------------------------------------------
529 INTEGER NL, N1, ISK, N2, N3, N4, N5, J,
530 . IAD ,NP ,IFUNC ,NPRES ,N,NSKIN_I,NSKINP0,IERR,IXST,SHIFT
531 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGN
532 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IRECT
533C=======================================================================
534C-----Force (pressure) first
535 nskin_i = nskin
536 DO nl=1,nconld-nploadpinch
537 n1 = ib(1,nl)
538 n2 = ib(2,nl)
539 n3 = ib(3,nl)
540 n4 = ib(4,nl)
541C
542 IF (n1>0.AND.n2>0.AND.n3>0.AND.n4/=-1) nskin = nskin + 1
543 END DO
544C----------load_pressure
545 shift = nloadp_f+pblast%NLOADP_B
546 DO nl=1+shift,nloadp_hyd+shift
547 iad = iloadp(4,nl)
548 DO n=1, iloadp(1,nl)/4
549 n1 = lloadp(iad+4*(n-1))
550 n2 = lloadp(iad+4*(n-1)+1)
551 n3 = lloadp(iad+4*(n-1)+2)
552 n4 = lloadp(iad+4*(n-1)+3)
553 IF (n1>0.AND.n2>0.AND.n3>0) nskin = nskin + 1
554 ENDDO
555 END DO
556C---------pfluid+pblast
557 DO nl=1,nloadp_f+pblast%NLOADP_B
558 iad = iloadp(4,nl)
559 DO n=1, iloadp(1,nl)/4
560 n1 = lloadp(iad+4*(n-1))
561 n2 = lloadp(iad+4*(n-1)+1)
562 n3 = lloadp(iad+4*(n-1)+2)
563 n4 = lloadp(iad+4*(n-1)+3)
564 IF (n1>0.AND.n2>0.AND.n3>0) nskin = nskin + 1
565 ENDDO
566 END DO
567C
568 DO nl = 1,loads%NLOAD_CYL
569 DO n = 1,loads%LOAD_CYL(nl)%NSEG
570 n1 = loads%LOAD_CYL(nl)%SEGNOD(n,1)
571 n2 = loads%LOAD_CYL(nl)%SEGNOD(n,2)
572 n3 = loads%LOAD_CYL(nl)%SEGNOD(n,3)
573 n4 = loads%LOAD_CYL(nl)%SEGNOD(n,4)
574 IF (n1>0.AND.n2>0.AND.n3>0) nskin = nskin + 1
575 ENDDO
576 END DO
577C
578 nskin0 = nskin
579 nskinp0 = nskin0 - nskin_i
580 IF (nskinp0 > (nconld-nploadpinch)) THEN
581 ALLOCATE(irect(4,nskinp0),itagn(numnod),stat=ierr)
582C
583 np = 0
584 itagn = 0
585 DO nl=1,nconld-nploadpinch
586 n1 = ib(1,nl)
587 n2 = ib(2,nl)
588 n3 = ib(3,nl)
589 n4 = ib(4,nl)
590C
591 IF (n1==0.OR.n2==0.OR.n3==0.OR.n4==-1) cycle
592 IF (n4==0) n4 = n3
593 np = np +1
594 itagn(n1) = 1
595 itagn(n2) = 1
596 itagn(n3) = 1
597 itagn(n4) = 1
598 irect(1:4,np) = ib(1:4,nl)
599 END DO
600C----add only not existing
601 shift = nloadp_f+pblast%NLOADP_B
602 DO nl=1+shift,nloadp_hyd+shift
603 iad = iloadp(4,nl)
604 DO n=1, iloadp(1,nl)/4
605 n1 = lloadp(iad+4*(n-1))
606 n2 = lloadp(iad+4*(n-1)+1)
607 n3 = lloadp(iad+4*(n-1)+2)
608 n4 = lloadp(iad+4*(n-1)+3)
609 IF (n1==0.OR.n2==0.OR.n3==0) cycle
610 IF (n4==0) n4 = n3
611 IF(itagn(n1)+itagn(n2)+itagn(n3)+itagn(n4)<4) THEN
612 np = np +1
613 itagn(n1) = 1
614 itagn(n2) = 1
615 itagn(n3) = 1
616 itagn(n4) = 1
617 irect(1,np) = n1
618 irect(2,np) = n2
619 irect(3,np) = n3
620 irect(4,np) = n4
621 ELSE
622 ixst = 0
623 j = 0
624 DO WHILE (ixst==0 .AND. j < np)
625 j = j + 1
626 IF (n1 /= irect(1,j)) cycle
627 IF (n2 /= irect(2,j)) cycle
628 IF (n3 /= irect(3,j)) cycle
629 IF (n4 /= irect(4,j)) cycle
630 ixst = 1
631 END DO
632 IF (ixst == 0 )THEN
633 np = np +1
634 itagn(n1) = 1
635 itagn(n2) = 1
636 itagn(n3) = 1
637 itagn(n4) = 1
638 irect(1,np) = n1
639 irect(2,np) = n2
640 irect(3,np) = n3
641 irect(4,np) = n4
642 END IF
643 END IF
644 ENDDO
645 END DO
646 DO nl=1,nloadp_f + pblast%NLOADP_B
647 iad = iloadp(4,nl)
648 DO n=1, iloadp(1,nl)/4
649 n1 = lloadp(iad+4*(n-1))
650 n2 = lloadp(iad+4*(n-1)+1)
651 n3 = lloadp(iad+4*(n-1)+2)
652 n4 = lloadp(iad+4*(n-1)+3)
653 IF (n1==0.OR.n2==0.OR.n3==0) cycle
654 IF (n4==0) n4 = n3
655 IF(itagn(n1)+itagn(n2)+itagn(n3)+itagn(n4)<4) THEN
656 np = np +1
657 itagn(n1) = 1
658 itagn(n2) = 1
659 itagn(n3) = 1
660 itagn(n4) = 1
661 irect(1,np) = n1
662 irect(2,np) = n2
663 irect(3,np) = n3
664 irect(4,np) = n4
665 ELSE
666 ixst = 0
667 j = 0
668 DO WHILE (ixst==0 .AND. j < np)
669 j = j + 1
670 IF (n1 /= irect(1,j)) cycle
671 IF (n2 /= irect(2,j)) cycle
672 IF (n3 /= irect(3,j)) cycle
673 IF (n4 /= irect(4,j)) cycle
674 ixst = 1
675 END DO
676 IF (ixst == 0 )THEN
677 np = np +1
678 itagn(n1) = 1
679 itagn(n2) = 1
680 itagn(n3) = 1
681 itagn(n4) = 1
682 irect(1,np) = n1
683 irect(2,np) = n2
684 irect(3,np) = n3
685 irect(4,np) = n4
686 END IF
687 END IF
688 ENDDO
689 END DO
690 DO nl = 1,loads%NLOAD_CYL
691 DO n = 1,loads%LOAD_CYL(nl)%NSEG
692 n1 = loads%LOAD_CYL(nl)%SEGNOD(n,1)
693 n2 = loads%LOAD_CYL(nl)%SEGNOD(n,2)
694 n3 = loads%LOAD_CYL(nl)%SEGNOD(n,3)
695 n4 = loads%LOAD_CYL(nl)%SEGNOD(n,4)
696 IF (n4==0) n4 = n3
697 IF(itagn(n1)+itagn(n2)+itagn(n3)+itagn(n4)<4) THEN
698 np = np +1
699 itagn(n1) = 1
700 itagn(n2) = 1
701 itagn(n3) = 1
702 itagn(n4) = 1
703 irect(1,np) = n1
704 irect(2,np) = n2
705 irect(3,np) = n3
706 irect(4,np) = n4
707 ELSE
708 ixst = 0
709 j = 0
710 DO WHILE (ixst==0 .AND. j < np)
711 j = j + 1
712 IF (n1 /= irect(1,j)) cycle
713 IF (n2 /= irect(2,j)) cycle
714 IF (n3 /= irect(3,j)) cycle
715 IF (n4 /= irect(4,j)) cycle
716 ixst = 1
717 END DO
718 IF (ixst == 0 )THEN
719 np = np +1
720 itagn(n1) = 1
721 itagn(n2) = 1
722 itagn(n3) = 1
723 itagn(n4) = 1
724 irect(1,np) = n1
725 irect(2,np) = n2
726 irect(3,np) = n3
727 irect(4,np) = n4
728 END IF
729 END IF
730 ENDDO
731 END DO
732 nskin = nskin_i + np
733 DEALLOCATE(irect,itagn)
734 END IF
735C-----some segs are used > 1 times
736C
737 RETURN

◆ h3d_skin_sol_dim()

subroutine h3d_skin_sol_dim ( integer, dimension(nparg,*) iparg,
integer, dimension(*) tag_skins6,
integer numskin )

Definition at line 393 of file h3d_skin_ixskin.F.

394C-----------------------------------------------
395C M o d u l e s
396C-----------------------------------------------
397 USE initbuf_mod
398C-----------------------------------------------
399C I m p l i c i t T y p e s
400C-----------------------------------------------
401#include "implicit_f.inc"
402C-----------------------------------------------
403C C o m m o n B l o c k s
404C-----------------------------------------------
405#include "param_c.inc"
406#include "com01_c.inc"
407C-----------------------------------------------
408C D u m m y A r g u m e n t s
409C-----------------------------------------------
410C REAL
411 INTEGER IPARG(NPARG,*),NUMSKIN, TAG_SKINS6(*)
412C-----------------------------------------------
413C L o c a l V a r i a b l e s
414C-----------------------------------------------
415 INTEGER I,NG,N,J,N1,N2,
416 . MLW ,NEL ,NFT ,IAD ,ITY ,
417 . NPT ,JALE ,ISMSTR ,JEUL ,JTUR ,
418 . JTHE ,JLAG ,JMULT ,JHBE ,JIVF ,
419 . NVAUX ,JPOR ,KCVT ,JCLOSE ,JPLASOL ,
420 . IREP ,IINT ,IGTYP ,ISRAT ,ISROT ,
421 . ICSEN ,ISORTH ,ISORTHG ,IFAILURE,JSMS ,
422 . NN,ICS,ISOLNOD,NN1,JJ,II,K1,K2,NF(3),NSKIN2,IDB
423 INTEGER FACES(4,6),NS(4),PWR(7),LL
424 DATA pwr/1,2,4,8,16,32,64/
425 DATA faces/4,3,2,1,
426 . 5,6,7,8,
427 . 1,2,6,5,
428 . 3,4,8,7,
429 . 2,3,7,6,
430 . 1,5,8,4/
431C----tetra4:-------------------------------------------
432c N8=N4 FACES : 2 2 1 1
433c N7=N3 4 3 3 4
434c N6=N3 1 1 3 4
435c N5=N4 2 2 4 3
436c N4=N2 1 2 3 3
437c N3=N2 1 4 4 2
438C-----------------------------------------------
439 DO ng=1,ngroup
440 CALL initbuf(iparg ,ng ,
441 2 mlw ,nel ,nft ,iad ,ity ,
442 3 npt ,jale ,ismstr ,jeul ,jtur ,
443 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
444 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
445 6 irep ,iint ,igtyp ,israt ,isrot ,
446 7 icsen ,isorth ,isorthg ,ifailure,jsms )
447!
448 IF(mlw == 13 .OR. mlw == 0.OR.ity /= 1) cycle
449C------
450 IF (igtyp==6 .OR. igtyp==14 ) THEN
451 isolnod = iparg(28,ng)
452 ics = iparg(17,ng)
453 IF(isolnod == 4)THEN
454!$omp simd private(jj,n,ll) reduction(+:numskin)
455 DO i=1,nel
456 n = i + nft
457 ll=tag_skins6(n)
458 DO jj=3,6
459 IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
460 numskin = numskin + 1
461 END DO
462 ENDDO
463 ELSEIF(isolnod == 6)THEN
464 ELSEIF(isolnod == 10)THEN
465!$OMP SIMD PRIVATE(JJ,N,LL) REDUCTION(+:NUMSKIN)
466 DO i=1,nel
467 n = i + nft
468 ll=tag_skins6(n)
469 DO jj=3,6
470 IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
471 numskin = numskin + 4
472 END DO
473 ENDDO
474 ELSE
475!$OMP SIMD PRIVATE(JJ,N,LL) REDUCTION(+:NUMSKIN)
476 DO i=1,nel
477 n = i + nft
478 ll=tag_skins6(n)
479 DO jj=1,6
480 IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
481 numskin = numskin + 1
482 END DO
483 ENDDO
484 ENDIF
485 ENDIF !IF (IGTYP==
486 END DO ! NG=1,NGROUP
487C-----------
488 RETURN

◆ h3d_skin_tsh_dim()

subroutine h3d_skin_tsh_dim ( integer, dimension(nparg,*) iparg,
integer, dimension(*) tag_skins6,
integer numskin )

Definition at line 335 of file h3d_skin_ixskin.F.

336C-----------------------------------------------
337C M o d u l e s
338C-----------------------------------------------
339 USE initbuf_mod
340C-----------------------------------------------
341C I m p l i c i t T y p e s
342C-----------------------------------------------
343#include "implicit_f.inc"
344C-----------------------------------------------
345C C o m m o n B l o c k s
346C-----------------------------------------------
347#include "param_c.inc"
348#include "com01_c.inc"
349C-----------------------------------------------
350C D u m m y A r g u m e n t s
351C-----------------------------------------------
352C REAL
353 INTEGER IPARG(NPARG,*),NUMSKIN, TAG_SKINS6(*)
354C-----------------------------------------------
355C L o c a l V a r i a b l e s
356C-----------------------------------------------
357 INTEGER I,NG,
358 . MLW ,NEL ,NFT ,IAD ,ITY ,
359 . NPT ,JALE ,ISMSTR ,JEUL ,JTUR ,
360 . JTHE ,JLAG ,JMULT ,JHBE ,JIVF ,
361 . NVAUX ,JPOR ,KCVT ,JCLOSE ,JPLASOL ,
362 . IREP ,IINT ,IGTYP ,ISRAT ,ISROT ,
363 . ICSEN ,ISORTH ,ISORTHG ,IFAILURE,JSMS ,
364 . NN,ICS,ISOLNOD
365C-----------------------------------------------
366 DO ng=1,ngroup
367 CALL initbuf(iparg ,ng ,
368 2 mlw ,nel ,nft ,iad ,ity ,
369 3 npt ,jale ,ismstr ,jeul ,jtur ,
370 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
371 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
372 6 irep ,iint ,igtyp ,israt ,isrot ,
373 7 icsen ,isorth ,isorthg ,ifailure,jsms )
374!
375 IF(mlw == 13 .OR. mlw == 0.OR.ity /= 1) cycle
376C------ possible to remove(w/ TAG_SKINS6) case of several layers in mesh (even not recommended)
377 IF (igtyp==20 .OR. igtyp==21 .OR. igtyp==22) THEN
378 numskin = numskin + 2*nel
379 ENDIF !IF (IGTYP==20
380 END DO ! NG=1,NGROUP
381C-----------
382 RETURN