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 46 of file ecrit.F.

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.AND..AND. IF ((IRAD2R==1)(R2R_SIU==1)(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.AND..AND. IF(IPRI/=0ITHIS/=0
174.AND. . INFO<=0ISTAT==0
175.AND..AND..AND. . NTH==0NANIM==0
176.OR. . (IABFIS/=0ABFILE(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.AND..NOT. IF(N2D == 0 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.AND. ELSEIF(IDTMINS==0IDTMINS_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.OR. IF(NTY == 7 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.OR. IF(IDTMINS/=0IDTMINS_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.AND..OR. IF((NERR_POSIT==0ABS(ERR)>DEMXK)
538.AND. . (NERR_POSIT==1ERR>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.AND..OR. ELSEIF((NERR_POSIT==0ABS(ERR)>DEMXS)
552.AND. . (NERR_POSIT==1ERR>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.AND. IF(IMON > 0 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.AND. IF(IMON > 0 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
my_real
#define my_real
Definition cppsort.cpp:32
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