LCOV - code coverage report
Current view: top level - inpgen - atom_input.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 160 507 31.6 %
Date: 2019-09-08 04:53:50 Functions: 3 5 60.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             :       MODULE m_atominput
       8             :       use m_juDFT
       9             :       INTEGER, PARAMETER ::  l_buffer=512   ! maximum length of e-config string
      10             :       INTEGER, PARAMETER  :: dbgfh=6, errfh=6, warnfh=6
      11             :       REAL, PARAMETER     :: eps=0.00000001
      12             : 
      13             :       CONTAINS
      14             : !***********************************************************************
      15             : !     reads in the parameters associated with atom types from input
      16             : !     file. Part of inp-generator
      17             : !***********************************************************************
      18           6 :       SUBROUTINE atom_input(
      19           3 :      >                      infh,xl_buffer,bfh,buffer,
      20           3 :      >                      input,idlist,xmlCoreRefOccs,
      21           3 :      X                      nline,xmlElectronStates,
      22           3 :      X                      xmlPrintCoreStates,xmlCoreOccs,
      23           3 :      >                      atomTypeSpecies,numSpecies,
      24             :      <                      nel,atoms,enpara )
      25             : 
      26             :       USE m_types
      27             :       USE m_juDFT_init
      28             :       USE m_readrecord
      29             :       USE m_setatomcore, ONLY : setatom_bystr, setcore_bystr
      30             :       USE m_constants
      31             :     
      32             :       IMPLICIT NONE
      33             : 
      34             :       TYPE(t_input),INTENT(INOUT)    :: input
      35             :       TYPE(t_enpara),INTENT(OUT)     :: enpara
      36             :       TYPE(t_atoms),INTENT(INOUT)    :: atoms
      37             : 
      38             : ! ... Arguments ...
      39             :       INTEGER, INTENT (IN)    :: infh  ! file number of input-file
      40             :       INTEGER, INTENT (IN)    :: bfh
      41             :       INTEGER, INTENT (IN)    :: numSpecies
      42             :       INTEGER, INTENT (INOUT) :: nline ! current line in this file
      43             :       INTEGER, INTENT (INOUT) :: nel   ! number of valence electrons
      44             : 
      45             :       INTEGER, INTENT (IN)     :: xl_buffer
      46             :       INTEGER, INTENT (IN)     :: atomTypeSpecies(atoms%ntype)
      47             :       REAL   , INTENT (IN)     :: idlist(atoms%ntype)
      48             :       REAL   , INTENT (IN)     :: xmlCoreRefOccs(29)
      49             :       REAL, INTENT (INOUT)     :: xmlCoreOccs(2,29,atoms%ntype)
      50             :       INTEGER, INTENT (INOUT)  :: xmlElectronStates(29,atoms%ntype)
      51             :       LOGICAL, INTENT (INOUT)  :: xmlPrintCoreStates(29,atoms%ntype)
      52             :       CHARACTER(len=xl_buffer) :: buffer
      53             : 
      54             : !===> data
      55             :       INTEGER, PARAMETER ::  nwdd=2         ! maximum number of windows
      56             :       INTEGER, PARAMETER ::  nstd=31        ! maximum number of core states
      57             : 
      58             : !===> Local Variables
      59             :       INTEGER :: nbuffer,ios,n,i,j,l,d1,d10,aoff,up,dn
      60             :       INTEGER :: lmax0_def,lnonsph0_def,jri0_def,ncst0_def
      61             :       INTEGER :: lmax0,lnonsph0,jri0,ncst0,nlod0,llod
      62             :       INTEGER :: natomst,ncorest,nvalst,z,nlo0
      63             :       INTEGER :: xmlCoreStateNumber, lmaxdTemp
      64             :       REAL    :: rmt0_def,dx0_def,bmu0_def, upReal, dnReal
      65             :       REAL    :: rmt0,dx0,bmu0,zat0,id,electronsOnAtom, electronsLeft
      66             :       LOGICAL :: fatalerror, h_atom, h_allatoms
      67           6 :       LOGICAL :: idone(atoms%ntype) 
      68          12 :       INTEGER :: lonqn(atoms%nlod,atoms%ntype),z_int(atoms%ntype)
      69          12 :       INTEGER :: coreqn(2,nstd,atoms%ntype),lval(nstd,atoms%ntype)
      70           6 :       INTEGER :: llo0(atoms%nlod)
      71           6 :       REAL    :: nelec(0:nwdd),coreocc(nstd,atoms%ntype)
      72             : 
      73             : 
      74             :       CHARACTER(len= l_buffer) :: econfig0_def,econfig0
      75           6 :       CHARACTER(len= l_buffer) :: econfig(atoms%ntype) ! verbose electronic config
      76           6 :       CHARACTER(len=80) :: lo(atoms%ntype), lo0
      77             :       CHARACTER(len=13) :: fname
      78             :       CHARACTER(LEN=20) :: speciesName0
      79             : 
      80             :       CHARACTER(len=1) :: lotype(0:3)
      81             : 
      82             :       DATA lotype /'s','p','d','f'/
      83             : 
      84             : !---> initialize some variables
      85             : 
      86           3 :       fatalerror = .false.
      87           3 :       h_atom=.false.;h_allatoms=.false.
      88             : 
      89           3 :       idone(1:atoms%ntype) = .false.
      90           3 :       z_int(1:atoms%ntype) = NINT(atoms%zatom(1:atoms%ntype))
      91           6 :       lo = ' ' ; nlod0 = 0 ; atoms%nlo = 0 ; llod = 0 ; lonqn = 0
      92           3 :       atoms%ncst = 0 ; econfig(1:atoms%ntype) = ' '
      93             : !
      94           3 :       lmax0_def    = -9999  
      95           3 :       lnonsph0_def = -9999
      96           3 :       rmt0_def     = -9999.9
      97           3 :       dx0_def      = -9999.9
      98           3 :       jri0_def     = -9999
      99           3 :       ncst0_def    = -9999
     100           3 :       econfig0_def = 'NONE'
     101           3 :       bmu0_def     = -9999.9
     102             : 
     103           3 :       WRITE(6,*)
     104           3 :       WRITE(6,'(a50)') '==============================================='
     105           3 :       WRITE(6,'(a50)') '===  modifying atomic input for &(all)atom  ==='
     106           3 :       WRITE(6,'(a50)') '==============================================='
     107           3 :       WRITE(6,*)
     108             : 
     109             : !===> continue reading input
     110             :       
     111           3 :       nbuffer = len_trim(buffer)
     112             : 
     113             :       IF ((buffer(1:9)=='&allatoms') .OR. 
     114             :      &    (buffer(1:5)=='&atom') .OR.
     115             : !    resetting nbuffer for &qss or &soc interferes with the lapw
     116             : !    namelist, therefore, its contributions are also checked for.
     117             : !    might interfere with other namelists, too.
     118             : !    Klueppelberg Jul 2012
     119             :      &    (buffer(1:5)=='&comp') .OR.
     120             :      &    (buffer(1:5)=='&exco') .OR.
     121           3 :      &    (buffer(1:5)=='&film') .OR.
     122             :      &    (buffer(1:4)=='&kpt') ) THEN
     123             :       ELSE
     124           2 :         nbuffer = 0 ! reset, to read in after &qss or &soc 
     125             :       ENDIF
     126             :       
     127           1 :       loop: DO
     128             : 
     129           4 :       IF (nbuffer == 0) THEN
     130           0 :         DO
     131           3 :           CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     132           3 :           IF (ios==1) GOTO 999
     133           1 :           IF (ios == 2)  CALL juDFT_error
     134             :      +         ("end of file while reading a record",
     135           0 :      +         calledby ="atom_input")
     136           1 :           IF (buffer(1:1)=='&') EXIT
     137           0 :           CALL err(0)
     138           1 :           fatalerror = .true.
     139             :         ENDDO
     140             :       ENDIF
     141             : 
     142             : !===> allatoms
     143             : 
     144           2 :       IF (buffer(1:9)=='&allatoms') THEN
     145           0 :         IF (h_allatoms) CALL err(1)
     146           0 :         h_allatoms = .true.
     147           0 :         IF (h_atom) then
     148           0 :           WRITE (errfh,*)
     149           0 :           WRITE (errfh,*) 'atom_input: ERROR',
     150           0 :      &     'namelist &allatoms must appear before namelist(s) &atom.'
     151           0 :           WRITE (errfh,*)
     152           0 :           fatalerror = .true.
     153             :         ELSE
     154             : !--->     read defaults for atom defaults
     155             :           CALL read_allatoms(
     156             :      >                       bfh,
     157             :      <                       rmt0_def,dx0_def,jri0_def,lmax0_def,
     158             :      <                       lnonsph0_def,ncst0_def,econfig0_def,
     159           0 :      <                       bmu0_def,ios)
     160             : 
     161           0 :           IF (ios.NE.0) GOTO 912
     162           0 :           IF (rmt0_def > -9999.8) THEN
     163           0 :             atoms%rmt     = rmt0_def
     164           0 :             WRITE (6,'(a25,f12.6)') 'globally changed rmt to',rmt0_def
     165             :           ENDIF
     166           0 :           IF (dx0_def  > -9999.8)   THEN
     167           0 :             atoms%dx      = dx0_def
     168           0 :             WRITE (6,'(a25,f12.6)') 'globally changed dx  to',dx0_def
     169             :           ENDIF
     170           0 :           IF (jri0_def > -9998  )   THEN
     171           0 :             atoms%jri     = jri0_def
     172           0 :             WRITE (6,'(a25,i12)') 'globally changed jri to',jri0_def
     173             :           ENDIF
     174           0 :           IF (lmax0_def > -9998 )   THEN
     175           0 :             atoms%lmax    = lmax0_def
     176           0 :             WRITE (6,'(a26,i12)') 'globally changed lmax to',
     177           0 :      &                                                       lmax0_def
     178             :           ENDIF
     179           0 :           IF (lnonsph0_def > -9998) THEN
     180           0 :             atoms%lnonsph = lnonsph0_def
     181           0 :             WRITE (6,'(a28,i12)') 'globally changed lnonsph to ',
     182           0 :      &                                                    lnonsph0_def
     183             :           ENDIF
     184           0 :           IF (ncst0_def > -9998 )   THEN
     185           0 :             atoms%ncst    = ncst0_def
     186           0 :             WRITE (6,'(a26,i12)') 'globally changed ncst to',
     187           0 :      &                                                       ncst0_def
     188             :           ENDIF
     189           0 :           IF (econfig0_def.NE.'NONE') THEN
     190           0 :             econfig = econfig0_def
     191           0 :             WRITE (6,'(a26,a80)') 'globally set econfig to ',
     192           0 :      &                                                    econfig0_def
     193             :           ENDIF
     194           0 :           IF (bmu0_def > -9999.8)   THEN
     195           0 :             atoms%bmu     = bmu0_def
     196           0 :             WRITE (6,'(a25,f12.6)') 'globally changed bmu to',bmu0_def
     197             :           ENDIF
     198             :         ENDIF
     199             : 
     200             : !===> atom
     201           2 :       ELSEIF (buffer(1:5)=='&atom') THEN
     202           1 :         h_atom=.true.
     203             : 
     204             : !--->   set atom defaults
     205           1 :         lmax0    = -9999  
     206           1 :         lnonsph0 = -9999
     207           1 :         rmt0     = -9999.9
     208           1 :         dx0      = -9999.9
     209           1 :         jri0     = -9999
     210           1 :         ncst0    = -9999
     211           1 :         econfig0 = 'NONE'
     212           1 :         bmu0     = -9999.9
     213           1 :         lo0      = ' '
     214           1 :         speciesName0 = ''
     215             : 
     216             : !--->   read namelist
     217             :         CALL read_atom(
     218             :      >                 bfh,lotype,
     219             :      <                 id,zat0,rmt0,jri0,dx0,lmax0,lnonsph0,
     220             :      <                 ncst0,econfig0,speciesName0,bmu0,lo0,nlod0,llod,
     221           1 :      <                 ios)
     222           1 :         IF (ios.ne.0) THEN
     223           0 :           CALL err(3)
     224             :         ELSE
     225             : !--->     put the data into the correct place
     226           2 :           DO n = 1, atoms%ntype
     227           1 :             IF (abs( id - idlist(n) ) > 0.001) CYCLE
     228           2 :             IF (idone(n)) then
     229           0 :               WRITE (errfh,*) 'atom_input: ERROR. did that one already'
     230           0 :               fatalerror=.true.
     231           0 :               EXIT
     232             :             ELSE
     233           1 :               IF (speciesName0.NE.'') THEN
     234             :                  atoms%speciesName(atomTypeSpecies(n)) = 
     235           0 :      &              TRIM(ADJUSTL(speciesName0))
     236           0 :                  DO i = 1, numSpecies
     237           0 :                     IF (i.NE.atomTypeSpecies(n)) THEN
     238           0 :                        IF((TRIM(ADJUSTL(speciesName0))).EQ.
     239             :      &                    (TRIM(ADJUSTL(atoms%speciesName(i))))) THEN
     240           0 :                           WRITE(*,*) ''
     241           0 :                           WRITE(*,*) 'Error for species name'
     242           0 :                           WRITE(*,*) TRIM(ADJUSTL(speciesName0))
     243           0 :                           WRITE(*,*) ''
     244             :                           CALL juDFT_error
     245             :      +                       ("Same name for different species",
     246           0 :      +                        calledby ="atom_input")
     247             :                        END IF
     248             :                     END IF
     249             :                  END DO
     250             :               END IF
     251           1 :               IF (rmt0 > -9999.8) THEN
     252           1 :                 atoms%rmt(n)  = rmt0
     253           1 :                 WRITE (6,'(a9,i4,2a2,a16,f12.6)') 'for atom ',n,
     254           2 :      &                ' (',namat_const(z_int(n)),') changed rmt to',rmt0
     255             :               ENDIF
     256           1 :               IF (dx0 > -9999.8) THEN
     257           0 :                 atoms%dx(n)  = dx0
     258           0 :                 WRITE (6,'(a9,i4,2a2,a16,f12.6)') 'for atom ',n,
     259           0 :      &                ' (',namat_const(z_int(n)),') changed dx  to', dx0
     260             :               ENDIF
     261           1 :               IF (jri0 > -9998  ) THEN
     262           1 :                 atoms%jri(n)  = jri0
     263           1 :                 WRITE (6,'(a9,i4,2a2,a16,i12)') 'for atom ',n,
     264           2 :      &                ' (',namat_const(z_int(n)),') changed jri to',jri0
     265             :               ENDIF
     266           1 :               IF (lmax0 > -9998  ) THEN
     267           1 :                 atoms%lmax(n)  = lmax0
     268           1 :                 WRITE (6,'(a9,i4,2a2,a17,i12)') 'for atom ',n,
     269           2 :      &              ' (',namat_const(z_int(n)),') changed lmax to',lmax0
     270             :               ENDIF
     271           1 :               IF (lnonsph0 > -9998  ) THEN
     272           1 :                 atoms%lnonsph(n)  = lnonsph0
     273           1 :                 WRITE (6,'(a9,i4,2a2,a20,i12)') 'for atom ',n,
     274           2 :      &        ' (',namat_const(z_int(n)),') changed lnonsph to',lnonsph0
     275             :               ENDIF
     276           1 :               IF (bmu0 > -9999.8  ) THEN
     277           0 :                 atoms%bmu(n)  = bmu0
     278           0 :                 WRITE (6,'(a9,i4,2a2,a16,f12.6)') 'for atom ',n,
     279           0 :      &              ' (',namat_const(z_int(n)),  ') changed bmu to',bmu0
     280             :               ENDIF
     281           1 :               IF (ncst0 > -9998  ) THEN
     282           0 :                 atoms%ncst(n)  = ncst0
     283           0 :                 WRITE (6,'(a9,i4,2a2,a17,i12)') 'for atom ',n,
     284           0 :      &             ' (',namat_const(z_int(n)), ') changed ncst to',ncst0
     285             :               ENDIF
     286             : ! ===> electronic configuration
     287           1 :               IF (econfig0.NE.'NONE') THEN
     288           0 :                  econfig(n) = econfig0
     289           0 :                  WRITE (6,'(a9,i4,2a2,a17,a80)') 'for atom ',n,
     290           0 :      &           ' (',namat_const(z_int(n)),') set econfig to ',econfig0
     291             :                  CALL setatom_bystr(
     292             :      >                              l_buffer,nwdd,econfig(n),
     293           0 :      <                          natomst,ncorest,nvalst,nelec)
     294             :                  WRITE (6,'("   corestates =",i3," with",f6.1,
     295           0 :      &                                 " electrons")')  ncorest,nelec(0)
     296             :                  WRITE (6,'("   valence st.=",i3," with",f6.1,
     297           0 :      &                                 " electrons")')   nvalst,nelec(1)
     298           0 :                  IF (nelec(2) /= 0) THEN
     299           0 :                  WRITE (6,'("second window found!")')
     300             :                  WRITE (6,'("   valence st.=",i3," with",f6.1,
     301           0 :      &                                 " electrons")')   nvalst,nelec(2)
     302             :                  ENDIF
     303           0 :                  IF (nelec(0)+nelec(1)+nelec(2)-
     304             :      &               atoms%zatom(n)>0.01) THEN
     305             :                     CALL juDFT_error
     306             :      +                   ("econfig does not fit to this atom type!"
     307           0 :      +                   ,calledby ="atom_input")
     308             :                  ENDIF
     309           0 :                  IF (ncst0 > -9998  ) THEN
     310           0 :                    IF (ncorest /= ncst0) THEN
     311             :                      WRITE (6,'("  ==> core-states (ncst):",i3,
     312             :      &                              " =/= (econfig):",i3)') 
     313           0 :      &                        atoms%ncst,ncorest
     314             :                      CALL juDFT_error
     315             :      +                    ("econfig does not fit to the specified ncst"
     316           0 :      +                    ,calledby ="atom_input")
     317             :                    ENDIF
     318             :                  ELSE
     319           0 :                    atoms%ncst(n) = ncorest
     320             :                  ENDIF
     321             :               ENDIF
     322             : ! ===> local orbitals
     323           1 :               IF (lo0 /= ' ') THEN
     324             :                 WRITE (6,'(a6,i3,a7,i3,a3,a80)')
     325           0 :      &                     "nlod =",nlod0," llod =",llod," : ",lo0
     326           0 :                 lo(n)      = lo0
     327           0 :                 IF (nlod0 > atoms%nlod)  
     328             :      &             CALL juDFT_error("atom_input: too "
     329           0 :      &                              //"many lo",calledby="atom_input")
     330             : 
     331           0 :                 atoms%nlo(n) = len_trim(lo(n))/2
     332           0 :                 DO i = 1, atoms%nlo(n)
     333           0 :                   j = 2*i
     334           0 :                   DO l = 0, 3
     335           0 :                     IF (lo(n)(j:j) == lotype(l)) THEN
     336           0 :                       atoms%llo(i,n) = l
     337             :                     ENDIF
     338             :                   ENDDO
     339           0 :                   j = j - 1
     340           0 :                   READ (lo(n)(j:j),*) lonqn(i,n)
     341             :                 ENDDO
     342           0 :                 WRITE (6,'("   nlo(",i3,") = ",i2," llo = ",8i2)') n,
     343           0 :      &                    atoms%nlo(n),(atoms%llo(i,n),i=1,atoms%nlo(n))
     344             :                 WRITE (6,'("   lonqn = ",8i2)') 
     345           0 :      &                    (lonqn(i,n),i=1,atoms%nlo(n))
     346             :               ENDIF
     347           1 :               idone(n)   = .true.
     348             :             ENDIF
     349             :           ENDDO
     350             :         ENDIF
     351             : 
     352             : !===> not an atom related namelist, we are done
     353             :       ELSE
     354             :         exit loop
     355             :       ENDIF
     356             : 
     357           4 :       nbuffer = 0
     358             :       ENDDO loop
     359             : 
     360             :  999  CONTINUE
     361           3 :       IF (fatalerror) 
     362             :      &   CALL juDFT_error("ERROR(S) reading input. Check output for "
     363           0 :      &                  //"details.",calledby="atom_input")
     364             : 
     365             : !----------- adjust the core-levels, lo's and the energy parameters ----
     366             : 
     367           3 :       coreqn(1:2,1:nstd,1:atoms%ntype) = 0
     368           6 :       coreocc(1:nstd,1:atoms%ntype) = -1.0
     369             : 
     370           3 :       nel = 0
     371             : 
     372           3 :       IF ( ANY(atoms%bmu(:) > 0.0) ) input%jspins=2 
     373             : 
     374           3 :       lmaxdTemp = atoms%lmaxd
     375           3 :       atoms%lmaxd = 3
     376           3 :       call enpara%init(atoms,input%jspins)
     377           6 :       DO n = 1, atoms%ntype
     378             : 
     379             :         CALL setcore_bystr(
     380             :      >                      n,nstd,atoms%ntype,l_buffer,
     381             :      X                      econfig,natomst,ncorest,
     382           3 :      <                      coreqn,coreocc)
     383             : 
     384           3 :         IF ( coreqn(1,1,n) /= 0 ) THEN
     385           0 :           DO i = 1, natomst
     386           0 :             IF (coreqn(2,i,n) < 0) THEN
     387           0 :                lval(i,n) = - coreqn(2,i,n) - 1
     388             :             ELSE
     389           0 :                lval(i,n) = coreqn(2,i,n)
     390             :             ENDIF
     391             :           ENDDO 
     392             : 
     393           0 :            d1  = mod(nint(atoms%zatom(n)),10)
     394           0 :            d10 = int( (nint(atoms%zatom(n)) + 0.5)/10 )
     395           0 :           aoff = iachar('1')-1
     396           0 :           IF(.NOT.input%l_inpXML) THEN
     397           0 :              fname = 'corelevels.'//achar(d10+aoff)//achar(d1+aoff)
     398           0 :              OPEN (27,file=fname,form='formatted')
     399           0 :              write(27,'(i3)') natomst
     400             :           END IF
     401             : 
     402           0 :           WRITE (6,*) '----------'
     403           0 :           electronsOnAtom = 0
     404           0 :           DO i = 1, ncorest
     405             :             WRITE(6,'("     core :",2i3,f6.1)') 
     406           0 :      &             coreqn(1,i,n),coreqn(2,i,n),coreocc(i,n)
     407           0 :             j = INT(coreocc(i,n) / 2)
     408           0 :             IF (coreocc(i,n) > 2*j) THEN
     409           0 :               j = - coreocc(i,n)
     410             :             ENDIF
     411           0 :             IF(.NOT.input%l_inpXML) THEN
     412           0 :                write(27,'(4i3)') coreqn(1,i,n),coreqn(2,i,n),j,j
     413             :             END IF
     414           0 :             xmlCoreStateNumber = 0
     415           0 :             SELECT CASE(coreqn(1,i,n))
     416             :                CASE (1)
     417           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 1   !(1s1/2)
     418             :                CASE (2)
     419           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 2   !(2s1/2)
     420           0 :                   IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 3    !(2p1/2)
     421           0 :                   IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 4   !(2p3/2)
     422             :                CASE (3)
     423           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 5   !(3s1/2)
     424           0 :                   IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 6    !(3p1/2)
     425           0 :                   IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 7   !(3p3/2)
     426           0 :                   IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 9    !(3d3/2)
     427           0 :                   IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 10  !(3d5/2)
     428             :                CASE (4)
     429           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 8   !(4s1/2)
     430           0 :                   IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 11   !(4p1/2)
     431           0 :                   IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 12  !(4p3/2)
     432           0 :                   IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 14   !(4d3/2)
     433           0 :                   IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 15  !(4d5/2)
     434           0 :                   IF(coreqn(2,i,n).EQ.3) xmlCoreStateNumber = 19   !(4f5/2)
     435           0 :                   IF(coreqn(2,i,n).EQ.-4) xmlCoreStateNumber = 20  !(4f7/2)
     436             :                CASE (5)
     437           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 13  !(5s1/2)
     438           0 :                   IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 16   !(5p1/2)
     439           0 :                   IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 17  !(5p3/2)
     440           0 :                   IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 21   !(5d3/2)
     441           0 :                   IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 22  !(5d5/2)
     442           0 :                   IF(coreqn(2,i,n).EQ.3) xmlCoreStateNumber = 26   !(5f5/2)
     443           0 :                   IF(coreqn(2,i,n).EQ.-4) xmlCoreStateNumber = 27  !(5f7/2)
     444             :                CASE (6)
     445           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 18  !(6s1/2)
     446           0 :                   IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 23   !(6p1/2)
     447           0 :                   IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 24  !(6p3/2)
     448           0 :                   IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 28   !(6d3/2)
     449           0 :                   IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 29  !(6d5/2)
     450             :                CASE (7)
     451           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 25  !(7s1/2)
     452             :             END SELECT
     453           0 :             IF(xmlCoreStateNumber.EQ.0) STOP 'Invalid core state!'
     454           0 :             xmlElectronStates(xmlCoreStateNumber,n) = coreState_const
     455             :             xmlPrintCoreStates(xmlCoreStateNumber,n) = 
     456           0 :      +         coreocc(i,n).NE.xmlCoreRefOccs(xmlCoreStateNumber)
     457           0 :             SELECT CASE(xmlCoreStateNumber)
     458             :                CASE (9:10,14:15,19:22,26:29)
     459             :                   up = MIN((xmlCoreRefOccs(xmlCoreStateNumber)/2),
     460           0 :      +                          coreocc(i,n))
     461           0 :                   dn = MAX(0.0,coreocc(i,n)-up)
     462             :                CASE DEFAULT
     463           0 :                   up = CEILING(coreocc(i,n)/2)
     464           0 :                   dn = FLOOR(coreocc(i,n)/2)
     465             :             END SELECT
     466           0 :             xmlCoreOccs(1,xmlCoreStateNumber,n) = up
     467           0 :             xmlCoreOccs(2,xmlCoreStateNumber,n) = dn
     468           0 :             electronsOnAtom = electronsOnAtom + up + dn
     469             :           ENDDO
     470           0 :           DO i = ncorest+1, natomst
     471             :             WRITE(6,'("  valence :",2i3,f6.1,i4,a1)') 
     472           0 :      &             coreqn(1,i,n),coreqn(2,i,n),coreocc(i,n),
     473           0 :      &                      coreqn(1,i,n),lotype(lval(i,n))
     474           0 :             nel = nel + coreocc(i,n) * atoms%neq(n)
     475           0 :             electronsOnAtom = electronsOnAtom + coreocc(i,n)
     476             : 
     477             : c           In d and f shells a magnetic alignment of the spins
     478             : c           is preferred in the valence bands
     479             : c           Hence the up and down occupation is chosen such that
     480             : c           the total spin is maximized
     481             : 
     482           0 :             IF ( abs(coreqn(2,i,n)+0.5) > 2.499 )
     483             :      +      THEN
     484           0 :               IF ( coreocc(i,n) > abs(coreqn(2,i,n)) ) THEN
     485           0 :                 up = abs(coreqn(2,i,n))
     486           0 :                 dn = coreocc(i,n) - abs(coreqn(2,i,n))
     487             :               ELSE
     488           0 :                 up = coreocc(i,n)
     489           0 :                 dn = 0
     490             :              END IF
     491           0 :              upreal=up
     492           0 :              dnreal=dn
     493             : 
     494             : c           in s and p states equal occupation of up and down states
     495             : 
     496             :             ELSE
     497           0 :               j = INT(coreocc(i,n) / 2)
     498           0 :               IF (coreocc(i,n) > 2*j) THEN
     499           0 :                 j = - coreocc(i,n)
     500             :               ENDIF
     501           0 :               up = j
     502           0 :               dn = j
     503           0 :               upReal = coreocc(i,n) / 2.0
     504           0 :               dnReal = coreocc(i,n) / 2.0
     505             :             END IF
     506           0 :             IF(.NOT.input%l_inpXML) THEN
     507           0 :                WRITE(27,'(4i3,i4,a1)') coreqn(1,i,n),coreqn(2,i,n),
     508           0 :      &                             up,dn,coreqn(1,i,n),lotype(lval(i,n))
     509             :             END IF
     510           0 :             xmlCoreStateNumber = 0
     511           0 :             SELECT CASE(coreqn(1,i,n))
     512             :                CASE (1)
     513           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 1   !(1s1/2)
     514             :                CASE (2)
     515           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 2   !(2s1/2)
     516           0 :                   IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 3    !(2p1/2)
     517           0 :                   IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 4   !(2p3/2)
     518             :                CASE (3)
     519           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 5   !(3s1/2)
     520           0 :                   IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 6    !(3p1/2)
     521           0 :                   IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 7   !(3p3/2)
     522           0 :                   IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 9    !(3d3/2)
     523           0 :                   IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 10  !(3d5/2)
     524             :                CASE (4)
     525           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 8   !(4s1/2)
     526           0 :                   IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 11   !(4p1/2)
     527           0 :                   IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 12  !(4p3/2)
     528           0 :                   IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 14   !(4d3/2)
     529           0 :                   IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 15  !(4d5/2)
     530           0 :                   IF(coreqn(2,i,n).EQ.3) xmlCoreStateNumber = 19   !(4f5/2)
     531           0 :                   IF(coreqn(2,i,n).EQ.-4) xmlCoreStateNumber = 20  !(4f7/2)
     532             :                CASE (5)
     533           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 13  !(5s1/2)
     534           0 :                   IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 16   !(5p1/2)
     535           0 :                   IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 17  !(5p3/2)
     536           0 :                   IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 21   !(5d3/2)
     537           0 :                   IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 22  !(5d5/2)
     538           0 :                   IF(coreqn(2,i,n).EQ.3) xmlCoreStateNumber = 26   !(5f5/2)
     539           0 :                   IF(coreqn(2,i,n).EQ.-4) xmlCoreStateNumber = 27  !(5f7/2)
     540             :                CASE (6)
     541           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 18  !(6s1/2)
     542           0 :                   IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 23   !(6p1/2)
     543           0 :                   IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 24  !(6p3/2)
     544           0 :                   IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 28   !(6d3/2)
     545           0 :                   IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 29  !(6d5/2)
     546             :                CASE (7)
     547           0 :                   IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 25  !(7s1/2)
     548             :             END SELECT
     549           0 :             IF(xmlCoreStateNumber.EQ.0) STOP 'Invalid valence state!'
     550           0 :             xmlElectronStates(xmlCoreStateNumber,n) = valenceState_const
     551             :             xmlPrintCoreStates(xmlCoreStateNumber,n) = 
     552           0 :      +         coreocc(i,n).NE.xmlCoreRefOccs(xmlCoreStateNumber)
     553             : !            SELECT CASE(xmlCoreStateNumber)
     554             : !               CASE (9:10,14:15,19:22,26:29)
     555             : !                  up = MIN((xmlCoreRefOccs(xmlCoreStateNumber)/2),
     556             : !     +                          coreocc(i,n))
     557             : !                  dn = MAX(0.0,coreocc(i,n)-up)
     558             : !               CASE DEFAULT
     559             : !                  up = CEILING(coreocc(i,n)/2)
     560             : !                  dn = FLOOR(coreocc(i,n)/2)
     561             : !            END SELECT
     562           0 :             xmlCoreOccs(1,xmlCoreStateNumber,n) = upReal
     563           0 :             xmlCoreOccs(2,xmlCoreStateNumber,n) = dnReal
     564             :           ENDDO
     565           0 :           WRITE (6,*) '----------'
     566             : 
     567             : 5392  FORMAT (' atom type: ',i5,' protons: ',f0.8,' electrons: ',f0.8)
     568           0 :           IF (ABS(electronsOnAtom-atoms%zatom(n)).GT.1e-13) THEN
     569           0 :              WRITE(*,*) 'Note: atom is charged. Is this Intended?'
     570           0 :              WRITE(*,5392) n, atoms%zatom(n), electronsOnAtom
     571           0 :              WRITE(6,*) 'Note: atom is charged. Is this Intended?'
     572           0 :              WRITE(6,5392) n, atoms%zatom(n), electronsOnAtom
     573             :           END IF
     574             : 
     575           0 :           IF(.NOT.input%l_inpXML) CLOSE(27)
     576             : 
     577           0 :           DO i = natomst,1,-1                    ! determine valence states
     578           0 :             IF (enpara%el0(lval(i,n),n,1) < -9999.8) THEN ! not processed already
     579           0 :               enpara%el0(lval(i,n),n,:) = REAL(coreqn(1,i,n))
     580           0 :               IF (i <= ncorest) THEN
     581           0 :                 enpara%el0(lval(i,n),n,:) = coreqn(1,i,n) + 1.0 ! was already in the core
     582             :               ENDIF
     583             :             ENDIF
     584             :           ENDDO
     585           0 :           DO j = 0,3
     586           0 :             IF (enpara%el0(j,n,1) < -9999.8) THEN
     587           0 :               enpara%el0(j,n,:) = REAL(j+1)
     588             :             ENDIF
     589             :           ENDDO
     590             : 
     591             :         ELSE  ! determine defauts  as usual
     592             : 
     593           3 :           z = NINT(atoms%zatom(n))
     594           3 :           nlo0 = atoms%nlo(n)
     595           3 :           llo0 = atoms%llo(:,n)
     596             :           CALL atom_defaults(
     597             :      >                       n,atoms%ntype,atoms%nlod,z,atoms%neq,
     598           3 :      X                       ncst0,nel,atoms%nlo,atoms%llo)
     599             : 
     600           3 :           IF (atoms%ncst(n) == 0) atoms%ncst(n) = ncst0
     601           3 :           IF (lonqn(1,n) /= 0) THEN ! already set before
     602           0 :             DO i = 1,atoms%nlo(n)                       ! subtract lo-charge
     603           0 :               nel = nel - 2*(2*atoms%llo(i,n)+1)*atoms%neq(n)
     604           0 :               IF (atoms%llo(i,n) == 0) atoms%ncst(n) = atoms%ncst(n) + 1
     605           0 :               IF (atoms%llo(i,n) >  0) atoms%ncst(n) = atoms%ncst(n) + 2
     606             :             ENDDO
     607           0 :             atoms%nlo(n) = nlo0                         ! set old values
     608           0 :             atoms%llo(:,n) = llo0 
     609           0 :             DO i = 1,atoms%nlo(n)                       ! add old lo-charge
     610           0 :               nel = nel + 2*(2*atoms%llo(i,n)+1)*atoms%neq(n)   
     611           0 :               IF (atoms%llo(i,n) == 0) atoms%ncst(n) = atoms%ncst(n) - 1
     612           0 :               IF (atoms%llo(i,n) >  0) atoms%ncst(n) = atoms%ncst(n) - 2
     613             :             ENDDO
     614             :           ELSE
     615           3 :              lonqn(1:atoms%nlo(n),n) = 0 !LO check below should not be needed
     616             :                                          !for default setting of enparas
     617             :           ENDIF
     618             : 
     619           3 :           IF(juDFT_was_argument("-electronConfig")) THEN
     620           0 :              electronsLeft = NINT(atoms%zatom(n))
     621           0 :              DO i = 1, 29
     622           0 :                 electronsLeft = electronsLeft - xmlCoreRefOccs(i)
     623           0 :                 IF(electronsLeft.GT.-xmlCoreRefOccs(i)+eps) THEN
     624           0 :                    natomst = i
     625           0 :                    IF(electronsLeft.LT.-eps) THEN
     626           0 :                       xmlPrintCoreStates(i,n) = .TRUE.
     627           0 :                       SELECT CASE(i)
     628             :                          CASE (9:10,14:15,19:22,26:29)
     629             :                             up = MIN((xmlCoreRefOccs(i)/2),
     630           0 :      +                               -electronsLeft)
     631           0 :                             dn = MAX(0.0,(-electronsLeft)-up)
     632             :                          CASE DEFAULT
     633           0 :                             up = CEILING((-electronsLeft)/2)
     634           0 :                             dn = FLOOR((-electronsLeft)/2)
     635             :                       END SELECT
     636           0 :                       xmlCoreOccs(1,i,n) = up
     637           0 :                       xmlCoreOccs(2,i,n) = dn
     638             :                    END IF
     639             :                 END IF
     640             :              END DO
     641           0 :              xmlElectronStates(1:atoms%ncst(n),n) = coreState_const
     642             :              xmlElectronStates(atoms%ncst(n)+1:natomst,n) = 
     643           0 :      +          valenceState_const
     644             :           END IF
     645             : 
     646             :         ENDIF
     647             : 
     648           3 :         IF (atoms%nlo(n) /= 0) THEN                    ! check for local orbitals
     649           0 :           DO i = 1, atoms%nlo(n)
     650           0 :             enpara%ello0(i,n,:) = REAL(lonqn(i,n))
     651           0 :             IF (lonqn(i,n) == enpara%qn_el(atoms%llo(i,n),n,1)) THEN  ! increase qn
     652             :               enpara%qn_el(atoms%llo(i,n),n,:) = 
     653           0 :      &           enpara%qn_el(atoms%llo(i,n),n,1) + 1          ! in LAPW's by 1
     654             :             ENDIF
     655             :           ENDDO
     656             :         ENDIF
     657           3 :         enpara%skiplo(n,:) = 0
     658           6 :         DO i = 1, atoms%nlo(n)
     659           0 :           enpara%qn_ello(i,n,:) = enpara%qn_el(atoms%llo(i,n),n,:) - 1
     660           3 :           enpara%skiplo(n,:) = enpara%skiplo(n,1) + (2*atoms%llo(i,n)+1)
     661             :         ENDDO
     662             : 
     663             :       ENDDO
     664             : 
     665           6 :       DO n = 1, atoms%ntype
     666             : ! correct valence charge
     667           6 :          DO i = 1,atoms%nlo(n)
     668           3 :             IF (atoms%llo(i,n).GT.3) THEN
     669           0 :                nel = nel - 2*(2*atoms%llo(i,n)+1)*atoms%neq(n)   
     670             :                IF (atoms%llo(i,n) == 0) atoms%ncst(n) = atoms%ncst(n)+1
     671           0 :                IF (atoms%llo(i,n) >  0) atoms%ncst(n) = atoms%ncst(n)+2
     672           0 :             ELSE IF (enpara%qn_ello(i,n,1).GE.
     673             :      &               enpara%qn_el(atoms%llo(i,n),n,1)) THEN
     674           0 :                nel = nel - 2*(2*atoms%llo(i,n)+1)*atoms%neq(n)   
     675           0 :                IF (atoms%llo(i,n) == 0) atoms%ncst(n) = atoms%ncst(n)+1
     676           0 :                IF (atoms%llo(i,n) >  0) atoms%ncst(n) = atoms%ncst(n)+2
     677             :             END IF
     678             :          ENDDO
     679             :       ENDDO
     680             : 
     681           3 :       WRITE (6,'("Valence Electrons =",i5)') nel
     682             : 
     683             : 
     684           3 :       enpara%llochg = .FALSE.
     685           3 :       enpara%lchange = .FALSE.
     686           3 :       enpara%enmix = 1.0
     687           3 :       enpara%lchg_v = .TRUE.
     688           3 :       IF(juDFT_was_argument("-genEnpara")) THEN
     689           0 :          CALL enpara%write(atoms,input%jspins,input%film)
     690             :       END IF
     691           3 :       atoms%lmaxd = lmaxdTemp
     692             :       RETURN
     693             : 
     694             : !===> error handling
     695             : 
     696             :  911  CONTINUE
     697             :       WRITE (errfh,*) 'atom_input: ERROR reading input. ios  =',ios,
     698             :      &               ', line =',nline
     699             :       CALL juDFT_error("atom_input: ERROR reading input",
     700           0 :      &                calledby="atom_input")
     701             : 
     702             :  912  CONTINUE
     703           0 :       WRITE (errfh,*) 'atom_input: ERROR reading namelist.',
     704           0 :      &               ' ios =',ios,
     705           0 :      &               ' line =',nline
     706           0 :       WRITE (errfh,*) buffer(1:nbuffer)
     707           0 :       WRITE (errfh,*) 'The cause of this error may be ...'
     708           0 :       WRITE (errfh,*) '        a variable not defined in this namelist,'
     709           0 :       WRITE (errfh,*) '        wrong type of data for a variable.'
     710             :       CALL juDFT_error("atom_input: ERROR reading input",
     711           0 :      &                calledby="atom_input")
     712             : 
     713             :  913  CONTINUE
     714           0 :       WRITE (errfh,*) 'atom_input: ERROR reading record.',
     715           0 :      &               ' ios =',ios,
     716           0 :      &               ' line =',nline
     717           0 :       WRITE (errfh,*) buffer(1:nbuffer)
     718             :       CALL juDFT_error("atom_input: ERROR reading input",
     719           0 :      &                calledby="atom_input")
     720             : 
     721             : !----------------------------------------------------------------
     722             :       CONTAINS   ! INTERNAL subroutines
     723             : !----------------------------------------------------------------
     724           0 :       SUBROUTINE err( n )
     725             : 
     726             :       INTEGER, INTENT (IN) :: n
     727             : 
     728           0 :       WRITE(errfh,*)
     729           0 :       IF (n==1) THEN
     730           0 :         WRITE (errfh,*) 'atom_input: ERROR multiple namelists.',
     731           0 :      &               ' line =',nline
     732           0 :       ELSEIF (n==2) THEN
     733           0 :         WRITE (errfh,*) 'atom_input: ERROR unknown namelist.',
     734           0 :      &               ' line =',nline
     735           0 :       ELSEIF (n==3) THEN
     736           0 :         WRITE (errfh,*) 'atom_input: ERROR reading namelist.',
     737           0 :      &               ' line =',nline
     738             :       ELSE
     739           0 :         WRITE (errfh,*) 'atom_input: ERROR reading input.',
     740           0 :      &               ' line =',nline
     741             :       ENDIF
     742           0 :       WRITE (errfh,*) buffer(1:nbuffer)
     743           0 :       WRITE (errfh,*)
     744           0 :       fatalerror = .true.
     745           0 :       RETURN
     746             :       END SUBROUTINE err
     747             : !----------------------------------------------------------------
     748             :       END SUBROUTINE atom_input
     749             : !----------------------------------------------------------------
     750             : !================================================================
     751           0 :       SUBROUTINE read_allatoms(
     752             :      >                         bfh,
     753             :      X                         rmt,dx,jri,lmax,lnonsph,ncst,econfig,
     754             :      <                         bmu,ios)
     755             : !****************************************************************
     756             : !     reads in defaults for muffin-tin radius, mesh, etc.
     757             : !****************************************************************
     758             : 
     759             :       IMPLICIT NONE
     760             : 
     761             :       INTEGER, INTENT (IN)    :: bfh
     762             :       INTEGER, INTENT (INOUT) :: jri     ! mt radial mesh points
     763             :       INTEGER, INTENT (INOUT) :: lmax    ! max. l to include for density, overlap etc.
     764             :       INTEGER, INTENT (INOUT) :: lnonsph ! max. l for nonspherical MT-contributions
     765             :       INTEGER, INTENT (INOUT) :: ncst    ! # of core levels
     766             :       INTEGER, INTENT (OUT)   :: ios
     767             :       REAL, INTENT (INOUT)    :: rmt, dx ! muffin-tin radius and log. spacing
     768             :       REAL, INTENT (INOUT)    :: bmu     ! magnetic moment
     769             :       CHARACTER(len=l_buffer) :: econfig ! verbose electronic config
     770             : 
     771             :       NAMELIST /allatoms/ rmt,dx,jri,lmax,lnonsph,ncst,econfig,
     772             :      &                    bmu
     773             : 
     774           0 :       READ (bfh,allatoms,err=911,end=911,iostat=ios)
     775             : 
     776             :  911  CONTINUE
     777           0 :       END SUBROUTINE read_allatoms
     778             : !================================================================
     779           1 :       SUBROUTINE read_atom(
     780             :      >                     bfh,lotype,
     781             :      X                     id,z,rmt,jri,dx,lmax,lnonsph,ncst,econfig,
     782             :      <                     speciesName,bmu,lo,nlod,llod,ios )
     783             : !***********************************************************************
     784             : !     reads in muffin-tin radius, mesh, etc.
     785             : !***********************************************************************
     786             : 
     787             :       USE m_element, ONLY : z_namat
     788             :       IMPLICIT NONE
     789             : 
     790             : ! ... arguments ...
     791             :       INTEGER, INTENT (IN)           :: bfh
     792             :       REAL, INTENT (OUT)             :: id,z,rmt,dx,bmu
     793             :       INTEGER                        :: lmax,lnonsph,ncst,jri,nlod,llod
     794             :       CHARACTER(len=l_buffer)        :: econfig
     795             :       CHARACTER(len=80)              :: lo
     796             :       CHARACTER(len=20), INTENT(OUT) :: speciesName
     797             :       INTEGER, INTENT (OUT)          :: ios
     798             :       CHARACTER(len=1), INTENT (IN)  :: lotype(0:3)
     799             : 
     800             : ! ... internal variables ...
     801             :       INTEGER                  :: i,j,k,l,n
     802             :       REAL                     :: zz
     803             :       CHARACTER(len=2)         :: element
     804             :       CHARACTER(len=20)        :: name
     805             :       CHARACTER(len=80)        :: lo1
     806             : 
     807             :       CHARACTER(len=2) :: lotype2(0:3)
     808             :       DATA lotype2 /'sS','pP','dD','fF'/
     809             : 
     810             :       NAMELIST /atom/ id,z,rmt,dx,jri,lmax,lnonsph,ncst,
     811             :      &                econfig,bmu,lo,element,name
     812             : 
     813           1 :       id = -9999.9
     814           1 :       z  = -9999.9
     815           1 :       element = ' '
     816           1 :       speciesName = ''
     817           1 :       name = ''
     818             : 
     819           1 :       READ (bfh,atom,err=911,end=911,iostat=ios)
     820             : 
     821           1 :       speciesName = TRIM(ADJUSTL(name))
     822             : 
     823             : ! -> determine which atom we are concerned with ...
     824             : 
     825           2 :       IF ((z < -9999.8).AND.(element.EQ.' ')) THEN
     826             :         WRITE (errfh,*)
     827           0 :      &       'ERROR! No element specified  in namelist atom...'
     828           0 :         WRITE (errfh,*) 'use z=.. or element=.. to define it!'
     829           0 :         ios = 3001
     830           0 :         RETURN
     831             :       ENDIF
     832           1 :       IF (id < -9999.8) THEN     ! if no id specified
     833           1 :         zz = REAL(z_namat(element))
     834           1 :         IF (z < 0.00) THEN
     835           1 :           IF (zz > eps) THEN
     836           1 :             id = zz              ! use element name
     837             :           ELSE
     838           0 :             id = z               ! or use "z" for id
     839             :           ENDIF
     840             :         ELSE
     841           0 :           IF (zz > 0 .AND. abs(zz-z)>0.5) THEN
     842           0 :             WRITE (warnfh,*)
     843           0 :             WRITE (warnfh,*) 'atom_input: WARNING! ',
     844           0 :      &       'z and z of specified element differ by more than 0.5. '
     845           0 :             WRITE (warnfh,*) '  z = ', z, 'element =',element
     846           0 :             WRITE (warnfh,*)
     847             :           ENDIF
     848             :         ENDIF
     849             :       ENDIF
     850             : 
     851             : !---> order local orbitals determine nlod, llod
     852           1 :       lo1 = adjustl(lo)
     853           1 :       lo = ' '
     854           1 :       i = 0
     855           1 :       n = 0
     856           5 :       DO l = 0, 3
     857           1 :         DO
     858           4 :           j = SCAN(lo1,lotype2(l))  ! search for 's' or 'S', 'p' or 'P' etc.
     859           4 :           IF (j > 0) THEN
     860           0 :             lo1(j:j) = ' '
     861           0 :             n = n + 1
     862           0 :             i = i + 1
     863           0 :             IF (j > 1) THEN
     864           0 :               k = SCAN(lo1(j-1:j-1),'123456') ! determine principal quantum number
     865           0 :               IF (k > 0) THEN
     866           0 :                 lo(i:i) = lo1(j-1:j-1)
     867           0 :                 lo1(j-1:j-1) = ' '
     868             :               ELSE
     869           0 :                 lo(i:i) = '0'
     870             :               ENDIf
     871             :             ELSE
     872           0 :               lo(i:i) = '0'
     873             :             ENDIF
     874           0 :             i = i + 1
     875           0 :             lo(i:i) = lotype(l)
     876           0 :             nlod = max( nlod, n )
     877           0 :             llod = max( llod, l )
     878             :           ELSE
     879             :             EXIT
     880             :           ENDIF
     881             :         ENDDO
     882             :       ENDDO
     883           1 :       IF (len_trim(lo1) > 0) then
     884           0 :         WRITE (errfh,*) 'ERROR reading local orbital input...',lo1
     885           0 :         ios = 3002
     886             :       ENDIF
     887             : 
     888             :  911  CONTINUE
     889             :       END SUBROUTINE read_atom
     890             : !================================================================
     891             : 
     892           3 :       SUBROUTINE atom_defaults(
     893           3 :      >                         n,ntype,nlod,z,neq,
     894           3 :      X                         ncst2,nel,nlo,llo)
     895             :       USE m_juDFT
     896             :       IMPLICIT NONE
     897             : 
     898             :       INTEGER, INTENT (IN)    :: n,ntype,nlod,z
     899             :       INTEGER, INTENT (IN)    :: neq(ntype)
     900             :       INTEGER, INTENT (INOUT) :: nel,ncst2
     901             :       INTEGER, INTENT (INOUT) :: nlo(ntype),llo(nlod,ntype)
     902             :       
     903             : 
     904             :       INTEGER locore,lo
     905             :       INTEGER ncst1(0:103),nce(0:24)
     906             : 
     907             : !
     908             : ! electrons associated with a given number of core-levels
     909             : !
     910          78 :       nce=-1;
     911           3 :       nce(0) = 0  ; nce(1) = 2  ; nce(2)= 4   ; nce(4) = 10  
     912           3 :       nce(5) = 12 ; nce(7) =18 ;nce(8)=20; 
     913           3 :       nce(9) = 28 ; nce(12) = 36; nce(14) = 46; nce(17) = 54
     914           3 :       nce(19) = 68; nce(21) = 78; nce(24) = 86
     915             : 
     916             : 
     917             : !
     918             : ! number of core levels for each element; the INT(ncst1/100) number
     919             : ! provides information about possible local orbitals: 
     920             : !    0  no LO
     921             : !    1  s-LO
     922             : !    2  p-LO
     923             : !    4  d-LO
     924             : !    8  f-LO
     925             : ! Sums are allowed, i.e. 3 (s,p)-LO
     926             : !
     927             : 
     928             : !Defaults
     929             :       ncst1 =(/0,0,                                            0,        ! Va,H,He
     930             :      + 01, 01,                                         1, 1, 1, 1, 1, 1,        ! Li - Ne
     931             :      + 304,304,                                        4, 4, 4, 4, 4, 4,       ! Na - Ar
     932             :      + 307,307,307,307,307,307,307,307,207,207, 7,  7,409,409,409,409,
     933             :      +                                                          409, 9,  ! K - Kr
     934             :      + 312,312,312,312,312,312,312,212,212,212,312,212,414,414,414,414,
     935             :      +                                                         414,414,  ! Rb - Xe
     936             :      + 317,317,217,217,217,217,217,217,217,217,217,17, 17,17,17,17,17,    ! Cs - Lu
     937             :      +    1119,1119,319,319,219,219,219,219,219,421,421,421,421,421,421,  ! Hf - Rn
     938           3 :      + 324,324,224,224,224,24,24,24,24,24,24,24, 24,24,24,24,24/)   ! Fr - Lw
     939             : 
     940           3 :       if (judft_was_argument("-fast_defaults")) 
     941             :      + ncst1 =(/0,0,                                                0,  ! Va,H,He
     942             :      +     01, 01,                                  1, 1, 1, 1, 1, 1,  ! Li - Ne
     943             :      +     04, 04,                                  4, 4, 4, 4, 4, 4,  ! Na - Ar
     944             :      +    307,307,207,207, 7, 7, 7, 7, 7, 7, 7, 7,409, 9, 9, 9, 9, 9,  ! K - Kr
     945             :      +    312,312,212,212,12,12,12,12,12,12,12,12,414,14,14,14,14,14,  ! Rb - Xe
     946             :      +    317,317,217,217,17,17,17,17,17,17,17,17, 17,17,17,17,17,     ! Cs - Lu
     947             :      +                219,19,19,19,19,19,19,19,19,421,21,21,21,21,21,  ! Hf - Rn
     948           0 :      +    324,324,224,224,224,24,24,24,24,24,24,24, 24,24,24,24,24/)   ! Fr - Lw
     949             : 
     950             : 
     951             : !
     952             : !--> determine core levels
     953             : !
     954           3 :       ncst2 = mod(ncst1( z ),100)
     955           3 :       lo=int(ncst1(z)/100)
     956             :       
     957           3 :       nel=nel+(z - nce(ncst2))*neq(n)
     958           3 :       nlo(n) = 0 ; locore = 0
     959             : 
     960           3 :       IF (btest(lo,0)) THEN !s-lo
     961           0 :          locore=locore+2
     962           0 :          ncst2=ncst2-1
     963           0 :          nlo(n)=nlo(n)+1
     964           0 :          llo(nlo(n),n)=0
     965             :       ENDIF
     966           3 :       IF (btest(lo,1)) THEN !p-lo
     967           0 :          locore=locore+6
     968           0 :          ncst2=ncst2-2
     969           0 :          nlo(n)=nlo(n)+1
     970           0 :          llo(nlo(n),n)=1
     971             :       ENDIF
     972           3 :       IF (btest(lo,2)) THEN !d-lo
     973           0 :          locore=locore+10
     974           0 :          ncst2=ncst2-2
     975           0 :          nlo(n)=nlo(n)+1
     976           0 :          llo(nlo(n),n)=2
     977             :       ENDIF
     978           3 :       IF (btest(lo,3)) THEN !f-lo
     979           0 :          locore=locore+14
     980           0 :          ncst2=ncst2-2
     981           0 :          nlo(n)=nlo(n)+1
     982           0 :          llo(nlo(n),n)=3
     983             :       ENDIF
     984             :       
     985           3 :       nel = nel +  locore  * neq(n)
     986             :       
     987           3 :       END SUBROUTINE atom_defaults
     988             : 
     989             :       END MODULE m_atominput

Generated by: LCOV version 1.13