Skip to content

Commit df87550

Browse files
victorkempvictorkemp
authored
Merge pull request #204 from Copper280z/dev
Use reverse lookup instead of nested loop for autospc
2 parents d9c4168 + 6401eff commit df87550

1 file changed

Lines changed: 31 additions & 13 deletions

File tree

‎Source/LK2/REDUCE_G_NM.f90‎

Lines changed: 31 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -84,7 +84,6 @@ SUBROUTINE REDUCE_G_NM
8484
INTEGER(LONG) :: SA_SET_COL ! Col no. in array TDOF where the SA-set is (from subr TDOF_COL_NUM)
8585
INTEGER(LONG) :: TOT_NUM_ASPC ! Sum of NUM_ASPC_BY_COMP(6)
8686
INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_G_NM_BEGEND
87-
8887
REAL(DOUBLE) :: KNN_DIAG(NDOFN) ! Diagonal terms from KNN
8988
REAL(DOUBLE) :: KNN_MAX_DIAG ! Max diag term from KNN
9089
REAL(DOUBLE) :: KNND_DIAG(NDOFN) ! Diagonal terms from KNND
@@ -574,7 +573,7 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1
574573
! reruns subr TDOF_PROC and writes the new TSET, TDOF, TDOFI tables to file L1C
575574

576575
USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE
577-
USE SCONTR, ONLY : DATA_NAM_LEN, NDOFG, NDOFSA, NGRID, NUM_PCHD_SPC1
576+
USE SCONTR, ONLY : DATA_NAM_LEN, FATAL_ERR, NDOFG, NDOFSA, NGRID, NUM_PCHD_SPC1
578577
USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1C, L1C_MSG, LINK1C, SPC, SPCFIL
579578
USE PARAMS, ONLY : AUTOSPC, AUTOSPC_INFO, AUTOSPC_NSET, PCHSPC1, PRTTSET, SPC1SID
580579
USE DOF_TABLES, ONLY : TDOF, TDOFI, TSET
@@ -593,14 +592,13 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1
593592
INTEGER(LONG) :: GRID_ID_ROW_NUM ! Row number in array GRID_ID where AGRID is found
594593
INTEGER(LONG) :: I,J ! DO loop indices
595594
INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening/reading a file
596-
INTEGER(LONG) :: JSTART ! DO loop start point
597595
INTEGER(LONG) :: NUM_ASPC_BY_COMP(6)! Number of AUTOSPC's by component number
598596
INTEGER(LONG) :: NUM_N_SET_ROWS_NULL! Number of rows in KNN that are null and are not S or O-set members
599597
INTEGER(LONG) :: N_SET_COL ! Col no. in array TDOF where the N-set is (from subr TDOF_COL_NUM)
598+
INTEGER(LONG), ALLOCATABLE :: N_SET_TDOFI_ROW(:) ! Row in TDOFI for each N-set DOF number
600599
INTEGER(LONG) :: R_SET_COL ! Col no. in array TDOF where the R-set is (from subr TDOF_COL_NUM)
601600
INTEGER(LONG) :: S_SET_COL ! Col no. in array TDOF where the S-set is (from subr TDOF_COL_NUM)
602601
INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN
603-
604602
! **********************************************************************************************************************************
605603
OUNT(1) = ERR
606604
OUNT(2) = F06
@@ -622,6 +620,21 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1
622620
CALL TDOF_COL_NUM ( 'R ', R_SET_COL )
623621
CALL TDOF_COL_NUM ( 'S ', S_SET_COL )
624622

623+
IF (NDOFN > 0) THEN
624+
ALLOCATE ( N_SET_TDOFI_ROW(NDOFN), STAT=IOCHK )
625+
IF (IOCHK /= 0) THEN
626+
WRITE(ERR,*) ' *ERROR: ALLOCATING N_SET_TDOFI_ROW IN ', SUBR_NAME
627+
WRITE(F06,*) ' *ERROR: ALLOCATING N_SET_TDOFI_ROW IN ', SUBR_NAME
628+
FATAL_ERR = FATAL_ERR + 1
629+
CALL OUTA_HERE ( 'Y' )
630+
ENDIF
631+
N_SET_TDOFI_ROW = 0
632+
DO J=1,NDOFG
633+
N_SET_DOF = TDOFI(J,N_SET_COL)
634+
IF (N_SET_DOF > 0) N_SET_TDOFI_ROW(N_SET_DOF) = J
635+
ENDDO
636+
ENDIF
637+
625638
WRITE(ERR,101) AUTOSPC_NSET, PROG_NAME
626639
IF (SUPINFO == 'N') THEN
627640
WRITE(F06,101) AUTOSPC_NSET, PROG_NAME
@@ -634,12 +647,12 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1
634647
ENDDO
635648

