OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
assem_q4.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine assem_q4 (ixq, nel, iddl, ndof, k_diag, k_lt, iadk, jdik, k11, k12, k13, k14, k22, k23, k24, k33, k34, k44, off)

Function/Subroutine Documentation

◆ assem_q4()

subroutine assem_q4 ( integer, dimension(nixq,*) ixq,
integer nel,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
k_diag,
k_lt,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
k11,
k12,
k13,
k14,
k22,
k23,
k24,
k33,
k34,
k44,
off )

Definition at line 31 of file assem_q4.F.

36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C G l o b a l P a r a m e t e r s
42C-----------------------------------------------
43#include "mvsiz_p.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER IXQ(NIXQ,*), NEL, IDDL(*), NDOF(*), IADK(*), JDIK(*)
49 . k_diag(*), k_lt(*),
50 . k11(2,2,*), k12(2,2,*), k13(2,2,*), k14(2,2,*), k22(2,2,*),
51 . k23(2,2,*), k24(2,2,*), k33(2,2,*), k34(2,2,*), k44(2,2,*),
52 . off(*)
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER I, J, EP, NN(MVSIZ,4)
58 . ktp(3,3,mvsiz)
59C-----------------------------------------------
60C S o u r c e L i n e s
61C-----------------------------------------------
62 DO i=1,4
63 DO ep=1,nel
64 nn(ep,i) = ixq(i+1,ep)
65 ENDDO
66 ENDDO
67C
68 DO ep=1,nel
69 DO j=1,3
70 ktp(1,j,ep) = zero
71 ENDDO
72 DO i=2,3
73 ktp(i,1,ep) = zero
74 ENDDO
75 ENDDO
76C-----block diagonal kii
77 DO ep=1,nel
78 DO j=1,2
79 DO i=1,2
80 ktp(i+1,j+1,ep) = k11(i,j,ep)
81 ENDDO
82 ENDDO
83 ENDDO
84 CALL assem_kii(nn(1,1),nel,iddl,iadk,k_diag,k_lt,ktp,3,off)
85 DO ep=1,nel
86 DO j=1,2
87 DO i=1,2
88 ktp(i+1,j+1,ep) = k22(i,j,ep)
89 ENDDO
90 ENDDO
91 ENDDO
92 CALL assem_kii(nn(1,2),nel,iddl,iadk,k_diag,k_lt,ktp,3,off)
93 DO ep=1,nel
94 DO j=1,2
95 DO i=1,2
96 ktp(i+1,j+1,ep) = k33(i,j,ep)
97 ENDDO
98 ENDDO
99 ENDDO
100 CALL assem_kii(nn(1,3),nel,iddl,iadk,k_diag,k_lt,ktp,3,off)
101 DO ep=1,nel
102 DO j=1,2
103 DO i=1,2
104 ktp(i+1,j+1,ep) = k44(i,j,ep)
105 ENDDO
106 ENDDO
107 ENDDO
108 CALL assem_kii(nn(1,4),nel,iddl,iadk,k_diag,k_lt,ktp,3,off)
109C-----non diag kij
110 DO ep=1,nel
111 DO j=1,2
112 DO i=1,2
113 ktp(i+1,j+1,ep) = k12(i,j,ep)
114 ENDDO
115 ENDDO
116 ENDDO
117 CALL assem_kij(nn(1,1),nn(1,2),nel,iddl,iadk,jdik,
118 . k_diag,k_lt,ktp,3,off)
119 DO ep=1,nel
120 DO j=1,2
121 DO i=1,2
122 ktp(i+1,j+1,ep) = k13(i,j,ep)
123 ENDDO
124 ENDDO
125 ENDDO
126 CALL assem_kij(nn(1,1),nn(1,3),nel,iddl,iadk,jdik,
127 . k_diag,k_lt,ktp,3,off)
128 DO ep=1,nel
129 DO j=1,2
130 DO i=1,2
131 ktp(i+1,j+1,ep) = k14(i,j,ep)
132 ENDDO
133 ENDDO
134 ENDDO
135 CALL assem_kij(nn(1,1),nn(1,4),nel,iddl,iadk,jdik,
136 . k_diag,k_lt,ktp,3,off)
137 DO ep=1,nel
138 DO j=1,2
139 DO i=1,2
140 ktp(i+1,j+1,ep) = k23(i,j,ep)
141 ENDDO
142 ENDDO
143 ENDDO
144 CALL assem_kij(nn(1,2),nn(1,3),nel,iddl,iadk,jdik,
145 . k_diag,k_lt,ktp,3,off)
146 DO ep=1,nel
147 DO j=1,2
148 DO i=1,2
149 ktp(i+1,j+1,ep) = k24(i,j,ep)
150 ENDDO
151 ENDDO
152 ENDDO
153 CALL assem_kij(nn(1,2),nn(1,4),nel,iddl,iadk,jdik,
154 . k_diag,k_lt,ktp,3,off)
155 DO ep=1,nel
156 DO j=1,2
157 DO i=1,2
158 ktp(i+1,j+1,ep) = k34(i,j,ep)
159 ENDDO
160 ENDDO
161 ENDDO
162 CALL assem_kij(nn(1,3),nn(1,4),nel,iddl,iadk,jdik,
163 . k_diag,k_lt,ktp,3,off)
164C
165 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine assem_kii(ni, nel, iddl, iadk, k_diag, k_lt, kii, nd, off)
Definition imp_glob_k.F:962
subroutine assem_kij(ni, nj, nel, iddl, iadk, jdik, k_diag, k_lt, kij, nd, off)