Skip to content

Commit f3076b5

Browse files
Bruno02468Bruno02468
authored
Merge pull request #59 from Bruno02468/main
MYSTRAN 15.2.0 - The RBE3 Fix
2 parents 33be646 + 47bcff4 commit f3076b5

2 files changed

Lines changed: 69 additions & 33 deletions

File tree

‎Source/LK1/L1D/RBE3_PROC.f90‎

Lines changed: 66 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -104,6 +104,9 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
104104
REAL(DOUBLE) :: WT ! Sum of weights on this RBE3
105105
REAL(DOUBLE) :: WT6(6) ! WT6(i) = Sum of weights in comp i of an indep grid NB *** new 10/03/21
106106

107+
REAL(DOUBLE) :: SXY,SZX,SYZ ! new Rdd terms according to victor
108+
REAL(DOUBLE) :: WTi6(MRBE3,6) ! per-DoF grid weights
109+
107110
! **********************************************************************************************************************************
108111
IF (WRT_LOG >= SUBR_BEGEND) THEN
109112
CALL OURTIM
@@ -145,6 +148,9 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
145148
WT6(I) = ZERO ! NB *** new 10/03/21
146149
ENDDO ! NB *** new 10/03/21
147150

151+
! zero-init WTi6
152+
WTi6 = ZERO
153+
148154
! Start reading at the 2nd record of L1F for this RBE3 (first record, RYPE, was read above in calling subr, RIGID_ELEM_PROC):
149155
! Read 2nd record from L1F for this RBE3
150156
READ(L1F,IOSTAT=IOCHK) REID, AGRID_D, COMPS_D, IRBE3, WT
@@ -171,14 +177,14 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
171177
IERR = IERR + 1
172178
JERR = JERR + 1
173179
ENDIF
174-
CALL RDOF ( COMPS_I(I), CDOF_I ) ! NB *** new 10/03/21 + next 6 lines
175-
IF (CDOF_I(1) == '1') THEN ; WT6(1) = WT6(1) + WTi(I) ; ENDIF
176-
IF (CDOF_I(2) == '1') THEN ; WT6(2) = WT6(2) + WTi(I) ; ENDIF
177-
IF (CDOF_I(3) == '1') THEN ; WT6(3) = WT6(3) + WTi(I) ; ENDIF
178-
IF (CDOF_I(4) == '1') THEN ; WT6(4) = WT6(4) + WTi(I) ; ENDIF
179-
IF (CDOF_I(5) == '1') THEN ; WT6(5) = WT6(5) + WTi(I) ; ENDIF
180-
IF (CDOF_I(6) == '1') THEN ; WT6(6) = WT6(6) + WTi(I) ; ENDIF
181-
write(f06,*)
180+
CALL RDOF ( COMPS_I(I), CDOF_I )
181+
DO J=1,6
182+
IF (CDOF_I(J) == '1') THEN
183+
WTi6(I,J) = WTi(I)
184+
WT6(J) = WT6(J) + WTi(I)
185+
END IF
186+
END DO
187+
WRITE(f06,*)
182188
ENDDO
183189

184190
! Return if error
@@ -235,9 +241,11 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
235241
DYI(J) = DUM3(2)
236242
DZI(J) = DUM3(3)
237243

238-
DX_BAR = DX_BAR + WTi(J)*DXI(J)/WT6(1) ! NB *** new 10/03/21. Change WT to WT6(1)
239-
DY_BAR = DY_BAR + WTi(J)*DYI(J)/WT6(2) ! NB *** new 10/03/21. Change WT to WT6(2)
240-
DZ_BAR = DZ_BAR + WTi(J)*DZI(J)/WT6(3) ! NB *** new 10/03/21. Change WT to WT6(3)
244+
DX_BAR = DX_BAR + WTi6(J,1)*DXI(J)
245+
DY_BAR = DY_BAR + WTi6(J,2)*DYI(J)
246+
DZ_BAR = DZ_BAR + WTi6(J,3)*DZI(J)
247+
248+
241249
ENDDO
242250

