From 2d50eabd8dc38ef9b6b44d1aea44ac6c5062694c Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Thu, 28 May 2026 18:26:20 -0300 Subject: [PATCH] link9 is now somewhat faster --- .gitmodules | 3 + Source/Interfaces/FMT_ES14_6_Interface.f90 | 44 ++++++ Source/Interfaces/FMT_I8_RJ_Interface.f90 | 44 ++++++ Source/LK9/L91/WRITE_ELEM_STRAINS.f90 | 23 ++- Source/LK9/L91/WRITE_ELEM_STRESSES.f90 | 22 ++- Source/LK9/L91/WRITE_GRD_PRT_OUTPUTS.f90 | 52 ++++--- Source/LK9/L91/WRT_REAL_TO_CHAR_VAR.f90 | 11 +- Source/LK9/L92/OFP1.f90 | 10 +- Source/LK9/L92/OFP2.f90 | 10 +- Source/LK9/L92/OFP3.f90 | 6 +- Source/LK9/L92/OFP3_ELFE_1D.f90 | 6 +- Source/LK9/L92/OFP3_ELFE_2D.f90 | 6 +- Source/LK9/L92/OFP3_STRE_NO_PCOMP.f90 | 6 +- Source/LK9/L92/OFP3_STRE_PCOMP.f90 | 6 +- Source/LK9/L92/OFP3_STRN_NO_PCOMP.f90 | 6 +- Source/LK9/L92/OFP3_STRN_PCOMP.f90 | 6 +- Source/USE_IFs/FMT_ES14_6_USE_IFs.f90 | 32 +++++ Source/USE_IFs/FMT_I8_RJ_USE_IFs.f90 | 32 +++++ Source/USE_IFs/WRITE_ELEM_STRAINS_USE_IFs.f90 | 2 + .../USE_IFs/WRITE_ELEM_STRESSES_USE_IFs.f90 | 2 + .../USE_IFs/WRITE_GRD_PRT_OUTPUTS_USE_IFs.f90 | 2 + .../USE_IFs/WRT_REAL_TO_CHAR_VAR_USE_IFs.f90 | 3 +- Source/UTIL/FMT_ES14_6.f90 | 134 ++++++++++++++++++ Source/UTIL/FMT_I8_RJ.f90 | 73 ++++++++++ 24 files changed, 456 insertions(+), 85 deletions(-) create mode 100644 Source/Interfaces/FMT_ES14_6_Interface.f90 create mode 100644 Source/Interfaces/FMT_I8_RJ_Interface.f90 create mode 100644 Source/USE_IFs/FMT_ES14_6_USE_IFs.f90 create mode 100644 Source/USE_IFs/FMT_I8_RJ_USE_IFs.f90 create mode 100644 Source/UTIL/FMT_ES14_6.f90 create mode 100644 Source/UTIL/FMT_I8_RJ.f90 diff --git a/.gitmodules b/.gitmodules index 8fbb8438..90039583 100644 --- a/.gitmodules +++ b/.gitmodules @@ -11,18 +11,21 @@ ignore = all update = checkout branch = master + [submodule "metis/GKlib"] path = submodules/GKlib url = https://github.com/KarypisLab/GKlib.git ignore = all update = checkout branch = master + [submodule "metis/METIS"] path = submodules/metis url = https://github.com/KarypisLab/METIS.git ignore = all update = checkout branch = master + [submodule "Source/lapack"] path = submodules/lapack url = https://github.com/Reference-LAPACK/lapack.git diff --git a/Source/Interfaces/FMT_ES14_6_Interface.f90 b/Source/Interfaces/FMT_ES14_6_Interface.f90 new file mode 100644 index 00000000..226fd04d --- /dev/null +++ b/Source/Interfaces/FMT_ES14_6_Interface.f90 @@ -0,0 +1,44 @@ +! ############################################################################################################################### +! Begin MIT license text. +! _______________________________________________________________________________________________________ + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and +! associated documentation files (the "Software"), to deal in the Software without restriction, including +! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! _______________________________________________________________________________________________________ + +! End MIT license text. + + MODULE FMT_ES14_6_Interface + + INTERFACE + + SUBROUTINE FMT_ES14_6 ( V, OUT ) + + USE PENTIUM_II_KIND, ONLY : BYTE, DOUBLE + + IMPLICIT NONE + + REAL(DOUBLE), INTENT(IN) :: V ! Real value to format + CHARACTER(14*BYTE), INTENT(OUT) :: OUT ! 14-char formatted result + + END SUBROUTINE FMT_ES14_6 + + END INTERFACE + + END MODULE FMT_ES14_6_Interface diff --git a/Source/Interfaces/FMT_I8_RJ_Interface.f90 b/Source/Interfaces/FMT_I8_RJ_Interface.f90 new file mode 100644 index 00000000..9c901a05 --- /dev/null +++ b/Source/Interfaces/FMT_I8_RJ_Interface.f90 @@ -0,0 +1,44 @@ +! ############################################################################################################################### +! Begin MIT license text. +! _______________________________________________________________________________________________________ + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and +! associated documentation files (the "Software"), to deal in the Software without restriction, including +! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! _______________________________________________________________________________________________________ + +! End MIT license text. + + MODULE FMT_I8_RJ_Interface + + INTERFACE + + SUBROUTINE FMT_I8_RJ ( V, OUT ) + + USE PENTIUM_II_KIND, ONLY : BYTE, LONG + + IMPLICIT NONE + + INTEGER(LONG), INTENT(IN) :: V ! Integer value to format + CHARACTER(8*BYTE), INTENT(OUT) :: OUT ! 8-char right-justified result + + END SUBROUTINE FMT_I8_RJ + + END INTERFACE + + END MODULE FMT_I8_RJ_Interface diff --git a/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 b/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 index a36e5259..47c28941 100644 --- a/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 +++ b/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 @@ -68,7 +68,8 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) INTEGER(LONG) :: I,J,L ! DO loop indices INTEGER(LONG) :: K ! Counter INTEGER(LONG) :: NCOLS ! Num of cols to write out - + CHARACTER(139*BYTE) :: CLINE_BUF ! Pre-assembled CENTER line for solid strains (matches FORMAT 1303) + CHARACTER(139*BYTE) :: GLINE_BUF ! Pre-assembled GRD line for solid strains (matches FORMAT 1306) REAL(DOUBLE) :: ABS_ANS(11) ! Max ABS for all element output REAL(DOUBLE) :: MAX_ANS(11) ! Max for all element output @@ -445,15 +446,31 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) NCOLS = 8 ENDIF + ! Pre-fill the fixed-text positions of the line buffers; variable fields (EID/GID and the + ! per-point values) are overwritten in the loop below. Layouts: + ! CLINE_BUF: FORMAT 1303 = (1X,I8,2X,'CENTER ',8X,8(1ES14.6)) + ! GLINE_BUF: FORMAT 1306 = (1X,A,10X,'GRD',I8,5X,8(1ES14.6)) with A = FILL(1:0) (empty) + CLINE_BUF = ' ' + CLINE_BUF(12:19) = 'CENTER ' + GLINE_BUF = ' ' + GLINE_BUF(12:14) = 'GRD' 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) + CALL FMT_I8_RJ ( EID_OUT_ARRAY(I,1), CLINE_BUF(2:9) ) + DO J=1,NCOLS + CALL FMT_ES14_6 ( OGEL(K,J), CLINE_BUF(28 + (J-1)*14 : 27 + J*14) ) + ENDDO + WRITE(F06,'(A)') CLINE_BUF(1 : 27 + NCOLS*14) ! 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) + CALL FMT_I8_RJ ( GID_OUT_ARRAY(I,L+1), GLINE_BUF(15:22) ) + DO J=1,NCOLS + CALL FMT_ES14_6 ( OGEL(K,J), GLINE_BUF(28 + (J-1)*14 : 27 + J*14) ) + ENDDO + WRITE(F06,'(A)') GLINE_BUF(1 : 27 + NCOLS*14) ENDDO ENDDO diff --git a/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 b/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 index 83efaab8..2dd8f85f 100644 --- a/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 +++ b/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 @@ -100,6 +100,8 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) INTEGER(LONG) :: ISUBCASE_INDEX ! the index into SCNUM INTEGER(LONG) :: CID ! coordinate system CHARACTER(4*BYTE) :: CEN_WORD ! the word "CEN/" (we need to cast the length) + CHARACTER(139*BYTE) :: CLINE_BUF ! Pre-assembled CENTER line for solid stresses (matches FORMAT 1303) + CHARACTER(139*BYTE) :: GLINE_BUF ! Pre-assembled GRD line for solid stresses (matches FORMAT 1306) @@ -462,15 +464,31 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ENDIF IF (WRITE_F06) THEN + ! Pre-fill the fixed-text positions of the line buffers; variable fields (EID/GID and the + ! per-point values) are overwritten in the loop below. Layouts: + ! CLINE_BUF: FORMAT 1303 = (1X,I8,2X,'CENTER ',8X,8(1ES14.6)) + ! GLINE_BUF: FORMAT 1306 = (1X,A,10X,'GRD',I8,5X,8(1ES14.6)) with A = FILL(1:0) (empty) + CLINE_BUF = ' ' + CLINE_BUF(12:19) = 'CENTER ' + GLINE_BUF = ' ' + GLINE_BUF(12:14) = 'GRD' 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) + CALL FMT_I8_RJ ( EID_OUT_ARRAY(I,1), CLINE_BUF(2:9) ) + DO J=1,NCOLS + CALL FMT_ES14_6 ( OGEL(K,J), CLINE_BUF(28 + (J-1)*14 : 27 + J*14) ) + ENDDO + WRITE(F06,'(A)') CLINE_BUF(1 : 27 + NCOLS*14) ! 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) + CALL FMT_I8_RJ ( GID_OUT_ARRAY(I,L+1), GLINE_BUF(15:22) ) + DO J=1,NCOLS + CALL FMT_ES14_6 ( OGEL(K,J), GLINE_BUF(28 + (J-1)*14 : 27 + J*14) ) + ENDDO + WRITE(F06,'(A)') GLINE_BUF(1 : 27 + NCOLS*14) ENDDO ENDDO ENDIF diff --git a/Source/LK9/L91/WRITE_GRD_PRT_OUTPUTS.f90 b/Source/LK9/L91/WRITE_GRD_PRT_OUTPUTS.f90 index 4eb66033..282360ee 100644 --- a/Source/LK9/L91/WRITE_GRD_PRT_OUTPUTS.f90 +++ b/Source/LK9/L91/WRITE_GRD_PRT_OUTPUTS.f90 @@ -57,6 +57,7 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG CHARACTER(14*BYTE) :: MAX_ANS_CHAR(6) ! Character variable that contains the 6 grid max outputs CHARACTER(14*BYTE) :: MIN_ANS_CHAR(6) ! Character variable that contains the 6 grid min outputs CHARACTER(14*BYTE) :: TOTALS_CHAR(6) ! Character variable that contains the 6 grid tot outputs + CHARACTER(108*BYTE) :: LINE_BUF ! Pre-assembled per-grid output line (matches FORMAT 9902 layout) INTEGER(LONG), INTENT(IN) :: JVEC ! Sol'n vector num. Can be internal subcase number or eigenvector number INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out @@ -220,33 +221,31 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG ENDDO DO I=1,6 - - IF (ABS_ANS(I) == 0.0) THEN - WRITE(ABS_ANS_CHAR(I),'(A)') ' 0.0 ' + IF (ABS(ABS_ANS(I)) == ZERO) THEN + ABS_ANS_CHAR(I) = ' 0.0 ' ELSE - WRITE(ABS_ANS_CHAR(I),'(1ES14.6)') ABS_ANS(I) + CALL FMT_ES14_6 ( ABS_ANS(I), ABS_ANS_CHAR(I) ) ENDIF - - IF (MAX_ANS(I) == 0.0) THEN - WRITE(MAX_ANS_CHAR(I),'(A)') ' 0.0 ' + IF (ABS(MAX_ANS(I)) == ZERO) THEN + MAX_ANS_CHAR(I) = ' 0.0 ' ELSE - WRITE(MAX_ANS_CHAR(I),'(1ES14.6)') MAX_ANS(I) + CALL FMT_ES14_6 ( MAX_ANS(I), MAX_ANS_CHAR(I) ) ENDIF - - IF (MIN_ANS(I) == 0.0) THEN - WRITE(MIN_ANS_CHAR(I),'(A)') ' 0.0 ' + IF (ABS(MIN_ANS(I)) == ZERO) THEN + MIN_ANS_CHAR(I) = ' 0.0 ' ELSE - WRITE(MIN_ANS_CHAR(I),'(1ES14.6)') MIN_ANS(I) + CALL FMT_ES14_6 ( MIN_ANS(I), MIN_ANS_CHAR(I) ) ENDIF - ENDDO ! Write accels, displ's, applied forces or SPC forces (also calc TOTALS for forces if that is being output) ! TOTALS(J) is summation of G.P. values of applied forces, SPC forces, or MFC forces, for each of the J=1,6 components. - DO J=1,6 - TOTALS(J) = ZERO - ENDDO + TOTALS = ZERO + +! Pre-fill the fixed-whitespace positions of LINE_BUF that match FORMAT 9902 = (6X,2(1X,I8),6A). +! Variable fields (GID, COORD, 6x14-char values) are overwritten per iteration in the loop below. + LINE_BUF = ' ' LINES_WRITTEN = 0 DO I=1,NUM @@ -254,19 +253,28 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG IF ((WHAT == 'OLOAD') .OR. (WHAT == 'SPCF') .OR. (WHAT == 'MPCF')) THEN DO J=1,6 TOTALS(J) = TOTALS(J) + OGEL(I,J) - IF (TOTALS(J) == 0.0) THEN - WRITE(TOTALS_CHAR(J),'(A)') ' 0.0 ' + IF (ABS(TOTALS(J)) == ZERO) THEN + TOTALS_CHAR(J) = ' 0.0 ' ELSE - WRITE(TOTALS_CHAR(J),'(1ES14.6)') TOTALS(J) + CALL FMT_ES14_6 ( TOTALS(J), TOTALS_CHAR(J) ) ENDIF ENDDO ENDIF IF (WRITE_OGEL(I) == 'Y') THEN - CALL WRT_REAL_TO_CHAR_VAR ( OGEL, MAXREQ, MOGEL, I, OGEL_CHAR ) - - WRITE(F06,9902) GID_OUT_ARRAY(I,1),GID_OUT_ARRAY(I,2),(OGEL_CHAR(J),J=1,6) +! Assemble the per-grid output line directly into LINE_BUF, then emit with a single A-format WRITE. +! Layout (matches FORMAT 9902): 6X | 1X | I8 | 1X | I8 | 6 * A14 ==> 108 chars total. + CALL FMT_I8_RJ ( GID_OUT_ARRAY(I,1), LINE_BUF( 8:15) ) + CALL FMT_I8_RJ ( GID_OUT_ARRAY(I,2), LINE_BUF(17:24) ) + DO J=1,6 + IF (ABS(OGEL(I,J)) == ZERO) THEN + LINE_BUF(25 + (J-1)*14 : 24 + J*14) = ' 0.0 ' + ELSE + CALL FMT_ES14_6 ( OGEL(I,J), LINE_BUF(25 + (J-1)*14 : 24 + J*14) ) + ENDIF + ENDDO + WRITE(F06,'(A)') LINE_BUF IF (GID_OUT_ARRAY(I,MELGP+1) > 0) THEN DO J=1,GID_OUT_ARRAY(I,MELGP+1) diff --git a/Source/LK9/L91/WRT_REAL_TO_CHAR_VAR.f90 b/Source/LK9/L91/WRT_REAL_TO_CHAR_VAR.f90 index fc8cc4b8..6a3be827 100644 --- a/Source/LK9/L91/WRT_REAL_TO_CHAR_VAR.f90 +++ b/Source/LK9/L91/WRT_REAL_TO_CHAR_VAR.f90 @@ -49,14 +49,14 @@ SUBROUTINE WRT_REAL_TO_CHAR_VAR ( REAL_VAR, NROWS, NCOLS, ROW_NUM, CHAR_VAR ) REAL(DOUBLE) , INTENT(IN) :: REAL_VAR(NROWS,NCOLS)! ! ********************************************************************************************************************************** - DO J=1,NCOLS - CHAR_VAR(J)(1:) = ' ' - ENDDO +! FMT_ES14_6 produces the same 14-char output as Fortran's 1ES14.6 edit descriptor but avoids the +! per-value internal WRITE overhead. Exact zeros are then overwritten with this routine's historical +! ' 0.0 ' substitution so the F06 output stays bit-identical. DO J=1,NCOLS IF (ABS(REAL_VAR(ROW_NUM,J)) == ZERO) THEN - WRITE(CHAR_VAR(J),'(A)') ' 0.0 ' + CHAR_VAR(J) = ' 0.0 ' ELSE - WRITE(CHAR_VAR(J),'(1ES14.6)') REAL_VAR(ROW_NUM,J) + CALL FMT_ES14_6 ( REAL_VAR(ROW_NUM,J), CHAR_VAR(J) ) ENDIF ENDDO @@ -65,4 +65,3 @@ SUBROUTINE WRT_REAL_TO_CHAR_VAR ( REAL_VAR, NROWS, NCOLS, ROW_NUM, CHAR_VAR ) ! ********************************************************************************************************************************** END SUBROUTINE WRT_REAL_TO_CHAR_VAR - diff --git a/Source/LK9/L92/OFP1.f90 b/Source/LK9/L92/OFP1.f90 index 2f3b8f2f..bf0dcea3 100644 --- a/Source/LK9/L92/OFP1.f90 +++ b/Source/LK9/L92/OFP1.f90 @@ -92,16 +92,10 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N ! ********************************************************************************************************************************** - DO I=1,MAXREQ - DO J=1,MOGEL - OGEL(I,J) = ZERO - ENDDO - ENDDO + OGEL = ZERO ! Initialize WRITE_OGEL - DO I=1,NGRID - WRITE_OGEL(I) = 'Y' - ENDDO + WRITE_OGEL(1:NGRID) = 'Y' ! --------------------------------------------------------------------------------------------------------------------------------- ! Process acceleration output requests for CB sol. diff --git a/Source/LK9/L92/OFP2.f90 b/Source/LK9/L92/OFP2.f90 index 55e57bf2..ab6c918c 100644 --- a/Source/LK9/L92/OFP2.f90 +++ b/Source/LK9/L92/OFP2.f90 @@ -127,16 +127,10 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** - DO I=1,MAXREQ - DO J=1,MOGEL - OGEL(I,J) = ZERO - ENDDO - ENDDO + OGEL = ZERO ! Initialize WRITE_OGEL - DO I=1,NGRID - WRITE_OGEL(I) = 'Y' - ENDDO + WRITE_OGEL(1:NGRID) = 'Y' ! --------------------------------------------------------------------------------------------------------------------------------- ! Process SPC force requests diff --git a/Source/LK9/L92/OFP3.f90 b/Source/LK9/L92/OFP3.f90 index fc6f34c8..c2d4834e 100644 --- a/Source/LK9/L92/OFP3.f90 +++ b/Source/LK9/L92/OFP3.f90 @@ -56,11 +56,7 @@ SUBROUTINE OFP3 ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! ********************************************************************************************************************************** ! Initialize - DO I=1,MAXREQ - DO J=1,MOGEL - OGEL(I,J) = ZERO - ENDDO - ENDDO + OGEL = ZERO DO I=1,MERROR IERROR(I) = 0 diff --git a/Source/LK9/L92/OFP3_ELFE_1D.f90 b/Source/LK9/L92/OFP3_ELFE_1D.f90 index a25346e8..bed546df 100644 --- a/Source/LK9/L92/OFP3_ELFE_1D.f90 +++ b/Source/LK9/L92/OFP3_ELFE_1D.f90 @@ -142,11 +142,7 @@ SUBROUTINE OFP3_ELFE_1D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ENDDO ENDDO - DO I=1,MAXREQ - DO J=1,MOGEL - OGEL(I,J) = ZERO - ENDDO - ENDDO + OGEL = ZERO !xx IROW_MAT = 0 !xx IROW_TXT = 0 diff --git a/Source/LK9/L92/OFP3_ELFE_2D.f90 b/Source/LK9/L92/OFP3_ELFE_2D.f90 index 2e004b13..204c24bd 100644 --- a/Source/LK9/L92/OFP3_ELFE_2D.f90 +++ b/Source/LK9/L92/OFP3_ELFE_2D.f90 @@ -169,11 +169,7 @@ SUBROUTINE OFP3_ELFE_2D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) !xx ENDIF !xx ENDDO - DO I=1,MAXREQ - DO J=1,MOGEL - OGEL(I,J) = ZERO - ENDDO - ENDDO + OGEL = ZERO !xx IROW_MAT = 0 !xx IROW_TXT = 0 diff --git a/Source/LK9/L92/OFP3_STRE_NO_PCOMP.f90 b/Source/LK9/L92/OFP3_STRE_NO_PCOMP.f90 index 179645c5..d2297a5e 100644 --- a/Source/LK9/L92/OFP3_STRE_NO_PCOMP.f90 +++ b/Source/LK9/L92/OFP3_STRE_NO_PCOMP.f90 @@ -148,11 +148,7 @@ SUBROUTINE OFP3_STRE_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ENDDO ENDDO - DO I=1,MAXREQ - DO J=1,MOGEL - OGEL(I,J) = ZERO - ENDDO - ENDDO + OGEL = ZERO ! 101 FORMAT("*DEBUG: ",A,"; ELEMENT_TYPE_INT=",I8,"; TABLE_NAME=",A) !xx IROW_MAT = 0 diff --git a/Source/LK9/L92/OFP3_STRE_PCOMP.f90 b/Source/LK9/L92/OFP3_STRE_PCOMP.f90 index 9d26b661..c1110b09 100644 --- a/Source/LK9/L92/OFP3_STRE_PCOMP.f90 +++ b/Source/LK9/L92/OFP3_STRE_PCOMP.f90 @@ -120,11 +120,7 @@ SUBROUTINE OFP3_STRE_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ENDDO ENDDO - DO I=1,MAXREQ - DO J=1,MOGEL - OGEL(I,J) = ZERO - ENDDO - ENDDO + OGEL = ZERO !xx IROW_MAT = 0 !xx IROW_TXT = 0 diff --git a/Source/LK9/L92/OFP3_STRN_NO_PCOMP.f90 b/Source/LK9/L92/OFP3_STRN_NO_PCOMP.f90 index b2844eea..9fff1d08 100644 --- a/Source/LK9/L92/OFP3_STRN_NO_PCOMP.f90 +++ b/Source/LK9/L92/OFP3_STRN_NO_PCOMP.f90 @@ -151,11 +151,7 @@ SUBROUTINE OFP3_STRN_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ENDIF ENDDO - DO I=1,MAXREQ - DO J=1,MOGEL - OGEL(I,J) = ZERO - ENDDO - ENDDO + OGEL = ZERO !xx IROW_MAT = 0 !xx IROW_TXT = 0 diff --git a/Source/LK9/L92/OFP3_STRN_PCOMP.f90 b/Source/LK9/L92/OFP3_STRN_PCOMP.f90 index 0cedacab..24f0df34 100644 --- a/Source/LK9/L92/OFP3_STRN_PCOMP.f90 +++ b/Source/LK9/L92/OFP3_STRN_PCOMP.f90 @@ -120,11 +120,7 @@ SUBROUTINE OFP3_STRN_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ENDDO ENDDO - DO I=1,MAXREQ - DO J=1,MOGEL - OGEL(I,J) = ZERO - ENDDO - ENDDO + OGEL = ZERO !xx IROW_MAT = 0 !xx IROW_TXT = 0 diff --git a/Source/USE_IFs/FMT_ES14_6_USE_IFs.f90 b/Source/USE_IFs/FMT_ES14_6_USE_IFs.f90 new file mode 100644 index 00000000..27f136e9 --- /dev/null +++ b/Source/USE_IFs/FMT_ES14_6_USE_IFs.f90 @@ -0,0 +1,32 @@ +! ################################################################################################################################## +! Begin MIT license text. +! _______________________________________________________________________________________________________ + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and +! associated documentation files (the "Software"), to deal in the Software without restriction, including +! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! _______________________________________________________________________________________________________ + +! End MIT license text. + + MODULE FMT_ES14_6_USE_IFs + +! USE Interface statements for all subroutines called by SUBROUTINE FMT_ES14_6 +! No subrs CALL'd by SUBROUTINE FMT_ES14_6 + + END MODULE FMT_ES14_6_USE_IFs diff --git a/Source/USE_IFs/FMT_I8_RJ_USE_IFs.f90 b/Source/USE_IFs/FMT_I8_RJ_USE_IFs.f90 new file mode 100644 index 00000000..f71d6b74 --- /dev/null +++ b/Source/USE_IFs/FMT_I8_RJ_USE_IFs.f90 @@ -0,0 +1,32 @@ +! ################################################################################################################################## +! Begin MIT license text. +! _______________________________________________________________________________________________________ + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and +! associated documentation files (the "Software"), to deal in the Software without restriction, including +! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! _______________________________________________________________________________________________________ + +! End MIT license text. + + MODULE FMT_I8_RJ_USE_IFs + +! USE Interface statements for all subroutines called by SUBROUTINE FMT_I8_RJ +! No subrs CALL'd by SUBROUTINE FMT_I8_RJ + + END MODULE FMT_I8_RJ_USE_IFs diff --git a/Source/USE_IFs/WRITE_ELEM_STRAINS_USE_IFs.f90 b/Source/USE_IFs/WRITE_ELEM_STRAINS_USE_IFs.f90 index b7aa4f88..85e5bdf9 100644 --- a/Source/USE_IFs/WRITE_ELEM_STRAINS_USE_IFs.f90 +++ b/Source/USE_IFs/WRITE_ELEM_STRAINS_USE_IFs.f90 @@ -32,5 +32,7 @@ MODULE WRITE_ELEM_STRAINS_USE_IFs USE GET_GRID_AND_COMP_Interface USE GET_MAX_MIN_ABS_STR_Interface USE OUTA_HERE_Interface + USE FMT_ES14_6_Interface + USE FMT_I8_RJ_Interface END MODULE WRITE_ELEM_STRAINS_USE_IFs diff --git a/Source/USE_IFs/WRITE_ELEM_STRESSES_USE_IFs.f90 b/Source/USE_IFs/WRITE_ELEM_STRESSES_USE_IFs.f90 index 8cd81820..8a5bda7a 100644 --- a/Source/USE_IFs/WRITE_ELEM_STRESSES_USE_IFs.f90 +++ b/Source/USE_IFs/WRITE_ELEM_STRESSES_USE_IFs.f90 @@ -34,5 +34,7 @@ MODULE WRITE_ELEM_STRESSES_USE_IFs USE GET_MAX_MIN_ABS_STR_Interface USE WRITE_ROD_Interface USE OUTA_HERE_Interface + USE FMT_ES14_6_Interface + USE FMT_I8_RJ_Interface END MODULE WRITE_ELEM_STRESSES_USE_IFs diff --git a/Source/USE_IFs/WRITE_GRD_PRT_OUTPUTS_USE_IFs.f90 b/Source/USE_IFs/WRITE_GRD_PRT_OUTPUTS_USE_IFs.f90 index 62e4a9ea..dd688ae6 100644 --- a/Source/USE_IFs/WRITE_GRD_PRT_OUTPUTS_USE_IFs.f90 +++ b/Source/USE_IFs/WRITE_GRD_PRT_OUTPUTS_USE_IFs.f90 @@ -31,5 +31,7 @@ MODULE WRITE_GRD_PRT_OUTPUTS_USE_IFs USE OUTA_HERE_Interface USE GET_GRID_AND_COMP_Interface USE WRT_REAL_TO_CHAR_VAR_Interface + USE FMT_ES14_6_Interface + USE FMT_I8_RJ_Interface END MODULE WRITE_GRD_PRT_OUTPUTS_USE_IFs diff --git a/Source/USE_IFs/WRT_REAL_TO_CHAR_VAR_USE_IFs.f90 b/Source/USE_IFs/WRT_REAL_TO_CHAR_VAR_USE_IFs.f90 index fff620c8..edca2687 100644 --- a/Source/USE_IFs/WRT_REAL_TO_CHAR_VAR_USE_IFs.f90 +++ b/Source/USE_IFs/WRT_REAL_TO_CHAR_VAR_USE_IFs.f90 @@ -26,6 +26,7 @@ MODULE WRT_REAL_TO_CHAR_VAR_USE_IFs ! USE Interface statements for all subroutines called by SUBROUTINE WRT_REAL_TO_CHAR_VAR -! No subrs CALL'd by SUBROUTINE WRT_REAL_TO_CHAR_VAR + + USE FMT_ES14_6_Interface END MODULE WRT_REAL_TO_CHAR_VAR_USE_IFs diff --git a/Source/UTIL/FMT_ES14_6.f90 b/Source/UTIL/FMT_ES14_6.f90 new file mode 100644 index 00000000..15dfab81 --- /dev/null +++ b/Source/UTIL/FMT_ES14_6.f90 @@ -0,0 +1,134 @@ +! ################################################################################################################################## +! Begin MIT license text. +! _______________________________________________________________________________________________________ + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and +! associated documentation files (the "Software"), to deal in the Software without restriction, including +! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! _______________________________________________________________________________________________________ + +! End MIT license text. + + SUBROUTINE FMT_ES14_6 ( V, OUT ) + +! Hand-rolled formatter that produces the same 14-character output as Fortran's 1ES14.6 edit descriptor, +! but bypasses the (relatively expensive) internal WRITE machinery. Used in the LK9 output pipeline to +! accelerate writing of the F06 file. Exact zeros are emitted as ' 0.000000E+00' to match Fortran's +! native 1ES14.6 output byte-for-byte. (Callers that prefer the WRT_REAL_TO_CHAR_VAR style ' 0.0 ' +! substitution must perform that replacement themselves.) +! +! Layout of OUT (positions 1..14): +! 1 : leading space +! 2 : sign ('-' or ' ') +! 3 : single mantissa digit +! 4 : '.' +! 5-10 : 6 fractional digits +! 11 : 'E' +! 12 : exponent sign ('+' or '-') +! 13-14 : 2-digit exponent +! +! Assumes |decimal exponent| < 100. Values exceeding that range are rare in FEA stress/strain output; +! if encountered the routine falls back to a Fortran internal WRITE so the field is still well formed. + + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE + USE CONSTANTS_1, ONLY : ZERO + + USE FMT_ES14_6_USE_IFs + + IMPLICIT NONE + + REAL(DOUBLE), INTENT(IN) :: V ! Real value to format + CHARACTER(14*BYTE), INTENT(OUT) :: OUT ! 14-char formatted result + + REAL(DOUBLE) :: AV, M + INTEGER(LONG) :: E10, IM, K + INTEGER(LONG) :: DIG(0:6) + CHARACTER(1*BYTE) :: ESIGN + LOGICAL :: NEG + + INTEGER(LONG), PARAMETER :: ZERO_CHAR = IACHAR('0') + +! ********************************************************************************************************************************** + IF (V == ZERO) THEN + OUT = ' 0.000000E+00' + RETURN + ENDIF + + NEG = V < ZERO + AV = ABS(V) + + E10 = FLOOR(LOG10(AV)) + M = AV * (10.0D0 ** (-E10)) + + ! Guard against floating-point rounding in LOG10/FLOOR that could put M outside [1,10). + IF (M < 1.0D0) THEN + M = M * 10.0D0 + E10 = E10 - 1 + ELSE IF (M >= 10.0D0) THEN + M = M * 0.1D0 + E10 = E10 + 1 + ENDIF + + IM = NINT(M * 1.0D6, KIND=LONG) + IF (IM >= 10000000) THEN ! carry from rounding 9.9999995 -> 10.000000 + IM = IM / 10 + E10 = E10 + 1 + ENDIF + + ! Fall back to Fortran formatting for the rare |E10| >= 100 case so the field still has 14 chars. + IF ((E10 >= 100) .OR. (E10 <= -100)) THEN + WRITE(OUT,'(1ES14.6)') V + RETURN + ENDIF + + DO K = 6, 0, -1 + DIG(K) = MOD(IM, 10_LONG) + IM = IM / 10 + ENDDO + + IF (E10 < 0) THEN + ESIGN = '-' + E10 = -E10 + ELSE + ESIGN = '+' + ENDIF + + OUT(1:1) = ' ' + IF (NEG) THEN + OUT(2:2) = '-' + ELSE + OUT(2:2) = ' ' + ENDIF + OUT(3:3) = ACHAR(ZERO_CHAR + DIG(0)) + OUT(4:4) = '.' + OUT(5:5) = ACHAR(ZERO_CHAR + DIG(1)) + OUT(6:6) = ACHAR(ZERO_CHAR + DIG(2)) + OUT(7:7) = ACHAR(ZERO_CHAR + DIG(3)) + OUT(8:8) = ACHAR(ZERO_CHAR + DIG(4)) + OUT(9:9) = ACHAR(ZERO_CHAR + DIG(5)) + OUT(10:10) = ACHAR(ZERO_CHAR + DIG(6)) + OUT(11:11) = 'E' + OUT(12:12) = ESIGN + OUT(13:13) = ACHAR(ZERO_CHAR + E10 / 10) + OUT(14:14) = ACHAR(ZERO_CHAR + MOD(E10, 10_LONG)) + + RETURN + +! ********************************************************************************************************************************** + + END SUBROUTINE FMT_ES14_6 diff --git a/Source/UTIL/FMT_I8_RJ.f90 b/Source/UTIL/FMT_I8_RJ.f90 new file mode 100644 index 00000000..37f25eca --- /dev/null +++ b/Source/UTIL/FMT_I8_RJ.f90 @@ -0,0 +1,73 @@ +! ################################################################################################################################## +! Begin MIT license text. +! _______________________________________________________________________________________________________ + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and +! associated documentation files (the "Software"), to deal in the Software without restriction, including +! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! _______________________________________________________________________________________________________ + +! End MIT license text. + + SUBROUTINE FMT_I8_RJ ( V, OUT ) + +! Right-justify a signed integer into an 8-character field, padded with spaces. Produces the same output +! as Fortran's I8 edit descriptor but avoids the internal WRITE machinery. Used in the LK9 output +! pipeline alongside FMT_ES14_6 to accelerate F06 line assembly. Values with more than 8 significant +! digits (counting the sign) fall back to a Fortran internal WRITE so the field stays well formed. + + USE PENTIUM_II_KIND, ONLY : BYTE, LONG + + USE FMT_I8_RJ_USE_IFs + + IMPLICIT NONE + + INTEGER(LONG), INTENT(IN) :: V ! Integer value to format + CHARACTER(8*BYTE), INTENT(OUT) :: OUT ! 8-char right-justified result + + INTEGER(LONG) :: X, K + INTEGER(LONG), PARAMETER :: ZERO_CHAR = IACHAR('0') + +! ********************************************************************************************************************************** + OUT = ' ' + + IF (V == 0) THEN + OUT(8:8) = '0' + RETURN + ENDIF + + ! Overflow guard: an I8 field holds at most 8 chars (sign + 7 digits for negatives, 8 digits for non-negatives). + IF ((V > 99999999_LONG) .OR. (V < -9999999_LONG)) THEN + WRITE(OUT,'(I8)') V + RETURN + ENDIF + + X = ABS(V) + K = 8 + DO WHILE ((X > 0) .AND. (K >= 1)) + OUT(K:K) = ACHAR(ZERO_CHAR + MOD(X, 10_LONG)) + X = X / 10 + K = K - 1 + ENDDO + IF ((V < 0) .AND. (K >= 1)) OUT(K:K) = '-' + + RETURN + +! ********************************************************************************************************************************** + + END SUBROUTINE FMT_I8_RJ