fix for ECP assignment issue #1037

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> @}