OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outp_r_s.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!|| outp_r_s ../engine/source/output/sty/outp_r_s.F
25!||--- called by ------------------------------------------------------
26!|| genoutp ../engine/source/output/sty/genoutp.f
27!||--- calls -----------------------------------------------------
28!|| spmd_rgather9_1comm ../engine/source/mpi/interfaces/spmd_outp.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!||====================================================================
32 SUBROUTINE outp_r_s(NBX ,KEY ,TEXT ,ELBUF_TAB,IPARG,
33 2 DD_IAD,SIZLOC,SIZP0,SIZ_WR )
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE elbufdef_mod
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 "param_c.inc"
47#include "units_c.inc"
48#include "task_c.inc"
49#include "scr16_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 CHARACTER*10 KEY
54 CHARACTER*40 TEXT
55 INTEGER NBX
56 INTEGER IPARG(NPARG,*), DD_IAD(NSPMD+1,*),SIZLOC,SIZP0,SIZ_WR
57C
58 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I,J, JJ,K,L
63 INTEGER NG, NEL, NFT, IAD, ITY, LFT, LLT,
64 . jj_old, ngf, ngl, nn, len, nuvar, nptt, npts,
65 . liad
66 INTEGER RESP0,WRTLEN,RES,COMPTEUR
67 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
68 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
69 my_real
70 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
71 my_real
72 . func(6)
73C
74 TYPE(g_bufel_) ,POINTER :: GBUF
75C-----------------------------------------------
76C NEW SUBROUTINE FOR SPRINGS
77C-----------------------------------------------
78 IF(ispmd==0) THEN
79 WRITE(iugeo,'(2A)')'/SPRING /SCALAR /',key
80 WRITE(iugeo,'(A)')text
81 IF (outyy_fmt == 2) THEN
82 WRITE(iugeo,'(A)')'#FORMAT: (1P6E12.5) (VAR(I),I=1,NUMELR)'
83 ELSE
84 WRITE(iugeo,'(A)')'#FORMAT: (1P6E20.13) (VAR(I),I=1,NUMELR)'
85 END IF
86 ENDIF
87! -----------------------------
88 jj_old = 1
89 ngf = 1
90 ngl = 0
91 resp0=0
92 jj = 0
93 compteur = 0
94 DO nn=1,nspgroup
95 ngl = ngl + dd_iad(ispmd+1,nn)
96 DO ng = ngf, ngl
97 ity =iparg(5,ng)
98 gbuf => elbuf_tab(ng)%GBUF
99 IF(ity==6) THEN
100 nel =iparg(2,ng)
101 nft =iparg(3,ng)
102 iad =iparg(4,ng)
103 lft=1
104 llt=nel
105 DO i=lft,llt
106 jj = jj + 1
107 IF (nbx==1)wa(jj) = gbuf%OFF(i)
108cc IF (NBX==1)WA(JJ) = BUFEL((IAD-1)+ I)
109 ENDDO
110 ENDIF
111 ENDDO
112 ngf = ngl + 1
113 jj_loc(nn) = jj - compteur ! size of each group
114 compteur = jj
115 ENDDO
116! ++++++++++
117 IF( nspmd>1 ) THEN
118 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
119 ELSE
120 wap0_loc(1:jj) = wa(1:jj)
121 adress(1,1) = 1
122 DO nn = 2,nspgroup+1
123 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
124 ENDDO
125 ENDIF
126! ++++++++++
127 IF(ispmd==0) THEN
128 resp0 = 0
129 DO nn=1,nspgroup
130 compteur = 0
131 DO k = 1,nspmd
132 IF((adress(nn+1,k)-1-adress(nn,k))>=0) THEN
133 DO l = adress(nn,k),adress(nn+1,k)-1
134 compteur = compteur + 1
135 wap0(compteur+resp0) = wap0_loc(l)
136 ENDDO ! l=... , ...
137 ENDIF !if(size_loc>0)
138 ENDDO ! k=1,nspmd
139
140 jj_old = compteur+resp0
141 IF(jj_old>0) THEN
142 res=mod(jj_old,6)
143 wrtlen=jj_old-res
144 IF (wrtlen>0) THEN
145 IF (outyy_fmt==2) THEN
146 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,wrtlen)
147 ELSE
148 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,wrtlen)
149 ENDIF
150 ENDIF
151 DO i=1,res
152 wap0(i)=wap0(wrtlen+i)
153 ENDDO
154 resp0=res
155 ENDIF ! if(jj_old>0)
156 ENDDO ! nn=1,nspgroup
157 IF (resp0>0) THEN
158 IF (outyy_fmt==2) THEN
159 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,resp0)
160 ELSE
161 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,resp0)
162 ENDIF
163 ENDIF
164 ENDIF ! ispmd=0
165 RETURN
166 END
167
168!||====================================================================
169!|| count_arsz_rs ../engine/source/output/sty/outp_r_s.F
170!||--- called by ------------------------------------------------------
171!|| genoutp ../engine/source/output/sty/genoutp.F
172!|| outp_arsz_rs ../engine/source/mpi/interfaces/spmd_outp.F
173!||====================================================================
174 SUBROUTINE count_arsz_rs(IPARG,DD_IAD,WASZ,SIZ_WRITE_LOC)
175C-----------------------------------------------
176C I m p l i c i t T y p e s
177C-----------------------------------------------
178#include "implicit_f.inc"
179C-----------------------------------------------
180C C o m m o n B l o c k s
181C-----------------------------------------------
182#include "param_c.inc"
183#include "com01_c.inc"
184#include "task_c.inc"
185#include "scr16_c.inc"
186C-----------------------------------------------
187C D u m m y A r g u m e n t s
188C-----------------------------------------------
189 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),
190 . wasz,siz_write_loc(nspgroup+1)
191C-----------------------------------------------
192C L o c a l V a r i a b l e s
193C-----------------------------------------------
194 INTEGER NGF,NGL,NN,ITY,NEL,NG,JJ
195C-----------------------------------------------
196 wasz = 0
197 IF (outp_rs(1) == 1) THEN
198 ngf = 1
199 ngl = 0
200 DO nn=1,nspgroup
201 jj = 0
202 ngl = ngl + dd_iad(ispmd+1,nn)
203 DO ng = ngf, ngl
204 ity =iparg(5,ng)
205 IF(ity == 6) THEN
206 nel = iparg(2,ng)
207 jj = jj + nel
208 ENDIF
209 ENDDO
210 ngf = ngl + 1
211 wasz = wasz + jj
212 siz_write_loc(nn) = jj
213 ENDDO
214 ENDIF
215 siz_write_loc(nspgroup+1) = wasz
216 RETURN
217 END
my_real
#define my_real
Definition cppsort.cpp:32
genoutp
subroutine genoutp(x, d, v, a, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, iparg, pm, igeo, ms, cont, itab, partsav, fint, fext, tani, eani, anin, ipart, vr, elbuf_tab, dd_iad, weight, ipm, kxsp, spbuf, nodglob, leng, fopt, nom_opt, npby, fncont, ftcont, geo, thke, stack, drape_sh4n, drape_sh3n, drapeg, output)
Definition genoutp.F:82
outp_r_s
subroutine outp_r_s(nbx, key, text, elbuf_tab, iparg, dd_iad, sizloc, sizp0, siz_wr)
Definition outp_r_s.F:34
count_arsz_rs
subroutine count_arsz_rs(iparg, dd_iad, wasz, siz_write_loc)
Definition outp_r_s.F:175
spmd_rgather9_1comm
subroutine spmd_rgather9_1comm(v, sizv, len, vp0, sizv0, adress)
Definition spmd_outp.F:1177