diff --git a/CMakeLists.txt b/CMakeLists.txt index 91b3c365..5ad10e65 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -29,16 +29,6 @@ include_directories("${CMAKE_SOURCE_DIR}/INCLUDE") # uncomment this to debug # set(CMAKE_VERBOSE_MAKEFILE true) -# a new build type for profiling -set(CMAKE_PROFILING_FLAGS "-O2 -g -fno-omit-frame-pointer -fno-inline-functions") - -set(CMAKE_C_FLAGS_PROFILING "${CMAKE_PROFILING_FLAGS}") -set(CMAKE_CXX_FLAGS_PROFILING "${CMAKE_PROFILING_FLAGS}") -set(CMAKE_Fortran_FLAGS_PROFILING "${CMAKE_PROFILING_FLAGS}") - -set(CMAKE_EXE_LINKER_FLAGS_PROFILING "") -set(CMAKE_SHARED_LINKER_FLAGS_PROFILING "") - # register the Profile build type, just in case set(CMAKE_CONFIGURATION_TYPES Debug @@ -46,6 +36,7 @@ set(CMAKE_CONFIGURATION_TYPES RelWithDebInfo MinSizeRel Profiling + Deterministic CACHE STRING "" FORCE ) @@ -346,6 +337,30 @@ if(CMAKE_COMPILER_IS_GNUCC) set(CMAKE_Fortran_FLAGS_DEBUG "-g -O0 -fcheck=all -fbacktrace -fbounds-check \ -fno-inline -fno-ipa-sra -fno-ipa-cp -fno-optimize-sibling-calls") + set(CMAKE_Fortran_FLAGS_DETERMINISTIC + "-O0 -g \ + -fno-fast-math \ + -ffp-contract=off \ + -fno-unsafe-math-optimizations \ + -fno-associative-math \ + -fno-reciprocal-math \ + -frounding-math" + ) + set(CMAKE_C_FLAGS_DETERMINISTIC + "-O0 -g \ + -fno-fast-math \ + -ffp-contract=off \ + -frounding-math" + ) + set(CMAKE_CXX_FLAGS_DETERMINISTIC + "${CMAKE_C_FLAGS_DETERMINISTIC}" + ) + set(CMAKE_PROFILING_FLAGS "-O2 -g -fno-omit-frame-pointer -fno-inline-functions") + set(CMAKE_C_FLAGS_PROFILING "${CMAKE_PROFILING_FLAGS}") + set(CMAKE_CXX_FLAGS_PROFILING "${CMAKE_PROFILING_FLAGS}") + set(CMAKE_Fortran_FLAGS_PROFILING "${CMAKE_PROFILING_FLAGS}") + set(CMAKE_EXE_LINKER_FLAGS_PROFILING "") + set(CMAKE_SHARED_LINKER_FLAGS_PROFILING "") endif() # issue a couple messages about compilation diff --git a/Source/Interfaces/MPC_PROC_Interface.f90 b/Source/Interfaces/MPC_PROC_Interface.f90 index a5b4e602..6a7730a8 100644 --- a/Source/Interfaces/MPC_PROC_Interface.f90 +++ b/Source/Interfaces/MPC_PROC_Interface.f90 @@ -1,28 +1,28 @@ ! ############################################################################################################################### -! Begin MIT license text. +! 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 + +! 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. +! 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. + +! End MIT license text. MODULE MPC_PROC_Interface @@ -30,24 +30,24 @@ MODULE MPC_PROC_Interface SUBROUTINE MPC_PROC - + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1J, L1S, LINK1S, L1S_MSG - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LMPCADDC, NGRID, NMPC, NMPCADD, NUM_MPCSIDS + USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LMPCADDC, NGRID, NMPC, NMPCADD, NUM_MPCSIDS, SOL_NAME USE TIMDAT, ONLY : TSEC USE SUBR_BEGEND_LEVELS, ONLY : MPC_PROC_BEGEND USE MODEL_STUF, ONLY : GRID_ID, MPCSET, MPCSIDS USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START + USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP IMPLICIT NONE - + CHARACTER( 1*BYTE) :: MPC_SET_USED ! 'Y'/'N' indicator if an MPC set in B.D. is used INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MPC_PROC_BEGEND - + END SUBROUTINE MPC_PROC END INTERFACE END MODULE MPC_PROC_Interface - diff --git a/Source/Interfaces/REDUCE_KGGD_TO_KNND_Interface.f90 b/Source/Interfaces/REDUCE_KGGD_TO_KNND_Interface.f90 index 8737b9f5..3f7f4e34 100644 --- a/Source/Interfaces/REDUCE_KGGD_TO_KNND_Interface.f90 +++ b/Source/Interfaces/REDUCE_KGGD_TO_KNND_Interface.f90 @@ -1,28 +1,28 @@ ! ############################################################################################################################### -! Begin MIT license text. +! 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 + +! 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. +! 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. + +! End MIT license text. MODULE REDUCE_KGGD_TO_KNND_Interface @@ -30,15 +30,15 @@ MODULE REDUCE_KGGD_TO_KNND_Interface SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) - + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F04, F06, LINK2A, L2A, L2ASTAT, L2A_MSG, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFN, NDOFM, NTERM_HMN, NTERM_KGGD, NTERM_KNND, & NTERM_KNMD, NTERM_KMMD, NTERM_GMN USE PARAMS, ONLY : EPSIL, SPARSTOR USE TIMDAT, ONLY : TSEC USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KGGD_TO_KNND_BEGEND - USE CONSTANTS_1, ONLY : ONE + USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_HMN, J_HMN, HMN, I_KGGD, J_KGGD, KGGD, I_KNND, J_KNND, KNND, I_KNMD, J_KNMD, KNMD, & I_KMMD, J_KMMD, KMMD, I_KMND, J_KMND, KMND, I_GMN, J_GMN, GMN, I_GMNt, J_GMNt, GMNt USE SPARSE_MATRICES, ONLY : SYM_GMN, SYM_HMN, SYM_KGGD, SYM_KNND, SYM_KNMD, SYM_KMMD, SYM_KMND @@ -47,7 +47,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), INTENT(IN) :: PART_VEC_G_NM(NDOFG)! Partitioning vector (G set into N and M sets) + INTEGER(LONG), INTENT(IN) :: PART_VEC_G_NM(NDOFG)! Partitioning vector (G set into N and M sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KGGD_TO_KNND_BEGEND @@ -57,4 +57,3 @@ END SUBROUTINE REDUCE_KGGD_TO_KNND END INTERFACE END MODULE REDUCE_KGGD_TO_KNND_Interface - diff --git a/Source/LK1/L1D/MPC_PROC.f90 b/Source/LK1/L1D/MPC_PROC.f90 index c15e6e2d..8ef2bd75 100644 --- a/Source/LK1/L1D/MPC_PROC.f90 +++ b/Source/LK1/L1D/MPC_PROC.f90 @@ -1,45 +1,46 @@ ! ################################################################################################################################## -! Begin MIT license text. +! 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 + +! 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. +! 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. - + +! End MIT license text. + SUBROUTINE MPC_PROC - + ! Processes MPC equations to get terms for the RMG constraint matrix - + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1J, L1S, LINK1S, L1S_MSG - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LMPCADDC, NGRID, NMPC, NMPCADD, NUM_MPCSIDS + USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LMPCADDC, NGRID, NMPC, NMPCADD, NUM_MPCSIDS, SOL_NAME USE TIMDAT, ONLY : TSEC USE SUBR_BEGEND_LEVELS, ONLY : MPC_PROC_BEGEND USE MODEL_STUF, ONLY : GRID_ID, MPCSET, MPCSIDS USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START + USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MPC_PROC_USE_IFs IMPLICIT NONE - + CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'MPC_PROC' CHARACTER( 1*BYTE) :: MPC_SET_USED ! 'Y'/'N' indicator if an MPC set in B.D. is used @@ -55,7 +56,7 @@ SUBROUTINE MPC_PROC INTEGER(LONG) :: M_SET_COL_NUM ! Col no., in TDOF array, of the M-set DOF list INTEGER(LONG) :: NUM_TRIPLES ! Counter on number of pairs of grid/comp/coeff triplets on an MPC ! logical card. Must be <= MMPC which was counted in subr BD_MPC0 - INTEGER(LONG) :: OUNT(2) ! File units to write messages to. + INTEGER(LONG) :: OUNT(2) ! File units to write messages to. INTEGER(LONG) :: REC_NO ! Record number when reading a file INTEGER(LONG) :: RMG_COL_NUM ! Col no. of a term in array RMG INTEGER(LONG) :: RMG_ROW_NUM ! Row no. of a term in array RMG @@ -63,7 +64,7 @@ SUBROUTINE MPC_PROC INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: SETID ! An SPC set ID read from file LINK1O INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MPC_PROC_BEGEND - + REAL(DOUBLE) :: COEFF ! An MPC coeff value read from file LINK1S that we do not need REAL(DOUBLE) :: COEFF_JUNK ! An MPC coeff value read from file LINK1S that we do not need @@ -76,13 +77,13 @@ SUBROUTINE MPC_PROC ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file - + OUNT(1) = ERR OUNT(2) = F06 - + ! ********************************************************************************************************************************** ! Process MPC data from file L1S (data written when MPC Bulk Data cards were read) - + ! File LINK1S contains data from the NMPC number of logical MPC cards in the input B.D. deck. For each logical MPC card, LINK1S has: ! 1st record for 1st MPC: the MPC set ID ! 2nd record for 1st MPC: the num of triplets of grid/comp/coeff (incl ones for the dependent DOF) on this logical MPC @@ -90,7 +91,7 @@ SUBROUTINE MPC_PROC ! 4th record for 1st MPC: grid/comp/coeff for the 1st independent DOF on the this MPC logical card ! 5th record, and on, for 1st MPC: grid/comp/coeff for the 2nd, and on, independent DOF's (if any) on the this MPC logical card -! The above record structure is repeated for each MPC logical card in the data deck (in the order in which they were read from the +! The above record structure is repeated for each MPC logical card in the data deck (in the order in which they were read from the ! B.D. deck). All logical MPC cards are included, not only the ones that may be used in a particular execution of MYSTRAN CALL TDOF_COL_NUM ( 'G ', G_SET_COL_NUM ) @@ -98,8 +99,8 @@ SUBROUTINE MPC_PROC REC_NO = 0 i_do3:DO I=1,NMPC ! Process data from file LINK1S (contains all info from the NMPC MPC's) - - READ(L1S,IOSTAT=IOCHK) SETID ! Read the SETID for the i-th logical MPC + + READ(L1S,IOSTAT=IOCHK) SETID ! Read the SETID for the i-th logical MPC REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) @@ -191,10 +192,10 @@ SUBROUTINE MPC_PROC MPC_SET_USED = 'N' CYCLE j_do3 - ENDIF + ENDIF + + ENDDO j_do3 - ENDDO j_do3 - IF (MPC_SET_USED == 'N') THEN ! This MPC set is not to be used, so skip all grid/comp/coeff records DO K=1,NUM_TRIPLES READ(L1S,IOSTAT=IOCHK) GID_JUNK,COMP_JUNK,COEFF_JUNK @@ -203,12 +204,15 @@ SUBROUTINE MPC_PROC CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) CALL OUTA_HERE ( 'Y' ) ENDIF - ENDDO + ENDDO ENDIF - ENDDO i_do3 - - CALL DEALLOCATE_MODEL_STUF ( 'MPCSIDS' ) + ENDDO i_do3 + + ! do not deallocate if we're on the first step of a buckling sol + IF ((SOL_NAME(1:8) /= 'BUCKLING') .OR. (LOAD_ISTEP /= 1)) THEN + CALL DEALLOCATE_MODEL_STUF ( 'MPCSIDS' ) + END IF ! ********************************************************************************************************************************** IF (WRT_LOG >= SUBR_BEGEND) THEN @@ -235,4 +239,3 @@ SUBROUTINE MPC_PROC ! ********************************************************************************************************************************** END SUBROUTINE MPC_PROC - diff --git a/Source/LK2/REDUCE_G_NM.f90 b/Source/LK2/REDUCE_G_NM.f90 index 8dbf0ae0..8bfc8f25 100644 --- a/Source/LK2/REDUCE_G_NM.f90 +++ b/Source/LK2/REDUCE_G_NM.f90 @@ -1,33 +1,33 @@ ! ################################################################################################################################## -! Begin MIT license text. +! 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 + +! 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. +! 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. + +! End MIT license text. SUBROUTINE REDUCE_G_NM - + ! Call routines to reduce stiffness, mass, loads and constraint matrices from G-set to N, M-sets - + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : ERR, F04, F06, L1C, LINK1C, L1C_MSG, SC1, WRT_ERR, WRT_LOG @@ -51,15 +51,15 @@ SUBROUTINE REDUCE_G_NM I_MGG , J_MGG , MGG , I_MNN , J_MNN , MNN , I_MNM , J_MNM , MNM , I_MMM , J_MMM , MMM , & I_PG , J_PG , PG , I_PN , J_PN , PN , I_PM , J_PM , PM , & I_RMG , J_RMG , RMG - + USE SPARSE_MATRICES, ONLY : SYM_KNN USE OUTPUT4_MATRICES, ONLY : ACT_OU4_MYSTRAN_NAMES, NUM_OU4_REQUESTS USE SCRATCH_MATRICES - + USE REDUCE_G_NM_USE_IFs IMPLICIT NONE - + CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'REDUCE_G_NM' CHARACTER( 8*BYTE) :: ASPC_SUM_MSG1 ! Message to be printed out in the AUTOSPC summary table @@ -69,18 +69,18 @@ SUBROUTINE REDUCE_G_NM CHARACTER( 1*BYTE) :: DEALLOCATE_KGGD= 'Y'! Indicator of whether we need to keep KGGD allocated for OU4 output CHARACTER( 1*BYTE) :: DEALLOCATE_MGG = 'Y'! Indicator of whether we need to keep MGG allocated for OU4 output CHARACTER( 1*BYTE) :: DEALLOCATE_PG = 'Y'! Indicator of whether we need to keep PG allocated for OU4 output - CHARACTER(132*BYTE) :: MATRIX_NAME ! Name of matrix for printout + CHARACTER(132*BYTE) :: MATRIX_NAME ! Name of matrix for printout CHARACTER(44*BYTE) :: MODNAM ! Name to write to screen to describe module being run - + INTEGER(LONG) :: DO_WHICH_CODE_FRAG ! 1 or 2 depending on which seg of code to run (depends on BUCKLING) INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: N_SET_COL ! Col no. in array TDOFI where the N-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: N_SET_DOF ! N-set DOF number INTEGER(LONG) :: NUM_ASPC_BY_COMP(6) ! Number of AUTOSPC's by component number INTEGER(LONG) :: NUM_COMPS ! 6 if GRID_NUM is an physical grid, 1 if an SPOINT - INTEGER(LONG) :: PART_VEC_G_NM(NDOFG)! Partitioning vector (G set into N and M sets) - INTEGER(LONG) :: PART_VEC_M(NDOFM) ! Partitioning vector (1's for all M set DOF's) - INTEGER(LONG) :: PART_VEC_SUB(NSUB) ! Partitioning vector (1's for all subcases) + INTEGER(LONG) :: PART_VEC_G_NM(NDOFG)! Partitioning vector (G set into N and M sets) + INTEGER(LONG) :: PART_VEC_M(NDOFM) ! Partitioning vector (1's for all M set DOF's) + INTEGER(LONG) :: PART_VEC_SUB(NSUB) ! Partitioning vector (1's for all subcases) INTEGER(LONG) :: SA_SET_COL ! Col no. in array TDOF where the SA-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: TOT_NUM_ASPC ! Sum of NUM_ASPC_BY_COMP(6) INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_G_NM_BEGEND @@ -142,7 +142,7 @@ SUBROUTINE REDUCE_G_NM DO I=1,NDOFM PART_VEC_M(I) = 1 ENDDO - + DO I=1,NSUB PART_VEC_SUB = 1 ENDDO @@ -153,9 +153,9 @@ SUBROUTINE REDUCE_G_NM CALL SOLVE_GMN ( PART_VEC_G_NM, PART_VEC_M ) ! First, solve for GMN !xx WRITE(SC1, * ) ! Advance 1 line for screen messages - WRITE(SC1,12345,ADVANCE='NO') ' Deallocate RMG', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'RMG' ) + WRITE(SC1,12345,ADVANCE='NO') ' Deallocate RMG', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'RMG' ) - IF (NTERM_KGG > 0) THEN ! Reduce KGG to KNN + IF (NTERM_KGG > 0) THEN ! Reduce KGG to KNN CALL OURTIM IF (MATSPARS == 'Y') THEN @@ -285,7 +285,7 @@ SUBROUTINE REDUCE_G_NM MODNAM = ' DEALLOCATE G-SET ARRAYS' WRITE(SC1,2092) MODNAM,HOUR,MINUTE,SEC,SFRAC - !xx WRITE(SC1, * ) ! Advance 1 line for screen messages + !xx WRITE(SC1, * ) ! Advance 1 line for screen messages IF (DEALLOCATE_KGG == 'Y') THEN WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KGG', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'KGG' ) @@ -424,7 +424,7 @@ SUBROUTINE REDUCE_G_NM ! Now print final AUTOSPC summary table. Need to calc NUM_ASPC_BY_COMP from TDOF table CALL TDOF_COL_NUM ( 'SA', SA_SET_COL ) - + DO J=1,6 NUM_ASPC_BY_COMP(J) = 0 ENDDO @@ -463,14 +463,14 @@ SUBROUTINE REDUCE_G_NM DO I=1,NDOFM PART_VEC_M(I) = 1 ENDDO - + DO I=1,NSUB PART_VEC_SUB = 1 ENDDO ! Reduce KGG to KNN - IF (NTERM_KGGD > 0) THEN ! Reduce KGGD to KNND + IF (NTERM_KGGD > 0) THEN ! Reduce KGGD to KNND CALL OURTIM MODNAM = ' REDUCE KGGD TO KNND (SPARSE MATRIX ROUTINES)' @@ -487,7 +487,7 @@ SUBROUTINE REDUCE_G_NM ENDIF - CALL DEALLOCATE_SPARSE_MAT ( 'RMG' ) + CALL DEALLOCATE_SPARSE_MAT ( 'RMG' ) ! There is no M-set, so equate N and G sets @@ -510,7 +510,7 @@ SUBROUTINE REDUCE_G_NM MODNAM = ' DEALLOCATE G-SET ARRAYS' WRITE(SC1,2092) MODNAM,HOUR,MINUTE,SEC,SFRAC - !xx WRITE(SC1, * ) ! Advance 1 line for screen messages + !xx WRITE(SC1, * ) ! Advance 1 line for screen messages IF (DEALLOCATE_KGGD == 'Y') THEN WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KGGD', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'KGGD' ) @@ -563,14 +563,14 @@ SUBROUTINE REDUCE_G_NM ! ********************************************************************************************************************************** ! ################################################################################################################################## - + CONTAINS - + ! ################################################################################################################################## SUBROUTINE N_SET_AUTOSPC_PROC_1 -! Checks KNN to see if any rows are null for DOF's not already in the S or O-sets, and, if so, puts these in the SA set and +! Checks KNN to see if any rows are null for DOF's not already in the S or O-sets, and, if so, puts these in the SA set and ! reruns subr TDOF_PROC and writes the new TSET, TDOF, TDOFI tables to file L1C USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE @@ -599,7 +599,7 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 INTEGER(LONG) :: N_SET_COL ! Col no. in array TDOF where the N-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: R_SET_COL ! Col no. in array TDOF where the R-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: S_SET_COL ! Col no. in array TDOF where the S-set is (from subr TDOF_COL_NUM) - INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN + INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN ! ********************************************************************************************************************************** OUNT(1) = ERR @@ -631,11 +631,11 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 DO I=1,6 ! Initialize NUM_ASPC_BY_COMP NUM_ASPC_BY_COMP(I) = 0 - ENDDO + ENDDO NUM_N_SET_ROWS_NULL = 0 JSTART = 1 -!xx WRITE(SC1, * ) ! Advance 1 line for screen messages +!xx WRITE(SC1, * ) ! Advance 1 line for screen messages CALL COUNTER_INIT(' Proc N-set DOF ', NDOFN) i_do: DO I=1,NDOFN IF (I_KNN(I+1) == I_KNN(I)) THEN ! If true, row i is null @@ -692,7 +692,7 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 WRITE(F06,57) DO J = 1,NGRID WRITE(F06,58) GRID(J,1), GRID_SEQ(J), (TSET(J,K),K = 1,6) - ENDDO + ENDDO WRITE(F06,'(//)') ENDIF @@ -778,7 +778,7 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2 INTEGER(LONG) :: N_SET_COL ! Col no. in array TDOF where the N-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: R_SET_COL ! Col no. in array TDOF where the R-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: S_SET_COL ! Col no. in array TDOF where the S-set is (from subr TDOF_COL_NUM) - INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN + INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN ! ********************************************************************************************************************************** OUNT(1) = ERR @@ -810,12 +810,12 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2 DO I=1,6 ! Initialize NUM_ASPC_BY_COMP NUM_ASPC_BY_COMP(I) = 0 - ENDDO + ENDDO NUM_NSET_DOFS_SPCD = 0 JSTART = 1 -!xx WRITE(SC1, * ) ! Advance 1 line for screen messages - CALL COUNTER_INIT(' Proc N-set DOF ', NDOFN) +!xx WRITE(SC1, * ) ! Advance 1 line for screen messages + CALL COUNTER_INIT(' Proc N-set DOF ', NDOFN) i_do: DO I=1,NDOFN IF ((DABS(KNN_DIAG(I)/KNN_MAX_DIAG) < AUTOSPC_RAT) .OR. (KNN_DIAG(I) < ZERO)) THEN j_do: DO J=JSTART,NDOFG ! Loop over rows of TDOFI to find where this N-set row is null @@ -871,7 +871,7 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2 WRITE(F06,57) DO J = 1,NGRID WRITE(F06,58) GRID(J,1), GRID_SEQ(J), (TSET(J,K),K = 1,6) - ENDDO + ENDDO WRITE(F06,'(//)') ENDIF diff --git a/Source/LK2/REDUCE_KGGD_TO_KNND.f90 b/Source/LK2/REDUCE_KGGD_TO_KNND.f90 index bb0ffb62..a0b389e2 100644 --- a/Source/LK2/REDUCE_KGGD_TO_KNND.f90 +++ b/Source/LK2/REDUCE_KGGD_TO_KNND.f90 @@ -1,41 +1,41 @@ ! ################################################################################################################################## -! Begin MIT license text. +! 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 + +! 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. +! 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. + +! End MIT license text. SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) - + ! Call routines to reduce the KGGD differential stiffness matrix from the G-set to the N, M-sets - + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F04, F06, LINK2A, L2A, L2ASTAT, L2A_MSG, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFN, NDOFM, NTERM_HMN, NTERM_KGGD, NTERM_KNND, & NTERM_KNMD, NTERM_KMMD, NTERM_GMN USE PARAMS, ONLY : EPSIL, SPARSTOR USE TIMDAT, ONLY : TSEC USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KGGD_TO_KNND_BEGEND - USE CONSTANTS_1, ONLY : ONE + USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_HMN, J_HMN, HMN, I_KGGD, J_KGGD, KGGD, I_KNND, J_KNND, KNND, I_KNMD, J_KNMD, KNMD, & I_KMMD, J_KMMD, KMMD, I_KMND, J_KMND, KMND, I_GMN, J_GMN, GMN, I_GMNt, J_GMNt, GMNt USE SPARSE_MATRICES, ONLY : SYM_GMN, SYM_HMN, SYM_KGGD, SYM_KNND, SYM_KNMD, SYM_KMMD, SYM_KMND @@ -51,8 +51,8 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) ! 'N' for nonsymmetric storage) CHARACTER( 1*BYTE) :: SYM_CRS3 ! Storage format for matrix CRS3 (either 'Y' for sym storage or ! 'N' for nonsymmetric storage) - - INTEGER(LONG), INTENT(IN) :: PART_VEC_G_NM(NDOFG)! Partitioning vector (G set into N and M sets) + + INTEGER(LONG), INTENT(IN) :: PART_VEC_G_NM(NDOFG)! Partitioning vector (G set into N and M sets) INTEGER(LONG) :: AROW_MAX_TERMS ! Output from MATMULT_SFS_NTERM and input to MATMULT_SFS INTEGER(LONG) :: I,J ! DO loop indices ! the ones on and above the diagonal (controlled by param SPARSTOR) @@ -60,10 +60,10 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) INTEGER(LONG) :: KNMD_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) !xx INTEGER(LONG) :: KMND_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) INTEGER(LONG) :: KMMD_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) - INTEGER(LONG) :: NTERM_CCS1 ! Number of terms in matrix CCS1 - INTEGER(LONG) :: NTERM_CRS1 ! Number of terms in matrix CRS1 - INTEGER(LONG) :: NTERM_CRS2 ! Number of terms in matrix CRS2 - INTEGER(LONG) :: NTERM_CRS3 ! Number of terms in matrix CRS3 + INTEGER(LONG) :: NTERM_CCS1 ! Number of terms in matrix CCS1 + INTEGER(LONG) :: NTERM_CRS1 ! Number of terms in matrix CRS1 + INTEGER(LONG) :: NTERM_CRS2 ! Number of terms in matrix CRS2 + INTEGER(LONG) :: NTERM_CRS3 ! Number of terms in matrix CRS3 INTEGER(LONG) :: NTERM_KMND ! Number of nonzeros in sparse matrix KMND (should = NTERM_KNMD) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices @@ -84,11 +84,11 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) IF (NDOFN > 0) THEN CALL PARTITION_SS_NTERM ( 'KGGD', NTERM_KGGD, NDOFG, NDOFG, SYM_KGGD, I_KGGD, J_KGGD, PART_VEC_G_NM, PART_VEC_G_NM, & - NUM1, NUM1, KNND_ROW_MAX_TERMS, 'KNND', NTERM_KNND, SYM_KNND ) + NUM1, NUM1, KNND_ROW_MAX_TERMS, 'KNND', NTERM_KNND, SYM_KNND ) CALL ALLOCATE_SPARSE_MAT ( 'KNND', NDOFN, NTERM_KNND, SUBR_NAME ) - IF (NTERM_KNND > 0) THEN + IF (NTERM_KNND > 0) THEN CALL PARTITION_SS ( 'KGGD', NTERM_KGGD, NDOFG, NDOFG, SYM_KGGD, I_KGGD, J_KGGD, KGGD, PART_VEC_G_NM, PART_VEC_G_NM, & NUM1, NUM1, KNND_ROW_MAX_TERMS, 'KNND', NTERM_KNND, NDOFN, SYM_KNND, I_KNND, J_KNND, KNND ) ENDIF @@ -100,7 +100,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) IF ((NDOFN > 0) .AND. (NDOFM > 0)) THEN CALL PARTITION_SS_NTERM ( 'KGGD', NTERM_KGGD, NDOFG, NDOFG, SYM_KGGD, I_KGGD, J_KGGD, PART_VEC_G_NM, PART_VEC_G_NM, & - NUM1, NUM2, KNMD_ROW_MAX_TERMS, 'KNMD', NTERM_KNMD, SYM_KNMD ) + NUM1, NUM2, KNMD_ROW_MAX_TERMS, 'KNMD', NTERM_KNMD, SYM_KNMD ) CALL ALLOCATE_SPARSE_MAT ( 'KNMD', NDOFN, NTERM_KNMD, SUBR_NAME ) @@ -116,7 +116,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) IF ((NDOFN > 0) .AND. (NDOFM > 0)) THEN !xx CALL PARTITION_SS_NTERM ( 'KGGD', NTERM_KGGD, NDOFG, NDOFG, SYM_KGGD, I_KGGD, J_KGGD, PART_VEC_G_NM, PART_VEC_G_NM, & -!xx NUM2, NUM1, KMND_ROW_MAX_TERMS, 'KMND', NTERM_KMND, SYM_KMND ) +!xx NUM2, NUM1, KMND_ROW_MAX_TERMS, 'KMND', NTERM_KMND, SYM_KMND ) !xx IF (NTERM_KMND /= NTERM_KNMD) THEN !xx FATAL_ERR = FATAL_ERR + 1 @@ -147,7 +147,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) IF (NDOFM > 0) THEN CALL PARTITION_SS_NTERM ( 'KGGD', NTERM_KGGD, NDOFG, NDOFG, SYM_KGGD, I_KGGD, J_KGGD, PART_VEC_G_NM, PART_VEC_G_NM, & - NUM2, NUM2, KMMD_ROW_MAX_TERMS, 'KMMD', NTERM_KMMD, SYM_KMMD ) + NUM2, NUM2, KMMD_ROW_MAX_TERMS, 'KMMD', NTERM_KMMD, SYM_KMMD ) CALL ALLOCATE_SPARSE_MAT ( 'KMMD', NDOFM, NTERM_KMMD, SUBR_NAME ) @@ -165,6 +165,10 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) IF (.NOT. ALLOCATED(GMN)) THEN CALL ALLOCATE_SPARSE_MAT ( 'GMN' , NDOFN, NTERM_GMN, SUBR_NAME ) + + CALL READ_MATRIX_1 ( LINK2A, L2A, 'N', 'N', L2ASTAT, L2A_MSG, & + 'GMN', NTERM_GMN, 'Y', NDOFM, & + I_GMN, J_GMN, GMN ) ENDIF CALL ALLOCATE_SPARSE_MAT ( 'GMNt', NDOFN, NTERM_GMN, SUBR_NAME ) CALL MATTRNSP_SS ( NDOFM, NDOFN, NTERM_GMN, 'GMN', I_GMN, J_GMN, GMN, 'GMNt', I_GMNt, J_GMNt, GMNt ) @@ -203,7 +207,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) CALL DEALLOCATE_SCR_MAT ( 'CRS2' ) ! I-6, deallocate CRS2 which was (KNMD*GMN)t ! I-7, CRS3 = (KNMD*GMN) + (KNMD*GMN)t has all nonzero terms in it. - IF (SPARSTOR == 'SYM ') THEN ! If SPARSTOR == 'SYM ', rewrite CRS3 as sym in CRS1 + IF (SPARSTOR == 'SYM ') THEN ! If SPARSTOR == 'SYM ', rewrite CRS3 as sym in CRS1 CALL SPARSE_CRS_TERM_COUNT ( NDOFN, NTERM_CRS3, '(KNMD*GMN) + (KNMD*GMN)t', I_CRS3, J_CRS3, NTERM_CRS1 ) CALL ALLOCATE_SCR_CRS_MAT ( 'CRS1', NDOFN, NTERM_CRS1, SUBR_NAME ) @@ -242,11 +246,11 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) CALL MATADD_SSS ( NDOFN, 'KNND-bar', NTERM_KNND, I_KNND, J_KNND, KNND, ONE, 'KNMD*GMN + (KNMD*GMN)t', NTERM_CRS1, & I_CRS1, J_CRS1, CRS1, ONE, 'CRS1', NTERM_CRS3, I_CRS3, J_CRS3, CRS3 ) - CALL DEALLOCATE_SCR_MAT ( 'CRS1' ) ! I-10, deallocate CRS1 = KNMD*GMN + (KNMD*GMN)t + CALL DEALLOCATE_SCR_MAT ( 'CRS1' ) ! I-10, deallocate CRS1 = KNMD*GMN + (KNMD*GMN)t NTERM_KNND = NTERM_CRS3 ! I-11, reallocate KNND to be size of CRS3 WRITE(SC1, * ) ' Reallocate KNND' - !xx WRITE(SC1, * ) ! Advance 1 line for screen messages + !xx WRITE(SC1, * ) ! Advance 1 line for screen messages WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KNND', CR13 CALL DEALLOCATE_SPARSE_MAT ( 'KNND' ) WRITE(SC1,12345,ADVANCE='NO') ' Allocate KNND', CR13 @@ -258,7 +262,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) DO J=1,NTERM_KNND J_KNND(J) = J_CRS3(J) KNND(J) = CRS3(J) - ENDDO + ENDDO CALL DEALLOCATE_SCR_MAT ( 'CRS3' ) ! I-13, deallocate CRS3 ! At this point, CRS1, CRS2, CRS3 are deallocated, CCS1 is being used @@ -319,7 +323,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) CALL DEALLOCATE_SCR_MAT ( 'CCS1' ) ! II-6, deallocate CCS1 ! II-7, CRS1 = GMNt*KMMD*GMN has all nonzero terms in it. - IF (SPARSTOR == 'SYM ') THEN ! If SPARSTOR == 'SYM ', rewrite CRS1 as sym in CRS3 + IF (SPARSTOR == 'SYM ') THEN ! If SPARSTOR == 'SYM ', rewrite CRS1 as sym in CRS3 CALL SPARSE_CRS_TERM_COUNT ( NDOFN, NTERM_CRS1, 'GMNt*KMMD*GMN all nonzeros', I_CRS1, J_CRS1, NTERM_CRS3 ) CALL ALLOCATE_SCR_CRS_MAT ( 'CRS3', NDOFN, NTERM_CRS3, SUBR_NAME ) @@ -360,7 +364,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) NTERM_KNND = NTERM_CRS2 ! II-11, reallocate KNND to be size of CRS2 WRITE(SC1, * ) ' Reallocate KNND' - !xx WRITE(SC1, * ) ! Advance 1 line for screen messages + !xx WRITE(SC1, * ) ! Advance 1 line for screen messages WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KNND', CR13 CALL DEALLOCATE_SPARSE_MAT ( 'KNND' ) WRITE(SC1,12345,ADVANCE='NO') ' Allocate KNND', CR13 @@ -402,7 +406,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) ENDIF WRITE(SC1, * ) ' DEALLOCATE SOME ARRAYS' - !xx WRITE(SC1, * ) ! Advance 1 line for screen messages + !xx WRITE(SC1, * ) ! Advance 1 line for screen messages WRITE(SC1,12345,ADVANCE='NO') ' Deallocate GMNt', CR13 CALL DEALLOCATE_SPARSE_MAT ( 'GMNt' ) WRITE(SC1,12345,ADVANCE='NO') ' Deallocate HMN ', CR13 @@ -429,5 +433,5 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) 12345 FORMAT(A,10X,A) ! ********************************************************************************************************************************** - + END SUBROUTINE REDUCE_KGGD_TO_KNND diff --git a/Source/LK9/LINK9/LINK9.f90 b/Source/LK9/LINK9/LINK9.f90 index 1e30466e..24a60429 100644 --- a/Source/LK9/LINK9/LINK9.f90 +++ b/Source/LK9/LINK9/LINK9.f90 @@ -1,31 +1,31 @@ ! ################################################################################################################################## -! Begin MIT license text. +! 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 + +! 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. +! 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. - + +! End MIT license text. + SUBROUTINE LINK9 ( LK9_PROC_NUM ) - + ! Main driver for calculating outputs requested in Case Control once the G-set unknowns have been solved for in prior LINK's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE @@ -93,7 +93,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) USE LINK9_USE_IFs IMPLICIT NONE - + LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_PCH, WRITE_ANS, WRITE_NEU ! flag LOGICAL :: LEXIST ! .TRUE. if a file exists LOGICAL :: LOPEN ! .TRUE. if a file is opened @@ -101,21 +101,21 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'LINK9' CHARACTER(LEN=3*CC_ENTRY_LEN+5) :: TSL ! Concatenated TITLE, STITLE, LABEL for FEMAP block 450 in FEMAP NEU file - CHARACTER( 1*BYTE) :: CLOSE_IT ! Input to subr READ_MATRIX_i. 'Y'/'N' whether to close a file or not + CHARACTER( 1*BYTE) :: CLOSE_IT ! Input to subr READ_MATRIX_i. 'Y'/'N' whether to close a file or not CHARACTER( 8*BYTE) :: CLOSE_STAT ! What to do with file when it is closed CHARACTER(14*BYTE) :: CTIME ! A char variable to which STIME will be written (for use in NEU file) CHARACTER( 6*BYTE) :: FEMAP_BLK='xxxxxx'! 3 digit number indicating the FEMAP data block CHARACTER( 1*BYTE) :: NULL_ROW ! 'Y'/'N' depending on whether a col in IF_LTM is null CHARACTER( 1*BYTE) :: ZERO_GEN_STIFF ! Indicator of whether there are zero gen stiffs (can't calc MEFFMASS) - CHARACTER(24*BYTE) :: MESSAG ! File description. Input to subr UNFORMATTED_OPEN + CHARACTER(24*BYTE) :: MESSAG ! File description. Input to subr UNFORMATTED_OPEN CHARACTER(54*BYTE) :: MODNAM ! Name to write to screen to describe module being run CHARACTER( 1*BYTE) :: NULL_COL ! An output from subr GET_SPARSE_CRS_COL CHARACTER( 1*BYTE) :: PROC_PG_OUTPUT ! 'Y' in general. However, for BUCKLING, set to 'N' for eigen subcase CHARACTER( 1*BYTE) :: READ_SPCARRAYS ! ='Y' if we need to read KSF, etc. See test below. - - INTEGER(LONG), INTENT(IN) :: LK9_PROC_NUM ! 2 if this is the LINK9 call for the linear buckling step of -! SOL_NAME = 'BUCKLING. Otherwise 1 to designate that, for BUCKLING, + + INTEGER(LONG), INTENT(IN) :: LK9_PROC_NUM ! 2 if this is the LINK9 call for the linear buckling step of +! SOL_NAME = 'BUCKLING. Otherwise 1 to designate that, for BUCKLING, ! this call to LINK9 is for the linear statics (1st) portion of BUCKLING INTEGER(LONG) :: ANY_U_P_OUTPUT ! > 0 if requests for output of elem loads/displs in a any S/C @@ -139,11 +139,11 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) INTEGER(LONG) :: NUM_COLS ! Number of cols to get when subr GET_SPARSE_CRS_COL is called INTEGER(LONG) :: NUM_SOLNS ! No. of solutions to process (e.g. NSUB for STATICS) INTEGER(LONG) :: NUM_OU4_NOT_PART ! Number of OU4 mats requested for partitioning that were not done - INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN + INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN INTEGER(LONG) :: OT4_EROW = 0 ! Row number in OT4 elem related files. Accumulated in OFP1,2 for OTM's INTEGER(LONG) :: OT4_GROW = 0 ! Row number in OT4 grid related files. Accumulated in OFP1,2 for OTM's - INTEGER(LONG) :: PART_G_NM(NDOFG) ! Partitioning vector (G set into N and M sets) - INTEGER(LONG) :: PART_SUB(NSUB) ! Partitioning vector (1's for all subcases) + INTEGER(LONG) :: PART_G_NM(NDOFG) ! Partitioning vector (G set into N and M sets) + INTEGER(LONG) :: PART_SUB(NSUB) ! Partitioning vector (1's for all subcases) INTEGER(LONG) :: P_LINKNO ! Prior LINK no's that should have run before this LINK can execute INTEGER(LONG) :: PM_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) INTEGER(LONG) :: REC_NO ! Record number when reading a file @@ -159,15 +159,15 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) INTEGER(LONG) :: SC_STRN_OUTPUT ! = 1 if requests for output of elem strains in a particular S/C INTEGER(LONG) :: XTIME ! Time stamp read from an unformatted file INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LINK9_BEGEND + 1 - + REAL(DOUBLE) :: EPS1 ! Small number to compare against zero REAL(DOUBLE) :: UGV ! A G-set vector read from file L5A REAL(DOUBLE) :: PHIXGV ! A G-set vector read from file L5B - INTEGER(LONG) :: ITABLE ! + INTEGER(LONG) :: ITABLE ! LOGICAL :: NEW_RESULT ! Is this a new result INTRINSIC :: IAND - + ! ********************************************************************************************************************************** LINKNO = 9 @@ -313,7 +313,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Allocate data to be read in LINK9S from file LINK1Q CALL ALLOCATE_MODEL_STUF ( 'PPNT, PDATA, PTYPE', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'PLOAD4_3D_DATA', SUBR_NAME ) - + ! Read LINK9S data CALL OURTIM MODNAM = 'READ MODEL DATA ARRAYS' @@ -329,7 +329,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Note: need PG to partition PM if MPC force outout is requested and also need PG if G.P. force balance is requested. CALL ALLOCATE_SPARSE_MAT ( 'PG', NDOFG, NTERM_PG, SUBR_NAME ) - + IF ((SOL_NAME(1:7)=='STATICS') .OR. (SOL_NAME(1:8)=='NLSTATIC') .OR. ((SOL_NAME(1:8)=='BUCKLING') .AND. (LOAD_ISTEP==1))) THEN IF ((ANY_OLOA_OUTPUT > 0) .OR. (ANY_MPCF_OUTPUT > 0) .OR. (ANY_GPFO_OUTPUT > 0) .OR. (WRITE_NEU)) THEN @@ -353,7 +353,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) PART_SUB = 1 ENDDO CALL PARTITION_SS_NTERM ( 'PG' , NTERM_PG, NDOFG, NSUB , SYM_PG , I_PG , J_PG , PART_G_NM, PART_SUB, & - NUM2, NUM1, PM_ROW_MAX_TERMS, 'PM', NTERM_PM, SYM_PM ) + NUM2, NUM1, PM_ROW_MAX_TERMS, 'PM', NTERM_PM, SYM_PM ) CALL ALLOCATE_SPARSE_MAT ( 'PM', NDOFM, NTERM_PM, SUBR_NAME ) CALL PARTITION_SS ( 'PG' , NTERM_PG , NDOFG, NSUB , SYM_PG , I_PG , J_PG , PG , PART_G_NM, PART_SUB, & @@ -368,7 +368,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF ! Read files with KSF, MSF, QSYS (used to calc SPC constraint forces, QS), but only if they will be needed. - ! For any SOL_NAME they will be needed if any SPC constraint force output is requested or GP force balance or if WRITE_NEU. + ! For any SOL_NAME they will be needed if any SPC constraint force output is requested or GP force balance or if WRITE_NEU. ! For non CB they will be needed also if MEFFMASS, MPFACTOR are to be calculated (done via SPC force total method) READ_SPCARRAYS = 'N' IF (SOL_NAME == 'GEN CB MODEL') THEN @@ -381,7 +381,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) READ_SPCARRAYS = 'Y' ENDIF ENDIF - + CALL ALLOCATE_SPARSE_MAT ( 'KSF' , NDOFS, NTERM_KFS , SUBR_NAME ) CALL ALLOCATE_SPARSE_MAT ( 'KSFD', NDOFS, NTERM_KFSD, SUBR_NAME ) CALL ALLOCATE_SPARSE_MAT ( 'MSF' , NDOFS, NTERM_MFS , SUBR_NAME ) @@ -390,7 +390,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL ALLOCATE_COL_VEC ('QSYS_COL',NDOFS,SUBR_NAME)! Alloc this here since OFP2 uses it (will be zero's if NTERM_QSYS = 0) IF (READ_SPCARRAYS == 'Y') THEN - + IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN IF (NTERM_KFSD > 0) THEN @@ -435,7 +435,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC CLOSE_IT = 'Y' CALL READ_MATRIX_1 ( LINK2S, L2S, 'N', CLOSE_IT, L2SSTAT, L2S_MSG, 'MSF', NTERM_MFS , 'Y', NDOFS, & - I_MSF , J_MSF , MSF ) + I_MSF , J_MSF , MSF ) ENDIF ENDIF @@ -451,7 +451,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CLOSE_IT = 'Y' CALL READ_MATRIX_1 ( LINK2C, L2C, 'N', CLOSE_IT, L2CSTAT, L2C_MSG, 'QSYS', NTERM_QSYS, 'Y', NDOFS, & I_QSYS, J_QSYS, QSYS ) - COL_NUM = 1 ! Put QSYS nonzero terms into QSYS_COL. + COL_NUM = 1 ! Put QSYS nonzero terms into QSYS_COL. NUM_COLS = 1 IF (NTERM_QSYS > 0) THEN CALL GET_SPARSE_CRS_COL ('QSYS_COL ', COL_NUM, NTERM_QSYS, NDOFS, NUM_COLS, I_QSYS, J_QSYS, QSYS, ONE, & @@ -476,7 +476,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF ENDIF - + ! Read MPC constraint matrices IF ((ANY_MPCF_OUTPUT > 0) .OR. (ANY_GPFO_OUTPUT > 0) .OR. (WRITE_NEU)) THEN @@ -489,7 +489,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC CLOSE_IT = 'Y' CALL ALLOCATE_SPARSE_MAT ( 'GMN', NDOFM, NTERM_GMN, SUBR_NAME ) - CALL READ_MATRIX_1 ( LINK2A, L2A, 'N', CLOSE_IT, L2ASTAT, L2A_MSG, 'GMN', NTERM_GMN, 'Y', NDOFM & + CALL READ_MATRIX_1 ( LINK2A, L2A, 'N', CLOSE_IT, 'KEEP', L2A_MSG, 'GMN', NTERM_GMN, 'Y', NDOFM & , I_GMN, J_GMN, GMN ) CALL ALLOCATE_SPARSE_MAT ( 'GMNt', NDOFN, NTERM_GMN, SUBR_NAME ) CALL MATTRNSP_SS ( NDOFM, NDOFN, NTERM_GMN, 'GMN', I_GMN, J_GMN, GMN, 'GMNt', I_GMNt, J_GMNt, GMNt ) @@ -514,7 +514,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC CLOSE_IT = 'Y' CALL ALLOCATE_SPARSE_MAT ( 'LMN', NDOFM, NTERM_LMN, SUBR_NAME ) - CALL READ_MATRIX_1 ( LINK2R, L2R, 'N', CLOSE_IT, L2RSTAT, L2R_MSG, 'LMN', NTERM_LMN, 'Y', NDOFM & + CALL READ_MATRIX_1 ( LINK2R, L2R, 'N', CLOSE_IT, 'KEEP', L2R_MSG, 'LMN', NTERM_LMN, 'Y', NDOFM & , I_LMN, J_LMN, LMN ) ENDIF @@ -554,12 +554,12 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF ! Determine if we need to open F25 to write element disp, loads to unformatted file - + !xx ANY_U_P_OUTPUT = IAND(OELDT,IBIT(ELDT_F25_U_P_BIT)) !xx IF (ANY_U_P_OUTPUT > 0) THEN !xx CALL FILE_OPEN ( F25, F25FIL, OUNT, 'REPLACE', F25_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) !xx ENDIF - + ! Open data files for reading displacements (will be read below in loop over number of subcases/vectors) CALL FILE_OPEN ( L5A, LINK5A, OUNT, 'OLD', L5A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) @@ -569,12 +569,12 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ZERO_GEN_STIFF = 'N' IF ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN CB MODEL')) THEN ! MODE_NUM is not used to det gen stiff but it is read in subr READ_L1M - CALL ALLOCATE_EIGEN1_MAT ( 'MODE_NUM' , NUM_EIGENS, 1, SUBR_NAME ) -!xx CALL ALLOCATE_EIGEN1_MAT ( 'EIGEN_VAL', NUM_EIGENS, 1, SUBR_NAME ) + CALL ALLOCATE_EIGEN1_MAT ( 'MODE_NUM' , NUM_EIGENS, 1, SUBR_NAME ) +!xx CALL ALLOCATE_EIGEN1_MAT ( 'EIGEN_VAL', NUM_EIGENS, 1, SUBR_NAME ) CALL ALLOCATE_EIGEN1_MAT ( 'GEN_MASS' , NUM_EIGENS, 1, SUBR_NAME ) IERROR = 0 CALL READ_L1M ( IERROR ) - CALL DEALLOCATE_EIGEN1_MAT ( 'MODE_NUM' ) + CALL DEALLOCATE_EIGEN1_MAT ( 'MODE_NUM' ) IF (IERROR /= 0) THEN WRITE(ERR,9995) LINKNO,IERROR WRITE(F06,9995) LINKNO,IERROR @@ -633,11 +633,11 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) !----------------------------------------------------------------------------------------------------------------------------------- ! Allocate arrays particular to LINK9 CALL ALLOCATE_LINK9_STUF ( SUBR_NAME ) - + ! Initialize JTSUB which will become the col no in the elem thermal loads matrix corresponding to the subcases below. JTSUB = 0 - - ! Set NUM_SOLNS for use in loop (below) to get outputs for each subcase/solution vector and size. Also, allocate memory for + + ! Set NUM_SOLNS for use in loop (below) to get outputs for each subcase/solution vector and size. Also, allocate memory for ! CB OTM matrices (if CB soln) and open CB OTM output files (OU4(8) for grid related OTM's and OU4(9) for elem related OTM's) PROC_PG_OUTPUT = 'Y' IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN @@ -793,7 +793,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF WRITE(SC1,9093) LINKNO,MODNAM,JVEC,HOUR,MINUTE,SEC,SFRAC - ! Read the displ's for the DOF for this subcase/eigenvector + ! Read the displ's for the DOF for this subcase/eigenvector CALL DEALLOCATE_COL_VEC ( 'UG_COL' ) CALL ALLOCATE_COL_VEC ( 'UG_COL', NDOFG, SUBR_NAME ) DO I=1,NDOFG @@ -804,7 +804,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL OUTA_HERE ( 'Y' ) ENDIF UG_COL(I) = UGV - ENDDO + ENDDO ! If this is a CB soln and JVEC <= NDOFR+NVEC, formulate a col of PHIXG from data in file L5B. Otherwise zero IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN @@ -875,7 +875,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF !CALL END_OP2_TABLE(ITABLE) - ! Calc SPC forces and process SPC force output requests, if there are any or if GP force balance, modal effective mass and/or + ! Calc SPC forces and process SPC force output requests, if there are any or if GP force balance, modal effective mass and/or ! participation factor output is requested. Calc anyway if there are any DOF's in the SA (AUTOSPC) set NEW_RESULT = .TRUE. ITABLE = -1 @@ -896,18 +896,18 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL ALLOCATE_COL_VEC ( 'PS_COL', NDOFS, SUBR_NAME ) DO K=1,NDOFS PS_COL(K) = ZERO - ENDDO + ENDDO IF ((SOL_NAME(1: 7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. & ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - IF (NTERM_PS > 0) THEN + IF (NTERM_PS > 0) THEN CALL GET_SPARSE_CRS_COL ('PS_COL', JVEC , NTERM_PS, NDOFS, NSUB, I_PS, J_PS, PS, ONE, PS_COL, NULL_COL ) ENDIF ELSE DO K=1,NDOFS PS_COL(K) = ZERO - ENDDO - ENDIF + ENDDO + ENDIF CALL OURTIM MODNAM = 'PROCESS SPC FORCE OUTPUT REQUESTS, "' @@ -926,11 +926,11 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL ALLOCATE_COL_VEC ( 'PM_COL', NDOFM, SUBR_NAME ) DO K=1,NDOFM PM_COL(K) = ZERO - ENDDO + ENDDO IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'BUCKLING') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - IF (NTERM_PM > 0) THEN + IF (NTERM_PM > 0) THEN CALL GET_SPARSE_CRS_COL ('PM_COL', JVEC , NTERM_PM, NDOFM, NSUB, I_PM, J_PM, PM, ONE, PM_COL, NULL_COL ) - ENDIF + ENDIF ENDIF CALL OURTIM @@ -978,7 +978,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDDO ENDIF DO I=1,NDOFG ! Calc SPC forces for all grids in requested output set (not only ones - CALL TDOF_COL_NUM ( 'R ', R_SET_COL ) ! that have a component in S-set) + CALL TDOF_COL_NUM ( 'R ', R_SET_COL ) ! that have a component in S-set) CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) RDOF = TDOF(I,R_SET_COL) GDOF = TDOF(I,G_SET_COL) @@ -1045,7 +1045,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (LOPEN) THEN REWIND (L1E) READ(L1E,IOSTAT=IOCHK) XTIME - MESSAG = 'STIME ' + MESSAG = 'STIME ' IF (IOCHK /= 0) THEN REC_NO = 1 CALL READERR ( IOCHK, LINK1E, MESSAG, REC_NO, OUNT, 'Y' ) @@ -1057,7 +1057,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (LOPEN) THEN REWIND (L2D) READ(L2D,IOSTAT=IOCHK) XTIME - MESSAG = 'STIME ' + MESSAG = 'STIME ' IF (IOCHK /= 0) THEN REC_NO = 1 CALL READERR ( IOCHK, LINK2D, MESSAG, REC_NO, OUNT, 'Y' ) @@ -1244,15 +1244,15 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF IF ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN CB MODEL')) THEN - CALL DEALLOCATE_EIGEN1_MAT ( 'EIGEN_VAL' ) - CALL DEALLOCATE_EIGEN1_MAT ( 'GEN_MASS' ) + CALL DEALLOCATE_EIGEN1_MAT ( 'EIGEN_VAL' ) + CALL DEALLOCATE_EIGEN1_MAT ( 'GEN_MASS' ) CALL DEALLOCATE_EIGEN1_MAT ( 'MODE_NUM' ) - ENDIF + ENDIF ! Deallocate some arrays !xx WRITE(SC1, * ) ' DEALLOCATE SOME ARRAYS' -!xx WRITE(SC1, * ) ! Advance 1 line for screen messages +!xx WRITE(SC1, * ) ! Advance 1 line for screen messages WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KSF ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'KSF' ) WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KSFD', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'KSFD') WRITE(SC1,12345,ADVANCE='NO') ' Deallocate MGG ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'MGG' ) @@ -1264,13 +1264,13 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) WRITE(SC1,12345,ADVANCE='NO') ' Deallocate GMNt', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'GMNt' ) WRITE(SC1,12345,ADVANCE='NO') ' Deallocate HMN ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'HMN' ) WRITE(SC1,12345,ADVANCE='NO') ' Deallocate MSF ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'MSF' ) - + ! save MLL from deallocation in case we need to use it for eigenvalue ! estimation in a next step of the eigen solution IF ((SOL_NAME(1:8) /= 'BUCKLING') .OR. (LOAD_ISTEP == 2)) THEN WRITE(SC1,12345,ADVANCE='NO') ' Deallocate MLL ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'MLL' ) END IF - + WRITE(SC1,12345,ADVANCE='NO') ' Deallocate LMN ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'LMN' ) WRITE(SC1,12345,ADVANCE='NO') ' Deallocate QSYS', CR13 ; CALL DEALLOCATE_COL_VEC ( 'QSYS_COL' ) @@ -1400,7 +1400,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Write LINK9 end to screen - CALL OURTIM + CALL OURTIM WRITE(SC1,153) LINKNO ! ********************************************************************************************************************************** @@ -1521,8 +1521,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) 98988 FORMAT(' *INFORMATION: Due to DEBUG(176) = ',i3 & ,/,14x,' Plate elem engr forces and stresses will be calculated by multiplying strains by the material matrix' & ,/,14x,' Strains are calculated using the strain-displ matrices:' & - ,/,14x,' BE1 (membrane), BE2 (bending), BE3 (transverse shear) times displacements') - + ,/,14x,' BE1 (membrane), BE2 (bending), BE3 (transverse shear) times displacements') + 98989 FORMAT(' *INFORMATION: Due to DEBUG(176) = ',i3 & ,/,14x,' Plate elem engr forces and stresses will be calculated by multiplying stress-displ matrices:' & ,/,14x,' SE1 (membrane), SE2 (bending), SE3 (transv shear) times displacements') @@ -1530,9 +1530,9 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) 12345 FORMAT(A,10X,A) ! ################################################################################################################################## - + CONTAINS - + ! ################################################################################################################################## SUBROUTINE CONCATENATE_TITLES @@ -1603,75 +1603,75 @@ SUBROUTINE WRITE_OTM_TO_F06 WRITE(F06,99770) ENDIF - IF (SC_ACCE_OUTPUT > 0) THEN + IF (SC_ACCE_OUTPUT > 0) THEN WRITE(F06,*) ' Output transformation matrix for acceleration: OTM_ACCE' WRITE(F06,*) ' -------------------------------------------------------' WRITE(F06,99771) (I,I=1,NDOFR+NVEC) - DO I=1,NROWS_OTM_ACCE - WRITE(F06,99778) I, (OTM_ACCE(I,J),J=1,NDOFR+NVEC) - ENDDO - WRITE(F06,*) - ENDIF + DO I=1,NROWS_OTM_ACCE + WRITE(F06,99778) I, (OTM_ACCE(I,J),J=1,NDOFR+NVEC) + ENDDO + WRITE(F06,*) + ENDIF - IF (SC_DISP_OUTPUT > 0) THEN + IF (SC_DISP_OUTPUT > 0) THEN WRITE(F06,*) ' Output transformation matrix for displacement: OTM_DISP' WRITE(F06,*) ' -------------------------------------------------------' WRITE(F06,99771) (I,I=1,NUM_CB_DOFS) - DO I=1,NROWS_OTM_DISP - WRITE(F06,99778) I, (OTM_DISP(I,J),J=1,NUM_CB_DOFS) - ENDDO - WRITE(F06,*) - ENDIF + DO I=1,NROWS_OTM_DISP + WRITE(F06,99778) I, (OTM_DISP(I,J),J=1,NUM_CB_DOFS) + ENDDO + WRITE(F06,*) + ENDIF - IF (SC_MPCF_OUTPUT > 0) THEN + IF (SC_MPCF_OUTPUT > 0) THEN WRITE(F06,*) ' Output transformation matrix for MPC forces: OTM_MPCF' WRITE(F06,*) ' -----------------------------------------------------' WRITE(F06,99771) (I,I=1,NUM_CB_DOFS) - DO I=1,NROWS_OTM_MPCF - WRITE(F06,99778) I, (OTM_MPCF(I,J),J=1,NUM_CB_DOFS) - ENDDO - WRITE(F06,*) - ENDIF + DO I=1,NROWS_OTM_MPCF + WRITE(F06,99778) I, (OTM_MPCF(I,J),J=1,NUM_CB_DOFS) + ENDDO + WRITE(F06,*) + ENDIF - IF (SC_SPCF_OUTPUT > 0) THEN + IF (SC_SPCF_OUTPUT > 0) THEN WRITE(F06,*) ' Output transformation matrix for SPC forces: OTM_SPCF' WRITE(F06,*) ' -----------------------------------------------------' WRITE(F06,99771) (I,I=1,NUM_CB_DOFS) - DO I=1,NROWS_OTM_SPCF - WRITE(F06,99778) I, (OTM_SPCF(I,J),J=1,NUM_CB_DOFS) - ENDDO - WRITE(F06,*) - ENDIF + DO I=1,NROWS_OTM_SPCF + WRITE(F06,99778) I, (OTM_SPCF(I,J),J=1,NUM_CB_DOFS) + ENDDO + WRITE(F06,*) + ENDIF - IF (SC_ELFE_OUTPUT > 0) THEN + IF (SC_ELFE_OUTPUT > 0) THEN WRITE(F06,*) ' Output transformation matrix for element engineering forces: OTM_ELFE' WRITE(F06,*) ' ---------------------------------------------------------------------' WRITE(F06,99771) (I,I=1,NUM_CB_DOFS) - DO I=1,NROWS_OTM_ELFE - WRITE(F06,99778) I, (OTM_ELFE(I,J),J=1,NUM_CB_DOFS) - ENDDO - WRITE(F06,*) - ENDIF + DO I=1,NROWS_OTM_ELFE + WRITE(F06,99778) I, (OTM_ELFE(I,J),J=1,NUM_CB_DOFS) + ENDDO + WRITE(F06,*) + ENDIF - IF (SC_ELFN_OUTPUT > 0) THEN + IF (SC_ELFN_OUTPUT > 0) THEN WRITE(F06,*) ' Output transformation matrix for element nodal forces: OTM_ELFN' WRITE(F06,*) ' ---------------------------------------------------------------' WRITE(F06,99771) (I,I=1,NUM_CB_DOFS) - DO I=1,NROWS_OTM_ELFN - WRITE(F06,99778) I, (OTM_ELFN(I,J),J=1,NUM_CB_DOFS) - ENDDO - WRITE(F06,*) - ENDIF + DO I=1,NROWS_OTM_ELFN + WRITE(F06,99778) I, (OTM_ELFN(I,J),J=1,NUM_CB_DOFS) + ENDDO + WRITE(F06,*) + ENDIF - IF (SC_STRE_OUTPUT > 0) THEN + IF (SC_STRE_OUTPUT > 0) THEN WRITE(F06,*) ' Output transformation matrix for element stresses: OTM_STRE' WRITE(F06,*) ' -----------------------------------------------------------' WRITE(F06,99771) (I,I=1,NUM_CB_DOFS) - DO I=1,NROWS_OTM_STRE - WRITE(F06,99778) I, (OTM_STRE(I,J),J=1,NUM_CB_DOFS) - ENDDO - WRITE(F06,*) - ENDIF + DO I=1,NROWS_OTM_STRE + WRITE(F06,99778) I, (OTM_STRE(I,J),J=1,NUM_CB_DOFS) + ENDDO + WRITE(F06,*) + ENDIF RETURN @@ -1685,8 +1685,8 @@ SUBROUTINE WRITE_OTM_TO_F06 99778 format(i8,32767(1es14.6)) ! ********************************************************************************************************************************** - - END SUBROUTINE WRITE_OTM_TO_F06 + + END SUBROUTINE WRITE_OTM_TO_F06 ! ################################################################################################################################## @@ -1704,7 +1704,7 @@ SUBROUTINE GET_FG_INERTIA_FORCES IMPLICIT NONE - INTEGER(LONG) :: K ! Counter + INTEGER(LONG) :: K ! Counter INTEGER(LONG) :: A_SET_COL ! Col no. in TDOF for A_SET displ set definition INTEGER(LONG) :: F_SET_COL ! Col no. in TDOF for F_SET displ set definition INTEGER(LONG) :: G_SET_COL ! Col no. in TDOF for G_SET displ set definition @@ -1758,7 +1758,7 @@ SUBROUTINE GET_FG_INERTIA_FORCES DO I=1,NDOFA FA_COL(I) = FL_COL(I) ENDDO - + ENDIF CALL DEALLOCATE_COL_VEC ( 'FL_COL' ) @@ -1785,7 +1785,7 @@ SUBROUTINE GET_FG_INERTIA_FORCES DO I=1,NDOFF FF_COL(I) = FA_COL(I) ENDDO - + ENDIF CALL DEALLOCATE_COL_VEC ( 'FA_COL' ) @@ -1812,7 +1812,7 @@ SUBROUTINE GET_FG_INERTIA_FORCES DO I=1,NDOFN FN_COL(I) = FF_COL(I) ENDDO - + ENDIF CALL DEALLOCATE_COL_VEC ( 'FF_COL' ) @@ -1838,7 +1838,7 @@ SUBROUTINE GET_FG_INERTIA_FORCES DO I=1,NDOFG FG_COL(I) = FN_COL(I) ENDDO - + ENDIF CALL DEALLOCATE_COL_VEC ( 'FN_COL' ) diff --git a/Source/USE_IFs/REDUCE_KGGD_TO_KNND_USE_IFs.f90 b/Source/USE_IFs/REDUCE_KGGD_TO_KNND_USE_IFs.f90 index 329698a8..f10d703b 100644 --- a/Source/USE_IFs/REDUCE_KGGD_TO_KNND_USE_IFs.f90 +++ b/Source/USE_IFs/REDUCE_KGGD_TO_KNND_USE_IFs.f90 @@ -1,27 +1,27 @@ -! Begin MIT license text. +! 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 + +! 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. +! 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. + +! End MIT license text. MODULE REDUCE_KGGD_TO_KNND_USE_IFs @@ -45,5 +45,6 @@ MODULE REDUCE_KGGD_TO_KNND_USE_IFs USE OUTA_HERE_Interface USE DEALLOCATE_SPARSE_MAT_Interface USE WRITE_MATRIX_1_Interface + USE READ_MATRIX_1_Interface END MODULE REDUCE_KGGD_TO_KNND_USE_IFs