OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rbe2f.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!|| rbe2t1 ../engine/source/constraints/general/rbe2/rbe2f.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| prerbe2 ../engine/source/constraints/general/rbe2/rbe2f.F
29!|| rbe2_s ../engine/source/constraints/general/rbe2/rbe2f.f
30!|| rbe2f ../engine/source/constraints/general/rbe2/rbe2f.f
31!|| rbe2fl ../engine/source/constraints/general/rbe2/rbe2f.F
32!|| spmd_exch_rbe2_pon ../engine/source/mpi/kinematic_conditions/spmd_exch_rbe2_pon.F
33!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
34!||====================================================================
35 SUBROUTINE rbe2t1(IRBE2 ,LRBE2 ,X ,A ,AR ,
36 1 MS ,IN ,SKEW ,WEIGHT ,IAD_RBE2,
37 2 FR_RBE2M,NMRBE2,STIFN ,STIFR ,R2SIZE)
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IRBE2(NRBE2L,*),LRBE2(*),WEIGHT(*),IAD_RBE2(*),
52 . FR_RBE2M(*) ,NMRBE2,R2SIZE
53C REAL
54 my_real
55 . stifn(*) ,stifr(*),x(3,*), a(3,*), ar(3,*),
56 . ms(*), in(*), skew(lskew,*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER J, N, JT(3,NRBE2),JR(3,NRBE2),IAD,
61 . ICOM,ISK,M,K,NSN,MID,NHI,IRAD
62C REAL
63 double precision
64 . frbe2m6(3,6,nmrbe2),mrbe2m6(3,6,nmrbe2),
65 . strbe2m6(6,nmrbe2),srrbe2m6(6,nmrbe2)
66C======================================================================|
67 CALL prerbe2(irbe2 ,jt ,jr )
68 icom = iad_rbe2(nspmd+1)-iad_rbe2(1)
69 IF (nspmd>1)CALL spmd_max_i(icom)
70 DO nhi=0,nhrbe2
71 DO n=1,nmrbe2
72 DO j=1,3
73 DO k=1,6
74 frbe2m6(j,k,n) = zero
75 mrbe2m6(j,k,n) = zero
76 END DO
77 END DO
78 DO k=1,6
79 strbe2m6(k,n) = zero
80 srrbe2m6(k,n) = zero
81 END DO
82 END DO
83c CALL RBE2_POFF(IRBE2 ,A ,AR ,MS ,IN ,
84c 1 STIFN ,STIFR ,WEIGHT,JR ,NHI )
85 DO n=1,nrbe2
86 IF (irbe2(9,n)/=nhi) cycle
87 iad = irbe2(1,n)
88 nsn = irbe2(5,n)
89 m = irbe2(3,n)
90 isk = irbe2(7,n)
91 mid = iabs(irbe2(6,n))
92 irad = irbe2(11,n)
93c print *,'iad,m,mid,ih=',iad,m,IRBE2(6,N),IRBE2(9,N)
94 IF (isk>1) THEN
95 CALL rbe2fl(nsn ,lrbe2(iad+1),x ,a ,ar ,
96 1 ms ,in ,weight,jt(1,n),jr(1,n),
97 2 frbe2m6(1,1,mid),mrbe2m6(1,1,mid),stifn ,stifr,
98 3 strbe2m6(1,mid),srrbe2m6(1,mid),m ,skew(1,isk),
99 4 irad )
100 ELSE
101 CALL rbe2f(nsn ,lrbe2(iad+1),x ,a ,ar ,
102 1 ms ,in ,weight,jt(1,n),jr(1,n),
103 2 frbe2m6(1,1,mid),mrbe2m6(1,1,mid),stifn ,stifr,
104 3 strbe2m6(1,mid),srrbe2m6(1,mid),m ,irad )
105 END IF
106 END DO
107C-----------------
108 IF (icom>0) THEN
109 CALL spmd_exch_rbe2_pon(
110 . frbe2m6 ,mrbe2m6 ,strbe2m6 ,srrbe2m6 ,iad_rbe2,
111 . fr_rbe2m,iad_rbe2(nspmd+1),r2size)
112 ENDIF
113C
114C Routine assemblage parith/ON
115C
116 CALL rbe2_s(irbe2 ,a ,ar ,ms ,in ,
117 1 stifn ,stifr ,weight ,frbe2m6,mrbe2m6,
118 2 strbe2m6,srrbe2m6,jr ,nmrbe2 ,nhi )
119C
120 END DO ! NHI=1,NHRBE2
121C---
122 RETURN
123 END
124!||====================================================================
125!|| rbe2f ../engine/source/constraints/general/rbe2/rbe2f.F
126!||--- called by ------------------------------------------------------
127!|| rbe2t1 ../engine/source/constraints/general/rbe2/rbe2f.F
128!||--- calls -----------------------------------------------------
129!|| foat_to_6_float ../engine/source/system/parit.F
130!||====================================================================
131 SUBROUTINE rbe2f(NSL ,ISL ,X ,A ,AR ,
132 1 MS ,IN ,WEIGHT,JT ,JR ,
133 2 F6 ,M6 ,STIFN ,STIFR ,STIF6 ,
134 3 STIR6 ,M ,IRAD )
135C-----------------------------------------------
136C I m p l i c i t T y p e s
137C-----------------------------------------------
138#include "implicit_f.inc"
139C-----------------------------------------------
140C D u m m y A r g u m e n t s
141C-----------------------------------------------
142 INTEGER NSL,ISL(*),WEIGHT(*),JT(3),JR(3),M,IRAD
143C REAL
144 my_real
145 . X(3,*), A(3,*), AR(3,*), MS(*), IN(*) ,STIFN(*) ,STIFR(*)
146 DOUBLE PRECISION
147 . f6(3,6), m6(3,6),stif6(6), stir6(6)
148C-----------------------------------------------
149C L o c a l V a r i a b l e s
150C-----------------------------------------------
151 INTEGER I, J, NS ,JTW(3),JRW(3),K,IJT,IJR
152C REAL
153 my_real
154 . RX, RY, RZ,AS(3,NSL),STIS(NSL),DD,FX,FY,FZ
155 DOUBLE PRECISION
156 . as6(6,3,nsl),stis6(6,nsl)
157C======================================================================|
158 IF ((jt(1)+jt(2)+jt(3))>0) THEN
159 ijt=1
160 ELSE
161 ijt=0
162 ENDIF
163 IF ((jr(1)+jr(2)+jr(3))>0) THEN
164 ijr=1
165 ELSE
166 ijr=0
167 ENDIF
168 DO i=1,nsl
169 ns = isl(i)
170 DO j=1,3
171 jtw(j) = jt(j)*weight(ns)
172 as(j,i) = a(j,ns)*jtw(j)
173 ENDDO
174 stis(i) = stifn(ns)*ijt*weight(ns)
175 ENDDO
176 CALL foat_to_6_float(1 ,nsl*3 ,as ,as6 )
177 CALL foat_to_6_float(1 ,nsl ,stis ,stis6 )
178c--- summ secnd forces pon
179 DO i=1,nsl
180 DO k=1,6
181 f6(1,k) = f6(1,k) + as6(k,1,i)
182 f6(2,k) = f6(2,k) + as6(k,2,i)
183 f6(3,k) = f6(3,k) + as6(k,3,i)
184 stif6(k) = stif6(k) + stis6(k,i)
185 ENDDO
186 ENDDO
187C-----------Nastran's formulation----
188 IF (irad==0) THEN
189 DO i=1,nsl
190 ns = isl(i)
191 DO j=1,3
192 jrw(j) = jr(j)*weight(ns)
193 jtw(j) = jt(j)*weight(ns)
194 ENDDO
195 rx = x(1,ns) - x(1,m)
196 ry = x(2,ns) - x(2,m)
197 rz = x(3,ns) - x(3,m)
198 fx = a(1,ns) *jtw(1)
199 fy = a(2,ns) *jtw(2)
200 fz = a(3,ns) *jtw(3)
201 as(1,i) = ar(1,ns)*jrw(1)+ ry*fz-rz*fy
202 as(2,i) = ar(2,ns)*jrw(2)+ rz*fx-rx*fz
203 as(3,i) = ar(3,ns)*jrw(3)+ rx*fy-ry*fx
204 dd = rx*rx+ry*ry+rz*rz
205 stis(i) = (stifr(ns)*ijr+stifn(ns)*dd*ijt)*weight(ns)
206 ENDDO
207 CALL foat_to_6_float(1 ,nsl*3 ,as ,as6 )
208 CALL foat_to_6_float(1 ,nsl ,stis ,stis6 )
209c--- summ secnd moments pon
210 DO i=1,nsl
211 DO k=1,6
212 m6(1,k) = m6(1,k)+as6(k,1,i)
213 m6(2,k) = m6(2,k)+as6(k,2,i)
214 m6(3,k) = m6(3,k)+as6(k,3,i)
215 stir6(k) = stir6(k) + stis6(k,i)
216 ENDDO
217 ENDDO
218 ELSEIF ((jr(1)+jr(2)+jr(3))>0) THEN
219 DO i=1,nsl
220 ns = isl(i)
221 DO j=1,3
222 jrw(j) = jr(j)*weight(ns)
223 ENDDO
224 rx = x(1,ns) - x(1,m)
225 ry = x(2,ns) - x(2,m)
226 rz = x(3,ns) - x(3,m)
227 as(1,i) = (ar(1,ns)+(ry*a(3,ns)-rz*a(2,ns)))*jrw(1)
228 as(2,i) = (ar(2,ns)+(rz*a(1,ns)-rx*a(3,ns)))*jrw(2)
229 as(3,i) = (ar(3,ns)+(rx*a(2,ns)-ry*a(1,ns)))*jrw(3)
230 dd = rx*rx+ry*ry+rz*rz
231 stis(i) = (stifr(ns)*ijr+stifn(ns)*dd*ijt)*weight(ns)
232 ENDDO
233 CALL foat_to_6_float(1 ,nsl*3 ,as ,as6 )
234 CALL foat_to_6_float(1 ,nsl ,stis ,stis6 )
235c--- summ secnd moments pon
236 DO i=1,nsl
237 DO k=1,6
238 m6(1,k) = m6(1,k)+as6(k,1,i)
239 m6(2,k) = m6(2,k)+as6(k,2,i)
240 m6(3,k) = m6(3,k)+as6(k,3,i)
241 stir6(k) = stir6(k) + stis6(k,i)
242 ENDDO
243 ENDDO
244 END IF
245C--- reset of secnd nodes forces is necessary w/AMS
246 IF(ijt/=0)THEN
247 DO i=1,nsl
248 ns = isl(i)
249 DO j=1,3
250 IF(jt(j)/=0)a(j,ns)=zero
251 ENDDO
252C--- partial depending dof will add more mass w/ /DT/NODA w.r.t. RBODY
253 IF ((jt(1)+jt(2)+jt(3))==3)stifn(ns)=em20
254 ENDDO
255 END IF
256 IF(ijr/=0)THEN
257 DO i=1,nsl
258 ns = isl(i)
259 DO j=1,3
260 IF(jr(j)/=0)ar(j,ns)=zero
261 ENDDO
262 IF ((jr(1)+jr(2)+jr(3))==3) stifr(ns)=em20
263 ENDDO
264 END IF
265C---
266 RETURN
267 END
268!||====================================================================
269!|| rbe2fl ../engine/source/constraints/general/rbe2/rbe2f.F
270!||--- called by ------------------------------------------------------
271!|| rbe2t1 ../engine/source/constraints/general/rbe2/rbe2f.F
272!||--- calls -----------------------------------------------------
273!|| cdi_bcn ../engine/source/constraints/general/rbe2/rbe2_imp0.F
274!|| cdi_bcn1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
275!|| foat_to_6_float ../engine/source/system/parit.F
276!|| rbe2flsn ../engine/source/constraints/general/rbe2/rbe2f.F
277!||====================================================================
278 SUBROUTINE rbe2fl(NSL ,ISL ,X ,A ,AR ,
279 1 MS ,IN ,WEIGHT,JT ,JR ,
280 2 F6 ,M6 ,STIFN ,STIFR ,STIF6 ,
281 3 STIR6 ,M ,SKEW ,IRAD )
282C-----------------------------------------------
283C I m p l i c i t T y p e s
284C-----------------------------------------------
285#include "implicit_f.inc"
286C-----------------------------------------------
287C D u m m y A r g u m e n t s
288C-----------------------------------------------
289 INTEGER NSL,ISL(*),WEIGHT(*),JT(3),JR(3),M,IRAD
290C REAL
291 my_real
292 . X(3,*), A(3,*), AR(3,*), MS(*),IN(*),SKEW(*),STIFN(*),STIFR(*)
293 DOUBLE PRECISION
294 . F6(3,6), M6(3,6),STIF6(6), STIR6(6)
295C-----------------------------------------------
296C L o c a l V a r i a b l e s
297C-----------------------------------------------
298 INTEGER I, J, NS ,K,IC,JT1(3),JR1(3),IJT,IJR,JJ
299C REAL
300 my_real
301 . rx, ry, rz,as(3,nsl),aar(3),las(3,nsl),
302 . stis(nsl),dd,cdt(9),cdr(9),cdtr(9),aa
303 double precision
304 . as6(6,3,nsl),stis6(6,nsl)
305C======================================================================|
306 ic = jt(1)*100+jt(2)*10+jt(3)
307 CALL cdi_bcn(ic ,skew ,jt ,cdt ,jt1 )
308 IF ((jt(1)+jt(2)+jt(3))>0) THEN
309 ijt=1
310 ELSE
311 ijt=0
312 ENDIF
313 IF ((jr(1)+jr(2)+jr(3))>0) THEN
314 ijr=1
315 ELSE
316 ijr=0
317 ENDIF
318 DO i=1,nsl
319 ns = isl(i)
320 rx = a(1,ns)*weight(ns)
321 ry = a(2,ns)*weight(ns)
322 rz = a(3,ns)*weight(ns)
323 as(1,i) = cdt(1)*rx+cdt(2)*ry+cdt(3)*rz
324 as(2,i) = cdt(4)*rx+cdt(5)*ry+cdt(6)*rz
325 as(3,i) = cdt(7)*rx+cdt(8)*ry+cdt(9)*rz
326 las(1,i) = rx
327 las(2,i) = ry
328 las(3,i) = rz
329 stis(i) = stifn(ns)*ijt*weight(ns)
330 ENDDO
331 CALL foat_to_6_float(1 ,nsl*3 ,as ,as6 )
332 CALL foat_to_6_float(1 ,nsl ,stis ,stis6 )
333c--- summ secnd forces pon
334 DO i=1,nsl
335 DO k=1,6
336 f6(1,k) = f6(1,k) + as6(k,1,i)
337 f6(2,k) = f6(2,k) + as6(k,2,i)
338 f6(3,k) = f6(3,k) + as6(k,3,i)
339 stif6(k) = stif6(k) + stis6(k,i)
340 ENDDO
341 ENDDO
342C--- NS components
343 IF (ic>0.AND.ic<111) THEN
344 CALL rbe2flsn(nsl ,isl ,a ,weight ,ic ,
345 1 skew )
346 END IF
347C---
348 IF (irad==0.OR.(jr(1)+jr(2)+jr(3))>0) THEN
349 ic = jr(1)*100+jr(2)*10+jr(3)
350 CALL cdi_bcn(ic ,skew ,jr ,cdr ,jr1 )
351 DO i=1,nsl
352 ns = isl(i)
353 rx = x(1,ns) - x(1,m)
354 ry = x(2,ns) - x(2,m)
355 rz = x(3,ns) - x(3,m)
356 CALL cdi_bcn1(rx,ry,rz,jt,jr,skew,cdtr,irad)
357 dd = rx*rx+ry*ry+rz*rz
358C
359 aar(1) = cdtr(1)*las(1,i)+cdtr(2)*las(2,i)+cdtr(3)*las(3,i)
360 aar(2) = cdtr(4)*las(1,i)+cdtr(5)*las(2,i)+cdtr(6)*las(3,i)
361 aar(3) = cdtr(7)*las(1,i)+cdtr(8)*las(2,i)+cdtr(9)*las(3,i)
362 rx = ar(1,ns)*weight(ns)
363 ry = ar(2,ns)*weight(ns)
364 rz = ar(3,ns)*weight(ns)
365 as(1,i)= aar(1)+cdr(1)*rx+cdr(2)*ry+cdr(3)*rz
366 as(2,i)= aar(2)+cdr(4)*rx+cdr(5)*ry+cdr(6)*rz
367 as(3,i)= aar(3)+cdr(7)*rx+cdr(8)*ry+cdr(9)*rz
368 stis(i) = (stifr(ns)*ijr+stifn(ns)*dd)*weight(ns)
369 ENDDO
370 CALL foat_to_6_float(1 ,nsl*3 ,as ,as6 )
371 CALL foat_to_6_float(1 ,nsl ,stis ,stis6 )
372c--- summ secnd moments pon
373 DO i=1,nsl
374 DO k=1,6
375 m6(1,k) = m6(1,k)+as6(k,1,i)
376 m6(2,k) = m6(2,k)+as6(k,2,i)
377 m6(3,k) = m6(3,k)+as6(k,3,i)
378 stir6(k) = stir6(k) + stis6(k,i)
379 ENDDO
380 ENDDO
381 IF (ic>0.AND.ic<111) THEN
382 CALL rbe2flsn(nsl ,isl ,ar ,weight ,ic ,
383 1 skew )
384 END IF
385 END IF
386C--- reset of secnd nodes forces is necessary w/AMS
387 IF(ijt/=0)THEN
388 DO i=1,nsl
389 ns = isl(i)
390 DO j=1,3
391 IF(jt(j)/=0)THEN
392 jj=3*(j-1)
393 aa=a(1,ns)*cdt(jj+1)+a(2,ns)*cdt(jj+2)+a(3,ns)*cdt(jj+3)
394 a(1,ns)=a(1,ns)-aa*cdt(jj+1)
395 a(2,ns)=a(2,ns)-aa*cdt(jj+2)
396 a(3,ns)=a(3,ns)-aa*cdt(jj+3)
397 END IF
398 ENDDO
399 IF ((jt(1)+jt(2)+jt(3))==3)stifn(ns)=em20
400 ENDDO
401 END IF
402 IF(ijr/=0)THEN
403 DO i=1,nsl
404 ns = isl(i)
405 DO j=1,3
406 IF(jr(j)/=0)THEN
407 jj=3*(j-1)
408 aa=ar(1,ns)*cdr(jj+1)+ar(2,ns)*cdr(jj+2)+ar(3,ns)*cdr(jj+3)
409 ar(1,ns)=ar(1,ns)-aa*cdr(jj+1)
410 ar(2,ns)=ar(2,ns)-aa*cdr(jj+2)
411 ar(3,ns)=ar(3,ns)-aa*cdr(jj+3)
412 END IF
413 ENDDO
414 IF ((jr(1)+jr(2)+jr(3))==3) stifr(ns)=em20
415 ENDDO
416 END IF
417C---
418 RETURN
419 END
420!||====================================================================
421!|| rbe2_poff ../engine/source/constraints/general/rbe2/rbe2f.F
422!||====================================================================
423 SUBROUTINE rbe2_poff(IRBE2 ,A ,AR ,MS ,IN ,
424 1 STIFN ,STIFR ,WEIGHT,JR ,IH )
425C-----------------------------------------------
426C I m p l i c i t T y p e s
427C-----------------------------------------------
428#include "implicit_f.inc"
429C-----------------------------------------------
430C C o m m o n B l o c k s
431C-----------------------------------------------
432#include "com04_c.inc"
433#include "param_c.inc"
434C-----------------------------------------------
435C D u m m y A r g u m e n t s
436C-----------------------------------------------
437 INTEGER IRBE2(NRBE2L,*),WEIGHT(*),JR(3,*),IH
438C REAL
439 my_real
440 . A(3,*), AR(3,*), MS(*), IN(*) ,STIFN(*) ,STIFR(*)
441C-----------------------------------------------
442C L o c a l V a r i a b l e s
443C-----------------------------------------------
444 INTEGER N ,IROT,M
445C REAL
446C======================================================================|
447#include "vectorize.inc"
448 DO n=1,nrbe2
449 IF (irbe2(9,n)/=ih) cycle
450 m = irbe2(3,n)
451 a(1,m) = a(1,m)*weight(m)
452 a(2,m) = a(2,m)*weight(m)
453 a(3,m) = a(3,m)*weight(m)
454 stifn(m) = stifn(m)*weight(m)
455 irot = jr(1,n)+jr(2,n)+jr(3,n)
456 IF (irot>0) THEN
457 ar(1,m) = ar(1,m)*weight(m)
458 ar(2,m) = ar(2,m)*weight(m)
459 ar(3,m) = ar(3,m)*weight(m)
460 stifr(m) = stifr(m)*weight(m)
461 ENDIF
462 ENDDO
463C---
464 RETURN
465 END
466!||====================================================================
467!|| rbe2_s ../engine/source/constraints/general/rbe2/rbe2f.F
468!||--- called by ------------------------------------------------------
469!|| rbe2t1 ../engine/source/constraints/general/rbe2/rbe2f.F
470!||====================================================================
471 SUBROUTINE rbe2_s(IRBE2 ,A ,AR ,MS ,IN ,
472 1 STIFN ,STIFR ,WEIGHT,F6 ,M6 ,
473 2 ST6 ,SR6 ,JR ,NMRBE2,IH )
474C-----------------------------------------------
475C I m p l i c i t T y p e s
476C-----------------------------------------------
477#include "implicit_f.inc"
478C-----------------------------------------------
479C C o m m o n B l o c k s
480C-----------------------------------------------
481#include "com04_c.inc"
482#include "param_c.inc"
483C-----------------------------------------------
484C D u m m y A r g u m e n t s
485C-----------------------------------------------
486 INTEGER IRBE2(NRBE2L,*),WEIGHT(*),NMRBE2,JR(3,*),IH
487C REAL
488 my_real
489 . A(3,*), AR(3,*), MS(*), IN(*) ,STIFN(*) ,STIFR(*)
490 DOUBLE PRECISION
491 . F6(3,6,*), M6(3,6,*) ,ST6(6,*) ,SR6(6,*)
492C-----------------------------------------------
493C L o c a l V a r i a b l e s
494C-----------------------------------------------
495 INTEGER K, N ,M,MID,IROT,IRAD
496C REAL
497C======================================================================|
498#include "vectorize.inc"
499 DO n=1,nrbe2
500 IF (ih/=irbe2(9,n)) cycle
501 m = irbe2(3,n)
502 mid = irbe2(6,n)
503 irad = irbe2(11,n)
504 IF (mid<0) cycle
505 irot = jr(1,n)+jr(2,n)+jr(3,n)
506 DO k=1,6
507 a(1,m) = a(1,m)+ f6(1,k,mid)
508 a(2,m) = a(2,m)+ f6(2,k,mid)
509 a(3,m) = a(3,m)+ f6(3,k,mid)
510 stifn(m) = stifn(m)+st6(k,mid)
511 ENDDO
512 IF (irot>0.OR.irad==0) THEN
513 DO k=1,6
514 ar(1,m) = ar(1,m)+ m6(1,k,mid)
515 ar(2,m) = ar(2,m)+ m6(2,k,mid)
516 ar(3,m) = ar(3,m)+ m6(3,k,mid)
517 stifr(m) = stifr(m)+sr6(k,mid)
518 ENDDO
519 ENDIF
520 ENDDO
521C---
522 RETURN
523 END
524!||====================================================================
525!|| prerbe2 ../engine/source/constraints/general/rbe2/rbe2f.F
526!||--- called by ------------------------------------------------------
527!|| rbe2_imp0 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
528!|| rbe2_impd ../engine/source/constraints/general/rbe2/rbe2v.F
529!|| rbe2_impi ../engine/source/constraints/general/rbe2/rbe2_imp0.F
530!|| rbe2_impr1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
531!|| rbe2cor ../engine/source/constraints/general/rbody/rgbcor.F
532!|| rbe2t1 ../engine/source/constraints/general/rbe2/rbe2f.F
533!|| rbe2v ../engine/source/constraints/general/rbe2/rbe2v.F
534!|| sms_diag_rbe2 ../engine/source/ams/sms_rbe2.F
535!|| sms_rbe2_nodxi ../engine/source/ams/sms_rbe2.F
536!|| sms_rbe_accl ../engine/source/ams/sms_rbe2.F
537!|| sms_rbe_cnds ../engine/source/ams/sms_rbe2.F
538!|| sms_rbe_corr ../engine/source/ams/sms_rbe2.F
539!|| sms_rbe_prec ../engine/source/ams/sms_rbe2.F
540!||====================================================================
541 SUBROUTINE prerbe2(IRBE2 ,JT ,JR )
542C-----------------------------------------------
543C I m p l i c i t T y p e s
544C-----------------------------------------------
545#include "implicit_f.inc"
546C-----------------------------------------------
547C C o m m o n B l o c k s
548C-----------------------------------------------
549#include "com01_c.inc"
550#include "com04_c.inc"
551#include "param_c.inc"
552C-----------------------------------------------
553C D u m m y A r g u m e n t s
554C-----------------------------------------------
555 INTEGER IRBE2(NRBE2L,*),JT(3,*) ,JR(3,*)
556C REAL
557C-----------------------------------------------
558C L o c a l V a r i a b l e s
559C-----------------------------------------------
560 INTEGER J, N,IC,ICT,ICR
561C======================================================================|
562 DO N=1,nrbe2
563 ic=irbe2(4,n)
564 ict=ic/512
565 icr=(ic-512*(ict))/64
566 IF (iroddl==0) icr =0
567 DO j =1,3
568 jt(j,n)=0
569 jr(j,n)=0
570 ENDDO
571 SELECT CASE (ict)
572 CASE(1)
573 jt(3,n)=1
574 CASE(2)
575 jt(2,n)=1
576 CASE(3)
577 jt(2,n)=1
578 jt(3,n)=1
579 CASE(4)
580 jt(1,n)=1
581 CASE(5)
582 jt(1,n)=1
583 jt(3,n)=1
584 CASE(6)
585 jt(1,n)=1
586 jt(2,n)=1
587 CASE(7)
588 jt(1,n)=1
589 jt(2,n)=1
590 jt(3,n)=1
591 END SELECT
592 SELECT CASE (icr)
593 CASE(1)
594 jr(3,n)=1
595 CASE(2)
596 jr(2,n)=1
597 CASE(3)
598 jr(2,n)=1
599 jr(3,n)=1
600 CASE(4)
601 jr(1,n)=1
602 CASE(5)
603 jr(1,n)=1
604 jr(3,n)=1
605 CASE(6)
606 jr(1,n)=1
607 jr(2,n)=1
608 CASE(7)
609 jr(1,n)=1
610 jr(2,n)=1
611 jr(3,n)=1
612 END SELECT
613 ENDDO
614C---
615 RETURN
616 END
617!||====================================================================
618!|| rbe2_init ../engine/source/constraints/general/rbe2/rbe2f.F
619!||--- called by ------------------------------------------------------
620!|| resol_init ../engine/source/engine/resol_init.F
621!||====================================================================
622 SUBROUTINE rbe2_init(IRBE2 ,LRBE2,NMRBE2,FR_RBE2,FR_RBE2M,NFR)
623C-----------------------------------------------
624C I m p l i c i t T y p e s
625C-----------------------------------------------
626#include "implicit_f.inc"
627C-----------------------------------------------
628C C o m m o n B l o c k s
629C-----------------------------------------------
630#include "com04_c.inc"
631#include "param_c.inc"
632C-----------------------------------------------
633C D u m m y A r g u m e n t s
634C-----------------------------------------------
635 INTEGER IRBE2(NRBE2L,*),LRBE2(*),NMRBE2,FR_RBE2(*),FR_RBE2M(*),NFR
636C REAL
637C-----------------------------------------------
638C L o c a l V a r i a b l e s
639C-----------------------------------------------
640 INTEGER M,N,ITAG(NUMNOD),IH(NRBE2),NIH
641C======================================================================|
642 NMRBE2 = 0
643 if (nrbe2==0) RETURN
644 DO n=1,numnod
645 itag(n)=0
646 ENDDO
647C-----s'il y a hierarchy----
648C DO N=1,NRBE2
649C M=IRBE2(3,N)
650C ITAG(M)=N
651C IH(N)=0
652C ENDDO
653C DO N=1,NRBE2
654C IAD=IRBE2(1,N)
655C M=IRBE2(3,N)
656C NSL =IRBE2(5,N)
657C DO J=1,NSL
658C NS= LRBE2(IAD+J)
659C IF (ITAG(NS)>0) IH(ITAG(NS)) =M
660C ENDDO
661C ENDDO
662C DO N=1,NRBE2
663C M=IRBE2(3,N)
664C ITAG(M)=0
665C ENDDO
666C
667 DO n=1,nrbe2
668 m=irbe2(3,n)
669 IF (itag(m)==0) THEN
670 nmrbe2 =nmrbe2 +1
671 itag(m)= nmrbe2
672 irbe2(6,n) = itag(m)
673 ih(nmrbe2) = irbe2(9,n)
674 ELSE
675 nih = ih(itag(m))
676 irbe2(6,n) = itag(m)
677C---------to avoid the double sum on A,AR for main nodes in the same IH
678 IF (irbe2(9,n)==nih) THEN
679 irbe2(6,n) = -itag(m)
680C---------case the same main in the same IH, but also before
681 ELSE
682 ih(itag(m)) = irbe2(9,n)
683 END IF
684 ENDIF
685 ENDDO
686C---
687 DO n=1,nfr
688 m=fr_rbe2(n)
689 fr_rbe2m(n)=itag(m)
690 ENDDO
691C
692 RETURN
693 END
694!||====================================================================
695!|| rbe2frf ../engine/source/constraints/general/rbe2/rbe2f.F
696!||--- called by ------------------------------------------------------
697!|| imp3_a2b ../engine/source/airbag/monv_imp0.F
698!|| upd_fr ../engine/source/mpi/implicit/imp_fri.F
699!||--- calls -----------------------------------------------------
700!|| cdi_bcn ../engine/source/constraints/general/rbe2/rbe2_imp0.F
701!|| cdi_bcn1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
702!|| rbe2flsnfr ../engine/source/constraints/general/rbe2/rbe2f.F
703!||====================================================================
704 SUBROUTINE rbe2frf(NS ,M ,A ,AR ,JT ,
705 1 JR ,X ,ISK ,SKEW0 ,IRAD )
706C-----------------------------------------------
707C I m p l i c i t T y p e s
708C-----------------------------------------------
709#include "implicit_f.inc"
710C-----------------------------------------------
711C C o m m o n B l o c k s
712C-----------------------------------------------
713#include "param_c.inc"
714C-----------------------------------------------
715C D u m m y A r g u m e n t s
716C-----------------------------------------------
717 INTEGER NS , M,JT(*),JR(*),ISK,IRAD
718C REAL
719 my_real
720 . A(3,*), AR(3,*), SKEW0(*),X(3,*)
721C-----------------------------------------------
722C L o c a l V a r i a b l e s
723C-----------------------------------------------
724 INTEGER K,JT1(3),JR1(3),IC
725C REAL
726 my_real
727 . RX,RY,RZ, SKEW(LSKEW),CDT(9),CDR(9),CDTR(9),AAR(3)
728C======================================================================|
729 IF (isk>1) THEN
730 DO k=1,9
731 skew(k)=skew0(k)
732 ENDDO
733 ELSE
734 DO k=1,lskew
735 skew(k)=zero
736 ENDDO
737 skew(1)=one
738 skew(5)=one
739 skew(9)=one
740 ENDIF
741 ic = jt(1)*100+jt(2)*10+jt(3)
742 CALL cdi_bcn(ic ,skew ,jt ,cdt ,jt1 )
743 a(1,m) = a(1,m)+cdt(1)*a(1,ns)+cdt(2)*a(2,ns)+cdt(3)*a(3,ns)
744 a(2,m) = a(2,m)+cdt(4)*a(1,ns)+cdt(5)*a(2,ns)+cdt(6)*a(3,ns)
745 a(3,m) = a(3,m)+cdt(7)*a(1,ns)+cdt(8)*a(2,ns)+cdt(9)*a(3,ns)
746C--- NS components
747 IF (ic>0.AND.ic<111) THEN
748 CALL rbe2flsnfr(ns ,a ,ic ,skew )
749 END IF
750C---
751 IF (irad==0.OR.(jr(1)+jr(2)+jr(3))>0) THEN
752 ic = jr(1)*100+jr(2)*10+jr(3)
753 CALL cdi_bcn(ic ,skew ,jr ,cdr ,jr1 )
754 rx = x(1,ns) - x(1,m)
755 ry = x(2,ns) - x(2,m)
756 rz = x(3,ns) - x(3,m)
757 CALL cdi_bcn1(rx,ry,rz,jt,jr,skew,cdtr,irad)
758C
759 aar(1) = cdtr(1)*a(1,ns)+cdtr(2)*a(2,ns)+cdtr(3)*a(3,ns)
760 aar(2) = cdtr(4)*a(1,ns)+cdtr(5)*a(2,ns)+cdtr(6)*a(3,ns)
761 aar(3) = cdtr(7)*a(1,ns)+cdtr(8)*a(2,ns)+cdtr(9)*a(3,ns)
762 ar(1,m)= ar(1,m)+
763 . aar(1)+cdr(1)*ar(1,ns)+cdr(2)*ar(2,ns)+cdr(3)*ar(3,ns)
764 ar(2,m)= ar(2,m)+
765 . aar(2)+cdr(4)*ar(1,ns)+cdr(5)*ar(2,ns)+cdr(6)*ar(3,ns)
766 ar(3,m)= ar(3,m)+
767 . aar(3)+cdr(7)*ar(1,ns)+cdr(8)*ar(2,ns)+cdr(9)*ar(3,ns)
768 IF (ic>0.AND.ic<111) THEN
769 CALL rbe2flsnfr(ns ,ar ,ic ,skew )
770 END IF
771 END IF
772C---
773 RETURN
774 END
775!||====================================================================
776!|| rbe2flsn ../engine/source/constraints/general/rbe2/rbe2f.F
777!||--- called by ------------------------------------------------------
778!|| rbe2fl ../engine/source/constraints/general/rbe2/rbe2f.F
779!||--- calls -----------------------------------------------------
780!|| dir_rbe2 ../engine/source/constraints/general/rbe2/rbe2v.F
781!|| l_dir ../engine/source/constraints/general/bcs/bc_imp0.F
782!||====================================================================
783 SUBROUTINE rbe2flsn(NSL ,ISL ,A ,WEIGHT,ICT ,
784 2 SKEW )
785C-----------------------------------------------
786C I m p l i c i t T y p e s
787C-----------------------------------------------
788#include "implicit_f.inc"
789C-----------------------------------------------
790C D u m m y A r g u m e n t s
791C-----------------------------------------------
792 INTEGER NSL ,ISL(*) ,ICT, WEIGHT(*)
793 my_real
794 . SKEW(*),A(3,*)
795C-----------------------------------------------
796C L o c a l V a r i a b l e s
797C-----------------------------------------------
798 INTEGER I,J,K,J1,NS
799 my_real
800 . EJ(3),EJ1(3),S,EA,EB
801C----------------100-------------------------
802 SELECT CASE (ICT)
803 CASE(100)
804 EJ(1)=skew(1)
805 ej(2)=skew(2)
806 ej(3)=skew(3)
807 CALL l_dir(ej,j)
808 j1=0
809 CALL dir_rbe2(j ,j1 ,k )
810C----------------010-------------------------
811 CASE(10)
812 ej(1)=skew(4)
813 ej(2)=skew(5)
814 ej(3)=skew(6)
815 CALL l_dir(ej,j)
816 j1=0
817 CALL dir_rbe2(j ,j1 ,k )
818C----------------001-------------------------
819 CASE(1)
820 ej(1)=skew(7)
821 ej(2)=skew(8)
822 ej(3)=skew(9)
823 CALL l_dir(ej,j)
824 j1=0
825 CALL dir_rbe2(j ,j1 ,k )
826C----------------011-------------------------
827 CASE(11)
828 ej(1)=skew(7)
829 ej(2)=skew(8)
830 ej(3)=skew(9)
831 CALL l_dir(ej,j)
832 ej1(1)=skew(4)
833 ej1(2)=skew(5)
834 ej1(3)=skew(6)
835 CALL l_dir(ej1,j1)
836 IF (j1==j) THEN
837 ej1(j)=zero
838 CALL l_dir(ej1,j1)
839 ej1(1)=skew(4)/skew(3+j1)
840 ej1(2)=skew(5)/skew(3+j1)
841 ej1(3)=skew(6)/skew(3+j1)
842 ENDIF
843 CALL dir_rbe2(j ,j1 ,k )
844 s=one/(one-ej(j1)*ej1(j))
845 ea=s*(ej(j1)*ej1(k)-ej(k))
846 eb=s*(ej1(j)*ej(k)-ej1(k))
847C----------------101-------------------------
848 CASE(101)
849 ej(1)=skew(7)
850 ej(2)=skew(8)
851 ej(3)=skew(9)
852 CALL l_dir(ej,j)
853 ej1(1)=skew(1)
854 ej1(2)=skew(2)
855 ej1(3)=skew(3)
856 CALL l_dir(ej1,j1)
857 IF (j1==j) THEN
858 ej1(j)=zero
859 CALL l_dir(ej1,j1)
860 ej1(1)=skew(1)/skew(j1)
861 ej1(2)=skew(2)/skew(j1)
862 ej1(3)=skew(3)/skew(j1)
863 ENDIF
864 CALL dir_rbe2(j ,j1 ,k )
865 s=one/(one-ej(j1)*ej1(j))
866 ea=s*(ej(j1)*ej1(k)-ej(k))
867 eb=s*(ej1(j)*ej(k)-ej1(k))
868C----------------110-------------------------
869 CASE(110)
870 ej(1)=skew(4)
871 ej(2)=skew(5)
872 ej(3)=skew(6)
873 CALL l_dir(ej,j)
874 ej1(1)=skew(1)
875 ej1(2)=skew(2)
876 ej1(3)=skew(3)
877 CALL l_dir(ej1,j1)
878 IF (j1==j) THEN
879 ej1(j)=zero
880 CALL l_dir(ej1,j1)
881 ej1(1)=skew(1)/skew(j1)
882 ej1(2)=skew(2)/skew(j1)
883 ej1(3)=skew(3)/skew(j1)
884 ENDIF
885 CALL dir_rbe2(j ,j1 ,k )
886 s=one/(one-ej(j1)*ej1(j))
887 ea=s*(ej(j1)*ej1(k)-ej(k))
888 eb=s*(ej1(j)*ej(k)-ej1(k))
889 END SELECT
890C
891 DO i=1,nsl
892 ns = isl(i)
893 IF (weight(ns)==0) cycle
894C-------------------100---------------------
895 IF (ict == 100 ) THEN
896 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
897 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
898C-------------------010---------------------
899 ELSEIF (ict == 10) THEN
900 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
901 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
902C-------------------001---------------------
903 ELSEIF (ict == 1) THEN
904 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
905 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
906C-------------------011---------------------
907 ELSEIF (ict == 11) THEN
908 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
909C-------------------101---------------------
910 ELSEIF (ict == 101) THEN
911 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
912C-------------------110---------------------
913 ELSEIF (ict == 110 ) THEN
914 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
915 ENDIF
916 ENDDO
917C
918 RETURN
919 END
920!||====================================================================
921!|| rbe2flsnfr ../engine/source/constraints/general/rbe2/rbe2f.F
922!||--- called by ------------------------------------------------------
923!|| rbe2frf ../engine/source/constraints/general/rbe2/rbe2f.F
924!||--- calls -----------------------------------------------------
925!|| dir_rbe2 ../engine/source/constraints/general/rbe2/rbe2v.F
926!|| l_dir ../engine/source/constraints/general/bcs/bc_imp0.F
927!||====================================================================
928 SUBROUTINE rbe2flsnfr(NS ,A ,ICT ,SKEW )
929C-----------------------------------------------
930C I m p l i c i t T y p e s
931C-----------------------------------------------
932#include "implicit_f.inc"
933C-----------------------------------------------
934C D u m m y A r g u m e n t s
935C-----------------------------------------------
936 INTEGER NS ,ICT
937 my_real
938 . SKEW(*),A(3,*)
939C-----------------------------------------------
940C L o c a l V a r i a b l e s
941C-----------------------------------------------
942 INTEGER J,K,J1
943 my_real
944 . EJ(3),EJ1(3),S,EA,EB
945C----------------100-------------------------
946 SELECT CASE (ICT)
947 CASE(100)
948 EJ(1)=skew(1)
949 ej(2)=skew(2)
950 ej(3)=skew(3)
951 CALL l_dir(ej,j)
952 j1=0
953 CALL dir_rbe2(j ,j1 ,k )
954 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
955 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
956C----------------010-------------------------
957 CASE(10)
958 ej(1)=skew(4)
959 ej(2)=skew(5)
960 ej(3)=skew(6)
961 CALL l_dir(ej,j)
962 j1=0
963 CALL dir_rbe2(j ,j1 ,k )
964 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
965 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
966C----------------001-------------------------
967 CASE(1)
968 ej(1)=skew(7)
969 ej(2)=skew(8)
970 ej(3)=skew(9)
971 CALL l_dir(ej,j)
972 j1=0
973 CALL dir_rbe2(j ,j1 ,k )
974 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
975 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
976C----------------011-------------------------
977 CASE(11)
978 ej(1)=skew(7)
979 ej(2)=skew(8)
980 ej(3)=skew(9)
981 CALL l_dir(ej,j)
982 ej1(1)=skew(4)
983 ej1(2)=skew(5)
984 ej1(3)=skew(6)
985 CALL l_dir(ej1,j1)
986 IF (j1==j) THEN
987 ej1(j)=zero
988 CALL l_dir(ej1,j1)
989 ej1(1)=skew(4)/skew(3+j1)
990 ej1(2)=skew(5)/skew(3+j1)
991 ej1(3)=skew(6)/skew(3+j1)
992 ENDIF
993 CALL dir_rbe2(j ,j1 ,k )
994 s=one/(one-ej(j1)*ej1(j))
995 ea=s*(ej(j1)*ej1(k)-ej(k))
996 eb=s*(ej1(j)*ej(k)-ej1(k))
997 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
998C----------------101-------------------------
999 CASE(101)
1000 ej(1)=skew(7)
1001 ej(2)=skew(8)
1002 ej(3)=skew(9)
1003 CALL l_dir(ej,j)
1004 ej1(1)=skew(1)
1005 ej1(2)=skew(2)
1006 ej1(3)=skew(3)
1007 CALL l_dir(ej1,j1)
1008 IF (j1==j) THEN
1009 ej1(j)=zero
1010 CALL l_dir(ej1,j1)
1011 ej1(1)=skew(1)/skew(j1)
1012 ej1(2)=skew(2)/skew(j1)
1013 ej1(3)=skew(3)/skew(j1)
1014 ENDIF
1015 CALL dir_rbe2(j ,j1 ,k )
1016 s=one/(one-ej(j1)*ej1(j))
1017 ea=s*(ej(j1)*ej1(k)-ej(k))
1018 eb=s*(ej1(j)*ej(k)-ej1(k))
1019 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
1020C----------------110-------------------------
1021 CASE(110)
1022 ej(1)=skew(4)
1023 ej(2)=skew(5)
1024 ej(3)=skew(6)
1025 CALL l_dir(ej,j)
1026 ej1(1)=skew(1)
1027 ej1(2)=skew(2)
1028 ej1(3)=skew(3)
1029 CALL l_dir(ej1,j1)
1030 IF (j1==j) THEN
1031 ej1(j)=zero
1032 CALL l_dir(ej1,j1)
1033 ej1(1)=skew(1)/skew(j1)
1034 ej1(2)=skew(2)/skew(j1)
1035 ej1(3)=skew(3)/skew(j1)
1036 ENDIF
1037 CALL dir_rbe2(j ,j1 ,k )
1038 s=one/(one-ej(j1)*ej1(j))
1039 ea=s*(ej(j1)*ej1(k)-ej(k))
1040 eb=s*(ej1(j)*ej(k)-ej1(k))
1041 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
1042 END SELECT
1043C
1044 RETURN
1045 END
1046!||====================================================================
1047!|| prerbe2fr ../engine/source/constraints/general/rbe2/rbe2f.F
1048!||--- called by ------------------------------------------------------
1049!|| diag_int ../engine/source/mpi/implicit/imp_fri.F
1050!|| fr_u2dd ../engine/source/mpi/implicit/imp_fri.F
1051!|| imp3_a2b ../engine/source/airbag/monv_imp0.F
1052!|| imp3_u2x ../engine/source/airbag/monv_imp0.F
1053!|| upd_fr ../engine/source/mpi/implicit/imp_fri.F
1054!|| upd_kml ../engine/source/mpi/implicit/imp_fri.F
1055!|| upd_ksl ../engine/source/mpi/implicit/imp_fri.F
1056!|| updk_mv ../engine/source/airbag/monv_imp0.F
1057!||====================================================================
1058 SUBROUTINE prerbe2fr(IC ,JT ,JR )
1059C-----------------------------------------------
1060C I m p l i c i t T y p e s
1061C-----------------------------------------------
1062#include "implicit_f.inc"
1063C-----------------------------------------------
1064C D u m m y A r g u m e n t s
1065C-----------------------------------------------
1066 INTEGER IC,JT(3) ,JR(3)
1067C-----------------------------------------------
1068C L o c a l V a r i a b l e s
1069C-----------------------------------------------
1070 INTEGER J,ICT,ICR
1071C======================================================================|
1072C IC=IRBE2(4,N)
1073 ict=ic/512
1074 icr=(ic-512*(ict))/64
1075 DO j =1,3
1076 jt(j)=0
1077 jr(j)=0
1078 ENDDO
1079 SELECT CASE (ict)
1080 CASE(1)
1081 jt(3)=1
1082 CASE(2)
1083 jt(2)=1
1084 CASE(3)
1085 jt(2)=1
1086 jt(3)=1
1087 CASE(4)
1088 jt(1)=1
1089 CASE(5)
1090 jt(1)=1
1091 jt(3)=1
1092 CASE(6)
1093 jt(1)=1
1094 jt(2)=1
1095 CASE(7)
1096 jt(1)=1
1097 jt(2)=1
1098 jt(3)=1
1099 END SELECT
1100 SELECT CASE (icr)
1101 CASE(1)
1102 jr(3)=1
1103 CASE(2)
1104 jr(2)=1
1105 CASE(3)
1106 jr(2)=1
1107 jr(3)=1
1108 CASE(4)
1109 jr(1)=1
1110 CASE(5)
1111 jr(1)=1
1112 jr(3)=1
1113 CASE(6)
1114 jr(1)=1
1115 jr(2)=1
1116 CASE(7)
1117 jr(1)=1
1118 jr(2)=1
1119 jr(3)=1
1120 END SELECT
1121C---
1122 RETURN
1123 END
l_dir
subroutine l_dir(ej, j)
Definition bc_imp0.F:405
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
spmd_max_i
subroutine spmd_max_i(n)
Definition imp_spmd.F:1362
foat_to_6_float
subroutine foat_to_6_float(jft, jlt, f, f6)
Definition parit.F:226
cdi_bcn1
subroutine cdi_bcn1(xs, ys, zs, jt, jr, skew, ktr, irad)
Definition rbe2_imp0.F:1449
cdi_bcn
subroutine cdi_bcn(ict, skew, jt, kt, jt1)
Definition rbe2_imp0.F:1012
rbe2_init
subroutine rbe2_init(irbe2, lrbe2, nmrbe2, fr_rbe2, fr_rbe2m, nfr)
Definition rbe2f.F:623
rbe2t1
subroutine rbe2t1(irbe2, lrbe2, x, a, ar, ms, in, skew, weight, iad_rbe2, fr_rbe2m, nmrbe2, stifn, stifr, r2size)
Definition rbe2f.F:38
rbe2flsnfr
subroutine rbe2flsnfr(ns, a, ict, skew)
Definition rbe2f.F:929
prerbe2fr
subroutine prerbe2fr(ic, jt, jr)
Definition rbe2f.F:1059
rbe2frf
subroutine rbe2frf(ns, m, a, ar, jt, jr, x, isk, skew0, irad)
Definition rbe2f.F:706
rbe2_s
subroutine rbe2_s(irbe2, a, ar, ms, in, stifn, stifr, weight, f6, m6, st6, sr6, jr, nmrbe2, ih)
Definition rbe2f.F:474
rbe2_poff
subroutine rbe2_poff(irbe2, a, ar, ms, in, stifn, stifr, weight, jr, ih)
Definition rbe2f.F:425
prerbe2
subroutine prerbe2(irbe2, jt, jr)
Definition rbe2f.F:542
rbe2fl
subroutine rbe2fl(nsl, isl, x, a, ar, ms, in, weight, jt, jr, f6, m6, stifn, stifr, stif6, stir6, m, skew, irad)
Definition rbe2f.F:282
rbe2f
subroutine rbe2f(nsl, isl, x, a, ar, ms, in, weight, jt, jr, f6, m6, stifn, stifr, stif6, stir6, m, irad)
Definition rbe2f.F:135
rbe2flsn
subroutine rbe2flsn(nsl, isl, a, weight, ict, skew)
Definition rbe2f.F:785
dir_rbe2
subroutine dir_rbe2(j, j1, k)
Definition rbe2v.F:714
spmd_exch_rbe2_pon
subroutine spmd_exch_rbe2_pon(a, ar, stifn, stifr, iad_m, fr_m, lcomm, isize)
Definition spmd_exch_rbe2_pon.F:34