LCOV - code coverage report
Current view: top level - init/old_inp - inped.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 148 234 63.2 %
Date: 2019-09-08 04:53:50 Functions: 1 2 50.0 %

          Line data    Source code
       1             :       MODULE m_inped
       2             :       USE m_juDFT
       3             : !     *******************************************************
       4             : !     read in input parameters
       5             : !     modified to include also empty spheres (z=1.e-10)
       6             : !     r.p. aug. 1990
       7             : !     now includes readin of k-points          * shz Apr.96 *
       8             : !     modified to include all exchange correlation potentials
       9             : !     and relativistic correction to vxc
      10             : !     r.pentcheva dec. 1995
      11             : !
      12             : !ta+
      13             : !     igrd=0: no gradient correction.
      14             : !     igrd=1: pw-91. icorr=6.
      15             : 
      16             : !     ndvgrd: number of points used to calculate the numerical
      17             : !c           derivatives. 6 is biggest and presumably the best.
      18             : !     ntimec: if ntime ge ntimec, iteration stops with code=2.
      19             : !     distc : distance of convergence in charge criterion.
      20             : !     tendfc: read-in in mhtree.
      21             : !c            if tendf (total energy diff. in mili-hartree from former
      22             : !c            tenrg) becomes less than tendfc, ntime=ntime+1.
      23             : !     chng  : charge-negative.
      24             : !c             if(ro.lt.chng) ineg=1 and stop.
      25             : !ta-
      26             : !     *******************************************************
      27             : !
      28             :       CONTAINS
      29          14 :         SUBROUTINE inped(atoms,obsolete,vacuum,input,banddos,xcpot,sym,&
      30             :                          cell,sliceplot,noco,&
      31             :                          stars,oneD,hybrid,kpts,a1,a2,a3,namex,relcor)
      32             :           USE m_rwinp
      33             :           USE m_chkmt
      34             :           USE m_inpnoco
      35             :           USE m_constants
      36             :           USE m_types
      37             :           USE m_inv3
      38             :           USE m_setlomap
      39             :           IMPLICIT NONE
      40             :           !     ..
      41             :           !     .. Scalar Arguments ..
      42             :           TYPE(t_atoms),     INTENT(INOUT) :: atoms
      43             :           TYPE(t_obsolete),  INTENT(INOUT) :: obsolete
      44             :           TYPE(t_vacuum),    INTENT(INOUT) :: vacuum
      45             :           TYPE(t_input),     INTENT(INOUT) :: input
      46             :           TYPE(t_banddos),   INTENT(INOUT) :: banddos
      47             :           TYPE(t_xcpot_inbuild),     INTENT(INOUT) :: xcpot
      48             :           TYPE(t_sym),       INTENT(INOUT) :: sym
      49             :           TYPE(t_cell),      INTENT(INOUT) :: cell
      50             :           TYPE(t_sliceplot), INTENT(INOUT) :: sliceplot
      51             :           TYPE(t_noco),      INTENT(INOUT) :: noco
      52             :           TYPE(t_stars),     INTENT(INOUT) :: stars
      53             :           TYPE(t_oneD),      INTENT(INOUT) :: oneD
      54             :           TYPE(t_hybrid),    INTENT(INOUT) :: hybrid
      55             :           TYPE(t_kpts),      INTENT(INOUT) :: kpts
      56             :           REAL,              INTENT(OUT)   :: a1(3)
      57             :           REAL,              INTENT(OUT)   :: a2(3)
      58             :           REAL,              INTENT(OUT)   :: a3(3)
      59             :           CHARACTER(len=4),  INTENT(OUT)   :: namex 
      60             :           CHARACTER(len=12), INTENT(OUT)   :: relcor
      61             : 
      62             :           !     .. Local Scalars ..
      63             :           REAL dr,dtild,r,kmax1,dvac1,zp
      64             :           INTEGER i,iz,j,n,n1,na,ntst,nn,ios
      65             :           LOGICAL l_gga,l_test,l_vca
      66             :           CHARACTER(len=2)  :: str_up,str_do
      67             : 
      68             :           !     ..
      69             :           !     .. Local Arrays ..
      70          28 :           CHARACTER(3) noel(atoms%ntype)
      71             :           CHARACTER(8) llr(0:1)
      72          28 :           INTEGER  jri1(atoms%ntype),lmax1(atoms%ntype)
      73          56 :           REAL    rmt1(atoms%ntype),dx1(atoms%ntype)
      74             : 
      75             :           !     ..
      76             :           !     .. Data statements ..
      77             :           DATA llr(0)/'absolute'/,llr(1)/'floating'/
      78             :           !
      79             : 
      80          14 :           a1(:) = 0
      81          14 :           a2(:) = 0
      82          14 :           a3(:) = 0
      83             : 
      84          14 :           na = 0
      85             : 
      86             :           CALL rw_inp('r',atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
      87          14 :                cell,sym,xcpot,noco,oneD,hybrid,kpts, noel,namex,relcor,a1,a2,a3)
      88             : 
      89          14 :           input%l_core_confpot=.TRUE. !this is the former CPP_CORE switch!
      90          14 :           input%l_useapw=.FALSE.      !this is the former CPP_APW switch!
      91          14 :           atoms%lapw_l(:) = -1
      92          14 :           IF(ANY(atoms%lnonsph(:).GT.39)) THEN
      93           0 :              WRITE(*,*) 'lnonsph > 39 detected. This is interpreted as an intention to use APW+lo.'
      94           0 :              WRITE(*,*) 'Switching to APW+lo!'
      95           0 :              input%l_useapw=.TRUE.
      96             :           END IF
      97             :           !---> pk non-collinear
      98             :           !---> read the angle information from nocoinf
      99          56 :           noco%qss(:) = 0.0
     100          14 :           IF (noco%l_noco) THEN
     101           3 :              CALL inpnoco(atoms,input,vacuum,noco)
     102             :           ELSE
     103          11 :              noco%l_ss = .FALSE.
     104          11 :              noco%l_mperp = .FALSE.
     105          11 :              noco%l_constr = .FALSE.
     106          11 :              noco%mix_b = 0.0
     107          11 :              noco%l_relax(:) = .FALSE.
     108          11 :              noco%alph(:) = 0.0
     109          11 :              noco%beta(:) = 0.0
     110          11 :              noco%b_con(:,:) = 0.0
     111             :           ENDIF
     112             :           !---> pk non-collinear
     113             : 
     114             : 8010      FORMAT (/,/,4x,10a8,/,/)
     115             :           !--->    the menu for namgrp can be found in subroutine spgset
     116          14 :           WRITE (6,FMT=8030) cell%latnam,sym%namgrp,sym%invs,sym%zrfs,sym%invs2,input%jspins
     117             : 8030      FORMAT (' lattice=',a3,/,' name of space group=',a4,/,' inversion symmetry=   ',l1&
     118             :                ,/,' z-reflection symmetry=',l1,/,' vacuum-inversion symm=',l1,/,' jspins=',i1)
     119             : 
     120          14 :           IF (input%film.AND.(sym%invs.OR.sym%zrfs)) THEN
     121           1 :              IF ( (sym%invs.AND.sym%zrfs).NEQV.sym%invs2 ) THEN
     122           0 :                 WRITE (6,*) 'Settings of inversion and z-reflection symmetry='
     123           0 :                 WRITE (6,*) 'are inconsistent with vacuum-inversion symmetry!'
     124           0 :                 CALL juDFT_error("invs, zrfs and invs2 do not match!",calledby ="inped")
     125             :              ENDIF
     126             :           ENDIF
     127             : 
     128             : 
     129          14 :           IF (ALL(a1.EQ.0.)) THEN
     130           0 :              WRITE (6,'(a4,3f10.5,a8,a4)') 'a1 =',a1(:),' latnam=',cell%latnam
     131           0 :              CALL juDFT_error("latnam",calledby ="inped")
     132             :           ENDIF
     133          14 :           dtild=a3(3)
     134          14 :           IF (input%scaleCell.EQ.0.0) input%scaleCell = 1.0
     135          14 :           vacuum%dvac = input%scaleCell*vacuum%dvac
     136          14 :           dtild = input%scaleCell*dtild
     137             :           !+odim
     138          14 :           IF (.NOT.oneD%odd%d1) THEN
     139          14 :              IF ((dtild-vacuum%dvac.LT.0.0).AND.input%film) THEN
     140           0 :                 WRITE(6,'(2(a7,f10.5))') 'dtild:',dtild,' dvac:',vacuum%dvac
     141           0 :                 CALL juDFT_error("dtild < dvac",calledby="inped")
     142             :              ENDIF
     143             :           ELSE
     144           0 :              IF (vacuum%dvac.GE.SQRT(a1(1)**2 + a1(2)**2).OR. vacuum%dvac.GE.SQRT(a2(1)**2 + a2(2)**2)) THEN
     145           0 :                 CALL juDFT_error("one-dim: dvac >= amat(1,1) or amat(2,2)" ,calledby ="inped")
     146             :              END IF
     147             :           ENDIF
     148             :           !-odim
     149          14 :           vacuum%nvac = 2
     150          14 :           IF (sym%zrfs .OR. sym%invs) vacuum%nvac = 1
     151          14 :           IF (oneD%odd%d1) vacuum%nvac = 1
     152          14 :           cell%z1 = vacuum%dvac/2
     153          14 :           vacuum%nmz = vacuum%nmzd
     154          14 :           vacuum%delz = 25.0/vacuum%nmz
     155          14 :           IF (oneD%odd%d1) vacuum%delz = 20.0/vacuum%nmz
     156             :           IF (vacuum%nmz>vacuum%nmzd)  CALL juDFT_error("nmzd",calledby ="inped")
     157          14 :           vacuum%nmzxy = vacuum%nmzxyd
     158             :           IF (vacuum%nmzxy>vacuum%nmzxyd)  CALL juDFT_error("nmzxyd",calledby ="inped")
     159          14 :           a1(:) = input%scaleCell*a1(:)
     160          56 :           a2(:) = input%scaleCell*a2(:)
     161          56 :           a3(:) = input%scaleCell*a3(:)
     162          14 :           WRITE (6,FMT=8050) input%scaleCell
     163             : 8050      FORMAT (' unit cell scaled by    ',f10.6)
     164          14 :           WRITE (6,FMT=8060) cell%z1
     165             : 8060      FORMAT (' the vacuum begins at z=',f10.6)
     166          14 :           WRITE (6,FMT=8070) dtild/2.
     167             : 8070      FORMAT (' dtilda/2=              ',f10.6)
     168             :           !     set up bravais matrices of real and reciprocal lattices
     169          56 :           cell%amat(:,1) = a1(:)
     170          56 :           cell%amat(:,2) = a2(:)
     171          56 :           cell%amat(:,3) = a3(:)
     172          14 :           CALL inv3(cell%amat,cell%bmat,cell%omtil)
     173          56 :           cell%bmat(:,:) = tpi_const*cell%bmat(:,:)
     174          14 :           cell%bbmat=MATMUL(cell%bmat,TRANSPOSE(cell%bmat))
     175          14 :           cell%omtil = ABS(cell%omtil)
     176             : 
     177          14 :           IF (input%film .AND. .NOT.oneD%odd%d1) THEN
     178           1 :              cell%vol = cell%omtil/cell%amat(3,3)*vacuum%dvac
     179           1 :              cell%area = cell%omtil/cell%amat(3,3)
     180             :              !-odim
     181          13 :           ELSEIF (oneD%odd%d1) THEN
     182           0 :              cell%area = tpi_const*cell%amat(3,3)
     183           0 :              cell%vol = pi_const*(vacuum%dvac**2)*cell%amat(3,3)/4.
     184             :              !+odim
     185             :           ELSE
     186          13 :              cell%vol = cell%omtil
     187          13 :              cell%area = cell%amat(1,1)*cell%amat(2,2)-cell%amat(1,2)*cell%amat(2,1)
     188          13 :              IF (cell%area.LT.1.0e-7) THEN
     189           0 :                 IF (cell%latnam.EQ.'any') THEN
     190           0 :                    cell%area = 1.
     191             :                 ELSE
     192           0 :                    CALL juDFT_error("area = 0",calledby ="inped")
     193             :                 ENDIF
     194             :              ENDIF
     195             :           ENDIF
     196             : 
     197             : 
     198          14 :           WRITE (6,FMT=8080)
     199             : 8080      FORMAT (/,/,1x,'bravais matrices of real and reciprocal lattices', /)
     200          56 :           DO i = 1,3
     201          56 :              WRITE (6,FMT=8090) (cell%amat(i,j),j=1,3), (cell%bmat(i,j),j=1,3)
     202             :           ENDDO
     203             : 8090      FORMAT (3x,3f10.6,3x,3f10.6)
     204          14 :           WRITE (6,FMT=8100) cell%omtil,cell%vol,cell%area
     205             : 8100      FORMAT (/,4x,'the volume of the unit cell omega-tilda=',f12.6,/, 10x,'the volume of the unit cell omega=',&
     206             :                f12.6,/,2x, 'the area of the two-dimensional unit cell=',f12.6)
     207          14 :           WRITE (6,FMT=8120) namex,relcor
     208             : 8120      FORMAT (1x,'exchange-correlation: ',a4,2x,a12,1x,'correction')
     209             : 
     210          14 :           CALL xcpot%init(namex,relcor.EQ.'relativistic',atoms%ntype)
     211             : !!$          xcpot%icorr = -99
     212             : !!$
     213             : !!$          !     l91: lsd(igrd=0) with dsprs=1.d-19 in pw91.
     214             : !!$          IF (namex.EQ.'exx ') xcpot%icorr = icorr_exx
     215             : !!$          IF (namex.EQ.'hf  ') xcpot%icorr = icorr_hf
     216             : !!$          IF (namex.EQ.'l91 ') xcpot%icorr = -1
     217             : !!$          IF (namex.EQ.'x-a ') xcpot%icorr =  0
     218             : !!$          IF (namex.EQ.'wign') xcpot%icorr =  1
     219             : !!$          IF (namex.EQ.'mjw')  xcpot%icorr =  2
     220             : !!$          IF (namex.EQ.'hl')   xcpot%icorr =  3
     221             : !!$          IF (namex.EQ.'bh')   xcpot%icorr =  3
     222             : !!$          IF (namex.EQ.'vwn')  xcpot%icorr =  4
     223             : !!$          IF (namex.EQ.'pz')   xcpot%icorr =  5
     224             : !!$          IF (namex.EQ.'pw91') xcpot%icorr =  6
     225             : !!$          !     pbe: easy_pbe [Phys.Rev.Lett. 77, 3865 (1996)]
     226             : !!$          !     rpbe: rev_pbe [Phys.Rev.Lett. 80, 890 (1998)]
     227             : !!$          !     Rpbe: Rev_pbe [Phys.Rev.B 59, 7413 (1999)]
     228             : !!$          IF (namex.EQ.'pbe')  xcpot%icorr =  7
     229             : !!$          IF (namex.EQ.'rpbe') xcpot%icorr =  8
     230             : !!$          IF (namex.EQ.'Rpbe') xcpot%icorr =  9
     231             : !!$          IF (namex.EQ.'wc')   xcpot%icorr = 10
     232             : !!$          !     wc: Wu & Cohen, [Phys.Rev.B 73, 235116 (2006)]
     233             : !!$          IF (namex.EQ.'PBEs') xcpot%icorr = 11
     234             : !!$          !     PBEs: PBE for solids ( arXiv:0711.0156v2 )
     235             : !!$          IF (namex.EQ.'pbe0') xcpot%icorr = icorr_pbe0
     236             : !!$          !     hse: Heyd, Scuseria, Ernzerhof, JChemPhys 118, 8207 (2003)
     237             : !!$          IF (namex.EQ.'hse ') xcpot%icorr = icorr_hse
     238             : !!$          IF (namex.EQ.'vhse') xcpot%icorr = icorr_vhse
     239             : !!$          ! local part of HSE
     240             : !!$          IF (namex.EQ.'lhse') xcpot%icorr = icorr_hseloc
     241             : !!$
     242             : !!$          IF (xcpot%icorr == -99) THEN
     243             : !!$             WRITE(6,*) 'Name of XC-potential not recognized. Use one of:'
     244             : !!$             WRITE(6,*) 'x-a,wign,mjw,hl,bh,vwn,pz,l91,pw91,pbe,rpbe,Rpbe,wc,PBEs,pbe0,hf,hse,lhse'
     245             : !!$             CALL juDFT_error("Wrong name of XC-potential!",calledby="inped")
     246             : !!$          ENDIF
     247             : !!$          xcpot%krla = 0
     248             : !!$          IF (relcor.EQ.'relativistic') THEN
     249             : !!$             xcpot%krla = 1
     250             : !!$           
     251             : !!$          ENDIF
     252             : 
     253             : !!$          IF (xcpot%icorr.EQ.0) WRITE(6,*) 'WARNING: using X-alpha for XC!'
     254             : !!$          IF (xcpot%icorr.EQ.1) WRITE(6,*) 'INFO   : using Wigner  for XC!'
     255             : !!$          IF ((xcpot%icorr.EQ.2).AND.(namex.NE.'mjw')) WRITE(6,*) 'CAUTION: using MJW(BH) for XC!'
     256             : !!$
     257             : !!$          !+guta
     258             : !!$          IF ((xcpot%icorr.EQ.-1).OR.(xcpot%icorr.GE.6)) THEN
     259             : 
     260          14 :           IF (xcpot%needs_grad()) THEN
     261           8 :              obsolete%ndvgrd = MAX(obsolete%ndvgrd,3)
     262             :             
     263             : 
     264             :              !        iggachk: removed; triggered via idsprs (see below)
     265             :              !                 idsprs-0(mt,l=0),-l(nmt),-i(interstitial),-v(vacuum)
     266             :              !                 enable to make gga partially enactive if corresponding
     267             :              !                 idsprs set to be zero.
     268             : 
     269             : 
     270           8 :              WRITE (6,FMT=8122) 1,obsolete%lwb,obsolete%ndvgrd,0,obsolete%chng
     271           8 :              WRITE (6,'(/)')
     272             : 8122         FORMAT ('igrd=',i1,',lwb=',l1,',ndvgrd=',i1,',idsprs=',i1, ',chng=',d10.3)
     273             : 
     274             :           ENDIF
     275             :           !-guta
     276             :           !     specification of atoms
     277             :           
     278          14 :           cell%volint = cell%vol
     279             : 
     280          46 :           DO  n = 1,atoms%ntype
     281          32 :              IF (TRIM(ADJUSTL(noel(n))).NE.TRIM(ADJUSTL(namat_const(atoms%nz(n))))) THEN
     282           0 :                 CALL trans(namat_const(n),str_up,str_do)
     283           0 :                 IF ( (TRIM(ADJUSTL(noel(n))).NE.TRIM(ADJUSTL(str_up))) .OR.&
     284           0 :                      &        (TRIM(ADJUSTL(noel(n))).NE.TRIM(ADJUSTL(str_do))) ) THEN
     285           0 :                    WRITE( 6,*) 'Element ',noel(n),' does not match Z = ',atoms%nz(n)
     286           0 :                    CALL juDFT_warn ("Element name and nuclear number do not match!" ,calledby ="inped")
     287             :                 ENDIF
     288             :              ENDIF
     289          32 :              WRITE (6,8140) noel(n),atoms%nz(n),atoms%ncst(n),atoms%lmax(n),atoms%jri(n),atoms%rmt(n),atoms%dx(n)
     290             : 8140         FORMAT (a3,i3,3i5,2f10.6)
     291          32 :              IF (atoms%jri(n)>atoms%jmtd)  CALL juDFT_error("jmtd",calledby ="inped")
     292          32 :              atoms%zatom(n) = atoms%nz(n)
     293          32 :              IF (atoms%nz(n).EQ.0) atoms%zatom(n) = 1.e-10
     294             :              !
     295             :              ! check for virtual crystal approximation
     296             :              !
     297          32 :              l_vca = .FALSE.
     298          32 :              INQUIRE (file="vca.in", exist=l_vca)
     299          32 :              IF (l_vca) THEN
     300           0 :                 OPEN (17,file='vca.in',form='formatted')
     301           0 :                 DO nn = 1, n
     302           0 :                    READ (17,*,IOSTAT=ios) ntst,zp
     303           0 :                    IF (ios /= 0) EXIT
     304           0 :                    IF (ntst == n) THEN
     305           0 :                       atoms%zatom(n) = atoms%zatom(n) + zp
     306             :                    ENDIF
     307             :                 ENDDO
     308           0 :                 CLOSE (17)
     309             :              ENDIF
     310             :              !
     311          32 :              r = atoms%rmt(n)*EXP(atoms%dx(n)* (1-atoms%jri(n)))
     312          32 :              dr = EXP(atoms%dx(n))
     313       21698 :              DO i = 1,atoms%jri(n)
     314       21666 :                 atoms%rmsh(i,n) = r
     315       21698 :                 r = r*dr
     316             :              ENDDO
     317          32 :              atoms%volmts(n) = fpi_const/3.*atoms%rmt(n)**3
     318          32 :              cell%volint = cell%volint - atoms%volmts(n)*atoms%neq(n)
     319             : 
     320          81 :              DO n1 = 1,atoms%neq(n)
     321          35 :                 na = na + 1
     322          35 :                 IF (na>atoms%nat)  CALL juDFT_error("natd too small",calledby ="inped")
     323             :                 !
     324             :                 !--->    the in-plane coordinates refer to the lattice vectors a1 and a2,
     325             :                 !--->    i.e. they are given in internal units scaled by 'scpos'
     326             :                 !
     327          35 :                 WRITE (6,FMT=8170) (atoms%taual(i,na),i=1,3),1.0
     328             : 8170            FORMAT (4f10.6)
     329             :                 !
     330             :                 !--->   for films, the z-coordinates are given in absolute values:
     331             :                 !
     332          35 :                 IF (input%film) atoms%taual(3,na) = input%scaleCell*atoms%taual(3,na)/a3(3)
     333             :                 !
     334             :                 ! Transform intern coordinates to cartesian:
     335             :                 !
     336             :                 !CALL cotra0(atoms%taual(1,na),atoms%pos(1,na),cell%amat)
     337          67 :                 atoms%pos(:,na)=MATMUL(cell%amat,atoms%taual(:,na))
     338             :              ENDDO  ! l.o. equivalent atoms (n1)
     339             :           ENDDO     ! loop over atom-types (n)
     340             : 
     341          14 :           IF (input%film .AND. .NOT.oneD%odd%d1) THEN
     342             :              !Check if setup is roughly centered
     343           1 :              IF (ABS(MAXVAL(atoms%pos(3,:))+MINVAL(atoms%pos(3,:)))>2.0) &
     344           0 :                   CALL juDFT_warn("Film setup not centered", hint= "The z = 0 plane is the center of the film",calledby="inped")
     345             :           ENDIF
     346             : 
     347             :           !
     348             :           !  check muffin tin radii
     349             :           !
     350          14 :           l_gga= xcpot%needs_grad()
     351          14 :           l_test = .TRUE.                  ! only checking, dont use new parameters
     352          14 :           CALL chkmt(atoms,input,vacuum,cell,oneD,l_test,l_gga,noel, kmax1,dtild,dvac1,lmax1,jri1,rmt1,dx1)
     353             : 
     354          14 :           WRITE (6,FMT=8180) cell%volint
     355             : 8180      FORMAT (13x,' volume of interstitial region=',f12.6)
     356          14 :           atoms%nat = na
     357             :           !--->    evaluate cartesian coordinates of positions
     358          14 :           WRITE (6,FMT=8190) atoms%ntype,atoms%nat
     359             : 8190      FORMAT (/,/,' number of atom types=',i3,/, ' total number of atoms=',i4,/,/,t3,'no.',t10,'type',&
     360             :                &       t21,'int.-coord.',t49,'cart.coord.',t76,'rmt',t84, 'jri',t92,'dx',t98,'lmax',/)
     361          14 :           na = 0
     362          46 :           DO  n = 1,atoms%ntype
     363          81 :              DO n1 = 1,atoms%neq(n)
     364          35 :                 na = na + 1
     365          35 :                 iz = NINT(atoms%zatom(n))
     366         315 :                 WRITE (6,FMT=8200) na,namat_const(iz),n, (atoms%taual(i,na),i=1,3), (atoms%pos(i,na),i=1,3),&
     367         382 :                      atoms%rmt(n),atoms%jri(n), atoms%dx(n),atoms%lmax(n)
     368             : 8200            FORMAT (1x,i3,4x,a2,t12,i3,2x,3f6.2,3x,3f10.6,3x, f10.6,i6,3x,f6.4,3x,i2)
     369             :              ENDDO
     370             :           ENDDO
     371             :           !
     372             :           !
     373          14 :           IF (input%l_useapw) THEN
     374             : 
     375           0 :              DO n = 1,atoms%ntype
     376             :                 !+APW
     377           0 :                 atoms%lapw_l(n) = (atoms%lnonsph(n) - MOD(atoms%lnonsph(n),10) )/10
     378           0 :                 atoms%lnonsph(n) = MOD(atoms%lnonsph(n),10)
     379             :                 !-APW
     380           0 :                 IF (atoms%lnonsph(n).EQ.0) atoms%lnonsph(n) = atoms%lmax(n)
     381           0 :                 atoms%lnonsph(n) = MIN(atoms%lnonsph(n),atoms%lmax(n))
     382             :              ENDDO
     383             :           ENDIF
     384             : 
     385             :           !--->    nwd = number of energy windows; lepr = 0 (1) for energy
     386             :           !--->    parameters given on absolute (floating) scale
     387          14 :           IF (ALL(obsolete%lepr .NE. (/0,1/))) CALL judft_error("Wrong choice of lepr",calledby="inped")
     388          14 :           WRITE (6,FMT=8320) input%l_f,input%eonly,1,llr(obsolete%lepr)
     389          14 :           WRITE (6,FMT=8330) atoms%ntype, (atoms%lnonsph(n),n=1,atoms%ntype)
     390             : 8320      FORMAT (1x,/,/,/,' input of parameters for eigenvalues:',/,t5,&
     391             :                &       'calculate Pulay-forces = ',l1,/,t5,'eigenvalues ',&
     392             :                &       'only = ',l1,/,t5,'number of energy windows =',i2,/,t5,&
     393             :                &       'energy parameter mode: ',a8,/,/)
     394             : 8330      FORMAT (t5,'max. l value in wavefunctions for atom type(s) 1 to',&
     395             :                &       i3,':',16i3,/, (t59,16i3,/))
     396             :           !
     397             :           !--->    input information  for each window
     398             :           !
     399          14 :           IF (obsolete%lepr.EQ.1) THEN
     400           0 :              WRITE ( 6,'(//,''  Floating energy parameters: relative'',                                    '' window(s):'')')
     401             :           ENDIF
     402             :           !--->    energy window
     403             : 
     404             :           !--->    for floating energy parameters, the window will be given relative
     405             :           !--->    to the highest/lowest energy parameters. a sanity check is made here
     406          14 :           IF (obsolete%lepr.EQ.1) THEN
     407           0 :              input%ellow = MIN( input%ellow , -0.2 )
     408           0 :              input%elup  = MAX( input%elup  ,  0.15 )
     409             :           ENDIF
     410             :           !
     411          14 :           WRITE (6,FMT=8350) input%ellow,input%elup,input%zelec
     412             : 8350      FORMAT (1x,/,/,' energy window from',f8.3,' to', f8.3,' hartrees; nr. of electrons=',f6.1)
     413             :           !--->    input of wavefunction cutoffs: input is a scaled quantity
     414             :           !--->    related to the absolute value by rscale (e.g. a muffin-tin
     415             :           !--->    radius)
     416          14 :           WRITE (6,FMT=8290) input%rkmax
     417             : 8290      FORMAT (1x,/,' wavefunction cutoff =',f10.5)
     418             :           !
     419          14 :           IF ((input%tria) .AND. (input%gauss)) THEN
     420           0 :              WRITE (6,FMT='(a)') 'choose: either gaussian or triangular!'
     421           0 :              CALL juDFT_error("integration method",calledby ="inped")
     422             :           END IF
     423          14 :           WRITE (6,FMT=8230) input%gauss,input%delgau
     424          14 :           WRITE (6,FMT=8240) input%zelec,input%tkb
     425             : 8230      FORMAT (/,10x,'gauss-integration is used  =',3x,l1,/,10x, 'gaussian half width        =',f10.5)
     426             : 8240      FORMAT (/,10x,'number of valence electrons=',f10.5,/,10x, 'temperature broadening     =',f10.5)
     427          14 :           WRITE (6,FMT=*) 'itmax=',input%itmax,' broy_sv=',input%maxiter,' imix=',input%imix
     428          14 :           WRITE (6,FMT=*) 'alpha=',input%alpha,' spinf=',input%spinf
     429             :     
     430          14 :           IF ((.NOT.sym%invs).AND.input%secvar) THEN
     431           0 :              WRITE(6,*)'The second variation is not implemented in the'
     432           0 :              WRITE(6,*)'complex version of the program.'
     433           0 :              CALL juDFT_error ("second variation not implemented in complex version" ,calledby ="inped")
     434             :           ENDIF
     435             : 
     436          14 :           IF ( (input%jspins.EQ.1).AND.(input%kcrel.EQ.1) )  THEN
     437           0 :              WRITE (6,*) 'WARNING : in a non-spinpolarized calculation the'
     438           0 :              WRITE (6,*) 'coupled-channel relativistic coreprogram (kcrel=1)'
     439           0 :              WRITE (6,*) 'makes no sense; **** setting kcrel = 0 ****'
     440           0 :              input%kcrel = 0
     441             :           ENDIF
     442             : 
     443          14 :           WRITE (6,'(a7,l1)') 'swsp = ',input%swsp
     444          14 :           WRITE (6,'(15f6.2)') (atoms%bmu(i),i=1,atoms%ntype)
     445          14 :           IF (vacuum%layers>vacuum%layerd)  CALL juDFT_error("too many layers",calledby ="inped")
     446          14 :           IF (sliceplot%slice) THEN
     447           0 :              input%cdinf = .FALSE.
     448           0 :              WRITE (6,FMT=8390) sliceplot%kk,sliceplot%e1s,sliceplot%e2s
     449             :           END IF
     450             : 8390      FORMAT (' slice: k=',i3,' e1s=',f10.6,' e2s=',f10.6)
     451             :           !
     452             :           ! Check the LO stuff:
     453             :           !
     454          46 :           DO n=1,atoms%ntype
     455          46 :              IF (atoms%nlo(n).GE.1) THEN
     456           7 :                 IF (input%secvar)          CALL juDFT_error ("LO + sevcar not implemented",calledby ="inped")
     457           7 :                 IF (atoms%nlo(n).GT.atoms%nlod) THEN
     458           0 :                    WRITE (6,*) 'nlo(n) =',atoms%nlo(n),' > nlod =',atoms%nlod
     459           0 :                    CALL juDFT_error("nlo(n)>nlod",calledby ="inped")
     460             :                 ENDIF
     461          14 :                 DO j=1,atoms%nlo(n)
     462           7 :                    IF (.NOT.input%l_useapw) THEN
     463           7 :                       IF (atoms%llo(j,n).LT.0) THEN ! CALL juDFT_error("llo<0 ; compile with DCPP_APW!",calledby="inped")
     464           0 :                          WRITE(6,'(A)') 'Info: l_useapw not set.'
     465           0 :                          WRITE(6,'(A,I2,A,I2,A)') '      LO #',j,' at atom type',n, ' is an e-derivative.'
     466             :                       ENDIF
     467             :                    ENDIF
     468          14 :                    IF ( (atoms%llo(j,n).GT.atoms%llod).OR.(MOD(-atoms%llod,10)-1).GT.atoms%llod ) THEN
     469           0 :                       WRITE (6,*) 'llo(j,n) =',atoms%llo(j,n),' > llod =',atoms%llod
     470           0 :                       CALL juDFT_error("llo(j,n)>llod",calledby ="inped")
     471             :                    ENDIF
     472             :                 ENDDO
     473           7 :                 CALL setlomap(n, input%l_useapw,atoms)
     474           7 :                 WRITE (6,*) 'atoms%lapw_l(n) = ',atoms%lapw_l(n)
     475             :              ENDIF
     476             :           ENDDO
     477             :           !
     478             :           ! Check for LDA+U:
     479             :           !
     480          14 :           DO i = 1, atoms%n_u
     481           0 :              n = atoms%lda_u(i)%atomType
     482          14 :              IF (atoms%nlo(n).GE.1) THEN
     483           0 :                 DO j = 1, atoms%nlo(n)
     484           0 :                    IF ((ABS(atoms%llo(j,n)).EQ.atoms%lda_u(i)%l) .AND. (.NOT.atoms%l_dulo(j,n)) ) &
     485           0 :                         WRITE (*,*) 'LO and LDA+U for same l not implemented'
     486             :                 END DO
     487             :              END IF
     488             :           END DO
     489          14 :           IF (atoms%n_u.GT.0) THEN
     490           0 :              IF (input%secvar)          CALL juDFT_error ("LDA+U and sevcar not implemented",calledby ="inped")
     491           0 :              IF (noco%l_mperp)         CALL juDFT_error ("LDA+U and l_mperp not implemented",calledby ="inped")
     492             :           ENDIF
     493             :           !
     494             :           !     check all the dos-related switches!
     495             :           !
     496          14 :           IF (banddos%ndir.LT.0.AND..NOT.banddos%dos) THEN
     497           0 :              CALL juDFT_error('STOP banddos: the inbuild dos-program  <0 can only be used if dos = true',calledby ="inped")
     498             :           ENDIF
     499             : 
     500          14 :           IF (banddos%ndir.LT.0.AND.banddos%dos) THEN
     501           4 :              IF (banddos%e1_dos-banddos%e2_dos.LT.1e-3) THEN
     502           0 :                 CALL juDFT_error("STOP banddos: no valid energy window for internal dos-program",calledby ="inped")
     503             :              ENDIF
     504           4 :              IF (banddos%sig_dos.LT.0) THEN
     505           0 :                 CALL juDFT_error ("STOP DOS: no valid broadening (sig_dos) for internal dos-PROGRAM",calledby ="inped")
     506             :              ENDIF
     507             :           ENDIF
     508             : 
     509          14 :           IF (banddos%vacdos) THEN
     510           0 :              IF (.NOT. banddos%dos) THEN
     511           0 :                 CALL juDFT_error ("STOP DOS: only set vacdos = .true. if dos = .true." ,calledby ="inped")
     512             :              ENDIF
     513           0 :              IF (.NOT.vacuum%starcoeff.AND.(vacuum%nstars.NE.1))THEN
     514           0 :                 CALL juDFT_error("STOP banddos: if stars = f set vacuum=1" ,calledby ="inped")
     515             :              ENDIF
     516           0 :              IF (vacuum%layers.LT.1) THEN
     517           0 :                 CALL juDFT_error("STOP DOS: specify layers if vacdos = true" ,calledby ="inped")
     518             :              ENDIF
     519           0 :              DO i=1,vacuum%layers
     520           0 :                 IF (vacuum%izlay(i,1).LT.1) THEN
     521           0 :                    CALL juDFT_error("STOP DOS: all layers must be at z>0" ,calledby ="inped")
     522             : 
     523             :                 ENDIF
     524             :              ENDDO
     525             :           ENDIF
     526             : 
     527          14 :           RETURN
     528             :         END SUBROUTINE inped
     529             : !--------------------------------------------------------------
     530           0 :       SUBROUTINE trans(string, str_up,str_do)
     531             : 
     532             :       IMPLICIT NONE
     533             :       CHARACTER(len=2), INTENT(IN)  :: string
     534             :       CHARACTER(len=2), INTENT(OUT) :: str_up,str_do
     535             : 
     536             :       INTEGER offs,i,n
     537             :       CHARACTER(len=2) :: str_in
     538             :       CHARACTER(len=1) :: st(2)
     539             : 
     540           0 :       str_up='  ' ; str_do='  ' ; st(:)=' '
     541           0 :       offs = IACHAR('A') - IACHAR('a')
     542           0 :       str_in = TRIM(ADJUSTL(string))
     543           0 :       n = LEN_TRIM(str_in)
     544           0 :       st = (/(str_in(i:i),i=1,n)/)
     545           0 :       DO i=1,n
     546           0 :         IF (IACHAR(st(i)) > IACHAR('Z')) THEN ! lowercase
     547           0 :           str_up(i:i) = CHAR( IACHAR(st(i)) + offs)
     548             :         ELSE
     549           0 :           str_up(i:i) = st(i)
     550             :         ENDIF
     551             :       ENDDO
     552           0 :       DO i=1,n
     553           0 :         str_do(i:i) = CHAR( IACHAR(str_up(i:i)) - offs)
     554             :       ENDDO
     555           0 :       END SUBROUTINE trans
     556             : 
     557             :       END MODULE

Generated by: LCOV version 1.13