From da2f3516da0df32521d2895e339a5e7092966faa Mon Sep 17 00:00:00 2001 From: edoapra Date: Thu, 19 Mar 2026 12:01:07 -0700 Subject: [PATCH] basis option uppercase to make uppercase chemical symbol in output file see Jmol issue https://github.com/nwchemgit/nwchem/issues/1261 --- src/basis/basP.fh | 2 ++ src/basis/bas_input.F | 26 +++++++++++++++++++------- src/basis/basis.F | 9 ++++++++- src/basis/basisP.F | 21 +++++++++++++++++++++ 4 files changed, 50 insertions(+), 8 deletions(-) diff --git a/src/basis/basP.fh b/src/basis/basP.fh index c939086150..1657e28456 100644 --- a/src/basis/basP.fh +++ b/src/basis/basP.fh @@ -234,6 +234,7 @@ c.. incore structures integer bas_nassoc logical bsactive logical bas_spherical + logical bas_upcase logical bas_any_gc logical bas_any_sp_shell c @@ -259,6 +260,7 @@ c......... above for each basis is stored ... below is in-core & bas_spherical(nbasis_bsmx), & bas_any_gc(nbasis_bsmx), & bas_any_sp_shell(nbasis_bsmx), + L bas_upcase(nbasis_bsmx), & bas_norm_id(nbasis_bsmx), & angular_bs(nbasis_bsmx), & nbfmax_bs(nbasis_bsmx), diff --git a/src/basis/bas_input.F b/src/basis/bas_input.F index 2a3e6cd9bf..82367ba867 100644 --- a/src/basis/bas_input.F +++ b/src/basis/bas_input.F @@ -12,7 +12,7 @@ c $Id$ c c basis [] [library [] [file ] \ c [spherical|cartesian] [segment||nosegment] [print|noprint]\ -c [ecpset ecp_name] [soset so_name] [rel] [bse] +c [ecpset ecp_name] [soset so_name] [rel] [bse] [uppercase] c c tag library [tag in library] [file ] c tag @@ -53,23 +53,24 @@ c::passed integer rtdb ! [input] handle to database c::local integer nopt - parameter (nopt = 13) + parameter (nopt = 14) character*10 opts(nopt) character*255 test, name, filename, standard character*255 ecpname, soname character*256 mydir character*1000 errmsg - logical status, ospherical, osegment, oprint + logical status, ospherical, osegment, oprint, oupcase logical o_add_ecpname, o_add_soname logical oHas_Star logical oIs_ecp, oIs_so, oIs_rel integer ind, basis - logical bas_add_ucnt_init, bas_set_spherical, bas_add_ucnt_tidy - external bas_add_ucnt_init, bas_set_spherical + logical bas_add_ucnt_init, bas_set_spherical, bas_add_ucnt_tidy, + B bas_set_upcase + external bas_add_ucnt_init, bas_set_spherical,bas_set_upcase data opts / & 'spherical', 'cartesian', 'segment', 'nosegment', 'library', & 'file', 'print', 'noprint', 'ecpset', 'soset', - & 'version', 'rel','bse'/ + & 'version', 'rel','bse', 'uppercase'/ c ecpname = ' ' soname = ' ' @@ -105,6 +106,7 @@ c o_add_soname = .false. ! Default is to not associate a so name oIs_rel = .false. ! Default is nonrelativistic oHas_Star = .false. ! Default, not using star-tags + oupcase = .false. ! Default is do not upper case ouput c 10 if (inp_a(test)) then c @@ -122,7 +124,7 @@ c endif c goto (100, 200, 300, 400, 500, 600, 700, 800, 900, 1000, - & 1100,1200,1300) ind + & 1100,1200,1300,1400) ind goto 10000 c c spherical @@ -212,6 +214,13 @@ c 01300 continue mydir='libraries.bse' goto 10 +c +c +c uppercase bs_tags +c +01400 continue + oupcase=.true. + goto 10 c endif c @@ -270,6 +279,9 @@ c & BASIS_ERR) if (.not. bas_set_spherical(basis, ospherical)) & call errquit + & (' bas_set_spherical failed ',911, BASIS_ERR) + if (.not. bas_set_upcase(basis, oupcase)) + & call errquit & (' bas_set_spherical failed ',911, BASIS_ERR) call bas_input_body(basis, osegment, oIs_rel, oHas_Star) diff --git a/src/basis/basis.F b/src/basis/basis.F index 4915831234..3c3116cfa2 100644 --- a/src/basis/basis.F +++ b/src/basis/basis.F @@ -330,6 +330,7 @@ c bas_spherical(basis) = .false. bas_any_gc(basis) = .false. bas_any_sp_shell(basis) = .false. + bas_upcase = .false. c h_tmp = exndcf(H_exndcf,basis) if (h_tmp .ne. -1) then @@ -549,6 +550,8 @@ c::-local endif enddo dum_tag = bs_tags(i_tag,basis) + if (bas_upcase(basis)) call inp_ucase(dum_tag) + tmp1 = inp_strlen(bs_stdname(i_tag,basis)) if (tmp1 .lt. (30-1)) then tmp2 = (30-tmp1)/2 @@ -663,6 +666,7 @@ c:: local *. . . . . . . . . . . ! Room for tag+space+(+element+) = 16+1+1+16+1 character*35 buffer character*12 polynomial + character*16 case_tag c #include "bas_exndcf.fh" #include "ecpso_sfnP.fh" @@ -723,8 +727,11 @@ c $ atn)) then len_tag = inp_strlen(bs_tags(i,basis)) len_ele = inp_strlen(element) + case_tag=bs_tags(i,basis) + if (bas_upcase(basis)) call inp_ucase(case_tag) + write(buffer,'(a,'' ('',a,'')'')') - $ bs_tags(i,basis)(1:len_tag), element(1:len_ele) + $ case_tag(1:len_tag), element(1:len_ele) else buffer = bs_tags(i,basis) endif diff --git a/src/basis/basisP.F b/src/basis/basisP.F index efd216d499..82e08f8c6e 100644 --- a/src/basis/basisP.F +++ b/src/basis/basisP.F @@ -513,3 +513,24 @@ c endif endif end + logical function bas_set_upcase(basisin, oupcase) + implicit none +#include "nwc_const.fh" +#include "basP.fh" +#include "basdeclsP.fh" +c + integer basisin ! [input] basis set handle + logical oupcase ! [input] logical for upcase setting +c + integer basis +c + bas_set_upcase = .false. +c + basis = basisin + BASIS_HANDLE_OFFSET + if (oupcase) then + bas_upcase(basis) = .true. + else + bas_upcase(basis) = .false. + endif + bas_set_upcase = .true. + end