OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecnoise.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "scrnoi_c.inc"
#include "chara_c.inc"
#include "scr05_c.inc"
#include "scr13_c.inc"
#include "titr_c.inc"
#include "task_c.inc"
#include "warn_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine lecnoise (inoise, itabm1, names_and_titles)

Function/Subroutine Documentation

◆ lecnoise()

subroutine lecnoise ( integer, dimension(*) inoise,
integer, dimension(*) itabm1,
type(names_and_titles_), intent(inout) names_and_titles )
Parameters
[in,out]names_and_titlesNAMES_AND_TITLES host the input deck names and titles for outputs

Definition at line 44 of file lecnoise.F.

45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE message_mod
49 USE inoutfile_mod
50 USE names_and_titles_mod,only:names_and_titles_,ltitle
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "units_c.inc"
61#include "scrnoi_c.inc"
62#include "chara_c.inc"
63#include "scr05_c.inc"
64#include "scr13_c.inc"
65#include "titr_c.inc"
66#include "task_c.inc"
67#include "warn_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER INOISE(*), ITABM1(*)
72 TYPE(NAMES_AND_TITLES_),INTENT(INOUT) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER ICODE,ITITLE(80),I,IFILNAM(2148),IWA(33),NOILEN,ITIT40(40),K,ITEST,J,INOITMP(NNOISE)
77 my_real title(20),tit40(10)
78 CHARACTER FILNAM*100, CH8*8 , EOR*8, CH40*40, CH80*80
79 CHARACTER(LEN=LTITLE) :: CARD
80 INTEGER :: LEN_TMP_NAME
81 CHARACTER(len=2148) :: TMP_NAME
82C-----------------------------------------------
83C E x t e r n a l F u n c t i o n s
84C-----------------------------------------------
85 CHARACTER, EXTERNAL :: STRI*8
86 INTEGER,EXTERNAL :: SYSFUS2
87C-----------------------------------------------
88 DATA eor/'ZZZZZEOR'/
89C-----------------------------------------------
90CFP Modif format @T + ajout acceleration et pression
91c si on de demande pas explicitement une reinitialisation
92c et qu'il existe un sauvegarde anterieure alors on continue
93 IF(rnoi==0 .AND. nnoiser/=0)rnoi=1
94c reinitialisation demandee
95 IF(rnoi==2)rnoi=0
96 IF(rnoi==0)THEN
97 IF(nnoiser/=0.AND.ispmd==0)THEN
98 WRITE(istdo,*)'***WARNING A @T FILE WAS SAVED IN A PREVIOUS RUN'
99 WRITE(istdo,*)' FILTERING WILL BE REINITIALIZED'
100 WRITE(iout,*)'***WARNING A @T FILE WAS SAVED IN A PREVIOUS RUN'
101 WRITE(iout,*)' IF YOU WANT TO RESUME DATA SAMPLING AS',
102 . ' BEFORE, PROVIDE ONLY LINE /@TFILE'
103 WRITE(iout,*)' OTHERWISE THE FILTERING WILL BE REINITIALIZED',
104 . ' AND YOU MAY MISS SOME SAMPLES'
105 ENDIF
106 READ (iin,'(10I10)')(inoise(i+nnoise),i=1,nnoise)
107C
108 DO i=1,nnoise
109 inoitmp(i)=sysfus2(inoise(i+nnoise),itabm1,numnod)
110 END DO
111 DO i=1,nnoise
112 inoise(i)= inoitmp(i) ! INOISE = 0 si noeud non present sur le proc
113 END DO
114 IF(nspmd > 1) CALL spmd_glob_isum9(inoitmp,nnoise)
115 IF(ispmd==0) THEN
116 DO i = 1, nnoise
117 IF(inoitmp(i)==0) THEN
118 CALL ancmsg(msgid=139,anmode=aninfo_blind,
119 . i1=inoise(i+nnoise))
120 ierr=ierr+1
121 RETURN
122 END IF
123 END DO
124 ENDIF
125 inoise(2*nnoise+8)=noisev
126 inoise(2*nnoise+9)=noisep
127 inoise(2*nnoise+10)=noisea
128 ELSE
129 IF(nnoiser==0.AND.ispmd==0) THEN
130 CALL ancmsg(msgid=138,anmode=aninfo)
131 CALL arret(2)
132 ENDIF
133C
134 IF(ispmd==0)
135 . WRITE(iout,*)' CONTINUING NOISE SAMPLING FROM PREVIOUS RUN'
136 itest=0
137 IF(noisev/=0 .AND. inoise(2*nnoise+8)==0)THEN
138 IF(ispmd==0)
139 . CALL ancmsg(msgid=140,anmode=aninfo,
140 . c1='VELOCITIES')
141 itest=1
142 ENDIF
143 IF(noisep/=0 .AND. inoise(2*nnoise+9)==0)THEN
144 IF(ispmd==0)
145 . CALL ancmsg(msgid=140,anmode=aninfo,
146 . c1='PRESSURES')
147 itest=1
148 ENDIF
149 IF(noisea/=0 .AND. inoise(2*nnoise+10)==0)THEN
150 IF(ispmd==0)
151 . CALL ancmsg(msgid=140,anmode=aninfo,
152 . c1='ACCELERATIONS')
153 itest=1
154 ENDIF
155 IF(itest==1)CALL arret(2)
156 noisev=inoise(2*nnoise+8)
157 noisep=inoise(2*nnoise+9)
158 noisea=inoise(2*nnoise+10)
159 ENDIF
160 IF(noisev+noisep+noisea==0)noisev=1
161 IF(ispmd==0) THEN
162 WRITE(iout,999)
163 IF(noisev/=0)WRITE(iout,'(A)')' ... VELOCITIES'
164 IF(noisea/=0)WRITE(iout,'(A)')' ... ACCELERATIONS'
165 IF(noisep/=0)WRITE(iout,'(A)')' ... PRESSURES'
166 WRITE(iout,1000)
167 WRITE(iout,'(10I10)') (inoise(i+nnoise),i=1,nnoise)
168 ENDIF
169C
170 ncnois=3*(noisev+noisea)+noisep
171 IF(ispmd/=0) RETURN
172C
173C FICHIER @T ENTETE
174C
175 iunit=iunoi
176 icode=3040
177 noilen=min(rootlen,7)
178 filnam=rootnam(1:noilen)//'_'//chrun//'_@.thy'
179 len_tmp_name = outfile_name_len + noilen + 11
180 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
181 IF(itform==0)THEN
182 OPEN(unit=iunit,file=tmp_name(1:len_tmp_name),
183 . access='SEQUENTIAL',
184 . form='UNFORMATTED',status='UNKNOWN')
185 ELSEIF(itform==1.OR.itform==2)THEN
186 OPEN(unit=iunit,file=tmp_name(1:len_tmp_name),
187 . access='SEQUENTIAL',
188 . form='FORMATTED',status='UNKNOWN')
189 ELSEIF(itform==3)THEN
190 DO i=1,len_tmp_name
191 ifilnam(i)=ichar(tmp_name(i:i))
192 ENDDO
193 CALL cur_fil_c(iunit)
194 CALL open_c(ifilnam,len_tmp_name,0)
195 ELSEIF(itform==4)THEN
196 DO i=1,len_tmp_name
197 ifilnam(i)=ichar(tmp_name(i:i))
198 ENDDO
199 CALL cur_fil_c(1)
200 CALL open_c(ifilnam,len_tmp_name,3)
201 itform=3
202 ELSEIF(itform==5)THEN
203 DO i=1,len_tmp_name
204 ifilnam(i)=ichar(tmp_name(i:i))
205 ENDDO
206 CALL cur_fil_c(1)
207 CALL open_c(ifilnam,len_tmp_name,6)
208 itform=3
209 ENDIF
210C
211C TITRE
212C
213 card(1:ltitle)=names_and_titles%TITLE(1:ltitle)
214
215 IF(itform==0)THEN
216 ! ITFORM is no more used
217 ELSEIF(itform==1)THEN
218 ch8=stri(icode)
219 WRITE(iunit,'(A)')filnam(1:noilen+11)
220 WRITE(iunit,'(2A)')ch8,card(1:72)
221 ELSEIF(itform==2)THEN
222 WRITE(iunit,'(2A)')filnam(1:noilen+11),' FORMAT'
223 WRITE(iunit,'(A,I5,A,I5,A)')eor,1,'I',72,'C'
224 WRITE(iunit,'(I5,A)')icode,card(1:72)
225 ELSEIF(itform==3)THEN
226 DO i=1,80
227 ititle(i)=ichar(card(i:i))
228 ENDDO
229 CALL eor_c(84)
230 CALL write_i_c(icode,1)
231 CALL write_c_c(ititle,80)
232 CALL eor_c(84)
233 ENDIF
234C
235C-------ivers date------------
236 CALL my_ctime(ititle)
237 DO i=1,24
238 ch80(i:i)=char(ititle(i))
239 ENDDO
240 ch80(25:33) =' RADIOSS '
241 ch80(34:59) =versio(2)(9:34)
242 ch80(60:80) =cpunam
243 DO i=25,80
244 ititle(i)=ichar(ch80(i:i))
245 ENDDO
246 IF(itform==0)THEN
247 READ(ch80,'(20A4)')title
248 WRITE(iunit)title
249 ELSEIF(itform==1)THEN
250 WRITE(iunit,'(A)')ch80
251 ELSEIF(itform==2)THEN
252 WRITE(iunit,'(2A)')filnam(1:rootlen+11),' FORMAT'
253 WRITE(iunit,'(A,I5,A)')eor,80,'C'
254 WRITE(iunit,'(A)')ch80
255 ELSEIF(itform==3)THEN
256 CALL eor_c(80)
257 CALL write_c_c(ititle,80)
258 CALL eor_c(80)
259 ENDIF
260C-------HIERARCHY INFO------------
261 iwa(1)=1
262 iwa(2)=1
263 iwa(3)=1
264 iwa(4)=1
265 iwa(5)=1
266 iwa(6)=1
267 CALL wrtdes(iwa,iwa,6,itform,0)
268C 1 VARIABLE GLOBALE
269 iwa(1)=1
270 CALL wrtdes(iwa,iwa,1,itform,0)
271C DO I=1,IWA(6)
272C IWA(I)=I
273C ENDDO
274C CALL WRTDES(IWA,IWA,12,ITFORM,0)
275C-------PART DESCRIPTION------------
276 ch40='FAKE'
277 READ(ch40,'(10A4)')tit40
278 DO i=1,40
279 itit40(i)=ichar(ch40(i:i))
280 ENDDO
281 IF(itform==0)THEN
282 WRITE(iunit)1,tit40,0,1,1,0
283 ELSEIF(itform==1)THEN
284 ELSEIF(itform==2)THEN
285 WRITE(iunit,'(A,I5,A,I5,A,I5,A)')eor,1,'I',40,'C',4,'I'
286 WRITE(iunit,'(I5,A,4I5)')1,ch40,0,1,1,0
287 ELSEIF(itform==3)THEN
288 CALL eor_c(60)
289 CALL write_i_c(1,1)
290 CALL write_c_c(itit40,40)
291 CALL write_i_c(0,1)
292 CALL write_i_c(1,1)
293 CALL write_i_c(1,1)
294 CALL write_i_c(0,1)
295 CALL eor_c(60)
296 ENDIF
297C-------MATER DESCRIPTION------------
298 ch40='FAKE'
299 READ(ch40,'(10A4)')tit40
300 DO i=1,40
301 itit40(i)=ichar(ch40(i:i))
302 ENDDO
303 IF(itform==0)THEN
304 WRITE(iunit)1,tit40
305 ELSEIF(itform==1)THEN
306 ELSEIF(itform==2)THEN
307 WRITE(iunit,'(A,I5,A,I5,A)')eor,1,'I',40,'C'
308 WRITE(iunit,'(I5,A)')1,ch40
309 ELSEIF(itform==3)THEN
310 CALL eor_c(44)
311 CALL write_i_c(1,1)
312 CALL write_c_c(itit40,40)
313 CALL eor_c(44)
314 ENDIF
315C-------MATER DESCRIPTION------------
316C CH40=''
317C READ(CH40,'(10A4)')TIT40
318C DO I=1,40
319C ITIT40(I)=ICHAR(CH40(I:I))
320C ENDDO
321C IF(ITFORM==0)THEN
322C WRITE(IUNIT)0,TIT40
323C ELSEIF(ITFORM==1)THEN
324C ELSEIF(ITFORM==2)THEN
325C WRITE(IUNIT,'(A,I5,A,I5,A)')EOR,1,'I',40,'C'
326C WRITE(IUNIT,'(I5,A)')0,CH40
327C ELSEIF(ITFORM==3)THEN
328C CALL EOR_C(44)
329C CALL WRITE_I_C(0,1)
330C CALL WRITE_C_C(ITIT40,40)
331C CALL EOR_C(44)
332C ENDIF
333
334C-------GEO DESCRIPTION------------
335 ch40='FAKE'
336 READ(ch40,'(10A4)')tit40
337 DO i=1,40
338 itit40(i)=ichar(ch40(i:i))
339 ENDDO
340 IF(itform==0)THEN
341 WRITE(iunit)1,tit40
342 ELSEIF(itform==1)THEN
343 ELSEIF(itform==2)THEN
344 WRITE(iunit,'(A,I5,A,I5,A)')eor,1,'I',40,'C'
345 WRITE(iunit,'(I5,A)')1,ch40
346 ELSEIF(itform==3)THEN
347 CALL eor_c(44)
348 CALL write_i_c(1,1)
349 CALL write_c_c(itit40,40)
350 CALL eor_c(44)
351 ENDIF
352C-------HIERARCHY DESCRIPTION------------
353 ch40=rootnam
354 READ(ch40,'(10A4)')tit40
355 DO i=1,40
356 itit40(i)=ichar(ch40(i:i))
357 ENDDO
358 IF(itform==0)THEN
359 WRITE(iunit)0,0,0,1,0,tit40
360 ELSEIF(itform==1)THEN
361 ELSEIF(itform==2)THEN
362 WRITE(iunit,'(A,I5,A,I5,A)')eor,5,'I',40,'C'
363 WRITE(iunit,'(5I5,A)')0,0,0,1,0,ch40
364 ELSEIF(itform==3)THEN
365 CALL eor_c(60)
366 CALL write_i_c(0,1)
367 CALL write_i_c(0,1)
368 CALL write_i_c(0,1)
369 CALL write_i_c(1,1)
370 CALL write_i_c(0,1)
371 CALL write_c_c(itit40,40)
372 CALL eor_c(60)
373 ENDIF
374 CALL wrtdes(iwa,iwa,1,itform,0)
375C-------NODE GROUPS------------
376 ch40='NODES'
377 READ(ch40,'(10A4)')tit40
378 DO i=1,40
379 itit40(i)=ichar(ch40(i:i))
380 ENDDO
381C
382 IF(itform==0)THEN
383 WRITE(iunit)1,0,0,nnoise,ncnois,tit40
384 ELSEIF(itform==1)THEN
385 ELSEIF(itform==2)THEN
386 WRITE(iunit,'(A,I5,A,I5,A)')eor,5,'I',40,'C'
387 WRITE(iunit,'(5I5,A)')1,0,0,nnoise,ncnois,ch40
388 ELSEIF(itform==3)THEN
389 CALL eor_c(60)
390 CALL write_i_c(1,1)
391 CALL write_i_c(0,1)
392 CALL write_i_c(0,1)
393 CALL write_i_c(nnoise,1)
394 CALL write_i_c(ncnois,1)
395 CALL write_c_c(itit40,40)
396 CALL eor_c(60)
397 ENDIF
398C
399 WRITE(ch40,'(40X)')
400 DO i=1,nnoise
401 WRITE(ch40,'(I10)')inoise(i+nnoise)
402 READ(ch40,'(10A4)')tit40
403 DO j=1,40
404 itit40(j)=ichar(ch40(j:j))
405 ENDDO
406 IF(itform==0)THEN
407 WRITE(iunit)inoise(i+nnoise),tit40
408 ELSEIF(itform==1)THEN
409 ELSEIF(itform==2)THEN
410 WRITE(iunit,'(A,I5,A,I5,A)')eor,1,'I',40,'C'
411 WRITE(iunit,'(I5,A)')inoise(i+nnoise),ch40
412 ELSEIF(itform==3)THEN
413 CALL eor_c(44)
414 CALL write_i_c(inoise(i+nnoise),1)
415 CALL write_c_c(itit40,40)
416 CALL eor_c(44)
417 ENDIF
418 ENDDO
419C
420 k=0
421 IF(noisev==1)THEN
422 k=k+1
423 iwa(k)=1
424 k=k+1
425 iwa(k)=2
426 k=k+1
427 iwa(k)=3
428 ENDIF
429 IF(noisea==1)THEN
430 k=k+1
431 iwa(k)=4
432 k=k+1
433 iwa(k)=5
434 k=k+1
435 iwa(k)=6
436 ENDIF
437 IF(noisep==1)THEN
438 k=k+1
439 iwa(k)=7
440 ENDIF
441 CALL wrtdes(iwa,iwa,ncnois,itform,0)
442C
443 RETURN
444C
445 999 FORMAT(///' LIST OF VARIABLES SAVED IN NOISE FILE')
446 1000 FORMAT(///' LIST OF NODES SAVED IN NOISE FILE')
my_real
#define my_real
Definition cppsort.cpp:32
sysfus2
integer function sysfus2(iu, itabm1, numnod)
Definition sysfus.F:99
min
#define min(a, b)
Definition macros.h:20
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::ltitle
integer, parameter ltitle
Definition names_and_titles_mod.F:1007
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:523
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
stri
character *8 function stri(n)
Definition stri.F:24
names_and_titles_mod::names_and_titles_
Definition names_and_titles_mod.F:1016
my_ctime
void my_ctime(int *p)
Definition timer_c.c:29
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645
eor_c
void eor_c(int *len)
Definition write_routtines.c:498
cur_fil_c
void cur_fil_c(int *nf)
Definition write_routtines.c:477
write_c_c
void write_c_c(int *w, int *len)
Definition write_routtines.c:591
open_c
void open_c(int *ifil, int *len, int *mod)
Definition write_routtines.c:180
wrtdes
subroutine wrtdes(a, ia, l, iform, ir)
Definition wrtdes.F:45