636649
NUM_N_SET_ROWS_NULL = 0
637-
JSTART = 1
638650
!xx WRITE(SC1, * ) ! Advance 1 line for screen messages
639651
CALL COUNTER_INIT(' Proc N-set DOF ', NDOFN)
640652
i_do: DO I=1,NDOFN
641653
IF (I_KNN(I+1) == I_KNN(I)) THEN ! If true, row i is null
642-
j_do: DO J=JSTART,NDOFG ! Loop over rows of TDOFI to find where this N-set row is null
654+
J = N_SET_TDOFI_ROW(I)
655+
IF (J > 0) THEN
643656
IF (TDOFI(J,N_SET_COL) == I) THEN
644657
IF ((TDOFI(J,S_SET_COL) == 0) .AND. (TDOFI(J,R_SET_COL) == 0)) THEN
645658
NUM_N_SET_ROWS_NULL = NUM_N_SET_ROWS_NULL + 1
@@ -659,11 +672,19 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1
659672
WRITE(SPC,109) SPC1SID, COMP, AGRID
660673
NUM_PCHD_SPC1 = NUM_PCHD_SPC1 + 1
661674
ENDIF
662-
JSTART = J
663-
EXIT j_do
664675
ENDIF
676+
ELSE
677+
WRITE(ERR,*) ' *ERROR: N_SET_AUTOSPC_PROC_1 LOOKUP MISMATCH FOR N-SET DOF ', I
678+
WRITE(F06,*) ' *ERROR: N_SET_AUTOSPC_PROC_1 LOOKUP MISMATCH FOR N-SET DOF ', I
679+
FATAL_ERR = FATAL_ERR + 1
680+
CALL OUTA_HERE ( 'Y' )
665681
ENDIF
666-
ENDDO j_do
682+
ELSE
683+
WRITE(ERR,*) ' *ERROR: N_SET_AUTOSPC_PROC_1 LOOKUP FAILED FOR N-SET DOF ', I
684+
WRITE(F06,*) ' *ERROR: N_SET_AUTOSPC_PROC_1 LOOKUP FAILED FOR N-SET DOF ', I
685+
FATAL_ERR = FATAL_ERR + 1
686+
CALL OUTA_HERE ( 'Y' )
687+
ENDIF
667688
ENDIF
668689
CALL COUNTER_PROGRESS(I)
669690
ENDDO i_do
@@ -719,7 +740,6 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1
719740
ENDIF
720741

721742
ENDIF
722-
723743
! **********************************************************************************************************************************
724744
56 FORMAT(64X,'DEGREE OF FREEDOM SET TABLE (TSET)')
725745

@@ -779,7 +799,6 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2
779799
INTEGER(LONG) :: R_SET_COL ! Col no. in array TDOF where the R-set is (from subr TDOF_COL_NUM)
780800
INTEGER(LONG) :: S_SET_COL ! Col no. in array TDOF where the S-set is (from subr TDOF_COL_NUM)
781801
INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN
782-
783802
! **********************************************************************************************************************************
784803
OUNT(1) = ERR
785804
OUNT(2) = F06
@@ -900,9 +919,8 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2
900919
ENDIF
901920

902921
ENDIF
903-
904922
! **********************************************************************************************************************************
905-
56 FORMAT(64X,'DEGREE OF FREEDOM SET TABLE (TSET)')
923+
56 FORMAT(64X,'DEGREE OF FREEDOM SET TABLE (TSET)')
906924

907925
57 FORMAT(33x,' GRID SEQUENCE T1 T2 T3 R1 R2 R3',/)
908926

0 commit comments

Comments
 (0)