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