OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outp_r_s.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "scr16_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine outp_r_s (nbx, key, text, elbuf_tab, iparg, dd_iad, sizloc, sizp0, siz_wr)
subroutine count_arsz_rs (iparg, dd_iad, wasz, siz_write_loc)

Function/Subroutine Documentation

◆ count_arsz_rs()

subroutine count_arsz_rs ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer wasz,
integer, dimension(nspgroup+1) siz_write_loc )

Definition at line 174 of file outp_r_s.F.

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

◆ outp_r_s()

subroutine outp_r_s ( integer nbx,
character*10 key,
character*40 text,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer sizloc,
integer sizp0,
integer siz_wr )

Definition at line 32 of file outp_r_s.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
spmd_rgather9_1comm
subroutine spmd_rgather9_1comm(v, sizv, len, vp0, sizv0, adress)
Definition spmd_outp.F:1177