OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_rbe3.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!||====================================================================
25!|| sms_rbe3_nodxi ../engine/source/ams/sms_rbe3.F
26!||--- called by ------------------------------------------------------
27!|| sms_build_diag ../engine/source/ams/sms_build_diag.F
28!||--- calls -----------------------------------------------------
29!|| prerbe3 ../engine/source/constraints/general/rbe3/rbe3f.F
30!|| spmd_exch_rbe3_nodnx ../engine/source/mpi/ams/spmd_sms.F
31!|| spmd_max_ii ../engine/source/mpi/implicit/imp_spmd.F
32!||====================================================================
33 SUBROUTINE sms_rbe3_nodxi(
34 1 IRBE3 ,LRBE3 ,NODXI_SMS,IAD_M ,FR_M )
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39#include "comlock.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com01_c.inc"
44#include "com04_c.inc"
45#include "param_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER IRBE3(NRBE3L,*),LRBE3(*),NODXI_SMS(*), IAD_M(*), FR_M(*)
50C REAL
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER N, I, M, JT(3,NRBE3), JR(3,NRBE3), IAD, NS, NML, FIN,
55 . finfin, icom, irotg, max_m
56C-----------------------------------------------
57 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
58 icom = iad_m(nspmd+1)-iad_m(1)
59c IF (NSPMD>1)CALL SPMD_MAX_II(IROTG,IAD_M,ICOM)
60C-----
61C when a secnd node belongs to a domain, all main nodes also belong to the domain !!!
62C-----
63 finfin=0
64 DO WHILE(finfin==0)
65 finfin=1
66C
67C going up
68 fin=0
69 DO WHILE(fin==0)
70 fin=1
71 DO n=1,nrbe3
72 iad = irbe3(1,n)
73 ns = irbe3(3,n)
74 IF (ns==0) cycle
75 nml = irbe3(5,n)
76 IF(jt(1,n)+jt(2,n)+jt(3,n)/=0)THEN
77 DO i=1,nml
78 m = lrbe3(iad+i)
79 IF(nodxi_sms(ns)/=0.AND.nodxi_sms(m)==0) THEN
80 nodxi_sms(m)=1
81 fin=0
82 END IF
83 ENDDO
84 END IF
85 END DO
86 END DO
87C
88 IF (icom>0) THEN
89 CALL spmd_exch_rbe3_nodnx(
90 1 nodxi_sms,fr_m ,iad_m ,iad_m(nspmd+1) )
91 END IF
92C
93C going down
94 fin=0
95 DO WHILE(fin==0)
96 fin=1
97 DO n=1,nrbe3
98 iad = irbe3(1,n)
99 ns = irbe3(3,n)
100 IF (ns==0) cycle
101 nml = irbe3(5,n)
102 IF(jt(1,n)+jt(2,n)+jt(3,n)/=0)THEN
103 DO i=1,nml
104 m = lrbe3(iad+i)
105 IF(nodxi_sms(m)/=0.AND.nodxi_sms(ns)==0) THEN
106 nodxi_sms(ns)=1
107 fin=0
108C
109C a climb-up is still needed
110 finfin=0
111 EXIT
112 END IF
113 ENDDO
114 END IF
115 END DO
116 END DO
117C
118 IF (nspmd>1)CALL spmd_max_ii(finfin,iad_m,icom)
119 END DO ! DO WHILE(FINFIN==0)
120C
121 RETURN
122 END
123
124!||====================================================================
125!|| sms_rbe3t1 ../engine/source/ams/sms_rbe3.F
126!||--- called by ------------------------------------------------------
127!|| sms_encin_2 ../engine/source/ams/sms_encin_2.F
128!|| sms_mass_scale_2 ../engine/source/ams/sms_mass_scale_2.F
129!|| sms_pcg ../engine/source/ams/sms_pcg.F
130!||--- calls -----------------------------------------------------
131!|| foat_to_6_float ../engine/source/system/parit.F
132!|| prerbe3 ../engine/source/constraints/general/rbe3/rbe3f.F
133!|| prerbe3p ../engine/source/constraints/general/rbe3/rbe3f.F
134!|| sms_rbe3_1 ../engine/source/ams/sms_rbe3.F
135!|| sms_rbe3_2 ../engine/source/ams/sms_rbe3.F
136!|| spmd_exch_rbe3_a_pon ../engine/source/mpi/kinematic_conditions/spmd_exch_rbe3_a_pon.f
137!|| zero1 ../engine/source/system/zero.F
138!||====================================================================
139 SUBROUTINE sms_rbe3t1(
140 1 IRBE3 ,LRBE3 ,X ,A ,FRBE3 ,
141 2 SKEW ,WEIGHT ,IAD_M ,FR_M ,FR_MPON,
142 3 RSUM ,RSUM_PON ,R3SIZE)
143C-----------------------------------------------
144C I m p l i c i t T y p e s
145C-----------------------------------------------
146#include "implicit_f.inc"
147C-----------------------------------------------
148C C o m m o n B l o c k s
149C-----------------------------------------------
150#include "com01_c.inc"
151#include "com04_c.inc"
152#include "param_c.inc"
153#include "tabsiz_c.inc"
154C-----------------------------------------------
155C D u m m y A r g u m e n t s
156C-----------------------------------------------
157 INTEGER IRBE3(NRBE3L,*), LRBE3(*), WEIGHT(*), IAD_M(*), FR_M(*),
158 . FR_MPON(*),R3SIZE
159 my_real
160 . X(3,*), A(3,*), FRBE3(*), SKEW(*), RSUM(*)
161 double precision
162 . rsum_pon(*)
163C-----------------------------------------------
164C L o c a l V a r i a b l e s
165C-----------------------------------------------
166 INTEGER I, J, N, MAX_M,IROTG,JT(3,NRBE3),JR(3,NRBE3),IERR,NMT,
167 . IADA,IADMS,IADFN,IADAR,IADIN,IADFR,IADM0,IADI0,IADL,
168 . IPA,IPMS,IPFN,IPAR,IPIN,IPFR,NMP,IADLP,NS,NML,ICOM,
169 . IADLP1,IADM1,IADI1,NMT0,IADMP(SLRBE3/2),IML(SLRBE3/2),
170 . isize
171C REAL
172C------------allacation will be removed to ini_ uniforming smp spmd in v11
173C my_real
174C . , DIMENSION(:), ALLOCATABLE :: RSUM
175C DOUBLE PRECISION
176C . , DIMENSION(:), ALLOCATABLE :: RSUM_PON
177C======================================================================|
178 nmt0 = slrbe3/2
179 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
180 icom = iad_m(nspmd+1)-iad_m(1)
181c IF (NSPMD>1)CALL SPMD_MAX_II(IROTG,IAD_M,ICOM)
182 IF (r3size>5)irotg = 1
183C
184 IF (nmt0>0) THEN
185 CALL prerbe3p(irbe3 ,lrbe3 ,iadmp ,iml , nmt )
186 iada=1
187 iadms=iada+3*nmt
188 iadfn=iadms+nmt
189 IF (irotg>0) THEN
190 iadar=iadfn+nmt
191 iadin=iadar+3*nmt
192 iadfr=iadin+nmt
193 ELSE
194 iadar=iadfn
195 iadin=iadar
196 iadfr=iadin
197 ENDIF
198 iadl=iadfr+nmt
199C
200C ALLOCATE(RSUM(IADL),STAT=IERR)
201 CALL zero1(rsum,iadl)
202 CALL sms_rbe3_1(
203 1 irbe3 ,lrbe3 ,x ,a ,frbe3 ,
204 2 skew ,weight,jt ,irotg ,max_m ,
205 3 rsum(iada),nmt0 ,iadmp )
206C
207 nmp = 6*nmt
208 ipa=1
209 ipms=ipa+3*nmp
210 ipfn=ipms+nmp
211 IF (irotg>0) THEN
212 ipar=ipfn+nmp
213 ipin=ipar+3*nmp
214 ipfr=ipin+nmp
215 ELSE
216 ipar=ipfn
217 ipin=ipar
218 ipfr=ipin
219 ENDIF
220 iadlp=ipfr+nmp
221C version spmd p/on
222C ALLOCATE(RSUM_PON(IADLP),STAT=IERR)
223C RSUM_PON=ZERO
224 CALL foat_to_6_float(1 ,nmt*3 ,rsum(iada) ,rsum_pon(ipa) )
225 IF (icom>0) THEN
226 isize=3
227 CALL spmd_exch_rbe3_a_pon(
228 . rsum_pon(ipa),fr_mpon,iad_m ,iad_m(nspmd+1),isize)
229 ENDIF
230C
231C Routine assemblage parith/ON
232C
233 CALL sms_rbe3_2(irbe3 ,lrbe3 ,a ,weight,rsum_pon(ipa),
234 2 nmt ,iml ,jt )
235C DEALLOCATE(RSUM_PON)
236C
237C DEALLOCATE(RSUM)
238 END IF ! IF (NMT>0)
239C---
240 RETURN
241 END
242
243!||====================================================================
244!|| sms_rbe3t2 ../engine/source/ams/sms_rbe3.F
245!||--- called by ------------------------------------------------------
246!|| sms_pcg ../engine/source/ams/sms_pcg.F
247!||--- calls -----------------------------------------------------
248!|| prerbe3 ../engine/source/constraints/general/rbe3/rbe3f.F
249!|| prerbe3p ../engine/source/constraints/general/rbe3/rbe3f.F
250!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
251!||====================================================================
252 SUBROUTINE sms_rbe3t2(IRBE3 ,LRBE3 ,X ,A ,FRBE3 ,
253 2 SKEW ,R ,PREC_SMS3)
254C-----------------------------------------------
255C I m p l i c i t T y p e s
256C-----------------------------------------------
257#include "implicit_f.inc"
258C-----------------------------------------------
259C C o m m o n B l o c k s
260C-----------------------------------------------
261#include "com01_c.inc"
262#include "com04_c.inc"
263#include "param_c.inc"
264#include "tabsiz_c.inc"
265C-----------------------------------------------
266C D u m m y A r g u m e n t s
267C-----------------------------------------------
268 INTEGER IRBE3(NRBE3L,*),LRBE3(*)
269C REAL
270 my_real
271 . X(3,*), A(3,*), FRBE3(*), SKEW(*), R(3,*), PREC_SMS3(3,*)
272C-----------------------------------------------
273C L o c a l V a r i a b l e s
274C-----------------------------------------------
275 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
276 . JT(3,NRBE3),JR(3,NRBE3),NM,NN,K,
277 . NMT,NMT0,IADMP(SLRBE3/2),IML(SLRBE3/2)
278C REAL
279 my_real
280 . as(3)
281 my_real,
282 . DIMENSION(:,:,:),ALLOCATABLE :: fdstnb ,mdstnb
283C======================================================================|
284 iads = slrbe3/2
285 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
286 ALLOCATE(fdstnb(3,6,max_m))
287 IF (irotg>0) ALLOCATE(mdstnb(3,6,max_m))
288C
289 nmt0 = slrbe3/2
290 IF (nmt0>0) THEN
291 CALL prerbe3p(irbe3 ,lrbe3 ,iadmp ,iml , nmt )
292 DO i=1,nmt
293 m = iml(i)
294 a(1,m)=r(1,m)*prec_sms3(1,m)
295 a(2,m)=r(2,m)*prec_sms3(2,m)
296 a(3,m)=r(3,m)*prec_sms3(3,m)
297 END DO
298 END IF
299C
300 DO n=1,nrbe3
301 iad = irbe3(1,n)
302 ns = irbe3(3,n)
303 IF (ns==0) cycle
304 nml = irbe3(5,n)
305 irot =min(irbe3(6,n),iroddl)
306 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
307 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
308 . mdstnb ,irbe3(2,n))
309 DO j = 1,3
310 as(j) = zero
311 ENDDO
312 DO i=1,nml
313 m = lrbe3(iad+i)
314 DO j = 1,3
315 DO k = 1,3
316 as(j) = as(j)+fdstnb(k,j,i)*a(k,m)
317 ENDDO
318 ENDDO
319 ENDDO
320 DO j = 1,3
321 a(j,ns) = as(j) *jt(j,n)
322 ENDDO
323 ENDDO
324C
325 DEALLOCATE(fdstnb)
326 IF (irotg>0) DEALLOCATE(mdstnb)
327C---
328 RETURN
329 END
330
331
332!||====================================================================
333!|| sms_rbe3_prec ../engine/source/ams/sms_rbe3.F
334!||--- called by ------------------------------------------------------
335!|| sms_pcg ../engine/source/ams/sms_pcg.f
336!||--- calls -----------------------------------------------------
337!|| foat_to_6_float ../engine/source/system/parit.F
338!|| prerbe3 ../engine/source/constraints/general/rbe3/rbe3f.F
339!|| prerbe3p ../engine/source/constraints/general/rbe3/rbe3f.f
340!|| sms_rbe3_1 ../engine/source/ams/sms_rbe3.F
341!|| sms_rbe3_3 ../engine/source/ams/sms_rbe3.F
342!|| spmd_exch_rbe3_a_pon ../engine/source/mpi/kinematic_conditions/spmd_exch_rbe3_a_pon.F
343!|| zero1 ../engine/source/system/zero.F
344!||====================================================================
345 SUBROUTINE sms_rbe3_prec(
346 1 IRBE3 ,LRBE3 ,X ,DIAG_SMS,DIAG_SMS3,
347 2 FRBE3 ,SKEW ,WEIGHT ,IAD_M ,FR_M ,
348 3 FR_MPON,RSUM ,RSUM_PON ,R3SIZE)
349C-----------------------------------------------
350C I m p l i c i t T y p e s
351C-----------------------------------------------
352#include "implicit_f.inc"
353C-----------------------------------------------
354C C o m m o n B l o c k s
355C-----------------------------------------------
356#include "com01_c.inc"
357#include "com04_c.inc"
358#include "param_c.inc"
359#include "tabsiz_c.inc"
360C-----------------------------------------------
361C D u m m y A r g u m e n t s
362C-----------------------------------------------
363 INTEGER IRBE3(NRBE3L,*), LRBE3(*), WEIGHT(*), IAD_M(*), FR_M(*),
364 . FR_MPON(*),R3SIZE
365C REAL
366 my_real
367 . X(3,*), DIAG_SMS(*), DIAG_SMS3(*), FRBE3(*), SKEW(*), RSUM(*)
368 DOUBLE PRECISION
369 . RSUM_PON(*)
370C-----------------------------------------------
371C L o c a l V a r i a b l e s
372C-----------------------------------------------
373 INTEGER I, J, N, MAX_M,IROTG,JT(3,NRBE3),JR(3,NRBE3),IERR,NMT,
374 . iada,iadms,iadfn,iadar,iadin,iadfr,iadm0,iadi0,iadl,
375 . ipa,ipms,ipfn,ipar,ipin,ipfr,nmp,iadlp,ns,nml,icom,
376 . iadlp1,iadm1,iadi1,nmt0,iadmp(slrbe3/2),iml(slrbe3/2),
377 . isize
378C REAL
379C------------allacation will be removed to ini_ uniforming smp spmd in v11
380C my_real
381C . , DIMENSION(:), ALLOCATABLE :: RSUM
382C DOUBLE PRECISION
383C . , DIMENSION(:), ALLOCATABLE :: RSUM_PON
384C======================================================================|
385 nmt0 = slrbe3/2
386 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
387 icom = iad_m(nspmd+1)-iad_m(1)
388c IF (NSPMD>1)CALL SPMD_MAX_II(IROTG,IAD_M,ICOM)
389 IF (r3size>5)irotg = 1
390C
391 IF (nmt0>0) THEN
392 CALL prerbe3p(irbe3 ,lrbe3 ,iadmp ,iml , nmt )
393 iada=1
394 iadms=iada+3*nmt
395 iadfn=iadms+nmt
396 IF (irotg>0) THEN
397 iadar=iadfn+nmt
398 iadin=iadar+3*nmt
399 iadfr=iadin+nmt
400 ELSE
401 iadar=iadfn
402 iadin=iadar
403 iadfr=iadin
404 ENDIF
405 iadl=iadfr+nmt
406C
407C ALLOCATE(RSUM(IADL),STAT=IERR)
408 CALL zero1(rsum,iadl)
409 CALL sms_rbe3_1(
410 1 irbe3 ,lrbe3 ,x ,diag_sms3,frbe3 ,
411 2 skew ,weight,jt ,irotg ,max_m ,
412 3 rsum(iada),nmt0 ,iadmp )
413C
414 nmp = 6*nmt
415 ipa=1
416 ipms=ipa+3*nmp
417 ipfn=ipms+nmp
418 IF (irotg>0) THEN
419 ipar=ipfn+nmp
420 ipin=ipar+3*nmp
421 ipfr=ipin+nmp
422 ELSE
423 ipar=ipfn
424 ipin=ipar
425 ipfr=ipin
426 ENDIF
427 iadlp=ipfr+nmp
428C version spmd p/on
429C ALLOCATE(RSUM_PON(IADLP),STAT=IERR)
430C RSUM_PON=ZERO
431 CALL foat_to_6_float(1 ,nmt*3 ,rsum(iada) ,rsum_pon(ipa) )
432 IF (icom>0) THEN
433 isize=3
434 CALL spmd_exch_rbe3_a_pon(
435 . rsum_pon(ipa),fr_mpon,iad_m ,iad_m(nspmd+1),isize)
436 ENDIF
437C
438C Routine assemblage parith/ON
439C
440 CALL sms_rbe3_3(irbe3 ,lrbe3 ,diag_sms3,weight,rsum_pon(ipa),
441 2 nmt ,iml ,jt )
442C DEALLOCATE(RSUM_PON)
443C
444C DEALLOCATE(RSUM)
445 END IF ! IF (NMT>0)
446C---
447 RETURN
448 END
449
450!||====================================================================
451!|| sms_rbe3_1 ../engine/source/ams/sms_rbe3.F
452!||--- called by ------------------------------------------------------
453!|| sms_rbe3_prec ../engine/source/ams/sms_rbe3.F
454!|| sms_rbe3t1 ../engine/source/ams/sms_rbe3.F
455!||--- calls -----------------------------------------------------
456!|| mfac_rbe3 ../engine/source/constraints/general/rbe3/rbe3f.f
457!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
458!||====================================================================
459 SUBROUTINE sms_rbe3_1(
460 1 IRBE3 ,LRBE3 ,X ,A ,FRBE3 ,
461 2 SKEW ,WEIGHT,JT ,IROTG ,MAX_M ,
462 3 AM ,NMT0 ,IADMP )
463C-----------------------------------------------
464C I m p l i c i t T y p e s
465C-----------------------------------------------
466#include "implicit_f.inc"
467C-----------------------------------------------
468C C o m m o n B l o c k s
469C-----------------------------------------------
470#include "com04_c.inc"
471#include "param_c.inc"
472C-----------------------------------------------
473C D u m m y A r g u m e n t s
474C-----------------------------------------------
475 INTEGER IRBE3(NRBE3L,*),LRBE3(*),WEIGHT(*)
476 INTEGER MAX_M,IROTG,JT(3,*),NMT0,IADMP(*)
477C REAL
478 my_real
479 . X(3,*), A(3,*), FRBE3(*),SKEW(*), AM(3,*)
480C-----------------------------------------------
481C L o c a l V a r i a b l e s
482C-----------------------------------------------
483 INTEGER I, J, N, NS ,NML, IAD, IROT, IADS, NN, K
484C REAL
485 my_real
486 . fns(3), sfd, smd
487C REAL
488 my_real,
489 . DIMENSION(:,:,:),ALLOCATABLE :: fdstnb ,mdstnb
490C-----------------------------------------------
491 iads = nmt0
492 ALLOCATE(fdstnb(3,6,max_m))
493 IF (irotg>0) ALLOCATE(mdstnb(3,6,max_m))
494C---
495 DO n=1,nrbe3
496 iad = irbe3(1,n)
497 ns = irbe3(3,n)
498 nml = irbe3(5,n)
499 irot =irbe3(6,n)
500 IF (ns>0) THEN
501 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
502 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
503 . mdstnb ,irbe3(2,n))
504
505 DO j = 1,3
506 nn = jt(j,n)*weight(ns)
507 fns(j) = a(j,ns)*nn
508 ENDDO
509C---not to add supplementary mass globally
510 CALL mfac_rbe3(fdstnb,mdstnb,nml ,irotg,sfd ,smd)
511 DO i=1,nml
512 k = iadmp(iad+i)
513 DO j = 1,3
514 am(1,k) = am(1,k)+fdstnb(1,j,i)*fns(j)
515 am(2,k) = am(2,k)+fdstnb(2,j,i)*fns(j)
516 am(3,k) = am(3,k)+fdstnb(3,j,i)*fns(j)
517 ENDDO
518 ENDDO
519C---
520 END IF ! IF (ns>0) THEN
521 ENDDO
522C
523 DEALLOCATE(fdstnb)
524 IF (irotg>0) DEALLOCATE(mdstnb)
525C
526 RETURN
527 END
528
529!||====================================================================
530!|| sms_rbe3_2 ../engine/source/ams/sms_rbe3.F
531!||--- called by ------------------------------------------------------
532!|| sms_rbe3t1 ../engine/source/ams/sms_rbe3.F
533!||====================================================================
534 SUBROUTINE sms_rbe3_2(IRBE3 ,LRBE3 ,A ,WEIGHT,DA ,
535 2 NMT ,IML ,JT )
536C-----------------------------------------------
537C I m p l i c i t T y p e s
538C-----------------------------------------------
539#include "implicit_f.inc"
540C-----------------------------------------------
541C C o m m o n B l o c k s
542C-----------------------------------------------
543#include "com04_c.inc"
544#include "param_c.inc"
545C-----------------------------------------------
546C D u m m y A r g u m e n t s
547C-----------------------------------------------
548 INTEGER IRBE3(NRBE3L,*),LRBE3(*),WEIGHT(*),IML(*) ,NMT,
549 . JT(3,NRBE3)
550C REAL
551 my_real
552 . A(3,*)
553 DOUBLE PRECISION
554 . DA(6,3,*)
555C-----------------------------------------------
556C L o c a l V a r i a b l e s
557C-----------------------------------------------
558 INTEGER I, J, M, N, NS
559C REAL
560 my_real
561 . ax,ay,az
562C======================================================================|
563#include "vectorize.inc"
564 DO i=1,nmt
565 m = iml(i)
566 ax = zero
567 ay = zero
568 az = zero
569 DO j=1,6
570 ax = ax + da(j,1,i)
571 ay = ay + da(j,2,i)
572 az = az + da(j,3,i)
573 END DO
574 a(1,m) = a(1,m)+ ax
575 a(2,m) = a(2,m)+ ay
576 a(3,m) = a(3,m)+ az
577 END DO
578C---
579 DO n=1,nrbe3
580 ns = irbe3(3,n)
581 IF(ns/=0)THEN
582C Reset residu for secnd node
583 DO j = 1,3
584 IF(jt(j,n)/=0)a(j,ns)=zero
585 END DO
586 END IF
587 END DO
588C---
589 RETURN
590 END
591
592!||====================================================================
593!|| sms_rbe3_3 ../engine/source/ams/sms_rbe3.F
594!||--- called by ------------------------------------------------------
595!|| sms_rbe3_prec ../engine/source/ams/sms_rbe3.F
596!||====================================================================
597 SUBROUTINE sms_rbe3_3(IRBE3 ,LRBE3 ,DIAG_SMS3,WEIGHT,DA ,
598 2 NMT ,IML ,JT )
599C-----------------------------------------------
600C I m p l i c i t T y p e s
601C-----------------------------------------------
602#include "implicit_f.inc"
603C-----------------------------------------------
604C C o m m o n B l o c k s
605C-----------------------------------------------
606#include "com04_c.inc"
607#include "param_c.inc"
608C-----------------------------------------------
609C D u m m y A r g u m e n t s
610C-----------------------------------------------
611 INTEGER IRBE3(NRBE3L,*),LRBE3(*),WEIGHT(*),IML(*) ,NMT, JT(3,NRBE3)
612 my_real DIAG_SMS3(3,*)
613 DOUBLE PRECISION DA(6,3,*)
614C-----------------------------------------------
615C L o c a l V a r i a b l e s
616C-----------------------------------------------
617 INTEGER I, J, K, M, N, NS
618C REAL
619 my_real
620 . DD
621C======================================================================|
622#include "vectorize.inc"
623 DO I=1,nmt
624 m = iml(i)
625 DO j=1,3
626 dd=diag_sms3(j,m)
627 DO k=1,6
628 dd = dd + da(k,j,i)
629 END DO
630 diag_sms3(j,m) = dd
631 END DO
632 END DO
633C---
634 RETURN
635 END
zero1
subroutine zero1(r, n)
Definition hm_read_rbe3.F:1481
spmd_max_ii
subroutine spmd_max_ii(nmax, iad_elem, tsize)
Definition imp_spmd.F:4810
rbe3cl
subroutine rbe3cl(inrbe3, ilrbe3, ns, xyz, frbe3, skew, ng, irot, fdstnb, mdstnb)
Definition kinchk.F:1586
prerbe3
subroutine prerbe3(irbe3, max_m, irotg, jt, jr)
Definition kinchk.F:1494
min
#define min(a, b)
Definition macros.h:20
foat_to_6_float
subroutine foat_to_6_float(jft, jlt, f, f6)
Definition parit.F:225
prerbe3p
subroutine prerbe3p(irbe3, lrbe3, ad_m, iml, nmt)
Definition rbe3f.F:1983
rbe3f
subroutine rbe3f(irbe3, lrbe3, x, a, ar, ms, in, frbe3, skew, weight, stifn, stifr, jt, jr, irotg, max_m, am, arm, msm, inm, stifnm, stifrm, nmt0, iadmp, pen, v, vr, nmt, dt1, iroddl)
Definition rbe3f.F:280
mfac_rbe3
subroutine mfac_rbe3(fdstnb, mdstnb, nml, irot, sf, sm)
Definition rbe3f.F:2104
sms_pcg
subroutine sms_pcg(timers, nodft, nodlt, nnz, iadk, jdik, diag_sms, lt_k, r, isp, x_sms, p_sms, z_sms, y_sms, prec_sms, nodft1_sms, nodlt1_sms, indx1_sms, icodt, icodr, iskew, skew, itask, nodnx_sms, iad_elem, fr_elem, weight, ibfv, vel, npc, tf, v, x, d, sensor_tab, iframe, xframe, jadi_sms, jdii_sms, nsensor, lti_sms, fr_sms, fr_rms, list_sms, list_rms, mskyi_fi_sms, vfi, iskyi_sms, mskyi_sms, res_sms, ilink, llink, fr_rl, frl6, nnlink, lnlink, fr_ll, fnl6, ms, tag_lnk_sms, itab, fsav, ljoint, iadcj, fr_cj, cjwork, frl, fnl, nprw, lprw, rwbuf, rwsav, fopt, fr_wall, irwl_work, nrwl_sms, frea, intstamp, imv, mv, mv6, mw6, kinet, ixc, ixtg, sh4tree, sh3tree, cptreac, nodreac, fthreac, frwl6, am, vr, dr, in, rby, npby, lpby, tagmsr_rby_sms, irbe2, lrbe2, iad_rbe2, fr_rbe2m, nmrbe2, r2size, irbe3, lrbe3, frbe3, iad_rbe3m, fr_rbe3m, fr_rbe3mp, rrbe3, rrbe3_pon, prec_sms3, diag_sms3, iad_rby, fr_rby6, rby6, tagslv_rby_sms, r3size, nodft2_sms, nodlt2_sms, indx2_sms, nodii_sms, ibcscyc, lbcscyc, wfext, ams_work)
Definition sms_pcg.F:92
sms_rbe3_nodxi
subroutine sms_rbe3_nodxi(irbe3, lrbe3, nodxi_sms, iad_m, fr_m)
Definition sms_rbe3.F:35
sms_rbe3t2
subroutine sms_rbe3t2(irbe3, lrbe3, x, a, frbe3, skew, r, prec_sms3)
Definition sms_rbe3.F:254
sms_rbe3_3
subroutine sms_rbe3_3(irbe3, lrbe3, diag_sms3, weight, da, nmt, iml, jt)
Definition sms_rbe3.F:599
sms_rbe3_prec
subroutine sms_rbe3_prec(irbe3, lrbe3, x, diag_sms, diag_sms3, frbe3, skew, weight, iad_m, fr_m, fr_mpon, rsum, rsum_pon, r3size)
Definition sms_rbe3.F:349
sms_rbe3t1
subroutine sms_rbe3t1(irbe3, lrbe3, x, a, frbe3, skew, weight, iad_m, fr_m, fr_mpon, rsum, rsum_pon, r3size)
Definition sms_rbe3.F:143
sms_rbe3_1
subroutine sms_rbe3_1(irbe3, lrbe3, x, a, frbe3, skew, weight, jt, irotg, max_m, am, nmt0, iadmp)
Definition sms_rbe3.F:463
sms_rbe3_2
subroutine sms_rbe3_2(irbe3, lrbe3, a, weight, da, nmt, iml, jt)
Definition sms_rbe3.F:536
spmd_exch_rbe3_a_pon
subroutine spmd_exch_rbe3_a_pon(a, fr_m, iad_m, lcomm, isize)
Definition spmd_exch_rbe3_a_pon.F:35
spmd_exch_rbe3_nodnx
subroutine spmd_exch_rbe3_nodnx(nodnx_sms, fr_m, iad_m, lcomm)
Definition spmd_sms.F:1256