From a24eb772495af29d0a180a863acc548044b35d60 Mon Sep 17 00:00:00 2001 From: "U-DESKTOP-CPU04V4\\vic" Date: Mon, 6 Apr 2026 12:34:02 +1200 Subject: [PATCH] gated writes to F06 --- Source/Interfaces/WRITE_BAR_Interface.f90 | 5 +- Source/LK9/L91/WRITE_BAR.f90 | 21 +++--- Source/LK9/L91/WRITE_ELEM_STRESSES.f90 | 90 +++++++++++++---------- 3 files changed, 66 insertions(+), 50 deletions(-) diff --git a/Source/Interfaces/WRITE_BAR_Interface.f90 b/Source/Interfaces/WRITE_BAR_Interface.f90 index c103b2bf..2ce84577 100644 --- a/Source/Interfaces/WRITE_BAR_Interface.f90 +++ b/Source/Interfaces/WRITE_BAR_Interface.f90 @@ -30,7 +30,7 @@ MODULE WRITE_BAR_Interface SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & TITLE, SUBTITLE, LABEL, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE ) + FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_F06 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE @@ -57,7 +57,8 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & CHARACTER(LEN=128), INTENT(IN) :: LABEL ! the subcase LABEL INTEGER(LONG), INTENT(IN) :: FIELD5_INT_MODE REAL(DOUBLE), INTENT(IN) :: FIELD6_EIGENVALUE - + LOGICAL, INTENT(IN) :: WRITE_F06 + END SUBROUTINE WRITE_BAR END INTERFACE diff --git a/Source/LK9/L91/WRITE_BAR.f90 b/Source/LK9/L91/WRITE_BAR.f90 index 65a0f6c0..5323f458 100644 --- a/Source/LK9/L91/WRITE_BAR.f90 +++ b/Source/LK9/L91/WRITE_BAR.f90 @@ -26,7 +26,7 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & TITLE, SUBTITLE, LABEL, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE ) + FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_F06 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06, OP2 @@ -52,6 +52,7 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & CHARACTER(LEN=128), INTENT(IN) :: LABEL ! the subcase LABEL INTEGER(LONG), INTENT(IN) :: FIELD5_INT_MODE REAL(DOUBLE), INTENT(IN) :: FIELD6_EIGENVALUE + LOGICAL, INTENT(IN) :: WRITE_F06 CHARACTER(133*BYTE) :: BLINE1A ! Result of concatenating char. variables BOUT1, BMS1, BMSF1, BTOR to ! make the 1st line of stress output for a CBAR with torsional stress @@ -190,13 +191,13 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & ENDIF ! Write the two lines of stress output for one element to F06 - WRITE(F06,*) + IF (WRITE_F06) WRITE(F06,*) IF (PRTANS == 'Y') WRITE(ANS,*) IF (BARTOR == 'Y') THEN BLINE1A = BOUT1//BMS1//BMSF1//BTOR BLINE2A = BOUT2//BMS2//BMSF2//BMS3//BMSF3 - WRITE(F06,9031) BLINE1A - WRITE(F06,9031) BLINE2A + IF (WRITE_F06) WRITE(F06,9031) BLINE1A + IF (WRITE_F06) WRITE(F06,9031) BLINE2A IF (PRTANS == 'Y') THEN WRITE(ANS,9901) FILL_ANS, EID_OUT_ARRAY(I,1), (OGEL(K-1,J),J=1,9) WRITE(ANS,9902) FILL_ANS, (OGEL(K,J),J=1,9) @@ -204,8 +205,8 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & ELSE BLINE1B = BOUT1//BMS1//BMSF1 BLINE2B = BOUT2//BMS2//BMSF2 - WRITE(F06,9031) BLINE1B - WRITE(F06,9031) BLINE2B + IF (WRITE_F06) WRITE(F06,9031) BLINE1B + IF (WRITE_F06) WRITE(F06,9031) BLINE2B IF (PRTANS == 'Y') THEN WRITE(ANS,9903) FILL_ANS, EID_OUT_ARRAY(I,1), (OGEL(K-1,J),J=1,8) WRITE(ANS,9904) FILL_ANS, (OGEL(K,J),J=1,8) @@ -218,9 +219,11 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & ENDDO CALL GET_MAX_MIN_ABS ( 1, 8 ) - WRITE(F06,9108) (MAX_ANS_CHAR(J),J=1,7), MAX_ANS(8), (MAX_ANS_CHAR(J),J=9,15), MAX_ANS(16), & - (MIN_ANS_CHAR(J),J=1,7), MIN_ANS(8), (MIN_ANS_CHAR(J),J=9,15), MIN_ANS(16), & - (ABS_ANS_CHAR(J),J=1,7), ABS_ANS(8), (ABS_ANS_CHAR(J),J=9,15), ABS_ANS(16) + IF (WRITE_F06) THEN + WRITE(F06,9108) (MAX_ANS_CHAR(J),J=1,7), MAX_ANS(8), (MAX_ANS_CHAR(J),J=9,15), MAX_ANS(16), & + (MIN_ANS_CHAR(J),J=1,7), MIN_ANS(8), (MIN_ANS_CHAR(J),J=9,15), MIN_ANS(16), & + (ABS_ANS_CHAR(J),J=1,7), ABS_ANS(8), (ABS_ANS_CHAR(J),J=9,15), ABS_ANS(16) + ENDIF IF (PRTANS == 'Y') THEN WRITE(ANS,9118) (MAX_ANS(J),J=1,16),(MIN_ANS(J),J=1,16), (ABS_ANS(J),J=1,16) ENDIF diff --git a/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 b/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 index 10c44684..96d71237 100644 --- a/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 +++ b/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 @@ -348,7 +348,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ELSE IF (TYPE(1:5) == 'SHEAR') THEN IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - WRITE(F06,302) FILL(1: 20) + IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) ELSE IF (WRITE_F06) WRITE(F06,301) FILL(1: 13) @@ -431,7 +431,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ! Write the element stress output IF (TYPE == 'BAR ') THEN CALL WRITE_BAR(NUM, FILL(1:1), FILL(1:16), ISUBCASE, ITABLE, TITLEI, STITLEI, LABELI, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE) + FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_F06) ELSE IF (TYPE(1:4) == 'ELAS') THEN IF (WRITE_OP2) THEN @@ -451,7 +451,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, REAL(OGEL(I,1), 4), I=1,NUM) ENDIF ! end of op2 - WRITE(F06,1103) (FILL(1:1), EID_OUT_ARRAY(I,1), OGEL(I,1),I=1,NUM) + IF(WRITE_F06) WRITE(F06,1103) (FILL(1:1), EID_OUT_ARRAY(I,1), OGEL(I,1),I=1,NUM) IF(WRITE_ANS) WRITE(ANS,1104) (FILL(1:16), EID_OUT_ARRAY(I,1),OGEL(I,1),I=1,NUM) ELSE IF((TYPE(1:4) == 'HEXA') .OR. (TYPE(1:5) == 'PENTA') .OR. (TYPE(1:5) == 'TETRA')) THEN @@ -521,28 +521,33 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) NCOLS = 8 ENDIF - K = 0 - DO I=1,NUM,NUM_PTS - K = K + 1 - ! Center - WRITE(F06,1303) EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,NCOLS) - ! Corner - DO L=1,NUM_PTS-1 + IF (WRITE_F06) THEN + K = 0 + DO I=1,NUM,NUM_PTS K = K + 1 - WRITE(F06,1306) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,NCOLS) + ! Center + WRITE(F06,1303) EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,NCOLS) + ! Corner + DO L=1,NUM_PTS-1 + K = K + 1 + WRITE(F06,1306) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,NCOLS) + ENDDO ENDDO - ENDDO - + ENDIF CALL GET_MAX_MIN_ABS_STR ( NUM, NCOLS, 'N', MAX_ANS, MIN_ANS, ABS_ANS ) IF (STRE_OPT == 'VONMISES') THEN - WRITE(F06,1304) (MAX_ANS(J),J=1,7), (MIN_ANS(J),J=1,7), (ABS_ANS(J),J=1,7) + IF (WRITE_F06) THEN + WRITE(F06,1304) (MAX_ANS(J),J=1,7), (MIN_ANS(J),J=1,7), (ABS_ANS(J),J=1,7) + ENDIF IF (WRITE_ANS) THEN WRITE(ANS,1314) (MAX_ANS(J),J=1,7), (MIN_ANS(J),J=1,7), (ABS_ANS(J),J=1,7) ENDIF ELSE - WRITE(F06,1305) (MAX_ANS(J),J=1,8), (MIN_ANS(J),J=1,8), (ABS_ANS(J),J=1,8) + IF (WRITE_F06) THEN + WRITE(F06,1305) (MAX_ANS(J),J=1,8), (MIN_ANS(J),J=1,8), (ABS_ANS(J),J=1,8) + ENDIF IF (WRITE_ANS) THEN WRITE(ANS,1315) (MAX_ANS(J),J=1,8), (MIN_ANS(J),J=1,8), (ABS_ANS(J),J=1,8) ENDIF @@ -615,31 +620,34 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) 4 FORMAT(' *DEBUG: WRITE_CQUAD4-144: I=',I4, " K=", I4) K = K + 1 WRITE(ERR,4) I,K - WRITE(F06,*) + IF (WRITE_F06) WRITE(F06,*) IF (WRITE_ANS) WRITE(ANS,*) - WRITE(F06,1403) FILL(1: 0), EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,10) + IF (WRITE_F06) WRITE(F06,1403) FILL(1: 0), EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,10) IF (WRITE_ANS) WRITE(ANS,1413) EID_OUT_ARRAY(I,1), (OGEL(K,J),J=1,10) K = K + 1 - WRITE(F06,1404) FILL(1: 0), (OGEL(K,J),J=1,8) + IF (WRITE_F06) WRITE(F06,1404) FILL(1: 0), (OGEL(K,J),J=1,8) IF (WRITE_ANS) WRITE(ANS,1414) (OGEL(K,J),J=1,8) DO L=1,NUM_PTS-1 K = K + 1 WRITE(ERR,4) I,K - WRITE(F06,*) + IF (WRITE_F06) WRITE(F06,*) IF (WRITE_ANS) WRITE(ANS,*) IF (DABS(POLY_FIT_ERR(I+L)) >= 0.01D0) THEN - WRITE(F06,1405) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L), POLY_FIT_ERR_INDEX(I+L) + IF (WRITE_F06) THEN + WRITE(F06,1405) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L), & + POLY_FIT_ERR_INDEX(I+L) + ENDIF WRT_ERR_INDEX_NOTE(POLY_FIT_ERR_INDEX(I+L)) = 'Y' ELSE - WRITE(F06,1406) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L) + IF (WRITE_F06) WRITE(F06,1406) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L) ENDIF IF (WRITE_ANS) THEN WRITE(ANS,1415) GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L), POLY_FIT_ERR_INDEX(I+L) ENDIF K = K + 1 - WRITE(F06,1407) FILL(1: 0), (OGEL(K,J),J=1,8) + IF (WRITE_F06) WRITE(F06,1407) FILL(1: 0), (OGEL(K,J),J=1,8) IF (WRITE_ANS) WRITE(ANS,1417) (OGEL(K,J),J=1,8) ENDDO @@ -672,20 +680,24 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ! Get abs POLY_FIT_ERR ABS_ANS(11) = MAX( DABS(MAX_ANS(11)), DABS(MIN_ANS(11)) ) - IF ((STRE_LOC == 'CORNER ') .OR. (TYPE(1:5) == 'QUAD8')) THEN - WRITE(F06,1408) FILL(1: 0), FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9), & - MAX_ANS(10),MAX_ANS(11), & - FILL(1: 0), MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9), & - MIN_ANS(10),MIN_ANS(11), & - FILL(1: 0), ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9), & - ABS_ANS(10),ABS_ANS(11), FILL(1: 0) - ELSE - WRITE(F06,1408) FILL(1: 0), FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9), & - MAX_ANS(10),MAX_ANS(11), & - FILL(1: 0), MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9), & - MIN_ANS(10),MIN_ANS(11), & - FILL(1: 0), ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9), & - ABS_ANS(10),ABS_ANS(11), FILL(1: 0) + IF (WRITE_F06) THEN + IF ((STRE_LOC == 'CORNER ') .OR. (TYPE(1:5) == 'QUAD8')) THEN + WRITE(F06,1408) FILL(1: 0), & + FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9), & + MAX_ANS(10),MAX_ANS(11), & + FILL(1: 0), MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9), & + MIN_ANS(10),MIN_ANS(11), & + FILL(1: 0), ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9), & + ABS_ANS(10),ABS_ANS(11), FILL(1: 0) + ELSE + WRITE(F06,1408) FILL(1: 0), & + FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9), & + MAX_ANS(10),MAX_ANS(11), & + FILL(1: 0), MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9), & + MIN_ANS(10),MIN_ANS(11), & + FILL(1: 0), ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9), & + ABS_ANS(10),ABS_ANS(11), FILL(1: 0) + ENDIF ENDIF IF (WRITE_ANS) THEN @@ -707,7 +719,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ENDIF ENDDO - IF (WRITE_NOTES == 'Y') THEN + IF ((WRITE_NOTES == 'Y') .AND. (WRITE_F06)) THEN WRITE(F06,1498) DO I=1,MAX_NUM_STR IF (WRT_ERR_INDEX_NOTE(I) == 'Y') THEN @@ -744,13 +756,13 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ENDIF DO I=1,NUM - WRITE(F06,1802) EID_OUT_ARRAY(I,1),(OGEL(I,J),J=1,6) + IF (WRITE_F06) WRITE(F06,1802) EID_OUT_ARRAY(I,1), (OGEL(I,J),J=1,6) IF (WRITE_ANS) WRITE(ANS,1812) EID_OUT_ARRAY(I,1), (OGEL(I,J),J=1,6) ENDDO ELSE IF (TYPE == 'USERIN ') THEN DO I=1,NUM - WRITE(F06,1902) EID_OUT_ARRAY(I,1), (OGEL(I,J),J=1,6) + IF (WRITE_F06) WRITE(F06,1902) EID_OUT_ARRAY(I,1), (OGEL(I,J),J=1,6) IF (WRITE_ANS) WRITE(ANS,1812) EID_OUT_ARRAY(I,1), (OGEL(I,J),J=1,6) ENDDO