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!|| h3d_mod ../engine/share/modules/h3d_mod.f
37!|| imp_dyna ../engine/share/modules/impbufdef_mod.f
38!|| message_mod ../engine/share/message_module/message_mod.F
39!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
40!|| output_mod ../common_source/modules/output/output_mod.F90
41!|| sensor_mod ../common_source/modules/sensor_mod.F90
42!|| state_mod ../common_source/modules/state_mod.F
43!|| timer_mod ../engine/source/system/timer_mod.F90
44!||====================================================================
45 SUBROUTINE ecrit(TIMERS,PARTSAV ,MS ,V ,IN ,R ,
46 2 DMAS ,WEIGHT ,ENINTOT ,EKINTOT ,
47 3 A ,AR ,FXBIPM ,FXBRPM ,MONVOL ,
48 4 XMOM_SMS ,SENSORS ,QFRICINT ,IPARI ,WEIGHT_MD ,
49 5 WFEXTH ,IFLAG ,MS_2D ,MULTI_FVM,MAS_ND ,
50 6 KEND ,H3D_DATA ,DYNAIN_DATA,USREINT,OUTPUT)
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE timer_mod
55 USE imp_dyna
56 USE message_mod
57 USE multi_fvm_mod
58 USE h3d_mod
59 USE sensor_mod
60 USE state_mod
61 USE output_mod , ONLY : output_
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "com01_c.inc"
70#include "com04_c.inc"
71#include "com06_c.inc"
72#include "com08_c.inc"
73#include "scr02_c.inc"
74#include "scr06_c.inc"
75#include "scr07_c.inc"
76#include "scr11_c.inc"
77#include "scr16_c.inc"
78#include "param_c.inc"
79#include "units_c.inc"
80#include "stati_c.inc"
81#include "statr_c.inc"
82#include "warn_c.inc"
83#include "task_c.inc"
84#include "lagmult.inc"
85#include "impl1_c.inc"
86#include "fxbcom.inc"
87#include "timeri_c.inc"
88#include "sms_c.inc"
89#include "rad2r_c.inc"
90#include "inter22.inc"
91#include "itet2_c.inc"
92C-----------------------------------------------
93C D u m m y A r g u m e n t s
94C-----------------------------------------------
95 TYPE(TIMER_), INTENT(INOUT) :: TIMERS ! for /MON
96 INTEGER IFLAG
97 INTEGER WEIGHT(NUMNOD),FXBIPM(NBIPM,*),
98 . IPARI(NPARI,NINTER),WEIGHT_MD(NUMNOD)
99 INTEGER MONVOL(*)
100 my_real,INTENT(INOUT) :: wfexth
101 my_real dmas, partsav(npsav,*), ms(numnod), v(3,numnod), a(3,numnod),
102 . in(numnod), r(3,numnod), ar(3,numnod),fxbrpm(*),
103 . xmom_sms(3,*),qfricint(*),ms_2d(*),kend,mas_nd
104 my_real, INTENT(IN) :: usreint
105 TYPE(multi_fvm_struct), INTENT(IN) :: MULTI_FVM
106 TYPE(h3d_database), INTENT(INOUT) :: H3D_DATA
107 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
108 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
109 TYPE(output_), INTENT(INOUT) :: OUTPUT !< output structure
110C-----------------------------------------------
111C L o c a l V a r i a b l e s
112C-----------------------------------------------
113 INTEGER IPRI, INFO, I,M, JPRI, ILIGN,ITHIS, ADRRPM, ISENS,NTY,INTHE,IABFIS
114 my_real :: entot, entot1, err, err1, x99, emass,mas,enintot,ekintot,
115 . vx,vy,vz,dt05,entmp(12) ,rtmp(10),
116 . mvx, mvy, mvz, ts, mas2, wewe2, entot1b,dmasnd
117 my_real :: dm_inout, de_inout
118
119 DOUBLE PRECISION :: ETIME, RETIME, TT0,
120 . ENCIND, XMOMTD, YMOMTD, ZMOMTD,
121 . XMASSD, ENROTD, ENINTD, ENCIND2,
122 . enrotd2, entotb, eamsd
123
124 DATA x99/99.9/
125 DATA tt0/-1./
126 CHARACTER ELTYP(0:105)*5
127C-----------------------------------------------
128 DATA ELTYP/'FIXED',
129 1 'SOLID','QUAD ','SHELL','TRUSS','BEAM ',
130 2 'SPRIN','SH_3N','TRIA ','AIRBA','INTER',
131 3 'NODE ','BLAST',' ',' ',' ',
132 4 ' ',' ',' ',' ',' ',
133 5 ' ',' ',' ',' ',' ',
134 6 ' ',' ',' ',' ',' ',
135 7 ' ',' ',' ',' ',' ',
136 8 ' ',' ',' ',' ',' ',
137 9 ' ',' ',' ',' ',' ',
138 a ' ',' ',' ',' ',' ',
139 b 'SPCEL','FVBAG',' ',' ',' ',
140 c ' ',' ',' ',' ',' ',
141 d ' ',' ',' ',' ',' ',
142 e ' ',' ',' ',' ',' ',
143 f ' ',' ',' ',' ',' ',
144 g ' ',' ',' ',' ',' ',
145 h ' ',' ',' ',' ',' ',
146 i ' ',' ',' ',' ',' ',
147 j ' ',' ',' ',' ',' ',
148 k ' ',' ',' ',' ','XELEM',
149 k 'IGE3D',' ',' ',' ',' '/
150 DATA ilign/55/
151C=======================================================================
152 dm_inout=0
153 ipri=1
154 iflag =0
155 IF(tt0==-one)tt0=tt
156 IF(t1s==tt)ipri=mod(ncycle,iabs(ncpri))
157 info=mdess-manim
158 ithis=0
159 iabfis=0
160 IF(tt<output%TH%THIS)ithis=1
161 IF(tt<tabfis(1))iabfis=1
162C--------Multidomains : control of time history for subdomains-----------
163 IF ((irad2r==1).AND.(r2r_siu==1).AND.(iddom/=0)) THEN
164 ithis=1
165 DO i=1,10
166 IF (r2r_th_main(i)>0) ithis=0
167 ENDDO
168 ENDIF
169C get and reset elapsed time
170 IF(imon > 0) CALL elapstime(timers,etime)
171 IF(ipri/=0.AND.ithis/=0.AND.
172 . info<=0.AND.istat==0
173 . .AND.nth==0.AND.nanim==0 .AND.
174 . (iabfis/=0.OR.abfile(1)==0) ) RETURN
175C
176C initialization / see corrections rbodies...
177 eams=encin
178C
179C global var initialized in resol and modified in rgbcor + switched to double for accumulation
180 encind = zero
181 enrotd = zero
182 enintd = zero
183 xmassd = zero
184 xmomtd = zero
185 ymomtd = zero
186 zmomtd = zero
187 encind2 = zero
188 enrotd2 = zero
189 wfexth = zero
190 eamsd = zero
191C
192 dt05=half*dt1
193C
194 iflag =1
195 IF(n2d == 0 .AND. .NOT. multi_fvm%IS_USED) THEN
196 IF (impl_s==1) THEN
197 IF (idyna>0) THEN
198 dt05=(one-dy_g)*dt1
199 DO i = 1, numnod
200 mas=ms(i)*weight_md(i)
201 vx = dy_v(1,i) - dt05*dy_a(1,i)
202 vy = dy_v(2,i) - dt05*dy_a(2,i)
203 vz = dy_v(3,i) - dt05*dy_a(3,i)
204 encind=encind + ( vx*vx + vy*vy + vz*vz)*half*mas
205 xmomtd=xmomtd+vx*mas
206 ymomtd=ymomtd+vy*mas
207 zmomtd=zmomtd+vz*mas
208 xmassd=xmassd+mas
209 mas2=ms(i)*(1-weight_md(i))*weight(i)
210 encind2=encind2 + ( vx*vx + vy*vy + vz*vz)*half*mas2
211 ENDDO
212 ELSE
213 DO i = 1, numnod
214 xmassd=xmassd+ms(i)*weight_md(i)
215 ENDDO
216 ENDIF
217 ELSEIF(idtmins==0.AND.idtmins_int==0)THEN
218C
219 DO i = 1, numnod
220 mas=ms(i)*weight_md(i)
221 vx = v(1,i) + dt05*a(1,i)
222 vy = v(2,i) + dt05*a(2,i)
223 vz = v(3,i) + dt05*a(3,i)
224 encind=encind + ( vx*vx + vy*vy + vz*vz)*half*mas
225 xmomtd=xmomtd+vx*mas
226 ymomtd=ymomtd+vy*mas
227 zmomtd=zmomtd+vz*mas
228 xmassd=xmassd+mas
229 mas2=ms(i)*(1-weight_md(i))*weight(i)
230 encind2=encind2 + ( vx*vx + vy*vy + vz*vz)*half*mas2
231 ENDDO
232C
233 ELSE
234C------ sms
235 DO i = 1, numnod
236 mas=ms(i)*weight_md(i)
237 vx = v(1,i) + dt05*a(1,i)
238 vy = v(2,i) + dt05*a(2,i)
239 vz = v(3,i) + dt05*a(3,i)
240 mvx=xmom_sms(1,i)*weight_md(i)
241 mvy=xmom_sms(2,i)*weight_md(i)
242 mvz=xmom_sms(3,i)*weight_md(i)
243 encind=encind + ( vx*mvx + vy*mvy + vz*mvz)*half
244 eamsd=eamsd + ( vx*vx + vy*vy + vz*vz)*half*mas
245 xmomtd=xmomtd+mvx
246 ymomtd=ymomtd+mvy
247 zmomtd=zmomtd+mvz
248 xmassd=xmassd+mas
249 mas2=ms(i)*(1-weight_md(i))*weight(i)
250 encind2=encind2 + ( vx*vx + vy*vy + vz*vz)*half*mas2
251 ENDDO
252 ENDIF
253C
254C ENCIND=0.5*ENCIND
255
256 ELSE IF (multi_fvm%IS_USED) THEN
257 DO m=1,npart
258 encind = encind + partsav(2,m)
259 xmassd = xmassd + partsav(6,m)
260 xmomtd = xmomtd + partsav(3,m)
261 ymomtd = ymomtd + partsav(4,m)
262 zmomtd = zmomtd + partsav(5,m)
263 ENDDO
264
265 ELSE
266 DO i = 1, numnod
267 mas=ms_2d(i)*weight_md(i)
268 vx = v(1,i) + dt05*a(1,i)
269 vy = v(2,i) + dt05*a(2,i)
270 vz = v(3,i) + dt05*a(3,i)
271 encind=encind + ( vx*vx + vy*vy + vz*vz)*half*mas
272 xmomtd=xmomtd+vx*mas
273 ymomtd=ymomtd+vy*mas
274 zmomtd=zmomtd+vz*mas
275 xmassd=xmassd+mas
276 mas2=ms_2d(i)*(1-weight_md(i))*weight(i)
277 encind2=encind2 + ( vx*vx + vy*vy + vz*vz)*half*mas2
278 ENDDO
279 ENDIF
280
281 IF (int22>0) THEN
282 !FVM cells take part in the balance
283 DO m=1,npart
284 encind = encind + partsav(2,m)
285 xmassd = xmassd + partsav(6,m)
286 xmomtd = xmomtd + partsav(3,m)
287 ymomtd = ymomtd + partsav(4,m)
288 zmomtd = zmomtd + partsav(5,m)
289 IF(partsav(6,m)>zero) encind2 = encind2 + half/partsav(6,m)*(partsav(3,m)**2+partsav(4,m)**2+partsav(5,m)**2)
290 ENDDO
291 ENDIF
292
293 IF (ns10e>0) THEN
294C-------- MS_ND= MAS_ND0
295 encind = encind + kend
296 xmassd = xmassd -mas_nd
297 dmasnd = max(zero,(mas_nd-ms_nd))
298 IF (dmasnd>ms_nd*em10) dmas = dmas -dmasnd
299C--------DMAS,DMASND are used only at Ncycle=0, update MS_ND for restart
300 ms_nd = mas_nd
301 ENDIF
302C
303 IF(iroddl/=0)THEN
304 IF (impl_s==1) THEN
305 IF (idyna>0) THEN
306 DO i = 1, numnod
307 vx = dy_vr(1,i) - dt05*dy_ar(1,i)
308 vy = dy_vr(2,i) - dt05*dy_ar(2,i)
309 vz = dy_vr(3,i) - dt05*dy_ar(3,i)
310 enrotd=enrotd
311 . + (vx*vx + vy*vy + vz*vz)*half*in(i)*weight_md(i)
312 wewe2 = (1-weight_md(i))*weight(i)
313 enrotd2=enrotd2
314 . + (vx*vx + vy*vy + vz*vz)*half*in(i)*wewe2
315 ENDDO
316 ENDIF
317 ELSE
318 DO i = 1, numnod
319 vx = r(1,i) + dt05*ar(1,i)
320 vy = r(2,i) + dt05*ar(2,i)
321 vz = r(3,i) + dt05*ar(3,i)
322 enrotd=enrotd
323 . + (vx*vx + vy*vy + vz*vz)*half*in(i)*weight_md(i)
324 wewe2 = (1-weight_md(i))*weight(i)
325 enrotd2=enrotd2
326 . + (vx*vx + vy*vy + vz*vz)*half*in(i)*wewe2
327 ENDDO
328 ENDIF
329C ENROTD=0.5*ENROTD
330 ENDIF
331C
332 enintd = epor + usreint + (dampw+edamp)*dt05
333 dampw = edamp
334 IF (nfxbody>0) THEN
335 DO i=1,nfxbody
336 adrrpm=fxbipm(14,i)
337 enintd=enintd+fxbrpm(adrrpm+10)-fxbrpm(adrrpm+14)
338 encind=encind+fxbrpm(adrrpm+11)
339 ENDDO
340 ENDIF
341 DO m=1,npart
342 enrotd= enrotd + partsav(7,m)
343 enintd = enintd + partsav(1,m) + partsav(24,m) + partsav(26,m)
344 output%TH%WFEXT = output%TH%WFEXT + partsav(27,m)
345 wfexth = wfexth + partsav(27,m)
346 wplast = wplast + partsav(29,m)
347 ENDDO
348C
349C Add Heat generated by Friction to internal energy
350C
351 DO i=1,ninter
352 nty = ipari(7,i)
353 IF(nty == 7 .OR. nty == 21) THEN
354 inthe =ipari(47,i)
355 IF (inthe > 0) THEN
356 enintd = enintd + qfricint(i)
357 ENDIF
358 ENDIF
359 ENDDO
360C
361C add contribution in DP to my_real var to keep precision
362C
363 encin=encin+encind
364 encin2=encin2+encind2
365 enrot=enrot+enrotd
366 enrot2=enrot2+enrotd2
367 eams =eams+eamsd
368C
369C ENCIN = ENCIN + ENCIN2
370C ENROT = ENROT + ENROT2
371C
372 enint=enintd
373 xmomt=xmomt+xmomtd
374 ymomt=ymomt+ymomtd
375 zmomt=zmomt+zmomtd
376 xmass=xmass+xmassd
377C
378 IF (impl_s==1) THEN
379 IF (idyna==0) THEN
380 encin =zero
381 enrot =zero
382 encin2 =zero
383 enrot2 =zero
384 output%TH%WFEXT=enint
385 ELSEIF (idy_damp>0) THEN
386C IF (NSPMD>1) CALL SPMD_SUM_S(DY_EDAMP)
387 enint = enint + dy_edamp
388 ENDIF
389 ENDIF
390C
391 IF (nspmd > 1) THEN
392C..... Send the contribution to Pro 0
393C..... summon the contributions then standard
394 entmp(1) = encin
395 entmp(2) = enrot
396 entmp(3) = enint
397 entmp(4) = xmomt
398 entmp(5) = ymomt
399 entmp(6) = zmomt
400 entmp(7) = xmass
401 entmp(8) = econt
402 entmp(9) = reint
403 entmp(10) = encin2
404 entmp(11) = enrot2
405 entmp(12) = eams
406 CALL spmd_glob_dsum9(entmp,12)
407 IF (ispmd==0) THEN
408 encin = entmp(1)
409 enrot = entmp(2)
410 enint = entmp(3)
411 xmomt = entmp(4)
412 ymomt = entmp(5)
413 zmomt = entmp(6)
414 xmass = entmp(7)
415 econt = entmp(8)
416 reint = entmp(9)
417 encin2 = entmp(10)
418 enrot2 = entmp(11)
419 eams = entmp(12)
420 ENDIF
421C
422 IF (istat==2) THEN
423C istat=2 => relaxation: broadcast of encin and enrot
424 CALL spmd_rbcast(entmp,entmp,1,2,0,2)
425 IF (ispmd/=0) THEN
426 encin = entmp(1)
427 enrot = entmp(2)
428 encin2 = entmp(10)
429 enrot2 = entmp(11)
430 ENDIF
431 ELSEIF (istat==3) THEN
432C istat=3 => adyrel: broadcast of encin and enrot enint
433 CALL spmd_rbcast(entmp,entmp,1,3,0,3)
434 IF (ispmd/=0) THEN
435 encin = entmp(1)
436 enrot = entmp(2)
437 enint = entmp(3)
438 ENDIF
439 ENDIF
440C
441 entmp(1) = output%TH%WFEXT
442 entmp(2) = ehour
443 entmp(3) = econtv
444 entmp(4) = dmas
445 entmp(5) = wfexth
446 entmp(6) = econtd
447 entmp(7) = econt_cumu
448 entmp(8) = wplast
449 entmp(9) = output%DATA%INOUT%DM_IN
450 entmp(10) = output%DATA%INOUT%DM_OUT
451 entmp(11) = output%DATA%INOUT%DE_IN
452 entmp(12) = output%DATA%INOUT%DE_OUT
453 CALL spmd_glob_dsum9(entmp,12)
454 IF(ispmd /= 0) THEN
455 output%TH%WFEXT = zero
456 ehour = zero
457 econtv = zero
458 dmas = zero
459 wfexth = zero
460 econtd = zero
461 econt_cumu = zero
462 wplast = zero
463 output%DATA%INOUT%DM_IN = zero
464 output%DATA%INOUT%DM_OUT = zero
465 output%DATA%INOUT%DE_IN = zero
466 output%DATA%INOUT%DE_OUT = zero
467 ELSE
468 output%TH%WFEXT = entmp(1)
469 ehour = entmp(2)
470 econtv= entmp(3)
471 dmas = entmp(4)
472 wfexth= entmp(5)
473 econtd = entmp(6)
474 econt_cumu = entmp(7)
475 wplast = entmp(8)
476 output%DATA%INOUT%DM_IN = entmp(9)
477 output%DATA%INOUT%DM_OUT = entmp(10)
478 output%DATA%INOUT%DE_IN = entmp(11)
479 output%DATA%INOUT%DE_OUT = entmp(12)
480 ENDIF
481 ENDIF
482C
483C EAMS = [ 1/2 v.Mv - 1/2 m v^2 ]/ 1/2 m v^2
484 IF(ispmd==0) THEN
485 IF(idtmins/=0.OR.idtmins_int/=0)THEN
486 IF(eams > em20)THEN
487 eams = (encin-eams)/eams
488 ELSE
489 eams = zero
490 END IF
491 END IF
492 END IF
493
494c----------------------------------------------------
495 IF (ispmd == 0) THEN
496c
497 dm_inout = output%DATA%INOUT%DM_IN+output%DATA%INOUT%DM_OUT
498 de_inout = output%DATA%INOUT%DE_IN+output%DATA%INOUT%DE_OUT
499c
500 entot = encin + enint + enrot
501 entotb = entot + encin2 + enrot2
502 IF(ncycle==0) THEN
503 entot0=entot - output%TH%WFEXT - output%TH%WFEXT_MD - de_inout
504 deltae=encin2 + enrot2
505 mass0 = xmass - dmas - dm_inout
506 ENDIF
507 entot1=entot0 + output%TH%WFEXT + de_inout
508 entot1b=entot0 + output%TH%WFEXT + deltae + output%TH%WFEXT_MD + de_inout
509 IF(abs(entot1b)>em20)THEN
510 err = entotb/entot1b - one
511 err1 = max(-x99, min(x99,err*hundred))
512 ELSE
513 err = zero
514 err1 =zero
515 ENDIF
516 emass = (xmass - (mass0+dm_inout)) / max(mass0+dm_inout,em20)
517 !EMASS = (XMASS - MASS0) / MAX(MASS0,EM20)
518 enintot = enint
519 ekintot = encin
520C-----------------------------------------------
521C /STATE/LSENSOR
522C-----------------------------------------------
523 IF (sensors%NSTAT > 0) THEN
524 mstatt = 0
525 DO i=1,sensors%NSTAT
526 isens = sensors%STAT(i)
527 ts = sensors%SENSOR_TAB(isens)%TSTART
528 IF (tt >= ts) THEN
529 mstat(i) = mstat(i)+1
530 ENDIF
531 IF (mstat(i)==1) mstatt=1
532 ENDDO
533 ENDIF
534C-----------------------------------------------
535C /OUTP/LSENSOR
536C-----------------------------------------------
537 IF (sensors%NOUTP > 0) THEN
538 moutpt = 0
539 DO i=1,sensors%NOUTP
540 isens = sensors%OUTP(i)
541 ts = sensors%SENSOR_TAB(isens)%TSTART
542 IF (tt >= ts) THEN
543 moutp(i) = moutp(i)+1
544 ENDIF
545 IF(moutp(i)==1) moutpt=1
546 ENDDO
547 ENDIF
548C
549 IF((nerr_posit==0.AND.abs(err)>demxk).OR.
550 . (nerr_posit==1.AND.err>demxk))THEN
551 CALL ancmsg(msgid=205,anmode=aninfo)
552 ierr=ierr+1
553 mstop=1
554 IF(nth/=0)THEN
555 output%TH%THIS= tt
556 ipri= 0
557 ENDIF
558 IF(nanim/=0)THEN
559 mdess = 1
560 output%TANIM = tt
561 ipri = 0
562 ENDIF
563 ELSEIF((nerr_posit==0.AND.abs(err)>demxs).OR.
564 . (nerr_posit==1.AND.err>demxs))THEN
565 CALL ancmsg(msgid=206,anmode=aninfo)
566 iwarn=iwarn+1
567 mstop=1
568 mrest=1
569 IF(nth/=0)THEN
570 output%TH%THIS= tt
571 ipri= 0
572 ENDIF
573 IF(nanim/=0)THEN
574 mdess = 1
575 output%TANIM = tt
576 ipri = 0
577 ENDIF
578 ENDIF
579C
580 IF(emass>dmtmxk)THEN
581 CALL ancmsg(msgid=207,anmode=aninfo)
582 ierr=ierr+1
583 mstop=1
584 IF(nth/=0)THEN
585 output%TH%THIS= tt
586 ipri = 0
587 ENDIF
588 IF(nanim/=0)THEN
589 mdess = 1
590 output%TANIM = tt
591 ipri = 0
592 ENDIF
593 ELSEIF(emass>dmtmxs)THEN
594 CALL ancmsg(msgid=208,anmode=aninfo)
595 iwarn=iwarn+1
596 mstop=1
597 mrest=1
598 IF(nth/=0)THEN
599 output%TH%THIS= tt
600 ipri = 0
601 ENDIF
602 IF(nanim/=0)THEN
603 mdess = 1
604 output%TANIM = tt
605 ipri = 0
606 ENDIF
607 ENDIF
608 ENDIF ! ISPMD == 0
609C---------------------------------
610C Communication MSTOP & MREST
611C---------------------------------
612 IF (nspmd > 1) THEN
613 IF (ispmd==0) THEN
614 rtmp(1) = mstop
615 rtmp(2) = mrest
616 rtmp(3) = mdess
617 rtmp(4) = output%TANIM
618 rtmp(5) = output%TH%THIS
619 rtmp(6) = tstat
620 rtmp(7) = toutp
621 rtmp(8) = info
622 rtmp(9) = h3d_data%TH3D
623 rtmp(10) = dynain_data%TDYNAIN
624 ENDIF
625C
626 CALL spmd_rbcast(rtmp,rtmp,10,1,0,2)
627
628 mstop = nint(rtmp(1))
629 mrest = nint(rtmp(2))
630 mdess = nint(rtmp(3))
631 output%TANIM = rtmp(4)
632 output%TH%THIS = rtmp(5)
633 tstat = rtmp(6)
634 toutp = rtmp(7)
635 h3d_data%TH3D = rtmp(9)
636 dynain_data%TDYNAIN = rtmp(10)
637
638 IF(info > 0) CALL spmd_exch_fvstats(monvol)
639
640 IF(ispmd/=0) RETURN
641 ! Only processor 0 will continue
642
643 ENDIF
644
645C-----------------------------------------------
646 IF(ipri==0)THEN
647 IF (nlpri /= 0) ilign = nlpri
648 jpri=mod(ncycle,ilign*iabs(ncpri))
649 IF(jpri==0) WRITE(iout,1000)
650 WRITE(iout,1100) ncycle,tt,dt2,eltyp(itypts),nelts,err1,enint,encin,enrot,output%TH%WFEXT,emass,xmass,xmass-mass0-dm_inout
651 CALL my_flush(iout)
652 IF(ncpri<0) THEN
653 IF(debug(10)/=0)THEN
654 IF(ncycle>=debug(10))THEN
655 write (*,*) " ALE ADVECTION SET OFF"
656 ENDIF
657 ENDIF
658 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
659 IF(lag_nc>0) THEN
660 WRITE(istdo,'(2(A,I8),A,1PE11.4)') ' LAG_NC=',lag_nc,', NITER_GC=',niter_gc,', LAG_ERSQ2=',lag_ersq2
661 ENDIF
662 IF(imon > 0 .AND. tt-tt0 > zero) THEN
663C compute remaining time
664 retime = (etime*(tstop-tt0)) / (tt-tt0) - etime
665 WRITE(istdo,'(A,F14.2,A,A,F14.2,A)')' ELAPSED TIME=',etime,' s ',' REMAINING TIME=',retime,' s'
666 END IF
667 CALL MY_FLUSH(ISTDO)
668 ENDIF
669 ENDIF
670C
671 IF(INFO>0)THEN
672 WRITE (IUSC3,'(//,a)',ERR=990) ' current state:'
673 WRITE (IUSC3,'(a,/)',ERR=990) ' --------------'
674 WRITE (IUSC3,'(a,i10)',ERR=990) ' cycle =',NCYCLE
675 WRITE (IUSC3,'(a,g14.7)',ERR=990) ' time =',TT
676 WRITE (IUSC3,'(a,g14.7,a,i8)',ERR=990)' time step =',DT2,ELTYP(ITYPTS),NELTS
677 WRITE (IUSC3,'(a,f5.1,a)',ERR=990) ' energy error =',ERR1,'%'
678 WRITE (IUSC3,'(a,g14.7)',ERR=990) ' internal energy =',ENINT
679 WRITE (IUSC3,'(a,g14.7)',ERR=990) ' kinetic energy =',ENCIN
680 WRITE (IUSC3,'(a,g14.7)',ERR=990) ' rot. kin. energy =',ENROT
681 WRITE (IUSC3,'(a,g14.7)',ERR=990) ' EXTERNAL work =',OUTPUT%TH%WFEXT
682 WRITE (IUSC3,'(a,g14.7)',ERR=990) ' mass.err(m-m0)/m0=',EMASS
683
684 CALL FVSTATS1(IUSC3,MONVOL,1)
685
686.AND. IF(IMON > 0 TT > ZERO) THEN
687C compute remaining time
688 RETIME = (ETIME*TSTOP) / TT - ETIME
689 WRITE(IUSC3,'(a)',ERR=990) ' '
690 WRITE(IUSC3,'(a,f14.2,a)',ERR=990)' current elapsed time =',ETIME,' s '
691 WRITE(IUSC3,'(a,f14.2,a)',ERR=990)' remaining time estimate =',RETIME,' s'
692 END IF
693
694 CLOSE(IUSC3)
695 990 CONTINUE
696 ENDIF
697C----------------
698C FORMATS
699C----------------
700 1000 FORMAT(' cycle time time-step element ',
701 + 'error i-energy k-energy t k-energy r ',
702 + 'ext-work mas.err total mass mass added')
703 1100 FORMAT(I8,2(1X,G11.4),1X,A5,1X,I10,1X,F5.1,1H%,7(1X,G11.4))
704C
705 RETURN
706 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:51
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:311
imp_dyna
Definition impbufdef_mod.F:314
impbufdef_mod
Definition impbufdef_mod.F:36
message_mod
Definition message_mod.F:1257
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, partsav, icut, xcut, 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, iparth, fr_mv, ipart_state, sh4tree, sh3tree, temp, thke, err_thk_sh4, err_thk_sh3, inod_pxfem, fthreac, nodreac, gresav, diag_sms, sh4trim, sh3trim, 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, 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, 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, mass0_start)
Definition sortie_main.F:144
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:379
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:895
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:438