OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25ass3.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!|| i25ass3 ../engine/source/interfaces/int25/i25ass3.F
25!||--- called by ------------------------------------------------------
26!|| i25mainf ../engine/source/interfaces/int25/i25mainf.F
27!||--- calls -----------------------------------------------------
28!|| i25ass0 ../engine/source/interfaces/int25/i25ass3.F
29!|| i25ass2 ../engine/source/interfaces/int25/i25ass3.F
30!||--- uses -----------------------------------------------------
31!|| pinchtype_mod ../common_source/modules/pinchtype_mod.F
32!|| tri7box ../engine/share/modules/tri7box.F
33!||====================================================================
34 SUBROUTINE i25ass3(JLT ,NSVG ,ITAB ,CE_LOC ,
35 2 JTASK ,NIN ,NOINT ,INTPLY ,A ,
36 3 STIF ,STIFN ,NISKYFI ,FSKYI ,ISKY ,
37 4 N1 ,N2 ,N3 ,H1 ,H2 ,
38 5 H3 ,H4 ,IX1 ,IX2 ,IX3 ,
39 6 IX4 ,INTTH ,FTHE ,FTHESKYI ,
40 7 PHI ,PHI1 ,PHI2 ,PHI3 ,PHI4 ,
41 8 FNI ,MSEGTYP ,APINCH ,STIFPINCH ,
42 9 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
43 A FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
44 B FY4 ,FZ4 ,FXI ,FYI ,FZI ,
45 F IFORM ,CONDINT ,CONDN ,CONDNSKYI ,NODADT_THERM)
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE tri7box
50 USE pinchtype_mod
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55#include "comlock.inc"
56C-----------------------------------------------
57C G l o b a l P a r a m e t e r s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "parit_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER ,INTENT(IN) :: NODADT_THERM
68 INTEGER JLT, NIN, NOINT, JTASK, NISKYFI, INTTH, INTPLY,
69 . IFORM,
70 . ITAB(*), ISKY(*), MSEGTYP(*)
71 INTEGER
72 . CE_LOC(MVSIZ),NSVG(MVSIZ),
73 . IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
74 my_real
75 . A(3,*), STIFN(*), FSKYI(LSKYI,NFSKYI),
76 . APINCH(3,*),STIFPINCH(*)
77 my_real
78 . stif(mvsiz), n1(mvsiz), n2(mvsiz), n3(mvsiz),
79 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
80 . fthe(*), ftheskyi(lskyi),
81 . condn(*),condnskyi(lskyi)
82 my_real
83 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz), fni(mvsiz),
84 . fxt(mvsiz),fyt(mvsiz),fzt(mvsiz),
85 . fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
86 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz),
87 . fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
88 . phi(mvsiz),phi1(mvsiz),phi2(mvsiz),phi3(mvsiz),
89 . phi4(mvsiz),condint(mvsiz)
90C-----------------------------------------------
91C
92 IF(iparit==3)THEN
93 stop 789
94 ELSEIF(iparit==0)THEN
95 CALL i25ass0(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
96 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
97 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
98 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
99 5 fxi ,fyi ,fzi ,a ,stifn ,nin ,
100 6 intth ,phi ,fthe ,phi1 , phi2 ,phi3 ,
101 7 phi4 ,jtask ,apinch ,stifpinch, msegtyp, ce_loc,
102 8 fni ,n1 ,n2 ,n3 ,iform,
103 9 condint,condn ,nodadt_therm)
104 ELSE
105 CALL i25ass2(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
106 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
107 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
108 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
109 5 fxi ,fyi ,fzi ,fskyi,isky ,niskyfi,
110 6 nin ,noint ,intth,phi ,ftheskyi ,intply,
111 7 phi1 ,phi2 ,phi3 , phi4 ,itab ,iform,
112 c condint,condnskyi ,nodadt_therm)
113 ENDIF
114C
115C
116 RETURN
117 END
118!||====================================================================
119!|| i25ass2 ../engine/source/interfaces/int25/i25ass3.F
120!||--- called by ------------------------------------------------------
121!|| i25ass3 ../engine/source/interfaces/int25/i25ass3.F
122!||--- calls -----------------------------------------------------
123!|| ancmsg ../engine/source/output/message/message.F
124!|| arret ../engine/source/system/arret.F
125!||--- uses -----------------------------------------------------
126!|| message_mod ../engine/share/message_module/message_mod.F
127!|| tri7box ../engine/share/modules/tri7box.F
128!||====================================================================
129 SUBROUTINE i25ass2(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
130 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
131 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
132 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
133 5 FXI ,FYI ,FZI ,FSKYI,ISKY ,NISKYFI,
134 6 NIN ,NOINT ,INTTH,PHI ,FTHESKYI,INTPLY,
135 7 PHI1 ,PHI2 ,PHI3 , PHI4 ,ITAB,IFORM,
136 C CONDINT,CONDNSKYI ,NODADT_THERM)
137C-----------------------------------------------
138C M o d u l e s
139C-----------------------------------------------
140 USE tri7box
141 USE message_mod
142C-----------------------------------------------
143C I m p l i c i t T y p e s
144C-----------------------------------------------
145#include "implicit_f.inc"
146#include "comlock.inc"
147C-----------------------------------------------
148C G l o b a l P a r a m e t e r s
149C-----------------------------------------------
150#include "mvsiz_p.inc"
151C-----------------------------------------------
152C C o m m o n B l o c k s
153C-----------------------------------------------
154#include "parit_c.inc"
155#include "scr18_c.inc"
156C-----------------------------------------------
157C D u m m y A r g u m e n t s
158C-----------------------------------------------
159 INTEGER JLT,NISKYFI,NIN,NOINT,INTTH,INTPLY,IFORM,
160 . ISKY(*),ITAB(*),
161 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),NSVG(MVSIZ)
162 INTEGER , INTENT(IN) :: NODADT_THERM
163 my_real
164 . H1(MVSIZ),H2(MVSIZ),H3(MVSIZ),H4(MVSIZ),STIF(MVSIZ),
165 . FX1(MVSIZ),FY1(MVSIZ),FZ1(MVSIZ),
166 . FX2(MVSIZ),FY2(MVSIZ),FZ2(MVSIZ),
167 . FX3(MVSIZ),FY3(MVSIZ),FZ3(MVSIZ),
168 . FX4(MVSIZ),FY4(MVSIZ),FZ4(MVSIZ),
169 . FXI(MVSIZ),FYI(MVSIZ),FZI(MVSIZ),
170 . FSKYI(LSKYI,NFSKYI),FTHESKYI(LSKYI),PHI(MVSIZ),
171 . PHI1(MVSIZ),PHI2(MVSIZ) ,PHI3(MVSIZ) ,PHI4(MVSIZ),
172 . CONDINT(MVSIZ),
173 . CONDNSKYI(LSKYI)
174C-----------------------------------------------
175C L o c a l V a r i a b l e s
176C-----------------------------------------------
177 my_real
178 . hh(mvsiz),fici(5),fics(4,4),ficsth(4,5)
179 INTEGER I, J1, IG, NISKYL1, NISKYL,IGP,IGM,IDR,NISKYFIL,J
180 INTEGER ITG,NN,ILY,JG,IXSS(4)
181C
182 niskyl1 = 0
183 DO i = 1, jlt
184 hh(i)=h1(i)+h2(i)+h3(i)+h4(i)
185 IF(hh(i)==zero)cycle
186 IF (h1(i)/=zero) niskyl1 = niskyl1 + 1
187 IF (h2(i)/=zero) niskyl1 = niskyl1 + 1
188 IF (h3(i)/=zero) niskyl1 = niskyl1 + 1
189 IF (h4(i)/=zero) niskyl1 = niskyl1 + 1
190
191 ENDDO
192C
193C Precalcul impact locaux / remote
194C
195 igp = 0
196 igm = 0
197 DO i=1,jlt
198 IF(hh(i)==zero)cycle
199 ig =nsvg(i)
200 IF(ig>0) THEN
201 igp = igp+1
202 ELSE
203 igm = igm+1
204 ENDIF
205 ENDDO
206C
207#include "lockon.inc"
208 niskyl = nisky
209 nisky = nisky + niskyl1 + igp
210 niskyfil = niskyfi
211 niskyfi = niskyfi + igm
212#include "lockoff.inc"
213C
214 IF (niskyl+niskyl1+igp > lskyi) THEN
215 CALL ancmsg(msgid=26,anmode=aninfo)
216 CALL arret(2)
217 ENDIF
218 IF (niskyfil+igm > nlskyfi(nin)) THEN
219 CALL ancmsg(msgid=26,anmode=aninfo)
220 CALL arret(2)
221 ENDIF
222C
223 IF(intth == 0 ) THEN
224 DO i=1,jlt
225 IF (h1(i)/=zero) THEN
226 niskyl = niskyl + 1
227 fskyi(niskyl,1)=fx1(i)
228 fskyi(niskyl,2)=fy1(i)
229 fskyi(niskyl,3)=fz1(i)
230 fskyi(niskyl,4)=stif(i)*abs(h1(i))
231 isky(niskyl) = ix1(i)
232 ENDIF
233 ENDDO
234 DO i=1,jlt
235 IF (h2(i)/=zero) THEN
236 niskyl = niskyl + 1
237 fskyi(niskyl,1)=fx2(i)
238 fskyi(niskyl,2)=fy2(i)
239 fskyi(niskyl,3)=fz2(i)
240 fskyi(niskyl,4)=stif(i)*abs(h2(i))
241 isky(niskyl) = ix2(i)
242 ENDIF
243 ENDDO
244 DO i=1,jlt
245 IF (h3(i)/=zero) THEN
246 niskyl = niskyl + 1
247 fskyi(niskyl,1)=fx3(i)
248 fskyi(niskyl,2)=fy3(i)
249 fskyi(niskyl,3)=fz3(i)
250 fskyi(niskyl,4)=stif(i)*abs(h3(i))
251 isky(niskyl) = ix3(i)
252 ENDIF
253 ENDDO
254 DO i=1,jlt
255 IF (h4(i)/=zero) THEN
256 niskyl = niskyl + 1
257 fskyi(niskyl,1)=fx4(i)
258 fskyi(niskyl,2)=fy4(i)
259 fskyi(niskyl,3)=fz4(i)
260 fskyi(niskyl,4)=stif(i)*abs(h4(i))
261 isky(niskyl) = ix4(i)
262 ENDIF
263 ENDDO
264C
265 DO i=1,jlt
266 IF(hh(i)==zero)cycle
267 ig =nsvg(i)
268 IF(ig>0) THEN
269 niskyl = niskyl + 1
270 fskyi(niskyl,1)=-fxi(i)
271 fskyi(niskyl,2)=-fyi(i)
272 fskyi(niskyl,3)=-fzi(i)
273 fskyi(niskyl,4)= stif(i)
274 isky(niskyl) = ig
275 ELSE
276 ig = -ig
277 niskyfil = niskyfil + 1
278 fskyfi(nin)%P(1,niskyfil)=-fxi(i)
279 fskyfi(nin)%P(2,niskyfil)=-fyi(i)
280 fskyfi(nin)%P(3,niskyfil)=-fzi(i)
281 fskyfi(nin)%P(4,niskyfil)= stif(i)
282 iskyfi(nin)%P(niskyfil) = ig
283 ENDIF
284 ENDDO
285C Thermique
286 ELSE
287 DO i=1,jlt
288 IF (h1(i)/=0.) THEN
289 niskyl = niskyl + 1
290 fskyi(niskyl,1)=fx1(i)
291 fskyi(niskyl,2)=fy1(i)
292 fskyi(niskyl,3)=fz1(i)
293 fskyi(niskyl,4)=stif(i)*abs(h1(i))
294 isky(niskyl) = ix1(i)
295 ftheskyi(niskyl) = phi1(i)
296 IF(nodadt_therm == 1.AND.iform > 0 ) condnskyi(niskyl) = condint(i)*abs(h1(i))
297 ENDIF
298 ENDDO
299 DO i=1,jlt
300 IF (h2(i)/=zero) THEN
301 niskyl = niskyl + 1
302 fskyi(niskyl,1)=fx2(i)
303 fskyi(niskyl,2)=fy2(i)
304 fskyi(niskyl,3)=fz2(i)
305 fskyi(niskyl,4)=stif(i)*abs(h2(i))
306 isky(niskyl) = ix2(i)
307 ftheskyi(niskyl) = phi2(i)
308 IF(nodadt_therm == 1.AND.iform > 0 ) condnskyi(niskyl) = condint(i)*abs(h2(i))
309 ENDIF
310 ENDDO
311 DO i=1,jlt
312 IF (h3(i)/=zero) THEN
313 niskyl = niskyl + 1
314 fskyi(niskyl,1)=fx3(i)
315 fskyi(niskyl,2)=fy3(i)
316 fskyi(niskyl,3)=fz3(i)
317 fskyi(niskyl,4)=stif(i)*abs(h3(i))
318 isky(niskyl) = ix3(i)
319 ftheskyi(niskyl) = phi3(i)
320 IF(nodadt_therm == 1.AND.iform > 0 ) condnskyi(niskyl) = condint(i)*abs(h3(i))
321 ENDIF
322 ENDDO
323 DO i=1,jlt
324 IF (h4(i)/=zero) THEN
325 niskyl = niskyl + 1
326 fskyi(niskyl,1)=fx4(i)
327 fskyi(niskyl,2)=fy4(i)
328 fskyi(niskyl,3)=fz4(i)
329 fskyi(niskyl,4)=stif(i)*abs(h4(i))
330 isky(niskyl) = ix4(i)
331 ftheskyi(niskyl) = phi4(i)
332 IF(nodadt_therm == 1.AND.iform > 0 ) condnskyi(niskyl) = condint(i)*abs(h4(i))
333 ENDIF
334 ENDDO
335C
336 DO i=1,jlt
337 IF(hh(i)==zero)cycle
338 ig =nsvg(i)
339 IF(ig>0) THEN
340 niskyl = niskyl + 1
341 fskyi(niskyl,1)=-fxi(i)
342 fskyi(niskyl,2)=-fyi(i)
343 fskyi(niskyl,3)=-fzi(i)
344 fskyi(niskyl,4)= stif(i)
345 isky(niskyl) = ig
346 ftheskyi(niskyl)=phi(i)
347 IF(nodadt_therm == 1) condnskyi(niskyl) = condint(i)
348 ELSE
349 ig = -ig
350 niskyfil = niskyfil + 1
351 fskyfi(nin)%P(1,niskyfil)=-fxi(i)
352 fskyfi(nin)%P(2,niskyfil)=-fyi(i)
353 fskyfi(nin)%P(3,niskyfil)=-fzi(i)
354 fskyfi(nin)%P(4,niskyfil)= stif(i)
355 iskyfi(nin)%P(niskyfil) = ig
356 ftheskyfi(nin)%P(niskyfil)=phi(i)
357 IF(nodadt_therm == 1) condnskyfi(nin)%P(niskyfil) = condint(i)
358 ENDIF
359 ENDDO
360 ENDIF
361C
362 RETURN
363 END
364!||====================================================================
365!|| i25ass0 ../engine/source/interfaces/int25/i25ass3.F
366!||--- called by ------------------------------------------------------
367!|| i25ass3 ../engine/source/interfaces/int25/i25ass3.F
368!||--- uses -----------------------------------------------------
369!|| pinchtype_mod ../common_source/modules/pinchtype_mod.F
370!|| tri7box ../engine/share/modules/tri7box.F
371!||====================================================================
372 SUBROUTINE i25ass0(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
373 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
374 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
375 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
376 5 FXI ,FYI ,FZI ,A ,STIFN ,NIN ,
377 6 INTTH ,PHI ,FTHE ,PHI1 , PHI2 ,PHI3 ,
378 7 PHI4 ,JTASK,APINCH ,STIFPINCH ,MSEGTYP, CE_LOC,
379 8 FNI ,N1 ,N2 ,N3 ,IFORM,
380 9 CONDINT,CONDN ,NODADT_THERM)
381C-----------------------------------------------
382C M o d u l e s
383C-----------------------------------------------
384 USE tri7box
385 USE pinchtype_mod
386C-----------------------------------------------
387C I m p l i c i t T y p e s
388C-----------------------------------------------
389#include "implicit_f.inc"
390C-----------------------------------------------
391C G l o b a l P a r a m e t e r s
392C-----------------------------------------------
393#include "mvsiz_p.inc"
394C-----------------------------------------------
395C C o m m o n B l o c k s
396C-----------------------------------------------
397#include "scr18_c.inc"
398C-----------------------------------------------
399C D u m m y A r g u m e n t s
400C-----------------------------------------------
401 INTEGER JLT, NIN,INTTH,IFORM,
402 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),NSVG(MVSIZ),JTASK,
403 . MSEGTYP(*),CE_LOC(MVSIZ)
404 INTEGER , INTENT(IN) :: NODADT_THERM
405 my_real
406 . H1(MVSIZ),H2(MVSIZ),H3(MVSIZ),H4(MVSIZ),STIF(MVSIZ),
407 . FX1(MVSIZ),FY1(MVSIZ),FZ1(MVSIZ),
408 . FX2(MVSIZ),FY2(MVSIZ),FZ2(MVSIZ),
409 . FX3(MVSIZ),FY3(MVSIZ),FZ3(MVSIZ),
410 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
411 . fxi(mvsiz),fyi(mvsiz),fzi(mvsiz),
412 . condint(mvsiz),
413 . a(3,*), stifn(*),phi(*), fthe(*),
414 . phi1(*), phi2(*), phi3(*), phi4(*),
415 . apinch(3,*),stifpinch(*),fni(*),n1(*),n2(*),n3(*),
416 . condn(*)
417C-----------------------------------------------
418C L o c a l V a r i a b l e s
419C-----------------------------------------------
420 my_real
421 . hh(mvsiz),fici(5),fics(4,4),ficsth(4,5),fact
422 INTEGER I, J1, IG,ILY,NN,JG,IXSS(4),NFIC,J,ISHIFT,NODFI
423
424C
425 IF(INTTH == 0) then
426 IF(npinch > 0)THEN
427 DO i=1,jlt
428 fact = half
429 IF(msegtyp(ce_loc(i))<0) THEN
430 fact = -half
431 ENDIF
432C
433 hh(i)=h1(i)+h2(i)+h3(i)+h4(i)
434 IF(hh(i)==zero)cycle
435C
436 j1=ix1(i)
437 a(1,j1)=a(1,j1)+fx1(i)
438 a(2,j1)=a(2,j1)+fy1(i)
439 a(3,j1)=a(3,j1)+fz1(i)
440 stifn(j1) = stifn(j1) + stif(i)*abs(h1(i))
441 apinch(1,j1)=apinch(1,j1)+fact*fni(i)*h1(i)*n1(i)
442 apinch(2,j1)=apinch(2,j1)+fact*fni(i)*h1(i)*n2(i)
443 apinch(3,j1)=apinch(3,j1)+fact*fni(i)*h1(i)*n3(i)
444 stifpinch(j1) = stifpinch(j1) + stif(i)*abs(h1(i))
445C
446 j1=ix2(i)
447 a(1,j1)=a(1,j1)+fx2(i)
448 a(2,j1)=a(2,j1)+fy2(i)
449 a(3,j1)=a(3,j1)+fz2(i)
450 stifn(j1) = stifn(j1) + stif(i)*abs(h2(i))
451 apinch(1,j1)=apinch(1,j1)+fact*fni(i)*h2(i)*n1(i)
452 apinch(2,j1)=apinch(2,j1)+fact*fni(i)*h2(i)*n2(i)
453 apinch(3,j1)=apinch(3,j1)+fact*fni(i)*h2(i)*n3(i)
454 stifpinch(j1) = stifpinch(j1) + stif(i)*abs(h2(i))
455C
456 j1=ix3(i)
457 a(1,j1)=a(1,j1)+fx3(i)
458 a(2,j1)=a(2,j1)+fy3(i)
459 a(3,j1)=a(3,j1)+fz3(i)
460 stifn(j1) = stifn(j1) + stif(i)*abs(h3(i))
461 apinch(1,j1)=apinch(1,j1)+fact*fni(i)*h3(i)*n1(i)
462 apinch(2,j1)=apinch(2,j1)+fact*fni(i)*h3(i)*n2(i)
463 apinch(3,j1)=apinch(3,j1)+fact*fni(i)*h3(i)*n3(i)
464 stifpinch(j1) = stifpinch(j1) + stif(i)*abs(h3(i))
465C
466 j1=ix4(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(h4(i))
471 apinch(1,j1)=apinch(1,j1)+fact*fni(i)*h4(i)*n1(i)
472 apinch(2,j1)=apinch(2,j1)+fact*fni(i)*h4(i)*n2(i)
473 apinch(3,j1)=apinch(3,j1)+fact*fni(i)*h4(i)*n3(i)
474 stifpinch(j1) = stifpinch(j1) + stif(i)*abs(h4(i))
475 ENDDO
476 ELSE ! NPINCH > 0
477 DO i=1,jlt
478 hh(i)=h1(i)+h2(i)+h3(i)+h4(i)
479 IF(hh(i)==zero)cycle
480 j1=ix1(i)
481 a(1,j1)=a(1,j1)+fx1(i)
482 a(2,j1)=a(2,j1)+fy1(i)
483 a(3,j1)=a(3,j1)+fz1(i)
484 stifn(j1) = stifn(j1) + stif(i)*abs(h1(i))
485C
486 j1=ix2(i)
487 a(1,j1)=a(1,j1)+fx2(i)
488 a(2,j1)=a(2,j1)+fy2(i)
489 a(3,j1)=a(3,j1)+fz2(i)
490 stifn(j1) = stifn(j1) + stif(i)*abs(h2(i))
491C
492 j1=ix3(i)
493 a(1,j1)=a(1,j1)+fx3(i)
494 a(2,j1)=a(2,j1)+fy3(i)
495 a(3,j1)=a(3,j1)+fz3(i)
496 stifn(j1) = stifn(j1) + stif(i)*abs(h3(i))
497C
498 j1=ix4(i)
499 a(1,j1)=a(1,j1)+fx4(i)
500 a(2,j1)=a(2,j1)+fy4(i)
501 a(3,j1)=a(3,j1)+fz4(i)
502 stifn(j1) = stifn(j1) + stif(i)*abs(h4(i))
503 ENDDO
504 ENDIF ! NPINCH > 0
505 ELSE
506 DO i=1,jlt
507 hh(i)=h1(i)+h2(i)+h3(i)+h4(i)
508 IF(hh(i)==zero)cycle
509 j1=ix1(i)
510 a(1,j1)=a(1,j1)+fx1(i)
511 a(2,j1)=a(2,j1)+fy1(i)
512 a(3,j1)=a(3,j1)+fz1(i)
513 stifn(j1) = stifn(j1) + stif(i)*abs(h1(i))
514 fthe(j1) = fthe(j1) + phi1(i)
515 IF(nodadt_therm == 1.AND.iform > 0 ) condn(j1) = condn(j1) + condint(i)*abs(h1(i))
516C
517 j1=ix2(i)
518 a(1,j1)=a(1,j1)+fx2(i)
519 a(2,j1)=a(2,j1)+fy2(i)
520 a(3,j1)=a(3,j1)+fz2(i)
521 stifn(j1) = stifn(j1) + stif(i)*abs(h2(i))
522 fthe(j1) = fthe(j1) + phi2(i)
523 IF(nodadt_therm == 1.AND.iform > 0 ) condn(j1) = condn(j1) + condint(i)*abs(h2(i))
524C
525 j1=ix3(i)
526 a(1,j1)=a(1,j1)+fx3(i)
527 a(2,j1)=a(2,j1)+fy3(i)
528 a(3,j1)=a(3,j1)+fz3(i)
529 stifn(j1) = stifn(j1) + stif(i)*abs(h3(i))
530 fthe(j1) = fthe(j1) + phi3(i)
531 IF(nodadt_therm == 1.AND.iform > 0 ) condn(j1) = condn(j1) + condint(i)*abs(h3(i))
532C
533 j1=ix4(i)
534 a(1,j1)=a(1,j1)+fx4(i)
535 a(2,j1)=a(2,j1)+fy4(i)
536 a(3,j1)=a(3,j1)+fz4(i)
537 stifn(j1) = stifn(j1) + stif(i)*abs(h4(i))
538 fthe(j1) = fthe(j1) + phi4(i)
539 IF(nodadt_therm == 1.AND.iform > 0 ) condn(j1) = condn(j1) + condint(i)*abs(h4(i))
540 ENDDO
541 ENDIF
542C
543 nodfi = nlskyfi(nin)
544 ishift = nodfi*(jtask-1)
545 IF(intth == 0 ) THEN
546 DO i=1,jlt
547 IF(hh(i)==zero)cycle
548 ig=nsvg(i)
549 IF(ig>0)THEN
550 a(1,ig)=a(1,ig)-fxi(i)
551 a(2,ig)=a(2,ig)-fyi(i)
552 a(3,ig)=a(3,ig)-fzi(i)
553 stifn(ig) = stifn(ig) + stif(i)
554 ELSE
555 ig = -ig
556 afi(nin)%P(1,ig+ishift)=afi(nin)%P(1,ig+ishift)-fxi(i)
557 afi(nin)%P(2,ig+ishift)=afi(nin)%P(2,ig+ishift)-fyi(i)
558 afi(nin)%P(3,ig+ishift)=afi(nin)%P(3,ig+ishift)-fzi(i)
559 stnfi(nin)%P(ig+ishift)=stnfi(nin)%P(ig+ishift) + stif(i)
560 ENDIF
561 ENDDO
562C
563 ELSE
564 DO i=1,jlt
565 IF(hh(i)==zero)cycle
566 ig=nsvg(i)
567 IF(ig>0)THEN
568 a(1,ig)=a(1,ig)-fxi(i)
569 a(2,ig)=a(2,ig)-fyi(i)
570 a(3,ig)=a(3,ig)-fzi(i)
571 stifn(ig) = stifn(ig) + stif(i)
572 fthe(ig)=fthe(ig) + phi(i)
573 IF(nodadt_therm == 1) condn(ig) = condn(ig) + condint(i)
574 ELSE
575 ig = -ig
576 afi(nin)%P(1,ig+ishift)=afi(nin)%P(1,ig+ishift)-fxi(i)
577 afi(nin)%P(2,ig+ishift)=afi(nin)%P(2,ig+ishift)-fyi(i)
578 afi(nin)%P(3,ig+ishift)=afi(nin)%P(3,ig+ishift)-fzi(i)
579 stnfi(nin)%P(ig+ishift)=stnfi(nin)%P(ig+ishift) + stif(i)
580 fthefi(nin)%P(ig+ishift)= fthefi(nin)%P(ig+ishift) + phi(i)
581 IF(nodadt_therm == 1) condnfi(nin)%P(ig+ishift)=condnfi(nin)%P(ig+ishift) + condint(i)
582 ENDIF
583 ENDDO
584 ENDIF
585C
586 RETURN
587 END
588
my_real
#define my_real
Definition cppsort.cpp:32
i25ass0
subroutine i25ass0(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, a, stifn, nin, intth, phi, fthe, phi1, phi2, phi3, phi4, jtask, apinch, stifpinch, msegtyp, ce_loc, fni, n1, n2, n3, iform, condint, condn, nodadt_therm)
Definition i25ass3.F:381
i25ass3
subroutine i25ass3(jlt, nsvg, itab, ce_loc, jtask, nin, noint, intply, a, stif, stifn, niskyfi, fskyi, isky, n1, n2, n3, h1, h2, h3, h4, ix1, ix2, ix3, ix4, intth, fthe, ftheskyi, phi, phi1, phi2, phi3, phi4, fni, msegtyp, apinch, stifpinch, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, iform, condint, condn, condnskyi, nodadt_therm)
Definition i25ass3.F:46
i25ass2
subroutine i25ass2(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, fskyi, isky, niskyfi, nin, noint, intth, phi, ftheskyi, intply, phi1, phi2, phi3, phi4, itab, iform, condint, condnskyi, nodadt_therm)
Definition i25ass3.F:137
message_mod
Definition message_mod.F:1249
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::npinch
integer npinch
Definition pinchtype_mod.F:73
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::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