From 5d5b151c0ca3268997bad5ac94a2055deb5ed368 Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 15:29:59 -0300 Subject: [PATCH 01/11] halfway to distillation: parsing and LINK4 --- Source/LK1/L1A-BD/BD_EIGR.f90 | 96 ++++++-- Source/LK1/L1A-BD/BD_EIGRL.f90 | 93 ++++++-- Source/LK1/L1A-CC/CC_METH.f90 | 50 +++- Source/LK1/L1A/LOADC.f90 | 59 ++++- Source/LK4/LINK4.f90 | 329 +++++++++++++++++++++----- Source/LK9/LINK9/LINK9.f90 | 11 +- Source/Modules/MODEL_STUF.f90 | 59 +++++ Source/Modules/SCONTR.f90 | 6 + Source/UTIL/ALLOCATE_MODEL_STUF.f90 | 57 +++++ Source/UTIL/DEALLOCATE_MODEL_STUF.f90 | 6 + 10 files changed, 665 insertions(+), 101 deletions(-) diff --git a/Source/LK1/L1A-BD/BD_EIGR.f90 b/Source/LK1/L1A-BD/BD_EIGR.f90 index 78c78a24..8e7348e1 100644 --- a/Source/LK1/L1A-BD/BD_EIGR.f90 +++ b/Source/LK1/L1A-BD/BD_EIGR.f90 @@ -30,10 +30,10 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1M - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB + USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB, NSUB USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE MODEL_STUF, ONLY : CC_EIGR_SID + USE MODEL_STUF, ONLY : CC_EIGR_SID, CC_EIGR_SID_SUB, CC_EIGR_SID_DECK, EIG_PARAMS USE MODEL_STUF, ONLY : EIG_COMP, EIG_CRIT, EIG_CRIT_DEF, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_METH, EIG_MSGLVL, & EIG_LAP_MAT_TYPE, EIG_MODE, EIG_N1, EIG_N2, EIG_NCVFACL, EIG_NORM, EIG_SID, EIG_SIGMA, & EIG_VECS, MAXMIJ, MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT @@ -51,9 +51,16 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) CHARACTER(LEN(JCARD)) :: CHRINP ! Char data in one field of this entry CHARACTER( 1*BYTE) :: USE_THIS_EIG ! ='Y' if this is the EIGR meth requested in CC + INTEGER(LONG) :: I_SUB ! DO loop index over subcases INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: JERR = 0 ! A local error count + LOGICAL :: MATCHES_SCALAR ! True when this card's SID matches the legacy scalar CC_EIGR_SID; +! in that case we still do the WRITE_L1M / LSUB-hack path so legacy +! single-METHOD decks continue to behave identically. + LOGICAL :: MATCHES_PER_SUB ! True when at least one subcase requested this card's SID via its own +! METHOD card (or via inheritance from the deck-level METHOD default). + LOGICAL :: SUB_WANTS_THIS ! Per-subcase test inside the EIG_PARAMS population loop @@ -88,7 +95,9 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) CALL MKJCARD ( SUBR_NAME, CARD, JCARD ) JERR = 0 - USE_THIS_EIG = 'N' + USE_THIS_EIG = 'N' + MATCHES_SCALAR = .FALSE. + MATCHES_PER_SUB = .FALSE. CALL I4FLD ( JCARD(2), JF(2), EIG_SID ) ! Read set ID and check if it is one requested in Case Control IF (IERRFL(2) == 'N') THEN IF (EIG_SID == CC_EIGR_SID) THEN @@ -99,10 +108,32 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) WRITE(F06,1117) JCARD(1),JCARD(2) ELSE EIGFND = 'Y' + MATCHES_SCALAR = .TRUE. + USE_THIS_EIG = 'Y' + ENDIF + ENDIF + ! Also pick up cards requested by any other modes-subcase via its own METHOD entry, or by deck-default + ! propagation when a subcase has not declared a METHOD of its own. This lets SOL 103 decks define a + ! distinct set of modes per subcase. We do not bump EIGFND in this branch — EIGFND is the legacy guard + ! against duplicate cards for the *scalar* SID only. + IF (.NOT. MATCHES_SCALAR) THEN + IF (ALLOCATED(CC_EIGR_SID_SUB)) THEN + DO I_SUB = 1, NSUB + IF (CC_EIGR_SID_SUB(I_SUB) == EIG_SID) THEN + MATCHES_PER_SUB = .TRUE. + EXIT + ENDIF + IF ((CC_EIGR_SID_SUB(I_SUB) == 0) .AND. (EIG_SID == CC_EIGR_SID_DECK) .AND. (CC_EIGR_SID_DECK /= 0)) THEN + MATCHES_PER_SUB = .TRUE. + EXIT + ENDIF + ENDDO + ENDIF + IF (MATCHES_PER_SUB) THEN USE_THIS_EIG = 'Y' + ELSE + RETURN ENDIF - ELSE - RETURN ENDIF ELSE JERR = JERR + 1 @@ -212,21 +243,56 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) EIG_MSGLVL = 0 EIG_NCVFACL = 0 - ! to ensure SCNUM is alloc'd right. #subcases = #eigenvecs - IF (EIG_N2 > LSUB) THEN - LSUB = EIG_N2 - ELSE - ! no idea what the # of eigenvectors should be for now, let's keep - ! it large for now. this ought to be fixed someday - LSUB = 1000 - END IF - NUM_FAIL_CRIT = 0 ! Following have not been determined yet but write values to L1M anyway MAXMIJ = ZERO MIJ_ROW = 0 MIJ_COL = 0 - CALL WRITE_L1M + ! Populate the per-subcase parameter table for every subcase that asked for this SID. The legacy EIG_* + ! scalars carry the values for the LAST card BD_EIGR processes; LINK4's modes-subcase loop reads back from + ! EIG_PARAMS(ISUB) into the scalars before each eigensolver invocation, so the scalars' end-of-parsing + ! state is irrelevant for the multi-METHOD path. + IF (ALLOCATED(EIG_PARAMS) .AND. ALLOCATED(CC_EIGR_SID_SUB)) THEN + DO I_SUB = 1, NSUB + SUB_WANTS_THIS = .FALSE. + IF (CC_EIGR_SID_SUB(I_SUB) == EIG_SID) SUB_WANTS_THIS = .TRUE. + IF ((CC_EIGR_SID_SUB(I_SUB) == 0) .AND. (EIG_SID == CC_EIGR_SID_DECK) .AND. (CC_EIGR_SID_DECK /= 0)) THEN + SUB_WANTS_THIS = .TRUE. + ENDIF + IF (SUB_WANTS_THIS) THEN + EIG_PARAMS(I_SUB)%METHOD = EIG_METH + EIG_PARAMS(I_SUB)%NORM = EIG_NORM + EIG_PARAMS(I_SUB)%LAP_MAT_TYPE = EIG_LAP_MAT_TYPE + EIG_PARAMS(I_SUB)%VECS = EIG_VECS + EIG_PARAMS(I_SUB)%SID = EIG_SID + EIG_PARAMS(I_SUB)%N1 = EIG_N1 + EIG_PARAMS(I_SUB)%N2 = EIG_N2 + EIG_PARAMS(I_SUB)%COMP = EIG_COMP + EIG_PARAMS(I_SUB)%GRID = EIG_GRID + EIG_PARAMS(I_SUB)%MODE = EIG_MODE + EIG_PARAMS(I_SUB)%MSGLVL = EIG_MSGLVL + EIG_PARAMS(I_SUB)%NCVFACL = EIG_NCVFACL + EIG_PARAMS(I_SUB)%CRIT = EIG_CRIT + EIG_PARAMS(I_SUB)%FRQ1 = EIG_FRQ1 + EIG_PARAMS(I_SUB)%FRQ2 = EIG_FRQ2 + EIG_PARAMS(I_SUB)%SIGMA = EIG_SIGMA + ENDIF + ENDDO + ENDIF + + IF (MATCHES_SCALAR) THEN + ! to ensure SCNUM is alloc'd right. #subcases = #eigenvecs (legacy hack; needed for single-METHOD path until + ! LINK9 is fully switched over to MODE_SUBCASE indexing). + IF (EIG_N2 > LSUB) THEN + LSUB = EIG_N2 + ELSE + ! no idea what the # of eigenvectors should be for now, let's keep + ! it large for now. this ought to be fixed someday + LSUB = 1000 + END IF + + CALL WRITE_L1M + ENDIF ENDIF diff --git a/Source/LK1/L1A-BD/BD_EIGRL.f90 b/Source/LK1/L1A-BD/BD_EIGRL.f90 index eb166e9b..61ee07d0 100644 --- a/Source/LK1/L1A-BD/BD_EIGRL.f90 +++ b/Source/LK1/L1A-BD/BD_EIGRL.f90 @@ -30,10 +30,11 @@ SUBROUTINE BD_EIGRL ( CARD, LARGE_FLD_INP, EIGFND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1M - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB, SOL_NAME + USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB, NSUB, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONEPM4 - USE MODEL_STUF, ONLY : CC_EIGR_SID, EIG_COMP, EIG_CRIT, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_LANCZOS_NEV_DELT, & + USE MODEL_STUF, ONLY : CC_EIGR_SID, CC_EIGR_SID_SUB, CC_EIGR_SID_DECK, EIG_PARAMS, & + EIG_COMP, EIG_CRIT, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_LANCZOS_NEV_DELT, & EIG_METH, EIG_MSGLVL, EIG_LAP_MAT_TYPE, EIG_MODE, EIG_N1, EIG_N2, EIG_NCVFACL, EIG_NORM, & EIG_SID, EIG_SIGMA, EIG_VECS, MAXMIJ, MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT @@ -50,9 +51,13 @@ SUBROUTINE BD_EIGRL ( CARD, LARGE_FLD_INP, EIGFND ) CHARACTER(LEN=JCARD_LEN) :: JCARD(10) ! The 10 fields of characters making up CARD INTEGER(LONG) :: I4INP ! An integer*4 value read + INTEGER(LONG) :: I_SUB ! DO loop index over subcases INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: JERR = 0 ! A local error count + LOGICAL :: MATCHES_SCALAR ! Mirrors BD_EIGR: legacy scalar match drives WRITE_L1M / LSUB hack + LOGICAL :: MATCHES_PER_SUB ! True when any modes-subcase requested this card + LOGICAL :: SUB_WANTS_THIS ! Per-subcase test inside the EIG_PARAMS population loop @@ -84,7 +89,9 @@ SUBROUTINE BD_EIGRL ( CARD, LARGE_FLD_INP, EIGFND ) CALL MKJCARD ( SUBR_NAME, CARD, JCARD ) JERR = 0 - USE_THIS_EIG = 'N' + USE_THIS_EIG = 'N' + MATCHES_SCALAR = .FALSE. + MATCHES_PER_SUB = .FALSE. ! second card deprecated. set defaults: ! - ARPACK mode 2 for buckling, 3 for everything else @@ -108,10 +115,30 @@ SUBROUTINE BD_EIGRL ( CARD, LARGE_FLD_INP, EIGFND ) WRITE(F06,1117) JCARD(1),JCARD(2) ELSE EIGFND = 'Y' + MATCHES_SCALAR = .TRUE. + USE_THIS_EIG = 'Y' + ENDIF + ENDIF + IF (.NOT. MATCHES_SCALAR) THEN + ! See BD_EIGR for rationale: also pick up cards needed by per-subcase METHOD requests or by + ! deck-default propagation. Only the scalar match triggers the WRITE_L1M / LSUB-hack path. + IF (ALLOCATED(CC_EIGR_SID_SUB)) THEN + DO I_SUB = 1, NSUB + IF (CC_EIGR_SID_SUB(I_SUB) == EIG_SID) THEN + MATCHES_PER_SUB = .TRUE. + EXIT + ENDIF + IF ((CC_EIGR_SID_SUB(I_SUB) == 0) .AND. (EIG_SID == CC_EIGR_SID_DECK) .AND. (CC_EIGR_SID_DECK /= 0)) THEN + MATCHES_PER_SUB = .TRUE. + EXIT + ENDIF + ENDDO + ENDIF + IF (MATCHES_PER_SUB) THEN USE_THIS_EIG = 'Y' + ELSE + RETURN ENDIF - ELSE - RETURN ENDIF ELSE JERR = JERR + 1 @@ -200,20 +227,52 @@ SUBROUTINE BD_EIGRL ( CARD, LARGE_FLD_INP, EIGFND ) MIJ_ROW = 0 MIJ_COL = 0 - ! ensure a proper size for SCNUM - IF (EIG_N2 > LSUB) THEN - LSUB = EIG_N2 - ELSE - ! since we have adaptive lanczos now, we set this to be - ! INITIAL_NEV*(2**MAX_DOUBLINGS), both being 10 and unlikely to be - ! changed unless someone *really* wants more than 10k modes AND - ! doesn't want to specify nmodes manually. - IF (SOL_NAME /= 'BUCKLING') THEN - LSUB = 10240 + ! Capture per-subcase parameters (see BD_EIGR for the matching rationale). + IF (ALLOCATED(EIG_PARAMS) .AND. ALLOCATED(CC_EIGR_SID_SUB)) THEN + DO I_SUB = 1, NSUB + SUB_WANTS_THIS = .FALSE. + IF (CC_EIGR_SID_SUB(I_SUB) == EIG_SID) SUB_WANTS_THIS = .TRUE. + IF ((CC_EIGR_SID_SUB(I_SUB) == 0) .AND. (EIG_SID == CC_EIGR_SID_DECK) .AND. (CC_EIGR_SID_DECK /= 0)) THEN + SUB_WANTS_THIS = .TRUE. + ENDIF + IF (SUB_WANTS_THIS) THEN + EIG_PARAMS(I_SUB)%METHOD = EIG_METH + EIG_PARAMS(I_SUB)%NORM = EIG_NORM + EIG_PARAMS(I_SUB)%LAP_MAT_TYPE = EIG_LAP_MAT_TYPE + EIG_PARAMS(I_SUB)%VECS = EIG_VECS + EIG_PARAMS(I_SUB)%SID = EIG_SID + EIG_PARAMS(I_SUB)%N1 = EIG_N1 + EIG_PARAMS(I_SUB)%N2 = EIG_N2 + EIG_PARAMS(I_SUB)%COMP = EIG_COMP + EIG_PARAMS(I_SUB)%GRID = EIG_GRID + EIG_PARAMS(I_SUB)%LANCZOS_NEV_DELT = EIG_LANCZOS_NEV_DELT + EIG_PARAMS(I_SUB)%MODE = EIG_MODE + EIG_PARAMS(I_SUB)%MSGLVL = EIG_MSGLVL + EIG_PARAMS(I_SUB)%NCVFACL = EIG_NCVFACL + EIG_PARAMS(I_SUB)%CRIT = EIG_CRIT + EIG_PARAMS(I_SUB)%FRQ1 = EIG_FRQ1 + EIG_PARAMS(I_SUB)%FRQ2 = EIG_FRQ2 + EIG_PARAMS(I_SUB)%SIGMA = EIG_SIGMA + ENDIF + ENDDO + ENDIF + + IF (MATCHES_SCALAR) THEN + ! ensure a proper size for SCNUM (legacy single-METHOD path) + IF (EIG_N2 > LSUB) THEN + LSUB = EIG_N2 + ELSE + ! since we have adaptive lanczos now, we set this to be + ! INITIAL_NEV*(2**MAX_DOUBLINGS), both being 10 and unlikely to be + ! changed unless someone *really* wants more than 10k modes AND + ! doesn't want to specify nmodes manually. + IF (SOL_NAME /= 'BUCKLING') THEN + LSUB = 10240 + END IF END IF - END IF - CALL WRITE_L1M + CALL WRITE_L1M + ENDIF ENDIF diff --git a/Source/LK1/L1A-CC/CC_METH.f90 b/Source/LK1/L1A-CC/CC_METH.f90 index 595de24d..313dbe08 100644 --- a/Source/LK1/L1A-CC/CC_METH.f90 +++ b/Source/LK1/L1A-CC/CC_METH.f90 @@ -30,10 +30,10 @@ SUBROUTINE CC_METH ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : WRT_ERR, ERR, F06 - USE SCONTR, ONLY : WARN_ERR, BLNK_SUB_NAM + USE SCONTR, ONLY : WARN_ERR, BLNK_SUB_NAM, NSUB USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE MODEL_STUF, ONLY : CC_EIGR_SID + USE MODEL_STUF, ONLY : CC_EIGR_SID, CC_EIGR_SID_SUB, CC_EIGR_SID_DECK, IS_MODES_SUBCASE USE CC_METH_USE_IFs @@ -54,25 +54,53 @@ SUBROUTINE CC_METH ( CARD ) CALL GET_SETID ( CARD, SETID ) -! Set CASE CONTROL variable to SETID +! Record per-subcase METHOD assignment so that SOL 103 decks can request a different set of modes for each subcase. +! NSUB is incremented by CC_SUBC at parse time, so: +! * NSUB == 0 -> this METHOD appears above any SUBCASE card; it is the deck-default that any subcase lacking its own +! METHOD inherits during LOADC's post-parse pass. +! * NSUB > 0 -> this METHOD belongs to the current (most-recently-opened) subcase. + + IF (NSUB == 0) THEN + + IF ((CC_EIGR_SID_DECK /= 0) .AND. (CC_EIGR_SID_DECK /= SETID)) THEN + WARN_ERR = WARN_ERR + 1 + WRITE(ERR,8867) CC_EIGR_SID_DECK, SETID + IF (SUPWARN == 'N') THEN + WRITE(F06,8867) CC_EIGR_SID_DECK, SETID + ENDIF + ENDIF + CC_EIGR_SID_DECK = SETID - IF (CC_EIGR_SID == 0) THEN - CC_EIGR_SID = SETID ELSE - CC_EIGR_SID = SETID - WARN_ERR = WARN_ERR+1 - WRITE(ERR,8866) - IF (SUPWARN == 'N') THEN - WRITE(F06,8866) + + IF (ALLOCATED(CC_EIGR_SID_SUB)) THEN + IF ((CC_EIGR_SID_SUB(NSUB) /= 0) .AND. (CC_EIGR_SID_SUB(NSUB) /= SETID)) THEN + WARN_ERR = WARN_ERR + 1 + WRITE(ERR,8868) NSUB, CC_EIGR_SID_SUB(NSUB), SETID + IF (SUPWARN == 'N') THEN + WRITE(F06,8868) NSUB, CC_EIGR_SID_SUB(NSUB), SETID + ENDIF + ENDIF + CC_EIGR_SID_SUB(NSUB) = SETID + IS_MODES_SUBCASE(NSUB) = 'Y' ENDIF + ENDIF +! Maintain the legacy scalar CC_EIGR_SID so existing single-METHOD code paths (BD_EIGR scalar match, WRITE_L1Z, restart +! sanity check, etc.) continue to work unchanged. After LOADC inheritance the scalar reflects the last seen SID. + + CC_EIGR_SID = SETID + RETURN ! ********************************************************************************************************************************** - 8866 FORMAT(' *WARNING : MORE THAN ONE METHOD ENTRY IN CASE CONTROL. LAST ONE READ WILL BE USED') + 8867 FORMAT(' *WARNING : MORE THAN ONE DECK-LEVEL METHOD ENTRY IN CASE CONTROL. PREVIOUS SET ID = ',I8,', NEW SET ID = ',I8, & + '. NEW VALUE WILL BE USED AS THE DECK DEFAULT.') + 8868 FORMAT(' *WARNING : MORE THAN ONE METHOD ENTRY IN SUBCASE ',I8,'. PREVIOUS SET ID = ',I8,', NEW SET ID = ',I8, & + '. NEW VALUE WILL BE USED.') ! ********************************************************************************************************************************** diff --git a/Source/LK1/L1A/LOADC.f90 b/Source/LK1/L1A/LOADC.f90 index 878ea477..c52c575b 100644 --- a/Source/LK1/L1A/LOADC.f90 +++ b/Source/LK1/L1A/LOADC.f90 @@ -33,7 +33,12 @@ SUBROUTINE LOADC RESTART, SOL_NAME USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPINFO, SUPWARN - USE MODEL_STUF, ONLY : CC_EIGR_SID, MEFFMASS_CALC, MPCSET, MPCSETS, MPFACTOR_CALC, SCNUM, SPCSET, SPCSETS, SUBLOD + USE MODEL_STUF, ONLY : CC_EIGR_SID, CC_EIGR_SID_SUB, CC_EIGR_SID_DECK, IS_MODES_SUBCASE, & + MEFFMASS_CALC, MPCSET, MPCSETS, MPFACTOR_CALC, SCNUM, SPCSET, SPCSETS, SUBLOD + USE MODEL_STUF, ONLY : EIG_PARAMS, & + EIG_COMP, EIG_CRIT, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_LANCZOS_NEV_DELT, EIG_METH, & + EIG_MSGLVL, EIG_LAP_MAT_TYPE, EIG_MODE, EIG_N1, EIG_N2, EIG_NCVFACL, EIG_NORM, EIG_SID, & + EIG_SIGMA, EIG_VECS USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRE_LOC, FORC_LOC USE LOADC_USE_IFs @@ -248,6 +253,58 @@ SUBROUTINE LOADC SCNUM(1) = 1 ENDIF + ! Propagate the deck-level METHOD default down to every subcase that does not have its own METHOD. + ! This must happen *after* the NSUB==0 -> NSUB=1 fixup above, so that an "implicit" single subcase still picks + ! up the METHOD declared at the deck level. The deck default is also recorded as the SID for any subcase that + ! omitted METHOD. For SOL types that do not consume eigenvalue extraction the arrays simply stay zero. + IF (ALLOCATED(CC_EIGR_SID_SUB)) THEN + DO I=1,NSUB + IF ((CC_EIGR_SID_SUB(I) == 0) .AND. (CC_EIGR_SID_DECK /= 0)) THEN + CC_EIGR_SID_SUB(I) = CC_EIGR_SID_DECK + IS_MODES_SUBCASE(I) = 'Y' + ENDIF + ENDDO + ! Keep the legacy scalar in sync: prefer the deck default; otherwise the first non-zero per-subcase SID. + IF (CC_EIGR_SID_DECK /= 0) THEN + CC_EIGR_SID = CC_EIGR_SID_DECK + ELSE + DO I=1,NSUB + IF (CC_EIGR_SID_SUB(I) /= 0) THEN + CC_EIGR_SID = CC_EIGR_SID_SUB(I) + EXIT + ENDIF + ENDDO + ENDIF + + ! Final fallback: for any subcase whose EIG_PARAMS slot is still empty (could happen when NSUB was 0 at the + ! time BD_EIGR/BD_EIGRL ran -- e.g. a deck with a deck-level METHOD and no SUBCASE cards), copy the values + ! from the legacy EIG_* scalars. After BD_EIGR/BD_EIGRL has WRITTEN L1M for the canonical (scalar-match) card, + ! those scalars hold that card's data, which is exactly what an inherited subcase should use. + IF (ALLOCATED(EIG_PARAMS)) THEN + DO I=1,NSUB + IF ((CC_EIGR_SID_SUB(I) /= 0) .AND. (EIG_PARAMS(I)%SID == 0)) THEN + EIG_PARAMS(I)%METHOD = EIG_METH + EIG_PARAMS(I)%NORM = EIG_NORM + EIG_PARAMS(I)%LAP_MAT_TYPE = EIG_LAP_MAT_TYPE + EIG_PARAMS(I)%VECS = EIG_VECS + EIG_PARAMS(I)%SID = CC_EIGR_SID_SUB(I) + EIG_PARAMS(I)%N1 = EIG_N1 + EIG_PARAMS(I)%N2 = EIG_N2 + EIG_PARAMS(I)%COMP = EIG_COMP + EIG_PARAMS(I)%GRID = EIG_GRID + EIG_PARAMS(I)%LANCZOS_NEV_DELT = EIG_LANCZOS_NEV_DELT + EIG_PARAMS(I)%MODE = EIG_MODE + EIG_PARAMS(I)%MSGLVL = EIG_MSGLVL + EIG_PARAMS(I)%NCVFACL = EIG_NCVFACL + EIG_PARAMS(I)%CRIT = EIG_CRIT + EIG_PARAMS(I)%FRQ1 = EIG_FRQ1 + EIG_PARAMS(I)%FRQ2 = EIG_FRQ2 + EIG_PARAMS(I)%SIGMA = EIG_SIGMA + ENDIF + ENDDO + ENDIF + ENDIF + ! If SOL is modes or CB or buckilng, then a METH card should have been found in Case Control IF ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN_CB_MODEL') .OR. (SOL_NAME(1:8) == 'BUCKLING')) THEN IF (CC_EIGR_SID == 0) THEN diff --git a/Source/LK4/LINK4.f90 b/Source/LK4/LINK4.f90 index f9565406..66d2a9fd 100644 --- a/Source/LK4/LINK4.f90 +++ b/Source/LK4/LINK4.f90 @@ -55,15 +55,17 @@ SUBROUTINE LINK4 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, ERRSTAT, F06, L1M, L3A, SC1 USE IOUNT1, ONLY : LINK1M, LINK2I, LINK3A, L1M_MSG, L3A_MSG - USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, FATAL_ERR, LINKNO, MBUG, NDOFL, & + USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, FATAL_ERR, LINKNO, MBUG, NDOFL, NSUB, & NTERM_KLL, NTERM_KLLD, NTERM_KLLDn, & NTERM_MLL, NTERM_MLLn, & - NVEC, NUM_EIGENS, NUM_KLLD_DIAG_ZEROS, NUM_MLL_DIAG_ZEROS, SOL_NAME, WARN_ERR + NVEC, NUM_EIGENS, NUM_KLLD_DIAG_ZEROS, NUM_MLL_DIAG_ZEROS, SOL_NAME, WARN_ERR, & + MODE_SUBCASE, NUM_MODES_SUBS, TOTAL_MODES USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EPSIL, SOLLIB, SPARSTOR, SUPINFO USE MODEL_STUF, ONLY : EIG_COMP, EIG_CRIT, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_METH, EIG_MSGLVL, EIG_LAP_MAT_TYPE, & EIG_MODE, EIG_N1, EIG_N2, EIG_NCVFACL, EIG_NORM, EIG_SID, EIG_SIGMA, EIG_VECS, MAXMIJ, & - MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT + MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT, EIG_PARAMS, IS_MODES_SUBCASE, NUM_EIGENS_SUB, & + CC_EIGR_SID USE SPARSE_MATRICES, ONLY : I_KLL, J_KLL, KLL, I_KLLD, J_KLLD, KLLD, I_KLLDn, J_KLLDn, KLLDn, & I_MLL, J_MLL, MLL, I_MLLn, J_MLLn, MLLn @@ -85,6 +87,16 @@ SUBROUTINE LINK4 INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN. INTEGER(LONG), PARAMETER :: P_LINKNO = 2 ! Prior LINK no's that should have run before this LINK can execute. + ! Multi-subcase modes-loop locals (per-subcase eigensolve dispatch for SOL 103 with multiple METHODs) + INTEGER(LONG) :: CUR_ISUB ! Subcase index currently being solved + INTEGER(LONG) :: CANONICAL_ISUB ! Subcase whose EIGR/EIGRL params were written to L1M + INTEGER(LONG) :: N_MODES_ITER ! Number of solver iterations (= max(1, NUM_MODES_SUBS)) + INTEGER(LONG) :: ITER, KCNT, KMODE, IDX, TOTAL_MODES_LOCAL + INTEGER(LONG) :: NTERM_KLL_BAK ! Backup of NTERM_KLL for multi-iter restore + INTEGER(LONG), ALLOCATABLE :: I_KLL_BAK(:) ! Shadow of I_KLL across solver iterations (eigensolver deallocates KLL) + INTEGER(LONG), ALLOCATABLE :: J_KLL_BAK(:) ! Shadow of J_KLL across solver iterations + REAL(DOUBLE), ALLOCATABLE :: KLL_BAK(:) ! Shadow of KLL across solver iterations + REAL(DOUBLE) :: EPS1 ! Small number to compare variables against zero. REAL(DOUBLE) :: EIGEN_VEC_COL(NDOFL)! One eigenvector put into a 1-D array. LOGICAL :: WRITE_MLL ! write the MLL matrix @@ -260,82 +272,289 @@ SUBROUTINE LINK4 ! ********************************************************************************************************************************** - ! Solve eigenvalue problem - IF ((EIG_METH(1:3) == 'GIV') .OR. (EIG_METH(1:4) == 'MGIV')) THEN - CALL EIG_GIV_MGIV + ! Identify modes-subcases for SOL 103. For BUCKLING / GEN CB MODEL the loop below runs exactly once with whatever scalars are + ! already loaded from L1M (legacy behavior preserved). For SOL 103, we iterate per modes-subcase and capture each subcase's + ! eigenresults into EIG_PARAMS(:); after the loop the scratch EIGEN_VAL/VEC/MODE_NUM/GEN_MASS are concatenated across subcases + ! so the downstream L3A write and LINK5/LINK9 can see the full mode set with MODE_SUBCASE giving per-mode subcase attribution. + NUM_MODES_SUBS = 0 + CANONICAL_ISUB = 0 + IF ((SOL_NAME(1:5) == 'MODES') .AND. ALLOCATED(IS_MODES_SUBCASE)) THEN + DO I=1,NSUB + IF (IS_MODES_SUBCASE(I) == 'Y') THEN + NUM_MODES_SUBS = NUM_MODES_SUBS + 1 + ! Canonical = first modes-subcase whose EIG_PARAMS%SID matches the L1M scalar CC_EIGR_SID + IF ((CANONICAL_ISUB == 0) .AND. (EIG_PARAMS(I)%SID == CC_EIGR_SID)) THEN + CANONICAL_ISUB = I + ENDIF + ENDIF + ENDDO + ! Fallback: if no SID match found (shouldn't happen given LOADC sync), use first modes-subcase + IF (CANONICAL_ISUB == 0) THEN + DO I=1,NSUB + IF (IS_MODES_SUBCASE(I) == 'Y') THEN + CANONICAL_ISUB = I + EXIT + ENDIF + ENDDO + ENDIF + ENDIF + IF (CANONICAL_ISUB == 0) CANONICAL_ISUB = 1 + + N_MODES_ITER = MAX(1, NUM_MODES_SUBS) + + ! For multi-iter MODES solves we need to preserve KLL across iterations because EIG_LANCZOS_ARPACK destructively + ! deallocates KLL mid-solve. Snapshot the CSR triple once here; restore at the head of iterations 2+. + IF (N_MODES_ITER > 1) THEN + NTERM_KLL_BAK = NTERM_KLL + ALLOCATE(I_KLL_BAK(NDOFL+1)) + ALLOCATE(J_KLL_BAK(NTERM_KLL)) + ALLOCATE(KLL_BAK(NTERM_KLL)) + I_KLL_BAK = I_KLL + J_KLL_BAK = J_KLL + KLL_BAK = KLL + ENDIF - ELSE IF (EIG_METH(1:3) == 'INV') THEN - CALL EIG_INV_PWR + ! Modes-subcase solver loop +m_lp: DO ITER = 1, N_MODES_ITER + + ! Restore KLL from shadow at the start of iterations 2+ (EIG_LANCZOS_ARPACK deallocated it during iter 1) + IF (ITER > 1) THEN + NTERM_KLL = NTERM_KLL_BAK + IF (.NOT. ALLOCATED(I_KLL)) ALLOCATE(I_KLL(NDOFL+1)) + IF (.NOT. ALLOCATED(J_KLL)) ALLOCATE(J_KLL(NTERM_KLL)) + IF (.NOT. ALLOCATED(KLL)) ALLOCATE(KLL(NTERM_KLL)) + I_KLL = I_KLL_BAK + J_KLL = J_KLL_BAK + KLL = KLL_BAK + ENDIF - ELSE IF (EIG_METH(1:7) == 'LANCZOS') THEN - ! Use adaptive version if frequency range specified and not BUCKLING/GEN CB MODEL - IF ((EIG_FRQ2 > EPS1) .AND. (SOL_NAME(1:8) /= 'BUCKLING') .AND. (SOL_NAME(1:12) /= 'GEN CB MODEL')) THEN - CALL EIG_LANCZOS_ARPACK_ADAPTIVE + ! Determine which subcase this iteration solves + IF (NUM_MODES_SUBS == 0) THEN + CUR_ISUB = CANONICAL_ISUB ! BUCKLING / GEN CB MODEL / single-shot legacy ELSE - CALL EIG_LANCZOS_ARPACK + KCNT = 0 + CUR_ISUB = CANONICAL_ISUB + DO I=1,NSUB + IF (IS_MODES_SUBCASE(I) == 'Y') THEN + KCNT = KCNT + 1 + IF (KCNT == ITER) THEN + CUR_ISUB = I + EXIT + ENDIF + ENDIF + ENDDO + + ! Load EIG_* scalars from EIG_PARAMS(CUR_ISUB) so the eigensolvers see this subcase's params + EIG_SID = EIG_PARAMS(CUR_ISUB)%SID + EIG_METH = EIG_PARAMS(CUR_ISUB)%METHOD + EIG_NORM = EIG_PARAMS(CUR_ISUB)%NORM + EIG_GRID = EIG_PARAMS(CUR_ISUB)%GRID + EIG_COMP = EIG_PARAMS(CUR_ISUB)%COMP + EIG_FRQ1 = EIG_PARAMS(CUR_ISUB)%FRQ1 + EIG_FRQ2 = EIG_PARAMS(CUR_ISUB)%FRQ2 + EIG_N1 = EIG_PARAMS(CUR_ISUB)%N1 + EIG_N2 = EIG_PARAMS(CUR_ISUB)%N2 + EIG_NCVFACL = EIG_PARAMS(CUR_ISUB)%NCVFACL + EIG_MSGLVL = EIG_PARAMS(CUR_ISUB)%MSGLVL + EIG_MODE = EIG_PARAMS(CUR_ISUB)%MODE + EIG_VECS = EIG_PARAMS(CUR_ISUB)%VECS + EIG_CRIT = EIG_PARAMS(CUR_ISUB)%CRIT + EIG_SIGMA = EIG_PARAMS(CUR_ISUB)%SIGMA + EIG_LAP_MAT_TYPE = EIG_PARAMS(CUR_ISUB)%LAP_MAT_TYPE ENDIF - ELSE + ! Solve eigenvalue problem + IF ((EIG_METH(1:3) == 'GIV') .OR. (EIG_METH(1:4) == 'MGIV')) THEN + CALL EIG_GIV_MGIV - WRITE(ERR,4005) SUBR_NAME, EIG_METH - WRITE(F06,4005) SUBR_NAME, EIG_METH - FATAL_ERR = FATAL_ERR + 1 - CALL OUTA_HERE ( 'Y' ) ! Coding error, so quit + ELSE IF (EIG_METH(1:3) == 'INV') THEN + CALL EIG_INV_PWR - ENDIF + ELSE IF (EIG_METH(1:7) == 'LANCZOS') THEN + ! Use adaptive version if frequency range specified and not BUCKLING/GEN CB MODEL + IF ((EIG_FRQ2 > EPS1) .AND. (SOL_NAME(1:8) /= 'BUCKLING') .AND. (SOL_NAME(1:12) /= 'GEN CB MODEL')) THEN + CALL EIG_LANCZOS_ARPACK_ADAPTIVE + ELSE + CALL EIG_LANCZOS_ARPACK + ENDIF - IF (SOL_NAME(1:12) /= 'GEN CB MODEL') THEN - !xx WRITE(SC1, * ) ! Advance 1 line for screen messages - IF (SOL_NAME(1:8) == 'BUCKLING') THEN - WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KLLD', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'KLLD' ) ELSE - WRITE(SC1,12345,ADVANCE='NO') ' Deallocate MLL ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'MLL' ) + + WRITE(ERR,4005) SUBR_NAME, EIG_METH + WRITE(F06,4005) SUBR_NAME, EIG_METH + FATAL_ERR = FATAL_ERR + 1 + CALL OUTA_HERE ( 'Y' ) ! Coding error, so quit + ENDIF - ENDIF - ! Calc generalized masses and renorm eigenvectors to mass (users renorm is done in LINK5) - NUM_FAIL_CRIT = 0 - MAXMIJ = 0 - MIJ_ROW = 0 - MIJ_COL = 0 + ! For BUCKLING (always single-iter) we can deallocate KLLD inline. For MODES we keep MLL alive across iterations + ! and dealloc it after the loop, since each iteration's eigensolver needs MLL/MLLn for the eigenproblem. + IF (SOL_NAME(1:12) /= 'GEN CB MODEL') THEN + IF (SOL_NAME(1:8) == 'BUCKLING') THEN + WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KLLD', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'KLLD' ) + ENDIF + ENDIF + + ! Calc generalized masses and renorm eigenvectors to mass (users renorm is done in LINK5) + NUM_FAIL_CRIT = 0 + MAXMIJ = 0 + MIJ_ROW = 0 + MIJ_COL = 0 + + CALL ALLOCATE_EIGEN1_MAT ( 'GEN_MASS', NUM_EIGENS, 1, SUBR_NAME ) + + IF (NVEC > 0) THEN + ! Calc gen mass + CALL LINK_MESSAGE('CALCULATE GENERALIZED MASS') + CALL CALC_GEN_MASS + + IF (EIG_NORM == 'MASS') THEN + ! Renorm vecs to mass if user asked for 'MASS'. + CALL LINK_MESSAGE('RENORMALIZE EIGENVECTORS TO UNIT GEN MASS') + CALL RENORM_ON_MASS ( NVEC, EPS1 ) + ENDIF - CALL ALLOCATE_EIGEN1_MAT ( 'GEN_MASS', NUM_EIGENS, 1, SUBR_NAME ) + ELSE - IF (NVEC > 0) THEN - ! Calc gen mass - CALL LINK_MESSAGE('CALCULATE GENERALIZED MASS') - CALL CALC_GEN_MASS + DO I=1,NUM_EIGENS + GEN_MASS(I) = ZERO + ENDDO - IF (EIG_NORM == 'MASS') THEN - ! Renorm vecs to mass if user asked for 'MASS'. - CALL LINK_MESSAGE('RENORMALIZE EIGENVECTORS TO UNIT GEN MASS') - CALL RENORM_ON_MASS ( NVEC, EPS1 ) ENDIF - ELSE + ! BUCKLING is single-iter, so KLLDn dealloc is safe here. MLLn is deferred to after the loop for MODES. + IF (SOL_NAME(1:8) == 'BUCKLING') THEN + WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KLLDn', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'KLLDn' ) + ENDIF - DO I=1,NUM_EIGENS - GEN_MASS(I) = ZERO - ENDDO + ! Capture this subcase's eigenresults into EIG_PARAMS(CUR_ISUB) + IF (NUM_MODES_SUBS > 0) THEN + IF (ALLOCATED(EIG_PARAMS(CUR_ISUB)%EIGEN_VAL)) DEALLOCATE(EIG_PARAMS(CUR_ISUB)%EIGEN_VAL) + IF (ALLOCATED(EIG_PARAMS(CUR_ISUB)%MODE_NUM)) DEALLOCATE(EIG_PARAMS(CUR_ISUB)%MODE_NUM) + IF (ALLOCATED(EIG_PARAMS(CUR_ISUB)%GEN_MASS)) DEALLOCATE(EIG_PARAMS(CUR_ISUB)%GEN_MASS) + IF (ALLOCATED(EIG_PARAMS(CUR_ISUB)%EIGEN_VEC)) DEALLOCATE(EIG_PARAMS(CUR_ISUB)%EIGEN_VEC) + ALLOCATE(EIG_PARAMS(CUR_ISUB)%EIGEN_VAL(NUM_EIGENS)) + ALLOCATE(EIG_PARAMS(CUR_ISUB)%MODE_NUM(NUM_EIGENS)) + ALLOCATE(EIG_PARAMS(CUR_ISUB)%GEN_MASS(NUM_EIGENS)) + ALLOCATE(EIG_PARAMS(CUR_ISUB)%EIGEN_VEC(NDOFL, MAX(1,NVEC))) + EIG_PARAMS(CUR_ISUB)%EIGEN_VAL(1:NUM_EIGENS) = EIGEN_VAL(1:NUM_EIGENS) + EIG_PARAMS(CUR_ISUB)%MODE_NUM(1:NUM_EIGENS) = MODE_NUM(1:NUM_EIGENS) + EIG_PARAMS(CUR_ISUB)%GEN_MASS(1:NUM_EIGENS) = GEN_MASS(1:NUM_EIGENS) + IF (NVEC > 0) THEN + EIG_PARAMS(CUR_ISUB)%EIGEN_VEC(1:NDOFL,1:NVEC) = EIGEN_VEC(1:NDOFL,1:NVEC) + ENDIF + EIG_PARAMS(CUR_ISUB)%NUM_EIGENS = NUM_EIGENS + EIG_PARAMS(CUR_ISUB)%NVEC = NVEC + EIG_PARAMS(CUR_ISUB)%NUM_FAIL_CRIT = NUM_FAIL_CRIT + EIG_PARAMS(CUR_ISUB)%MAXMIJ = MAXMIJ + EIG_PARAMS(CUR_ISUB)%MIJ_ROW = MIJ_ROW + EIG_PARAMS(CUR_ISUB)%MIJ_COL = MIJ_COL + NUM_EIGENS_SUB(CUR_ISUB) = NUM_EIGENS + ENDIF + + ! Write eigenvalue analysis summary to output file (per-subcase summary in the multi-METHOD case) + IF ((EIG_NORM == 'MASS ') .OR. (EIG_NORM == 'NONE')) THEN + CALL LINK_MESSAGE('WRITE EIGENVALUE SUMMARY TO OUTFIL') + CALL EIG_SUMMARY + ENDIF + + ! If more iterations remain, free scratch eigen arrays and Lanczos workspaces so the next iteration can re-allocate cleanly + IF (ITER < N_MODES_ITER) THEN + CALL DEALLOCATE_EIGEN1_MAT ( 'EIGEN_VAL' ) + CALL DEALLOCATE_EIGEN1_MAT ( 'EIGEN_VEC' ) + CALL DEALLOCATE_EIGEN1_MAT ( 'MODE_NUM' ) + CALL DEALLOCATE_EIGEN1_MAT ( 'GEN_MASS' ) + CALL DEALLOCATE_LAPACK_MAT ( 'ABAND' ) + CALL DEALLOCATE_LAPACK_MAT ( 'BBAND' ) + CALL DEALLOCATE_LAPACK_MAT ( 'RFAC' ) + ENDIF + ENDDO m_lp + + ! Deferred MLL/MLLn deallocations for the MODES path (BUCKLING already did KLLD/KLLDn inline above; GEN CB MODEL skips entirely) + IF ((SOL_NAME(1:5) == 'MODES')) THEN + IF (ALLOCATED(MLL)) THEN + WRITE(SC1,12345,ADVANCE='NO') ' Deallocate MLL ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'MLL' ) + ENDIF + IF (ALLOCATED(MLLn)) THEN + WRITE(SC1,12345,ADVANCE='NO') ' Deallocate MLLn ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'MLLn' ) + ENDIF ENDIF -!xx WRITE(SC1, * ) ! Advance 1 line for screen messages - IF (SOL_NAME(1:8) == 'BUCKLING') THEN - WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KLLDn', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'KLLDn' ) + ! Free the multi-iter KLL shadow + IF (ALLOCATED(I_KLL_BAK)) DEALLOCATE(I_KLL_BAK) + IF (ALLOCATED(J_KLL_BAK)) DEALLOCATE(J_KLL_BAK) + IF (ALLOCATED(KLL_BAK)) DEALLOCATE(KLL_BAK) + + ! Concatenate per-subcase eigenresults into the scratch arrays so downstream L3A / LINK5 / LINK9 see the full mode set. + ! Also populate MODE_SUBCASE so LINK9 can attribute each mode to its owning subcase. + IF (NUM_MODES_SUBS > 1) THEN + TOTAL_MODES_LOCAL = 0 + DO I=1,NSUB + IF (IS_MODES_SUBCASE(I) == 'Y') TOTAL_MODES_LOCAL = TOTAL_MODES_LOCAL + NUM_EIGENS_SUB(I) + ENDDO + TOTAL_MODES = TOTAL_MODES_LOCAL + + CALL DEALLOCATE_EIGEN1_MAT ( 'EIGEN_VAL' ) + CALL DEALLOCATE_EIGEN1_MAT ( 'EIGEN_VEC' ) + CALL DEALLOCATE_EIGEN1_MAT ( 'MODE_NUM' ) + CALL DEALLOCATE_EIGEN1_MAT ( 'GEN_MASS' ) + CALL ALLOCATE_EIGEN1_MAT ( 'EIGEN_VAL', TOTAL_MODES_LOCAL, 1, SUBR_NAME ) + CALL ALLOCATE_EIGEN1_MAT ( 'EIGEN_VEC', NDOFL, TOTAL_MODES_LOCAL, SUBR_NAME ) + CALL ALLOCATE_EIGEN1_MAT ( 'MODE_NUM', TOTAL_MODES_LOCAL, 1, SUBR_NAME ) + CALL ALLOCATE_EIGEN1_MAT ( 'GEN_MASS', TOTAL_MODES_LOCAL, 1, SUBR_NAME ) + + IF (ALLOCATED(MODE_SUBCASE)) DEALLOCATE(MODE_SUBCASE) + ALLOCATE(MODE_SUBCASE(TOTAL_MODES_LOCAL)) + + IDX = 0 + DO I=1,NSUB + IF (IS_MODES_SUBCASE(I) /= 'Y') CYCLE + DO KMODE = 1, NUM_EIGENS_SUB(I) + IDX = IDX + 1 + EIGEN_VAL(IDX) = EIG_PARAMS(I)%EIGEN_VAL(KMODE) + MODE_NUM(IDX) = IDX + GEN_MASS(IDX) = EIG_PARAMS(I)%GEN_MASS(KMODE) + EIGEN_VEC(1:NDOFL,IDX) = EIG_PARAMS(I)%EIGEN_VEC(1:NDOFL,KMODE) + MODE_SUBCASE(IDX) = I + ENDDO + ENDDO + NUM_EIGENS = TOTAL_MODES_LOCAL + NVEC = TOTAL_MODES_LOCAL ELSE - WRITE(SC1,12345,ADVANCE='NO') ' Deallocate MLLn ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'MLLn' ) + ! Single-iter path: trivial MODE_SUBCASE mapping + IF (ALLOCATED(MODE_SUBCASE)) DEALLOCATE(MODE_SUBCASE) + ALLOCATE(MODE_SUBCASE(MAX(1, NUM_EIGENS))) + MODE_SUBCASE = CANONICAL_ISUB + TOTAL_MODES = NUM_EIGENS ENDIF - ! Write data to L1M - CALL WRITE_L1M - - ! Write eigenvalue analysis summary to output file - ! if DEBUG requested them or if renormalization is on 'MASS' or 'NONE' - IF ((EIG_NORM == 'MASS ') .OR. (EIG_NORM == 'NONE')) THEN - CALL LINK_MESSAGE('WRITE EIGENVALUE SUMMARY TO OUTFIL') - CALL EIG_SUMMARY + ! Restore canonical-subcase EIG_* scalars and write L1M (only once, after the loop, so the file holds the global mode count + ! and canonical params). LINK5 / LINK9 read L1M for the scalars and the global eigen list, then use EIG_PARAMS(MODE_SUBCASE(J)) + ! for per-mode subcase attribution where needed. + IF (NUM_MODES_SUBS > 0) THEN + EIG_SID = EIG_PARAMS(CANONICAL_ISUB)%SID + EIG_METH = EIG_PARAMS(CANONICAL_ISUB)%METHOD + EIG_NORM = EIG_PARAMS(CANONICAL_ISUB)%NORM + EIG_GRID = EIG_PARAMS(CANONICAL_ISUB)%GRID + EIG_COMP = EIG_PARAMS(CANONICAL_ISUB)%COMP + EIG_FRQ1 = EIG_PARAMS(CANONICAL_ISUB)%FRQ1 + EIG_FRQ2 = EIG_PARAMS(CANONICAL_ISUB)%FRQ2 + EIG_N1 = EIG_PARAMS(CANONICAL_ISUB)%N1 + EIG_N2 = EIG_PARAMS(CANONICAL_ISUB)%N2 + EIG_NCVFACL = EIG_PARAMS(CANONICAL_ISUB)%NCVFACL + EIG_MSGLVL = EIG_PARAMS(CANONICAL_ISUB)%MSGLVL + EIG_MODE = EIG_PARAMS(CANONICAL_ISUB)%MODE + EIG_VECS = EIG_PARAMS(CANONICAL_ISUB)%VECS + EIG_CRIT = EIG_PARAMS(CANONICAL_ISUB)%CRIT + EIG_SIGMA = EIG_PARAMS(CANONICAL_ISUB)%SIGMA + EIG_LAP_MAT_TYPE = EIG_PARAMS(CANONICAL_ISUB)%LAP_MAT_TYPE + NUM_FAIL_CRIT = EIG_PARAMS(CANONICAL_ISUB)%NUM_FAIL_CRIT + MAXMIJ = EIG_PARAMS(CANONICAL_ISUB)%MAXMIJ + MIJ_ROW = EIG_PARAMS(CANONICAL_ISUB)%MIJ_ROW + MIJ_COL = EIG_PARAMS(CANONICAL_ISUB)%MIJ_COL ENDIF + CALL WRITE_L1M ! Open and set up file L3A (used to hold eigenvectors) CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'REPLACE', L3A_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) diff --git a/Source/LK9/LINK9/LINK9.f90 b/Source/LK9/LINK9/LINK9.f90 index 0165e61a..f832a741 100644 --- a/Source/LK9/LINK9/LINK9.f90 +++ b/Source/LK9/LINK9/LINK9.f90 @@ -54,7 +54,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) NROWS_OTM_ACCE, NROWS_OTM_DISP, NROWS_OTM_MPCF, NROWS_OTM_SPCF, & NROWS_OTM_ELFE, NROWS_OTM_ELFN, NROWS_OTM_STRE, NROWS_OTM_STRN, & NROWS_TXT_ACCE, NROWS_TXT_DISP, NROWS_TXT_MPCF, NROWS_TXT_SPCF, & - NROWS_TXT_ELFE, NROWS_TXT_ELFN, NROWS_TXT_STRE, NROWS_TXT_STRN, RESTART, SOL_NAME, WARN_ERR + NROWS_TXT_ELFE, NROWS_TXT_ELFN, NROWS_TXT_STRE, NROWS_TXT_STRN, RESTART, SOL_NAME, WARN_ERR, & + MODE_SUBCASE USE SCONTR, ONLY : GROUT_ACCE_BIT, GROUT_DISP_BIT, GROUT_OLOA_BIT, GROUT_SPCF_BIT, GROUT_MPCF_BIT, & GROUT_GPFO_BIT, ELOUT_ELFN_BIT, ELOUT_ELFE_BIT, ELOUT_STRE_BIT, ELOUT_STRN_BIT, & @@ -675,7 +676,13 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) FEMAP_SET_ID = LK9_PROC_NUM ELSE IF (SOL_NAME(1: 5) == 'MODES') THEN - INT_SC_NUM = 1 + ! Each mode is attributed to its owning subcase via MODE_SUBCASE (populated in LINK4). For legacy single-METHOD + ! decks MODE_SUBCASE is uniformly the canonical subcase, so behaviour matches the original INT_SC_NUM=1 fallback. + IF (ALLOCATED(MODE_SUBCASE) .AND. (JVEC <= SIZE(MODE_SUBCASE))) THEN + INT_SC_NUM = MODE_SUBCASE(JVEC) + ELSE + INT_SC_NUM = 1 + ENDIF FEMAP_SET_ID = JVEC ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN diff --git a/Source/Modules/MODEL_STUF.f90 b/Source/Modules/MODEL_STUF.f90 index e9b895df..85c23382 100644 --- a/Source/Modules/MODEL_STUF.f90 +++ b/Source/Modules/MODEL_STUF.f90 @@ -1808,6 +1808,65 @@ MODULE MODEL_STUF REAL(DOUBLE) :: MAXMIJ = ZERO ! Largest off-diag term in generalized mass matrix. ! ********************************************************************************************************************************** +! Per-subcase eigenvalue extraction parameters (Feature A: SOL 103 multi-METHOD). +! +! The legacy EIG_* scalars above remain as the "currently active" view used by the eigensolvers (EIG_LANCZOS_ARPACK*, +! EIG_GIV_MGIV, EIG_INV_PWR, etc.). When more than one modes-subcase exists with distinct METHOD requests, LINK4 loops +! over the modes-subcases and copies the per-subcase parameters from EIG_PARAMS(isub) into those scalars at the head of +! each iteration. Results are captured back into the per-subcase arrays at the bottom of the iteration. +! +! For legacy single-METHOD decks, EIG_PARAMS(1) holds the same data as the scalars and the loop runs exactly once. + + TYPE EIG_PARAMS_TYPE + CHARACTER(LEN=JCARD_LEN) :: METHOD = ' ' + CHARACTER(LEN=JCARD_LEN) :: NORM = 'MASS' + CHARACTER(LEN=JCARD_LEN) :: LAP_MAT_TYPE = 'DPB' + CHARACTER(1*BYTE) :: VECS = 'Y' + INTEGER(LONG) :: SID = 0 ! EIGR/EIGRL set ID resolved from CC METHOD + INTEGER(LONG) :: N1 = 0 + INTEGER(LONG) :: N2 = 0 + INTEGER(LONG) :: COMP = 0 + INTEGER(LONG) :: GRID = 0 + INTEGER(LONG) :: LANCZOS_NEV_DELT = 2 + INTEGER(LONG) :: MODE = 2 + INTEGER(LONG) :: MSGLVL = 0 + INTEGER(LONG) :: NCVFACL = 3 + REAL(DOUBLE) :: CRIT = ZERO + REAL(DOUBLE) :: FRQ1 = ZERO + REAL(DOUBLE) :: FRQ2 = ZERO + REAL(DOUBLE) :: SIGMA = -ONE + ! Results captured from the eigensolver run for this subcase: + INTEGER(LONG) :: NUM_EIGENS = 0 ! No. of eigenvalues actually extracted + INTEGER(LONG) :: NVEC = 0 ! No. of eigenvectors retained + INTEGER(LONG) :: NUM_FAIL_CRIT = 0 + INTEGER(LONG) :: MIJ_ROW = 0 + INTEGER(LONG) :: MIJ_COL = 0 + REAL(DOUBLE) :: MAXMIJ = ZERO + ! Per-subcase result buffers, populated by LINK4 inside the modes-subcase loop. They are sized exactly to + ! NUM_EIGENS at solve time, so memory is not wasted on subcases that ask for fewer modes than the deck maximum. + REAL(DOUBLE) , ALLOCATABLE :: EIGEN_VAL(:) ! (NUM_EIGENS) + INTEGER(LONG) , ALLOCATABLE :: MODE_NUM(:) ! (NUM_EIGENS) extraction order index for each mode + REAL(DOUBLE) , ALLOCATABLE :: GEN_MASS(:) ! (NUM_EIGENS) generalized masses + REAL(DOUBLE) , ALLOCATABLE :: EIGEN_VEC(:,:) ! (NDOFL, NVEC) + ! Reserved for STATSUB (feature B): static subcase id whose stiffness is used as the prestress source. + ! Default 0 = legacy BUCKLING single-prestress mechanism. + INTEGER(LONG) :: STATSUB_REF = 0 + END TYPE EIG_PARAMS_TYPE + + TYPE(EIG_PARAMS_TYPE), ALLOCATABLE :: EIG_PARAMS(:) ! Sized LSUB; index by internal subcase number + INTEGER(LONG) , ALLOCATABLE :: CC_EIGR_SID_SUB(:) ! Per-subcase METHOD set ID (0 if subcase has no METHOD). +! Populated by CC_METH; for subcases lacking a METHOD card, +! the deck-default (METHOD declared above any SUBCASE) is +! propagated by the post-parse inheritance pass. + INTEGER(LONG) :: CC_EIGR_SID_DECK = 0 +! METHOD SID declared above the first SUBCASE card (deck-default) + CHARACTER(1*BYTE) , ALLOCATABLE :: IS_MODES_SUBCASE(:) +! 'Y' for each modes-subcase (has a resolved METHOD); 'N' otherwise. + +! Per-subcase eigen result tally (allocated alongside EIG_PARAMS by ALLOCATE_MODEL_STUF). The full per-subcase result +! buffers live as allocatable components inside EIG_PARAMS(ISUB). + INTEGER(LONG) , ALLOCATABLE :: NUM_EIGENS_SUB(:) ! No. of eigenvalues extracted per modes-subcase +! ********************************************************************************************************************************** ! Rigid element ID's INTEGER(LONG), ALLOCATABLE :: RIGID_ELEM_IDS(:) ! Rigid element ID's diff --git a/Source/Modules/SCONTR.f90 b/Source/Modules/SCONTR.f90 index 6bc14654..cbdb26a9 100644 --- a/Source/Modules/SCONTR.f90 +++ b/Source/Modules/SCONTR.f90 @@ -294,6 +294,12 @@ MODULE SCONTR INTEGER(LONG) :: NSPOINT = 0 ! Count of no. of SPOINT's INTEGER(LONG) :: NUM_SPCSIDS = 0 ! The number of SPC set ID's called for in an execution INTEGER(LONG) :: NSUB = 0 ! Count of no. of subcases + INTEGER(LONG) :: NUM_MODES_SUBS = 0 ! Count of subcases that have a resolved METHOD (modes-subcases) + INTEGER(LONG) :: TOTAL_MODES = 0 ! sum(NUM_EIGENS_SUB(:)) = total eigenvectors across all modes-subs + INTEGER(LONG), ALLOCATABLE :: MODE_SUBCASE(:) ! Length = TOTAL_MODES. Maps each global mode index (the JVEC +! iteration in LINK5/LINK9) to its owning internal subcase index. +! For legacy single-METHOD SOL 103 decks this is just +! MODE_SUBCASE(:) = 1. INTEGER(LONG) :: NTCARD = 0 ! Count of no. of TEMP/TEMPRB/TEMPP1 cards written to filename.L1K INTEGER(LONG) :: NTDAT = 0 ! Count of no. of rows that go into array TDATA INTEGER(LONG) :: NTERM_ALL = 0 ! Count of no. of terms in ALL matrix diff --git a/Source/UTIL/ALLOCATE_MODEL_STUF.f90 b/Source/UTIL/ALLOCATE_MODEL_STUF.f90 index e1962c2d..789e7ada 100644 --- a/Source/UTIL/ALLOCATE_MODEL_STUF.f90 +++ b/Source/UTIL/ALLOCATE_MODEL_STUF.f90 @@ -70,6 +70,7 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) USE MODEL_STUF, ONLY : ALL_SETS_ARRAY, ONE_SET_ARRAY, SETS_IDS, SC_ACCE, SC_DISP, SC_ELFN, SC_ELFE, SC_GPFO, & SC_MPCF, SC_OLOA, SC_SPCF, SC_STRE, SC_STRN, LOAD_SIDS, LOAD_FACS USE MODEL_STUF, ONLY : ELDT, ELOUT, GROUT, OELOUT, OGROUT, LABEL, SCNUM, STITLE, SUBLOD, TITLE + USE MODEL_STUF, ONLY : CC_EIGR_SID_SUB, EIG_PARAMS, EIG_PARAMS_TYPE, IS_MODES_SUBCASE, NUM_EIGENS_SUB USE MODEL_STUF, ONLY : SYS_LOAD USE MODEL_STUF, ONLY : CETEMP, CETEMP_ERR, CGTEMP, CGTEMP_ERR, ETEMP, ETEMP_INIT, GTEMP, GTEMP_INIT, TDATA, TPNT USE MODEL_STUF, ONLY : RIGID_ELEM_IDS @@ -530,6 +531,62 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) ENDIF ENDIF + ! Piggy-back the per-subcase METHOD/eigen-parameter arrays on SCNUM. Their lifetime exactly matches SCNUM's, + ! and any code path that allocates SCNUM needs these too. The per-mode result arrays (EIGEN_VAL_SUB, etc.) + ! are allocated separately by LINK4 once NDOFL and the per-subcase mode counts are known. + IF (.NOT. ALLOCATED(CC_EIGR_SID_SUB)) THEN + ALLOCATE (CC_EIGR_SID_SUB(LSUB), STAT=IERR) + IF (IERR == 0) THEN + DO I=1,LSUB + CC_EIGR_SID_SUB(I) = 0 + ENDDO + ELSE + WRITE(ERR,991) 0.0D0, 'CC_EIGR_SID_SUB', SUBR_NAME, IERR + WRITE(F06,991) 0.0D0, 'CC_EIGR_SID_SUB', SUBR_NAME, IERR + FATAL_ERR = FATAL_ERR + 1 + JERR = JERR + 1 + ENDIF + ENDIF + + IF (.NOT. ALLOCATED(IS_MODES_SUBCASE)) THEN + ALLOCATE (IS_MODES_SUBCASE(LSUB), STAT=IERR) + IF (IERR == 0) THEN + DO I=1,LSUB + IS_MODES_SUBCASE(I) = 'N' + ENDDO + ELSE + WRITE(ERR,991) 0.0D0, 'IS_MODES_SUBCASE', SUBR_NAME, IERR + WRITE(F06,991) 0.0D0, 'IS_MODES_SUBCASE', SUBR_NAME, IERR + FATAL_ERR = FATAL_ERR + 1 + JERR = JERR + 1 + ENDIF + ENDIF + + IF (.NOT. ALLOCATED(NUM_EIGENS_SUB)) THEN + ALLOCATE (NUM_EIGENS_SUB(LSUB), STAT=IERR) + IF (IERR == 0) THEN + DO I=1,LSUB + NUM_EIGENS_SUB(I) = 0 + ENDDO + ELSE + WRITE(ERR,991) 0.0D0, 'NUM_EIGENS_SUB', SUBR_NAME, IERR + WRITE(F06,991) 0.0D0, 'NUM_EIGENS_SUB', SUBR_NAME, IERR + FATAL_ERR = FATAL_ERR + 1 + JERR = JERR + 1 + ENDIF + ENDIF + + IF (.NOT. ALLOCATED(EIG_PARAMS)) THEN + ALLOCATE (EIG_PARAMS(LSUB), STAT=IERR) + IF (IERR /= 0) THEN + WRITE(ERR,991) 0.0D0, 'EIG_PARAMS', SUBR_NAME, IERR + WRITE(F06,991) 0.0D0, 'EIG_PARAMS', SUBR_NAME, IERR + FATAL_ERR = FATAL_ERR + 1 + JERR = JERR + 1 + ENDIF + ! Defaults from EIG_PARAMS_TYPE component initializers are applied automatically. + ENDIF + ELSE IF (NAME_IN == 'SUBLOD') THEN ! Allocate array SUBLOD NAME = 'SUBLOD' diff --git a/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 b/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 index 68478e33..244394fa 100644 --- a/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 +++ b/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 @@ -56,6 +56,7 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) USE MODEL_STUF, ONLY : ALL_SETS_ARRAY, ONE_SET_ARRAY, SETS_IDS, SC_ACCE, SC_DISP, SC_ELFN, SC_ELFE, SC_GPFO, & SC_MPCF, SC_OLOA, SC_SPCF, SC_STRE, SC_STRN, LOAD_SIDS, LOAD_FACS USE MODEL_STUF, ONLY : ELDT, ELOUT, GROUT, OELOUT, OGROUT, LABEL, SCNUM, STITLE, SUBLOD, TITLE + USE MODEL_STUF, ONLY : CC_EIGR_SID_SUB, EIG_PARAMS, IS_MODES_SUBCASE, NUM_EIGENS_SUB USE MODEL_STUF, ONLY : SYS_LOAD USE MODEL_STUF, ONLY : CETEMP, CETEMP_ERR, CGTEMP, CGTEMP_ERR, ETEMP, ETEMP_INIT, GTEMP, GTEMP_INIT, TDATA, TPNT USE MODEL_STUF, ONLY : RIGID_ELEM_IDS @@ -296,6 +297,11 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) ENDIF ENDIF + ! NOTE: CC_EIGR_SID_SUB, IS_MODES_SUBCASE, NUM_EIGENS_SUB, and EIG_PARAMS are deliberately *not* deallocated + ! alongside SCNUM. LINK9 deallocates+reallocates SCNUM at startup, and we need the per-subcase eigen state + ! populated by LK1/LK4 to survive that cycle so LINK9 can iterate modes per their owning subcase. The matching + ! ALLOCATE_MODEL_STUF('SCNUM') skips them when they are already allocated, so they remain populated. + ELSE IF (NAME_IN == 'SUBLOD') THEN ! Deallocate array SUBLOD NAME = 'SUBLOD' From fe5ccca6f52925a791f30e2c6f310324331adf21 Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 15:38:39 -0300 Subject: [PATCH 02/11] almost done: LINK5 and LINK9 --- Source/LK5/LINK5.f90 | 33 ++++++++++++++++++++++-- Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 | 10 ++++--- Source/LK9/LINK9/LINK9.f90 | 7 +++-- 3 files changed, 41 insertions(+), 9 deletions(-) diff --git a/Source/LK5/LINK5.f90 b/Source/LK5/LINK5.f90 index 5579f8da..c343aaac 100644 --- a/Source/LK5/LINK5.f90 +++ b/Source/LK5/LINK5.f90 @@ -38,7 +38,7 @@ SUBROUTINE LINK5 USE IOUNT1, ONLY : ERRSTAT, L1HSTAT, L2ESTAT, L2FSTAT, L3ASTAT USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, FATAL_ERR, LINKNO, MBUG, NDOFA, NDOFF, NDOFG, NDOFL, NDOFM, & NDOFN, NDOFO, NDOFR, NDOFS, NDOFSE, NGRID, NSUB, NTERM_GMN, NTERM_GOA, NTERM_PO, & - NUM_CB_DOFS, NUM_EIGENS, NVEC, SOL_NAME, WARN_ERR + NUM_CB_DOFS, NUM_EIGENS, NVEC, SOL_NAME, WARN_ERR, MODE_SUBCASE USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EIGNORM2, SUPINFO, SUPWARN USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -50,7 +50,8 @@ SUBROUTINE LINK5 USE COL_VECS, ONLY : UG_COL, YSe, UO0_COL, UL_COL USE DEBUG_PARAMETERS, ONLY : DEBUG USE DOF_TABLES, ONLY : TDOF, TDOFI - USE MODEL_STUF, ONLY : GRID, GRID_ID, INV_GRID_SEQ, EIG_COMP, EIG_GRID, EIG_NORM, MAXMIJ, MIJ_COL, MIJ_ROW + USE MODEL_STUF, ONLY : GRID, GRID_ID, INV_GRID_SEQ, EIG_COMP, EIG_GRID, EIG_NORM, MAXMIJ, MIJ_COL, MIJ_ROW, & + EIG_PARAMS USE LINK5_USE_IFs USE LINK_MESSAGE_Interface @@ -444,6 +445,34 @@ SUBROUTINE LINK5 WRITE(F06,9995) LINKNO,IERROR CALL OUTA_HERE ( 'Y' ) ENDIF + + ! Multi-METHOD MODES: switch EIG_NORM / EIG_GRID / EIG_COMP and recompute EIG_NORM_GSET_DOF to this mode's + ! owning subcase before the per-mode renorm call below. For legacy single-METHOD this is a no-op (EIG_PARAMS + ! entries all reference the canonical subcase's params). Nested IFs avoid evaluating SIZE/index on + ! MODE_SUBCASE when it is unallocated (gfortran does not guarantee short-circuit evaluation of .AND.). + IF (SOL_NAME(1:5) == 'MODES') THEN + IF (ALLOCATED(MODE_SUBCASE)) THEN + IF (J <= SIZE(MODE_SUBCASE)) THEN + IF ((MODE_SUBCASE(J) >= 1) .AND. ALLOCATED(EIG_PARAMS)) THEN + IF (EIG_PARAMS(MODE_SUBCASE(J))%SID /= 0) THEN + EIG_NORM = EIG_PARAMS(MODE_SUBCASE(J))%NORM + EIG_GRID = EIG_PARAMS(MODE_SUBCASE(J))%GRID + EIG_COMP = EIG_PARAMS(MODE_SUBCASE(J))%COMP + IF (EIG_NORM == 'POINT ') THEN + EIG_NORM_GSET_DOF = 0 + CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) + DO I=1,NDOFG + IF (TDOF(I,1) == EIG_GRID) THEN + EIG_NORM_GSET_DOF = TDOF(I,G_SET_COL) + EIG_COMP - 1 + EXIT + ENDIF + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF ! Build UA from UL and UR CALL ALLOCATE_COL_VEC ( 'UA_COL', NDOFA, SUBR_NAME ) CALL ALLOCATE_COL_VEC ( 'UR_COL', NDOFR, SUBR_NAME ) diff --git a/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 b/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 index b1064bbe..c57a0f39 100644 --- a/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 +++ b/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 @@ -33,7 +33,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : ERR, F06, OP2, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, GROUT_GPFO_BIT, IBIT, INT_SC_NUM, JTSUB, NDOFG, NDOFM, MELDOF, NDOFO, NDOFR,& - NELE, NGRID, NUM_CB_DOFS, NVEC, SOL_NAME + NELE, NGRID, NUM_CB_DOFS, NVEC, SOL_NAME, MODE_SUBCASE USE CONSTANTS_1, ONLY : ZERO, ONE_HUNDRED USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -42,7 +42,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) USE COL_VECS, ONLY : FG_COL, PG_COL, QGm_COL, QGs_COL, QGr_COL, UG_COL USE CC_OUTPUT_DESCRIBERS, ONLY : GPFO_OUT USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - + USE GP_FORCE_BALANCE_PROC_USE_IFs IMPLICIT NONE @@ -183,7 +183,11 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) IF (WRITE_F06) WRITE(F06,9102) JVEC ELSE IF (SOL_NAME(1:5) == 'MODES') THEN - ISUBCASE_INDEX = 1 ! modes + ! Per-mode subcase attribution (LINK4 populates MODE_SUBCASE). Falls back to 1 for legacy single-METHOD paths. + ISUBCASE_INDEX = 1 + IF (ALLOCATED(MODE_SUBCASE)) THEN + IF (JVEC <= SIZE(MODE_SUBCASE)) ISUBCASE_INDEX = MODE_SUBCASE(JVEC) + ENDIF ANALYSIS_CODE = 2 FIELD5_INT_MODE = JVEC IF (WRITE_F06) WRITE(F06,9102) JVEC diff --git a/Source/LK9/LINK9/LINK9.f90 b/Source/LK9/LINK9/LINK9.f90 index f832a741..0ec4f42f 100644 --- a/Source/LK9/LINK9/LINK9.f90 +++ b/Source/LK9/LINK9/LINK9.f90 @@ -678,10 +678,9 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ELSE IF (SOL_NAME(1: 5) == 'MODES') THEN ! Each mode is attributed to its owning subcase via MODE_SUBCASE (populated in LINK4). For legacy single-METHOD ! decks MODE_SUBCASE is uniformly the canonical subcase, so behaviour matches the original INT_SC_NUM=1 fallback. - IF (ALLOCATED(MODE_SUBCASE) .AND. (JVEC <= SIZE(MODE_SUBCASE))) THEN - INT_SC_NUM = MODE_SUBCASE(JVEC) - ELSE - INT_SC_NUM = 1 + INT_SC_NUM = 1 + IF (ALLOCATED(MODE_SUBCASE)) THEN + IF (JVEC <= SIZE(MODE_SUBCASE)) INT_SC_NUM = MODE_SUBCASE(JVEC) ENDIF FEMAP_SET_ID = JVEC From 09a3dc7773c1332863d3e554b0b2adeabb0cf847 Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 15:50:06 -0300 Subject: [PATCH 03/11] distillation finished up, multi-subcase 103 support ready --- Source/LK4/LINK4.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Source/LK4/LINK4.f90 b/Source/LK4/LINK4.f90 index 66d2a9fd..edfdf83c 100644 --- a/Source/LK4/LINK4.f90 +++ b/Source/LK4/LINK4.f90 @@ -455,6 +455,10 @@ SUBROUTINE LINK4 ! Write eigenvalue analysis summary to output file (per-subcase summary in the multi-METHOD case) IF ((EIG_NORM == 'MASS ') .OR. (EIG_NORM == 'NONE')) THEN CALL LINK_MESSAGE('WRITE EIGENVALUE SUMMARY TO OUTFIL') + IF (N_MODES_ITER > 1) THEN + WRITE(F06,9876) CUR_ISUB, EIG_PARAMS(CUR_ISUB)%SID +9876 FORMAT(/,' ',79('='),/,' SUBCASE ',I8,' (METHOD SID = ',I8,')',/,' ',79('=')) + ENDIF CALL EIG_SUMMARY ENDIF From bd270899cb8ff7841bb976cb2415b3423c89392d Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 15:50:56 -0300 Subject: [PATCH 04/11] added some modes test cases to verify feature works --- Build_Test_Cases/.gitignore | 10 ++++++ Build_Test_Cases/modes/modes_multi.bdf | 30 ++++++++++++++++++ Build_Test_Cases/modes/modes_multi3.bdf | 33 ++++++++++++++++++++ Build_Test_Cases/modes/modes_multi_mixed.bdf | 30 ++++++++++++++++++ Build_Test_Cases/modes/modes_smoke.bdf | 26 +++++++++++++++ 5 files changed, 129 insertions(+) create mode 100644 Build_Test_Cases/.gitignore create mode 100644 Build_Test_Cases/modes/modes_multi.bdf create mode 100644 Build_Test_Cases/modes/modes_multi3.bdf create mode 100644 Build_Test_Cases/modes/modes_multi_mixed.bdf create mode 100644 Build_Test_Cases/modes/modes_smoke.bdf diff --git a/Build_Test_Cases/.gitignore b/Build_Test_Cases/.gitignore new file mode 100644 index 00000000..5085262c --- /dev/null +++ b/Build_Test_Cases/.gitignore @@ -0,0 +1,10 @@ +# Ignore all generated artifacts in test case directories; keep only inputs. +* +!*/ +!.gitignore +!README.md +!*.bdf +!*.BDF +!*.dat +!*.DAT +!*.py diff --git a/Build_Test_Cases/modes/modes_multi.bdf b/Build_Test_Cases/modes/modes_multi.bdf new file mode 100644 index 00000000..721e30c5 --- /dev/null +++ b/Build_Test_Cases/modes/modes_multi.bdf @@ -0,0 +1,30 @@ +ID Bruno, modes_multi +SOL MODES +TIME 100 +CEND +TITLE = Modes multi-METHOD (2 subcases, distinct EIGRL counts) +SPC = 1 +DISPLACEMENT = ALL +SUBCASE 1 + METHOD = 10 +SUBCASE 2 + METHOD = 20 +BEGIN BULK +PARAM,POST,-1 +EIGRL,10,,,3 +EIGRL,20,,,5 +GRID,1,,0.0,0.0,0.0 +GRID,2,,1.0,0.0,0.0 +GRID,3,,2.0,0.0,0.0 +GRID,4,,3.0,0.0,0.0 +GRID,5,,4.0,0.0,0.0 +GRID,6,,5.0,0.0,0.0 +CBAR,1,10,1,2,0.0,1.0,0.0 +CBAR,2,10,2,3,0.0,1.0,0.0 +CBAR,3,10,3,4,0.0,1.0,0.0 +CBAR,4,10,4,5,0.0,1.0,0.0 +CBAR,5,10,5,6,0.0,1.0,0.0 +PBAR,10,100,1.0,0.0833,0.0833,0.1406 +MAT1,100,1.0E7,,0.3,2.59E-4 +SPC1,1,123456,1 +ENDDATA diff --git a/Build_Test_Cases/modes/modes_multi3.bdf b/Build_Test_Cases/modes/modes_multi3.bdf new file mode 100644 index 00000000..a56faba6 --- /dev/null +++ b/Build_Test_Cases/modes/modes_multi3.bdf @@ -0,0 +1,33 @@ +ID Bruno, modes_multi3 +SOL MODES +TIME 100 +CEND +TITLE = Modes 3 subcases, 3 distinct METHODs +SPC = 1 +DISPLACEMENT = ALL +SUBCASE 1 + METHOD = 10 +SUBCASE 2 + METHOD = 20 +SUBCASE 3 + METHOD = 30 +BEGIN BULK +PARAM,POST,-1 +EIGRL,10,,,2 +EIGRL,20,,,4 +EIGRL,30,,,6 +GRID,1,,0.0,0.0,0.0 +GRID,2,,1.0,0.0,0.0 +GRID,3,,2.0,0.0,0.0 +GRID,4,,3.0,0.0,0.0 +GRID,5,,4.0,0.0,0.0 +GRID,6,,5.0,0.0,0.0 +CBAR,1,10,1,2,0.0,1.0,0.0 +CBAR,2,10,2,3,0.0,1.0,0.0 +CBAR,3,10,3,4,0.0,1.0,0.0 +CBAR,4,10,4,5,0.0,1.0,0.0 +CBAR,5,10,5,6,0.0,1.0,0.0 +PBAR,10,100,1.0,0.0833,0.0833,0.1406 +MAT1,100,1.0E7,,0.3,2.59E-4 +SPC1,1,123456,1 +ENDDATA diff --git a/Build_Test_Cases/modes/modes_multi_mixed.bdf b/Build_Test_Cases/modes/modes_multi_mixed.bdf new file mode 100644 index 00000000..0cccb2f5 --- /dev/null +++ b/Build_Test_Cases/modes/modes_multi_mixed.bdf @@ -0,0 +1,30 @@ +ID Bruno, modes_multi_mixed +SOL MODES +TIME 100 +CEND +TITLE = Modes multi-METHOD: EIGRL sub1, EIGR (GIV) sub2 +SPC = 1 +DISPLACEMENT = ALL +SUBCASE 1 + METHOD = 10 +SUBCASE 2 + METHOD = 20 +BEGIN BULK +PARAM,POST,-1 +EIGRL,10,,,4 +EIGR,20,MGIV,0.0,1.0E6,,,3 +GRID,1,,0.0,0.0,0.0 +GRID,2,,1.0,0.0,0.0 +GRID,3,,2.0,0.0,0.0 +GRID,4,,3.0,0.0,0.0 +GRID,5,,4.0,0.0,0.0 +GRID,6,,5.0,0.0,0.0 +CBAR,1,10,1,2,0.0,1.0,0.0 +CBAR,2,10,2,3,0.0,1.0,0.0 +CBAR,3,10,3,4,0.0,1.0,0.0 +CBAR,4,10,4,5,0.0,1.0,0.0 +CBAR,5,10,5,6,0.0,1.0,0.0 +PBAR,10,100,1.0,0.0833,0.0833,0.1406 +MAT1,100,1.0E7,,0.3,2.59E-4 +SPC1,1,123456,1 +ENDDATA diff --git a/Build_Test_Cases/modes/modes_smoke.bdf b/Build_Test_Cases/modes/modes_smoke.bdf new file mode 100644 index 00000000..e043a472 --- /dev/null +++ b/Build_Test_Cases/modes/modes_smoke.bdf @@ -0,0 +1,26 @@ +ID Bruno, modes_smoke +SOL MODES +TIME 100 +CEND +TITLE = Modes smoke test (single METHOD, deck-level) +METHOD = 10 +SPC = 1 +DISPLACEMENT(PLOT) = ALL +BEGIN BULK +PARAM,POST,-1 +EIGRL,10,,,5 +GRID,1,,0.0,0.0,0.0 +GRID,2,,1.0,0.0,0.0 +GRID,3,,2.0,0.0,0.0 +GRID,4,,3.0,0.0,0.0 +GRID,5,,4.0,0.0,0.0 +GRID,6,,5.0,0.0,0.0 +CBAR,1,10,1,2,0.0,1.0,0.0 +CBAR,2,10,2,3,0.0,1.0,0.0 +CBAR,3,10,3,4,0.0,1.0,0.0 +CBAR,4,10,4,5,0.0,1.0,0.0 +CBAR,5,10,5,6,0.0,1.0,0.0 +PBAR,10,100,1.0,0.0833,0.0833,0.1406 +MAT1,100,1.0E7,,0.3,2.59E-4 +SPC1,1,123456,1 +ENDDATA From 9dec90493266629f152bbf38138c57046bcaf51b Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 16:09:13 -0300 Subject: [PATCH 05/11] fixed a memory leak --- Source/LK4/EIG_LANCZOS_ARPACK.f90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/Source/LK4/EIG_LANCZOS_ARPACK.f90 b/Source/LK4/EIG_LANCZOS_ARPACK.f90 index 2517eeab..13887566 100644 --- a/Source/LK4/EIG_LANCZOS_ARPACK.f90 +++ b/Source/LK4/EIG_LANCZOS_ARPACK.f90 @@ -46,6 +46,8 @@ SUBROUTINE EIG_LANCZOS_ARPACK USE SPARSE_MATRICES, ONLY : I_KLL, J_KLL, KLL, I_KLLD, J_KLLD, KLLD, I_MLL, J_MLL, MLL, SYM_KLL, SYM_KLLD, SYM_MLL, & I_KMSM, J_KMSM, KMSM, I_KMSMn, J_KMSMn, KMSMn, I_KMSMs, J_KMSMs, KMSMs + USE SuperLU_STUF, ONLY : SLU_FACTORS, SLU_INFO + USE ARPACK_LANCZOS_EIG USE MYSTRAN_LAPACK_EXT @@ -421,6 +423,16 @@ SUBROUTINE EIG_LANCZOS_ARPACK NVEC = IPARAM(5) ! With HOWMNY = 'A' we are calc'ing eigenvecs for all eigenvalues found NUM_EIGENS = IPARAM(5) + ! Free SuperLU factorization stored in SLU_FACTORS by SYM_MAT_DECOMP_SUPRLU inside DSBAND (SPARSE solver). + ! Required to avoid leaking the factor across multi-METHOD MODES iterations. + IF (SOLLIB(1:6) == 'SPARSE') THEN + BLOCK + REAL(DOUBLE) :: DUM_COL(1) + DUM_COL(1) = ZERO + CALL C_FORTRAN_DGSSV ( 3, NDOFL, NTERM_KMSMn, 1, KMSMn, J_KMSMn, I_KMSMn, DUM_COL, NDOFL, SLU_FACTORS, SLU_INFO ) + END BLOCK + ENDIF + !xx WRITE(SC1, * ) ' DEALLOCATE SOME ARRAYS' !xx WRITE(SC1, * ) ! Advance 1 line for screen messages WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KMSMn ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'KMSMn' ) From c6c2fadebfb3c9b677870d1a29717eb6b45d9c94 Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 16:47:41 -0300 Subject: [PATCH 06/11] STATSUB preliminary work --- Source/Interfaces/CC_STATSUB_Interface.f90 | 50 +++++++ Source/LK1/L1A-CC/CC_STATSUB.f90 | 132 +++++++++++++++++++ Source/LK1/L1A/LOADC.f90 | 144 +++++++++++++++------ Source/Modules/MODEL_STUF.f90 | 10 ++ Source/Modules/SCONTR.f90 | 1 + Source/USE_IFs/CC_STATSUB_USE_IFs.f90 | 33 +++++ Source/USE_IFs/LOADC_USE_IFs.f90 | 1 + Source/UTIL/ALLOCATE_MODEL_STUF.f90 | 31 ++++- Source/UTIL/DEALLOCATE_MODEL_STUF.f90 | 12 +- 9 files changed, 368 insertions(+), 46 deletions(-) create mode 100644 Source/Interfaces/CC_STATSUB_Interface.f90 create mode 100644 Source/LK1/L1A-CC/CC_STATSUB.f90 create mode 100644 Source/USE_IFs/CC_STATSUB_USE_IFs.f90 diff --git a/Source/Interfaces/CC_STATSUB_Interface.f90 b/Source/Interfaces/CC_STATSUB_Interface.f90 new file mode 100644 index 00000000..644e3787 --- /dev/null +++ b/Source/Interfaces/CC_STATSUB_Interface.f90 @@ -0,0 +1,50 @@ +! ############################################################################################################################### +! 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 CC_STATSUB_Interface + + INTERFACE + + SUBROUTINE CC_STATSUB ( CARD ) + + + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 + USE SCONTR, ONLY : WARN_ERR, BLNK_SUB_NAM, FATAL_ERR + USE TIMDAT, ONLY : TSEC + USE PARAMS, ONLY : SUPWARN + + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Case Control card + + + + END SUBROUTINE CC_STATSUB + + END INTERFACE + + END MODULE CC_STATSUB_Interface diff --git a/Source/LK1/L1A-CC/CC_STATSUB.f90 b/Source/LK1/L1A-CC/CC_STATSUB.f90 new file mode 100644 index 00000000..1b311df2 --- /dev/null +++ b/Source/LK1/L1A-CC/CC_STATSUB.f90 @@ -0,0 +1,132 @@ +! ################################################################################################################################## +! 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 CC_STATSUB ( CARD ) + +! Processes Case Control STATSUB entries for SOL 105 buckling. Syntax accepted: +! STATSUB = n +! STATSUB(PRELOAD) = n +! The describer (BUCKLING) is recognized and rejected as FATAL since nonlinear preload integration is not implemented. +! "n" is a static SUBCASE id (the external subcase number) whose linear-static solution provides the prestress used to +! build KGGD for the buckling eigenproblem in this subcase. Resolution of "n" against the actual subcase table happens +! later in LOADC, after all SUBCASE cards have been seen. + + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 + USE SCONTR, ONLY : WARN_ERR, BLNK_SUB_NAM, FATAL_ERR, NSUB + USE TIMDAT, ONLY : TSEC + USE PARAMS, ONLY : SUPWARN + USE MODEL_STUF, ONLY : CC_STATSUB_DECK, CC_STATSUB_SUB + + USE CC_STATSUB_USE_IFs + + IMPLICIT NONE + + CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'CC_STATSUB' + CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Case Control card + + INTEGER(LONG) :: SETID ! Integer following '=' on the card (the static subcase id) + INTEGER(LONG) :: LP, RP ! Positions of '(' and ')' in CARD (0 if absent) + INTEGER(LONG) :: EQ ! Position of '=' in CARD + + + + +! ********************************************************************************************************************************** +! Process STATSUB cards + + ! Detect an optional describer ( PRELOAD or BUCKLING ) before the '=' sign. + EQ = INDEX(CARD,'=') + LP = INDEX(CARD,'(') + RP = INDEX(CARD,')') + + IF ((LP > 0) .AND. (RP > LP) .AND. ((EQ == 0) .OR. (LP < EQ))) THEN + IF (INDEX(CARD(LP+1:RP-1),'BUCKLING') > 0) THEN + FATAL_ERR = FATAL_ERR + 1 + WRITE(ERR,9881) + WRITE(F06,9881) + RETURN + ENDIF + ! Any describer other than PRELOAD is treated as a warning. Empty describer is silently accepted. + IF ((INDEX(CARD(LP+1:RP-1),'PRELOAD') == 0) .AND. (LEN_TRIM(CARD(LP+1:RP-1)) > 0)) THEN + WARN_ERR = WARN_ERR + 1 + WRITE(ERR,9882) CARD(LP:RP) + IF (SUPWARN == 'N') THEN + WRITE(F06,9882) CARD(LP:RP) + ENDIF + ENDIF + ENDIF + + ! Pull the integer following '=' (this is a SUBCASE id, not a bulk-data set id, but the parser is identical). + CALL GET_SETID ( CARD, SETID ) + + ! Record the per-subcase or deck-level value. NSUB is incremented by CC_SUBC at parse time, so: + ! * NSUB == 0 -> this STATSUB appears above any SUBCASE card; it is the deck-default that any subcase lacking + ! its own STATSUB inherits during LOADC's post-parse pass. + ! * NSUB > 0 -> this STATSUB belongs to the current (most-recently-opened) subcase. + + IF (NSUB == 0) THEN + + IF ((CC_STATSUB_DECK /= 0) .AND. (CC_STATSUB_DECK /= SETID)) THEN + WARN_ERR = WARN_ERR + 1 + WRITE(ERR,9883) CC_STATSUB_DECK, SETID + IF (SUPWARN == 'N') THEN + WRITE(F06,9883) CC_STATSUB_DECK, SETID + ENDIF + ENDIF + CC_STATSUB_DECK = SETID + + ELSE + + IF (ALLOCATED(CC_STATSUB_SUB)) THEN + IF ((CC_STATSUB_SUB(NSUB) /= 0) .AND. (CC_STATSUB_SUB(NSUB) /= SETID)) THEN + WARN_ERR = WARN_ERR + 1 + WRITE(ERR,9884) NSUB, CC_STATSUB_SUB(NSUB), SETID + IF (SUPWARN == 'N') THEN + WRITE(F06,9884) NSUB, CC_STATSUB_SUB(NSUB), SETID + ENDIF + ENDIF + CC_STATSUB_SUB(NSUB) = SETID + ENDIF + + ENDIF + + + + RETURN + +! ********************************************************************************************************************************** + 9881 FORMAT(' *ERROR 9881: STATSUB(BUCKLING) IS NOT SUPPORTED. ONLY STATSUB(PRELOAD) (OR THE EQUIVALENT BARE "STATSUB=n")', & + ' IS RECOGNIZED.') + 9882 FORMAT(' *WARNING : UNRECOGNIZED DESCRIBER ',A,' ON STATSUB CASE CONTROL ENTRY. PRELOAD INTERPRETATION ASSUMED.') + 9883 FORMAT(' *WARNING : MORE THAN ONE DECK-LEVEL STATSUB ENTRY IN CASE CONTROL. PREVIOUS VALUE = ',I8,', NEW VALUE = ',I8, & + '. NEW VALUE WILL BE USED AS THE DECK DEFAULT.') + 9884 FORMAT(' *WARNING : MORE THAN ONE STATSUB ENTRY IN SUBCASE ',I8,'. PREVIOUS VALUE = ',I8,', NEW VALUE = ',I8, & + '. NEW VALUE WILL BE USED.') + +! ********************************************************************************************************************************** + + END SUBROUTINE CC_STATSUB diff --git a/Source/LK1/L1A/LOADC.f90 b/Source/LK1/L1A/LOADC.f90 index c52c575b..913a2e20 100644 --- a/Source/LK1/L1A/LOADC.f90 +++ b/Source/LK1/L1A/LOADC.f90 @@ -29,11 +29,12 @@ SUBROUTINE LOADC ! LOADC reads in the CASE CONTROL DECK USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : BUGOUT, ERR, F06, IN1, WRT_ERR - USE SCONTR, ONLY : BLNK_SUB_NAM, CC_ENTRY_LEN, ENFORCED, FATAL_ERR, WARN_ERR, NSUB, NTSUB, PROG_NAME, & - RESTART, SOL_NAME + USE SCONTR, ONLY : BLNK_SUB_NAM, CC_ENTRY_LEN, ENFORCED, FATAL_ERR, WARN_ERR, NSUB, NTSUB, NUM_BUCKLING_SUBS, & + PROG_NAME, RESTART, SOL_NAME USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPINFO, SUPWARN - USE MODEL_STUF, ONLY : CC_EIGR_SID, CC_EIGR_SID_SUB, CC_EIGR_SID_DECK, IS_MODES_SUBCASE, & + USE MODEL_STUF, ONLY : CC_EIGR_SID, CC_EIGR_SID_SUB, CC_EIGR_SID_DECK, CC_STATSUB_DECK, CC_STATSUB_SUB, & + IS_BUCKLING_SUBCASE, IS_MODES_SUBCASE, & MEFFMASS_CALC, MPCSET, MPCSETS, MPFACTOR_CALC, SCNUM, SPCSET, SPCSETS, SUBLOD USE MODEL_STUF, ONLY : EIG_PARAMS, & EIG_COMP, EIG_CRIT, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_LANCZOS_NEV_DELT, EIG_METH, & @@ -189,6 +190,9 @@ SUBROUTINE LOADC ELSE IF (CARD1(1:4) == 'SPCF' ) THEN CALL CC_SPCF ( CARD1 ) + ELSE IF (CARD1(1:7) == 'STATSUB') THEN + CALL CC_STATSUB ( CARD1 ) + ELSE IF((CARD1(1:4) == 'STRA' ) .OR. (CARD1(1:4) == 'STRN' ) .OR. (CARD1(1:8) == 'ELSTRAIN')) THEN CALL CC_STRN ( CARD1 ) @@ -314,53 +318,100 @@ SUBROUTINE LOADC ENDIF ENDIF - ! If SOL is buckling there should be 2 subcases; the first with a load - ! and the second with a METH (METH checked above) - ! If any load, SPC or MPC is found in the 2nd subcase, make sure it is - ! the same as in subcase 1 + ! For SOL 105 buckling, resolve STATSUB(PRELOAD) references for each buckling subcase. A buckling subcase is one + ! that has a resolved METHOD (and therefore IS_MODES_SUBCASE(I)=='Y'). The remaining subcases supply linear-static + ! preloads. STATSUB(PRELOAD)=n names the external SUBCASE id of the static subcase whose displacement field is + ! used to assemble KGGD for the buckling eigenproblem. If no STATSUB is given anywhere, fall back to the legacy + ! behavior: the first non-buckling subcase that carries a LOAD or TEMP request acts as the preload source. IF (SOL_NAME == 'BUCKLING') THEN - IF (NSUB /= 2) THEN ! Check for 2 subcases - WRITE(ERR,1101) - WRITE(F06,1101) - FATAL_ERR = FATAL_ERR + 1 - IF (NSUB < 2) THEN - ! further code will crash if we continue with just one subcase - CALL OUTA_HERE ( 'Y' ) - END IF + + ! Tag every modes-subcase as a buckling-subcase, and count them. + NUM_BUCKLING_SUBS = 0 + IF (ALLOCATED(IS_BUCKLING_SUBCASE) .AND. ALLOCATED(IS_MODES_SUBCASE)) THEN + DO I = 1, NSUB + IF (IS_MODES_SUBCASE(I) == 'Y') THEN + IS_BUCKLING_SUBCASE(I) = 'Y' + NUM_BUCKLING_SUBS = NUM_BUCKLING_SUBS + 1 + ENDIF + ENDDO ENDIF - ! Check that subcase 1 has a mechanical or thermal load - IF ((SUBLOD(1,1) == 0) .AND. (SUBLOD(1,2) == 0)) THEN + + IF (NUM_BUCKLING_SUBS == 0) THEN ! no buckling subcase -> nothing to solve WRITE(ERR,1101) WRITE(F06,1101) FATAL_ERR = FATAL_ERR + 1 + CALL OUTA_HERE ( 'Y' ) ENDIF - ! Check the 2 subcases for identical loading (if S/C 2 has any stated) - DO I = 1,2 - IF (SUBLOD(2,I) /= 0) THEN - IF (SUBLOD(2,I) /= SUBLOD(1,I)) THEN - WRITE(ERR,1102) - WRITE(F06,1102) - FATAL_ERR = FATAL_ERR + 1 + ! Confirm at least one non-buckling subcase carries a load (mechanical or thermal). Without one there is no + ! linear-static preload to drive KGGD. + BLOCK + LOGICAL :: HAS_STATIC_LOAD + INTEGER(LONG) :: STATSUB_REQ, RESOLVED_IDX, K + HAS_STATIC_LOAD = .FALSE. + DO I = 1, NSUB + IF ((IS_BUCKLING_SUBCASE(I) == 'N') .AND. ((SUBLOD(I,1) /= 0) .OR. (SUBLOD(I,2) /= 0))) THEN + HAS_STATIC_LOAD = .TRUE. + EXIT ENDIF - ENDIF - ENDDO - - IF (SPCSETS(2) /= 0) THEN ! Check the 2 subcases for identical SPC (if S/C 2 has any stated) - IF (SPCSETS(2) /= SPCSETS(1)) THEN - WRITE(ERR,1102) - WRITE(F06,1102) + ENDDO + IF (.NOT. HAS_STATIC_LOAD) THEN + WRITE(ERR,1101) + WRITE(F06,1101) FATAL_ERR = FATAL_ERR + 1 ENDIF - ENDIF - IF (MPCSETS(2) /= 0) THEN ! Check the 2 subcases for identical MPC (if S/C 2 has any stated) - IF (MPCSETS(2) /= MPCSETS(1)) THEN - WRITE(ERR,1102) - WRITE(F06,1102) - FATAL_ERR = FATAL_ERR + 1 - ENDIF - ENDIF + ! Resolve STATSUB(PRELOAD) for each buckling subcase. Per-subcase value beats deck-level which beats the + ! legacy fallback (first static subcase that carries a load). + DO I = 1, NSUB + IF (IS_BUCKLING_SUBCASE(I) /= 'Y') CYCLE + STATSUB_REQ = 0 + IF (ALLOCATED(CC_STATSUB_SUB)) STATSUB_REQ = CC_STATSUB_SUB(I) + IF (STATSUB_REQ == 0) STATSUB_REQ = CC_STATSUB_DECK + + RESOLVED_IDX = 0 + IF (STATSUB_REQ == 0) THEN + ! Legacy fallback: first static subcase with LOAD or TEMP. + DO K = 1, NSUB + IF ((IS_BUCKLING_SUBCASE(K) == 'N') .AND. ((SUBLOD(K,1) /= 0) .OR. (SUBLOD(K,2) /= 0))) THEN + RESOLVED_IDX = K + EXIT + ENDIF + ENDDO + IF (RESOLVED_IDX == 0) THEN + WRITE(ERR,1103) I + WRITE(F06,1103) I + FATAL_ERR = FATAL_ERR + 1 + ENDIF + ELSE + ! Look up external subcase id (STATSUB_REQ) in SCNUM(:) to find its internal index. + DO K = 1, NSUB + IF (SCNUM(K) == STATSUB_REQ) THEN + RESOLVED_IDX = K + EXIT + ENDIF + ENDDO + IF (RESOLVED_IDX == 0) THEN + WRITE(ERR,1104) STATSUB_REQ, I + WRITE(F06,1104) STATSUB_REQ, I + FATAL_ERR = FATAL_ERR + 1 + ELSE IF (IS_BUCKLING_SUBCASE(RESOLVED_IDX) == 'Y') THEN + WRITE(ERR,1105) STATSUB_REQ, I + WRITE(F06,1105) STATSUB_REQ, I + FATAL_ERR = FATAL_ERR + 1 + RESOLVED_IDX = 0 + ELSE IF ((SUBLOD(RESOLVED_IDX,1) == 0) .AND. (SUBLOD(RESOLVED_IDX,2) == 0)) THEN + WRITE(ERR,1106) STATSUB_REQ, I + WRITE(F06,1106) STATSUB_REQ, I + FATAL_ERR = FATAL_ERR + 1 + ENDIF + ENDIF + + IF (ALLOCATED(EIG_PARAMS) .AND. (RESOLVED_IDX > 0)) THEN + EIG_PARAMS(I)%STATSUB_REF = RESOLVED_IDX + ENDIF + ENDDO + END BLOCK ENDIF @@ -424,10 +475,23 @@ SUBROUTINE LOADC 1028 FORMAT(' *ERROR 1028: THERE MUST BE 2 SUBCASES FOR LINEAR BUCKLING ANALYSES BUT NSUB = ',I8) - 1101 FORMAT(' *ERROR 1101: FOR BUCKLING ANALYSES THERE MUST BE 2 SUBCASES WITH A LOAD (AND/OR TEMP) DEFINED IN SUBCASE 1') + 1101 FORMAT(' *ERROR 1101: FOR BUCKLING ANALYSES THERE MUST BE AT LEAST ONE SUBCASE WITH A METHOD (BUCKLING EIGENPROBLEM)', & + ' AND AT LEAST ONE OTHER SUBCASE THAT CARRIES A LOAD (AND/OR TEMP) TO ACT AS THE STATSUB PRELOAD.') 1102 FORMAT(' *ERROR 1102: FOR BUCKLING ANALYSES ANY LOAD, SPS OR MPC IN 2nd SUBCASE MUST BE THE SAME AS THOSE IN 1st SUBCASE') + 1103 FORMAT(' *ERROR 1103: BUCKLING SUBCASE (INTERNAL #',I8,') HAS NO STATSUB AND NO STATIC SUBCASE WITH A LOAD WAS FOUND', & + ' TO ACT AS THE LEGACY DEFAULT PRELOAD.') + + 1104 FORMAT(' *ERROR 1104: STATSUB(PRELOAD)=',I8,' ON BUCKLING SUBCASE (INTERNAL #',I8,') REFERENCES A SUBCASE THAT DOES NOT', & + ' EXIST IN THIS CASE CONTROL DECK.') + + 1105 FORMAT(' *ERROR 1105: STATSUB(PRELOAD)=',I8,' ON BUCKLING SUBCASE (INTERNAL #',I8,') REFERENCES ANOTHER BUCKLING SUBCASE.',& + ' STATSUB MUST POINT TO A LINEAR-STATIC SUBCASE.') + + 1106 FORMAT(' *ERROR 1106: STATSUB(PRELOAD)=',I8,' ON BUCKLING SUBCASE (INTERNAL #',I8,') REFERENCES A SUBCASE THAT CARRIES', & + ' NEITHER LOAD NOR TEMP.') + 1199 FORMAT(' *WARNING : BE CAREFUL WITH LINES THAT BEGIN WITH A $ SIGN IN COL 1 FOLLOWED BY AN UPPER CASE LETTER IN EXEC OR', & ' CASE CONTROL.' & ,/,14X,' THE LINE CAN BE MISINTERPRETED AS A DIRECTIVE FOR THE BANDIT GRID RESEQUENCING ALGORITHM.' & diff --git a/Source/Modules/MODEL_STUF.f90 b/Source/Modules/MODEL_STUF.f90 index 85c23382..363116b5 100644 --- a/Source/Modules/MODEL_STUF.f90 +++ b/Source/Modules/MODEL_STUF.f90 @@ -1863,6 +1863,16 @@ MODULE MODEL_STUF CHARACTER(1*BYTE) , ALLOCATABLE :: IS_MODES_SUBCASE(:) ! 'Y' for each modes-subcase (has a resolved METHOD); 'N' otherwise. + INTEGER(LONG) , ALLOCATABLE :: CC_STATSUB_SUB(:) ! Per-subcase STATSUB(PRELOAD) value (0 if subcase has no STATSUB). +! Populated by CC_STATSUB; for buckling subcases lacking a STATSUB +! card, the deck-default (STATSUB declared above any SUBCASE) is +! propagated by the post-parse inheritance pass in LOADC. + INTEGER(LONG) :: CC_STATSUB_DECK = 0 +! STATSUB(PRELOAD) declared above the first SUBCASE card (deck-default). + CHARACTER(1*BYTE) , ALLOCATABLE :: IS_BUCKLING_SUBCASE(:) +! 'Y' for each buckling-subcase (resolved by LOADC for SOL 105 +! decks); 'N' otherwise. + ! Per-subcase eigen result tally (allocated alongside EIG_PARAMS by ALLOCATE_MODEL_STUF). The full per-subcase result ! buffers live as allocatable components inside EIG_PARAMS(ISUB). INTEGER(LONG) , ALLOCATABLE :: NUM_EIGENS_SUB(:) ! No. of eigenvalues extracted per modes-subcase diff --git a/Source/Modules/SCONTR.f90 b/Source/Modules/SCONTR.f90 index cbdb26a9..61c24cda 100644 --- a/Source/Modules/SCONTR.f90 +++ b/Source/Modules/SCONTR.f90 @@ -295,6 +295,7 @@ MODULE SCONTR INTEGER(LONG) :: NUM_SPCSIDS = 0 ! The number of SPC set ID's called for in an execution INTEGER(LONG) :: NSUB = 0 ! Count of no. of subcases INTEGER(LONG) :: NUM_MODES_SUBS = 0 ! Count of subcases that have a resolved METHOD (modes-subcases) + INTEGER(LONG) :: NUM_BUCKLING_SUBS = 0 ! Count of subcases tagged as buckling-subcases (SOL 105 only) INTEGER(LONG) :: TOTAL_MODES = 0 ! sum(NUM_EIGENS_SUB(:)) = total eigenvectors across all modes-subs INTEGER(LONG), ALLOCATABLE :: MODE_SUBCASE(:) ! Length = TOTAL_MODES. Maps each global mode index (the JVEC ! iteration in LINK5/LINK9) to its owning internal subcase index. diff --git a/Source/USE_IFs/CC_STATSUB_USE_IFs.f90 b/Source/USE_IFs/CC_STATSUB_USE_IFs.f90 new file mode 100644 index 00000000..a760f824 --- /dev/null +++ b/Source/USE_IFs/CC_STATSUB_USE_IFs.f90 @@ -0,0 +1,33 @@ +! 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 CC_STATSUB_USE_IFs + +! USE Interface statements for all subroutines called by SUBROUTINE CC_STATSUB + + USE OURTIM_Interface + USE GET_SETID_Interface + + END MODULE CC_STATSUB_USE_IFs diff --git a/Source/USE_IFs/LOADC_USE_IFs.f90 b/Source/USE_IFs/LOADC_USE_IFs.f90 index 98e992e7..3efc43ac 100644 --- a/Source/USE_IFs/LOADC_USE_IFs.f90 +++ b/Source/USE_IFs/LOADC_USE_IFs.f90 @@ -48,6 +48,7 @@ MODULE LOADC_USE_IFs USE CC_SET_Interface USE CC_SPC_Interface USE CC_SPCF_Interface + USE CC_STATSUB_Interface USE CC_STRN_Interface USE CC_STRE_Interface USE CC_SUBC_Interface diff --git a/Source/UTIL/ALLOCATE_MODEL_STUF.f90 b/Source/UTIL/ALLOCATE_MODEL_STUF.f90 index 789e7ada..9f3f8c12 100644 --- a/Source/UTIL/ALLOCATE_MODEL_STUF.f90 +++ b/Source/UTIL/ALLOCATE_MODEL_STUF.f90 @@ -70,7 +70,8 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) USE MODEL_STUF, ONLY : ALL_SETS_ARRAY, ONE_SET_ARRAY, SETS_IDS, SC_ACCE, SC_DISP, SC_ELFN, SC_ELFE, SC_GPFO, & SC_MPCF, SC_OLOA, SC_SPCF, SC_STRE, SC_STRN, LOAD_SIDS, LOAD_FACS USE MODEL_STUF, ONLY : ELDT, ELOUT, GROUT, OELOUT, OGROUT, LABEL, SCNUM, STITLE, SUBLOD, TITLE - USE MODEL_STUF, ONLY : CC_EIGR_SID_SUB, EIG_PARAMS, EIG_PARAMS_TYPE, IS_MODES_SUBCASE, NUM_EIGENS_SUB + USE MODEL_STUF, ONLY : CC_EIGR_SID_SUB, CC_STATSUB_SUB, EIG_PARAMS, EIG_PARAMS_TYPE, IS_BUCKLING_SUBCASE, & + IS_MODES_SUBCASE, NUM_EIGENS_SUB USE MODEL_STUF, ONLY : SYS_LOAD USE MODEL_STUF, ONLY : CETEMP, CETEMP_ERR, CGTEMP, CGTEMP_ERR, ETEMP, ETEMP_INIT, GTEMP, GTEMP_INIT, TDATA, TPNT USE MODEL_STUF, ONLY : RIGID_ELEM_IDS @@ -562,6 +563,34 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) ENDIF ENDIF + IF (.NOT. ALLOCATED(CC_STATSUB_SUB)) THEN + ALLOCATE (CC_STATSUB_SUB(LSUB), STAT=IERR) + IF (IERR == 0) THEN + DO I=1,LSUB + CC_STATSUB_SUB(I) = 0 + ENDDO + ELSE + WRITE(ERR,991) 0.0D0, 'CC_STATSUB_SUB', SUBR_NAME, IERR + WRITE(F06,991) 0.0D0, 'CC_STATSUB_SUB', SUBR_NAME, IERR + FATAL_ERR = FATAL_ERR + 1 + JERR = JERR + 1 + ENDIF + ENDIF + + IF (.NOT. ALLOCATED(IS_BUCKLING_SUBCASE)) THEN + ALLOCATE (IS_BUCKLING_SUBCASE(LSUB), STAT=IERR) + IF (IERR == 0) THEN + DO I=1,LSUB + IS_BUCKLING_SUBCASE(I) = 'N' + ENDDO + ELSE + WRITE(ERR,991) 0.0D0, 'IS_BUCKLING_SUBCASE', SUBR_NAME, IERR + WRITE(F06,991) 0.0D0, 'IS_BUCKLING_SUBCASE', SUBR_NAME, IERR + FATAL_ERR = FATAL_ERR + 1 + JERR = JERR + 1 + ENDIF + ENDIF + IF (.NOT. ALLOCATED(NUM_EIGENS_SUB)) THEN ALLOCATE (NUM_EIGENS_SUB(LSUB), STAT=IERR) IF (IERR == 0) THEN diff --git a/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 b/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 index 244394fa..144c5199 100644 --- a/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 +++ b/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 @@ -56,7 +56,8 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) USE MODEL_STUF, ONLY : ALL_SETS_ARRAY, ONE_SET_ARRAY, SETS_IDS, SC_ACCE, SC_DISP, SC_ELFN, SC_ELFE, SC_GPFO, & SC_MPCF, SC_OLOA, SC_SPCF, SC_STRE, SC_STRN, LOAD_SIDS, LOAD_FACS USE MODEL_STUF, ONLY : ELDT, ELOUT, GROUT, OELOUT, OGROUT, LABEL, SCNUM, STITLE, SUBLOD, TITLE - USE MODEL_STUF, ONLY : CC_EIGR_SID_SUB, EIG_PARAMS, IS_MODES_SUBCASE, NUM_EIGENS_SUB + USE MODEL_STUF, ONLY : CC_EIGR_SID_SUB, CC_STATSUB_SUB, EIG_PARAMS, IS_BUCKLING_SUBCASE, IS_MODES_SUBCASE, & + NUM_EIGENS_SUB USE MODEL_STUF, ONLY : SYS_LOAD USE MODEL_STUF, ONLY : CETEMP, CETEMP_ERR, CGTEMP, CGTEMP_ERR, ETEMP, ETEMP_INIT, GTEMP, GTEMP_INIT, TDATA, TPNT USE MODEL_STUF, ONLY : RIGID_ELEM_IDS @@ -297,10 +298,11 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) ENDIF ENDIF - ! NOTE: CC_EIGR_SID_SUB, IS_MODES_SUBCASE, NUM_EIGENS_SUB, and EIG_PARAMS are deliberately *not* deallocated - ! alongside SCNUM. LINK9 deallocates+reallocates SCNUM at startup, and we need the per-subcase eigen state - ! populated by LK1/LK4 to survive that cycle so LINK9 can iterate modes per their owning subcase. The matching - ! ALLOCATE_MODEL_STUF('SCNUM') skips them when they are already allocated, so they remain populated. + ! NOTE: CC_EIGR_SID_SUB, CC_STATSUB_SUB, IS_MODES_SUBCASE, IS_BUCKLING_SUBCASE, NUM_EIGENS_SUB, and EIG_PARAMS + ! are deliberately *not* deallocated alongside SCNUM. LINK9 deallocates+reallocates SCNUM at startup, and we + ! need the per-subcase eigen/buckling state populated by LK1/LK4 to survive that cycle so LINK9 can iterate + ! modes per their owning subcase. The matching ALLOCATE_MODEL_STUF('SCNUM') skips them when they are already + ! allocated, so they remain populated. ELSE IF (NAME_IN == 'SUBLOD') THEN ! Deallocate array SUBLOD From 1c63e535e64db50631f9366d785de0b85788a187 Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 16:57:29 -0300 Subject: [PATCH 07/11] more statsub work: L5A mess --- .../READ_L5A_UG_FOR_SUBCASE_Interface.f90 | 47 ++++++ Source/LK5/LINK5.f90 | 44 +++++- .../READ_L5A_UG_FOR_SUBCASE_USE_IFs.f90 | 34 +++++ Source/UTIL/READ_L5A_UG_FOR_SUBCASE.f90 | 135 ++++++++++++++++++ 4 files changed, 258 insertions(+), 2 deletions(-) create mode 100644 Source/Interfaces/READ_L5A_UG_FOR_SUBCASE_Interface.f90 create mode 100644 Source/USE_IFs/READ_L5A_UG_FOR_SUBCASE_USE_IFs.f90 create mode 100644 Source/UTIL/READ_L5A_UG_FOR_SUBCASE.f90 diff --git a/Source/Interfaces/READ_L5A_UG_FOR_SUBCASE_Interface.f90 b/Source/Interfaces/READ_L5A_UG_FOR_SUBCASE_Interface.f90 new file mode 100644 index 00000000..eb6977c7 --- /dev/null +++ b/Source/Interfaces/READ_L5A_UG_FOR_SUBCASE_Interface.f90 @@ -0,0 +1,47 @@ +! ############################################################################################################################### +! 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 READ_L5A_UG_FOR_SUBCASE_Interface + + INTERFACE + + SUBROUTINE READ_L5A_UG_FOR_SUBCASE ( ISUB, IERROR ) + + + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE + + IMPLICIT NONE + + INTEGER(LONG), INTENT(IN) :: ISUB + INTEGER(LONG), INTENT(INOUT) :: IERROR + + + + END SUBROUTINE READ_L5A_UG_FOR_SUBCASE + + END INTERFACE + + END MODULE READ_L5A_UG_FOR_SUBCASE_Interface diff --git a/Source/LK5/LINK5.f90 b/Source/LK5/LINK5.f90 index c343aaac..d92fedf3 100644 --- a/Source/LK5/LINK5.f90 +++ b/Source/LK5/LINK5.f90 @@ -51,10 +51,11 @@ SUBROUTINE LINK5 USE DEBUG_PARAMETERS, ONLY : DEBUG USE DOF_TABLES, ONLY : TDOF, TDOFI USE MODEL_STUF, ONLY : GRID, GRID_ID, INV_GRID_SEQ, EIG_COMP, EIG_GRID, EIG_NORM, MAXMIJ, MIJ_COL, MIJ_ROW, & - EIG_PARAMS + EIG_PARAMS, IS_BUCKLING_SUBCASE USE LINK5_USE_IFs USE LINK_MESSAGE_Interface + USE READ_L5A_UG_FOR_SUBCASE_Interface IMPLICIT NONE @@ -322,7 +323,10 @@ SUBROUTINE LINK5 NUM_SOLNS = NVEC ELSE IF (SOL_NAME(1:8) == 'BUCKLING') THEN IF (LOAD_ISTEP == 1) THEN - NUM_SOLNS = 1 + ! Process every subcase's static solution so file LINK5A holds one full UG_COL per subcase. + ! The step-2 KGGD assembly (and any per-buckling-subcase preload selection done via STATSUB) seeks into + ! L5A by subcase index and reads back the appropriate preload UG, so we must have all NSUB columns on disk. + NUM_SOLNS = NSUB ELSE IF (LOAD_ISTEP == 2) THEN NUM_SOLNS = NVEC ENDIF @@ -606,6 +610,42 @@ SUBROUTINE LINK5 ENDDO j_do ! End of loop on NUM_SOLNS +! For SOL 105 step 1, the j_do loop above iterates over every subcase, including the buckling subcases (which carry no load, +! so their UG_COL is zero). Without intervention the UG_COL left in memory after the loop is whichever subcase happened to be +! processed last. The step-2 LINK1 ESP path uses that residual UG_COL to assemble the differential stiffness KGGD. To preserve +! legacy single-preload behaviour (and to give multi-buckling decks a sensible default until the explicit per-buckling-subcase +! preload selection lands in a later phase), we reload UG_COL with the canonical preload subcase's column from L5A. +! The canonical choice is the STATSUB_REF resolved for the first buckling subcase. If for some reason none of that information +! is available (defensive fallback only — LOADC always resolves it for valid decks) we leave UG_COL untouched. + + IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1)) THEN + BUCKLING_PRELOAD_RELOAD : BLOCK + INTEGER(LONG) :: I_BUCK, ISUB_PRELOAD, IERR_RELOAD + ISUB_PRELOAD = 0 + IF (ALLOCATED(IS_BUCKLING_SUBCASE) .AND. ALLOCATED(EIG_PARAMS)) THEN + DO I_BUCK = 1, NSUB + IF (IS_BUCKLING_SUBCASE(I_BUCK) == 'Y') THEN + IF (EIG_PARAMS(I_BUCK)%STATSUB_REF > 0) THEN + ISUB_PRELOAD = EIG_PARAMS(I_BUCK)%STATSUB_REF + EXIT + ENDIF + ENDIF + ENDDO + ENDIF + IF (ISUB_PRELOAD > 0) THEN + CALL DEALLOCATE_COL_VEC ( 'UG_COL' ) + CALL ALLOCATE_COL_VEC ( 'UG_COL', NDOFG, SUBR_NAME ) + IERR_RELOAD = 0 + CALL READ_L5A_UG_FOR_SUBCASE ( ISUB_PRELOAD, IERR_RELOAD ) + IF (IERR_RELOAD /= 0) THEN + WRITE(ERR,9995) LINKNO, IERR_RELOAD + WRITE(F06,9995) LINKNO, IERR_RELOAD + CALL OUTA_HERE ( 'Y' ) + ENDIF + ENDIF + END BLOCK BUCKLING_PRELOAD_RELOAD + ENDIF + ! If CB soln, expand PHIXA to G-set size and write to file unit L5B IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN diff --git a/Source/USE_IFs/READ_L5A_UG_FOR_SUBCASE_USE_IFs.f90 b/Source/USE_IFs/READ_L5A_UG_FOR_SUBCASE_USE_IFs.f90 new file mode 100644 index 00000000..5b25a992 --- /dev/null +++ b/Source/USE_IFs/READ_L5A_UG_FOR_SUBCASE_USE_IFs.f90 @@ -0,0 +1,34 @@ +! 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 READ_L5A_UG_FOR_SUBCASE_USE_IFs + +! USE Interface statements for all subroutines called by SUBROUTINE READ_L5A_UG_FOR_SUBCASE + + USE FILE_OPEN_Interface + USE FILE_CLOSE_Interface + USE READERR_Interface + + END MODULE READ_L5A_UG_FOR_SUBCASE_USE_IFs diff --git a/Source/UTIL/READ_L5A_UG_FOR_SUBCASE.f90 b/Source/UTIL/READ_L5A_UG_FOR_SUBCASE.f90 new file mode 100644 index 00000000..fe18b7b8 --- /dev/null +++ b/Source/UTIL/READ_L5A_UG_FOR_SUBCASE.f90 @@ -0,0 +1,135 @@ +! ################################################################################################################################## +! 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 READ_L5A_UG_FOR_SUBCASE ( ISUB, IERROR ) + +! Reads the G-set displacement vector (UG_COL) for a specific internal subcase index from file LINK5A. +! File LINK5A is written by LINK5 during the linear-static portion of an analysis: for each of NUM_SOLNS solution columns, +! LINK5 writes NDOFG unformatted records, one per G-set DOF, holding the column's UG values. For SOL 105 (BUCKLING) the +! step-1 LINK5 invocation writes one full UG vector per subcase (NUM_SOLNS == NSUB), so seeking past (ISUB-1)*NDOFG records +! and reading the next NDOFG records yields subcase ISUB's UG displacements. +! +! Caller responsibilities: +! * UG_COL must already be allocated to size NDOFG (use ALLOCATE_COL_VEC('UG_COL',NDOFG,SUBR_NAME) if not). +! * The L5A file must contain at least ISUB columns of NDOFG records each (i.e. LINK5 step 1 must have run with +! NUM_SOLNS >= ISUB). +! On error, IERROR is incremented; on success it is left unchanged. + + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE + USE IOUNT1, ONLY : ERR, F06, L5A, LINK5A, L5A_MSG + USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG + USE COL_VECS, ONLY : UG_COL + + USE READ_L5A_UG_FOR_SUBCASE_USE_IFs + + IMPLICIT NONE + + CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'READ_L5A_UG_FOR_SUBCASE' + + INTEGER(LONG), INTENT(IN) :: ISUB ! Internal subcase index (1..NSUB) to fetch UG_COL for + INTEGER(LONG), INTENT(INOUT) :: IERROR ! Cumulative error count, incremented on any IO failure + + INTEGER(LONG) :: I ! DO loop index + INTEGER(LONG) :: IOCHK ! IOSTAT from READ + INTEGER(LONG) :: REC_NO ! Record number for READERR diagnostics + INTEGER(LONG) :: SKIP ! Number of records to skip before reaching subcase ISUB + INTEGER(LONG) :: OUNT(2) ! File units for READERR + + + +! ********************************************************************************************************************************** + OUNT(1) = ERR + OUNT(2) = F06 + + IF (ISUB < 1) THEN + WRITE(ERR,9101) SUBR_NAME, ISUB + WRITE(F06,9101) SUBR_NAME, ISUB + FATAL_ERR = FATAL_ERR + 1 + IERROR = IERROR + 1 + RETURN + ENDIF + + IF (.NOT. ALLOCATED(UG_COL)) THEN + WRITE(ERR,9102) SUBR_NAME + WRITE(F06,9102) SUBR_NAME + FATAL_ERR = FATAL_ERR + 1 + IERROR = IERROR + 1 + RETURN + ENDIF + + IF (SIZE(UG_COL) < NDOFG) THEN + WRITE(ERR,9103) SUBR_NAME, SIZE(UG_COL), NDOFG + WRITE(F06,9103) SUBR_NAME, SIZE(UG_COL), NDOFG + FATAL_ERR = FATAL_ERR + 1 + IERROR = IERROR + 1 + RETURN + ENDIF + + ! Open L5A fresh in READ/REWIND mode. If it is already open elsewhere we close it first so we can rewind cleanly. + CALL FILE_CLOSE ( L5A, LINK5A, 'KEEP' ) + CALL FILE_OPEN ( L5A, LINK5A, OUNT, 'OLD', L5A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) + + ! Skip (ISUB-1)*NDOFG records to position at the start of subcase ISUB's UG vector. + SKIP = (ISUB - 1) * NDOFG + REC_NO = 0 + DO I = 1, SKIP + REC_NO = REC_NO + 1 + READ(L5A,IOSTAT=IOCHK) + IF (IOCHK /= 0) THEN + CALL READERR ( IOCHK, LINK5A, L5A_MSG, REC_NO, OUNT ) + IERROR = IERROR + 1 + CALL FILE_CLOSE ( L5A, LINK5A, 'KEEP' ) + RETURN + ENDIF + ENDDO + + ! Read NDOFG records into UG_COL. + DO I = 1, NDOFG + REC_NO = REC_NO + 1 + READ(L5A,IOSTAT=IOCHK) UG_COL(I) + IF (IOCHK /= 0) THEN + CALL READERR ( IOCHK, LINK5A, L5A_MSG, REC_NO, OUNT ) + IERROR = IERROR + 1 + CALL FILE_CLOSE ( L5A, LINK5A, 'KEEP' ) + RETURN + ENDIF + ENDDO + + ! Leave L5A closed so the next writer (e.g. step-2 LINK5) can REPLACE it cleanly. + CALL FILE_CLOSE ( L5A, LINK5A, 'KEEP' ) + + + + RETURN + +! ********************************************************************************************************************************** + 9101 FORMAT(' *ERROR 9101: PROGRAMMING ERROR IN ',A,': ISUB MUST BE >= 1 BUT IS ',I8) + 9102 FORMAT(' *ERROR 9102: PROGRAMMING ERROR IN ',A,': UG_COL IS NOT ALLOCATED') + 9103 FORMAT(' *ERROR 9103: PROGRAMMING ERROR IN ',A,': SIZE(UG_COL)=',I8,' IS LESS THAN NDOFG=',I8) + +! ********************************************************************************************************************************** + + END SUBROUTINE READ_L5A_UG_FOR_SUBCASE From 32cd1f158cd9976fdf6ba7fcf272711e37e1e3b6 Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 17:03:08 -0300 Subject: [PATCH 08/11] more STATSUB work: reentrant KGGD build --- .../BUILD_KGGD_FROM_UG_Interface.f90 | 39 +++++ Source/LK1/LINK1/BUILD_KGGD_FROM_UG.f90 | 120 ++++++++++++++++ Source/LK1/LINK1/LINK1.f90 | 134 ++++++++++-------- Source/USE_IFs/BUILD_KGGD_FROM_UG_USE_IFs.f90 | 37 +++++ 4 files changed, 274 insertions(+), 56 deletions(-) create mode 100644 Source/Interfaces/BUILD_KGGD_FROM_UG_Interface.f90 create mode 100644 Source/LK1/LINK1/BUILD_KGGD_FROM_UG.f90 create mode 100644 Source/USE_IFs/BUILD_KGGD_FROM_UG_USE_IFs.f90 diff --git a/Source/Interfaces/BUILD_KGGD_FROM_UG_Interface.f90 b/Source/Interfaces/BUILD_KGGD_FROM_UG_Interface.f90 new file mode 100644 index 00000000..4ea7f835 --- /dev/null +++ b/Source/Interfaces/BUILD_KGGD_FROM_UG_Interface.f90 @@ -0,0 +1,39 @@ +! ############################################################################################################################### +! 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 BUILD_KGGD_FROM_UG_Interface + + INTERFACE + + SUBROUTINE BUILD_KGGD_FROM_UG + + IMPLICIT NONE + + END SUBROUTINE BUILD_KGGD_FROM_UG + + END INTERFACE + + END MODULE BUILD_KGGD_FROM_UG_Interface diff --git a/Source/LK1/LINK1/BUILD_KGGD_FROM_UG.f90 b/Source/LK1/LINK1/BUILD_KGGD_FROM_UG.f90 new file mode 100644 index 00000000..0c3d9ea3 --- /dev/null +++ b/Source/LK1/LINK1/BUILD_KGGD_FROM_UG.f90 @@ -0,0 +1,120 @@ +! ################################################################################################################################## +! 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 BUILD_KGGD_FROM_UG + +! Re-entrant assembly of the G-set differential stiffness matrix KGGD from the displacement field currently held in UG_COL. +! +! This is the SOL 105 step-2 KGGD assembly path that previously lived inline in LINK1. It has been factored out so that the +! multi-buckling-subcase driver added in Phase 4 can rebuild KGGD once per buckling subcase (each with its own preload UG_COL) +! without re-entering all of LINK1. +! +! Caller responsibilities: +! * UG_COL must already be loaded with the preload static displacement field for the buckling subcase being assembled +! (typically by READ_L5A_UG_FOR_SUBCASE). Element ELMDIS calls (gated on OPT(6)=='Y' .AND. LOAD_ISTEP>1) read from UG_COL +! to form per-element KED contributions. +! * MPC_IND_GRIDS must remain allocated across repeated calls (SPARSE_KGGD consumes it). The original LINK1 step-2 block +! deallocated MPC_IND_GRIDS immediately after SPARSE_KGGD; for a single-shot invocation (the legacy path) that dealloc +! happens in LINK1 just after this routine returns, preserving prior behavior. +! +! Re-entry safety: any pre-existing sparse KGGD (I_KGGD, J_KGGD, KGGD) and STF linked-list arrays (STFKEY, STF3) are deallocated +! before fresh allocation so this routine is safe to call multiple times in a row. + + USE PENTIUM_II_KIND, ONLY : BYTE, LONG + USE IOUNT1, ONLY : ERR, F06, SC1 + USE SCONTR, ONLY : BLNK_SUB_NAM, LTERM_KGGD + USE PARAMS, ONLY : ESP0_PAUSE + USE SPARSE_MATRICES, ONLY : I_KGGD, J_KGGD, KGGD + USE STF_ARRAYS, ONLY : STFKEY, STF3 + + USE BUILD_KGGD_FROM_UG_USE_IFs + USE LINK_MESSAGE_Interface + + IMPLICIT NONE + + CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'BUILD_KGGD_FROM_UG' + + CHARACTER, PARAMETER :: CR13 = CHAR(13) + CHARACTER( 1*BYTE) :: RESPONSE ! Used only if ESP0_PAUSE == 'Y' + + INTEGER(LONG) :: LTERM ! Local copy of LTERM_KGGD for optional interactive override + + + +! ********************************************************************************************************************************** + +! 1) Drop any stale sparse KGGD left over from a prior buckling-subcase iteration. + + IF (ALLOCATED(KGGD) .OR. ALLOCATED(I_KGGD) .OR. ALLOCATED(J_KGGD)) THEN + CALL DEALLOCATE_SPARSE_MAT ( 'KGGD' ) + ENDIF + +! 2) Drop any stale STF linked-list arrays. ALLOCATE_STF_ARRAYS FATALs if its target is already allocated, so deallocate first. + + IF (ALLOCATED(STFKEY)) CALL DEALLOCATE_STF_ARRAYS ( 'STFKEY' ) + IF (ALLOCATED(STF3)) CALL DEALLOCATE_STF_ARRAYS ( 'STF3' ) + +! 3) Estimate LTERM_KGGD (subr ESP0 sizes the linked-list storage for the element merge pass). + + CALL ESP0 + CALL LINK_MESSAGE('CALCULATE ESTIMATE OF KGGD MATRIX SIZE ') + LTERM = LTERM_KGGD + + IF (ESP0_PAUSE == 'Y') THEN + WRITE(SC1,'(A,A,I12)') ' From ESP0: ', 'LTERM_KGGD', ' = ', LTERM + WRITE(SC1,'(A,A)') ' Do you want to change ', 'LTERM_KGGD estimate? (Y/N)' + READ(*,*) RESPONSE + IF ((RESPONSE == 'Y') .OR. (RESPONSE == 'y')) THEN + WRITE(SC1,'(A)') 'Enter new LTERM_KGGD' + WRITE(SC1,*) + READ(*,*) LTERM + LTERM_KGGD = LTERM + WRITE(SC1,'(A,I12)') 'New LTERM_KGGD will be = ', LTERM + ENDIF + ENDIF + +! 4) Allocate STF linked-list workspace, run ESP (element-by-element KED merge), then condense to sparse KGGD. + + CALL LINK_MESSAGE('ALLOCATE MEM FOR STFKEY, STFCOL, STFPNT, STF') + CALL ALLOCATE_STF_ARRAYS ( 'STFKEY', SUBR_NAME ) + CALL ALLOCATE_STF_ARRAYS ( 'STF3', SUBR_NAME ) + + CALL LINK_MESSAGE('G-SET STIFFNESS MATRIX PROCESSOR ') + CALL ESP + + CALL LINK_MESSAGE('SPARSE KGGD PROCESSOR ') + CALL SPARSE_KGGD + + CALL DEALLOCATE_STF_ARRAYS ( 'STFKEY' ) + CALL DEALLOCATE_STF_ARRAYS ( 'STF3' ) + + WRITE(SC1,*) CR13 + + + + RETURN + + END SUBROUTINE BUILD_KGGD_FROM_UG diff --git a/Source/LK1/LINK1/LINK1.f90 b/Source/LK1/LINK1/LINK1.f90 index d6f4e6ad..b143d365 100644 --- a/Source/LK1/LINK1/LINK1.f90 +++ b/Source/LK1/LINK1/LINK1.f90 @@ -59,6 +59,7 @@ SUBROUTINE LINK1 USE LINK1_USE_IFs USE LINK_MESSAGE_Interface + USE BUILD_KGGD_FROM_UG_Interface IMPLICIT NONE @@ -315,87 +316,108 @@ SUBROUTINE LINK1 ! Estimate LTERM so arrays can be allocated for G-set stiffness matrix - CALL ESP0 IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN - CALL LINK_MESSAGE('CALCULATE ESTIMATE OF KGGD MATRIX SIZE ') - LTERM_NAME = 'LTERM_KGGD' - LTERM = LTERM_KGGD + +! KGGD assembly path: delegated to a re-entrant helper so the Phase 4 multi-buckling-subcase driver can rebuild KGGD +! once per buckling subcase (each with its own preload UG_COL) without re-entering all of LINK1. For the single-shot legacy +! path this is behaviorally identical to the previous inline ESP0 / ALLOCATE_STF_ARRAYS / ESP / SPARSE_KGGD sequence. + + CALL BUILD_KGGD_FROM_UG + + IF ((SOL_NAME(1:8) /= 'BUCKLING') .AND. (SOL_NAME(1:8) /= 'NLSTATIC') .AND. (SOL_NAME(1:8) /= 'DIFFEREN')) THEN + CALL DEALLOCATE_MODEL_STUF ( 'SCNUM' ) + CALL DEALLOCATE_MODEL_STUF ( 'ELDT' ) + CALL DEALLOCATE_MODEL_STUF ( 'TPNT, TDATA' ) + CALL DEALLOCATE_MODEL_STUF ( 'PPNT, PDATA, PTYPE' ) + CALL DEALLOCATE_MODEL_STUF ( 'PLOAD4_3D_DATA' ) + CALL DEALLOCATE_MODEL_STUF ( 'GTEMP' ) + ENDIF + + INQUIRE ( FILE=F23FIL, EXIST=LEXIST, OPENED=LOPEN ) + IF (LOPEN) THEN + CALL FILE_CLOSE ( F23, F23FIL, 'KEEP' ) + ELSE + CALL FILE_CLOSE ( F23, F23FIL, 'DELETE' ) + ENDIF + + CALL DEALLOCATE_IN4_FILES ( 'IN4FIL' ) + + INQUIRE ( FILE=F24FIL, EXIST=LEXIST, OPENED=LOPEN ) + IF (LOPEN) THEN + CALL FILE_CLOSE ( F24, F24FIL, 'KEEP' ) + ELSE + CALL FILE_CLOSE ( F24, F24FIL, 'DELETE' ) + ENDIF + + CALL DEALLOCATE_MODEL_STUF ( 'MPC_IND_GRIDS' ) + ELSE + + CALL ESP0 CALL LINK_MESSAGE('CALCULATE ESTIMATE OF KGG MATRIX SIZE ') LTERM_NAME = 'LTERM_KGG' LTERM = LTERM_KGG - ENDIF - IF (ESP0_PAUSE == 'Y') THEN - WRITE(SC1,'(A,A,A,I12)') ' From ESP0: ', LTERM_NAME,' = ',LTERM - WRITE(SC1,'(A,A,A)') ' Do you want to change ',LTERM_NAME,' estimate? (Y/N)' - READ(*,*) RESPONSE - IF ((RESPONSE == 'Y') .OR. (RESPONSE == 'y')) THEN - WRITE(SC1,'(A,A)') 'Enter new ', LTERM_NAME - WRITE(SC1,*) - READ (*,*) LTERM - IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN - LTERM_KGGD = LTERM - ELSE + IF (ESP0_PAUSE == 'Y') THEN + WRITE(SC1,'(A,A,A,I12)') ' From ESP0: ', LTERM_NAME,' = ',LTERM + WRITE(SC1,'(A,A,A)') ' Do you want to change ',LTERM_NAME,' estimate? (Y/N)' + READ(*,*) RESPONSE + IF ((RESPONSE == 'Y') .OR. (RESPONSE == 'y')) THEN + WRITE(SC1,'(A,A)') 'Enter new ', LTERM_NAME + WRITE(SC1,*) + READ (*,*) LTERM LTERM_KGG = LTERM + WRITE(SC1,'(A,A,A,I12)') 'New ', LTERM_NAME,' will be = ',LTERM ENDIF - WRITE(SC1,'(A,A,A,I12)') 'New ', LTERM_NAME,' will be = ',LTERM ENDIF - ENDIF - if (setlktk /= 3) then ! Subr ESP0 estimated LTERM conservatively. Now allocate this amount - CALL LINK_MESSAGE('ALLOCATE MEM FOR STFKEY, STFCOL, STFPNT, STF') - CALL ALLOCATE_STF_ARRAYS ( 'STFKEY', SUBR_NAME ) - CALL ALLOCATE_STF_ARRAYS ( 'STF3', SUBR_NAME ) - else - Write(err,*) '*ERROR : PROGRAMMING ERROR IN SUBR ',SUBR_NAME,' SETLKTK CANNOT = 3' - Write(f06,*) '*ERROR : PROGRAMMING ERROR IN SUBR ',SUBR_NAME,' SETLKTK CANNOT = 3' - endif + if (setlktk /= 3) then ! Subr ESP0 estimated LTERM conservatively. Now allocate this amount + CALL LINK_MESSAGE('ALLOCATE MEM FOR STFKEY, STFCOL, STFPNT, STF') + CALL ALLOCATE_STF_ARRAYS ( 'STFKEY', SUBR_NAME ) + CALL ALLOCATE_STF_ARRAYS ( 'STF3', SUBR_NAME ) + else + Write(err,*) '*ERROR : PROGRAMMING ERROR IN SUBR ',SUBR_NAME,' SETLKTK CANNOT = 3' + Write(f06,*) '*ERROR : PROGRAMMING ERROR IN SUBR ',SUBR_NAME,' SETLKTK CANNOT = 3' + endif ! Compute element stiffness and merge into system stiffness matrix. - CALL LINK_MESSAGE('G-SET STIFFNESS MATRIX PROCESSOR ') - CALL ESP + CALL LINK_MESSAGE('G-SET STIFFNESS MATRIX PROCESSOR ') + CALL ESP - IF ((SOL_NAME(1:8) /= 'BUCKLING') .AND. (SOL_NAME(1:8) /= 'NLSTATIC') .AND. (SOL_NAME(1:8) /= 'DIFFEREN')) THEN - CALL DEALLOCATE_MODEL_STUF ( 'SCNUM' ) - CALL DEALLOCATE_MODEL_STUF ( 'ELDT' ) - CALL DEALLOCATE_MODEL_STUF ( 'TPNT, TDATA' ) - CALL DEALLOCATE_MODEL_STUF ( 'PPNT, PDATA, PTYPE' ) - CALL DEALLOCATE_MODEL_STUF ( 'PLOAD4_3D_DATA' ) - CALL DEALLOCATE_MODEL_STUF ( 'GTEMP' ) - ENDIF + IF ((SOL_NAME(1:8) /= 'BUCKLING') .AND. (SOL_NAME(1:8) /= 'NLSTATIC') .AND. (SOL_NAME(1:8) /= 'DIFFEREN')) THEN + CALL DEALLOCATE_MODEL_STUF ( 'SCNUM' ) + CALL DEALLOCATE_MODEL_STUF ( 'ELDT' ) + CALL DEALLOCATE_MODEL_STUF ( 'TPNT, TDATA' ) + CALL DEALLOCATE_MODEL_STUF ( 'PPNT, PDATA, PTYPE' ) + CALL DEALLOCATE_MODEL_STUF ( 'PLOAD4_3D_DATA' ) + CALL DEALLOCATE_MODEL_STUF ( 'GTEMP' ) + ENDIF - INQUIRE ( FILE=F23FIL, EXIST=LEXIST, OPENED=LOPEN ) - IF (LOPEN) THEN - CALL FILE_CLOSE ( F23, F23FIL, 'KEEP' ) - ELSE - CALL FILE_CLOSE ( F23, F23FIL, 'DELETE' ) - ENDIF + INQUIRE ( FILE=F23FIL, EXIST=LEXIST, OPENED=LOPEN ) + IF (LOPEN) THEN + CALL FILE_CLOSE ( F23, F23FIL, 'KEEP' ) + ELSE + CALL FILE_CLOSE ( F23, F23FIL, 'DELETE' ) + ENDIF - CALL DEALLOCATE_IN4_FILES ( 'IN4FIL' ) + CALL DEALLOCATE_IN4_FILES ( 'IN4FIL' ) - INQUIRE ( FILE=F24FIL, EXIST=LEXIST, OPENED=LOPEN ) - IF (LOPEN) THEN - CALL FILE_CLOSE ( F24, F24FIL, 'KEEP' ) - ELSE - CALL FILE_CLOSE ( F24, F24FIL, 'DELETE' ) - ENDIF + INQUIRE ( FILE=F24FIL, EXIST=LEXIST, OPENED=LOPEN ) + IF (LOPEN) THEN + CALL FILE_CLOSE ( F24, F24FIL, 'KEEP' ) + ELSE + CALL FILE_CLOSE ( F24, F24FIL, 'DELETE' ) + ENDIF ! Convert system stiff matrix from linked list format to sparse format (SPARSE_KGG calls grid singularity check subr) - IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN - CALL LINK_MESSAGE('SPARSE KGGD PROCESSOR ') - CALL SPARSE_KGGD - CALL DEALLOCATE_MODEL_STUF ( 'MPC_IND_GRIDS' ) - CALL DEALLOCATE_STF_ARRAYS ( 'STFKEY' ) - CALL DEALLOCATE_STF_ARRAYS ( 'STF3' ) - ELSE CALL LINK_MESSAGE('SPARSE KGG PROCESSOR ') CALL SPARSE_KGG CALL DEALLOCATE_MODEL_STUF ( 'MPC_IND_GRIDS' ) CALL DEALLOCATE_STF_ARRAYS ( 'STFKEY' ) CALL DEALLOCATE_STF_ARRAYS ( 'STF3' ) + ENDIF ! Write DOF tables and deallocate diff --git a/Source/USE_IFs/BUILD_KGGD_FROM_UG_USE_IFs.f90 b/Source/USE_IFs/BUILD_KGGD_FROM_UG_USE_IFs.f90 new file mode 100644 index 00000000..1d3b842c --- /dev/null +++ b/Source/USE_IFs/BUILD_KGGD_FROM_UG_USE_IFs.f90 @@ -0,0 +1,37 @@ +! 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 BUILD_KGGD_FROM_UG_USE_IFs + +! USE Interface statements for all subroutines called by SUBROUTINE BUILD_KGGD_FROM_UG + + USE ESP0_Interface + USE ESP_Interface + USE SPARSE_KGGD_Interface + USE ALLOCATE_STF_ARRAYS_Interface + USE DEALLOCATE_STF_ARRAYS_Interface + USE DEALLOCATE_SPARSE_MAT_Interface + + END MODULE BUILD_KGGD_FROM_UG_USE_IFs From f13130ef70d96a3bea5723b6e71dc8ef2dcf9235 Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 17:33:26 -0300 Subject: [PATCH 09/11] STATSUB about done --- .../REBUILD_KLLD_FROM_KGGD_Interface.f90 | 39 +++++ Source/LK1/LINK1/BUILD_KGGD_FROM_UG.f90 | 15 ++ Source/LK1/LINK1/LINK1.f90 | 23 ++- Source/LK2/REBUILD_KLLD_FROM_KGGD.f90 | 143 ++++++++++++++++++ Source/LK2/REDUCE_KFFD_TO_KAAD.f90 | 7 +- Source/LK4/LINK4.f90 | 105 ++++++++++++- Source/USE_IFs/BUILD_KGGD_FROM_UG_USE_IFs.f90 | 2 + Source/USE_IFs/LINK4_USE_IFs.f90 | 5 + .../REBUILD_KLLD_FROM_KGGD_USE_IFs.f90 | 38 +++++ .../USE_IFs/REDUCE_KFFD_TO_KAAD_USE_IFs.f90 | 1 + 10 files changed, 364 insertions(+), 14 deletions(-) create mode 100644 Source/Interfaces/REBUILD_KLLD_FROM_KGGD_Interface.f90 create mode 100644 Source/LK2/REBUILD_KLLD_FROM_KGGD.f90 create mode 100644 Source/USE_IFs/REBUILD_KLLD_FROM_KGGD_USE_IFs.f90 diff --git a/Source/Interfaces/REBUILD_KLLD_FROM_KGGD_Interface.f90 b/Source/Interfaces/REBUILD_KLLD_FROM_KGGD_Interface.f90 new file mode 100644 index 00000000..147b4353 --- /dev/null +++ b/Source/Interfaces/REBUILD_KLLD_FROM_KGGD_Interface.f90 @@ -0,0 +1,39 @@ +! ############################################################################################################################### +! 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 REBUILD_KLLD_FROM_KGGD_Interface + + INTERFACE + + SUBROUTINE REBUILD_KLLD_FROM_KGGD + + IMPLICIT NONE + + END SUBROUTINE REBUILD_KLLD_FROM_KGGD + + END INTERFACE + + END MODULE REBUILD_KLLD_FROM_KGGD_Interface diff --git a/Source/LK1/LINK1/BUILD_KGGD_FROM_UG.f90 b/Source/LK1/LINK1/BUILD_KGGD_FROM_UG.f90 index 0c3d9ea3..21514b87 100644 --- a/Source/LK1/LINK1/BUILD_KGGD_FROM_UG.f90 +++ b/Source/LK1/LINK1/BUILD_KGGD_FROM_UG.f90 @@ -49,6 +49,7 @@ SUBROUTINE BUILD_KGGD_FROM_UG USE PARAMS, ONLY : ESP0_PAUSE USE SPARSE_MATRICES, ONLY : I_KGGD, J_KGGD, KGGD USE STF_ARRAYS, ONLY : STFKEY, STF3 + USE MODEL_STUF, ONLY : AGRID, BGRID USE BUILD_KGGD_FROM_UG_USE_IFs USE LINK_MESSAGE_Interface @@ -61,6 +62,7 @@ SUBROUTINE BUILD_KGGD_FROM_UG CHARACTER( 1*BYTE) :: RESPONSE ! Used only if ESP0_PAUSE == 'Y' INTEGER(LONG) :: LTERM ! Local copy of LTERM_KGGD for optional interactive override + LOGICAL :: WE_ALLOCD_SINGLE_ELEM_ARRS @@ -97,6 +99,15 @@ SUBROUTINE BUILD_KGGD_FROM_UG ENDIF ! 4) Allocate STF linked-list workspace, run ESP (element-by-element KED merge), then condense to sparse KGGD. +! SINGLE ELEMENT ARRAYS (AGRID, BGRID, DT, etc.) may have already been deallocated by LINK1 if we are being +! invoked re-entrantly from LINK4 for a multi-buckling-subcase rebuild. Re-allocate them just for this assembly +! pass and deallocate again on exit, so the legacy single-shot path's allocation state is preserved. + + WE_ALLOCD_SINGLE_ELEM_ARRS = .FALSE. + IF (.NOT. ALLOCATED(AGRID)) THEN + CALL ALLOCATE_MODEL_STUF ( 'SINGLE ELEMENT ARRAYS', SUBR_NAME ) + WE_ALLOCD_SINGLE_ELEM_ARRS = .TRUE. + ENDIF CALL LINK_MESSAGE('ALLOCATE MEM FOR STFKEY, STFCOL, STFPNT, STF') CALL ALLOCATE_STF_ARRAYS ( 'STFKEY', SUBR_NAME ) @@ -111,6 +122,10 @@ SUBROUTINE BUILD_KGGD_FROM_UG CALL DEALLOCATE_STF_ARRAYS ( 'STFKEY' ) CALL DEALLOCATE_STF_ARRAYS ( 'STF3' ) + IF (WE_ALLOCD_SINGLE_ELEM_ARRS) THEN + CALL DEALLOCATE_MODEL_STUF ( 'SINGLE ELEMENT ARRAYS' ) + ENDIF + WRITE(SC1,*) CR13 diff --git a/Source/LK1/LINK1/LINK1.f90 b/Source/LK1/LINK1/LINK1.f90 index b143d365..98b43db6 100644 --- a/Source/LK1/LINK1/LINK1.f90 +++ b/Source/LK1/LINK1/LINK1.f90 @@ -48,7 +48,8 @@ SUBROUTINE LINK1 USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, ELDT_F21_P_T_BIT, ELDT_F22_ME_BIT, ELDT_F23_KE_BIT, ELDT_F24_SE_BIT, & FATAL_ERR, IBIT, LINKNO, LTERM_KGG, LTERM_KGGD, LTERM_MGGE, NDOFM, NFORCE, & - NGRAV, NMPC, NPLOAD, NRFORCE, NRIGEL, NSLOAD, NTERM_RMG, NTSUB, RESTART, SOL_NAME + NGRAV, NMPC, NPLOAD, NRFORCE, NRIGEL, NSLOAD, NTERM_RMG, NTSUB, NUM_BUCKLING_SUBS, & + RESTART, SOL_NAME USE DOF_TABLES, ONLY : TDOFI @@ -349,7 +350,11 @@ SUBROUTINE LINK1 CALL FILE_CLOSE ( F24, F24FIL, 'DELETE' ) ENDIF - CALL DEALLOCATE_MODEL_STUF ( 'MPC_IND_GRIDS' ) + ! For SOL 105 multi-buckling decks LINK4 will iterate per buckling subcase, re-invoking BUILD_KGGD_FROM_UG + ! (via REBUILD_KLLD_FROM_KGGD) which requires MPC_IND_GRIDS to stay alive. LINK4 frees it after its loop. + IF (.NOT. ((SOL_NAME(1:8) == 'BUCKLING') .AND. (NUM_BUCKLING_SUBS > 1))) THEN + CALL DEALLOCATE_MODEL_STUF ( 'MPC_IND_GRIDS' ) + ENDIF ELSE @@ -452,10 +457,16 @@ SUBROUTINE LINK1 ENDIF res19 ! Deallocate - - CALL DEALLOCATE_MODEL_STUF ( 'SINGLE ELEMENT ARRAYS' ) - IF ((SOL_NAME(1:8) /= 'NLSTATIC') .AND. (SOL_NAME(1:8) /= 'DIFFEREN')) THEN - CALL DEALLOCATE_MODEL_STUF ( 'SUBLOD' ) +! +! For multi-buckling-subcase SOL 105 we defer these dealloc's so the LK4 multi-statsub driver can re-enter +! the LK1/LK2 reduction chain (via REBUILD_KLLD_FROM_KGGD -> BUILD_KGGD_FROM_UG -> ESP) without crashing on +! freed AGRID/BGRID/SUBLOD/etc. LK4 (or LK9) cleans them up after the buckling loop is done. + + IF (.NOT. ((SOL_NAME(1:8) == 'BUCKLING') .AND. (NUM_BUCKLING_SUBS > 1) .AND. (LOAD_ISTEP == 2))) THEN + CALL DEALLOCATE_MODEL_STUF ( 'SINGLE ELEMENT ARRAYS' ) + IF ((SOL_NAME(1:8) /= 'NLSTATIC') .AND. (SOL_NAME(1:8) /= 'DIFFEREN')) THEN + CALL DEALLOCATE_MODEL_STUF ( 'SUBLOD' ) + ENDIF ENDIF ! Check allocation status of allocatable arrays, if requested diff --git a/Source/LK2/REBUILD_KLLD_FROM_KGGD.f90 b/Source/LK2/REBUILD_KLLD_FROM_KGGD.f90 new file mode 100644 index 00000000..e4fc6761 --- /dev/null +++ b/Source/LK2/REBUILD_KLLD_FROM_KGGD.f90 @@ -0,0 +1,143 @@ +! ################################################################################################################################## +! 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 REBUILD_KLLD_FROM_KGGD + +! Re-entrant rebuild of the L-set differential stiffness matrix KLLD from the displacement field currently held in UG_COL. +! +! This is the SOL 105 step-2 LINK2 reduction chain (KGGD -> KNND -> KFFD -> KAAD -> KLLD) wrapped so the multi-buckling-subcase +! driver added to LINK4 (Phase 4) can rebuild KLLD once per buckling subcase (each with its own preload UG_COL) without +! re-entering all of LINK1 and LINK2. +! +! Caller responsibilities: +! * SOL_NAME(1:8) == 'BUCKLING' and LOAD_ISTEP == 2. Each of the four reducers below internally branches on those globals to +! run the D-only path. (Verify LOAD_ISTEP at call site; callers from LINK4 do not modify it.) +! * UG_COL must already be loaded with the preload static displacement field for the buckling subcase being assembled +! (typically by READ_L5A_UG_FOR_SUBCASE). This routine then calls BUILD_KGGD_FROM_UG which assembles KGGD from UG_COL. +! * Files L2A and L2E (containing GMN and GOA respectively) must remain on disk with CLOSE_STAT='KEEP'. REDUCE_KGGD_TO_KNND +! and REDUCE_KFFD_TO_KAAD self-load GMN/GOA from those files when not in memory. +! +! Re-entry safety: any pre-existing D-side derived matrices (KNND/KNMD/KMMD/KFFD/KFSD/KSSD/KAAD/KAOD/KOOD/KLLD/KRLD/KRRD) and +! any intermediate transposes/partitions (GMNt, KMND) are deallocated before the reduction chain is re-run. KGGD itself is +! also deallocated as part of the cleanup; BUILD_KGGD_FROM_UG rebuilds it afresh from UG_COL. +! +! KLL/MLL (the non-differential L-set matrices used in the buckling eigenproblem alongside KLLD) are NOT touched: those are +! built once during LINK2 step 1 and must persist across all buckling-subcase iterations. LINK4 already snapshots/restores +! KLL via KLL_BAK because the eigensolver consumes it destructively. + + USE PENTIUM_II_KIND, ONLY : BYTE, LONG + USE IOUNT1, ONLY : ERR, F06, SC1 + USE SCONTR, ONLY : BLNK_SUB_NAM, SOL_NAME, & + NTERM_KNND, NTERM_KNMD, NTERM_KMMD, & + NTERM_KFFD, NTERM_KFSD, NTERM_KSSD, & + NTERM_KAAD, NTERM_KAOD, NTERM_KOOD, & + NTERM_KLLD, NTERM_KRLD, NTERM_KRRD + USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP + USE SPARSE_MATRICES, ONLY : I_KNND, J_KNND, KNND, I_KNMD, J_KNMD, KNMD, I_KMMD, J_KMMD, KMMD, & + I_KFFD, J_KFFD, KFFD, I_KFSD, J_KFSD, KFSD, I_KSSD, J_KSSD, KSSD, & + I_KAAD, J_KAAD, KAAD, I_KAOD, J_KAOD, KAOD, I_KOOD, J_KOOD, KOOD, & + I_KLLD, J_KLLD, KLLD, I_KRLD, J_KRLD, KRLD, I_KRRD, J_KRRD, KRRD, & + I_GMN , J_GMN , GMN , I_GMNt, J_GMNt, GMNt, I_KMND, J_KMND, KMND, & + I_GOA , J_GOA , GOA , I_GOAt, J_GOAt, GOAt + + USE REBUILD_KLLD_FROM_KGGD_USE_IFs + + IMPLICIT NONE + + CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'REBUILD_KLLD_FROM_KGGD' + + + +! ********************************************************************************************************************************** +! Guard: this routine is BUCKLING step-2 only. + + IF ((SOL_NAME(1:8) /= 'BUCKLING') .OR. (LOAD_ISTEP /= 2)) THEN + WRITE(ERR,9101) SUBR_NAME, SOL_NAME, LOAD_ISTEP + WRITE(F06,9101) SUBR_NAME, SOL_NAME, LOAD_ISTEP + RETURN + ENDIF + +! ********************************************************************************************************************************** +! 1) Drop all stale D-side derived matrices from any prior iteration. +! These are everything REDUCE_G_NM/REDUCE_N_FS/REDUCE_F_AO/REDUCE_A_LR allocate on the D-only step-2 path. + + IF (ALLOCATED(KNND) .OR. ALLOCATED(I_KNND) .OR. ALLOCATED(J_KNND)) CALL DEALLOCATE_SPARSE_MAT ( 'KNND' ) + IF (ALLOCATED(KNMD) .OR. ALLOCATED(I_KNMD) .OR. ALLOCATED(J_KNMD)) CALL DEALLOCATE_SPARSE_MAT ( 'KNMD' ) + IF (ALLOCATED(KMMD) .OR. ALLOCATED(I_KMMD) .OR. ALLOCATED(J_KMMD)) CALL DEALLOCATE_SPARSE_MAT ( 'KMMD' ) + IF (ALLOCATED(KFFD) .OR. ALLOCATED(I_KFFD) .OR. ALLOCATED(J_KFFD)) CALL DEALLOCATE_SPARSE_MAT ( 'KFFD' ) + IF (ALLOCATED(KFSD) .OR. ALLOCATED(I_KFSD) .OR. ALLOCATED(J_KFSD)) CALL DEALLOCATE_SPARSE_MAT ( 'KFSD' ) + IF (ALLOCATED(KSSD) .OR. ALLOCATED(I_KSSD) .OR. ALLOCATED(J_KSSD)) CALL DEALLOCATE_SPARSE_MAT ( 'KSSD' ) + IF (ALLOCATED(KAAD) .OR. ALLOCATED(I_KAAD) .OR. ALLOCATED(J_KAAD)) CALL DEALLOCATE_SPARSE_MAT ( 'KAAD' ) + IF (ALLOCATED(KAOD) .OR. ALLOCATED(I_KAOD) .OR. ALLOCATED(J_KAOD)) CALL DEALLOCATE_SPARSE_MAT ( 'KAOD' ) + IF (ALLOCATED(KOOD) .OR. ALLOCATED(I_KOOD) .OR. ALLOCATED(J_KOOD)) CALL DEALLOCATE_SPARSE_MAT ( 'KOOD' ) + IF (ALLOCATED(KLLD) .OR. ALLOCATED(I_KLLD) .OR. ALLOCATED(J_KLLD)) CALL DEALLOCATE_SPARSE_MAT ( 'KLLD' ) + IF (ALLOCATED(KRLD) .OR. ALLOCATED(I_KRLD) .OR. ALLOCATED(J_KRLD)) CALL DEALLOCATE_SPARSE_MAT ( 'KRLD' ) + IF (ALLOCATED(KRRD) .OR. ALLOCATED(I_KRRD) .OR. ALLOCATED(J_KRRD)) CALL DEALLOCATE_SPARSE_MAT ( 'KRRD' ) + +! 2) Drop intermediate transposes / partitions that REDUCE_KGGD_TO_KNND allocates internally and does not deallocate +! in time for the next call (GMNt is freed at end of REDUCE_KGGD_TO_KNND; KMND is held until LINK2 end). GMN/GOA are +! self-loaded from L2A/L2E so dropping any in-memory copy here forces a fresh read. + + IF (ALLOCATED(GMNt) .OR. ALLOCATED(I_GMNt) .OR. ALLOCATED(J_GMNt)) CALL DEALLOCATE_SPARSE_MAT ( 'GMNt' ) + IF (ALLOCATED(KMND) .OR. ALLOCATED(I_KMND) .OR. ALLOCATED(J_KMND)) CALL DEALLOCATE_SPARSE_MAT ( 'KMND' ) + IF (ALLOCATED(GOAt) .OR. ALLOCATED(I_GOAt) .OR. ALLOCATED(J_GOAt)) CALL DEALLOCATE_SPARSE_MAT ( 'GOAt' ) + IF (ALLOCATED(GMN) .OR. ALLOCATED(I_GMN) .OR. ALLOCATED(J_GMN)) CALL DEALLOCATE_SPARSE_MAT ( 'GMN' ) + IF (ALLOCATED(GOA) .OR. ALLOCATED(I_GOA) .OR. ALLOCATED(J_GOA)) CALL DEALLOCATE_SPARSE_MAT ( 'GOA' ) + +! 3) Rebuild KGGD at the G-set from the current UG_COL. BUILD_KGGD_FROM_UG itself deallocs any stale KGGD before fresh assembly. + + CALL BUILD_KGGD_FROM_UG + +! 4) Re-zero the D-side term counters. Mirror the same zero-out that LINK2 step 2 performs before the four reducers. + + NTERM_KNND = 0 + NTERM_KNMD = 0 + NTERM_KMMD = 0 + NTERM_KFFD = 0 + NTERM_KFSD = 0 + NTERM_KSSD = 0 + NTERM_KAAD = 0 + NTERM_KAOD = 0 + NTERM_KOOD = 0 + NTERM_KLLD = 0 + NTERM_KRLD = 0 + NTERM_KRRD = 0 + +! 5) Re-run the LINK2 reduction chain. Each of these branches on (SOL_NAME=='BUCKLING' .AND. LOAD_ISTEP==2) and walks +! the D-only code path that produces the corresponding D matrix at the next reduced set. + + CALL REDUCE_G_NM ! KGGD -> KNND + CALL REDUCE_N_FS ! KNND -> KFFD + CALL REDUCE_F_AO ! KFFD -> KAAD + CALL REDUCE_A_LR ! KAAD -> KLLD + + RETURN + +! ********************************************************************************************************************************** + 9101 FORMAT(' *ERROR 9101: ',A,' was called with SOL_NAME = "',A,'" and LOAD_ISTEP = ',I0, & + '. This routine is only valid for BUCKLING step 2; ignoring call.') + + END SUBROUTINE REBUILD_KLLD_FROM_KGGD diff --git a/Source/LK2/REDUCE_KFFD_TO_KAAD.f90 b/Source/LK2/REDUCE_KFFD_TO_KAAD.f90 index d23d5e72..8cf96720 100644 --- a/Source/LK2/REDUCE_KFFD_TO_KAAD.f90 +++ b/Source/LK2/REDUCE_KFFD_TO_KAAD.f90 @@ -29,7 +29,7 @@ SUBROUTINE REDUCE_KFFD_TO_KAAD ( PART_VEC_F_AO ) ! Call routines to reduce the KFFD differential stiffness matrix from the F-set to the A, O-sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F06, L2E, LINK2E, L2E_MSG, SC1, WRT_ERR + USE IOUNT1, ONLY : ERR, F06, L2E, L2ESTAT, LINK2E, L2E_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, NDOFF, NDOFA, NDOFO, NTERM_KFFD, NTERM_KAAD, & NTERM_KAOD, NTERM_KOOD, NTERM_KOODs, NTERM_GOA USE PARAMS, ONLY : EPSIL, KOORAT, SPARSTOR, RCONDK @@ -122,6 +122,11 @@ SUBROUTINE REDUCE_KFFD_TO_KAAD ( PART_VEC_F_AO ) IF (NTERM_KAOD > 0) THEN ! Calc KAOD*GOA & add it orig KAAD + IF (.NOT. ALLOCATED(GOA)) THEN ! Self-load GOA from L2E if not in memory (needed for re-entrant call) + CALL ALLOCATE_SPARSE_MAT ( 'GOA', NDOFO, NTERM_GOA, SUBR_NAME ) + CALL READ_MATRIX_1 ( LINK2E, L2E, 'N', 'Y', 'KEEP', L2E_MSG, & + 'GOA', NTERM_GOA, 'Y', NDOFO, I_GOA, J_GOA, GOA ) + ENDIF ! CCS1 will be sparse CCS format version of sparse CRS matrix GOA CALL ALLOCATE_SCR_CCS_MAT ( 'CCS1', NDOFA, NTERM_GOA, SUBR_NAME ) diff --git a/Source/LK4/LINK4.f90 b/Source/LK4/LINK4.f90 index edfdf83c..a3072901 100644 --- a/Source/LK4/LINK4.f90 +++ b/Source/LK4/LINK4.f90 @@ -55,17 +55,17 @@ SUBROUTINE LINK4 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, ERRSTAT, F06, L1M, L3A, SC1 USE IOUNT1, ONLY : LINK1M, LINK2I, LINK3A, L1M_MSG, L3A_MSG - USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, FATAL_ERR, LINKNO, MBUG, NDOFL, NSUB, & + USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, FATAL_ERR, LINKNO, MBUG, NDOFG, NDOFL, NSUB, & NTERM_KLL, NTERM_KLLD, NTERM_KLLDn, & NTERM_MLL, NTERM_MLLn, & NVEC, NUM_EIGENS, NUM_KLLD_DIAG_ZEROS, NUM_MLL_DIAG_ZEROS, SOL_NAME, WARN_ERR, & - MODE_SUBCASE, NUM_MODES_SUBS, TOTAL_MODES + MODE_SUBCASE, NUM_MODES_SUBS, NUM_BUCKLING_SUBS, TOTAL_MODES USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EPSIL, SOLLIB, SPARSTOR, SUPINFO USE MODEL_STUF, ONLY : EIG_COMP, EIG_CRIT, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_METH, EIG_MSGLVL, EIG_LAP_MAT_TYPE, & EIG_MODE, EIG_N1, EIG_N2, EIG_NCVFACL, EIG_NORM, EIG_SID, EIG_SIGMA, EIG_VECS, MAXMIJ, & - MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT, EIG_PARAMS, IS_MODES_SUBCASE, NUM_EIGENS_SUB, & - CC_EIGR_SID + MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT, EIG_PARAMS, IS_MODES_SUBCASE, IS_BUCKLING_SUBCASE, & + NUM_EIGENS_SUB, CC_EIGR_SID USE SPARSE_MATRICES, ONLY : I_KLL, J_KLL, KLL, I_KLLD, J_KLLD, KLLD, I_KLLDn, J_KLLDn, KLLDn, & I_MLL, J_MLL, MLL, I_MLLn, J_MLLn, MLLn @@ -97,6 +97,12 @@ SUBROUTINE LINK4 INTEGER(LONG), ALLOCATABLE :: J_KLL_BAK(:) ! Shadow of J_KLL across solver iterations REAL(DOUBLE), ALLOCATABLE :: KLL_BAK(:) ! Shadow of KLL across solver iterations + ! BUCKLING multi-subcase per-iter preload swap state (SOL 105 with multiple buckling subcases / distinct STATSUBs) + LOGICAL :: IS_BUCK_MULTI ! True when SOL 105 with NUM_BUCKLING_SUBS > 1 + INTEGER(LONG) :: CURRENT_PRELOAD_ISUB! Static-subcase ISUB whose UG_COL is currently loaded / whose KLLD is built + INTEGER(LONG) :: TARGET_PRELOAD ! EIG_PARAMS(CUR_ISUB)%STATSUB_REF for the iter being solved + INTEGER(LONG) :: IERR_RELOAD ! Return status from READ_L5A_UG_FOR_SUBCASE + REAL(DOUBLE) :: EPS1 ! Small number to compare variables against zero. REAL(DOUBLE) :: EIGEN_VEC_COL(NDOFL)! One eigenvector put into a 1-D array. LOGICAL :: WRITE_MLL ! write the MLL matrix @@ -278,7 +284,10 @@ SUBROUTINE LINK4 ! so the downstream L3A write and LINK5/LINK9 can see the full mode set with MODE_SUBCASE giving per-mode subcase attribution. NUM_MODES_SUBS = 0 CANONICAL_ISUB = 0 - IF ((SOL_NAME(1:5) == 'MODES') .AND. ALLOCATED(IS_MODES_SUBCASE)) THEN + IS_BUCK_MULTI = .FALSE. + ! For SOL 105 LOADC populates IS_MODES_SUBCASE in lockstep with IS_BUCKLING_SUBCASE, so the same iteration logic + ! drives both the modes-multi (SOL 103) and the buckling-multi (SOL 105) paths. + IF (((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:8) == 'BUCKLING')) .AND. ALLOCATED(IS_MODES_SUBCASE)) THEN DO I=1,NSUB IF (IS_MODES_SUBCASE(I) == 'Y') THEN NUM_MODES_SUBS = NUM_MODES_SUBS + 1 @@ -302,6 +311,16 @@ SUBROUTINE LINK4 N_MODES_ITER = MAX(1, NUM_MODES_SUBS) + ! Detect SOL 105 multi-buckling-subcase mode. The canonical preload was loaded by LINK5 step 1 (= first buckling subcase's + ! STATSUB_REF) so iter 1 will not need to rebuild KLLD; iter 2+ may swap UG_COL and re-run REBUILD_KLLD_FROM_KGGD. + IS_BUCK_MULTI = ((SOL_NAME(1:8) == 'BUCKLING') .AND. (NUM_BUCKLING_SUBS > 1)) + CURRENT_PRELOAD_ISUB = 0 + IF (IS_BUCK_MULTI) THEN + IF (ALLOCATED(EIG_PARAMS) .AND. (CANONICAL_ISUB > 0) .AND. (CANONICAL_ISUB <= NSUB)) THEN + CURRENT_PRELOAD_ISUB = EIG_PARAMS(CANONICAL_ISUB)%STATSUB_REF + ENDIF + ENDIF + ! For multi-iter MODES solves we need to preserve KLL across iterations because EIG_LANCZOS_ARPACK destructively ! deallocates KLL mid-solve. Snapshot the CSR triple once here; restore at the head of iterations 2+. IF (N_MODES_ITER > 1) THEN @@ -328,6 +347,61 @@ SUBROUTINE LINK4 KLL = KLL_BAK ENDIF + ! For SOL 105 multi-buckling-subcase, iter>1 needs KLLD/KLLDn rebuilt (the inline KLLD/KLLDn deallocs at the end of + ! the previous iter freed them). If the target subcase's STATSUB preload differs from the one currently loaded, also + ! reload UG_COL from L5A before rebuilding. CUR_ISUB is determined just below from IS_MODES_SUBCASE / ITER; for the + ! SOL 105 path that mapping is identical because LOADC sets IS_MODES_SUBCASE == IS_BUCKLING_SUBCASE. + IF (IS_BUCK_MULTI .AND. (ITER > 1)) THEN + ! Map ITER -> CUR_ISUB locally so we can resolve TARGET_PRELOAD before the canonical scalar reload below + KCNT = 0 + CUR_ISUB = CANONICAL_ISUB + DO I=1,NSUB + IF (IS_MODES_SUBCASE(I) == 'Y') THEN + KCNT = KCNT + 1 + IF (KCNT == ITER) THEN + CUR_ISUB = I + EXIT + ENDIF + ENDIF + ENDDO + TARGET_PRELOAD = 0 + IF (ALLOCATED(EIG_PARAMS)) TARGET_PRELOAD = EIG_PARAMS(CUR_ISUB)%STATSUB_REF + IF ((TARGET_PRELOAD > 0) .AND. (TARGET_PRELOAD /= CURRENT_PRELOAD_ISUB)) THEN + CALL LINK_MESSAGE('RELOAD UG_COL FROM L5A FOR NEXT PRELOAD') + CALL DEALLOCATE_COL_VEC ( 'UG_COL' ) + CALL ALLOCATE_COL_VEC ( 'UG_COL', NDOFG, SUBR_NAME ) + IERR_RELOAD = 0 + CALL READ_L5A_UG_FOR_SUBCASE ( TARGET_PRELOAD, IERR_RELOAD ) + IF (IERR_RELOAD /= 0) THEN + WRITE(ERR,9994) SUBR_NAME, TARGET_PRELOAD, IERR_RELOAD + WRITE(F06,9994) SUBR_NAME, TARGET_PRELOAD, IERR_RELOAD + FATAL_ERR = FATAL_ERR + 1 + CALL OUTA_HERE ( 'Y' ) + ENDIF + CURRENT_PRELOAD_ISUB = TARGET_PRELOAD + ENDIF + CALL LINK_MESSAGE('REBUILD KLLD FROM CURRENT UG_COL (STATSUB)') + CALL REBUILD_KLLD_FROM_KGGD + ! Redo KLLDn conversion / copy (mirrors the pre-loop SPARSTOR block for BUCKLING) + IF (SPARSTOR == 'SYM ') THEN + CALL SPARSE_MAT_DIAG_ZEROS ( 'KLLD', NDOFL, NTERM_KLLD, I_KLLD, J_KLLD, NUM_KLLD_DIAG_ZEROS ) + NTERM_KLLDn = 2*NTERM_KLLD - (NDOFL - NUM_KLLD_DIAG_ZEROS) + CALL ALLOCATE_SPARSE_MAT ( 'KLLDn', NDOFL, NTERM_KLLDn, SUBR_NAME ) + CALL CRS_SYM_TO_CRS_NONSYM ( 'KLLD', NDOFL, NTERM_KLLD, I_KLLD, J_KLLD, KLLD, 'KLLDn', NTERM_KLLDn, & + I_KLLDn, J_KLLDn, KLLDn, 'Y' ) + ELSE IF (SPARSTOR == 'NONSYM') THEN + NTERM_KLLDn = NTERM_KLLD + CALL ALLOCATE_SPARSE_MAT ( 'KLLDn', NDOFL, NTERM_KLLDn, SUBR_NAME ) + DO I=1,NDOFL+1 + I_KLLDn(I) = I_KLLD(I) + ENDDO + DO J=1,NTERM_KLLDn + J_KLLDn(J) = J_KLLD(J) + KLLDn(J) = KLLD(J) + ENDDO + ENDIF + ENDIF + ! Determine which subcase this iteration solves IF (NUM_MODES_SUBS == 0) THEN CUR_ISUB = CANONICAL_ISUB ! BUCKLING / GEN CB MODEL / single-shot legacy @@ -456,8 +530,13 @@ SUBROUTINE LINK4 IF ((EIG_NORM == 'MASS ') .OR. (EIG_NORM == 'NONE')) THEN CALL LINK_MESSAGE('WRITE EIGENVALUE SUMMARY TO OUTFIL') IF (N_MODES_ITER > 1) THEN - WRITE(F06,9876) CUR_ISUB, EIG_PARAMS(CUR_ISUB)%SID -9876 FORMAT(/,' ',79('='),/,' SUBCASE ',I8,' (METHOD SID = ',I8,')',/,' ',79('=')) + IF (IS_BUCK_MULTI) THEN + WRITE(F06,9875) CUR_ISUB, EIG_PARAMS(CUR_ISUB)%SID, CURRENT_PRELOAD_ISUB +9875 FORMAT(/,' ',79('='),/,' SUBCASE ',I8,' (METHOD SID = ',I8,', STATSUB = ',I8,')',/,' ',79('=')) + ELSE + WRITE(F06,9876) CUR_ISUB, EIG_PARAMS(CUR_ISUB)%SID +9876 FORMAT(/,' ',79('='),/,' SUBCASE ',I8,' (METHOD SID = ',I8,')',/,' ',79('=')) + ENDIF ENDIF CALL EIG_SUMMARY ENDIF @@ -533,6 +612,15 @@ SUBROUTINE LINK4 TOTAL_MODES = NUM_EIGENS ENDIF + ! End-of-loop cleanup for the SOL 105 multi-buckling-subcase path. LINK1 step 2 deferred the MPC_IND_GRIDS dealloc so that + ! REBUILD_KLLD_FROM_KGGD / BUILD_KGGD_FROM_UG could be re-invoked per iter. Free it here, plus the residual UG_COL. + IF (IS_BUCK_MULTI) THEN + CALL DEALLOCATE_MODEL_STUF ( 'MPC_IND_GRIDS' ) + CALL DEALLOCATE_MODEL_STUF ( 'SINGLE ELEMENT ARRAYS' ) + CALL DEALLOCATE_MODEL_STUF ( 'SUBLOD' ) + CALL DEALLOCATE_COL_VEC ( 'UG_COL' ) + ENDIF + ! Restore canonical-subcase EIG_* scalars and write L1M (only once, after the loop, so the file holds the global mode count ! and canonical params). LINK5 / LINK9 read L1M for the scalars and the global eigen list, then use EIG_PARAMS(MODE_SUBCASE(J)) ! for per-mode subcase attribution where needed. @@ -653,6 +741,9 @@ SUBROUTINE LINK4 9103 FORMAT(1X,A,' = ',1ES13.6) + 9994 FORMAT(' *ERROR 9994: SUBROUTINE ',A,' FAILED TO RELOAD UG_COL FROM FILE L5A FOR PRELOAD SUBCASE ',I8, & + ' (IOSTAT = ',I8,').') + 9998 FORMAT(' *ERROR 9998: COMM ',I3,' INDICATES UNSUCCESSFUL LINK ',I2,' COMPLETION.' & ,/,14X,' FATAL ERROR - CANNOT START LINK ',I2) diff --git a/Source/USE_IFs/BUILD_KGGD_FROM_UG_USE_IFs.f90 b/Source/USE_IFs/BUILD_KGGD_FROM_UG_USE_IFs.f90 index 1d3b842c..1bd46209 100644 --- a/Source/USE_IFs/BUILD_KGGD_FROM_UG_USE_IFs.f90 +++ b/Source/USE_IFs/BUILD_KGGD_FROM_UG_USE_IFs.f90 @@ -33,5 +33,7 @@ MODULE BUILD_KGGD_FROM_UG_USE_IFs USE ALLOCATE_STF_ARRAYS_Interface USE DEALLOCATE_STF_ARRAYS_Interface USE DEALLOCATE_SPARSE_MAT_Interface + USE ALLOCATE_MODEL_STUF_Interface + USE DEALLOCATE_MODEL_STUF_Interface END MODULE BUILD_KGGD_FROM_UG_USE_IFs diff --git a/Source/USE_IFs/LINK4_USE_IFs.f90 b/Source/USE_IFs/LINK4_USE_IFs.f90 index 07e4af61..f286ca5c 100644 --- a/Source/USE_IFs/LINK4_USE_IFs.f90 +++ b/Source/USE_IFs/LINK4_USE_IFs.f90 @@ -56,5 +56,10 @@ MODULE LINK4_USE_IFs USE CHK_ARRAY_ALLOC_STAT_Interface USE WRITE_ALLOC_MEM_TABLE_Interface USE FILE_INQUIRE_Interface + USE READ_L5A_UG_FOR_SUBCASE_Interface + USE REBUILD_KLLD_FROM_KGGD_Interface + USE ALLOCATE_COL_VEC_Interface + USE DEALLOCATE_COL_VEC_Interface + USE DEALLOCATE_MODEL_STUF_Interface END MODULE LINK4_USE_IFs diff --git a/Source/USE_IFs/REBUILD_KLLD_FROM_KGGD_USE_IFs.f90 b/Source/USE_IFs/REBUILD_KLLD_FROM_KGGD_USE_IFs.f90 new file mode 100644 index 00000000..ca9e0c81 --- /dev/null +++ b/Source/USE_IFs/REBUILD_KLLD_FROM_KGGD_USE_IFs.f90 @@ -0,0 +1,38 @@ +! ############################################################################################################################### +! 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 REBUILD_KLLD_FROM_KGGD_USE_IFs + +! USE Interface statements for all subroutines called by SUBROUTINE REBUILD_KLLD_FROM_KGGD + + USE BUILD_KGGD_FROM_UG_Interface + USE REDUCE_G_NM_Interface + USE REDUCE_N_FS_Interface + USE REDUCE_F_AO_Interface + USE REDUCE_A_LR_Interface + USE DEALLOCATE_SPARSE_MAT_Interface + + END MODULE REBUILD_KLLD_FROM_KGGD_USE_IFs diff --git a/Source/USE_IFs/REDUCE_KFFD_TO_KAAD_USE_IFs.f90 b/Source/USE_IFs/REDUCE_KFFD_TO_KAAD_USE_IFs.f90 index 0b807840..4ef64956 100644 --- a/Source/USE_IFs/REDUCE_KFFD_TO_KAAD_USE_IFs.f90 +++ b/Source/USE_IFs/REDUCE_KFFD_TO_KAAD_USE_IFs.f90 @@ -30,6 +30,7 @@ MODULE REDUCE_KFFD_TO_KAAD_USE_IFs USE OURTIM_Interface USE PARTITION_SS_NTERM_Interface USE ALLOCATE_SPARSE_MAT_Interface + USE READ_MATRIX_1_Interface USE PARTITION_SS_Interface USE ALLOCATE_SCR_CCS_MAT_Interface USE SPARSE_CRS_SPARSE_CCS_Interface From b26da79f8d740d80b554e2df2857e35dfa84cc53 Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 17:41:10 -0300 Subject: [PATCH 10/11] STATSUB done, also added tests --- .../buckling/bar_column_baseline.bdf | 128 ++++++++++++++++++ Build_Test_Cases/buckling/beam_all_shapes.bdf | 128 ++++++++++++++++++ .../buckling/buck_multi_statsub.bdf | 97 +++++++++++++ .../buckling/buck_statsub_default.bdf | 90 ++++++++++++ Build_Test_Cases/buckling/quad4_column.bdf | 89 ++++++++++++ Source/LK1/L1A-BD/BD_EIGR.f90 | 2 +- Source/LK5/LINK5.f90 | 2 +- Source/UTIL/MATADD_SSS.f90 | 2 +- 8 files changed, 535 insertions(+), 3 deletions(-) create mode 100644 Build_Test_Cases/buckling/bar_column_baseline.bdf create mode 100644 Build_Test_Cases/buckling/beam_all_shapes.bdf create mode 100644 Build_Test_Cases/buckling/buck_multi_statsub.bdf create mode 100644 Build_Test_Cases/buckling/buck_statsub_default.bdf create mode 100644 Build_Test_Cases/buckling/quad4_column.bdf diff --git a/Build_Test_Cases/buckling/bar_column_baseline.bdf b/Build_Test_Cases/buckling/bar_column_baseline.bdf new file mode 100644 index 00000000..090aeb66 --- /dev/null +++ b/Build_Test_Cases/buckling/bar_column_baseline.bdf @@ -0,0 +1,128 @@ +$ Generated by Mecway 33 +$-----------------------EXECUTIVE CONTROL SECTION----------------------- +SOL 105 +CEND +$-------------------------CASE CONTROL SECTION-------------------------- +DISPLACEMENT = ALL +SPC = 1 +SUBCASE 1 +LOAD = 1 +SUBCASE 2 +METHOD = 1 +BEGIN BULK +$---------------------------BULK DATA SECTION--------------------------- +GRID 1 0 2.5+1 0.0+0 -1.2+1 0 +GRID* 2 0 1.4695276246-14 0.0+0* +* -1.2+1 0 +GRID 3 0 2.5+1 0.0+0 -1.8+1 0 +GRID* 4 0 2.2042914369-14 0.0+0* +* -1.8+1 0 +GRID 5 0 2.5+1 0.0+0 -2.4+1 0 +GRID* 6 0 2.571673343-14 0.0+0* +* -2.1+1 0 +GRID 7 0 2.5+1 0.0+0 -1.5+1 0 +GRID* 8 0 1.8369095307-14 0.0+0* +* -1.5+1 0 +GRID 9 0 2.5+1 0.0+0 -9.0+0 0 +GRID* 10 0 1.1021457184-14 0.0+0* +* -9.0+0 0 +GRID* 11 0 2.9390552492-14 0.0+0* +* -2.4+1 0 +GRID 12 0 2.5+1 0.0+0 -2.1+1 0 +PARAM STR_CID -2 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(7) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 4 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(8) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 5 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(9) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 6 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(4) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 1 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(5) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 2 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(6) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 3 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +SPC 1 1 1 0.0+0 +SPC 1 1 2 0.0+0 +SPC 1 1 3 0.0+0 +SPC 1 1 4 0.0+0 +SPC 1 1 5 0.0+0 +SPC 1 1 6 0.0+0 +SPC 1 3 1 0.0+0 +SPC 1 3 2 0.0+0 +SPC 1 3 3 0.0+0 +SPC 1 3 4 0.0+0 +SPC 1 3 5 0.0+0 +SPC 1 3 6 0.0+0 +SPC 1 5 1 0.0+0 +SPC 1 5 2 0.0+0 +SPC 1 5 3 0.0+0 +SPC 1 5 4 0.0+0 +SPC 1 5 5 0.0+0 +SPC 1 5 6 0.0+0 +SPC 1 7 1 0.0+0 +SPC 1 7 2 0.0+0 +SPC 1 7 3 0.0+0 +SPC 1 7 4 0.0+0 +SPC 1 7 5 0.0+0 +SPC 1 7 6 0.0+0 +SPC 1 9 1 0.0+0 +SPC 1 9 2 0.0+0 +SPC 1 9 3 0.0+0 +SPC 1 9 4 0.0+0 +SPC 1 9 5 0.0+0 +SPC 1 9 6 0.0+0 +SPC 1 12 1 0.0+0 +SPC 1 12 2 0.0+0 +SPC 1 12 3 0.0+0 +SPC 1 12 4 0.0+0 +SPC 1 12 5 0.0+0 +SPC 1 12 6 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(6) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR* 1 4 3.14159265359-2 7.85398163397-5* +* 7.85398163397-5 1.57079632679-4 0.0+0 +CBAR 3 1 4 3 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(7) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR* 2 5 5.96902604182-3 2.70098428392-5* +* 2.70098428392-5 5.40196856785-5 0.0+0 +CBAR 1 2 6 12 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(8) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR 3 6 3.0-2 3.0-4 6.0-6 1.0-4 0.0+0 +CBAR 2 3 11 5 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(3) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR* 4 1 5.3-3 5.33641666667-5* +* 5.64416666667-6 1.7979089233-7 0.0+0 +CBAR 5 4 10 9 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(4) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR* 5 2 3.0-2 5.625-5* +* 1.0-4 1.21490661621-4 0.0+0 +CBAR 6 5 2 1 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(5) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR* 6 3 9.6-3 1.2072-4* +* 6.392-5 1.26500416667-4 0.0+0 +CBAR 4 6 8 7 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ force $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +FORCE 2 10 0 1.0+0 5.0+0 0.0+0 0.0+0 +FORCE 2 2 0 1.0+0 5.0+0 0.0+0 0.0+0 +FORCE 2 8 0 1.0+0 5.0+0 0.0+0 0.0+0 +FORCE 2 4 0 1.0+0 5.0+0 0.0+0 0.0+0 +FORCE 2 6 0 1.0+0 5.0+0 0.0+0 0.0+0 +FORCE 2 11 0 1.0+0 5.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +EIGRL 1 12 0 1.0+2 MASS +LOAD 1 1.0+0 1.0+0 2 +ENDDATA diff --git a/Build_Test_Cases/buckling/beam_all_shapes.bdf b/Build_Test_Cases/buckling/beam_all_shapes.bdf new file mode 100644 index 00000000..090aeb66 --- /dev/null +++ b/Build_Test_Cases/buckling/beam_all_shapes.bdf @@ -0,0 +1,128 @@ +$ Generated by Mecway 33 +$-----------------------EXECUTIVE CONTROL SECTION----------------------- +SOL 105 +CEND +$-------------------------CASE CONTROL SECTION-------------------------- +DISPLACEMENT = ALL +SPC = 1 +SUBCASE 1 +LOAD = 1 +SUBCASE 2 +METHOD = 1 +BEGIN BULK +$---------------------------BULK DATA SECTION--------------------------- +GRID 1 0 2.5+1 0.0+0 -1.2+1 0 +GRID* 2 0 1.4695276246-14 0.0+0* +* -1.2+1 0 +GRID 3 0 2.5+1 0.0+0 -1.8+1 0 +GRID* 4 0 2.2042914369-14 0.0+0* +* -1.8+1 0 +GRID 5 0 2.5+1 0.0+0 -2.4+1 0 +GRID* 6 0 2.571673343-14 0.0+0* +* -2.1+1 0 +GRID 7 0 2.5+1 0.0+0 -1.5+1 0 +GRID* 8 0 1.8369095307-14 0.0+0* +* -1.5+1 0 +GRID 9 0 2.5+1 0.0+0 -9.0+0 0 +GRID* 10 0 1.1021457184-14 0.0+0* +* -9.0+0 0 +GRID* 11 0 2.9390552492-14 0.0+0* +* -2.4+1 0 +GRID 12 0 2.5+1 0.0+0 -2.1+1 0 +PARAM STR_CID -2 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(7) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 4 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(8) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 5 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(9) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 6 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(4) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 1 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(5) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 2 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material(6) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1 3 2.0+11 1.0+11 0.0+0 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +SPC 1 1 1 0.0+0 +SPC 1 1 2 0.0+0 +SPC 1 1 3 0.0+0 +SPC 1 1 4 0.0+0 +SPC 1 1 5 0.0+0 +SPC 1 1 6 0.0+0 +SPC 1 3 1 0.0+0 +SPC 1 3 2 0.0+0 +SPC 1 3 3 0.0+0 +SPC 1 3 4 0.0+0 +SPC 1 3 5 0.0+0 +SPC 1 3 6 0.0+0 +SPC 1 5 1 0.0+0 +SPC 1 5 2 0.0+0 +SPC 1 5 3 0.0+0 +SPC 1 5 4 0.0+0 +SPC 1 5 5 0.0+0 +SPC 1 5 6 0.0+0 +SPC 1 7 1 0.0+0 +SPC 1 7 2 0.0+0 +SPC 1 7 3 0.0+0 +SPC 1 7 4 0.0+0 +SPC 1 7 5 0.0+0 +SPC 1 7 6 0.0+0 +SPC 1 9 1 0.0+0 +SPC 1 9 2 0.0+0 +SPC 1 9 3 0.0+0 +SPC 1 9 4 0.0+0 +SPC 1 9 5 0.0+0 +SPC 1 9 6 0.0+0 +SPC 1 12 1 0.0+0 +SPC 1 12 2 0.0+0 +SPC 1 12 3 0.0+0 +SPC 1 12 4 0.0+0 +SPC 1 12 5 0.0+0 +SPC 1 12 6 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(6) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR* 1 4 3.14159265359-2 7.85398163397-5* +* 7.85398163397-5 1.57079632679-4 0.0+0 +CBAR 3 1 4 3 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(7) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR* 2 5 5.96902604182-3 2.70098428392-5* +* 2.70098428392-5 5.40196856785-5 0.0+0 +CBAR 1 2 6 12 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(8) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR 3 6 3.0-2 3.0-4 6.0-6 1.0-4 0.0+0 +CBAR 2 3 11 5 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(3) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR* 4 1 5.3-3 5.33641666667-5* +* 5.64416666667-6 1.7979089233-7 0.0+0 +CBAR 5 4 10 9 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(4) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR* 5 2 3.0-2 5.625-5* +* 1.0-4 1.21490661621-4 0.0+0 +CBAR 6 5 2 1 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Component(5) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PBAR* 6 3 9.6-3 1.2072-4* +* 6.392-5 1.26500416667-4 0.0+0 +CBAR 4 6 8 7 0.0+0 1.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ force $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +FORCE 2 10 0 1.0+0 5.0+0 0.0+0 0.0+0 +FORCE 2 2 0 1.0+0 5.0+0 0.0+0 0.0+0 +FORCE 2 8 0 1.0+0 5.0+0 0.0+0 0.0+0 +FORCE 2 4 0 1.0+0 5.0+0 0.0+0 0.0+0 +FORCE 2 6 0 1.0+0 5.0+0 0.0+0 0.0+0 +FORCE 2 11 0 1.0+0 5.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +EIGRL 1 12 0 1.0+2 MASS +LOAD 1 1.0+0 1.0+0 2 +ENDDATA diff --git a/Build_Test_Cases/buckling/buck_multi_statsub.bdf b/Build_Test_Cases/buckling/buck_multi_statsub.bdf new file mode 100644 index 00000000..2ddbc025 --- /dev/null +++ b/Build_Test_Cases/buckling/buck_multi_statsub.bdf @@ -0,0 +1,97 @@ +$ Generated by Mecway 33 +$-----------------------EXECUTIVE CONTROL SECTION----------------------- +SOL 105 +CEND +$-------------------------CASE CONTROL SECTION-------------------------- +DISPLACEMENT = ALL +SPC = 1 +SUBCASE 1 +LOAD = 1 +SUBCASE 2 +LOAD = 11 +SUBCASE 3 +METHOD = 1 +STATSUB = 1 +SUBCASE 4 +METHOD = 2 +STATSUB = 2 +BEGIN BULK +$---------------------------BULK DATA SECTION--------------------------- +GRID* 1 0 1.46446609407-2 0.0+0* +* 3.53553390593-2 0 +GRID 2 0 5.0-2 0.0+0 0.0+0 0 +GRID 3 0 5.0-2 1.0+0 0.0+0 0 +GRID* 4 0 1.46446609407-2 1.0+0* +* 3.53553390593-2 0 +GRID* 5 0 1.46446609407-2 7.6-1* +* 3.53553390593-2 0 +GRID 6 0 5.0-2 7.4-1 0.0+0 0 +GRID* 7 0 1.46446609407-2 8.6-1* +* 3.53553390593-2 0 +GRID 8 0 5.0-2 5.4-1 0.0+0 0 +GRID* 9 0 1.46446609407-2 6.0-2* +* 3.53553390593-2 0 +GRID 10 0 5.0-2 1.4-1 0.0+0 0 +GRID* 11 0 1.46446609407-2 1.6-1* +* 3.53553390593-2 0 +GRID 12 0 5.0-2 9.4-1 0.0+0 0 +GRID* 13 0 1.46446609407-2 2.6-1* +* 3.53553390593-2 0 +GRID 14 0 5.0-2 2.4-1 0.0+0 0 +GRID* 15 0 1.46446609407-2 3.6-1* +* 3.53553390593-2 0 +GRID 16 0 5.0-2 6.4-1 0.0+0 0 +GRID* 17 0 1.46446609407-2 4.6-1* +* 3.53553390593-2 0 +GRID 18 0 5.0-2 3.4-1 0.0+0 0 +GRID* 19 0 1.46446609407-2 5.6-1* +* 3.53553390593-2 0 +GRID 20 0 5.0-2 8.4-1 0.0+0 0 +GRID* 21 0 1.46446609407-2 6.6-1* +* 3.53553390593-2 0 +GRID 22 0 5.0-2 4.4-1 0.0+0 0 +PARAM STR_CID -2 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1* 1 2.1+11 7.7777777778+10 3.5-1* +* 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +SPC 1 1 1 0.0+0 +SPC 1 1 2 0.0+0 +SPC 1 1 3 0.0+0 +SPC 1 1 4 0.0+0 +SPC 1 1 5 0.0+0 +SPC 1 1 6 0.0+0 +SPC 1 2 1 0.0+0 +SPC 1 2 2 0.0+0 +SPC 1 2 3 0.0+0 +SPC 1 2 4 0.0+0 +SPC 1 2 5 0.0+0 +SPC 1 2 6 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Default $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PSHELL 1 1 5.0-2 1 1 0.0+0 +CQUAD4 1 1 4 7 12 3 0.0+0 0.0+0 +CQUAD4 2 1 9 1 2 10 0.0+0 0.0+0 +CQUAD4 3 1 11 9 10 14 0.0+0 0.0+0 +CQUAD4* 4 1 11 14* +* 18 13-2.2489917832-15 0.0+0 +CQUAD4* 5 1 13 18* +* 22 15-2.2489917832-15 0.0+0 +CQUAD4* 6 1 15 22* +* 8 17-2.2489917832-15 0.0+0 +CQUAD4* 7 1 17 8* +* 16 19-2.2489917832-15 0.0+0 +CQUAD4 8 1 21 19 16 6 0.0+0 0.0+0 +CQUAD4 9 1 5 21 6 20 0.0+0 0.0+0 +CQUAD4 10 1 7 5 20 12 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ force $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +FORCE 2 4 0 1.0+0 0.0+0 -5.0+3 0.0+0 +FORCE 2 3 0 1.0+0 0.0+0 -5.0+3 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +EIGRL 1 3 0 1.0+1 MASS +EIGRL 2 3 0 1.0+1 MASS +LOAD 1 1.0+0 1.0+0 2 +LOAD 11 1.0+0 2.0+0 2 +ENDDATA diff --git a/Build_Test_Cases/buckling/buck_statsub_default.bdf b/Build_Test_Cases/buckling/buck_statsub_default.bdf new file mode 100644 index 00000000..5e0fa2bf --- /dev/null +++ b/Build_Test_Cases/buckling/buck_statsub_default.bdf @@ -0,0 +1,90 @@ +$ Generated by Mecway 33 +$-----------------------EXECUTIVE CONTROL SECTION----------------------- +SOL 105 +CEND +$-------------------------CASE CONTROL SECTION-------------------------- +DISPLACEMENT = ALL +SPC = 1 +SUBCASE 1 +LOAD = 1 +SUBCASE 2 +METHOD = 1 +STATSUB = 1 +BEGIN BULK +$---------------------------BULK DATA SECTION--------------------------- +GRID* 1 0 1.46446609407-2 0.0+0* +* 3.53553390593-2 0 +GRID 2 0 5.0-2 0.0+0 0.0+0 0 +GRID 3 0 5.0-2 1.0+0 0.0+0 0 +GRID* 4 0 1.46446609407-2 1.0+0* +* 3.53553390593-2 0 +GRID* 5 0 1.46446609407-2 7.6-1* +* 3.53553390593-2 0 +GRID 6 0 5.0-2 7.4-1 0.0+0 0 +GRID* 7 0 1.46446609407-2 8.6-1* +* 3.53553390593-2 0 +GRID 8 0 5.0-2 5.4-1 0.0+0 0 +GRID* 9 0 1.46446609407-2 6.0-2* +* 3.53553390593-2 0 +GRID 10 0 5.0-2 1.4-1 0.0+0 0 +GRID* 11 0 1.46446609407-2 1.6-1* +* 3.53553390593-2 0 +GRID 12 0 5.0-2 9.4-1 0.0+0 0 +GRID* 13 0 1.46446609407-2 2.6-1* +* 3.53553390593-2 0 +GRID 14 0 5.0-2 2.4-1 0.0+0 0 +GRID* 15 0 1.46446609407-2 3.6-1* +* 3.53553390593-2 0 +GRID 16 0 5.0-2 6.4-1 0.0+0 0 +GRID* 17 0 1.46446609407-2 4.6-1* +* 3.53553390593-2 0 +GRID 18 0 5.0-2 3.4-1 0.0+0 0 +GRID* 19 0 1.46446609407-2 5.6-1* +* 3.53553390593-2 0 +GRID 20 0 5.0-2 8.4-1 0.0+0 0 +GRID* 21 0 1.46446609407-2 6.6-1* +* 3.53553390593-2 0 +GRID 22 0 5.0-2 4.4-1 0.0+0 0 +PARAM STR_CID -2 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1* 1 2.1+11 7.7777777778+10 3.5-1* +* 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +SPC 1 1 1 0.0+0 +SPC 1 1 2 0.0+0 +SPC 1 1 3 0.0+0 +SPC 1 1 4 0.0+0 +SPC 1 1 5 0.0+0 +SPC 1 1 6 0.0+0 +SPC 1 2 1 0.0+0 +SPC 1 2 2 0.0+0 +SPC 1 2 3 0.0+0 +SPC 1 2 4 0.0+0 +SPC 1 2 5 0.0+0 +SPC 1 2 6 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Default $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PSHELL 1 1 5.0-2 1 1 0.0+0 +CQUAD4 1 1 4 7 12 3 0.0+0 0.0+0 +CQUAD4 2 1 9 1 2 10 0.0+0 0.0+0 +CQUAD4 3 1 11 9 10 14 0.0+0 0.0+0 +CQUAD4* 4 1 11 14* +* 18 13-2.2489917832-15 0.0+0 +CQUAD4* 5 1 13 18* +* 22 15-2.2489917832-15 0.0+0 +CQUAD4* 6 1 15 22* +* 8 17-2.2489917832-15 0.0+0 +CQUAD4* 7 1 17 8* +* 16 19-2.2489917832-15 0.0+0 +CQUAD4 8 1 21 19 16 6 0.0+0 0.0+0 +CQUAD4 9 1 5 21 6 20 0.0+0 0.0+0 +CQUAD4 10 1 7 5 20 12 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ force $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +FORCE 2 4 0 1.0+0 0.0+0 -5.0+3 0.0+0 +FORCE 2 3 0 1.0+0 0.0+0 -5.0+3 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +EIGRL 1 3 0 1.0+1 MASS +LOAD 1 1.0+0 1.0+0 2 +ENDDATA diff --git a/Build_Test_Cases/buckling/quad4_column.bdf b/Build_Test_Cases/buckling/quad4_column.bdf new file mode 100644 index 00000000..d4c88be2 --- /dev/null +++ b/Build_Test_Cases/buckling/quad4_column.bdf @@ -0,0 +1,89 @@ +$ Generated by Mecway 33 +$-----------------------EXECUTIVE CONTROL SECTION----------------------- +SOL 105 +CEND +$-------------------------CASE CONTROL SECTION-------------------------- +DISPLACEMENT = ALL +SPC = 1 +SUBCASE 1 +LOAD = 1 +SUBCASE 2 +METHOD = 1 +BEGIN BULK +$---------------------------BULK DATA SECTION--------------------------- +GRID* 1 0 1.46446609407-2 0.0+0* +* 3.53553390593-2 0 +GRID 2 0 5.0-2 0.0+0 0.0+0 0 +GRID 3 0 5.0-2 1.0+0 0.0+0 0 +GRID* 4 0 1.46446609407-2 1.0+0* +* 3.53553390593-2 0 +GRID* 5 0 1.46446609407-2 7.6-1* +* 3.53553390593-2 0 +GRID 6 0 5.0-2 7.4-1 0.0+0 0 +GRID* 7 0 1.46446609407-2 8.6-1* +* 3.53553390593-2 0 +GRID 8 0 5.0-2 5.4-1 0.0+0 0 +GRID* 9 0 1.46446609407-2 6.0-2* +* 3.53553390593-2 0 +GRID 10 0 5.0-2 1.4-1 0.0+0 0 +GRID* 11 0 1.46446609407-2 1.6-1* +* 3.53553390593-2 0 +GRID 12 0 5.0-2 9.4-1 0.0+0 0 +GRID* 13 0 1.46446609407-2 2.6-1* +* 3.53553390593-2 0 +GRID 14 0 5.0-2 2.4-1 0.0+0 0 +GRID* 15 0 1.46446609407-2 3.6-1* +* 3.53553390593-2 0 +GRID 16 0 5.0-2 6.4-1 0.0+0 0 +GRID* 17 0 1.46446609407-2 4.6-1* +* 3.53553390593-2 0 +GRID 18 0 5.0-2 3.4-1 0.0+0 0 +GRID* 19 0 1.46446609407-2 5.6-1* +* 3.53553390593-2 0 +GRID 20 0 5.0-2 8.4-1 0.0+0 0 +GRID* 21 0 1.46446609407-2 6.6-1* +* 3.53553390593-2 0 +GRID 22 0 5.0-2 4.4-1 0.0+0 0 +PARAM STR_CID -2 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Material $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +MAT1* 1 2.1+11 7.7777777778+10 3.5-1* +* 0.0+0 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +SPC 1 1 1 0.0+0 +SPC 1 1 2 0.0+0 +SPC 1 1 3 0.0+0 +SPC 1 1 4 0.0+0 +SPC 1 1 5 0.0+0 +SPC 1 1 6 0.0+0 +SPC 1 2 1 0.0+0 +SPC 1 2 2 0.0+0 +SPC 1 2 3 0.0+0 +SPC 1 2 4 0.0+0 +SPC 1 2 5 0.0+0 +SPC 1 2 6 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ Default $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +PSHELL 1 1 5.0-2 1 1 0.0+0 +CQUAD4 1 1 4 7 12 3 0.0+0 0.0+0 +CQUAD4 2 1 9 1 2 10 0.0+0 0.0+0 +CQUAD4 3 1 11 9 10 14 0.0+0 0.0+0 +CQUAD4* 4 1 11 14* +* 18 13-2.2489917832-15 0.0+0 +CQUAD4* 5 1 13 18* +* 22 15-2.2489917832-15 0.0+0 +CQUAD4* 6 1 15 22* +* 8 17-2.2489917832-15 0.0+0 +CQUAD4* 7 1 17 8* +* 16 19-2.2489917832-15 0.0+0 +CQUAD4 8 1 21 19 16 6 0.0+0 0.0+0 +CQUAD4 9 1 5 21 6 20 0.0+0 0.0+0 +CQUAD4 10 1 7 5 20 12 0.0+0 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ force $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +FORCE 2 4 0 1.0+0 0.0+0 -5.0+3 0.0+0 +FORCE 2 3 0 1.0+0 0.0+0 -5.0+3 0.0+0 +$--1---><--2---><--3---><--4---><--5---><--6---><--7---><--8---><--9---><--10--> +EIGRL 1 3 0 1.0+1 MASS +LOAD 1 1.0+0 1.0+0 2 +ENDDATA diff --git a/Source/LK1/L1A-BD/BD_EIGR.f90 b/Source/LK1/L1A-BD/BD_EIGR.f90 index 8e7348e1..bc1360bb 100644 --- a/Source/LK1/L1A-BD/BD_EIGR.f90 +++ b/Source/LK1/L1A-BD/BD_EIGR.f90 @@ -114,7 +114,7 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) ENDIF ! Also pick up cards requested by any other modes-subcase via its own METHOD entry, or by deck-default ! propagation when a subcase has not declared a METHOD of its own. This lets SOL 103 decks define a - ! distinct set of modes per subcase. We do not bump EIGFND in this branch — EIGFND is the legacy guard + ! distinct set of modes per subcase. We do not bump EIGFND in this branch -- EIGFND is the legacy guard ! against duplicate cards for the *scalar* SID only. IF (.NOT. MATCHES_SCALAR) THEN IF (ALLOCATED(CC_EIGR_SID_SUB)) THEN diff --git a/Source/LK5/LINK5.f90 b/Source/LK5/LINK5.f90 index d92fedf3..12b90682 100644 --- a/Source/LK5/LINK5.f90 +++ b/Source/LK5/LINK5.f90 @@ -616,7 +616,7 @@ SUBROUTINE LINK5 ! legacy single-preload behaviour (and to give multi-buckling decks a sensible default until the explicit per-buckling-subcase ! preload selection lands in a later phase), we reload UG_COL with the canonical preload subcase's column from L5A. ! The canonical choice is the STATSUB_REF resolved for the first buckling subcase. If for some reason none of that information -! is available (defensive fallback only — LOADC always resolves it for valid decks) we leave UG_COL untouched. +! is available (defensive fallback only -- LOADC always resolves it for valid decks) we leave UG_COL untouched. IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1)) THEN BUCKLING_PRELOAD_RELOAD : BLOCK diff --git a/Source/UTIL/MATADD_SSS.f90 b/Source/UTIL/MATADD_SSS.f90 index cb2adf1d..7916ed77 100644 --- a/Source/UTIL/MATADD_SSS.f90 +++ b/Source/UTIL/MATADD_SSS.f90 @@ -121,7 +121,7 @@ SUBROUTINE MATADD_SSS ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, A, ALPHA, C(CNT) = BETA * B(P_B) J_C(CNT) = COL_B P_B = P_B + 1 - ELSE ! Both have an entry — add + ELSE ! Both have an entry -- add V = ALPHA * A(P_A) + BETA * B(P_B) CNT = CNT + 1 C(CNT) = V From 5c2e8a0a727b3b41051c8bdfef4402f686af0744 Mon Sep 17 00:00:00 2001 From: Bruno Borges Paschoalinoto Date: Sun, 31 May 2026 18:48:32 -0300 Subject: [PATCH 11/11] renamed files that use Fortran 2003 features --- Source/LK1/L1A/{LOADC.f90 => LOADC.f03} | 0 Source/LK4/{EIG_LANCZOS_ARPACK.f90 => EIG_LANCZOS_ARPACK.f03} | 0 Source/Modules/{MODEL_STUF.f90 => MODEL_STUF.f03} | 0 Source/Modules/{SCONTR.f90 => SCONTR.f03} | 0 4 files changed, 0 insertions(+), 0 deletions(-) rename Source/LK1/L1A/{LOADC.f90 => LOADC.f03} (100%) rename Source/LK4/{EIG_LANCZOS_ARPACK.f90 => EIG_LANCZOS_ARPACK.f03} (100%) rename Source/Modules/{MODEL_STUF.f90 => MODEL_STUF.f03} (100%) rename Source/Modules/{SCONTR.f90 => SCONTR.f03} (100%) diff --git a/Source/LK1/L1A/LOADC.f90 b/Source/LK1/L1A/LOADC.f03 similarity index 100% rename from Source/LK1/L1A/LOADC.f90 rename to Source/LK1/L1A/LOADC.f03 diff --git a/Source/LK4/EIG_LANCZOS_ARPACK.f90 b/Source/LK4/EIG_LANCZOS_ARPACK.f03 similarity index 100% rename from Source/LK4/EIG_LANCZOS_ARPACK.f90 rename to Source/LK4/EIG_LANCZOS_ARPACK.f03 diff --git a/Source/Modules/MODEL_STUF.f90 b/Source/Modules/MODEL_STUF.f03 similarity index 100% rename from Source/Modules/MODEL_STUF.f90 rename to Source/Modules/MODEL_STUF.f03 diff --git a/Source/Modules/SCONTR.f90 b/Source/Modules/SCONTR.f03 similarity index 100% rename from Source/Modules/SCONTR.f90 rename to Source/Modules/SCONTR.f03