Skip to content

Fixed lower case matrix name bug. Common TO_UPPER fn. #245

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
victorkemp merged 1 commit into from
Jun 1, 2026
Merged

Fixed lower case matrix name bug. Common TO_UPPER fn. #245

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
41 changes: 41 additions & 0 deletions Source/Interfaces/TO_UPPER_Interface.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,41 @@
! ###############################################################################################################################
! 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 TO_UPPER_Interface

INTERFACE

FUNCTION TO_UPPER(IN_TEXT) RESULT(rslt)
IMPLICIT NONE
CHARACTER(LEN=*), INTENT (IN) :: IN_TEXT
CHARACTER(len=len(IN_TEXT)) :: rslt

END FUNCTION TO_UPPER

END INTERFACE

END MODULE TO_UPPER_Interface

14 changes: 12 additions & 2 deletions Source/LK1/L1A/EC_OUTPUT4.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,7 @@ SUBROUTINE EC_OUTPUT4 ( CARD1, IERR, ANY_OU4_NAME_BAD )
USE TIMDAT, ONLY : TSEC

USE EC_OUTPUT4_USE_IFs ! Added 2019/07/14
USE TO_UPPER_Interface

IMPLICIT NONE

Expand Down Expand Up @@ -416,13 +417,21 @@ SUBROUTINE CHECK_MATRIX_NAME ( MYSTRAN_NAME, INDEX )
INTEGER(LONG), INTENT(OUT) :: INDEX ! Row in array ALLOW_OU4_MYSTRAN_NAMES where name was found
INTEGER(LONG) :: JJ ! DO loop index

CHARACTER(16*BYTE) :: ALLOW_OU4_MYSTRAN_NAME_UPPER
CHARACTER(16*BYTE) :: ALLOW_OU4_OUTPUT_NAME_UPPER

! **********************************************************************************************************************************
! Check requested OUTPUT4 names to make sure they are in the list of valid names

VALID_OU4_NAME = 'Y'
DO JJ=1,NUM_OU4_VALID_NAMES
FOUND = 'N'
IF ((MYSTRAN_NAME == ALLOW_OU4_MYSTRAN_NAMES(JJ)) .OR. (MYSTRAN_NAME == ALLOW_OU4_OUTPUT_NAMES(JJ))) THEN
! MYSTRAN_NAME was upper-cased when reading the card.
! Here, upper-case the allowed names so that comparison is case-insensitive
! and thus allows KRRcb, MRRcb, KLR(t).
ALLOW_OU4_MYSTRAN_NAME_UPPER = TO_UPPER(ALLOW_OU4_MYSTRAN_NAMES(JJ))
ALLOW_OU4_OUTPUT_NAME_UPPER = TO_UPPER(ALLOW_OU4_OUTPUT_NAMES(JJ))
IF ((MYSTRAN_NAME == ALLOW_OU4_MYSTRAN_NAME_UPPER) .OR. (MYSTRAN_NAME == ALLOW_OU4_OUTPUT_NAME_UPPER)) THEN
FOUND = 'Y'
INDEX = JJ
EXIT
Expand Down Expand Up @@ -452,5 +461,6 @@ SUBROUTINE CHECK_MATRIX_NAME ( MYSTRAN_NAME, INDEX )
! **********************************************************************************************************************************

END SUBROUTINE CHECK_MATRIX_NAME



END SUBROUTINE EC_OUTPUT4
16 changes: 8 additions & 8 deletions Source/LK1/L1A/EC_PARTN.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,20 +38,17 @@ SUBROUTINE EC_PARTN ( CARD1, IERR )
! the OUTPUT4 matrix. PARTN must follow an OUTPUT4 requesting output of the matrix A

USE PENTIUM_II_KIND, ONLY : BYTE, LONG
USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN
USE IOUNT1, ONLY : ERR, F06, MOU4, OU4, OU4_ELM_OTM, OU4_GRD_OTM, SC1
USE SCONTR, ONLY : EC_ENTRY_LEN
USE IOUNT1, ONLY : ERR, F06, MOU4, OU4, OU4_ELM_OTM, OU4_GRD_OTM
USE DEBUG_PARAMETERS, ONLY : DEBUG
USE OUTPUT4_MATRICES, ONLY : NUM_OU4_REQUESTS, NUM_PARTN_REQUESTS, OU4_PART_VEC_NAMES, OU4_PART_MAT_NAMES, &
ACT_OU4_MYSTRAN_NAMES, ACT_OU4_OUTPUT_NAMES, &
ALLOW_OU4_MYSTRAN_NAMES, ALLOW_OU4_OUTPUT_NAMES

USE TIMDAT, ONLY : TSEC
ACT_OU4_MYSTRAN_NAMES, ACT_OU4_OUTPUT_NAMES

USE EC_PARTN_USE_IFs ! Added 2019/07/14
USE TO_UPPER_Interface

IMPLICIT NONE

CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'EC_PARTN'
CHARACTER(LEN=*), INTENT(IN) :: CARD1 ! Card read in LOADE and shifted to begin in col 1
CHARACTER(LEN=LEN(CARD1)) :: CARD2 ! CARD1 truncated at $ (trailing comment) if there is one
CHARACTER(LEN=EC_ENTRY_LEN) :: DATA_80(3) ! Temp slot for holding data until lead/trail blanks stripped
Expand Down Expand Up @@ -168,7 +165,10 @@ SUBROUTINE EC_PARTN ( CARD1, IERR )