243251

@@ -249,13 +257,23 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
249257

250258
DO J=1,IRBE3
251259

252-
EBAR_YZ = EBAR_YZ + WTi(J)*( DYI(J)*DYI(J) + DZI(J)*DZI(J) )/WT
253-
EBAR_ZX = EBAR_ZX + WTi(J)*( DZI(J)*DZI(J) + DXI(J)*DXI(J) )/WT
254-
EBAR_XY = EBAR_XY + WTi(J)*( DXI(J)*DXI(J) + DYI(J)*DYI(J) )/WT
260+
EBAR_YZ = EBAR_YZ + WTi6(J,3)*DYI(J)*DYI(J) + WTi6(J,2)*DZI(J)*DZI(J)
261+
EBAR_ZX = EBAR_ZX + WTi6(J,1)*DZI(J)*DZI(J) + WTi6(J,3)*DXI(J)*DXI(J)
262+
EBAR_XY = EBAR_XY + WTi6(J,2)*DXI(J)*DXI(J) + WTi6(J,1)*DYI(J)*DYI(J)
255263

256264
ENDDO
257265

258-
266+
! Calc the S-terms
267+
SXY = ZERO
268+
SZX = ZERO
269+
SYZ = ZERO
270+
271+
DO J=1,IRBE3
272+
SXY = SXY + WTi6(J,3) * DXI(J) * DYI(J)
273+
SZX = SZX + WTi6(J,2) * DZI(J) * DXI(J)
274+
SYZ = SYZ + WTi6(J,1) * DYI(J) * DZI(J)
275+
END DO
276+
259277
CALL TDOF_COL_NUM ( 'G ', G_SET_COL_NUM )
260278
CALL TDOF_COL_NUM ( 'M ', M_SET_COL_NUM )
261279
CALL RDOF ( COMPS_D, CDOF_D )
@@ -290,10 +308,10 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
290308
! Write coeff for the T1, T2 or T3 component at the ref pt
291309
IF ((I == 1) .OR. (I == 2) .OR. (I == 3)) THEN
292310
IF (DABS(WT) > EPS1) THEN
293-
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(I), ONE
311+
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(I), WT6(I)
294312
ITERM_RMG = ITERM_RMG + 1
295313
ELSE
296-
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(I), ONE
314+
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(I), WT6(I)
297315
ITERM_RMG = ITERM_RMG + 1
298316
CYCLE do_i1
299317
ENDIF
@@ -345,6 +363,12 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
345363
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(I), ONE
346364
ITERM_RMG = ITERM_RMG + 1
347365
ENDIF
366+
367+
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(5), -SXY
368+
ITERM_RMG = ITERM_RMG + 1
369+
370+
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(6), -SZX
371+
ITERM_RMG = ITERM_RMG + 1
348372
ENDIF
349373

350374
IF (I == 5) THEN
@@ -355,6 +379,12 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
355379
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(I), ONE
356380
ITERM_RMG = ITERM_RMG + 1
357381
ENDIF
382+
383+
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(4), -SXY
384+
ITERM_RMG = ITERM_RMG + 1
385+
386+
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(6), -SYZ
387+
ITERM_RMG = ITERM_RMG + 1
358388
ENDIF
359389

360390
IF (I == 6) THEN
@@ -365,6 +395,12 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
365395
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(I), ONE
366396
ITERM_RMG = ITERM_RMG + 1
367397
ENDIF
398+
399+
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(4), -SZX
400+
ITERM_RMG = ITERM_RMG + 1
401+
402+
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_D(5), -SYZ
403+
ITERM_RMG = ITERM_RMG + 1
368404
ENDIF
369405

