OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ecrit.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr02_c.inc"
#include "scr06_c.inc"
#include "scr07_c.inc"
#include "scr11_c.inc"
#include "scr16_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "stati_c.inc"
#include "statr_c.inc"
#include "warn_c.inc"
#include "task_c.inc"
#include "lagmult.inc"
#include "impl1_c.inc"
#include "fxbcom.inc"
#include "timeri_c.inc"
#include "sms_c.inc"
#include "rad2r_c.inc"
#include "inter22.inc"
#include "itet2_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ ecrit()

subroutine ecrit ( type(timer_), intent(inout) timers,
partsav,
ms,
v,
in,
r,
dmas,
integer, dimension(numnod) weight,
enintot,
ekintot,
a,
ar,
integer, dimension(nbipm,*) fxbipm,
fxbrpm,
integer, dimension(*) monvol,
xmom_sms,
type (sensors_), intent(in) sensors,
qfricint,
integer, dimension(npari,ninter) ipari,
integer, dimension(numnod) weight_md,
intent(inout) wfexth,
integer iflag,
ms_2d,
type(multi_fvm_struct), intent(in) multi_fvm,
mas_nd,
kend,
type(h3d_database), intent(inout) h3d_data,
type (dynain_database), intent(inout) dynain_data,
intent(in) usreint,
type(output_), intent(inout) output )
Parameters
[in,out]outputoutput structure

Definition at line 45 of file ecrit.F.

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.AND..AND. IF ((IRAD2R==1)(R2R_SIU==1)(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.AND..AND. IF(IPRI/=0ITHIS/=0
172.AND. . INFO<=0ISTAT==0
173.AND..AND..AND. . NTH==0NANIM==0
174.OR. . (IABFIS/=0ABFILE(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.AND..NOT. IF(N2D == 0 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.AND. ELSEIF(IDTMINS==0IDTMINS_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.OR. IF(NTY == 7 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.OR. IF(IDTMINS/=0IDTMINS_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.AND..OR. IF((NERR_POSIT==0ABS(ERR)>DEMXK)
550.AND. . (NERR_POSIT==1ERR>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.AND..OR. ELSEIF((NERR_POSIT==0ABS(ERR)>DEMXS)
564.AND. . (NERR_POSIT==1ERR>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.AND. IF(IMON > 0 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
my_real
#define my_real
Definition cppsort.cpp:32
h3d_mod
Definition h3d_mod.F:311
imp_dyna
Definition impbufdef_mod.F:314
message_mod
Definition message_mod.F:1257
state_mod
Definition state_mod.F:54