Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions Source/EMG/EMG1/ELMDAT1.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down
3 changes: 0 additions & 3 deletions Source/EMG/EMG1/GET_ELEM_AGRID_BGRID.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
14 changes: 7 additions & 7 deletions Source/EMG/EMG2/ELMOUT.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand Down
4 changes: 2 additions & 2 deletions Source/EMG/EMG3/ELAS1.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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)

! **********************************************************************************************************************************
Expand Down
20 changes: 1 addition & 19 deletions Source/Interfaces/GET_ARRAY_ROW_NUM_Interface.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
16 changes: 6 additions & 10 deletions Source/Interfaces/GET_GRID_NUM_COMPS_Interface.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions Source/LK1/L1B/OU4_PARTVEC_PROC.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
34 changes: 17 additions & 17 deletions Source/LK1/L1B/TDOF_PROC.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions Source/LK1/L1B/TSET_PROC.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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) = '--'
Expand Down Expand Up @@ -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 '
Expand Down
6 changes: 3 additions & 3 deletions Source/LK1/L1B/TSET_PROC_FOR_OMITS.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 '
Expand All @@ -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 '
Expand Down
Loading
Loading