diff --git a/src/basis/basis.F b/src/basis/basis.F index c599014261..4915831234 100644 --- a/src/basis/basis.F +++ b/src/basis/basis.F @@ -4483,6 +4483,8 @@ logical function bas_match_tags(tag_from_geom,basisin,btag) character*16 b_elem ! basis set tag -> element name integer b_atn ! basis set tag -> atomic number logical debug ! true for extra output + logical bas_cmplcase + external bas_cmplcase c integer na2z parameter (na2z = 26) @@ -4511,10 +4513,10 @@ logical function bas_match_tags(tag_from_geom,basisin,btag) c c... first match full geometry tag to full basis tag list c did the user specifically assign a tag ? - +c lowercase tags nbtgs = infbs_head(HEAD_NTAGS,basis) do i = 1, nbtgs - if (gstring.eq.bs_tags(i,basis)) then + if (bas_cmplcase(gstring,bs_tags(i,basis))) then bas_match_tags = .true. btag = i bsmatch = bs_tags(i,basis) @@ -4564,7 +4566,7 @@ logical function bas_match_tags(tag_from_geom,basisin,btag) lgstring = inp_strlen(gstring) if (lgstring_old.gt.lgstring) then do i = 1, nbtgs - if (gstring.eq.bs_tags(i,basis)) then + if (bas_cmplcase(gstring,bs_tags(i,basis))) then bas_match_tags = .true. btag = i bsmatch = bs_tags(i,basis) @@ -4597,6 +4599,7 @@ logical function bas_match_tags(tag_from_geom,basisin,btag) call errquit('bas_match_tags: fatal error ',911, BASIS_ERR) endif endif +#if 0 if (g_elem.eq.b_elem) then bas_match_tags = .true. btag = i @@ -4608,6 +4611,7 @@ logical function bas_match_tags(tag_from_geom,basisin,btag) bsmatch = bs_tags(i,basis) goto 00009 endif +#endif enddo if (debug) & write(luout,*)'bas_match_tags:debug: no match for tag <', @@ -5757,4 +5761,27 @@ logical function bas_do_tags_match(tag_one,tag_two) 10000 format('bas_do_tags_match:debug: tag ',a16, & ' matched this tag ',a16) end + logical function bas_cmplcase(a,b) + implicit none + character*(*) a,b +#include "inp.fh" + character*256 a_lcase,b_lcase + integer ipos +c check for oniom sub string + if(inp_contains(.false.,'oniom',a,ipos)) then + a_lcase=a(1:ipos-1) + else + a_lcase=a + endif + call inp_lcase(a_lcase) +c do not lowercase bqs + if (a_lcase(1:2).eq.'bq') a_lcase=a + b_lcase=b + call inp_lcase(b_lcase) + if (b_lcase(1:2).eq.'bq') b_lcase=b + bas_cmplcase= + A a_lcase(1:inp_strlen(a)).eq. + B b_lcase(1:inp_strlen(b)) + return + end C> @}