OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_read.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_read ../engine/source/tools/sect/section_read.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!||--- uses -----------------------------------------------------
37!|| inoutfile_mod ../common_source/modules/inoutfile_mod.F
38!|| message_mod ../engine/share/message_module/message_mod.F
39!||====================================================================
40 SUBROUTINE section_read (TTT,NSTRF ,SECBUF)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE message_mod
45 USE inoutfile_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "comlock.inc"
54#include "com04_c.inc"
55#include "com08_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER NSTRF(*)
60 my_real ttt, secbuf(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER J, I, K, II, I1, I2, N, KR1,KR2,KR3,K0,KR0,K1,K2,
65 . IR1, IR2, IFRL1, IFRL2, FOUND, NR, L, NSECR, ID_SEC,
66 . TYPE, IFILNAM(2148), LROOTLEN, LREC, NNOD,IR, NNODR,KR11,KR12,
67 . KR21,KR22,NBINTER,IEXTRA
68 my_real tt1, tt2, tt3
69 CHARACTER FILNAM*12,LCHRUN*2
70 LOGICAL FEXIST
71 real*4 r4
72 INTEGER :: LEN_TMP_NAME
73 CHARACTER(len=2048) :: TMP_NAME
74
75C-----------------------------------------------
76C READ FILE dans l'ordre des sections lues sur le fichier
77C TTT = TT ou TT + DT2
78C-----------------------------------------------
79
80 tt1 = secbuf(2)
81 tt2 = secbuf(3)
82 tt3 = secbuf(4)
83 iextra=nstrf(3)
84 IF(nstrf(2)>=1.AND.ttt>=tt2.AND.iextra==0
85 . .AND. ttt <= tstop)THEN
86 ifrl1=nstrf(7)
87 ifrl2=mod(ifrl1+1,2)
88 l=1
89 CALL cur_fil_c(4)
90 dowhile(tt2<=ttt)
91 ifrl1=ifrl2
92 ifrl2=mod(ifrl1+1,2)
93 CALL read_r_c(r4,1)
94C test EOF-------------------------------------------------------------------
95 IF(r4>=0.0)THEN
96 tt1=tt2
97 tt2=r4
98 ELSEIF(tt3==ep30)THEN
99 CALL close_c()
100 iextra=1
101 nstrf(3)=iextra
102 GOTO 100
103 ELSE
104 CALL close_c()
105 ir2=nstrf(5)
106 ir1=ir2
107 ir=ir1
108 lrootlen=0
109 DO i=1,8
110 filnam(i:i)=char(nstrf(15+i))
111 IF(filnam(i:i)/=' ')lrootlen=lrootlen+1
112 ENDDO
113 dowhile(tt3<=ttt.AND.ir<100)
114 ir=ir+1
115 WRITE(lchrun,'(I2.2)')ir
116 filnam=filnam(1:lrootlen)//'SC'//lchrun
117 len_tmp_name = outfile_name_len + len_trim(filnam)
118 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
119 INQUIRE(file=tmp_name(1:len_tmp_name),exist=fexist)
120
121 IF(.NOT.fexist) THEN
122 len_tmp_name = len_trim(filnam)
123 tmp_name(1:len_tmp_name)=filnam(1:len_tmp_name)
124 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
125 ENDIF
126
127 IF(fexist)THEN
128 ir2=ir
129 CALL cur_fil_c(4)
130 DO i=1,len_tmp_name
131 ifilnam(i)=ichar(tmp_name(i:i))
132 ENDDO
133 CALL open_c(ifilnam,len_tmp_name,1)
134 CALL read_r_c(r4,1)
135 CALL close_c()
136 tt3=r4
137 ENDIF
138 ENDDO
139 IF(ir==100)THEN
140 tt3=ep30
141 iextra=1
142 nstrf(3)=iextra
143 GOTO 100
144 ENDIF
145 WRITE(lchrun,'(I2.2)')ir1
146 filnam=filnam(1:lrootlen)//'SC'//lchrun
147 len_tmp_name = outfile_name_len + len_trim(filnam)
148 tmp_name(1:len_tmp_name)=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
149 INQUIRE(file=tmp_name(1:len_tmp_name),exist=fexist)
150
151 IF(.NOT.fexist) THEN
152 len_tmp_name = len_trim(filnam)
153 tmp_name(1:len_tmp_name)=filnam(1:len_tmp_name)
154 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
155 ENDIF
156
157 CALL cur_fil_c(4)
158 DO i=1,len_tmp_name
159 ifilnam(i)=ichar(tmp_name(i:i))
160 ENDDO
161
162 CALL open_c(ifilnam,len_tmp_name,1)
163C
164 secbuf(4) = tt3
165C
166 nstrf(4) = ir1
167 nstrf(5) = ir2
168C
169 CALL read_r_c(r4,1)
170 tt1=tt2
171 tt2=r4
172 ENDIF
173C-----------------------------------------------
174 CALL read_i_c(l,1)
175 CALL read_i_c(nsecr,1)
176 DO nr=1,nsecr
177 CALL read_i_c(id_sec,1)
178 k0 = nstrf(25)
179 kr0 = nstrf(26)
180 found=0
181 n=0
182 dowhile(found==0.AND.n<nsect)
183 n=n+1
184 IF(id_sec==nstrf(k0+23))THEN
185 found=1
186 ELSE
187 kr0 = nstrf(k0+25)
188 k0 = nstrf(k0+24)
189 ENDIF
190 ENDDO
191 nnod = nstrf(k0+6)
192 kr1 = kr0 + 10 + ifrl1*6*nnod
193 kr2 = kr1 + 12*nnod
194 kr3 = kr2 + 12*nnod
195 CALL read_i_c(TYPE,1)
196 CALL read_i_c(nnodr,1)
197 IF (nnod/=nnodr .AND. found == 1) THEN
198 CALL ancmsg(msgid=35,anmode=aninfo_blind,
199 . i1=id_sec,i2=nnodr,i3=nnod)
200 CALL arret(2)
201 END IF
202 IF(found==0.OR.nstrf(k0)<100)THEN
203C skip deplacements et forces
204 IF(type>=1)THEN
205 DO i=1,6*nnodr
206 CALL read_r_c(r4,1)
207 ENDDO
208 ENDIF
209 IF(type>=2)THEN
210 DO i=1,6*nnodr
211 CALL read_r_c(r4,1)
212 ENDDO
213 ENDIF
214 ELSEIF(nstrf(k0)==100)THEN
215C lecture deplacements
216 IF(type>=1)THEN
217 DO i=1,nnod
218 CALL read_r_c(r4,1)
219 secbuf(kr1+6*i-6)=r4
220 CALL read_r_c(r4,1)
221 secbuf(kr1+6*i-5)=r4
222 CALL read_r_c(r4,1)
223 secbuf(kr1+6*i-4)=r4
224 CALL read_r_c(r4,1)
225 secbuf(kr1+6*i-3)=r4
226 CALL read_r_c(r4,1)
227 secbuf(kr1+6*i-2)=r4
228 CALL read_r_c(r4,1)
229 secbuf(kr1+6*i-1)=r4
230 ENDDO
231 ELSE
232C Pb de compatibilite type_new>=100 et type_old<1
233 ENDIF
234 IF(type>=2)THEN
235C skip forces
236 DO i=1,6*nnod
237 CALL read_r_c(r4,1)
238 ENDDO
239 ENDIF
240 ELSEIF(nstrf(k0)==101)THEN
241C lecture deplacements
242 IF(type>=1)THEN
243 DO i=1,nnod
244 CALL read_r_c(r4,1)
245 secbuf(kr1+6*i-6)=r4
246 CALL read_r_c(r4,1)
247 secbuf(kr1+6*i-5)=r4
248 CALL read_r_c(r4,1)
249 secbuf(kr1+6*i-4)=r4
250 CALL read_r_c(r4,1)
251 secbuf(kr1+6*i-3)=r4
252 CALL read_r_c(r4,1)
253 secbuf(kr1+6*i-2)=r4
254 CALL read_r_c(r4,1)
255 secbuf(kr1+6*i-1)=r4
256 ENDDO
257 ELSE
258C Pb de compatibilite type_new>=101 et type_old<1
259 ENDIF
260 IF(type>=2)THEN
261C lecture forces
262 DO i=1,nnod
263 CALL read_r_c(r4,1)
264 secbuf(kr2+6*i-6)=r4
265 CALL read_r_c(r4,1)
266 secbuf(kr2+6*i-5)=r4
267 CALL read_r_c(r4,1)
268 secbuf(kr2+6*i-4)=r4
269 CALL read_r_c(r4,1)
270 secbuf(kr2+6*i-3)=r4
271 CALL read_r_c(r4,1)
272 secbuf(kr2+6*i-2)=r4
273 CALL read_r_c(r4,1)
274 secbuf(kr2+6*i-1)=r4
275 ENDDO
276 ELSE
277C Pb de compatibilite type_new>=101 et type_old<2
278 ENDIF
279 ELSEIF(nstrf(k0)>=102)THEN
280C a faire
281 ENDIF
282 ENDDO
283 ENDDO
284C-----------------------------------------------
285 secbuf(2) = tt1
286 secbuf(3) = tt2
287C
288 nstrf(7) = ifrl1
289 ENDIF
290 100 CONTINUE
291C
292 RETURN
293 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_read
subroutine section_read(ttt, nstrf, secbuf)
Definition section_read.F:41
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:889
arret
subroutine arret(nn)
Definition arret.F:87
read_i_c
void read_i_c(int *w, int *len)
Definition write_routtines.c:805
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