OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ecrit.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!|| ecrit ../engine/source/output/ecrit.F
25!||--- called by ------------------------------------------------------
26!|| sortie_main ../engine/source/output/sortie_main.f
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| elapstime ../engine/source/system/timer.F
30!|| fvstats1 ../engine/source/airbag/fvstats1.F
31!|| my_flush ../engine/source/system/machine.F
32!|| spmd_exch_fvstats ../engine/source/mpi/airbags/spmd_exch_fvstats.f
33!|| spmd_glob_dsum9 ../engine/source/mpi/interfaces/spmd_th.f
34!|| spmd_rbcast ../engine/source/mpi/generic/spmd_rbcast.F
35!||--- uses -----------------------------------------------------
36!|| anim_mod ../common_source/modules/output/anim_mod.f
37!|| h3d_mod ../engine/share/modules/h3d_mod.F
38!|| imp_dyna ../engine/share/modules/impbufdef_mod.F
39!|| message_mod ../engine/share/message_module/message_mod.F
40!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
41!|| output_mod ../common_source/modules/output/output_mod.F90
42!|| sensor_mod ../common_source/modules/sensor_mod.F90
43!|| state_mod ../common_source/modules/state_mod.F
44!|| timer_mod ../engine/source/system/timer_mod.F90
45!||====================================================================
46 SUBROUTINE ecrit(TIMERS,PARTSAV ,MS ,V ,IN ,R ,
47 2 DMAS ,WEIGHT ,ENINTOT ,EKINTOT ,
48 3 A ,AR ,FXBIPM ,FXBRPM ,MONVOL ,
49 4 XMOM_SMS ,SENSORS ,QFRICINT ,IPARI ,WEIGHT_MD ,
50 5 WFEXTH ,IFLAG ,MS_2D ,MULTI_FVM,MAS_ND ,
51 6 KEND ,H3D_DATA ,DYNAIN_DATA,USREINT,OUTPUT)
52C-----------------------------------------------
53C M o d u l e s
54C-----------------------------------------------
55 USE timer_mod
56 USE imp_dyna
57 USE message_mod
58 USE multi_fvm_mod
59 USE h3d_mod
60 USE sensor_mod
61 USE anim_mod
62 USE state_mod
63 USE output_mod , ONLY : output_
64C-----------------------------------------------
65C I m p l i c i t T y p e s
66C-----------------------------------------------
67#include "implicit_f.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "com01_c.inc"
72#include "com04_c.inc"
73#include "com06_c.inc"
74#include "com08_c.inc"
75#include "scr02_c.inc"
76#include "scr06_c.inc"
77#include "scr07_c.inc"
78#include "scr11_c.inc"
79#include "scr16_c.inc"
80#include "param_c.inc"
81#include "units_c.inc"
82#include "stati_c.inc"
83#include "statr_c.inc"
84#include "warn_c.inc"
85#include "task_c.inc"
86#include "lagmult.inc"
87#include "impl1_c.inc"
88#include "fxbcom.inc"
89#include "timeri_c.inc"
90#include "sms_c.inc"
91#include "rad2r_c.inc"
92#include "inter22.inc"
93#include "itet2_c.inc"
94C-----------------------------------------------
95C D u m m y A r g u m e n t s
96C-----------------------------------------------
97 TYPE(timer_), INTENT(INOUT) :: TIMERS ! for /MON
98 INTEGER IFLAG
99 INTEGER WEIGHT(NUMNOD),FXBIPM(NBIPM,*),
100 . IPARI(NPARI,NINTER),WEIGHT_MD(NUMNOD)
101 INTEGER MONVOL(*)
102 my_real,INTENT(INOUT) :: wfexth
103 my_real dmas, partsav(npsav,*), ms(numnod), v(3,numnod), a(3,numnod),
104 . in(numnod), r(3,numnod), ar(3,numnod),fxbrpm(*),
105 . xmom_sms(3,*),qfricint(*),ms_2d(*),kend,mas_nd
106 my_real, INTENT(IN) :: usreint
107 TYPE(multi_fvm_struct), INTENT(IN) :: MULTI_FVM
108 TYPE(h3d_database), INTENT(INOUT) :: H3D_DATA
109 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
110 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
111 TYPE(output_), INTENT(INOUT) :: OUTPUT !< output structure
112C-----------------------------------------------
113C L o c a l V a r i a b l e s
114C-----------------------------------------------
115 INTEGER IPRI, INFO, I,M, JPRI, ILIGN,ITHIS, ADRRPM, ISENS,
116 . nty,inthe,iabfis
117 my_real
118 . entot, entot1, err, err1, x99, emass,mas,enintot,ekintot,
119 . vx,vy,vz,dt05,entmp(12) ,rtmp(10),
120 . mvx, mvy, mvz, ts, mas2, wewe2, entot1b,dmasnd
121
122 DOUBLE PRECISION ETIME, RETIME, TT0,
123 . ENCIND, XMOMTD, YMOMTD, ZMOMTD,
124 . XMASSD, ENROTD, ENINTD, ENCIND2,
125 . ENROTD2, ENTOTB, EAMSD
126
127 DATA x99/99.9/
128 DATA tt0/-1./
129 CHARACTER ELTYP(0:105)*5
130C-----------------------------------------------
131 DATA ELTYP/'FIXED',
132 1 'SOLID','QUAD ','SHELL','TRUSS','BEAM ',
133 2 'SPRIN','SH_3N','TRIA ','AIRBA','INTER',
134 3 'NODE ','BLAST',' ',' ',' ',
135 4 ' ',' ',' ',' ',' ',
136 5 ' ',' ',' ',' ',' ',
137 6 ' ',' ',' ',' ',' ',
138 7 ' ',' ',' ',' ',' ',
139 8 ' ',' ',' ',' ',' ',
140 9 ' ',' ',' ',' ',' ',
141 a ' ',' ',' ',' ',' ',
142 b 'SPCEL','FVBAG',' ',' ',' ',
143 c ' ',' ',' ',' ',' ',
144 D ' ',' ',' ',' ',' ',
145 E ' ',' ',' ',' ',' ',
146 F ' ',' ',' ',' ',' ',
147 G ' ',' ',' ',' ',' ',
148 h ' ',' ',' ',' ',' ',
149 i ' ',' ',' ',' ',' ',
150 j ' ',' ',' ',' ',' ',
151 k ' ',' ',' ',' ','XELEM',
152 k 'IGE3D',' ',' ',' ',' '/
153 DATA ilign/55/
154C=======================================================================
155 ipri=1
156 iflag =0
157 IF(tt0==-one)tt0=tt
158 IF(t1s==tt)ipri=mod(ncycle,iabs(ncpri))
159 info=mdess-manim
160 ithis=0
161 iabfis=0
162 IF(tt<output%TH%THIS)ithis=1
163 IF(tt<tabfis(1))iabfis=1
164C--------Multidomains : control of time history for subdomains-----------
165 IF ((irad2r==1).AND.(r2r_siu==1).AND.(iddom/=0)) THEN
166 ithis=1
167 DO i=1,10
168 IF (r2r_th_main(i)>0) ithis=0
169 ENDDO
170 ENDIF
171C get and reset elapsed time
172 IF(imon > 0) CALL elapstime(timers,etime)
173 IF(ipri/=0.AND.ithis/=0.AND.
174 . info<=0.AND.istat==0
175 . .AND.nth==0.AND.nanim==0 .AND.
176 . (iabfis/=0.OR.abfile(1)==0) ) RETURN
177C
178C initialization / see corrections rbodies...
179 eams=encin
180C
181C GLOBAL VAR INITIALISES DANS RESOL ET MODIFIE DANS RGBCOR + passage en DOUBLE pour cumul
182 encind = zero
183 enrotd = zero
184 enintd = zero
185 xmassd = zero
186 xmomtd = zero
187 ymomtd = zero
188 zmomtd = zero
189 encind2 = zero
190 enrotd2 = zero
191 wfexth = zero
192 eamsd = zero
193C
194 dt05=half*dt1
195C
196 iflag =1
197 IF(n2d == 0 .AND. .NOT. multi_fvm%IS_USED) THEN
198 IF (impl_s==1) THEN
199 IF (idyna>0) THEN
200 dt05=(one-dy_g)*dt1
201 DO i = 1, numnod
202 mas=ms(i)*weight_md(i)
203 vx = dy_v(1,i) - dt05*dy_a(1,i)
204 vy = dy_v(2,i) - dt05*dy_a(2,i)
205 vz = dy_v(3,i) - dt05*dy_a(3,i)
206 encind=encind + ( vx*vx + vy*vy + vz*vz)*half*mas
207 xmomtd=xmomtd+vx*mas
208 ymomtd=ymomtd+vy*mas
209 zmomtd=zmomtd+vz*mas
210 xmassd=xmassd+mas
211 mas2=ms(i)*(1-weight_md(i))*weight(i)
212 encind2=encind2 + ( vx*vx + vy*vy + vz*vz)*half*mas2
213 ENDDO
214 ELSE
215 DO i = 1, numnod
216 xmassd=xmassd+ms(i)*weight_md(i)
217 ENDDO
218 ENDIF
219 ELSEIF(idtmins==0.AND.idtmins_int==0)THEN
220C
221 DO i = 1, numnod
222 mas=ms(i)*weight_md(i)
223 vx = v(1,i) + dt05*a(1,i)
224 vy = v(2,i) + dt05*a(2,i)
225 vz = v(3,i) + dt05*a(3,i)
226 encind=encind + ( vx*vx + vy*vy + vz*vz)*half*mas
227 xmomtd=xmomtd+vx*mas
228 ymomtd=ymomtd+vy*mas
229 zmomtd=zmomtd+vz*mas
230 xmassd=xmassd+mas
231 mas2=ms(i)*(1-weight_md(i))*weight(i)
232 encind2=encind2 + ( vx*vx + vy*vy + vz*vz)*half*mas2
233 ENDDO
234C
235 ELSE
236C------ sms
237 DO i = 1, numnod
238 mas=ms(i)*weight_md(i)
239 vx = v(1,i) + dt05*a(1,i)
240 vy = v(2,i) + dt05*a(2,i)
241 vz = v(3,i) + dt05*a(3,i)
242 mvx=xmom_sms(1,i)*weight_md(i)
243 mvy=xmom_sms(2,i)*weight_md(i)
244 mvz=xmom_sms(3,i)*weight_md(i)
245 encind=encind + ( vx*mvx + vy*mvy + vz*mvz)*half
246 eamsd=eamsd + ( vx*vx + vy*vy + vz*vz)*half*mas
247 xmomtd=xmomtd+mvx
248 ymomtd=ymomtd+mvy
249 zmomtd=zmomtd+mvz
250 xmassd=xmassd+mas
251 mas2=ms(i)*(1-weight_md(i))*weight(i)
252 encind2=encind2 + ( vx*vx + vy*vy + vz*vz)*half*mas2
253 ENDDO
254 ENDIF
255C
256C ENCIND=0.5*ENCIND
257
258 ELSE IF (multi_fvm%IS_USED) THEN
259 DO m=1,npart
260 encind = encind + partsav(2,m)
261 xmassd = xmassd + partsav(6,m)
262 xmomtd = xmomtd + partsav(3,m)
263 ymomtd = ymomtd + partsav(4,m)
264 zmomtd = zmomtd + partsav(5,m)
265 ENDDO
266
267 ELSE
268 DO i = 1, numnod
269 mas=ms_2d(i)*weight_md(i)
270 vx = v(1,i) + dt05*a(1,i)
271 vy = v(2,i) + dt05*a(2,i)
272 vz = v(3,i) + dt05*a(3,i)
273 encind=encind + ( vx*vx + vy*vy + vz*vz)*half*mas
274 xmomtd=xmomtd+vx*mas
275 ymomtd=ymomtd+vy*mas
276 zmomtd=zmomtd+vz*mas
277 xmassd=xmassd+mas
278 mas2=ms_2d(i)*(1-weight_md(i))*weight(i)
279 encind2=encind2 + ( vx*vx + vy*vy + vz*vz)*half*mas2
280 ENDDO
281 ENDIF
282
283 IF (int22>0) THEN
284 !FVM cells take part in the balance
285 DO m=1,npart
286 encind = encind + partsav(2,m)
287 xmassd = xmassd + partsav(6,m)
288 xmomtd = xmomtd + partsav(3,m)
289 ymomtd = ymomtd + partsav(4,m)
290 zmomtd = zmomtd + partsav(5,m)
291 IF(partsav(6,m)>zero) encind2 = encind2 + half/partsav(6,m)*(partsav(3,m)**2+partsav(4,m)**2+partsav(5,m)**2)
292 ENDDO
293 ENDIF
294
295 IF (ns10e>0) THEN
296C-------- MS_ND= MAS_ND0
297 encind = encind + kend
298 xmassd = xmassd -mas_nd
299 dmasnd = max(zero,(mas_nd-ms_nd))
300 IF (dmasnd>ms_nd*em10) dmas = dmas -dmasnd
301C--------DMAS,DMASND are used only at Ncycle=0, update MS_ND for restart
302 ms_nd = mas_nd
303 ENDIF
304C
305 IF(iroddl/=0)THEN
306 IF (impl_s==1) THEN
307 IF (idyna>0) THEN
308 DO i = 1, numnod
309 vx = dy_vr(1,i) - dt05*dy_ar(1,i)
310 vy = dy_vr(2,i) - dt05*dy_ar(2,i)
311 vz = dy_vr(3,i) - dt05*dy_ar(3,i)
312 enrotd=enrotd
313 . + (vx*vx + vy*vy + vz*vz)*half*in(i)*weight_md(i)
314 wewe2 = (1-weight_md(i))*weight(i)
315 enrotd2=enrotd2
316 . + (vx*vx + vy*vy + vz*vz)*half*in(i)*wewe2
317 ENDDO
318 ENDIF
319 ELSE
320 DO i = 1, numnod
321 vx = r(1,i) + dt05*ar(1,i)
322 vy = r(2,i) + dt05*ar(2,i)
323 vz = r(3,i) + dt05*ar(3,i)
324 enrotd=enrotd
325 . + (vx*vx + vy*vy + vz*vz)*half*in(i)*weight_md(i)
326 wewe2 = (1-weight_md(i))*weight(i)
327 enrotd2=enrotd2
328 . + (vx*vx + vy*vy + vz*vz)*half*in(i)*wewe2
329 ENDDO
330 ENDIF
331C ENROTD=0.5*ENROTD
332 ENDIF
333C
334 enintd = epor + usreint + (dampw+edamp)*dt05
335 dampw = edamp
336 IF (nfxbody>0) THEN
337 DO i=1,nfxbody
338 adrrpm=fxbipm(14,i)
339 enintd=enintd+fxbrpm(adrrpm+10)-fxbrpm(adrrpm+14)
340 encind=encind+fxbrpm(adrrpm+11)
341 ENDDO
342 ENDIF
343 DO m=1,npart
344 enrotd= enrotd + partsav(7,m)
345 enintd = enintd + partsav(1,m) + partsav(24,m) + partsav(26,m)
346 output%TH%WFEXT = output%TH%WFEXT + partsav(27,m)
347 wfexth = wfexth + partsav(27,m)
348 wplast = wplast + partsav(29,m)
349 ENDDO
350C
351C Add Heat generated by Friction to internal energy
352C
353 DO i=1,ninter
354 nty = ipari(7,i)
355 IF(nty == 7 .OR. nty == 21) THEN
356 inthe =ipari(47,i)
357 IF (inthe > 0) THEN
358 enintd = enintd + qfricint(i)
359 ENDIF
360 ENDIF
361 ENDDO
362C
363C add contribution in DP to my_real var to keep precision
364C
365 encin=encin+encind
366 encin2=encin2+encind2
367 enrot=enrot+enrotd
368 enrot2=enrot2+enrotd2
369 eams =eams+eamsd
370C
371C ENCIN = ENCIN + ENCIN2
372C ENROT = ENROT + ENROT2
373C
374 enint=enintd
375 xmomt=xmomt+xmomtd
376 ymomt=ymomt+ymomtd
377 zmomt=zmomt+zmomtd
378 xmass=xmass+xmassd
379C
380 IF (impl_s==1) THEN
381 IF (idyna==0) THEN
382 encin =zero
383 enrot =zero
384 encin2 =zero
385 enrot2 =zero
386 output%TH%WFEXT=enint
387 ELSEIF (idy_damp>0) THEN
388C IF (NSPMD>1) CALL SPMD_SUM_S(DY_EDAMP)
389 enint = enint + dy_edamp
390 ENDIF
391 ENDIF
392C
393 IF (nspmd > 1) THEN
394C.....envoyer la contribution au proc 0
395C.....sommer les contributions puis standard
396 entmp(1) = encin
397 entmp(2) = enrot
398 entmp(3) = enint
399 entmp(4) = xmomt
400 entmp(5) = ymomt
401 entmp(6) = zmomt
402 entmp(7) = xmass
403 entmp(8) = econt
404 entmp(9) = reint
405 entmp(10) = encin2
406 entmp(11) = enrot2
407 entmp(12) = eams
408 CALL spmd_glob_dsum9(entmp,12)
409 IF (ispmd==0) THEN
410 encin = entmp(1)
411 enrot = entmp(2)
412 enint = entmp(3)
413 xmomt = entmp(4)
414 ymomt = entmp(5)
415 zmomt = entmp(6)
416 xmass = entmp(7)
417 econt = entmp(8)
418 reint = entmp(9)
419 encin2 = entmp(10)
420 enrot2 = entmp(11)
421 eams = entmp(12)
422 ENDIF
423C
424 IF (istat==2) THEN
425C istat=2 => relaxation : broadcast de encin et enrot
426 CALL spmd_rbcast(entmp,entmp,1,2,0,2)
427 IF (ispmd/=0) THEN
428 encin = entmp(1)
429 enrot = entmp(2)
430 encin2 = entmp(10)
431 enrot2 = entmp(11)
432 ENDIF
433 ELSEIF (istat==3) THEN
434C istat=3 => ADYREL : broadcast de encin et enrot ENINT
435 CALL spmd_rbcast(entmp,entmp,1,3,0,3)
436 IF (ispmd/=0) THEN
437 encin = entmp(1)
438 enrot = entmp(2)
439 enint = entmp(3)
440 ENDIF
441 ENDIF
442C
443 entmp(1) = output%TH%WFEXT
444 entmp(2) = ehour
445 entmp(3) = econtv
446 entmp(4) = dmas
447 entmp(5) = wfexth
448 entmp(6) = econtd
449 entmp(7) = econt_cumu
450 entmp(8) = wplast
451 CALL spmd_glob_dsum9(entmp,8)
452 IF(ispmd/=0) THEN
453 output%TH%WFEXT = zero
454 ehour = zero
455 econtv = zero
456 dmas = zero
457 wfexth = zero
458 econtd = zero
459 econt_cumu = zero
460 wplast = zero
461 ELSE
462 output%TH%WFEXT = entmp(1)
463 ehour = entmp(2)
464 econtv= entmp(3)
465 dmas = entmp(4)
466 wfexth= entmp(5)
467 econtd = entmp(6)
468 econt_cumu = entmp(7)
469 wplast = entmp(8)
470 ENDIF
471 ENDIF
472C
473C EAMS = [ 1/2 v.Mv - 1/2 m v^2 ]/ 1/2 m v^2
474 IF(ispmd==0) THEN
475 IF(idtmins/=0.OR.idtmins_int/=0)THEN
476 IF(eams > em20)THEN
477 eams = (encin-eams)/eams
478 ELSE
479 eams = zero
480 END IF
481 END IF
482 END IF
483
484c----------------------------------------------------
485 IF (ispmd == 0) THEN
486c
487 entot = encin + enint + enrot
488 entotb = entot + encin2 + enrot2
489 IF(ncycle==0) THEN
490 entot0=entot - output%TH%WFEXT - output%TH%WFEXT_MD
491 deltae=encin2 + enrot2
492 mass0 = xmass - dmas
493 ENDIF
494 mass0 = mass0 + dmf
495 entot0= entot0 + def
496 entot1=entot0 + output%TH%WFEXT
497 entot1b=entot0 + output%TH%WFEXT + deltae + output%TH%WFEXT_MD
498 IF(abs(entot1b)>em20)THEN
499 err = entotb/entot1b - one
500 err1 = max(-x99, min(x99,err*hundred))
501 ELSE
502 err = zero
503 err1 =zero
504 ENDIF
505 emass = (xmass - mass0) / max(mass0,em20)
506 enintot = enint
507 ekintot = encin
508C-----------------------------------------------
509C /STATE/LSENSOR
510C-----------------------------------------------
511 IF (sensors%NSTAT > 0) THEN
512 mstatt = 0
513 DO i=1,sensors%NSTAT
514 isens = sensors%STAT(i)
515 ts = sensors%SENSOR_TAB(isens)%TSTART
516 IF (tt >= ts) THEN
517 mstat(i) = mstat(i)+1
518 ENDIF
519 IF (mstat(i)==1) mstatt=1
520 ENDDO
521 ENDIF
522C-----------------------------------------------
523C /OUTP/LSENSOR
524C-----------------------------------------------
525 IF (sensors%NOUTP > 0) THEN
526 moutpt = 0
527 DO i=1,sensors%NOUTP
528 isens = sensors%OUTP(i)
529 ts = sensors%SENSOR_TAB(isens)%TSTART
530 IF (tt >= ts) THEN
531 moutp(i) = moutp(i)+1
532 ENDIF
533 IF(moutp(i)==1) moutpt=1
534 ENDDO
535 ENDIF
536C
537 IF((nerr_posit==0.AND.abs(err)>demxk).OR.
538 . (nerr_posit==1.AND.err>demxk))THEN
539 CALL ancmsg(msgid=205,anmode=aninfo)
540 ierr=ierr+1
541 mstop=1
542 IF(nth/=0)THEN
543 output%TH%THIS= tt
544 ipri= 0
545 ENDIF
546 IF(nanim/=0)THEN
547 mdess = 1
548 tanim = tt
549 ipri = 0
550 ENDIF
551 ELSEIF((nerr_posit==0.AND.abs(err)>demxs).OR.
552 . (nerr_posit==1.AND.err>demxs))THEN
553 CALL ancmsg(msgid=206,anmode=aninfo)
554 iwarn=iwarn+1
555 mstop=1
556 mrest=1
557 IF(nth/=0)THEN
558 output%TH%THIS= tt
559 ipri= 0
560 ENDIF
561 IF(nanim/=0)THEN
562 mdess = 1
563 tanim = tt
564 ipri = 0
565 ENDIF
566 ENDIF
567C
568 IF(emass>dmtmxk)THEN
569 CALL ancmsg(msgid=207,anmode=aninfo)
570 ierr=ierr+1
571 mstop=1
572 IF(nth/=0)THEN
573 output%TH%THIS= tt
574 ipri = 0
575 ENDIF
576 IF(nanim/=0)THEN
577 mdess = 1
578 tanim = tt
579 ipri = 0
580 ENDIF
581 ELSEIF(emass>dmtmxs)THEN
582 CALL ancmsg(msgid=208,anmode=aninfo)
583 iwarn=iwarn+1
584 mstop=1
585 mrest=1
586 IF(nth/=0)THEN
587 output%TH%THIS= tt
588 ipri = 0
589 ENDIF
590 IF(nanim/=0)THEN
591 mdess = 1
592 tanim = tt
593 ipri = 0
594 ENDIF
595 ENDIF
596 ENDIF ! ISPMD == 0
597C---------------------------------
598C Communication MSTOP & MREST
599C---------------------------------
600 IF (nspmd > 1) THEN
601 IF (ispmd==0) THEN
602 rtmp(1) = mstop
603 rtmp(2) = mrest
604 rtmp(3) = mdess
605 rtmp(4) = tanim
606 rtmp(5) = output%TH%THIS
607 rtmp(6) = tstat
608 rtmp(7) = toutp
609 rtmp(8) = info
610 rtmp(9) = h3d_data%TH3D
611 rtmp(10) = dynain_data%TDYNAIN
612 ENDIF
613C
614 CALL spmd_rbcast(rtmp,rtmp,10,1,0,2)
615
616 mstop = nint(rtmp(1))
617 mrest = nint(rtmp(2))
618 mdess = nint(rtmp(3))
619 tanim = rtmp(4)
620 output%TH%THIS = rtmp(5)
621 tstat = rtmp(6)
622 toutp = rtmp(7)
623 h3d_data%TH3D = rtmp(9)
624 dynain_data%TDYNAIN = rtmp(10)
625
626 IF(info > 0) CALL spmd_exch_fvstats(monvol)
627
628 IF(ispmd/=0) RETURN
629 ! Only processor 0 will continue
630
631 ENDIF
632
633C-----------------------------------------------
634 IF(ipri==0)THEN
635 IF (nlpri /= 0) ilign = nlpri
636 jpri=mod(ncycle,ilign*iabs(ncpri))
637 IF(jpri==0) WRITE(iout,1000)
638 WRITE(iout,1100) ncycle,tt,dt2,eltyp(itypts),nelts,err1,enint,encin,enrot,output%TH%WFEXT,emass,xmass,xmass-mass0
639 CALL my_flush(iout)
640 IF(ncpri<0) THEN
641 IF(debug(10)/=0)THEN
642 IF(ncycle>=debug(10))THEN
643 write (*,*) " ALE ADVECTION SET OFF"
644 ENDIF
645 ENDIF
646 WRITE(istdo,'(A,I8,2(A,1PE11.4),A,0PF5.1,A,1PE11.4)')' NC=',ncycle,' T=',tt,' DT=',dt2,' ERR=',err1,'% DM/M=',emass
647 IF(lag_nc>0) THEN
648 WRITE(istdo,'(2(A,I8),A,1PE11.4)') ' LAG_NC=',lag_nc,', NITER_GC=',niter_gc,', LAG_ERSQ2=',lag_ersq2
649 ENDIF
650 IF(imon > 0 .AND. tt-tt0 > zero) THEN
651C calcul temps restant
652 retime = (etime*(tstop-tt0)) / (tt-tt0) - etime
653 WRITE(istdo,'(A,F14.2,A,A,F14.2,A)')' ELAPSED TIME=',etime,' s ',' REMAINING TIME=',retime,' s'
654 END IF
655 CALL my_flush(istdo)
656 ENDIF
657 ENDIF
658C
659 IF(info>0)THEN
660 WRITE (iusc3,'(//,A)',err=990) ' CURRENT STATE:'
661 WRITE (iusc3,'(A,/)',err=990) ' --------------'
662 WRITE (iusc3,'(A,I10)',err=990) ' CYCLE =',ncycle
663 WRITE (iusc3,'(A,G14.7)',err=990) ' TIME =',tt
664 WRITE (iusc3,'(A,G14.7,A,I8)',err=990)' TIME STEP =',dt2,eltyp(itypts),nelts
665 WRITE (iusc3,'(A,F5.1,A)',err=990) ' ENERGY ERROR =',err1,'%'
666 WRITE (iusc3,'(A,G14.7)',err=990) ' INTERNAL ENERGY =',enint
667 WRITE (iusc3,'(A,G14.7)',err=990) ' KINETIC ENERGY =',encin
668 WRITE (iusc3,'(A,G14.7)',err=990) ' ROT. KIN. ENERGY =',enrot
669 WRITE (iusc3,'(A,G14.7)',err=990) ' EXTERNAL WORK =',output%TH%WFEXT
670 WRITE (iusc3,'(A,G14.7)',err=990) ' MASS.ERR (M-M0)/M0=',emass
671
672 CALL fvstats1(iusc3,monvol,1)
673
674 IF(imon > 0 .AND. tt > zero) THEN
675C calcul temps restant
676 retime = (etime*tstop) / tt - etime
677 WRITE(iusc3,'(A)',err=990) ' '
678 WRITE(iusc3,'(A,F14.2,A)',err=990)' CURRENT ELAPSED TIME =',etime,' s '
679 WRITE(iusc3,'(A,F14.2,A)',err=990)' REMAINING TIME ESTIMATE =',retime,' s'
680 END IF
681
682 CLOSE(iusc3)
683 990 CONTINUE
684 ENDIF
685C----------------
686C FORMATS
687C----------------
688 1000 FORMAT(' CYCLE TIME TIME-STEP ELEMENT ',
689 + 'ERROR I-ENERGY K-ENERGY T K-ENERGY R ',
690 + 'EXT-WORK MAS.ERR TOTAL MASS MASS ADDED')
691 1100 FORMAT(i8,2(1x,g11.4),1x,a5,1x,i10,1x,f5.1,1h%,7(1x,g11.4))
692C
693 RETURN
694 END
my_real
#define my_real
Definition cppsort.cpp:32
ecrit
subroutine ecrit(timers, partsav, ms, v, in, r, dmas, weight, enintot, ekintot, a, ar, fxbipm, fxbrpm, monvol, xmom_sms, sensors, qfricint, ipari, weight_md, wfexth, iflag, ms_2d, multi_fvm, mas_nd, kend, h3d_data, dynain_data, usreint, output)
Definition ecrit.F:52
fvstats1
subroutine fvstats1(iout, monvol, info)
Definition fvstats1.F:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
anim_mod
Definition anim_mod.F:96
h3d_mod
Definition h3d_mod.F:308
imp_dyna
Definition impbufdef_mod.F:314
message_mod
Definition message_mod.F:1249
state_mod
Definition state_mod.F:54
sortie_main
subroutine sortie_main(timers, pm, d, v, ale_connect, w, elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, wa, itab, x, geo, ms, a, cont, partsav, icut, xcut, fint, fext, fopt, anin, lpby, npby, nstrf, rwbuf, nprw, ebcs_tab, tani, inoise, bufnois, rby, neflsw, nnflsw, crflsw, flsw, lout, nodes, fsav, skew, elbuf_tab, cluster, vr, in, weight, fcluster, mcluster, dd_iad, dmas, accelm, gauge, ipari, eani, ipart, mat_param, igrnod, subset, nom_opt, ar, igrsurf, bufsf, idata, rdata, kxx, ixx, bufmat, bufgeo, kxsp, ixsp, nod2sp, spbuf, dr, fsavd, ixri, rivet, iskwn, iframe, xframe, ixs10, ixs20, ixs16, ndma, monvol, volmon, ipm, igeo, nodglob, iad_elem, fr_elem, fr_rby2, iad_rby2, fr_wall, fr_sec, fxbipm, fxbrpm, ndin, fxbdep, fxbvit, fxbacc, iflow, rflow, ipartl, npartl, iaccp, naccp, fasolfr, fncont, ftcont, iparth, fr_mv, ipart_state, sh4tree, sh3tree, temp, thke, err_thk_sh4, err_thk_sh3, inod_pxfem, fthreac, nodreac, gresav, diag_sms, sh4trim, sh3trim, fncont2, xmom_sms, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, dxancg, iel_pxfem, zi_ply, vgaz, fcontg, fncontg, ftcontg, fanreac, inod_crk, iel_crk, elcutc, iadc_crk, pdama2, res_sms, sensors, qfricint, igaup, ngaup, weight_md, ncont, indexcont, nodglobxfe, nodedge, xfem_tab, nv46, rthbuf, kxig3d, ixig3d, knot, wige, nercvois, nesdvois, lercvois, lesdvois, crkedge, stack, isphio, vsphio, icode, indx_crk, xedge4n, xedge3n, sph2sol, stifn, stifr, drape_sh4n, drape_sh3n, ms_2d, multi_fvm, segquadfr, h3d_data, iskew, pskids, iskwp, knotlocpc, knotlocel, pinch_data, tag_skins6, irunn_bis, tf, npc, dynain_data, fcont_max, mds_matid, fncontp2, ftcontp2, ibcl, iloadp, lloadp, loadp, tagncont, loadp_hyd_inter, forc, drapeg, user_windows, output, dt, fsavsurf, table, loads, sfani, iparit, x_c, sz_npcont2, npcont2, glob_therm, pblast, wfext)
Definition sortie_main.F:145
spmd_exch_fvstats
subroutine spmd_exch_fvstats(monvol)
Definition spmd_exch_fvstats.F:33
spmd_rbcast
subroutine spmd_rbcast(tabi, tabr, n1, n2, from, add)
Definition spmd_rbcast.F:62
spmd_glob_dsum9
subroutine spmd_glob_dsum9(v, len)
Definition spmd_th.F:380
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
my_flush
subroutine my_flush(iunit)
Definition machine.F:147
elapstime
subroutine elapstime(etime)
Definition timer.F:366
h3d_mod::h3d_database
Definition h3d_mod.F:435