FOUND = 'N'
DO I=1,NUM_OU4_REQUESTS ! Set names of the matrix to be partitioned, the partitions and the vecs
IF (DATA_16(1) == ACT_OU4_MYSTRAN_NAMES(I)) THEN
! DATA_16(1) was upper-cased when reading the card.
! Here, upper-case the allowed names so that comparison is case-insensitive
! and thus allows KRRcb, MRRcb, KLR(t).
IF (DATA_16(1) == TO_UPPER(ACT_OU4_MYSTRAN_NAMES(I))) THEN
FOUND = 'Y'
OU4_PART_MAT_NAMES(I,1) = DATA_16(1)
OU4_PART_VEC_NAMES(I,1) = DATA_16(2)
Expand Down
61 changes: 18 additions & 43 deletions Source/LK1/L1A/LOADB.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1112,48 +1112,23 @@ END SUBROUTINE CALC_MAX_GAUSS_POINTS

END SUBROUTINE LOADB


!function to_upper(in) result (out)
SUBROUTINE TO_UPPER_LINE(LINE)
! it seems like there should be a better way to write an upper function...
! https://en.wikibooks.org/wiki/Fortran/strings
implicit none
CHARACTER(256), intent (inout) :: LINE
integer :: I, J
CHARACTER(26), parameter :: UPP = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
CHARACTER(26), parameter :: LOW = 'abcdefghijklmnopqrstuvwxyz'

DO I = 1,256
! remove $
IF (LINE(I:I) == '$') THEN
LINE(I:) = ' '
GOTO 100 ! break
ENDIF

J = index(LOW, LINE(I:I)) ! Is ith character in LOW
IF (J>0) LINE(I:I) = UPP(J:J) ! Yes, then subst with UPP
100 ENDDO
END SUBROUTINE TO_UPPER_LINE
!end function to_upper

!---------------------------------------------------------
SUBROUTINE READ_BDF_LINE(IN1, IOCHK, LINE)

! it seems like there should be a better way to write an upper function...
! https://en.wikibooks.org/wiki/Fortran/strings
USE IOUNT1, ONLY : ERR, INFILE, F06 !
USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE
implicit none
CHARACTER(256), intent (inout) :: LINE
CHARACTER(256) :: TRIM_LINE
integer, intent (in) :: IN1
integer, intent (inout) :: IOCHK
integer :: I, J, FATAL_ERR
CHARACTER(26), parameter :: UPP = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
CHARACTER(26), parameter :: LOW = 'abcdefghijklmnopqrstuvwxyz'
CHARACTER(24*BYTE) :: MESSAG ! Message for output error purposes
INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr READERR
INTEGER(LONG) :: REC_NO ! Record number when reading a file. Input to subr READERR
USE PENTIUM_II_KIND, ONLY : BYTE, LONG
USE TO_UPPER_Interface

IMPLICIT NONE

CHARACTER(256), INTENT (INOUT) :: LINE
CHARACTER(256) :: TRIM_LINE
INTEGER, INTENT (IN) :: IN1
INTEGER, INTENT (INOUT) :: IOCHK
INTEGER :: I, FATAL_ERR
CHARACTER(24*BYTE) :: MESSAG ! Message for output error purposes
INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr READERR
INTEGER(LONG) :: REC_NO ! Record number when reading a file. Input to subr READERR

! Make units for writing errors the error file and output file
OUNT(1) = ERR
Expand All @@ -1178,12 +1153,12 @@ SUBROUTINE READ_BDF_LINE(IN1, IOCHK, LINE)
! remove $
IF (LINE(I:I) == '$') THEN
LINE(I:) = ' '
GOTO 100 ! break
EXIT
ENDIF

J = index(LOW, LINE(I:I)) ! Is ith character in LOW
IF (J>0) LINE(I:I) = UPP(J:J) ! Yes, then subst with UPP
100 ENDDO
ENDDO

LINE = TO_UPPER(LINE)


101 FORMAT(A)
END SUBROUTINE READ_BDF_LINE
5 changes: 3 additions & 2 deletions Source/LK1/L1A/LOADC.f03
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,8 @@ SUBROUTINE LOADC
USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRE_LOC, FORC_LOC

USE LOADC_USE_IFs

USE TO_UPPER_Interface

IMPLICIT NONE

CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'LOADC'
Expand Down Expand Up @@ -169,7 +170,7 @@ SUBROUTINE LOADC
! so read all entries up to BEGIN BULK and then exit loop for CC entries
inner: DO
READ(IN1,101) CARD
CALL TO_UPPER_LINE(CARD)
CARD = TO_UPPER(CARD)
IF (CARD(1:10) == 'BEGIN BULK') THEN
WRITE(F06,101) CARD
EXIT outer
Expand Down
45 changes: 45 additions & 0 deletions Source/UTIL/TO_UPPER.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,45 @@
! ##################################################################################################################################
! 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.

FUNCTION TO_UPPER(IN_TEXT) RESULT(rslt)

IMPLICIT NONE
CHARACTER(LEN=*), INTENT (IN) :: IN_TEXT
CHARACTER(len=len(IN_TEXT)) :: rslt
INTEGER :: I, J
CHARACTER(26), parameter :: UPP = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
CHARACTER(26), parameter :: LOW = 'abcdefghijklmnopqrstuvwxyz'

DO I = 1,len(IN_TEXT)
J = index(LOW, IN_TEXT(I:I))
IF (J>0) THEN
rslt(I:I) = UPP(J:J)
ELSE
rslt(I:I) = IN_TEXT(I:I)
ENDIF
ENDDO

END FUNCTION TO_UPPER
Loading