OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11ass3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i11ass3 ../engine/source/interfaces/int11/i11ass3.F
25!||--- called by ------------------------------------------------------
26!|| i11mainf ../engine/source/interfaces/int11/i11mainf.F
27!||--- calls -----------------------------------------------------
28!|| i11ass0 ../engine/source/interfaces/int11/i11ass3.F
29!|| i11ass05 ../engine/source/interfaces/int11/i11ass3.F
30!|| i11ass2 ../engine/source/interfaces/int11/i11ass3.F
31!|| i11ass25 ../engine/source/interfaces/int11/i11ass3.F
32!|| i11sms2 ../engine/source/interfaces/int11/i11sms2.F
33!||--- uses -----------------------------------------------------
34!|| h3d_mod ../engine/share/modules/h3d_mod.F
35!|| tri7box ../engine/share/modules/tri7box.F
36!||====================================================================
37 SUBROUTINE i11ass3(
38 1 JLT ,A ,NIN ,NOINT ,CS_LOC ,
39 2 STIFN ,STIF ,FSKYI ,ISKY ,FCONT ,
40 3 HS1 ,HS2 ,HM1 ,HM2 ,N1 ,
41 4 N2 ,M1 ,M2 ,NISKYFI,ISECIN ,
42 5 NSTRF ,SECFCUM,VISCN ,NRTS ,ISKYI_SMS,
43 6 NSMS ,ICONTACT,MSKYI_SMS,FX1 ,FY1 ,
44 7 FZ1 ,FX2 ,FY2 ,FZ2 ,FX3 ,
45 8 FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
46 9 K1 ,K2 ,K3 ,K4 ,C1 ,
47 A C2 ,C3 ,C4 ,INTTH ,PHIS1 ,
48 B PHIS2 ,PHIM1 ,PHIM2 ,FTHE ,FTHESKYI ,
49 C CONDINTS1,CONDINTS2,CONDINTM1,CONDINTM2,CONDN,
50 D CONDNSKYI,JTASK ,H3D_DATA,NODADT_THERM)
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE tri7box
55 USE h3d_mod
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60#include "comlock.inc"
61C-----------------------------------------------
62C G l o b a l P a r a m e t e r s
63C-----------------------------------------------
64#include "mvsiz_p.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "com01_c.inc"
69#include "com04_c.inc"
70#include "scr14_c.inc"
71#include "scr16_c.inc"
72#include "scr18_c.inc"
73#include "parit_c.inc"
74#include "impl1_c.inc"
75#include "sms_c.inc"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79 INTEGER ,INTENT(IN) :: NODADT_THERM
80 INTEGER JLT,NRTS,NISKYFI,NIN,INTTH
81 INTEGER ISKY(*),
82 . NOINT,ISECIN, NSTRF(*)
83 INTEGER N1(MVSIZ), N2(MVSIZ), M1(MVSIZ), M2(MVSIZ),
84 . CS_LOC(MVSIZ),NSMS(MVSIZ),ICONTACT(*),ISKYI_SMS(*),JTASK
85 my_real
86 . A(3,*), FCONT(3,*),
87 . STIFN(*),FSKYI(LSKYI,NFSKYI)
88 my_real
89 . HS1(MVSIZ), HS2(MVSIZ), HM1(MVSIZ), HM2(MVSIZ),
90 . STIF(MVSIZ),
91 . SECFCUM(7,NUMNOD,NSECT), VISCN(*),
92 . fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
93 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz),
94 . fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
95 . k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
96 . c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),
97 . phis1(mvsiz),phis2(mvsiz),fthe(*),ftheskyi(*),condn(*),
98 . condints1(mvsiz),condints2(mvsiz),condintm1(mvsiz),condintm2(mvsiz),
99 . condnskyi(*),mskyi_sms(*),phim1(mvsiz),phim2(mvsiz)
100 TYPE(h3d_database) :: H3D_DATA
101C-----------------------------------------------
102C L o c a l V a r i a b l e s
103C-----------------------------------------------
104 INTEGER I, J, K0, NBINTER, K1S, K
105C---------------------------------
106 IF(IDTMINS==2.OR.idtmins_int/=0)
107 . CALL i11sms2(jlt ,cs_loc ,n1 ,n2 ,m1 ,
108 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
109 3 stif ,nin ,noint ,mskyi_sms ,iskyi_sms,
110 4 nsms ,k1 ,k2 ,k3 ,k4 ,
111 5 c1 ,c2 ,c3 ,c4 ,nrts )
112C
113 IF(idtmins_int/=0)THEN
114 stif(1:jlt)=zero
115 END IF
116C
117 IF(iparit==0)THEN
118 IF(kdtint==0)THEN
119 CALL i11ass0(jlt ,cs_loc,n1 ,n2 ,m1 ,
120 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
121 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
122 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
123 5 fy4 ,fz4 ,a ,stifn,stif ,
124 6 nrts ,nin ,intth,phis1,phis2,
125 7 phim1,phim2 ,fthe ,condints1 ,
126 8 condints2,condintm1,condintm2,condn ,
127 9 jtask ,nodadt_therm)
128 ELSE
129 CALL i11ass05(jlt ,cs_loc,n1 ,n2 ,m1 ,
130 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
131 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
132 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
133 5 fy4 ,fz4 ,a ,stifn,nrts ,
134 6 k1 ,k2 ,k3 ,k4 ,c1 ,
135 7 c2 ,c3 ,c4 ,viscn,nin ,
136 8 intth ,phis1 ,phis2 ,phim1,phim2,
137 9 fthe ,condints1,condints2,condintm1,
138 a condintm2,condn,jtask,nodadt_therm)
139 END IF
140 ELSE
141 IF(kdtint==0)THEN
142 CALL i11ass2(jlt ,cs_loc ,n1 ,n2 ,m1 ,
143 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
144 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
145 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
146 5 fy4 ,fz4 ,fskyi ,isky ,niskyfi,
147 6 stif ,nrts ,nin , noint,intth ,
148 7 phis1 ,phis2 ,phim1 ,phim2 ,ftheskyi,
149 8 condints1,condints2,condintm1,condintm2,
150 a condnskyi,nodadt_therm)
151 ELSE
152 CALL i11ass25(jlt ,cs_loc ,n1 ,n2 ,m1 ,
153 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
154 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
155 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
156 5 fy4 ,fz4 ,isky ,niskyfi,nrts ,
157 6 k1 ,k2 ,k3 ,k4 ,c1 ,
158 7 c2 ,c3 ,c4 ,nin , noint,
159 8 intth ,phis1 ,phis2 ,phim1 ,phim2 ,
160 9 ftheskyi,condints1,condints2,condintm1,
161 a condintm2,condnskyi,nodadt_therm)
162 END IF
163 END IF
164C
165 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0)THEN
166 IF (inconv==1) THEN
167#include "lockon.inc"
168 DO i=1,jlt
169 IF(cs_loc(i)<=nrts) THEN
170 fcont(1,n1(i)) =fcont(1,n1(i)) + fx1(i)
171 fcont(2,n1(i)) =fcont(2,n1(i)) + fy1(i)
172 fcont(3,n1(i)) =fcont(3,n1(i)) + fz1(i)
173 fcont(1,n2(i)) =fcont(1,n2(i)) + fx2(i)
174 fcont(2,n2(i)) =fcont(2,n2(i)) + fy2(i)
175 fcont(3,n2(i)) =fcont(3,n2(i)) + fz2(i)
176 END IF
177 fcont(1,m1(i)) =fcont(1,m1(i)) + fx3(i)
178 fcont(2,m1(i)) =fcont(2,m1(i)) + fy3(i)
179 fcont(3,m1(i)) =fcont(3,m1(i)) + fz3(i)
180 fcont(1,m2(i)) =fcont(1,m2(i)) + fx4(i)
181 fcont(2,m2(i)) =fcont(2,m2(i)) + fy4(i)
182 fcont(3,m2(i)) =fcont(3,m2(i)) + fz4(i)
183 ENDDO
184#include "lockoff.inc"
185 END IF !(INCONV==1) THEN
186 ENDIF
187C
188 IF(isecin>0.AND.inconv==1)THEN
189 k0=nstrf(25)
190 IF(nstrf(1)+nstrf(2)/=0)THEN
191 DO i=1,nsect
192 nbinter=nstrf(k0+14)
193 k1s=k0+30
194 DO j=1,nbinter
195 IF(nstrf(k1s)==noint)THEN
196 IF(isecut/=0)THEN
197#include "lockon.inc"
198 DO k=1,jlt
199 IF(cs_loc(k)<=nrts) THEN
200 IF(secfcum(4,n1(k),i)==1.)THEN
201 secfcum(1,n1(k),i)=secfcum(1,n1(k),i)-fx1(k)
202 secfcum(2,n1(k),i)=secfcum(2,n1(k),i)-fy1(k)
203 secfcum(3,n1(k),i)=secfcum(3,n1(k),i)-fz1(k)
204 ENDIF
205 IF(secfcum(4,n2(k),i)==1.)THEN
206 secfcum(1,n2(k),i)=secfcum(1,n2(k),i)-fx2(k)
207 secfcum(2,n2(k),i)=secfcum(2,n2(k),i)-fy2(k)
208 secfcum(3,n2(k),i)=secfcum(3,n2(k),i)-fz2(k)
209 ENDIF
210 END IF
211 IF(secfcum(4,m1(k),i)==1.)THEN
212 secfcum(1,m1(k),i)=secfcum(1,m1(k),i)-fx3(k)
213 secfcum(2,m1(k),i)=secfcum(2,m1(k),i)-fy3(k)
214 secfcum(3,m1(k),i)=secfcum(3,m1(k),i)-fz3(k)
215 ENDIF
216 IF(secfcum(4,m2(k),i)==1.)THEN
217 secfcum(1,m2(k),i)=secfcum(1,m2(k),i)-fx4(k)
218 secfcum(2,m2(k),i)=secfcum(2,m2(k),i)-fy4(k)
219 secfcum(3,m2(k),i)=secfcum(3,m2(k),i)-fz4(k)
220 ENDIF
221 ENDDO
222#include "lockoff.inc"
223 ENDIF
224C +fsav(section)
225 ENDIF
226 k1s=k1s+1
227 ENDDO
228 k0=nstrf(k0+24)
229 ENDDO
230 ENDIF
231 ENDIF
232C
233C-----------------------------------------------------
234 IF(idamp_rdof/=0) THEN
235 DO i=1,jlt
236 IF(cs_loc(i)<=nrts) THEN
237 IF(fx1(i)/=zero.OR.fy1(i)/=zero.OR.fz1(i)/=zero)THEN
238 icontact(n1(i))=1
239 ENDIF
240 IF(fx2(i)/=zero.OR.fy2(i)/=zero.OR.fz2(i)/=zero)THEN
241 icontact(n2(i))=1
242 ENDIF
243 ENDIF
244C test modified for consistency with SPMD communication (spmd_i7tools)
245 IF(fx3(i)/=zero.OR.fy3(i)/=zero.OR.fz3(i)/=zero)THEN
246 icontact(m1(i))=1
247 ENDIF
248 IF(fx4(i)/=zero.OR.fy4(i)/=zero.OR.fz4(i)/=zero)THEN
249 icontact(m2(i))=1
250 ENDIF
251 ENDDO
252 ENDIF
253C
254 RETURN
255 END
256C
257!||====================================================================
258!|| i11ass0 ../engine/source/interfaces/int11/i11ass3.F
259!||--- called by ------------------------------------------------------
260!|| i11ass3 ../engine/source/interfaces/int11/i11ass3.F
261!||--- uses -----------------------------------------------------
262!|| tri7box ../engine/share/modules/tri7box.F
263!||====================================================================
264 SUBROUTINE i11ass0(JLT ,CS_LOC,N1 ,N2 ,M1 ,
265 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
266 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
267 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
268 5 FY4 ,FZ4 ,A ,STIFN,STIF ,
269 6 NRTS ,NIN ,INTTH ,PHIS1,PHIS2,
270 7 PHIM1,PHIM2 ,FTHE ,CONDINTS1 ,
271 8 CONDINTS2,CONDINTM1,CONDINTM2,CONDN,
272 9 JTASK ,NODADT_THERM)
273C-----------------------------------------------
274C M o d u l e s
275C-----------------------------------------------
276 USE tri7box
277C-----------------------------------------------
278C I m p l i c i t T y p e s
279C-----------------------------------------------
280#include "implicit_f.inc"
281C-----------------------------------------------
282C G l o b a l P a r a m e t e r s
283C-----------------------------------------------
284#include "mvsiz_p.inc"
285C-----------------------------------------------
286C C o m m o n B l o c k s
287C-----------------------------------------------
288#include "scr18_c.inc"
289C-----------------------------------------------
290C D u m m y A r g u m e n t s
291C-----------------------------------------------
292 INTEGER ,INTENT(IN) :: NODADT_THERM
293 INTEGER JLT, NRTS, NIN,INTTH,
294 + CS_LOC(*),
295 + N1(MVSIZ),N2(MVSIZ),M1(MVSIZ),M2(MVSIZ),JTASK
296 my_real
297 . hs1(mvsiz),hs2(mvsiz),hm1(mvsiz),hm2(mvsiz),
298 . fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
299 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
300 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
301 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
302 . phis1(mvsiz),phis2(mvsiz),condints1(mvsiz),
303 . condints2(mvsiz),phim1(mvsiz),phim2(mvsiz),
304 . condintm1(mvsiz),condintm2(mvsiz),
305 . a(3,*), stifn(*), stif(*),fthe(*),condn(*)
306C-----------------------------------------------
307C L o c a l V a r i a b l e s
308C-----------------------------------------------
309 INTEGER I, J1, NODFI, ISHIFT
310C-----------------------------------------------
311C
312 NODFI = nlskyfi(nin)
313 ishift = nodfi*(jtask-1)
314C
315 IF(intth==0)THEN
316 DO i=1,jlt
317 IF(cs_loc(i)<=nrts) THEN
318 j1=n1(i)
319 a(1,j1)=a(1,j1)+fx1(i)
320 a(2,j1)=a(2,j1)+fy1(i)
321 a(3,j1)=a(3,j1)+fz1(i)
322 stifn(j1) = stifn(j1) + stif(i)*abs(hs1(i))
323C
324 j1=n2(i)
325 a(1,j1)=a(1,j1)+fx2(i)
326 a(2,j1)=a(2,j1)+fy2(i)
327 a(3,j1)=a(3,j1)+fz2(i)
328 stifn(j1) = stifn(j1) + stif(i)*abs(hs2(i))
329 ELSE
330 j1=n1(i)
331 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx1(i)
332 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy1(i)
333 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz1(i)
334 stnfi(nin)%P(j1+ishift) = stnfi(nin)%P(j1+ishift) + stif(i)*abs(hs1(i))
335C
336 j1=n2(i)
337 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx2(i)
338 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy2(i)
339 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz2(i)
340 stnfi(nin)%P(j1+ishift) = stnfi(nin)%P(j1+ishift) + stif(i)*abs(hs2(i))
341 END IF
342 END DO
343 ELSE
344 IF(nodadt_therm == 1 ) THEN
345 DO i=1,jlt
346 IF(cs_loc(i)<=nrts) THEN
347 j1=n1(i)
348 a(1,j1)=a(1,j1)+fx1(i)
349 a(2,j1)=a(2,j1)+fy1(i)
350 a(3,j1)=a(3,j1)+fz1(i)
351 stifn(j1) = stifn(j1) + stif(i)*abs(hs1(i))
352 fthe(j1)=fthe(j1)+phis1(i)
353 condn(j1) = condn(j1) + condints1(i)
354C
355 j1=n2(i)
356 a(1,j1)=a(1,j1)+fx2(i)
357 a(2,j1)=a(2,j1)+fy2(i)
358 a(3,j1)=a(3,j1)+fz2(i)
359 stifn(j1) = stifn(j1) + stif(i)*abs(hs2(i))
360 fthe(j1)=fthe(j1)+phis2(i)
361 condn(j1) = condn(j1) + condints2(i)
362 ELSE
363 j1=n1(i)
364 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx1(i)
365 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy1(i)
366 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz1(i)
367 stnfi(nin)%P(j1+ishift) = stnfi(nin)%P(j1+ishift) + stif(i)*abs(hs1(i))
368 fthefi(nin)%P(j1+ishift)= fthefi(nin)%P(j1+ishift) + phis1(i)
369 condnfi(nin)%P(j1+ishift)=condnfi(nin)%P(j1+ishift) + condints1(i)
370C
371 j1=n2(i)
372 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx2(i)
373 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy2(i)
374 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz2(i)
375 stnfi(nin)%P(j1+ishift) = stnfi(nin)%P(j1+ishift) + stif(i)*abs(hs2(i))
376 fthefi(nin)%P(j1+ishift)= fthefi(nin)%P(j1+ishift) + phis2(i)
377 condnfi(nin)%P(j1+ishift)=condnfi(nin)%P(j1+ishift) + condints2(i)
378 END IF
379 END DO
380 ELSE
381 DO i=1,jlt
382 IF(cs_loc(i)<=nrts) THEN
383 j1=n1(i)
384 a(1,j1)=a(1,j1)+fx1(i)
385 a(2,j1)=a(2,j1)+fy1(i)
386 a(3,j1)=a(3,j1)+fz1(i)
387 stifn(j1) = stifn(j1) + stif(i)*abs(hs1(i))
388 fthe(j1)=fthe(j1)+phis1(i)
389C
390 j1=n2(i)
391 a(1,j1)=a(1,j1)+fx2(i)
392 a(2,j1)=a(2,j1)+fy2(i)
393 a(3,j1)=a(3,j1)+fz2(i)
394 stifn(j1) = stifn(j1) + stif(i)*abs(hs2(i))
395 fthe(j1)=fthe(j1)+phis2(i)
396 ELSE
397 j1=n1(i)
398 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx1(i)
399 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy1(i)
400 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz1(i)
401 stnfi(nin)%P(j1+ishift) = stnfi(nin)%P(j1+ishift) + stif(i)*abs(hs1(i))
402 fthefi(nin)%P(j1+ishift)= fthefi(nin)%P(j1+ishift) + phis1(i)
403C
404 j1=n2(i)
405 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx2(i)
406 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy2(i)
407 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz2(i)
408 stnfi(nin)%P(j1+ishift) = stnfi(nin)%P(j1+ishift) + stif(i)*abs(hs2(i))
409 fthefi(nin)%P(j1+ishift)= fthefi(nin)%P(j1+ishift) + phis2(i)
410 END IF
411 END DO
412 ENDIF
413 ENDIF
414C
415 IF(intth==0)THEN
416 DO i=1,jlt
417 j1=m1(i)
418 a(1,j1)=a(1,j1)+fx3(i)
419 a(2,j1)=a(2,j1)+fy3(i)
420 a(3,j1)=a(3,j1)+fz3(i)
421 stifn(j1) = stifn(j1) + stif(i)*abs(hm1(i))
422C
423 j1=m2(i)
424 a(1,j1)=a(1,j1)+fx4(i)
425 a(2,j1)=a(2,j1)+fy4(i)
426 a(3,j1)=a(3,j1)+fz4(i)
427 stifn(j1) = stifn(j1) + stif(i)*abs(hm2(i))
428
429 ENDDO
430C
431 ELSE
432 IF(nodadt_therm == 1 ) THEN
433 DO i=1,jlt
434 j1=m1(i)
435 a(1,j1)=a(1,j1)+fx3(i)
436 a(2,j1)=a(2,j1)+fy3(i)
437 a(3,j1)=a(3,j1)+fz3(i)
438 stifn(j1) = stifn(j1) + stif(i)*abs(hm1(i))
439 fthe(j1) = fthe(j1) + phim1(i)
440 condn(j1) = condn(j1) + condintm1(i)
441C
442 j1=m2(i)
443 a(1,j1)=a(1,j1)+fx4(i)
444 a(2,j1)=a(2,j1)+fy4(i)
445 a(3,j1)=a(3,j1)+fz4(i)
446 stifn(j1) = stifn(j1) + stif(i)*abs(hm2(i))
447 fthe(j1) = fthe(j1) + phim2(i)
448 condn(j1) = condn(j1) + condintm2(i)
449 ENDDO
450C
451 ELSE
452C
453 DO i=1,jlt
454 j1=m1(i)
455 a(1,j1)=a(1,j1)+fx3(i)
456 a(2,j1)=a(2,j1)+fy3(i)
457 a(3,j1)=a(3,j1)+fz3(i)
458 stifn(j1) = stifn(j1) + stif(i)*abs(hm1(i))
459 fthe(j1) = fthe(j1) + phim1(i)
460C
461 j1=m2(i)
462 a(1,j1)=a(1,j1)+fx4(i)
463 a(2,j1)=a(2,j1)+fy4(i)
464 a(3,j1)=a(3,j1)+fz4(i)
465 stifn(j1) = stifn(j1) + stif(i)*abs(hm2(i))
466 fthe(j1) = fthe(j1) + phim2(i)
467 ENDDO
468 ENDIF
469 ENDIF
470 RETURN
471 END
472C
473!||====================================================================
474!|| i11ass05 ../engine/source/interfaces/int11/i11ass3.F
475!||--- called by ------------------------------------------------------
476!|| i11ass3 ../engine/source/interfaces/int11/i11ass3.F
477!||--- uses -----------------------------------------------------
478!|| tri7box ../engine/share/modules/tri7box.F
479!||====================================================================
480 SUBROUTINE i11ass05(JLT ,CS_LOC,N1 ,N2 ,M1 ,
481 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
482 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
483 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
484 5 FY4 ,FZ4 ,A ,STIFN,NRTS ,
485 6 K1 ,K2 ,K3 ,K4 ,C1 ,
486 7 C2 ,C3 ,C4 ,VISCN,NIN ,
487 8 INTTH ,PHIS1 ,PHIS2 ,PHIM1,PHIM2,
488 9 FTHE ,CONDINTS1,CONDINTS2,CONDINTM1,
489 A CONDINTM2,CONDN,JTASK,NODADT_THERM)
490C-----------------------------------------------
491C M o d u l e s
492C-----------------------------------------------
493 USE tri7box
494C-----------------------------------------------
495C I m p l i c i t T y p e s
496C-----------------------------------------------
497#include "implicit_f.inc"
498C-----------------------------------------------
499C G l o b a l P a r a m e t e r s
500C-----------------------------------------------
501#include "mvsiz_p.inc"
502C-----------------------------------------------
503C C o m m o n B l o c k s
504C-----------------------------------------------
505#include "scr18_c.inc"
506C-----------------------------------------------
507C D u m m y A r g u m e n t s
508C-----------------------------------------------
509 INTEGER ,INTENT(IN) :: NODADT_THERM
510 INTEGER JLT, NRTS, NIN,INTTH ,
511 + CS_LOC(*),
512 + N1(MVSIZ),N2(MVSIZ),M1(MVSIZ),M2(MVSIZ),JTASK
513 my_real
514 . HS1(MVSIZ),HS2(MVSIZ),HM1(MVSIZ),HM2(MVSIZ),
515 . FX1(MVSIZ),FY1(MVSIZ),FZ1(MVSIZ),
516 . FX2(MVSIZ),FY2(MVSIZ),FZ2(MVSIZ),
517 . FX3(MVSIZ),FY3(MVSIZ),FZ3(MVSIZ),
518 . FX4(MVSIZ),FY4(MVSIZ),FZ4(MVSIZ),
519 . K1(MVSIZ),K2(MVSIZ),K3(MVSIZ),K4(MVSIZ),
520 . C1(MVSIZ),C2(MVSIZ),C3(MVSIZ),C4(MVSIZ),
521 . PHIS1(MVSIZ),PHIS2(MVSIZ),CONDINTS1(MVSIZ),
522 . CONDINTS2(MVSIZ),PHIM1(MVSIZ),PHIM2(MVSIZ),
523 . condintm1(mvsiz),condintm2(mvsiz),
524 . a(3,*), stifn(*), viscn(*),fthe(*),condn(*)
525C-----------------------------------------------
526C L o c a l V a r i a b l e s
527C-----------------------------------------------
528 INTEGER I, J1, NODFI, ISHIFT
529C-----------------------------------------------
530C
531 NODFI = nlskyfi(nin)
532 ishift = nodfi*(jtask-1)
533C
534 IF(intth==0)THEN
535 DO i=1,jlt
536 IF(cs_loc(i)<=nrts) THEN
537 j1=n1(i)
538 a(1,j1)=a(1,j1)+fx1(i)
539 a(2,j1)=a(2,j1)+fy1(i)
540 a(3,j1)=a(3,j1)+fz1(i)
541 stifn(j1)=stifn(j1)+k1(i)
542 viscn(j1)=viscn(j1)+c1(i)
543C
544 j1=n2(i)
545 a(1,j1)=a(1,j1)+fx2(i)
546 a(2,j1)=a(2,j1)+fy2(i)
547 a(3,j1)=a(3,j1)+fz2(i)
548 stifn(j1)=stifn(j1)+k2(i)
549 viscn(j1)=viscn(j1)+c2(i)
550 ELSE
551 j1=n1(i)
552 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx1(i)
553 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy1(i)
554 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz1(i)
555 stnfi(nin)%P(j1+ishift)=stnfi(nin)%P(j1+ishift)+k1(i)
556 vscfi(nin)%P(j1+ishift)=vscfi(nin)%P(j1+ishift)+c1(i)
557C
558 j1=n2(i)
559 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx2(i)
560 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy2(i)
561 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz2(i)
562 stnfi(nin)%P(j1+ishift)=stnfi(nin)%P(j1+ishift)+k2(i)
563 vscfi(nin)%P(j1+ishift)=vscfi(nin)%P(j1+ishift)+c2(i)
564 END IF
565 END DO
566 ELSE
567 IF(nodadt_therm == 1 ) THEN
568 DO i=1,jlt
569 IF(cs_loc(i)<=nrts) THEN
570 j1=n1(i)
571 a(1,j1)=a(1,j1)+fx1(i)
572 a(2,j1)=a(2,j1)+fy1(i)
573 a(3,j1)=a(3,j1)+fz1(i)
574 stifn(j1)=stifn(j1)+k1(i)
575 viscn(j1)=viscn(j1)+c1(i)
576 fthe(j1)=fthe(j1)+phis1(i)
577 condn(j1) = condn(j1) + condints1(i)
578C
579 j1=n2(i)
580 a(1,j1)=a(1,j1)+fx2(i)
581 a(2,j1)=a(2,j1)+fy2(i)
582 a(3,j1)=a(3,j1)+fz2(i)
583 stifn(j1)=stifn(j1)+k2(i)
584 viscn(j1)=viscn(j1)+c2(i)
585 fthe(j1)=fthe(j1)+phis2(i)
586 condn(j1) = condn(j1) + condints2(i)
587 ELSE
588 j1=n1(i)
589 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx1(i)
590 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy1(i)
591 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz1(i)
592 stnfi(nin)%P(j1+ishift)=stnfi(nin)%P(j1+ishift)+k1(i)
593 vscfi(nin)%P(j1+ishift)=vscfi(nin)%P(j1+ishift)+c1(i)
594 fthefi(nin)%P(j1+ishift)=fthefi(nin)%P(j1+ishift)+phis1(i)
595 condnfi(nin)%P(j1+ishift)=condnfi(nin)%P(j1+ishift) + condints1(i)
596C
597 j1=n2(i)
598 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx2(i)
599 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy2(i)
600 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz2(i)
601 stnfi(nin)%P(j1+ishift)=stnfi(nin)%P(j1+ishift)+k2(i)
602 vscfi(nin)%P(j1+ishift)=vscfi(nin)%P(j1+ishift)+c2(i)
603 fthefi(nin)%P(j1+ishift)=fthefi(nin)%P(j1+ishift)+phis2(i)
604 condnfi(nin)%P(j1+ishift)=condnfi(nin)%P(j1+ishift) + condints2(i)
605 END IF
606 END DO
607 ELSE
608 DO i=1,jlt
609 IF(cs_loc(i)<=nrts) THEN
610 j1=n1(i)
611 a(1,j1)=a(1,j1)+fx1(i)
612 a(2,j1)=a(2,j1)+fy1(i)
613 a(3,j1)=a(3,j1)+fz1(i)
614 stifn(j1)=stifn(j1)+k1(i)
615 viscn(j1)=viscn(j1)+c1(i)
616 fthe(j1)=fthe(j1)+phis1(i)
617C
618 j1=n2(i)
619 a(1,j1)=a(1,j1)+fx2(i)
620 a(2,j1)=a(2,j1)+fy2(i)
621 a(3,j1)=a(3,j1)+fz2(i)
622 stifn(j1)=stifn(j1)+k2(i)
623 viscn(j1)=viscn(j1)+c2(i)
624 fthe(j1)=fthe(j1)+phis2(i)
625 ELSE
626 j1=n1(i)
627 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx1(i)
628 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy1(i)
629 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz1(i)
630 stnfi(nin)%P(j1+ishift)=stnfi(nin)%P(j1+ishift)+k1(i)
631 vscfi(nin)%P(j1+ishift)=vscfi(nin)%P(j1+ishift)+c1(i)
632 fthefi(nin)%P(j1+ishift)=fthefi(nin)%P(j1+ishift)+phis1(i)
633C
634 j1=n2(i)
635 afi(nin)%P(1,j1+ishift)=afi(nin)%P(1,j1+ishift)+fx2(i)
636 afi(nin)%P(2,j1+ishift)=afi(nin)%P(2,j1+ishift)+fy2(i)
637 afi(nin)%P(3,j1+ishift)=afi(nin)%P(3,j1+ishift)+fz2(i)
638 stnfi(nin)%P(j1+ishift)=stnfi(nin)%P(j1+ishift)+k2(i)
639 vscfi(nin)%P(j1+ishift)=vscfi(nin)%P(j1+ishift)+c2(i)
640 fthefi(nin)%P(j1+ishift)=fthefi(nin)%P(j1+ishift)+phis2(i)
641 END IF
642 END DO
643 ENDIF
644 ENDIF
645C
646 IF(intth==0)THEN
647 DO i=1,jlt
648 j1=m1(i)
649 a(1,j1)=a(1,j1)+fx3(i)
650 a(2,j1)=a(2,j1)+fy3(i)
651 a(3,j1)=a(3,j1)+fz3(i)
652 stifn(j1)=stifn(j1)+k3(i)
653 viscn(j1)=viscn(j1)+c3(i)
654C
655 j1=m2(i)
656 a(1,j1)=a(1,j1)+fx4(i)
657 a(2,j1)=a(2,j1)+fy4(i)
658 a(3,j1)=a(3,j1)+fz4(i)
659 stifn(j1)=stifn(j1)+k4(i)
660 viscn(j1)=viscn(j1)+c4(i)
661 ENDDO
662C
663 ELSE
664 IF(nodadt_therm == 1 ) THEN
665 DO i=1,jlt
666 j1=m1(i)
667 a(1,j1)=a(1,j1)+fx3(i)
668 a(2,j1)=a(2,j1)+fy3(i)
669 a(3,j1)=a(3,j1)+fz3(i)
670 stifn(j1)=stifn(j1)+k3(i)
671 viscn(j1)=viscn(j1)+c3(i)
672 fthe(j1) = fthe(j1) + phim1(i)
673 condn(j1) = condn(j1) + condintm1(i)
674C
675 j1=m2(i)
676 a(1,j1)=a(1,j1)+fx4(i)
677 a(2,j1)=a(2,j1)+fy4(i)
678 a(3,j1)=a(3,j1)+fz4(i)
679 stifn(j1)=stifn(j1)+k4(i)
680 viscn(j1)=viscn(j1)+c4(i)
681 fthe(j1) = fthe(j1) + phim2(i)
682 condn(j1) = condn(j1) + condintm2(i)
683 ENDDO
684C
685 ELSE
686C
687 DO i=1,jlt
688 j1=m1(i)
689 a(1,j1)=a(1,j1)+fx3(i)
690 a(2,j1)=a(2,j1)+fy3(i)
691 a(3,j1)=a(3,j1)+fz3(i)
692 stifn(j1)=stifn(j1)+k3(i)
693 viscn(j1)=viscn(j1)+c3(i)
694 fthe(j1) = fthe(j1) + phim1(i)
695C
696 j1=m2(i)
697 a(1,j1)=a(1,j1)+fx4(i)
698 a(2,j1)=a(2,j1)+fy4(i)
699 a(3,j1)=a(3,j1)+fz4(i)
700 stifn(j1)=stifn(j1)+k4(i)
701 viscn(j1)=viscn(j1)+c4(i)
702 fthe(j1) = fthe(j1) + phim2(i)
703 ENDDO
704 ENDIF
705 ENDIF
706 RETURN
707 END
708C
709!||====================================================================
710!|| i11ass2 ../engine/source/interfaces/int11/i11ass3.f
711!||--- called by ------------------------------------------------------
712!|| i11ass3 ../engine/source/interfaces/int11/i11ass3.F
713!||--- calls -----------------------------------------------------
714!|| ancmsg ../engine/source/output/message/message.F
715!|| arret ../engine/source/system/arret.F
716!||--- uses -----------------------------------------------------
717!|| message_mod ../engine/share/message_module/message_mod.F
718!|| tri7box ../engine/share/modules/tri7box.F
719!||====================================================================
720 SUBROUTINE i11ass2(JLT ,CS_LOC ,N1 ,N2 ,M1 ,
721 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
722 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
723 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
724 5 FY4 ,FZ4 ,FSKYI ,ISKY ,NISKYFI,
725 6 STIF ,NRTS ,NIN ,NOINT ,INTTH ,
726 7 PHIS1 ,PHIS2 ,PHIM1 ,PHIM2 ,FTHESKYI,
727 8 CONDINTS1,CONDINTS2,CONDINTM1,CONDINTM2,
728 A CONDNSKYI,NODADT_THERM)
729C-----------------------------------------------
730C M o d u l e s
731C-----------------------------------------------
732 USE tri7box
733 USE message_mod
734C-----------------------------------------------
735C I m p l i c i t T y p e s
736C-----------------------------------------------
737#include "implicit_f.inc"
738#include "comlock.inc"
739C-----------------------------------------------
740C G l o b a l P a r a m e t e r s
741C-----------------------------------------------
742#include "mvsiz_p.inc"
743C-----------------------------------------------
744C C o m m o n B l o c k s
745C-----------------------------------------------
746#include "parit_c.inc"
747#include "scr18_c.inc"
748C-----------------------------------------------
749C D u m m y A r g u m e n t s
750C-----------------------------------------------
751 INTEGER ,INTENT(IN) :: NODADT_THERM
752 INTEGER JLT, NRTS,NISKYFI,NIN,NOINT,INTTH ,
753 + CS_LOC(*),ISKY(*),
754 + N1(MVSIZ),N2(MVSIZ),M1(MVSIZ),M2(MVSIZ)
755 my_real
756 . HS1(MVSIZ),HS2(MVSIZ),HM1(MVSIZ),HM2(MVSIZ),
757 . FX1(MVSIZ),FY1(MVSIZ),FZ1(MVSIZ),
758 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
759 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
760 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
761 . phis1(mvsiz),phis2(mvsiz),condints1(mvsiz),
762 . condints2(mvsiz),phim1(mvsiz),phim2(mvsiz),
763 . condintm1(mvsiz),condintm2(mvsiz),
764 . fskyi(lskyi,nfskyi), stif(*),ftheskyi(*),condnskyi(*)
765C-----------------------------------------------
766C L o c a l V a r i a b l e s
767C-----------------------------------------------
768 INTEGER I, NISKYL1, NISKYL, IGP, IGM, NISKYFIL
769C
770 niskyl1 = 0
771 DO i = 1, jlt
772 IF (hm1(i)/=zero) niskyl1 = niskyl1 + 1
773 ENDDO
774 DO i = 1, jlt
775 IF (hm2(i)/=zero) niskyl1 = niskyl1 + 1
776 ENDDO
777
778 igp = 0
779 igm = 0
780 DO i=1,jlt
781 IF(cs_loc(i)<=nrts) THEN
782 igp = igp+2
783 ELSE
784 igm = igm+1
785 ENDIF
786 ENDDO
787
788#include "lockon.inc"
789 niskyl = nisky
790 nisky = nisky + niskyl1 + igp
791 niskyfil = niskyfi
792 niskyfi = niskyfi + igm
793#include "lockoff.inc"
794
795 IF (niskyl+niskyl1+igp > lskyi) THEN
796 CALL ancmsg(msgid=26,anmode=aninfo_blind)
797 CALL arret(2)
798 ENDIF
799 IF (niskyfil+igm > nlskyfi(nin)) THEN
800 CALL ancmsg(msgid=25,anmode=aninfo_blind,
801 . i1=noint)
802 CALL arret(2)
803 ENDIF
804C
805 IF(intth==0)THEN
806 DO i=1,jlt
807 IF(cs_loc(i)<=nrts) THEN
808 niskyl = niskyl + 1
809 fskyi(niskyl,1)=fx1(i)
810 fskyi(niskyl,2)=fy1(i)
811 fskyi(niskyl,3)=fz1(i)
812 fskyi(niskyl,4)=stif(i)*abs(hs1(i))
813 isky(niskyl) = n1(i)
814C
815 niskyl = niskyl + 1
816 fskyi(niskyl,1)=fx2(i)
817 fskyi(niskyl,2)=fy2(i)
818 fskyi(niskyl,3)=fz2(i)
819 fskyi(niskyl,4)=stif(i)*abs(hs2(i))
820 isky(niskyl) = n2(i)
821 ELSE
822 niskyfil = niskyfil + 1
823 fskyfi(nin)%P(1,niskyfil)=fx1(i)
824 fskyfi(nin)%P(2,niskyfil)=fy1(i)
825 fskyfi(nin)%P(3,niskyfil)=fz1(i)
826 fskyfi(nin)%P(4,niskyfil)=stif(i)*abs(hs1(i))
827 fskyfi(nin)%P(5,niskyfil)=fx2(i)
828 fskyfi(nin)%P(6,niskyfil)=fy2(i)
829 fskyfi(nin)%P(7,niskyfil)=fz2(i)
830 fskyfi(nin)%P(8,niskyfil)=stif(i)*abs(hs2(i))
831 iskyfi(nin)%P(niskyfil) = cs_loc(i)-nrts
832 END IF
833 END DO
834 ELSE
835 IF(nodadt_therm == 1 ) THEN
836 DO i=1,jlt
837 IF(cs_loc(i)<=nrts) THEN
838 niskyl = niskyl + 1
839 fskyi(niskyl,1)=fx1(i)
840 fskyi(niskyl,2)=fy1(i)
841 fskyi(niskyl,3)=fz1(i)
842 fskyi(niskyl,4)=stif(i)*abs(hs1(i))
843 ftheskyi(niskyl)=phis1(i)
844 condnskyi(niskyl)=condints1(i)
845 isky(niskyl) = n1(i)
846C
847 niskyl = niskyl + 1
848 fskyi(niskyl,1)=fx2(i)
849 fskyi(niskyl,2)=fy2(i)
850 fskyi(niskyl,3)=fz2(i)
851 fskyi(niskyl,4)=stif(i)*abs(hs2(i))
852 ftheskyi(niskyl)=phis2(i)
853 condnskyi(niskyl)=condints2(i)
854 isky(niskyl) = n2(i)
855 ELSE
856 niskyfil = niskyfil + 1
857 fskyfi(nin)%P(1,niskyfil)=fx1(i)
858 fskyfi(nin)%P(2,niskyfil)=fy1(i)
859 fskyfi(nin)%P(3,niskyfil)=fz1(i)
860 fskyfi(nin)%P(4,niskyfil)=stif(i)*abs(hs1(i))
861 ftheskyfi(nin)%P(2*(niskyfil-1)+1)=phis1(i)
862 condnskyfi(nin)%P(2*(niskyfil-1)+1)=condints1(i)
863 fskyfi(nin)%P(5,niskyfil)=fx2(i)
864 fskyfi(nin)%P(6,niskyfil)=fy2(i)
865 fskyfi(nin)%P(7,niskyfil)=fz2(i)
866 fskyfi(nin)%P(8,niskyfil)=stif(i)*abs(hs2(i))
867 ftheskyfi(nin)%P(2*(niskyfil-1)+2)=phis2(i)
868 condnskyfi(nin)%P(2*(niskyfil-1)+2)=condints2(i)
869 iskyfi(nin)%P(niskyfil) = cs_loc(i)-nrts
870 END IF
871 END DO
872 ELSE
873 DO i=1,jlt
874 IF(cs_loc(i)<=nrts) THEN
875 niskyl = niskyl + 1
876 fskyi(niskyl,1)=fx1(i)
877 fskyi(niskyl,2)=fy1(i)
878 fskyi(niskyl,3)=fz1(i)
879 fskyi(niskyl,4)=stif(i)*abs(hs1(i))
880 ftheskyi(niskyl)=phis1(i)
881 isky(niskyl) = n1(i)
882C
883 niskyl = niskyl + 1
884 fskyi(niskyl,1)=fx2(i)
885 fskyi(niskyl,2)=fy2(i)
886 fskyi(niskyl,3)=fz2(i)
887 fskyi(niskyl,4)=stif(i)*abs(hs2(i))
888 ftheskyi(niskyl)=phis2(i)
889 isky(niskyl) = n2(i)
890 ELSE
891 niskyfil = niskyfil + 1
892 fskyfi(nin)%P(1,niskyfil)=fx1(i)
893 fskyfi(nin)%P(2,niskyfil)=fy1(i)
894 fskyfi(nin)%P(3,niskyfil)=fz1(i)
895 fskyfi(nin)%P(4,niskyfil)=stif(i)*abs(hs1(i))
896 ftheskyfi(nin)%P(2*(niskyfil-1)+1)=phis1(i)
897 fskyfi(nin)%P(5,niskyfil)=fx2(i)
898 fskyfi(nin)%P(6,niskyfil)=fy2(i)
899 fskyfi(nin)%P(7,niskyfil)=fz2(i)
900 fskyfi(nin)%P(8,niskyfil)=stif(i)*abs(hs2(i))
901 ftheskyfi(nin)%P(2*(niskyfil-1)+2)=phis2(i)
902 iskyfi(nin)%P(niskyfil) = cs_loc(i)-nrts
903 END IF
904 END DO
905 ENDIF
906 ENDIF
907C
908 IF(intth==0)THEN
909 DO i=1,jlt
910 IF (hm1(i)/=zero) THEN
911 niskyl = niskyl + 1
912 fskyi(niskyl,1)=fx3(i)
913 fskyi(niskyl,2)=fy3(i)
914 fskyi(niskyl,3)=fz3(i)
915 fskyi(niskyl,4)=stif(i)*abs(hm1(i))
916 isky(niskyl) = m1(i)
917 ENDIF
918 ENDDO
919 DO i=1,jlt
920 IF (hm2(i)/=zero) THEN
921 niskyl = niskyl + 1
922 fskyi(niskyl,1)=fx4(i)
923 fskyi(niskyl,2)=fy4(i)
924 fskyi(niskyl,3)=fz4(i)
925 fskyi(niskyl,4)=stif(i)*abs(hm2(i))
926 isky(niskyl) = m2(i)
927 ENDIF
928 ENDDO
929 ELSE
930 IF(nodadt_therm == 1 ) THEN
931 DO i=1,jlt
932 IF (hm1(i)/=zero) THEN
933 niskyl = niskyl + 1
934 fskyi(niskyl,1)=fx3(i)
935 fskyi(niskyl,2)=fy3(i)
936 fskyi(niskyl,3)=fz3(i)
937 fskyi(niskyl,4)=stif(i)*abs(hm1(i))
938 isky(niskyl) = m1(i)
939 ftheskyi(niskyl)=phim1(i)
940 condnskyi(niskyl)=condintm1(i)
941 ENDIF
942 ENDDO
943 DO i=1,jlt
944 IF (hm2(i)/=zero) THEN
945 niskyl = niskyl + 1
946 fskyi(niskyl,1)=fx4(i)
947 fskyi(niskyl,2)=fy4(i)
948 fskyi(niskyl,3)=fz4(i)
949 fskyi(niskyl,4)=stif(i)*abs(hm2(i))
950 isky(niskyl) = m2(i)
951 ftheskyi(niskyl)=phim2(i)
952 condnskyi(niskyl)=condintm2(i)
953 ENDIF
954 ENDDO
955 ELSE
956 DO i=1,jlt
957 IF (hm1(i)/=zero) THEN
958 niskyl = niskyl + 1
959 fskyi(niskyl,1)=fx3(i)
960 fskyi(niskyl,2)=fy3(i)
961 fskyi(niskyl,3)=fz3(i)
962 fskyi(niskyl,4)=stif(i)*abs(hm1(i))
963 isky(niskyl) = m1(i)
964 ftheskyi(niskyl)=phim1(i)
965 ENDIF
966 ENDDO
967 DO i=1,jlt
968 IF (hm2(i)/=zero) THEN
969 niskyl = niskyl + 1
970 fskyi(niskyl,1)=fx4(i)
971 fskyi(niskyl,2)=fy4(i)
972 fskyi(niskyl,3)=fz4(i)
973 fskyi(niskyl,4)=stif(i)*abs(hm2(i))
974 isky(niskyl) = m2(i)
975 ftheskyi(niskyl)=phim2(i)
976 ENDIF
977 ENDDO
978 ENDIF
979 ENDIF
980C
981 RETURN
982 END
983C
984!||====================================================================
985!|| i11ass25 ../engine/source/interfaces/int11/i11ass3.F
986!||--- called by ------------------------------------------------------
987!|| i11ass3 ../engine/source/interfaces/int11/i11ass3.F
988!||--- calls -----------------------------------------------------
989!|| ancmsg ../engine/source/output/message/message.F
990!|| arret ../engine/source/system/arret.F
991!||--- uses -----------------------------------------------------
992!|| message_mod ../engine/share/message_module/message_mod.F
993!|| tri7box ../engine/share/modules/tri7box.F
994!||====================================================================
995 SUBROUTINE i11ass25(JLT ,CS_LOC ,N1 ,N2 ,M1 ,
996 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
997 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
998 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
999 5 FY4 ,FZ4 ,ISKY ,NISKYFI,NRTS ,
1000 6 K1 ,K2 ,K3 ,K4 ,C1 ,
1001 7 C2 ,C3 ,C4 ,NIN ,NOINT ,
1002 8 INTTH ,PHIS1 ,PHIS2 ,PHIM1 ,PHIM2 ,
1003 9 FTHESKYI,CONDINTS1,CONDINTS2,CONDINTM1,
1004 A CONDINTM2,CONDNSKYI,NODADT_THERM)
1005C-----------------------------------------------
1006C M o d u l e s
1007C-----------------------------------------------
1008 USE tri7box
1009 USE message_mod
1010C-----------------------------------------------
1011C I m p l i c i t T y p e s
1012C-----------------------------------------------
1013#include "implicit_f.inc"
1014#include "comlock.inc"
1015C-----------------------------------------------
1016C G l o b a l P a r a m e t e r s
1017C-----------------------------------------------
1018#include "mvsiz_p.inc"
1019C-----------------------------------------------
1020C C o m m o n B l o c k s
1021C-----------------------------------------------
1022#include "parit_c.inc"
1023#include "scr18_c.inc"
1024C-----------------------------------------------
1025C D u m m y A r g u m e n t s
1026C-----------------------------------------------
1027 INTEGER ,INTENT(IN) :: NODADT_THERM
1028 INTEGER JLT, NRTS,NISKYFI,NIN,NOINT,INTTH ,
1029 + cs_loc(*),isky(*),
1030 + n1(mvsiz),n2(mvsiz),m1(mvsiz),m2(mvsiz)
1031 my_real
1032 . hs1(mvsiz),hs2(mvsiz),hm1(mvsiz),hm2(mvsiz),
1033 . fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
1034 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
1035 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
1036 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
1037 . k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
1038 . c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),
1039 . phis1(mvsiz),phis2(mvsiz),condints1(mvsiz),
1040 . condints2(mvsiz),phim1(mvsiz),phim2(mvsiz),
1041 . condintm1(mvsiz),condintm2(mvsiz),
1042 . fskyi(lskyi,nfskyi),ftheskyi(*),condnskyi(*)
1043C-----------------------------------------------
1044C L o c a l V a r i a b l e s
1045C-----------------------------------------------
1046 INTEGER I, NISKYL1, NISKYL, IGP, IGM, NISKYFIL
1047C
1048 NISKYL1 = 0
1049 do i = 1, jlt
1050 IF (hm1(i)/=zero) niskyl1 = niskyl1 + 1
1051 ENDDO
1052 DO i = 1, jlt
1053 IF (hm2(i)/=zero) niskyl1 = niskyl1 + 1
1054 ENDDO
1055
1056 igp = 0
1057 igm = 0
1058 DO i=1,jlt
1059 IF(cs_loc(i)<=nrts) THEN
1060 igp = igp+2
1061 ELSE
1062 igm = igm+1
1063 ENDIF
1064 ENDDO
1065
1066#include "lockon.inc"
1067 niskyl = nisky
1068 nisky = nisky + niskyl1 + igp
1069 niskyfil = niskyfi
1070 niskyfi = niskyfi + igm
1071#include "lockoff.inc"
1072C
1073 IF (niskyl+niskyl1+igp > lskyi) THEN
1074 CALL ancmsg(msgid=26,anmode=aninfo_blind)
1075 CALL arret(2)
1076 ENDIF
1077 IF (niskyfil+igm > nlskyfi(nin)) THEN
1078 CALL ancmsg(msgid=26,anmode=aninfo_blind)
1079 CALL arret(2)
1080 ENDIF
1081C
1082 IF(intth == 0)THEN
1083 DO i=1,jlt
1084 IF(cs_loc(i)<=nrts) THEN
1085 niskyl = niskyl + 1
1086 fskyi(niskyl,1)=fx1(i)
1087 fskyi(niskyl,2)=fy1(i)
1088 fskyi(niskyl,3)=fz1(i)
1089 fskyi(niskyl,4)=k1(i)
1090 fskyi(niskyl,5)=c1(i)
1091 isky(niskyl) = n1(i)
1092C
1093 niskyl = niskyl + 1
1094 fskyi(niskyl,1)=fx2(i)
1095 fskyi(niskyl,2)=fy2(i)
1096 fskyi(niskyl,3)=fz2(i)
1097 fskyi(niskyl,4)=k2(i)
1098 fskyi(niskyl,5)=c2(i)
1099 isky(niskyl) = n2(i)
1100 ELSE
1101 niskyfil = niskyfil + 1
1102 fskyfi(nin)%P(1,niskyfil)=fx1(i)
1103 fskyfi(nin)%P(2,niskyfil)=fy1(i)
1104 fskyfi(nin)%P(3,niskyfil)=fz1(i)
1105 fskyfi(nin)%P(4,niskyfil)=k1(i)
1106 fskyfi(nin)%P(5,niskyfil)=c1(i)
1107 fskyfi(nin)%P(6,niskyfil)=fx2(i)
1108 fskyfi(nin)%P(7,niskyfil)=fy2(i)
1109 fskyfi(nin)%P(8,niskyfil)=fz2(i)
1110 fskyfi(nin)%P(9,niskyfil)=k2(i)
1111 fskyfi(nin)%P(10,niskyfil)=c2(i)
1112
1113 iskyfi(nin)%P(niskyfil) = cs_loc(i)-nrts
1114 END IF
1115 END DO
1116 ELSE
1117 IF(nodadt_therm == 1 ) THEN
1118 DO i=1,jlt
1119 IF(cs_loc(i)<=nrts) THEN
1120 niskyl = niskyl + 1
1121 fskyi(niskyl,1)=fx1(i)
1122 fskyi(niskyl,2)=fy1(i)
1123 fskyi(niskyl,3)=fz1(i)
1124 fskyi(niskyl,4)=k1(i)
1125 fskyi(niskyl,5)=c1(i)
1126 ftheskyi(niskyl)=phis1(i)
1127 condnskyi(niskyl)=condints1(i)
1128 isky(niskyl) = n1(i)
1129C
1130 niskyl = niskyl + 1
1131 fskyi(niskyl,1)=fx2(i)
1132 fskyi(niskyl,2)=fy2(i)
1133 fskyi(niskyl,3)=fz2(i)
1134 fskyi(niskyl,4)=k2(i)
1135 fskyi(niskyl,5)=c2(i)
1136 ftheskyi(niskyl)=phis2(i)
1137 condnskyi(niskyl)=condints2(i)
1138 isky(niskyl) = n2(i)
1139 ELSE
1140 niskyfil = niskyfil + 1
1141 fskyfi(nin)%P(1,niskyfil)=fx1(i)
1142 fskyfi(nin)%P(2,niskyfil)=fy1(i)
1143 fskyfi(nin)%P(3,niskyfil)=fz1(i)
1144 fskyfi(nin)%P(4,niskyfil)=k1(i)
1145 fskyfi(nin)%P(5,niskyfil)=c1(i)
1146 ftheskyfi(nin)%P(2*(niskyfil-1)+1)=phis1(i)
1147 condnskyfi(nin)%P(2*(niskyfil-1)+1)=condints1(i)
1148 fskyfi(nin)%P(6,niskyfil)=fx2(i)
1149 fskyfi(nin)%P(7,niskyfil)=fy2(i)
1150 fskyfi(nin)%P(8,niskyfil)=fz2(i)
1151 fskyfi(nin)%P(9,niskyfil)=k2(i)
1152 fskyfi(nin)%P(10,niskyfil)=c2(i)
1153 ftheskyfi(nin)%P(2*(niskyfil-1)+2)=phis2(i)
1154 condnskyfi(nin)%P(2*(niskyfil-1)+2)=condints1(i)
1155 iskyfi(nin)%P(niskyfil) = cs_loc(i)-nrts
1156 END IF
1157 END DO
1158 ELSE
1159 DO i=1,jlt
1160 IF(cs_loc(i)<=nrts) THEN
1161 niskyl = niskyl + 1
1162 fskyi(niskyl,1)=fx1(i)
1163 fskyi(niskyl,2)=fy1(i)
1164 fskyi(niskyl,3)=fz1(i)
1165 fskyi(niskyl,4)=k1(i)
1166 fskyi(niskyl,5)=c1(i)
1167 ftheskyi(niskyl)=phis1(i)
1168 isky(niskyl) = n1(i)
1169C
1170 niskyl = niskyl + 1
1171 fskyi(niskyl,1)=fx2(i)
1172 fskyi(niskyl,2)=fy2(i)
1173 fskyi(niskyl,3)=fz2(i)
1174 fskyi(niskyl,4)=k2(i)
1175 fskyi(niskyl,5)=c2(i)
1176 ftheskyi(niskyl)=phis2(i)
1177 isky(niskyl) = n2(i)
1178 ELSE
1179 niskyfil = niskyfil + 1
1180 fskyfi(nin)%P(1,niskyfil)=fx1(i)
1181 fskyfi(nin)%P(2,niskyfil)=fy1(i)
1182 fskyfi(nin)%P(3,niskyfil)=fz1(i)
1183 fskyfi(nin)%P(4,niskyfil)=k1(i)
1184 fskyfi(nin)%P(5,niskyfil)=c1(i)
1185 ftheskyfi(nin)%P(2*(niskyfil-1)+1)=phis1(i)
1186 fskyfi(nin)%P(6,niskyfil)=fx2(i)
1187 fskyfi(nin)%P(7,niskyfil)=fy2(i)
1188 fskyfi(nin)%P(8,niskyfil)=fz2(i)
1189 fskyfi(nin)%P(9,niskyfil)=k2(i)
1190 fskyfi(nin)%P(10,niskyfil)=c2(i)
1191 ftheskyfi(nin)%P(2*(niskyfil-1)+2)=phis2(i)
1192 iskyfi(nin)%P(niskyfil) = cs_loc(i)-nrts
1193 END IF
1194 END DO
1195 ENDIF
1196 ENDIF
1197C
1198 IF(intth == 0)THEN
1199 DO i=1,jlt
1200 IF (hm1(i)/=zero) THEN
1201 niskyl = niskyl + 1
1202 fskyi(niskyl,1)=fx3(i)
1203 fskyi(niskyl,2)=fy3(i)
1204 fskyi(niskyl,3)=fz3(i)
1205 fskyi(niskyl,4)=k3(i)
1206 fskyi(niskyl,5)=c3(i)
1207 isky(niskyl) = m1(i)
1208 ENDIF
1209 ENDDO
1210 DO i=1,jlt
1211 IF (hm2(i)/=zero) THEN
1212 niskyl = niskyl + 1
1213 fskyi(niskyl,1)=fx4(i)
1214 fskyi(niskyl,2)=fy4(i)
1215 fskyi(niskyl,3)=fz4(i)
1216 fskyi(niskyl,4)=k4(i)
1217 fskyi(niskyl,5)=c4(i)
1218 isky(niskyl) = m2(i)
1219 ENDIF
1220 ENDDO
1221 ELSE
1222 IF(nodadt_therm == 1 ) THEN
1223 DO i=1,jlt
1224 IF (hm1(i)/=zero) THEN
1225 niskyl = niskyl + 1
1226 fskyi(niskyl,1)=fx3(i)
1227 fskyi(niskyl,2)=fy3(i)
1228 fskyi(niskyl,3)=fz3(i)
1229 fskyi(niskyl,4)=k3(i)
1230 fskyi(niskyl,5)=c3(i)
1231 isky(niskyl) = m1(i)
1232 ftheskyi(niskyl)=phim1(i)
1233 condnskyi(niskyl)=condintm1(i)
1234 ENDIF
1235 ENDDO
1236 DO i=1,jlt
1237 IF (hm2(i)/=zero) THEN
1238 niskyl = niskyl + 1
1239 fskyi(niskyl,1)=fx4(i)
1240 fskyi(niskyl,2)=fy4(i)
1241 fskyi(niskyl,3)=fz4(i)
1242 fskyi(niskyl,4)=k4(i)
1243 fskyi(niskyl,5)=c4(i)
1244 isky(niskyl) = m2(i)
1245 ftheskyi(niskyl)=phim2(i)
1246 condnskyi(niskyl)=condintm2(i)
1247 ENDIF
1248 ENDDO
1249 ELSE
1250 DO i=1,jlt
1251 IF (hm1(i)/=zero) THEN
1252 niskyl = niskyl + 1
1253 fskyi(niskyl,1)=fx3(i)
1254 fskyi(niskyl,2)=fy3(i)
1255 fskyi(niskyl,3)=fz3(i)
1256 fskyi(niskyl,4)=k3(i)
1257 fskyi(niskyl,5)=c3(i)
1258 isky(niskyl) = m1(i)
1259 ftheskyi(niskyl)=phim1(i)
1260 ENDIF
1261 ENDDO
1262 DO i=1,jlt
1263 IF (hm2(i)/=zero) THEN
1264 niskyl = niskyl + 1
1265 fskyi(niskyl,1)=fx4(i)
1266 fskyi(niskyl,2)=fy4(i)
1267 fskyi(niskyl,3)=fz4(i)
1268 fskyi(niskyl,4)=k4(i)
1269 fskyi(niskyl,5)=c4(i)
1270 isky(niskyl) = m2(i)
1271 ftheskyi(niskyl)=phim2(i)
1272 ENDIF
1273 ENDDO
1274 ENDIF
1275 ENDIF
1276C
1277 RETURN
1278 END
my_real
#define my_real
Definition cppsort.cpp:32
i11ass0
subroutine i11ass0(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, a, stifn, stif, nrts, nin, intth, phis1, phis2, phim1, phim2, fthe, condints1, condints2, condintm1, condintm2, condn, jtask, nodadt_therm)
Definition i11ass3.F:273
i11ass05
subroutine i11ass05(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, a, stifn, nrts, k1, k2, k3, k4, c1, c2, c3, c4, viscn, nin, intth, phis1, phis2, phim1, phim2, fthe, condints1, condints2, condintm1, condintm2, condn, jtask, nodadt_therm)
Definition i11ass3.F:490
i11ass25
subroutine i11ass25(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, isky, niskyfi, nrts, k1, k2, k3, k4, c1, c2, c3, c4, nin, noint, intth, phis1, phis2, phim1, phim2, ftheskyi, condints1, condints2, condintm1, condintm2, condnskyi, nodadt_therm)
Definition i11ass3.F:1005
i11ass3
subroutine i11ass3(jlt, a, nin, noint, cs_loc, stifn, stif, fskyi, isky, fcont, hs1, hs2, hm1, hm2, n1, n2, m1, m2, niskyfi, isecin, nstrf, secfcum, viscn, nrts, iskyi_sms, nsms, icontact, mskyi_sms, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, k1, k2, k3, k4, c1, c2, c3, c4, intth, phis1, phis2, phim1, phim2, fthe, ftheskyi, condints1, condints2, condintm1, condintm2, condn, condnskyi, jtask, h3d_data, nodadt_therm)
Definition i11ass3.F:51
i11ass2
subroutine i11ass2(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fskyi, isky, niskyfi, stif, nrts, nin, noint, intth, phis1, phis2, phim1, phim2, ftheskyi, condints1, condints2, condintm1, condintm2, condnskyi, nodadt_therm)
Definition i11ass3.F:729
i11sms2
subroutine i11sms2(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, stif, nin, noint, mskyi_sms, iskyi_sms, nsms, k1, k2, k3, k4, c1, c2, c3, c4, nrts)
Definition i11sms2.F:39
h3d_mod
Definition h3d_mod.F:311
message_mod
Definition message_mod.F:1257
tri7box::condnfi
type(real_pointer), dimension(:), allocatable condnfi
Definition tri7box.F:449
tri7box::ftheskyfi
type(real_pointer), dimension(:), allocatable ftheskyfi
Definition tri7box.F:449
tri7box::condnskyfi
type(real_pointer), dimension(:), allocatable condnskyfi
Definition tri7box.F:449
tri7box::stnfi
type(real_pointer), dimension(:), allocatable stnfi
Definition tri7box.F:449
tri7box::afi
type(real_pointer2), dimension(:), allocatable afi
Definition tri7box.F:459
tri7box::fskyfi
type(real_pointer2), dimension(:), allocatable fskyfi
Definition tri7box.F:459
tri7box::iskyfi
type(int_pointer), dimension(:), allocatable iskyfi
Definition tri7box.F:480
tri7box::vscfi
type(real_pointer), dimension(:), allocatable vscfi
Definition tri7box.F:449
tri7box::nlskyfi
integer, dimension(:), allocatable nlskyfi
Definition tri7box.F:512
tri7box::fthefi
type(real_pointer), dimension(:), allocatable fthefi
Definition tri7box.F:449
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86
h3d_mod::h3d_database
Definition h3d_mod.F:438