From 887c803b86c5d8d324f548b1e506b6eaf1a786ab Mon Sep 17 00:00:00 2001 From: "U-DESKTOP-CPU04V4\\vic" Date: Sat, 4 Apr 2026 07:40:14 +1300 Subject: [PATCH 1/2] Redefined 1st parameter from actual grid number to internal grid number --- Source/EMG/EMG1/ELMDAT1.f90 | 4 +- Source/EMG/EMG2/ELMOUT.f90 | 14 ++--- Source/EMG/EMG3/ELAS1.f90 | 4 +- .../GET_GRID_NUM_COMPS_Interface.f90 | 16 ++--- Source/LK1/L1B/OU4_PARTVEC_PROC.f90 | 4 +- Source/LK1/L1B/TDOF_PROC.f90 | 34 +++++----- Source/LK1/L1B/TSET_PROC.f90 | 4 +- Source/LK1/L1B/TSET_PROC_FOR_OMITS.f90 | 6 +- Source/LK1/L1B/TSET_PROC_FOR_SPCS.f90 | 4 +- Source/LK1/L1B/USET_PROC.f90 | 2 +- Source/LK1/L1C/CONM2_PROC_1.f90 | 2 +- Source/LK1/L1C/GPWG.f90 | 2 +- Source/LK1/L1C/RB_DISP_MATRIX_PROC.f90 | 6 +- Source/LK1/L1D/EPTL.f90 | 2 +- Source/LK1/L1D/GET_GRID_6X6_MASS.f90 | 2 +- Source/LK1/L1D/RBE2_PROC.f90 | 10 +-- Source/LK1/L1D/RBE3_PROC.f90 | 11 ++-- Source/LK1/L1D/RSPLINE_PROC.f90 | 18 +++--- Source/LK1/L1E/EMP.f90 | 2 +- Source/LK1/L1E/ESP.f90 | 6 +- Source/LK1/L1E/ESP0_FINAL.f90 | 2 +- Source/LK1/L1E/KGG_SINGULARITY_PROC.f90 | 2 +- Source/LK1/L1E/MGGC_MASS_MATRIX.f90 | 2 +- Source/LK1/L1E/SPARSE_KGG.f90 | 2 +- Source/LK1/L1E/SPARSE_KGGD.f90 | 2 +- Source/LK1/L1E/SPARSE_MGG.f90 | 4 +- Source/LK2/REDUCE_G_NM.f90 | 2 +- Source/LK5/LINK5.f90 | 2 +- Source/LK9/L91/WRITE_FEMAP_GRID_VECS.f90 | 2 +- Source/LK9/L92/CALC_ELEM_NODE_FORCES.f90 | 2 +- Source/LK9/L92/ELMDIS.f90 | 14 ++--- Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 | 6 +- Source/LK9/L92/OFP1.f90 | 6 +- Source/LK9/L92/OFP2.f90 | 8 +-- Source/LK9/L92/OFP3_ELFN.f90 | 4 +- Source/UTIL/CALC_TDOF_ROW_START.f90 | 2 +- Source/UTIL/CONVERT_VEC_COORD_SYS.f90 | 4 +- Source/UTIL/GET_GRID_NUM_COMPS.f90 | 63 +++---------------- Source/UTIL/GET_UG_123_IN_GRD_ORD.f90 | 4 +- Source/UTIL/WRITE_TDOF.f90 | 4 +- 40 files changed, 124 insertions(+), 166 deletions(-) diff --git a/Source/EMG/EMG1/ELMDAT1.f90 b/Source/EMG/EMG1/ELMDAT1.f90 index e0f43196..afe5bac3 100644 --- a/Source/EMG/EMG1/ELMDAT1.f90 +++ b/Source/EMG/EMG1/ELMDAT1.f90 @@ -168,7 +168,7 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) ELDOF = 0 DO I=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) ELDOF = ELDOF + NUM_COMPS ENDDO @@ -1006,7 +1006,7 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) DO I=1,2 ! If displ comps on CELAS1,2 entry were blank or 0, change to 1,2 ELAS_COMP(I) = EDAT(EPNTK+3+I) ! (i.e. ELAS has 2 components of displ) IF (ELAS_COMP(I) == 0) THEN - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS > 1) THEN NUM_EMG_FATAL_ERRS = NUM_EMG_FATAL_ERRS + 1 FATAL_ERR = FATAL_ERR + 1 diff --git a/Source/EMG/EMG2/ELMOUT.f90 b/Source/EMG/EMG2/ELMOUT.f90 index 75655621..10234500 100644 --- a/Source/EMG/EMG2/ELMOUT.f90 +++ b/Source/EMG/EMG2/ELMOUT.f90 @@ -88,7 +88,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) GRID_TYPE(I) = 'undefined ' ENDDO DO I=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 1) THEN GRID_TYPE(I) = 'scalar point' ELSE IF (NUM_COMPS == 6) THEN @@ -658,7 +658,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = UEL(I2) @@ -674,7 +674,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = PEL(I2) @@ -692,7 +692,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = UEB(I2) @@ -708,7 +708,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = PEB(I2) @@ -726,7 +726,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = UEG(I2) @@ -742,7 +742,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = PEG(I2) diff --git a/Source/EMG/EMG3/ELAS1.f90 b/Source/EMG/EMG3/ELAS1.f90 index 1b4b741b..0bea2e8a 100644 --- a/Source/EMG/EMG3/ELAS1.f90 +++ b/Source/EMG/EMG3/ELAS1.f90 @@ -36,7 +36,7 @@ SUBROUTINE ELAS1 ( OPT, WRITE_WARN ) USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE SUBR_BEGEND_LEVELS, ONLY : ELAS1_BEGEND - USE MODEL_STUF, ONLY : AGRID, ELAS_COMP, EID, EPROP, FCONV, KE, SE1, TYPE + USE MODEL_STUF, ONLY : AGRID, BGRID, ELAS_COMP, EID, EPROP, FCONV, KE, SE1, TYPE USE ELAS1_USE_IFs @@ -72,7 +72,7 @@ SUBROUTINE ELAS1 ( OPT, WRITE_WARN ) FCONV(1) = 1.D0 ENDIF I1 = ELAS_COMP(1) - CALL GET_GRID_NUM_COMPS ( AGRID(1), NUM_COMPS_GRID_1, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(1), NUM_COMPS_GRID_1, SUBR_NAME ) I2 = NUM_COMPS_GRID_1 + ELAS_COMP(2) ! ********************************************************************************************************************************** diff --git a/Source/Interfaces/GET_GRID_NUM_COMPS_Interface.f90 b/Source/Interfaces/GET_GRID_NUM_COMPS_Interface.f90 index 56c342a6..6f43f706 100644 --- a/Source/Interfaces/GET_GRID_NUM_COMPS_Interface.f90 +++ b/Source/Interfaces/GET_GRID_NUM_COMPS_Interface.f90 @@ -28,26 +28,22 @@ MODULE GET_GRID_NUM_COMPS_Interface INTERFACE - SUBROUTINE GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, CALLING_SUBR ) + SUBROUTINE GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, CALLING_SUBR ) - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NGRID - USE TIMDAT, ONLY : TSEC + USE PENTIUM_II_KIND, ONLY : LONG USE MODEL_STUF, ONLY : GRID - USE SUBR_BEGEND_LEVELS, ONLY : GET_GRID_NUM_COMPS_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Subr that called this one - INTEGER(LONG), INTENT(IN) :: GRID_NUM ! A grid number (calling subr checked that it is an actual grid) + INTEGER(LONG), INTENT(IN) :: IGRID ! An internal grid number INTEGER(LONG), INTENT(OUT) :: NUM_COMPS ! 6 if GRID_NUM is an physical grid, 1 if an SPOINT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_GRID_NUM_COMPS_BEGEND - - END SUBROUTINE GET_GRID_NUM_COMPS + END SUBROUTINE GET_GRID_NUM_COMPS + + END INTERFACE END MODULE GET_GRID_NUM_COMPS_Interface diff --git a/Source/LK1/L1B/OU4_PARTVEC_PROC.f90 b/Source/LK1/L1B/OU4_PARTVEC_PROC.f90 index 2cba27e8..058ab1b6 100644 --- a/Source/LK1/L1B/OU4_PARTVEC_PROC.f90 +++ b/Source/LK1/L1B/OU4_PARTVEC_PROC.f90 @@ -292,7 +292,7 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO DO GRID_NUM=GRID1,GRID2 ! GRID2 >= GRID1 was checked in subr BD_SPC1 CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_NUM, GRID_ID_ROW_NUM ) IF (GRID_ID_ROW_NUM /= -1) THEN - CALL GET_GRID_NUM_COMPS ( GRID(GRID_ID_ROW_NUM,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS ! Put data in PSET IF (CDOF(K) == '1') THEN IF ((PSET(GRID_ID_ROW_NUM,K,I) == '--') .OR. (PSET(GRID_ID_ROW_NUM,K,I) == PSET_CHAR(I))) THEN @@ -341,7 +341,7 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO IF (NDIM_F(I) > 0) THEN DO K=1,NGRID IGRID = INV_GRID_SEQ(K) - CALL GET_GRID_NUM_COMPS ( GRID_ID(IGRID), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (PSET(IGRID,J,I) == PSET_CHAR(I)) THEN IROW = TDOF_ROW_START(IGRID) + J - 1 diff --git a/Source/LK1/L1B/TDOF_PROC.f90 b/Source/LK1/L1B/TDOF_PROC.f90 index 47e92afa..645b8c1a 100644 --- a/Source/LK1/L1B/TDOF_PROC.f90 +++ b/Source/LK1/L1B/TDOF_PROC.f90 @@ -150,7 +150,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) IROW = 0 CALL COUNTER_INIT(' Process col 1-4 of TDOF', NGRID) DO I = 1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J = 1,NUM_COMPS IROW = IROW + 1 TDOF(IROW,1) = GRID_ID(I) @@ -168,7 +168,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 NDOFG = NDOFG + 1 @@ -194,7 +194,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process M -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'M ') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -213,7 +213,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process SA-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'SA') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -232,7 +232,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process SB-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'SB') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -251,7 +251,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process SG-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'SG') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -270,7 +270,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process SE-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'SE') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -289,7 +289,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process O -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'O ') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -308,7 +308,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process R -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'R ') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -326,7 +326,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process N -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,G_SET_COL) > 0) .AND. (TDOF(IROW,M_SET_COL) == 0)) THEN @@ -346,7 +346,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process SZ-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,SA_SET_COL) > 0) .OR. (TDOF(IROW,SB_SET_COL) > 0) .OR. (TDOF(IROW,SG_SET_COL) > 0)) THEN @@ -367,7 +367,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process S -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,SZ_SET_COL) > 0) .OR. (TDOF(IROW,SE_SET_COL) > 0)) THEN @@ -387,7 +387,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process F -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,N_SET_COL) > 0) .AND. (TDOF(IROW,S_SET_COL) == 0)) THEN @@ -406,7 +406,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process A -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,F_SET_COL) > 0) .AND. (TDOF(IROW,O_SET_COL) == 0)) THEN @@ -425,7 +425,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process L -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,A_SET_COL) > 0) .AND. (TDOF(IROW,R_SET_COL) == 0)) THEN @@ -445,7 +445,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process U1-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (USET(IGRID,J) == 'U1') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -464,7 +464,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process U2-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (USET(IGRID,J) == 'U2') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 diff --git a/Source/LK1/L1B/TSET_PROC.f90 b/Source/LK1/L1B/TSET_PROC.f90 index ae2da1fa..98f15f16 100644 --- a/Source/LK1/L1B/TSET_PROC.f90 +++ b/Source/LK1/L1B/TSET_PROC.f90 @@ -106,7 +106,7 @@ SUBROUTINE TSET_PROC WRITE(SC1,12345,ADVANCE='NO') ' Initializing ', CR13 DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID(I,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 1) THEN DO K=2,6 TSET(I,K) = '--' @@ -141,7 +141,7 @@ SUBROUTINE TSET_PROC NDOFO = 0 IF (NAOCARD == 0) THEN ! If no ASET,1/OMIT,1 cards, then, for time being, set all remaining DOF DO I = 1,NGRID ! to A-set (if there are SUPORT's some will get changed to R set below) - CALL GET_GRID_NUM_COMPS ( GRID(I,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS IF (TSET(I,K) == ' ') THEN TSET(I,K) = 'A ' diff --git a/Source/LK1/L1B/TSET_PROC_FOR_OMITS.f90 b/Source/LK1/L1B/TSET_PROC_FOR_OMITS.f90 index e9a897c7..ee34c146 100644 --- a/Source/LK1/L1B/TSET_PROC_FOR_OMITS.f90 +++ b/Source/LK1/L1B/TSET_PROC_FOR_OMITS.f90 @@ -131,7 +131,7 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) DO J=GID1,GID2 ! GID2 > GID1 was checked when ASET/OMIT B.D. cards were read CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, J, GRID_ID_ROW_NUM ) IF (GRID_ID_ROW_NUM /= -1) THEN - CALL GET_GRID_NUM_COMPS ( GRID(GRID_ID_ROW_NUM,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS IF (CDOF1(K) == '1') THEN IF ((TSET(GRID_ID_ROW_NUM,K) == ' ') .OR. (TSET(GRID_ID_ROW_NUM,K) == DOFSET)) THEN @@ -155,7 +155,7 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) IF ((ASET_FND == 'Y').AND.(OMIT_FND == 'N')) THEN ! Make all DOF's not as yet set be O-set DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID(I,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO K=1,NUM_COMPS IF (TSET(I,K) == ' ') THEN TSET(I,K) = 'O ' @@ -167,7 +167,7 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) IF ((ASET_FND == 'N').AND.(OMIT_FND == 'Y')) THEN ! Make all DOF's not as yet set be A-set DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID(I,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO K=1,NUM_COMPS IF (TSET(I,K) == ' ') THEN TSET(I,K) = 'A ' diff --git a/Source/LK1/L1B/TSET_PROC_FOR_SPCS.f90 b/Source/LK1/L1B/TSET_PROC_FOR_SPCS.f90 index 2e0114fe..66e3230b 100644 --- a/Source/LK1/L1B/TSET_PROC_FOR_SPCS.f90 +++ b/Source/LK1/L1B/TSET_PROC_FOR_SPCS.f90 @@ -90,7 +90,7 @@ SUBROUTINE TSET_PROC_FOR_SPCS ( IERRT ) DO I=1,NGRID IF (GRID(I,4) /= 0) THEN CALL RDOF ( GRID(I,4), CDOF ) - CALL GET_GRID_NUM_COMPS ( GRID(I,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS IF (CDOF(K) == '1') THEN IF ((TSET(I,K) == ' ') .OR. (TSET(I,K) == 'SB')) THEN @@ -201,7 +201,7 @@ SUBROUTINE TSET_PROC_FOR_SPCS ( IERRT ) DO GRID_NUM=GRID1,GRID2 ! GRID2 >= GRID1 was checked in subr BD_SPC1 CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_NUM, GRID_ID_ROW_NUM ) IF (GRID_ID_ROW_NUM /= -1) THEN - CALL GET_GRID_NUM_COMPS ( GRID(GRID_ID_ROW_NUM,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS ! Put data in TSET and write enforced displ to L1H. IF (CDOF(K) == '1') THEN IF (DOFSET == 'SE') THEN diff --git a/Source/LK1/L1B/USET_PROC.f90 b/Source/LK1/L1B/USET_PROC.f90 index 219e5446..cded9401 100644 --- a/Source/LK1/L1B/USET_PROC.f90 +++ b/Source/LK1/L1B/USET_PROC.f90 @@ -153,7 +153,7 @@ SUBROUTINE USET_PROC DO GRID_NUM=GRID1,GRID2 ! GRID2 >= GRID1 was checked in subr BD_SPC1 CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_NUM, GRID_ID_ROW_NUM ) IF (GRID_ID_ROW_NUM /= -1) THEN - CALL GET_GRID_NUM_COMPS ( GRID(GRID_ID_ROW_NUM,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM, NUM_COMPS, SUBR_NAME ) DO J = 1,NUM_COMPS ! Put data in USET and write enforced displ to L1H. IF (CDOF(J) == '1') THEN IF (SNAME == 'U1') THEN diff --git a/Source/LK1/L1C/CONM2_PROC_1.f90 b/Source/LK1/L1C/CONM2_PROC_1.f90 index f20cc555..4aba7c71 100644 --- a/Source/LK1/L1C/CONM2_PROC_1.f90 +++ b/Source/LK1/L1C/CONM2_PROC_1.f90 @@ -123,7 +123,7 @@ SUBROUTINE CONM2_PROC_1 WRITE(F06,1822) 'GRID ', AGRID, NAME, CONM2(I,1) ENDIF IF (IERROR == 0) THEN - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 1) THEN NUM_RCONM2_RESET = NUM_RCONM2_RESET + 1 DO J=2,MRCONM2 ! Keep mass but reset offsets amd MOI's to zero for SPOINT's diff --git a/Source/LK1/L1C/GPWG.f90 b/Source/LK1/L1C/GPWG.f90 index b1a37b98..e5276142 100644 --- a/Source/LK1/L1C/GPWG.f90 +++ b/Source/LK1/L1C/GPWG.f90 @@ -216,7 +216,7 @@ SUBROUTINE GPWG ( WHICH ) ENDIF ENDIF - CALL GET_GRID_NUM_COMPS ( AGRID(J), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(J), NUM_COMPS, SUBR_NAME ) JDOF = NUM_COMPS*(J - 1) + 1 M0 = ME(JDOF,JDOF) MASS = MASS + M0 diff --git a/Source/LK1/L1C/RB_DISP_MATRIX_PROC.f90 b/Source/LK1/L1C/RB_DISP_MATRIX_PROC.f90 index c5673a24..918d5705 100644 --- a/Source/LK1/L1C/RB_DISP_MATRIX_PROC.f90 +++ b/Source/LK1/L1C/RB_DISP_MATRIX_PROC.f90 @@ -136,7 +136,7 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) WRITE(F06,1408) SUBR_NAME, AGRID_R, 'GRID_ID' CALL OUTA_HERE ( 'Y' ) ENDIF - CALL GET_GRID_NUM_COMPS ( AGRID_R, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_R, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! AGRID_R is a physical grid X0_R = RGRID(GRID_ID_ROW_NUM_R,1) Y0_R = RGRID(GRID_ID_ROW_NUM_R,2) @@ -211,7 +211,7 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) DO K=1,NGRID AGRID_K = GRID_ID(INV_GRID_SEQ(K)) - CALL GET_GRID_NUM_COMPS ( AGRID_K, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(K), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! Only process physical grids. Let rows of RBGLOBAL = 0 otherwise @@ -332,7 +332,7 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) DO I=1,NGRID AGRID_K = GRID_ID(INV_GRID_SEQ(I)) AGRID = GRID_ID(INV_GRID_SEQ(I)) - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS L = L + 1 IF (J == 1) THEN diff --git a/Source/LK1/L1D/EPTL.f90 b/Source/LK1/L1D/EPTL.f90 index b9a73967..dc0fe636 100644 --- a/Source/LK1/L1D/EPTL.f90 +++ b/Source/LK1/L1D/EPTL.f90 @@ -170,7 +170,7 @@ SUBROUTINE EPTL !xx CALL CALC_TDOF_ROW_NUM ( AGRID(J), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID(J), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(J), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL_NUM ) ROW_NUM = ROW_NUM_START + K - 1 diff --git a/Source/LK1/L1D/GET_GRID_6X6_MASS.f90 b/Source/LK1/L1D/GET_GRID_6X6_MASS.f90 index e3b99824..c197fb46 100644 --- a/Source/LK1/L1D/GET_GRID_6X6_MASS.f90 +++ b/Source/LK1/L1D/GET_GRID_6X6_MASS.f90 @@ -67,7 +67,7 @@ SUBROUTINE GET_GRID_6X6_MASS ( AGRID, IGRID, FOUND, GRID_MGG ) ! ********************************************************************************************************************************** ! If AGRID is an SPOINT give error and quit - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS /= 6) THEN FATAL_ERR = FATAL_ERR + 1 WRITE(ERR,1502) AGRID, NUM_COMPS diff --git a/Source/LK1/L1D/RBE2_PROC.f90 b/Source/LK1/L1D/RBE2_PROC.f90 index 0058e671..ee05b395 100644 --- a/Source/LK1/L1D/RBE2_PROC.f90 +++ b/Source/LK1/L1D/RBE2_PROC.f90 @@ -102,16 +102,20 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) JERR = 0 READ(L1F,IOSTAT=IOCHK) REID, AGRID_D, DDOF, AGRID_I + + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D, GRID_ID_ROW_NUM_D ) + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I, GRID_ID_ROW_NUM_I ) + REC_NO = REC_NO + 1 IF (IOCHK == 0) THEN - CALL GET_GRID_NUM_COMPS ( AGRID_D, NUM_COMPS_D, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_D, NUM_COMPS_D, SUBR_NAME ) IF (NUM_COMPS_D /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 WRITE(ERR,1951) 'RBE2', REID, NUM_COMPS_D WRITE(F06,1951) 'RBE2', REID, NUM_COMPS_D ENDIF - CALL GET_GRID_NUM_COMPS ( AGRID_I, NUM_COMPS_I, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_I, NUM_COMPS_I, SUBR_NAME ) IF (NUM_COMPS_I /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 @@ -134,7 +138,6 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) ! We know that the indep and dep grids (AGRID_I and AGRID_D) exist. This was checked in subr DOF_PROC. ! Get the basic-to-global trensformation matrices for AGRID_D and AGRID_I - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D, GRID_ID_ROW_NUM_D ) ECORD_D = GRID(GRID_ID_ROW_NUM_D,3) IF (ECORD_D /= 0) THEN DO I=1,NCORD @@ -153,7 +156,6 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) ENDDO ENDIF - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I, GRID_ID_ROW_NUM_I ) ECORD_I = GRID(GRID_ID_ROW_NUM_I,3) IF (ECORD_I /= 0) THEN DO I=1,NCORD diff --git a/Source/LK1/L1D/RBE3_PROC.f90 b/Source/LK1/L1D/RBE3_PROC.f90 index acc013e9..9887743d 100644 --- a/Source/LK1/L1D/RBE3_PROC.f90 +++ b/Source/LK1/L1D/RBE3_PROC.f90 @@ -154,9 +154,12 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) ! Start reading at the 2nd record of L1F for this RBE3 (first record, RYPE, was read above in calling subr, RIGID_ELEM_PROC): ! Read 2nd record from L1F for this RBE3 READ(L1F,IOSTAT=IOCHK) REID, AGRID_D, COMPS_D, IRBE3, WT + + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D, GRID_ID_ROW_NUM_D ) + REC_NO = REC_NO + 1 IF (IOCHK == 0) THEN - CALL GET_GRID_NUM_COMPS ( AGRID_D, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_D, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 @@ -195,7 +198,6 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) ! Get T0D (transforms global vector at AGRID_D to basic) - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D, GRID_ID_ROW_NUM_D ) ECORD_D = GRID(GRID_ID_ROW_NUM_D,3) IF (ECORD_D /= 0) THEN DO I=1,NCORD @@ -444,7 +446,9 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) ! Get T0I (transforms global vector at AGRID_I to basic) CALL RDOF ( COMPS_I(J), CDOF_I ) - CALL GET_GRID_NUM_COMPS ( AGRID_I(J), NUM_COMPS, SUBR_NAME ) + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I(J), GRID_ID_ROW_NUM_I ) + + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_I, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 @@ -454,7 +458,6 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) RETURN ENDIF - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I(J), GRID_ID_ROW_NUM_I ) ECORD_I= GRID(GRID_ID_ROW_NUM_I,3) IF (ECORD_I /= 0) THEN DO K=1,NCORD diff --git a/Source/LK1/L1D/RSPLINE_PROC.f90 b/Source/LK1/L1D/RSPLINE_PROC.f90 index c779a1f6..4e9dd3fd 100644 --- a/Source/LK1/L1D/RSPLINE_PROC.f90 +++ b/Source/LK1/L1D/RSPLINE_PROC.f90 @@ -135,23 +135,30 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) IF (DEBUG(111) > 0) CALL DEB_RSPLINE_PROC ( ' 1' ) + +! Get the internal grid ID's for AGRID I1, AGRID_I2 and AGRID_D. We know they exist + + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I1, GRID_ID_ROW_NUM_I1 ) + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I2, GRID_ID_ROW_NUM_I2 ) + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D , GRID_ID_ROW_NUM_D ) + REC_NO = REC_NO + 1 IF (IOCHK == 0) THEN - CALL GET_GRID_NUM_COMPS ( AGRID_I1, NUM_COMPS_I1, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_I1, NUM_COMPS_I1, SUBR_NAME ) IF (NUM_COMPS_I1 /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 WRITE(ERR,1951) 'RSPLINE', REID, NUM_COMPS_I1 WRITE(F06,1951) 'RSPLINE', REID, NUM_COMPS_I1 ENDIF - CALL GET_GRID_NUM_COMPS ( AGRID_I2, NUM_COMPS_I2, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_I2, NUM_COMPS_I2, SUBR_NAME ) IF (NUM_COMPS_I2 /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 WRITE(ERR,1951) 'RSPLINE', REID, NUM_COMPS_I2 WRITE(F06,1951) 'RSPLINE', REID, NUM_COMPS_I2 ENDIF - CALL GET_GRID_NUM_COMPS ( AGRID_D, NUM_COMPS_D, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_D, NUM_COMPS_D, SUBR_NAME ) IF (NUM_COMPS_D /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 @@ -171,11 +178,6 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) RETURN ENDIF -! Get the internal grid ID's for AGRID I1, AGRID_I2 and AGRID_D. We know they exist - - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I1, GRID_ID_ROW_NUM_I1 ) - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I2, GRID_ID_ROW_NUM_I2 ) - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D , GRID_ID_ROW_NUM_D ) ! Get the distances from AGRID_I1 to AGRID_I2 (total length of the RSPLINE) and AGRID_I1 to AGRID_D diff --git a/Source/LK1/L1E/EMP.f90 b/Source/LK1/L1E/EMP.f90 index cdeca3c4..2da1ea66 100644 --- a/Source/LK1/L1E/EMP.f90 +++ b/Source/LK1/L1E/EMP.f90 @@ -159,7 +159,7 @@ SUBROUTINE EMP ! CALL CALC_TDOF_ROW_NUM ( AGRID(J), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID(J), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(J), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL_NUM ) TDOF_ROW_NUM = ROW_NUM_START + K - 1 diff --git a/Source/LK1/L1E/ESP.f90 b/Source/LK1/L1E/ESP.f90 index 77a2b441..87f6bb2f 100644 --- a/Source/LK1/L1E/ESP.f90 +++ b/Source/LK1/L1E/ESP.f90 @@ -235,7 +235,7 @@ SUBROUTINE ESP DO J = 1,ELGP CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID(J), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(J), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL_NUM ) TDOF_ROW_NUM = ROW_NUM_START + K - 1 @@ -666,7 +666,7 @@ END SUBROUTINE DUMPSTF SUBROUTINE WRITE_NEG_DIAG_STIFFNESS ( WHAT ) USE CONSTANTS_1,ONLY : ZERO - USE MODEL_STUF, ONLY : AGRID, EID, ELGP, ELDOF, TYPE + USE MODEL_STUF, ONLY : AGRID, BGRID, EID, ELGP, ELDOF, TYPE IMPLICIT NONE @@ -715,7 +715,7 @@ SUBROUTINE WRITE_NEG_DIAG_STIFFNESS ( WHAT ) WRITE(F06,97533) KK=0 DO LL=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(LL), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(LL), NUM_COMPS, SUBR_NAME ) DO MM=1,NUM_COMPS KK = KK + 1 RATIO = ZERO diff --git a/Source/LK1/L1E/ESP0_FINAL.f90 b/Source/LK1/L1E/ESP0_FINAL.f90 index bad78299..acc584c5 100644 --- a/Source/LK1/L1E/ESP0_FINAL.f90 +++ b/Source/LK1/L1E/ESP0_FINAL.f90 @@ -120,7 +120,7 @@ SUBROUTINE ESP0_FINAL !xx CALL CALC_TDOF_ROW_NUM ( AGRID(J), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID(J), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(J), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL_NUM ) TDOF_ROW_NUM = ROW_NUM_START + K - 1 diff --git a/Source/LK1/L1E/KGG_SINGULARITY_PROC.f90 b/Source/LK1/L1E/KGG_SINGULARITY_PROC.f90 index cfeabfee..63b2bc61 100644 --- a/Source/LK1/L1E/KGG_SINGULARITY_PROC.f90 +++ b/Source/LK1/L1E/KGG_SINGULARITY_PROC.f90 @@ -112,7 +112,7 @@ SUBROUTINE KGG_SINGULARITY_PROC ( AGRID, KGRD, NUM_ASPC_BY_COMP ) !xx CALL CALC_TDOF_ROW_NUM ( AGRID, ROW_NUM_START, 'N' )! Det where in TDOF (not TDOFI) the DOF data begins for AGRID CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID, IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, 'N' ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, 'N' ) comps:IF (NUM_COMPS == 6) THEN ! Physical grid with 6 components represented in KGRD comps6: DO K=1,2 ! K=1 is for translational DOF's and K=2 is for rotational DOF's diff --git a/Source/LK1/L1E/MGGC_MASS_MATRIX.f90 b/Source/LK1/L1E/MGGC_MASS_MATRIX.f90 index 2c7f514a..2fdd214c 100644 --- a/Source/LK1/L1E/MGGC_MASS_MATRIX.f90 +++ b/Source/LK1/L1E/MGGC_MASS_MATRIX.f90 @@ -87,7 +87,7 @@ SUBROUTINE MGGC_MASS_MATRIX !xx GRID_NUM = GRID_ID(INV_GRID_SEQ(I)) ! GRID_NUM's are in TDOFI order (internal DOF order) GRID_NUM = GRID_ID(I) CALL MGG_CONM2_PROC ( I, GRID_NUM, MGG_CONM2, MGG_CONM2_NONZERO ) - CALL GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) IF (MGG_CONM2_NONZERO == 'Y') THEN DO J=1,NUM_COMPS diff --git a/Source/LK1/L1E/SPARSE_KGG.f90 b/Source/LK1/L1E/SPARSE_KGG.f90 index 4e8096de..574e3c53 100644 --- a/Source/LK1/L1E/SPARSE_KGG.f90 +++ b/Source/LK1/L1E/SPARSE_KGG.f90 @@ -198,7 +198,7 @@ SUBROUTINE SPARSE_KGG CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(INV_GRID_SEQ(I)), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) KGG_COL_NUM = TDOF(ROW_NUM_START,G_SET_COL) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) k_do: DO K=1,NUM_COMPS KGG_ROW_NUM = KGG_ROW_NUM + 1 diff --git a/Source/LK1/L1E/SPARSE_KGGD.f90 b/Source/LK1/L1E/SPARSE_KGGD.f90 index c654eb08..5b9132bc 100644 --- a/Source/LK1/L1E/SPARSE_KGGD.f90 +++ b/Source/LK1/L1E/SPARSE_KGGD.f90 @@ -156,7 +156,7 @@ SUBROUTINE SPARSE_KGGD CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(INV_GRID_SEQ(I)), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) KGGD_COL_NUM = TDOF(ROW_NUM_START,G_SET_COL) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) k_do: DO K=1,NUM_COMPS KGGD_ROW_NUM = KGGD_ROW_NUM + 1 diff --git a/Source/LK1/L1E/SPARSE_MGG.f90 b/Source/LK1/L1E/SPARSE_MGG.f90 index d45e36d7..359fd292 100644 --- a/Source/LK1/L1E/SPARSE_MGG.f90 +++ b/Source/LK1/L1E/SPARSE_MGG.f90 @@ -146,7 +146,7 @@ SUBROUTINE SPARSE_MGG !xx CALL CALC_TDOF_ROW_NUM ( GRID_NUM, IROW_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_NUM, IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) k_do: DO K=1,NUM_COMPS IK = ROW_NUM_START + K - 1 @@ -320,7 +320,7 @@ SUBROUTINE SPARSE_MGG IF (DEBUG(36) > 0) THEN WRITE(F06,1101) DO K=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(K), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( K, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! Only do output for actual grids, not SPOINT's CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(K), IGRID ) IF (IGRID == -1) THEN diff --git a/Source/LK2/REDUCE_G_NM.f90 b/Source/LK2/REDUCE_G_NM.f90 index 8bfc8f25..8d3f526e 100644 --- a/Source/LK2/REDUCE_G_NM.f90 +++ b/Source/LK2/REDUCE_G_NM.f90 @@ -434,7 +434,7 @@ SUBROUTINE REDUCE_G_NM WRITE(SC1,2092) MODNAM,HOUR,MINUTE,SEC,SFRAC K = 0 DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS K = K + 1 IF (TDOF(K,SA_SET_COL) /= 0) THEN diff --git a/Source/LK5/LINK5.f90 b/Source/LK5/LINK5.f90 index cb788036..1a953ee5 100644 --- a/Source/LK5/LINK5.f90 +++ b/Source/LK5/LINK5.f90 @@ -623,7 +623,7 @@ SUBROUTINE LINK5 WRITE(F06,99886) (J,J=1,NUM_CB_DOFS) L = 0 DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO K=1,NUM_COMPS L = L + 1 IF (K == 1) THEN diff --git a/Source/LK9/L91/WRITE_FEMAP_GRID_VECS.f90 b/Source/LK9/L91/WRITE_FEMAP_GRID_VECS.f90 index 105984d6..e43cdfe9 100644 --- a/Source/LK9/L91/WRITE_FEMAP_GRID_VECS.f90 +++ b/Source/LK9/L91/WRITE_FEMAP_GRID_VECS.f90 @@ -130,7 +130,7 @@ SUBROUTINE WRITE_FEMAP_GRID_VECS ( GRID_VEC, FEMAP_SET_ID, WHAT ) R3_VEC(I) = ZERO GRID_NUMS(I) = GRID_ID(INV_GRID_SEQ(I)) - CALL GET_GRID_NUM_COMPS ( GRID_NUMS(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! Grid point, 6 DOF IDOFG = IDOFG + 1 ; T1_VEC(I) = GRID_VEC(IDOFG) IDOFG = IDOFG + 1 ; T2_VEC(I) = GRID_VEC(IDOFG) diff --git a/Source/LK9/L92/CALC_ELEM_NODE_FORCES.f90 b/Source/LK9/L92/CALC_ELEM_NODE_FORCES.f90 index 0dc1d10c..adbf1339 100644 --- a/Source/LK9/L92/CALC_ELEM_NODE_FORCES.f90 +++ b/Source/LK9/L92/CALC_ELEM_NODE_FORCES.f90 @@ -83,7 +83,7 @@ SUBROUTINE CALC_ELEM_NODE_FORCES IF (TYPE(1:4) == 'ELAS') THEN ! Calculate forces for ELAS1-4 elems I1 = ELAS_COMP(1) - CALL GET_GRID_NUM_COMPS ( AGRID(1), NUM_COMPS_GRID_1, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(1), NUM_COMPS_GRID_1, SUBR_NAME ) I2 = NUM_COMPS_GRID_1 + ELAS_COMP(2) PEL(I1) = KE(I1,I1)*UEL(I1) + KE(I1,I2)*UEL(I2) ! Note: KE is global and local for the ELAS elems PEL(I2) = KE(I2,I1)*UEL(I1) + KE(I2,I2)*UEL(I2) diff --git a/Source/LK9/L92/ELMDIS.f90 b/Source/LK9/L92/ELMDIS.f90 index 05597f46..d74dbeee 100644 --- a/Source/LK9/L92/ELMDIS.f90 +++ b/Source/LK9/L92/ELMDIS.f90 @@ -99,7 +99,7 @@ SUBROUTINE ELMDIS ! CALL CALC_TDOF_ROW_NUM ( AGRID(I), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 ! TDOF has rows in grid point numerical order @@ -124,7 +124,7 @@ SUBROUTINE ELMDIS ! --------------------------------------------------------------------------------------------------------------------------- I2 = 0 ! (1) Transform global displs at grids to global displs at elem nodes DO I=1,ELGP ! First assume no offset at this node - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 UEG(I2) = UGG(I2) @@ -174,7 +174,7 @@ SUBROUTINE ELMDIS ENDDO I2 = I2 + NUM_COMPS ELSE ! If global is basic, get UEB terms directly from UEG - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 UEB(I2) = UEG(I2) @@ -260,7 +260,7 @@ SUBROUTINE DEBUG_ELMDIS I2 = 0 DO I=1,ELGP ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 @@ -271,7 +271,7 @@ SUBROUTINE DEBUG_ELMDIS I2 = 0 DO I=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 ENDDO @@ -279,7 +279,7 @@ SUBROUTINE DEBUG_ELMDIS I2 = 0 DO I=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 ENDDO @@ -287,7 +287,7 @@ SUBROUTINE DEBUG_ELMDIS I2 = 0 DO I=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 ENDDO diff --git a/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 b/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 index ea40fba3..a84cbbcb 100644 --- a/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 +++ b/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 @@ -356,7 +356,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) !FLUSH(ERR) IB = IAND(GROUT(I,INT_SC_NUM),IBIT(GROUT_GPFO_BIT)) GRID_NUM = GRID(I,1) - CALL GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) IF ((IB > 0) .AND. (NUM_COMPS == 6)) THEN ! Do not do force balance for SPOINT's G_CID = GRID(I,3) @@ -442,7 +442,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) DO I=1,NGRID IB = IAND(GROUT(I,INT_SC_NUM),IBIT(GROUT_GPFO_BIT)) GRID_NUM = GRID(I,1) - CALL GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) IF ((IB > 0) .AND. (NUM_COMPS == 6)) THEN ! Do not do force balance for SPOINT's G_CID = GRID(I,3) @@ -494,7 +494,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) ! get applied load, thermal load, SPC force, MPC force for a single node CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_NUM, IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 diff --git a/Source/LK9/L92/OFP1.f90 b/Source/LK9/L92/OFP1.f90 index 68b20fc1..64ed08eb 100644 --- a/Source/LK9/L92/OFP1.f90 +++ b/Source/LK9/L92/OFP1.f90 @@ -154,7 +154,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N !xx CALL CALC_TDOF_ROW_NUM ( GRID_ID(I), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 @@ -240,7 +240,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N GID_OUT_ARRAY(NUM,MELGP+1) = GRID(I,5) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 @@ -323,7 +323,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N GID_OUT_ARRAY(NUM,MELGP+1) = GRID(I,5) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 diff --git a/Source/LK9/L92/OFP2.f90 b/Source/LK9/L92/OFP2.f90 index 5adf1c94..d4f7cd85 100644 --- a/Source/LK9/L92/OFP2.f90 +++ b/Source/LK9/L92/OFP2.f90 @@ -246,7 +246,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 !xx CALL CALC_TDOF_ROW_NUM ( GRID_ID(I), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) !xx WRITE_OGEL(NUM) = 'N' ! Set WRITE_OGEL to 'Y' for all grids that have a component in S-set !xx DO J=1,NUM_COMPS @@ -342,7 +342,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 ENDDO K = 0 DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS K = K + 1 QGs_MEFM_SUM(J) = QGs_MEFM_SUM(J) + QGs_MEFM(K) @@ -380,7 +380,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 !xx CALL CALC_TDOF_ROW_NUM ( GRID_ID(I), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'S' , S_SET_COL ) CALL TDOF_COL_NUM ( 'SA', SA_SET_COL ) @@ -557,7 +557,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 !xx CALL CALC_TDOF_ROW_NUM ( GRID_ID(I), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 diff --git a/Source/LK9/L92/OFP3_ELFN.f90 b/Source/LK9/L92/OFP3_ELFN.f90 index 0c006937..3b92fa31 100644 --- a/Source/LK9/L92/OFP3_ELFN.f90 +++ b/Source/LK9/L92/OFP3_ELFN.f90 @@ -37,7 +37,7 @@ SUBROUTINE OFP3_ELFN ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) USE SUBR_BEGEND_LEVELS, ONLY : OFP3_ELFN_BEGEND USE PARAMS, ONLY : ELFORCEN, OTMSKIP USE MODEL_STUF, ONLY : EDAT, EPNT, ETYPE, AGRID, EID, ELDT, ELGP, ELMTYP, ELOUT, METYPE, NUM_EMG_FATAL_ERRS, & - PEB, PEG, PEL, PLY_NUM, TYPE, SCNUM + PEB, PEG, PEL, PLY_NUM, TYPE, SCNUM, BGRID USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, EID_OUT_ARRAY, MAXREQ, OGEL USE OUTPUT4_MATRICES, ONLY : OTM_ELFN, TXT_ELFN @@ -177,7 +177,7 @@ SUBROUTINE OFP3_ELFN ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) DO L=1,6 OGEL(NUM_OGEL,L) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(K), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(K), NUM_COMPS, SUBR_NAME ) DO L=1,NUM_COMPS I2 = I2 + 1 IF (ELFORCEN == 'LOCAL') THEN diff --git a/Source/UTIL/CALC_TDOF_ROW_START.f90 b/Source/UTIL/CALC_TDOF_ROW_START.f90 index 75c5fcb2..b838714c 100644 --- a/Source/UTIL/CALC_TDOF_ROW_START.f90 +++ b/Source/UTIL/CALC_TDOF_ROW_START.f90 @@ -62,7 +62,7 @@ SUBROUTINE CALC_TDOF_ROW_START ( PRTDEB ) TDOF_ROW_START(1) = 1 DO I=2,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I-1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I-1, NUM_COMPS, SUBR_NAME ) TDOF_ROW_START(I) = TDOF_ROW_START(I-1) + NUM_COMPS ENDDO diff --git a/Source/UTIL/CONVERT_VEC_COORD_SYS.f90 b/Source/UTIL/CONVERT_VEC_COORD_SYS.f90 index ced0c5a7..88f4e61b 100644 --- a/Source/UTIL/CONVERT_VEC_COORD_SYS.f90 +++ b/Source/UTIL/CONVERT_VEC_COORD_SYS.f90 @@ -88,7 +88,7 @@ SUBROUTINE CONVERT_VEC_COORD_SYS ( MESSAG, INPUT_VEC, OUTPUT_VEC, NCID ) DO K=1,NGRID AGRID = GRID_ID(INV_GRID_SEQ(K)) - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(K), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! Only 6 comp grids need transforming CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID, GRID_ID_ROW_NUM ) @@ -156,7 +156,7 @@ SUBROUTINE CONVERT_VEC_COORD_SYS ( MESSAG, INPUT_VEC, OUTPUT_VEC, NCID ) DO K=1,NGRID AGRID = GRID_ID(INV_GRID_SEQ(K)) - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(K), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! Only 6 comp grids need transforming diff --git a/Source/UTIL/GET_GRID_NUM_COMPS.f90 b/Source/UTIL/GET_GRID_NUM_COMPS.f90 index 3c6eb95f..8077ae74 100644 --- a/Source/UTIL/GET_GRID_NUM_COMPS.f90 +++ b/Source/UTIL/GET_GRID_NUM_COMPS.f90 @@ -23,74 +23,29 @@ ! _______________________________________________________________________________________________________ ! End MIT license text. + + + SUBROUTINE GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, CALLING_SUBR ) - SUBROUTINE GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, CALLING_SUBR ) - -! Gets the number of components for a "grid" number from array GRID by testing GRID(I,6) +! Gets the number of components for a "grid" number from array GRID by testing GRID(IGRID,6) ! If GRID(I,6) is 6 then this is a physical grid with 6 comps of displ and if GRID(I,6) is 1 then this is an SPOINT. - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NGRID - USE TIMDAT, ONLY : TSEC + USE PENTIUM_II_KIND, ONLY : LONG USE MODEL_STUF, ONLY : GRID - USE SUBR_BEGEND_LEVELS, ONLY : GET_GRID_NUM_COMPS_BEGEND - - USE GET_GRID_NUM_COMPS_USE_IFs IMPLICIT NONE - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'GET_GRID_NUM_COMPS' CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Subr that called this one - INTEGER(LONG), INTENT(IN) :: GRID_NUM ! A grid number (calling subr checked that it is an actual grid) + INTEGER(LONG), INTENT(IN) :: IGRID ! An internal grid number INTEGER(LONG), INTENT(OUT) :: NUM_COMPS ! 6 if GRID_NUM is an physical grid, 1 if an SPOINT - INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_GRID_NUM_COMPS_BEGEND - -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF ! ********************************************************************************************************************************** -! Initialize outputs - - NUM_COMPS = 0 - -! Calc NUM_COMPS - - DO I=1,NGRID - IF (GRID(I,1) == GRID_NUM) THEN - NUM_COMPS = GRID(I,6) - EXIT - ENDIF - ENDDO - -! Error if NUM_COMPS not 1 or 6 - - IF ((NUM_COMPS /= 1) .AND. (NUM_COMPS /= 6)) THEN - FATAL_ERR = FATAL_ERR + 1 - WRITE(ERR,950) SUBR_NAME, CALLING_SUBR, GRID_NUM, NUM_COMPS - WRITE(F06,950) SUBR_NAME, CALLING_SUBR, GRID_NUM, NUM_COMPS - CALL OUTA_HERE ( 'Y' ) - ENDIF - -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + NUM_COMPS = GRID(IGRID, 6) + RETURN -! ********************************************************************************************************************************** - 950 FORMAT(' *ERROR 945: PROGRAMMING ERROR IN SUBROUTINE ',A,' CALLED BY SUBROUTINE ',A & - ,/,14X,' FOR GRID ',I8,' THE NUMBER OF DISPL COMPONENTS IS ',I8,' BUT MUST BE EITHER 1 (SPOINT) OR 6 (GRID)') - ! ********************************************************************************************************************************** - END SUBROUTINE GET_GRID_NUM_COMPS \ No newline at end of file + END SUBROUTINE GET_GRID_NUM_COMPS \ No newline at end of file diff --git a/Source/UTIL/GET_UG_123_IN_GRD_ORD.f90 b/Source/UTIL/GET_UG_123_IN_GRD_ORD.f90 index c79aedd4..305a2d6f 100644 --- a/Source/UTIL/GET_UG_123_IN_GRD_ORD.f90 +++ b/Source/UTIL/GET_UG_123_IN_GRD_ORD.f90 @@ -68,7 +68,7 @@ SUBROUTINE GET_UG_123_IN_GRD_ORD ( IERR ) IGRID = 0 IDOFG = 0 DO I = 1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J = 1,NUM_COMPS IDOFG = IDOFG + 1 IF (IDOFG > NDOFG) CALL ARRAY_SIZE_ERROR_1 ( SUBR_NAME, IDOFG, 'TDOFI' ) @@ -100,7 +100,7 @@ SUBROUTINE GET_UG_123_IN_GRD_ORD ( IERR ) IDOFG = 0 DO I = 1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) j_do2: DO J = 1,NUM_COMPS IDOFG = IDOFG + 1 IF (J <= 3) THEN ! We only want the 3 translations (or 1 if SPOINT) diff --git a/Source/UTIL/WRITE_TDOF.f90 b/Source/UTIL/WRITE_TDOF.f90 index 557b6ac9..6a85789f 100644 --- a/Source/UTIL/WRITE_TDOF.f90 +++ b/Source/UTIL/WRITE_TDOF.f90 @@ -71,7 +71,7 @@ SUBROUTINE WRITE_TDOF ( TDOF_MSG ) ENDIF IROW = 0 DO I = 1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J = 1,NUM_COMPS IROW = IROW + 1 IF (J == 1) THEN @@ -111,7 +111,7 @@ SUBROUTINE WRITE_TDOF ( TDOF_MSG ) ENDIF IROW = 0 DO I = 1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J = 1,NUM_COMPS IROW = IROW + 1 IF (J == 1) THEN From e94d188a1cce601c382b88d613898b364eca31f4 Mon Sep 17 00:00:00 2001 From: "U-DESKTOP-CPU04V4\\vic" Date: Sat, 4 Apr 2026 11:38:02 +1300 Subject: [PATCH 2/2] Remove testing GRID array is sorted --- Source/EMG/EMG1/GET_ELEM_AGRID_BGRID.f90 | 3 -- .../GET_ARRAY_ROW_NUM_Interface.f90 | 20 +--------- Source/UTIL/GET_ARRAY_ROW_NUM.f90 | 40 ------------------- 3 files changed, 1 insertion(+), 62 deletions(-) diff --git a/Source/EMG/EMG1/GET_ELEM_AGRID_BGRID.f90 b/Source/EMG/EMG1/GET_ELEM_AGRID_BGRID.f90 index 315163c4..565ad2d1 100644 --- a/Source/EMG/EMG1/GET_ELEM_AGRID_BGRID.f90 +++ b/Source/EMG/EMG1/GET_ELEM_AGRID_BGRID.f90 @@ -72,9 +72,6 @@ SUBROUTINE GET_ELEM_AGRID_BGRID ( INT_ELEM_ID, CHECK_AGRID ) CALL GET_ELGP ( INT_ELEM_ID ) - ! assert that the array is sorted and the binary search in GET_ARRAY_ROW_NUM will work - CALL ASSERT_ARRAY_SORTED ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID) - DO I=1,ELGP DELTA = 1 IF (TYPE == 'BUSH ') THEN ! 1st grid in EDAT for BUSH is at EPNTK+3 since "Num grids" is EPNTK+2 diff --git a/Source/Interfaces/GET_ARRAY_ROW_NUM_Interface.f90 b/Source/Interfaces/GET_ARRAY_ROW_NUM_Interface.f90 index 11c8f375..b5077bf1 100644 --- a/Source/Interfaces/GET_ARRAY_ROW_NUM_Interface.f90 +++ b/Source/Interfaces/GET_ARRAY_ROW_NUM_Interface.f90 @@ -51,25 +51,7 @@ SUBROUTINE GET_ARRAY_ROW_NUM ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY, EXT_ID, R INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ARRAY_ROW_NUM_BEGEND END SUBROUTINE GET_ARRAY_ROW_NUM - - SUBROUTINE ASSERT_ARRAY_SORTED ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY) - - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, f06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR - - USE GET_ARRAY_ROW_NUM_USE_IFs - - IMPLICIT NONE - - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ASSERT_ARRAY_SORTED' - CHARACTER(LEN=*), INTENT(IN) :: ARRAY_NAME ! Name of array to be searched - CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Name of subr that called this one - - INTEGER(LONG), INTENT(IN) :: ASIZE ! Size of ARRAY - INTEGER(LONG), INTENT(IN) :: ARRAY(ASIZE) ! Array to search - INTEGER(LONG) :: N ! Loop index - END SUBROUTINE ASSERT_ARRAY_SORTED + END INTERFACE END MODULE GET_ARRAY_ROW_NUM_Interface diff --git a/Source/UTIL/GET_ARRAY_ROW_NUM.f90 b/Source/UTIL/GET_ARRAY_ROW_NUM.f90 index 8f4df876..72993504 100644 --- a/Source/UTIL/GET_ARRAY_ROW_NUM.f90 +++ b/Source/UTIL/GET_ARRAY_ROW_NUM.f90 @@ -142,43 +142,3 @@ SUBROUTINE GET_ARRAY_ROW_NUM ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY, EXT_ID, R END SUBROUTINE GET_ARRAY_ROW_NUM - SUBROUTINE ASSERT_ARRAY_SORTED ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY ) - ! Checks and asserts that the array is sorted - ! This check was previously internal to GET_ARRAY_ROW_NUM, however that function is usually called in large loops - ! leading to much longer runtimes. - ! - ! ********************************************************************************************************************************** - - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, f06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR - - USE GET_ARRAY_ROW_NUM_USE_IFs - - IMPLICIT NONE - - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ASSERT_ARRAY_SORTED' - CHARACTER(LEN=*), INTENT(IN) :: ARRAY_NAME ! Name of array to be searched - CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Name of subr that called this one - - INTEGER(LONG), INTENT(IN) :: ASIZE ! Size of ARRAY - INTEGER(LONG), INTENT(IN) :: ARRAY(ASIZE) ! Array to search - INTEGER(LONG) :: N ! Loop index - ! ********************************************************************************************************************************** - - ! Make sure array is sorted into numerically increasing order - - DO N=2,ASIZE - IF (ARRAY(N) < ARRAY(N-1)) THEN - FATAL_ERR = FATAL_ERR + 1 - WRITE(ERR,920) CALLING_SUBR, ARRAY_NAME - WRITE(F06,920) CALLING_SUBR, ARRAY_NAME - CALL OUTA_HERE ( 'Y' ) - ENDIF - ENDDO - RETURN - ! ********************************************************************************************************************************** - 920 FORMAT(' *ERROR 920: PROGRAMMING ERROR IN SUBROUTINE ',A & - ,/,14X,' INPUT ARRAY ',A,' MUST BE SORTED IN NUMERICALLY INCREASING ORDER FOR THIS SUBR TO WORK') - - END SUBROUTINE ASSERT_ARRAY_SORTED