OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_init.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com08_c.inc"
#include "chara_c.inc"
#include "warn_c.inc"
#include "task_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine section_init (nstrf, secbuf, nom_sect, isectr, nsect, ioldsect)

Function/Subroutine Documentation

◆ section_init()

subroutine section_init ( integer, dimension(*) nstrf,
secbuf,
integer, dimension(*) nom_sect,
integer isectr,
integer nsect,
integer ioldsect )

Definition at line 39 of file section_init.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE inoutfile_mod
45 USE names_and_titles_mod, ONLY: nchartitle
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 "com08_c.inc"
55#include "chara_c.inc"
56#include "warn_c.inc"
57#include "task_c.inc"
58#include "com01_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER NSTRF(*),NOM_SECT(*),ISECTR,NSECT,IOLDSECT
63 my_real
64 . secbuf(*)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I,J,IR, N, IR1, IR2, IFILNAM(2548),LROOTLEN,LEN,K0,ID_SEC
69 my_real
70 . tt1, tt2, tt3, tmp(20)
71 CHARACTER(LEN=NCHARTITLE) :: FILNAM
72 CHARACTER LCHRUN*2,LCHRUN_P1*2,CH_IDSEC*10
73 LOGICAL FEXIST
74 real*4 r4
75 INTEGER :: LEN_TMP_NAME
76 CHARACTER(len=2048) :: TMP_NAME
77C-----------------------------------------------
78 tt1 = secbuf(2)
79 tt2 = secbuf(3)
80 tt3 = secbuf(4)
81 ir1=nstrf(4)
82 ir2=nstrf(5)
83C-----------------------------------------------
84C WRITE FILE
85C-----------------------------------------------
86 IF (ispmd==0) THEN
87 k0 = nstrf(25)
88 DO j=1,nsect
89 IF(nstrf(k0)>=1 .AND. nstrf(k0)<=10 )THEN
90 WRITE(lchrun,'(I2.2)')irun
91 lrootlen=0
92 DO i=1,500
93c
94 filnam(i:i)=char(nom_sect((j-1)*500+i))
95 IF(filnam(i:i)/=' ')lrootlen=lrootlen+1
96 ENDDO
97 IF (lrootlen == 0 .AND. abs(ioldsect) == 1) THEN
98 ioldsect = 1
99 ELSEIF( lrootlen /= 0 .AND. (ioldsect >= 1)) THEN
100 ioldsect = 2
101 ENDIF
102 ENDIF
103 k0 = nstrf(k0+24)
104 ENDDO
105 IF(nstrf(1)>=1 .AND. ioldsect == 1)THEN
106C FILNAM=ROOTNAM(1:ROOTLEN)//'SC'//CHRUN
107 WRITE(lchrun,'(I2.2)')irun
108 filnam=rootnam(1:rootlen)//'SC'//lchrun
109 len_tmp_name = outfile_name_len + rootlen + 4
110 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:rootlen+4)
111 DO i=1,len_tmp_name
112 ifilnam(i)=ichar(tmp_name(i:i))
113 ENDDO
114 CALL cur_fil_c(42)
115 CALL open_c(ifilnam,len_tmp_name,0)
116 ELSEIF(nstrf(1)>=1) THEN
117 k0 = nstrf(25)
118 DO j=1,nsect
119 IF(nstrf(k0)>=1 .AND. nstrf(k0)<=10 )THEN
120 WRITE(lchrun,'(I2.2)')irun
121 lrootlen=0
122 DO i=1,500
123c
124 IF(char(nom_sect((j-1)*500+i))/=' ')THEN
125 lrootlen=lrootlen+1
126 filnam(lrootlen:lrootlen)=char(nom_sect((j-1)*500+i))
127 ENDIF
128 ENDDO
129 IF (lrootlen == 0) THEN
130 WRITE(ch_idsec,'(I10.10)')nstrf(k0+23)
131 filnam=rootnam(1:rootlen)//ch_idsec//'SC'//lchrun
132 len_tmp_name = outfile_name_len + rootlen + 14
133 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:rootlen+14)
134 DO i=1,len_tmp_name
135 ifilnam(i)=ichar(tmp_name(i:i))
136 ENDDO
137 CALL cur_fil_c(41+j)
138 CALL open_c(ifilnam,len_tmp_name,0)
139 ELSE
140 filnam=filnam(1:lrootlen)//'SC'//lchrun
141 len_tmp_name = outfile_name_len + lrootlen + 4
142 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:lrootlen+4)
143 DO i=1,len_tmp_name
144 ifilnam(i)=ichar(tmp_name(i:i))
145 ENDDO
146 CALL cur_fil_c(41+j)
147 CALL open_c(ifilnam,len_tmp_name,0)
148 ENDIF
149 ENDIF
150 k0 = nstrf(k0+24)
151 ENDDO
152 ENDIF
153C-----------------------------------------------
154C READ FILES
155C-----------------------------------------------
156 IF(nstrf(2)>=1)THEN
157 lrootlen=0
158 DO i=1,500
159c
160 filnam(i:i)=char(nom_sect((isectr-1)*500+i))
161 IF(filnam(i:i)/=' ')lrootlen=lrootlen+1
162 ENDDO
163 IF(tt==zero)THEN
164 tt1=zero
165 tt2=zero
166 filnam=filnam(1:lrootlen)//'SC01'
167 len_tmp_name = outfile_name_len + lrootlen + 4
168 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:lrootlen+4)
169 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
170
171 IF(.NOT.fexist) THEN
172 len_tmp_name = lrootlen + 4
173 tmp_name(1:len_tmp_name)=filnam(1:lrootlen+4)
174 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
175 ENDIF
176
177 IF(fexist)THEN
178 CALL cur_fil_c(4)
179 DO i=1,len_tmp_name
180 ifilnam(i)=ichar(tmp_name(i:i))
181 ENDDO
182 CALL open_c(ifilnam,len_tmp_name,1)
183 CALL read_r_c(r4,1)
184 CALL close_c()
185 tt1=r4
186 ir1=1
187 ir2=1
188 ELSE
189 CALL ancmsg(msgid=188,anmode=aninfo,
190 . c1=filnam)
191 ierr=ierr+1
192 tstop = tt
193 ENDIF
194 filnam=filnam(1:lrootlen)//'SC02'
195 len_tmp_name = outfile_name_len + lrootlen + 4
196 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:lrootlen+4)
197
198 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
199
200 IF(.NOT.fexist) THEN
201 len_tmp_name = lrootlen + 4
202 tmp_name(1:len_tmp_name)=filnam(1:lrootlen+4)
203 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
204 ENDIF
205
206 IF(fexist)THEN
207 ir2=2
208 CALL cur_fil_c(4)
209 DO i=1,len_tmp_name!LROOTLEN+4
210 ifilnam(i)=ichar(filnam(i:i))
211 ENDDO
212
213 CALL open_c(ifilnam,len_tmp_name,1)
214 CALL read_r_c(r4,1)
215 CALL close_c()
216 tt3=r4
217 ELSE
218 tt3=ep30
219 ENDIF
220 ELSE
221 tt1=zero
222 tt2=zero
223 WRITE(lchrun,'(I2.2)')irun
224 filnam=filnam(1:lrootlen)//'SC'//lchrun
225 len_tmp_name = outfile_name_len + len_trim(filnam)
226 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
227
228 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
229
230 IF(.NOT.fexist) THEN
231 len_tmp_name = len_trim(filnam)
232 tmp_name(1:len_tmp_name)=filnam(1:len_trim(filnam))
233 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
234 ENDIF
235
236 IF(fexist)THEN
237 CALL cur_fil_c(4)
238 DO i=1,len_tmp_name
239 ifilnam(i)=ichar(tmp_name(i:i))
240 ENDDO
241
242 CALL open_c(ifilnam,len_tmp_name,1)
243 CALL read_r_c(r4,1)
244 CALL close_c()
245 tt1=r4
246 ir1=irun
247 ir2=irun
248 ELSE
249 CALL ancmsg(msgid=188,anmode=aninfo,
250 . c1=filnam)
251 ierr=ierr+1
252 tstop = tt
253 ENDIF
254 WRITE(lchrun_p1,'(I2.2)')irun+1
255 filnam=filnam(1:lrootlen)//'SC'//lchrun_p1
256 len_tmp_name = outfile_name_len + len_trim(filnam)
257 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
258
259 INQUIRE(file=tmp_name,exist=fexist)
260
261 IF(.NOT.fexist) THEN
262 len_tmp_name = len_trim(filnam)
263 tmp_name(1:len_tmp_name)=filnam(1:len_tmp_name)
264 INQUIRE(file=tmp_name(1:len_trim(tmp_name)),exist=fexist)
265 ENDIF
266
267 IF(fexist)THEN
268 ir2=irun + 1
269 CALL cur_fil_c(4)
270 DO i=1,len_tmp_name
271 ifilnam(i)=ichar(tmp_name(i:i))
272 ENDDO
273
274 CALL open_c(ifilnam,len_tmp_name,1)
275 CALL read_r_c(r4,1)
276 CALL close_c()
277 tt3=r4
278 ELSE
279 tt3=ep30
280 ENDIF
281 ENDIF
282C
283 WRITE(lchrun,'(I2.2)')ir1
284 filnam=filnam(1:lrootlen)//'SC'//lchrun
285 len_tmp_name = outfile_name_len + len_trim(filnam)
286 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
287
288 CALL cur_fil_c(4)
289 DO i=1,len_tmp_name
290 ifilnam(i)=ichar(tmp_name(i:i))
291 ENDDO
292
293 CALL open_c(ifilnam,len_tmp_name,1)
294 ENDIF
295 ENDIF
296C-----------------------------------------------
297 secbuf(2) = tt1
298 secbuf(3) = tt2
299 secbuf(4) = tt3
300C
301 nstrf(4) = ir1
302 nstrf(5) = ir2
303C
304C MAJ SPMD sur proc remote
305C
306 IF (nspmd > 1) THEN
307 IF(ispmd==0) THEN
308 tmp(1) = nstrf(4)
309 tmp(2) = nstrf(5)
310 tmp(3) = secbuf(2)
311 tmp(4) = secbuf(3)
312 tmp(5) = secbuf(4)
313 len = 5
314C 2*LEN necessaire pour communication !!!
315 CALL spmd_rbcast(tmp,tmp,len,1,0,2)
316 ELSE
317 len = 5
318C 2*LEN necessaire pour communication !!!
319 CALL spmd_rbcast(tmp,tmp,len,1,0,2)
320 nstrf(4) = tmp(1)
321 nstrf(5) = tmp(2)
322 secbuf(2)= tmp(3)
323 secbuf(3)= tmp(4)
324 secbuf(4)= tmp(5)
325 ENDIF
326 END IF
327C
328 RETURN
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
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::lchrun
integer, parameter lchrun
Definition names_and_titles_mod.F:1009
spmd_rbcast
subroutine spmd_rbcast(tabi, tabr, n1, n2, from, add)
Definition spmd_rbcast.F:62
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
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