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_routtines.c
32!|| cur_fil_c ../common_source/tools/input_output/write_routtines.c
33!|| open_c ../common_source/tools/input_output/write_routtines.c
34!|| read_i_c ../common_source/tools/input_output/write_routtines.c
35!|| read_r_c ../common_source/tools/input_output/write_routtines.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 . j, i, k, ii, i1, i2, n, kr1,kr2,kr3,k0,kr0,k1,k2,kc,iflg,
69 . ir1, ir2, ifrl1, ifrl2, found, nr, l, ll, nsecr, id_sec,nnodg,
70 . TYPE, ifilnam(2148), LROOTLEN, LREC, NNOD,IR, NNODR,KR11,KR12,
71 . KR21,KR22,NBINTER,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 dans l'ordre des sections lues sur le fichier
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.NOT. IF(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.AND. DOWHILE(FOUND==0N<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.AND. IF (NNOD/=NNODR 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.OR. IF(FOUND==0NSTRF(K0)<100)THEN
231C skip deplacements et 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 lecture 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 Pb de compatibilite type_new>=100 et 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 lecture 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 Pb de compatibilite type_new>=101 et type_old<1
295 ENDIF
296 IF(TYPE>=2)THEN
297C lecture 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 Pb de compatibilite type_new>=101 et 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 Traitement Passage de SECBUFG a SECBUF local
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 remplissage secbuf avec 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 remplissage secbuf avec 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.AND. IF(NSTRF(K0)>=100ISPMD==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:1249
section_readp
subroutine section_readp(ttt, nstrf, secbuf, nnodt, iad_cut, fr_cut)
Definition section_readp.F:43
close_c
void close_c()
Definition write_routtines.c:298
cur_fil_c
void cur_fil_c(int *nf)
Definition write_routtines.c:477
read_r_c
void read_r_c(float *w, int *len)
Definition write_routtines.c:756
open_c
void open_c(int *ifil, int *len, int *mod)
Definition write_routtines.c:180