370406
IF (I == 4) THEN
@@ -441,9 +477,9 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
441477
CALL MATMULT_FFF_T ( T0D, T0I, 3, 3, 3, TDI )
442478

443479
IF ((I == 1) .OR. (I == 2) .OR. (I == 3)) THEN
444-
CALL WRITE_L1J_123 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi, AGRID_I, CDOF_I, COMPS_I, TDI )
480+
CALL WRITE_L1J_123 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi6, AGRID_I, CDOF_I, COMPS_I, TDI )
445481
ELSE
446-
CALL WRITE_L1J_456 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi, AGRID_I, CDOF_I, DXI, DYI, DZI )
482+
CALL WRITE_L1J_456 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi6, AGRID_I, CDOF_I, DXI, DYI, DZI )
447483
ENDIF
448484

449485
ENDDO do_j1
@@ -497,7 +533,7 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR )
497533

498534
! ##################################################################################################################################
499535

500-
SUBROUTINE WRITE_L1J_123 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi, AGRID_I, CDOF_I, COMPS_I, TDI )
536+
SUBROUTINE WRITE_L1J_123 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi6, AGRID_I, CDOF_I, COMPS_I, TDI )
501537

502538
USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE
503539
USE IOUNT1, ONLY : L1J
@@ -520,7 +556,7 @@ SUBROUTINE WRITE_L1J_123 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi, AGR
520556
INTEGER(LONG) :: ROW_NUM_START_I ! DOF number where TDOF data begins for a grid
521557

522558
REAL(DOUBLE) , INTENT(IN) :: TDI(3,3) ! TOD'*T0I
523-
REAL(DOUBLE) , INTENT(IN) :: WTi(MRBE3) ! Weight value for an indep grid
559+
REAL(DOUBLE) , INTENT(IN) :: WTi6(MRBE3,6) ! Weight value for an indep grid (PER-DOF)
524560

525561
! **********************************************************************************************************************************
526562

@@ -534,7 +570,7 @@ SUBROUTINE WRITE_L1J_123 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi, AGR
534570
RMG_COL_NUM_I = TDOF(ROW_NUM,G_SET_COL_NUM)
535571

536572
IF (RMG_COL_NUM_I > 0) THEN ! NB *** new 10/03/21 Change WT (below) to WT6(K)
537-
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_I, -WTi(J)*TDI(I,K)/WT6(K)
573+
WRITE(L1J) RMG_ROW_NUM, RMG_COL_NUM_I, -WTi6(J,K)*TDI(I,K)
538574
ITERM_RMG = ITERM_RMG + 1
539575
ELSE
540576
WRITE(ERR,1513) 'RBE3_PROC', AGRID_I(J) ,COMPS_I(J), RMG_COL_NUM_I
@@ -558,7 +594,7 @@ END SUBROUTINE WRITE_L1J_123
558594

559595
! ##################################################################################################################################
560596

561-
SUBROUTINE WRITE_L1J_456 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi, AGRID_I, CDOF_I, DXI, DYI, DZI )
597+
SUBROUTINE WRITE_L1J_456 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi6, AGRID_I, CDOF_I, DXI, DYI, DZI )
562598

563599
USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE
564600
USE IOUNT1, ONLY : L1J
@@ -581,7 +617,7 @@ SUBROUTINE WRITE_L1J_456 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi, AGR
581617
REAL(DOUBLE) , INTENT(IN) :: DXI(MRBE3) ! Distances from ref pt to pt i in X global directions at ref pt
582618
REAL(DOUBLE) , INTENT(IN) :: DYI(MRBE3) ! Distances from ref pt to pt i in Y global directions at ref pt
583619
REAL(DOUBLE) , INTENT(IN) :: DZI(MRBE3) ! Distances from ref pt to pt i in Z global directions at ref pt
584-
REAL(DOUBLE) , INTENT(IN) :: WTi(MRBE3) ! Weight value for an indep grid
620+
REAL(DOUBLE) , INTENT(IN) :: WTi6(MRBE3,6) ! Weight value for an indep grid (PER-DOF)
585621

