LCOV - code coverage report
Current view: top level - inpgen - set_atom_core.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 7 197 3.6 %
Date: 2019-09-08 04:53:50 Functions: 1 5 20.0 %

          Line data    Source code
       1             :       MODULE m_setatomcore
       2             :       use m_juDFT
       3             :       CONTAINS
       4             : !================================
       5             : !     setatom_bystr
       6             : !     setcore_bystr
       7             : !================================
       8           0 :       SUBROUTINE setatom_bystr(
       9           0 :      >                        l_buffer,nwdd,econfig,
      10             :      <                        natomst, ncorest, nvalst, nelec)
      11             : 
      12             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      13             : ! 
      14             : ! This subroutine sets up the atomic configuration, definded by a string
      15             : ! In principle all features of 'setatom' are implemented, except for the
      16             : ! storage of the configuration in the arrays nprnc, kappa, occ
      17             : !
      18             : ! Different states are defined by n,l and the occupation
      19             : ! the syntax for this string is rather strict:
      20             : !     nloo   where n is the single digit major quantum number n 1,2,3,...
      21             : !                  l is the single digit minor quantum number l s,p,d,f
      22             : !                 oo is the double digit integer occupation 1,2,...,10,11,...
      23             : !     the entries in the string are separated by spaces
      24             : ! Core electrons and valence electrons and different energy-windows 
      25             : ! are separated by one of 'separators'
      26             : !
      27             : !                                                           r.g.2001
      28             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      29             :       IMPLICIT NONE
      30             : 
      31             :       INTEGER,                 INTENT(IN)    :: l_buffer,nwdd
      32             :       CHARACTER(LEN=l_buffer), INTENT(IN)    :: econfig
      33             :       INTEGER,       OPTIONAL, INTENT(OUT)   :: natomst,ncorest,nvalst
      34             :       REAL,          OPTIONAL, INTENT(INOUT) :: nelec(0:nwdd)
      35             : 
      36             :       INTEGER     :: n,o,win,newst
      37             :       CHARACTER   :: l
      38           0 :       INTEGER     :: nat, nco, nva, nel(0:nwdd)
      39           0 :       CHARACTER(LEN=l_buffer) :: workconf
      40             : 
      41           0 :       IF ( TRIM(econfig).EQ."NULL".OR.              ! check, wether we're 
      42             :      &     LEN_TRIM(econfig).EQ.0 )  RETURN         ! supposed to do something
      43             : 
      44             :       nat = 0 ! overall number of atomic states
      45             :       nco = 0 ! number of corestates
      46             :       nva = 0 ! number of valence states
      47             :       win = 0 ! index to current window (0=core)
      48           0 :       nel = 0 ! initialize electron-counter
      49             : 
      50           0 :       workconf=econfig            ! working copy of econfig
      51           0 :       CALL expandconfig(workconf) ! check econfig and expand noble-gas shortcuts
      52             : 
      53           0 :       DO WHILE ( LEN_TRIM(workconf).GT.0 ) ! scan through character string 
      54             :                                            ! containing the electronic configuration
      55             : 
      56             :         CALL getconfig(workconf,           ! get next item of the configuration
      57           0 :      <                 n,l,o)
      58             : 
      59           0 :         DO WHILE ( n.EQ.0.AND.l.EQ."0".AND.o.EQ.0 )  ! if a window-deliminator was hit,
      60             :                                                      ! increase the window=index
      61           0 :           win=win+1
      62             :           CALL getconfig(workconf,
      63           0 :      <                   n,l,o)
      64             :         ENDDO
      65             : 
      66           0 :         SELECT CASE (l)                    ! store n,l,o to the atomic arrays and 
      67             :                                            !increase the state-counters accordingly      
      68             :           CASE("s")
      69           0 :                 IF ( o.GT.0 ) newst=1
      70             :           CASE("p")
      71           0 :                 IF ( o.GT.0 ) newst=1
      72           0 :                 IF ( o.GT.2 ) newst=2
      73             :           CASE("d") 
      74           0 :                 IF ( o.GT.0 ) newst=1
      75           0 :                 IF ( o.GT.4 ) newst=2
      76             :           CASE("f")
      77           0 :                 IF ( o.GT.0 ) newst=1
      78           0 :                 IF ( o.GT.6 ) newst=2
      79             :         END SELECT
      80           0 :         nat=nat+newst
      81           0 :         IF ( win.EQ.0 ) THEN ; nco=nco+newst
      82           0 :                         ELSE ; nva=nva+newst
      83             :         ENDIF
      84           0 :         nel(win)=nel(win)+o
      85             :       ENDDO
      86             : 
      87           0 :       IF ( PRESENT(natomst) ) natomst=nat
      88           0 :       IF ( PRESENT(ncorest) ) ncorest=nco
      89           0 :       IF ( PRESENT(nvalst)  ) nvalst =nva
      90           0 :       IF ( PRESENT(nelec)   ) nelec  =nel
      91             : 
      92             :       RETURN
      93           0 :       END SUBROUTINE setatom_bystr
      94             : 
      95             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      96             : ! 
      97             : !  SUBROUTINE setcore_bystr
      98             : !
      99             : ! This subroutine sets up the core configuration, definded by a string
     100             : ! It stores the core-quantum-numbers to coreqn and the 
     101             : ! occupation-numbers to coreocc, which will be used by 'setcore'
     102             : !
     103             : ! Different states are defined by n,l and the occupation
     104             : ! The syntax for this string is rather strict:
     105             : !     nloo   where n is the single digit major quantum number n 1,2,3,...
     106             : !                  l is the single digit minor quantum number l s,p,d,f
     107             : !                 oo is the double digit integer occupation 1,2,...,10,11,...
     108             : !     The entries in the string are separated by spaces
     109             : ! core electrons and valence electrons are separated by one of 'separators'
     110             : !
     111             : ! the routine will not exit as the first window-separator is found, but 
     112             : ! count up all levels. Core states reach up to nallst
     113             : !
     114             : !                                                           r.g.12.2000
     115             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     116           3 :       SUBROUTINE setcore_bystr(
     117             :      >                         atype,nstd,ntype,l_buffer,
     118           3 :      X                         econfig,nallst,ncorest,
     119           3 :      <                         coreqn,coreocc)
     120             : 
     121             :       IMPLICIT none
     122             : 
     123             :       INTEGER, PARAMETER :: errfh = 6
     124             : !      INTEGER          :: storeconfig
     125             : 
     126             :       INTEGER, INTENT(IN)     :: atype,nstd,ntype,l_buffer
     127             :       CHARACTER(LEN=l_buffer), INTENT(IN)    :: econfig(ntype)
     128             :       INTEGER, INTENT(INOUT)  :: ncorest,nallst
     129             :       INTEGER, INTENT(OUT)    :: coreqn(2,nstd,ntype) ! core states (relativistic)
     130             :       REAL,    INTENT(OUT)    :: coreocc(nstd,ntype)  ! core occupations
     131             : 
     132             :       INTEGER                 :: n,o,i,win,newst
     133             :       CHARACTER               :: l
     134           3 :       CHARACTER(LEN=l_buffer) :: workconf
     135             : 
     136             : ! check, wether we're supposed to do something
     137           3 :       IF (     TRIM(econfig(atype)).EQ."NULL".OR.
     138           3 :      &     LEN_TRIM(econfig(atype)).EQ.0 ) RETURN
     139             : 
     140           0 :       nallst = 0                  ! number of all states
     141           0 :       ncorest = 0                 ! number of corestates
     142           0 :       workconf = econfig(atype)   ! working copy of electronic configuration
     143           0 :       CALL expandconfig(workconf) ! check econfig and expand noble-gas shortcuts
     144             : 
     145           0 :       win = 0
     146           0 :       DO WHILE ( LEN_TRIM(workconf).GT.0 )    ! scan through character string 
     147             :                                               ! containing the electronic configuration
     148           0 :         CALL getconfig(workconf,n,l,o)        ! get next item of the configuration
     149             : 
     150           0 :         DO WHILE ( n.EQ.0.AND.l.EQ."0".AND.o.EQ.0 )  ! if a window-deliminator was hit
     151           0 :           win = win + 1                              ! increase window index
     152           0 :           CALL getconfig(workconf,n,l,o)
     153             :         ENDDO
     154             : 
     155             :         newst=storeconfig(n,l,o,nstd,nallst,                        ! store n,l,o to the atomic
     156           0 :      &    coreqn(1,:,atype),coreqn(2,:,atype),coreocc(:,atype))     ! arrays and increase the
     157           0 :         nallst  = nallst  + newst                                   ! state-counters accordingly
     158           0 :         IF (win == 0) ncorest = ncorest + newst                                   
     159             : 
     160             :       ENDDO
     161             : 
     162           0 :       IF (win == 0) THEN
     163             : ! actually, the routine should be exited from within the WHILE-loop
     164             : ! obviously no window-sepatator was found - ABORT!
     165           0 :       WRITE(errfh,*) "An error was found while processing the"
     166           0 :       WRITE(errfh,*) "  electronic configuration for atom #",
     167           0 :      &               atype
     168           0 :       WRITE(errfh,*) "Please divide core- and valence states "
     169           0 :       WRITE(errfh,*) "  by inserting one of '|/\-'"
     170             :        CALL juDFT_error("setcore_bystr",calledby="set_atom_core",hint=
     171             :      +     "An error was found while processing the"//
     172             :      +     " electronic configuration. Please divide core- and "//
     173           0 :      +     "valence states by inserting one of '|/\-'")
     174             :       ENDIF
     175             : 
     176           3 :       END SUBROUTINE setcore_bystr
     177             : 
     178             : 
     179             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     180             : ! 
     181             : !  SUBROUTINE expandconfig
     182             : !
     183             : ! this subroutine check the validity of econfig (not very strict though) and
     184             : ! expands noble gas shortcuts
     185             : !                                                           r.g.12.2000
     186             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     187           0 :       SUBROUTINE expandconfig(econfig)
     188             : 
     189             :       IMPLICIT none
     190             : 
     191             :       INTEGER, PARAMETER :: errfh = 6, l_buffer= 512, s_buffer= 20
     192             :       CHARACTER (LEN=*), PARAMETER :: 
     193             :      C    He_core="1s2",
     194             :      C    Ne_core="1s2 2s2 2p6",
     195             :      C    Ar_core="1s2 2s2 2p6 3s2 3p6",
     196             :      C    Kr_core="1s2 2s2 2p6 3s2 3p6 3d10 4s2 4p6",
     197             :      C    Xe_core="1s2 2s2 2p6 3s2 3p6 3d10 4s2 4p6 4d10 5s2 5p6",
     198             :      C    Rn_core="1s2 2s2 2p6 3s2 3p6 3d10 4s2 4p6 4d10 4f14 5s2 "//
     199             :      C                                "5p6 5d10 6s2 6p6"
     200             :       CHARACTER (LEN=*), PARAMETER :: 
     201             :      C    separators="|/\-",
     202             :      C    legalchars="spdf0123456789 [HeNeArKrXeRn]"//separators
     203             : 
     204             :       CHARACTER(LEN=*), INTENT(INOUT) :: econfig
     205             : 
     206             :       INTEGER :: n,o,error,i,win
     207             :       INTEGER :: strpos,newpos
     208             :       CHARACTER(LEN=l_buffer)      :: bigbuf
     209             :       CHARACTER(LEN=s_buffer)      :: buf
     210             :       CHARACTER                    :: l
     211             : 
     212             : ! scan for illegal charcters
     213           0 :       error=VERIFY(econfig,legalchars)
     214           0 :       IF ( error.NE.0 ) THEN
     215             :         WRITE(errfh,'(A)')  "*** An illegal character was found in "//
     216           0 :      &                      "the electronic configuration:"
     217           0 :         WRITE(errfh,'(A)')  TRIM(econfig)
     218           0 :         bigbuf=REPEAT("-",(error-1))//"^"
     219           0 :         WRITE(errfh,FMT='(A)') TRIM(bigbuf)
     220             :         CALL juDFT_error("invalid electronic configuration",calledby
     221           0 :      +       ="set_atom_core")
     222             :       ENDIF
     223             : 
     224           0 :       IF ( SCAN(econfig,separators).EQ.0 ) THEN
     225             : ! obviously no window-sepatator was found - ABORT!
     226           0 :         WRITE(errfh,*) "An error was found while processing the"
     227           0 :         WRITE(errfh,*) "  electronic configuration ",TRIM(econfig)
     228           0 :         WRITE(errfh,*) "Please divide core- and valence states "
     229           0 :         WRITE(errfh,*) "  by inserting one of '|/\-'"
     230             :        CALL juDFT_error("expnadconfig",calledby="set_atom_core",hint=
     231             :      +     "An error was found while processing the"//
     232             :      +     " electronic configuration. Please divide core- and "//
     233           0 :      +     "valence states by inserting one of '|/\-'")
     234             :       ENDIF
     235             : 
     236             : ! condense multiple spaces to single spaces
     237           0 :       econfig=ADJUSTL(econfig)
     238           0 :       DO WHILE ( INDEX(TRIM(econfig),"  ").GT.0 )
     239           0 :         strpos=INDEX(econfig,"  ")
     240           0 :         econfig=econfig(:strpos)//econfig(strpos+2:)
     241             :       END DO
     242             :  
     243             : ! first, look if there's some noble gas core configuration included
     244             : ! if so, replace the shortcut with the full configuration
     245           0 :       if ( INDEX(econfig,"[").GT.0 ) THEN
     246           0 :         strpos=INDEX(econfig,"[")
     247           0 :         newpos=INDEX(econfig,"]")
     248           0 :         SELECT CASE (econfig((strpos+1):(newpos-1)))
     249             :           CASE ("He")
     250           0 :             econfig=He_core//" "//ADJUSTL(econfig((newpos+1):))
     251             :           CASE ("Ne")
     252           0 :             econfig=Ne_core//" "//ADJUSTL(econfig((newpos+1):))
     253             :           CASE ("Ar")
     254           0 :             econfig=Ar_core//" "//ADJUSTL(econfig((newpos+1):))
     255             :           CASE ("Kr")
     256           0 :             econfig=Kr_core//" "//ADJUSTL(econfig((newpos+1):))
     257             :           CASE ("Xe")
     258           0 :             econfig=Xe_core//" "//ADJUSTL(econfig((newpos+1):))
     259             :           CASE ("Rn")
     260           0 :             econfig=Rn_core//" "//ADJUSTL(econfig((newpos+1):))
     261             :           CASE DEFAULT
     262           0 :             WRITE(*,'(2A)') "*** Unknown noble gas ",
     263           0 :      A                      econfig((strpos+1):(newpos-1))
     264             :             CALL juDFT_error("unknown configuration shortcut",calledby
     265           0 :      +           ="set_atom_core")
     266             :         END SELECT
     267             :       ENDIF
     268             : 
     269           0 :       RETURN
     270           0 :       END SUBROUTINE expandconfig
     271             : 
     272             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     273             : ! 
     274             : !  SUBROUTINE getconfig
     275             : !
     276             : ! this subroutine chops off the first set of electrons of econfig and returns 
     277             : ! the corresponding n,l,o values and the shortened econfig
     278             : !
     279             : ! the syntax for this string is rather strict:
     280             : !     nloo   where n is the single digit major quantum number n 1,2,3,...
     281             : !                  l is the single digit minor quantum number l s,p,d,f
     282             : !                 oo is the double digit integer occupation 1,2,...,10,11,...
     283             : !     the entries in the string are separated by spaces
     284             : !
     285             : ! core electrons and valence electrons are separated by |,...
     286             : ! if such a separator was encountered, n=l=o=0 is returned
     287             : !
     288             : ! make sure, the configuration covers _all_ electrons - core and valence
     289             : !
     290             : !                                                           r.g.12.2000
     291             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     292           0 :       SUBROUTINE getconfig(econfig,n,l,o)
     293             : 
     294             :       IMPLICIT NONE
     295             : 
     296             :       INTEGER, PARAMETER :: errfh = 6, l_buffer= 512, s_buffer= 20
     297             :       CHARACTER (LEN=*), PARAMETER :: separators="|/\-"
     298             : 
     299             :       CHARACTER(LEN=*), INTENT(INOUT) :: econfig
     300             :       INTEGER,          INTENT(OUT)   :: n,o
     301             :       CHARACTER,        INTENT(OUT)   :: l
     302             : 
     303             :       INTEGER :: error,i,win
     304             :       INTEGER :: strpos,newpos
     305             :       CHARACTER(LEN=l_buffer)      :: bigbuf
     306             :       CHARACTER(LEN=s_buffer)      :: buf
     307             : 
     308           0 :       win = 0 !gs
     309             : 
     310           0 :       econfig=ADJUSTL(econfig)
     311             : ! look if a separator is in first place. if so, exit
     312           0 :       IF ( VERIFY(econfig(1:1),separators).EQ.0 ) THEN
     313           0 :         win=win+1
     314           0 :         econfig=ADJUSTL(econfig(2:))
     315           0 :         n=0
     316           0 :         l="0"
     317           0 :         o=0
     318           0 :         RETURN
     319             :       ENDIF
     320             : 
     321             : ! copy first item to buf - 
     322             : ! items are separated by a space
     323             : ! or an separator (see separators), to mark core/valence and win/win - bounds
     324           0 :       strpos=SCAN(econfig,(separators//" "))
     325             : !      write(*,*) "getconfig: ",TRIM(econfig)
     326             : !      write(*,*) "           ",REPEAT("-",(strpos-1)),"^"
     327           0 :       buf=econfig(:(strpos-1))
     328             : !      write(*,*) "getconfig: ",TRIM(buf)
     329             : ! check if these n-l values occur again within the string
     330             : ! if so, abort
     331           0 :       IF ( INDEX(econfig(2:),buf(1:2)).GT.0 ) THEN
     332           0 :         WRITE(*,'(3A)') "*** There can only be one set of ",buf(1:2),
     333           0 :      A             "-electrons"
     334             :         CALL juDFT_error("getconfig: invalid electronic configuration"
     335           0 :      +       ,calledby ="set_atom_core")
     336             :       ENDIF
     337             : ! split and convert description to numeric/character var's
     338           0 :       READ(buf,FMT='(I1,A1,I2)',IOSTAT=error) n,l,o
     339           0 :       IF ( error.NE.0 ) THEN
     340             :         WRITE(*,'(2A)') "*** error encountered, "//
     341           0 :      A                  "while processing entry ",buf," of econfig"
     342           0 :         WRITE(*,'(A)') "*** valid syntax is  nloo  (e.g. 3d10)"
     343             :         CALL juDFT_error("error converting configuration string"
     344           0 :      +          ,calledby ="set_atom_core")
     345             :       ENDIF
     346             : 
     347             : ! remove first item from econfig
     348           0 :       econfig=ADJUSTL(econfig(strpos:))
     349             : 
     350           0 :       RETURN
     351             : 
     352           0 :       END SUBROUTINE getconfig
     353             : 
     354             : 
     355             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     356             : !
     357             : !      INTEGER FUNCTION storeconfig
     358             : !
     359             : !  This function stores the states described by n,l,o (inn,inl,ino) to the 
     360             : !  arrays coren(nstd) (n) corek(nstd) (kappa) and coreocc(nstd)
     361             : !
     362             : !  nst is the number of the current number of states in these arrays
     363             : !  it will _NOT_ be changed here. 
     364             : !
     365             : !  the return value is the number of states added to the arrays
     366             : !
     367             : !                                                          r.g.2001
     368             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     369           0 :       INTEGER FUNCTION storeconfig(
     370             :      >                             inn,inl,ino,nstd,nst,
     371           0 :      <                             coren,corek,coreo)
     372             : 
     373             :       IMPLICIT none
     374             : 
     375             :       INTEGER,       INTENT(IN)    :: inn,ino,nstd
     376             :       CHARACTER,     INTENT(IN)    :: inl
     377             :       INTEGER,       INTENT(IN)    :: nst
     378             :       INTEGER,       INTENT(INOUT) :: coren(nstd)
     379             :       INTEGER,       INTENT(INOUT) :: corek(nstd)
     380             : !      INTEGER,       INTENT(INOUT) :: coreqn(2,nstd)
     381             :       REAL,          INTENT(INOUT) :: coreo(nstd)
     382             : 
     383             :       INTEGER            :: naddst,n,o
     384             :       CHARACTER(LEN=1)   :: l
     385             : 
     386           0 :       naddst=0
     387           0 :       n=inn
     388           0 :       l=inl
     389           0 :       o=ino
     390             : 
     391           0 :       SELECT CASE (TRIM(l))
     392             : ! --- s-states
     393             :         CASE("s")
     394           0 :           IF ( o.GT.2 ) THEN
     395           0 :             WRITE(*,'(A,I3,A)') "*** ",o,
     396           0 :      A                          " s-electrons are impossible!"
     397             :             CALL juDFT_error("storeconfig: too many s-electrons",
     398           0 :      +           calledby="set_atom_core")
     399             :           ENDIF
     400           0 :           naddst=naddst+1
     401           0 :           coren(nst+naddst) = n
     402           0 :           corek(nst+naddst) = -1
     403           0 :           coreo(nst+naddst)  = REAL(o)
     404             : ! --- p-states
     405             :         CASE("p")
     406           0 :           IF ( o.GT.6 ) THEN
     407           0 :             WRITE(*,'(A,I3,A)') "*** ",o,
     408           0 :      A                          " p-electrons are impossible!"
     409             :             CALL juDFT_error("storeconfig: too many p-electrons",
     410           0 :      +           calledby="set_atom_core")
     411             :           ENDIF
     412           0 :           IF ( n.LT.2 ) THEN 
     413           0 :             WRITE(*,'(a,i0,a)') "*** There's nothing like ",n,"p"
     414             :             CALL juDFT_error("storeconfig: invalid specifier",
     415           0 :      +                      calledby="set_atom_core")
     416             :           ENDIF
     417           0 :           naddst=naddst+1
     418           0 :           coren(nst+naddst)  = n
     419           0 :           corek(nst+naddst)  = 1
     420           0 :           IF ( o.GT.2 ) THEN; coreo(nst+naddst) = 2.0 
     421           0 :                         ELSE; coreo(nst+naddst) = REAL(o)
     422             :           ENDIF
     423           0 :           o = o-2
     424           0 :           IF ( o.GT.0 ) THEN
     425           0 :             naddst=naddst+1
     426           0 :             coren(nst+naddst) = n
     427           0 :             corek(nst+naddst) = -2
     428           0 :             coreo(nst+naddst)  = REAL(o)
     429             :           ENDIF
     430             : ! --- d-states
     431             :         CASE("d")
     432           0 :           IF ( o.GT.10 ) THEN
     433           0 :             WRITE(*,'(A,I3,A)') "*** ",o,
     434           0 :      A                          " d-electrons are impossible!"
     435             :             CALL juDFT_error("storeconfig: too many d-electrons",
     436           0 :      +           calledby="set_atom_core")
     437             :           ENDIF
     438           0 :           IF ( n.LT.3 ) THEN
     439           0 :             WRITE(*,'(a,i0,a)') "**** There's nothing like ",n,"d"
     440             :             CALL juDFT_error("storeconfig: invalid specifier",calledby
     441           0 :      +           ="set_atom_core")
     442             :           ENDIF
     443           0 :           naddst=naddst+1
     444           0 :           coren(nst+naddst) = n
     445           0 :           corek(nst+naddst) = 2
     446             : c
     447             : c         Prefer a magnetic configuration to a nonmagnetic one
     448             : c         Example: 3 d electrons are distributed as
     449             : c         2 electrons in the kappa=2 and 1 electron in the kappa=-3 state
     450             : c
     451           0 :           IF ( o <= 2 ) THEN
     452           0 :             coreo(nst+naddst) = REAL(o)
     453           0 :           ELSEIF ( o < 6 ) THEN
     454           0 :             coreo(nst+naddst) = 2.0
     455           0 :           ELSEIF ( o <= 7 ) THEN
     456           0 :             coreo(nst+naddst) = REAL(o) - 3.0
     457             :           ELSE
     458           0 :             coreo(nst+naddst) = 4.0
     459             :           ENDIF
     460           0 :           o = o - coreo(nst+naddst)
     461           0 :           IF ( o.GT.0 ) THEN
     462           0 :             naddst=naddst+1
     463           0 :             coren(nst+naddst) = n
     464           0 :             corek(nst+naddst) = -3
     465           0 :             coreo(nst+naddst)  = REAL(o)
     466             :           ENDIF
     467             : ! --- f-states
     468             :         CASE("f")
     469           0 :           IF ( o.GT.14 ) THEN
     470           0 :             WRITE(*,'(A,I3,A)') "*** ",o,
     471           0 :      A                          " f-electrons are impossible!"
     472             :             CALL juDFT_error("storeconfig: too many f-electrons",
     473           0 :      +           calledby="set_atom_core")
     474             :           ENDIF
     475           0 :           IF ( n.LT.4 ) THEN
     476           0 :             WRITE(*,'(a,i0,a)') "*** There's nothing like ",n,"f"
     477             :             CALL juDFT_error("storeconfig: invalid specifier",calledby
     478           0 :      +           ="set_atom_core")
     479             :           ENDIF
     480           0 :           naddst=naddst+1
     481           0 :           coren(nst+naddst) = n
     482           0 :           corek(nst+naddst) = 3
     483             : c
     484             : c         Prefer a magnetic configuration to a nonmagnetic one
     485             : c         Example: 9 f electrons are distributed as
     486             : c         5 electrons in the kappa=3 and 4 electrons in the kappa=-4 state
     487             : c
     488           0 :           IF ( o <= 3 ) THEN
     489           0 :             coreo(nst+naddst) = REAL(o)
     490           0 :           ELSEIF ( o < 8 ) THEN
     491           0 :             coreo(nst+naddst) = 3.0
     492           0 :           ELSEIF ( o <= 10 ) THEN
     493           0 :             coreo(nst+naddst) = REAL(o) - 4.0
     494             :           ELSE
     495           0 :             coreo(nst+naddst) = 6.0
     496             :           ENDIF
     497           0 :           o = o - coreo(nst+naddst)
     498           0 :           IF ( o.GT.0 ) THEN
     499           0 :             naddst=naddst+1
     500           0 :             coren(nst+naddst) = n
     501           0 :             corek(nst+naddst) = -4
     502           0 :             coreo(nst+naddst) = REAL(o)
     503             :           ENDIF
     504             : ! --- other states, abort!!
     505             :         CASE DEFAULT
     506           0 :           WRITE(*,'(2A)') "*** invalid l-specifier: ",l
     507             :           CALL juDFT_error("storeconfig: invalid specifier",calledby
     508           0 :      +         ="set_atom_core")
     509             :       END SELECT
     510             : 
     511           0 :       storeconfig=naddst
     512             : 
     513           0 :       END FUNCTION storeconfig
     514             : 
     515             :       END MODULE m_setatomcore

Generated by: LCOV version 1.13