OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_readp.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!|| section_readp ../engine/source/tools/sect/section_readp.F
25!||--- called by ------------------------------------------------------
26!|| section_fio ../engine/source/tools/sect/section_fio.F
27!|| section_io ../engine/source/tools/sect/section_io.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../engine/source/output/message/message.F
30!|| arret ../engine/source/system/arret.F
31!|| close_c ../common_source/tools/input_output/write_routines.c
32!|| cur_fil_c ../common_source/tools/input_output/write_routines.c
33!|| open_c ../common_source/tools/input_output/write_routines.c
34!|| read_i_c ../common_source/tools/input_output/write_routines.c
35!|| read_r_c ../common_source/tools/input_output/write_routines.c
36!|| spmd_rbcast ../engine/source/mpi/generic/spmd_rbcast.F
37!|| spmd_sd_cut ../engine/source/mpi/sections/spmd_section.F
38!||--- uses -----------------------------------------------------
39!|| inoutfile_mod ../common_source/modules/inoutfile_mod.F
40!|| message_mod ../engine/share/message_module/message_mod.F
41!||====================================================================
42 SUBROUTINE section_readp(TTT,NSTRF,SECBUF,NNODT,IAD_CUT,FR_CUT)
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE message_mod
47 USE inoutfile_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "com08_c.inc"
58#include "task_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER NNODT, NSTRF(*), IAD_CUT(NSPMD+2,*), FR_CUT(*)
63 my_real ttt, secbuf(*)
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 integer
68 . i, n, kr1,kr2,kr3,k0,kr0,kc,iflg,
69 . ir1, ir2, ifrl1, ifrl2, found, nr, l, ll, nsecr, id_sec,nnodg,
70 . TYPE, ifilnam(2148), LROOTLEN, NNOD,IR, NNODR,
71 . IEXTRA, ADDSEC(2*NSECT)
72 my_real tt1, tt2, tt3, bufcom(3*nsect+7), secbufg(24*nnodt)
73 CHARACTER FILNAM*12,LCHRUN*2
74 LOGICAL FEXIST
75 real*4 r4
76
77 INTEGER :: LEN_TMP_NAME
78 CHARACTER(len=2048) :: TMP_NAME
79C-----------------------------------------------
80C read file in the order of the sections read from the file
81C TTT = TT ou TT + DT2
82C-----------------------------------------------
83C debranchement pi <> p0
84 IF(ispmd/=0) GO TO 100
85C Init buffer communication
86 DO i = 1, nsect
87 bufcom(i) = zero
88 bufcom(i+nsect) = zero
89 bufcom(i+2*nsect) = zero
90 addsec(i) = zero
91 addsec(i+nsect) = zero
92 END DO
93C
94 tt1 = secbuf(2)
95 tt2 = secbuf(3)
96 tt3 = secbuf(4)
97 iextra=nstrf(3)
98 IF(nstrf(2)>=1.AND.ttt>=tt2.AND.iextra==0
99 . .AND. ttt <= tstop)THEN
100 ifrl1=nstrf(7)
101 ifrl2=mod(ifrl1+1,2)
102 ll=1
103 IF(ispmd==0) THEN
104 CALL cur_fil_c(4)
105 END IF
106 DO WHILE(tt2<=ttt) ! Loop until Next timestep in SC01 file is reached / Keep only last state
107 l = 0
108 DO i = 1, nsect ! In case of restart : looping over sections Times to reach good state
109 bufcom(i) = zero ! reset BUFCOM and ADDSEC, otherwise values from previous step are kept
110 bufcom(i+nsect) = zero
111 bufcom(i+2*nsect) = zero
112 addsec(i) = zero
113 addsec(i+nsect) = zero
114 END DO
115
116 ifrl1=ifrl2
117 ifrl2=mod(ifrl1+1,2)
118 CALL read_r_c(r4,1)
119C test EOF-------------------------------------------------------------------
120 IF(r4>=0.0)THEN
121 tt1=tt2
122 tt2=r4
123 ELSEIF(tt3==ep30)THEN
124 CALL close_c()
125 iextra=1
126 nstrf(3)=iextra
127 GOTO 100
128 ELSE
129 CALL close_c()
130 ir2=nstrf(5)
131 ir1=ir2
132 ir=ir1
133 lrootlen=0
134 DO i=1,8
135 filnam(i:i)=char(nstrf(15+i))
136 IF(filnam(i:i)/=' ')lrootlen=lrootlen+1
137 ENDDO
138 dowhile(tt3<=ttt.AND.ir<100)
139 ir=ir+1
140 WRITE(lchrun,'(I2.2)')ir
141 filnam=filnam(1:lrootlen)//'SC'//lchrun
142 INQUIRE(file=filnam,exist=fexist)
143
144 IF(.NOT.fexist) THEN
145 len_tmp_name = outfile_name_len +len_trim(filnam)
146 tmp_name(1:len_tmp_name)=outfile_name(1:outfile_name_len)//filnam(1:lrootlen+4)
147 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
148 ENDIF
149
150 IF(fexist)THEN
151 ir2=ir
152 CALL cur_fil_c(4)
153 DO i=1,len_tmp_name
154 ifilnam(i)=ichar(tmp_name(i:i))
155 ENDDO
156
157 CALL open_c(ifilnam,tmp_name,1)
158 CALL read_r_c(r4,1)
159 CALL close_c()
160 tt3=r4
161 ENDIF
162 ENDDO
163 IF(ir==100)THEN
164 tt3=ep30
165 iextra=1
166 nstrf(3)=iextra
167 GOTO 100
168 ENDIF
169 WRITE(lchrun,'(I2.2)')ir1
170 filnam=filnam(1:lrootlen)//'SC'//lchrun
171 len_tmp_name = outfile_name_len + len_trim(filnam)
172 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
173 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
174
175 IF(.NOT.fexist) THEN
176 len_tmp_name = len_trim(filnam)
177 tmp_name(1:len_tmp_name)=filnam(1:len_tmp_name)
178 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
179 ENDIF
180
181 CALL cur_fil_c(4)
182 DO i=1,len_tmp_name
183 ifilnam(i)=ichar(tmp_name(i:i))
184 ENDDO
185
186 CALL open_c(ifilnam,len_tmp_name,1)
187C
188 secbuf(4) = tt3
189C
190 nstrf(4) = ir1
191 nstrf(5) = ir2
192C
193 CALL read_r_c(r4,1)
194 IF(r4 /= zero) l = 0
195 tt1=tt2
196 tt2=r4
197 ENDIF
198C-----------------------------------------------
199 CALL read_i_c(ll,1)
200 CALL read_i_c(nsecr,1)
201 DO nr=1,nsecr
202 CALL read_i_c(id_sec,1)
203 k0 = nstrf(25)
204 kr0 = nstrf(26)
205 found=0
206 n=0
207 dowhile(found==0.AND.n<nsect)
208 n=n+1
209 IF(id_sec==nstrf(k0+23))THEN
210 found=1
211 ELSE
212C KR0 = NSTRF(K0+25)
213 k0 = nstrf(k0+24)
214 ENDIF
215 ENDDO
216 IF(found==1) THEN
217 nnod = iad_cut(nspmd+2,n)
218 END IF
219C NNOD = NSTRF(K0+6)
220C KR1 = KR0 + 10 + IFRL1*6*NNOD
221C KR2 = KR1 + 12*NNOD
222C KR3 = KR2 + 12*NNOD
223 CALL read_i_c(TYPE,1)
224 CALL read_i_c(nnodr,1)
225 IF (nnod/=nnodr .AND. found == 1) THEN
226 CALL ancmsg(msgid=35,anmode=aninfo_blind,
227 . i1=id_sec,i2=nnodr,i3=nnod)
228 CALL arret(2)
229 END IF
230 IF(found==0.OR.nstrf(k0)<100)THEN
231C skip displacements and forces
232 IF(type>=1)THEN
233 DO i=1,6*nnodr
234 CALL read_r_c(r4,1)
235 ENDDO
236 ENDIF
237 IF(type>=2)THEN
238 DO i=1,6*nnodr
239 CALL read_r_c(r4,1)
240 ENDDO
241 ENDIF
242 ELSEIF(nstrf(k0)==100)THEN
243C Reading Deplacements
244 IF(type>=1)THEN
245 bufcom(n) = 1
246 bufcom(n+nsect+ifrl1*nsect) = 1
247 addsec(n+ifrl1*nsect) = l+1
248 DO i=1,nnod
249 CALL read_r_c(r4,1)
250 secbufg(l+1)=r4
251 CALL read_r_c(r4,1)
252 secbufg(l+2)=r4
253 CALL read_r_c(r4,1)
254 secbufg(l+3)=r4
255 CALL read_r_c(r4,1)
256 secbufg(l+4)=r4
257 CALL read_r_c(r4,1)
258 secbufg(l+5)=r4
259 CALL read_r_c(r4,1)
260 secbufg(l+6)=r4
261 l = l + 6
262 ENDDO
263 ELSE
264C compatibility issue type_new>=100 and type_old<1
265 ENDIF
266 IF(type>=2)THEN
267C skip forces
268 DO i=1,6*nnod
269 CALL read_r_c(r4,1)
270 ENDDO
271 ENDIF
272 ELSEIF(nstrf(k0)==101)THEN
273C Reading Deplacements
274 IF(type>=1)THEN
275 bufcom(n) = 1
276 bufcom(n+nsect+ifrl1*nsect) = 1
277 addsec(n+ifrl1*nsect) = l+1
278 DO i=1,nnod
279 CALL read_r_c(r4,1)
280 secbufg(l+1)=r4
281 CALL read_r_c(r4,1)
282 secbufg(l+2)=r4
283 CALL read_r_c(r4,1)
284 secbufg(l+3)=r4
285 CALL read_r_c(r4,1)
286 secbufg(l+4)=r4
287 CALL read_r_c(r4,1)
288 secbufg(l+5)=r4
289 CALL read_r_c(r4,1)
290 secbufg(l+6)=r4
291 l = l + 6
292 ENDDO
293 ELSE
294C compatibility issue type_new>=101 and type_old<1
295 ENDIF
296 IF(type>=2)THEN
297C reading forces
298 bufcom(n) = 2
299c BUFCOM(N+NSECT+IFRL1*NSECT) = 1
300c ADDSEC(N+IFRL1*NSECT) = L+1
301 DO i=1,nnod
302 CALL read_r_c(r4,1)
303 secbufg(l+1)=r4
304 CALL read_r_c(r4,1)
305 secbufg(l+2)=r4
306 CALL read_r_c(r4,1)
307 secbufg(l+3)=r4
308 CALL read_r_c(r4,1)
309 secbufg(l+4)=r4
310 CALL read_r_c(r4,1)
311 secbufg(l+5)=r4
312 CALL read_r_c(r4,1)
313 secbufg(l+6)=r4
314 l = l + 6
315 ENDDO
316 ELSE
317C compatibility issue type_new>=101 and type_old<2
318 ENDIF
319 ELSEIF(nstrf(k0)>=102)THEN
320C a faire
321 ENDIF
322 ENDDO
323 ENDDO
324C-----------------------------------------------
325 secbuf(2) = tt1
326 secbuf(3) = tt2
327C
328 nstrf(7) = ifrl1
329 ENDIF
330 bufcom(3*nsect+1) = nstrf(3)
331 bufcom(3*nsect+2) = nstrf(4)
332 bufcom(3*nsect+3) = nstrf(5)
333 bufcom(3*nsect+4) = nstrf(7)
334 bufcom(3*nsect+5) = secbuf(2)
335 bufcom(3*nsect+6) = secbuf(3)
336 bufcom(3*nsect+7) = secbuf(4)
337 100 CONTINUE
338 CALL spmd_rbcast(bufcom,bufcom,3*nsect+7,1,0,2)
339 IF(ispmd/=0) THEN
340 nstrf(3) = nint(bufcom(3*nsect+1))
341 nstrf(4) = nint(bufcom(3*nsect+2))
342 nstrf(5) = nint(bufcom(3*nsect+3))
343 nstrf(7) = nint(bufcom(3*nsect+4))
344 secbuf(2) = bufcom(3*nsect+5)
345 secbuf(3) = bufcom(3*nsect+6)
346 secbuf(4) = bufcom(3*nsect+7)
347 END IF
348C
349C Treatment Passage from Secou
350C
351 l = 1
352 kc = 1
353 k0 = nstrf(25)
354 kr0 = nstrf(26)
355 DO i = 1, nsect
356 IF(nint(bufcom(i))>0) THEN
357 IF(ispmd==0) THEN
358 nnodg = iad_cut(nspmd+2,i)
359 ELSE
360 nnodg = 0
361 END IF
362 nnod = nstrf(k0+6)
363 iflg = nint(bufcom(i))
364 IF(nint(bufcom(nsect+i))==1) THEN
365C SECUBUF filling with IFRL1 = 0
366 ifrl1 = 0
367 kr1 = kr0 + 10 + ifrl1*6*nnod
368 kr2 = kr1 + 12*nnod
369 kr3 = kr2 + 12*nnod
370 IF(ispmd==0) THEN
371 l = addsec(i+ifrl1*nsect)
372 END IF
373 CALL spmd_sd_cut(
374 1 secbufg(l),nnodg ,secbuf(kr1),secbuf(kr2),nnod,
375 2 fr_cut(kc),iad_cut(1,i),iflg )
376 END IF
377 IF(nint(bufcom(2*nsect+i))==1) THEN
378C SECUBUF filling with IFRL1 = 1
379 ifrl1 = 1
380 kr1 = kr0 + 10 + ifrl1*6*nnod
381 kr2 = kr1 + 12*nnod
382 kr3 = kr2 + 12*nnod
383 IF(ispmd==0) THEN
384 l = addsec(i+ifrl1*nsect)
385 END IF
386 CALL spmd_sd_cut(
387 1 secbufg(l),nnodg ,secbuf(kr1),secbuf(kr2),nnod,
388 2 fr_cut(kc),iad_cut(1,i),iflg )
389 END IF
390 END IF
391 IF(nstrf(k0)>=100.AND.ispmd==0) THEN
392 kc = kc + iad_cut(nspmd+1,i)
393 END IF
394 kr0 = nstrf(k0+25)
395 k0 = nstrf(k0+24)
396 END DO
397C
398 RETURN
399 END
my_real
#define my_real
Definition cppsort.cpp:32
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::outfile_name
character(len=outfile_char_len) outfile_name
Definition inoutfile_mod.F:111
inoutfile_mod::outfile_name_len
integer outfile_name_len
Definition inoutfile_mod.F:109
message_mod
Definition message_mod.F:1257
section_readp
subroutine section_readp(ttt, nstrf, secbuf, nnodt, iad_cut, fr_cut)
Definition section_readp.F:43
spmd_rbcast
subroutine spmd_rbcast(tabi, tabr, n1, n2, from, add)
Definition spmd_rbcast.F:62
spmd_sd_cut
subroutine spmd_sd_cut(secbufg, nnodg, secbuf1, secbuf2, nnod, fr_cut, iad_cut, iflg)
Definition spmd_section.F:1395
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86
read_i_c
void read_i_c(int *w, int *len)
Definition write_routines.c:805
close_c
void close_c()
Definition write_routines.c:298
cur_fil_c
void cur_fil_c(int *nf)
Definition write_routines.c:477
read_r_c
void read_r_c(float *w, int *len)
Definition write_routines.c:756
open_c
void open_c(int *ifil, int *len, int *mod)
Definition write_routines.c:180