OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_aget_sect.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "com04_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_aget_sect (nstrf, x, xsec, weight, itab)

Function/Subroutine Documentation

◆ spmd_aget_sect()

subroutine spmd_aget_sect ( integer, dimension(*) nstrf,
x,
xsec,
integer, dimension(*) weight,
integer, dimension(*) itab )

Definition at line 31 of file spmd_aget_sect.F.

32 USE spmd_mod
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37#include "spmd.inc"
38#include "com04_c.inc"
39#include "task_c.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 my_real
44 . xsec(3,3,nsect),x(3,*)
45 INTEGER NSTRF(*),WEIGHT(*),ITAB(*)
46C-----------------------------------------------
47C L O C A L V A R I A B L E S
48C-----------------------------------------------
49#ifdef MPI
50 INTEGER IERROR
51 my_real
52 . xsectmp(3,3,nsect)
53
54 INTEGER I,K1,N1,N2,N3,LEN
55
56 DO i=1,nsect
57 xsectmp(1,1,i)=zero
58 xsectmp(1,2,i)=zero
59 xsectmp(1,3,i)=zero
60
61 xsectmp(2,1,i)=zero
62 xsectmp(2,2,i)=zero
63 xsectmp(2,3,i)=zero
64
65 xsectmp(3,1,i)=zero
66 xsectmp(3,2,i)=zero
67 xsectmp(3,3,i)=zero
68
69 xsec(1,1,i)=zero
70 xsec(1,2,i)=zero
71 xsec(1,3,i)=zero
72
73 xsec(2,1,i)=zero
74 xsec(2,2,i)=zero
75 xsec(2,3,i)=zero
76
77 xsec(3,1,i)=zero
78 xsec(3,2,i)=zero
79 xsec(3,3,i)=zero
80
81 ENDDO
82
83 k1 = 33
84
85 DO i=1,nsect
86 n1 = nstrf(k1+1)
87 n2 = nstrf(k1+2)
88 n3 = nstrf(k1+3)
89 IF (n1>0) THEN
90 IF (weight(n1)==1) THEN
91 xsectmp(1,1,i) = x(1,n1)
92 xsectmp(1,2,i) = x(2,n1)
93 xsectmp(1,3,i) = x(3,n1)
94 ENDIF
95 ENDIF
96
97 IF (n2>0) THEN
98 IF (weight(n2)==1) THEN
99 xsectmp(2,1,i) = x(1,n2)
100 xsectmp(2,2,i) = x(2,n2)
101 xsectmp(2,3,i) = x(3,n2)
102 ENDIF
103 ENDIF
104
105 IF (n3>0) THEN
106 IF (weight(n3)==1) THEN
107 xsectmp(3,1,i) = x(1,n3)
108 xsectmp(3,2,i) = x(2,n3)
109 xsectmp(3,3,i) = x(3,n3)
110 ENDIF
111 ENDIF
112
113 k1= nstrf(k1+22)+2
114 ENDDO
115
116 len = 9*nsect
117
118
119 CALL mpi_reduce(xsectmp,xsec,len,
120 . real,mpi_sum,it_spmd(1),
121 . spmd_comm_world,ierror)
122
123
124C
125C IF (ISPMD==0) THEN
126C DO I=1,NSECT
127C print*,I,'XSEC N1= ',XSEC(1,1,I),XSEC(1,2,I),XSEC(1,3,I)
128C print*,I,'XSEC N2= ',XSEC(2,1,I),XSEC(2,2,I),XSEC(2,3,I)
129C print*,I,'XSEC N2= ',XSEC(3,1,I),XSEC(3,2,I),XSEC(3,3,I)
130C print*,' '
131C ENDDO
132C ENDIF
133#endif
134 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
mpi_reduce
subroutine mpi_reduce(sendbuf, recvbuf, cnt, datatype, op, root, comm, ierr)
Definition mpi.f:120