586622
! **********************************************************************************************************************************
587623
!xx CALL CALC_TDOF_ROW_NUM ( AGRID_I(J), ROW_NUM_START_I, 'N' )
@@ -599,36 +635,36 @@ SUBROUTINE WRITE_L1J_456 ( I, J, ITERM_RMG, G_SET_COL_NUM, RMG_ROW_NUM, WTi, AGR
599635
IF (I == 4) THEN ! Rotation about x, i.e. in yz (23) plane
600636

601637
IF (CDOF_I(2) == '1') THEN
602-
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+2, +WTi(J)*DZI(J)/WT
638+
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+2, +WTi6(J,1)*DZI(J)
603639
ITERM_RMG = ITERM_RMG +1
604640
ENDIF
605641

606642
IF (CDOF_I(3) == '1') THEN
607-
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+3, -WTi(J)*DYI(J)/WT
643+
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+3, -WTi6(J,1)*DYI(J)
608644
ITERM_RMG = ITERM_RMG +1
609645
ENDIF
610646

611647
ELSE IF (I == 5) THEN ! Rotation about y, i.e. in zx (31) plane
612648

613649
IF (CDOF_I(1) == '1') THEN
614-
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+1, -WTi(J)*DZI(J)/WT
650+
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+1, -WTi6(J,2)*DZI(J)
615651
ITERM_RMG = ITERM_RMG +1
616652
ENDIF
617653

618654
IF (CDOF_I(3) == '1') THEN
619-
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+3, +WTi(J)*DXI(J)/WT
655+
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+3, +WTi6(J,2)*DXI(J)
620656
ITERM_RMG = ITERM_RMG +1
621657
ENDIF
622658

623659
ELSE IF (I == 6) THEN ! Rotation about z, i.e. in xy (12) plane
624660

625661
IF (CDOF_I(1) == '1') THEN
626-
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+1, +WTi(J)*DYI(J)/WT
662+
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+1, +WTi6(J,3)*DYI(J)
627663
ITERM_RMG = ITERM_RMG +1
628664
ENDIF
629665

630666
IF (CDOF_I(2) == '1') THEN
631-
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+2, -WTi(J)*DXI(J)/WT
667+
WRITE(L1J) RMG_ROW_NUM, (RMG_COL_NUM_START-1)+2, -WTi6(J,3)*DXI(J)
632668
ITERM_RMG = ITERM_RMG +1
633669
ENDIF
634670

‎Source/Modules/MYSTRAN_Version.f90‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -35,9 +35,9 @@ MODULE MYSTRAN_Version
3535
SAVE
3636

3737
CHARACTER(256*BYTE) :: MYSTRAN_COMMENT = '*** Please report any problems to mystransolver@gmail.com ***'
38-
CHARACTER( 8*BYTE), PARAMETER :: MYSTRAN_VER_NUM = '15.1.7'
39-
CHARACTER( 3*BYTE), PARAMETER :: MYSTRAN_VER_MONTH= 'Mar'
40-
CHARACTER( 2*BYTE), PARAMETER :: MYSTRAN_VER_DAY = '24'
38+
CHARACTER( 8*BYTE), PARAMETER :: MYSTRAN_VER_NUM = '15.2.0'
39+
CHARACTER( 3*BYTE), PARAMETER :: MYSTRAN_VER_MONTH= 'Apr'
40+
CHARACTER( 2*BYTE), PARAMETER :: MYSTRAN_VER_DAY = '07'
4141
CHARACTER( 4*BYTE), PARAMETER :: MYSTRAN_VER_YEAR = '2024'
4242
CHARACTER( 33*BYTE), PARAMETER :: MYSTRAN_AUTHOR = 'MYSTRAN developed by Dr Bill Case'
4343

0 commit comments

Comments
 (0)