LCOV - code coverage report
Current view: top level - inpgen - lapw_input.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 48 109 44.0 %
Date: 2019-09-08 04:53:50 Functions: 1 2 50.0 %

          Line data    Source code
       1             :       MODULE m_lapwinput      
       2             :       use m_juDFT
       3             : !-----------------------------------------------------------------------
       4             : ! read in some lapw-specific input or set appropriate defauts
       5             : !-----------------------------------------------------------------------
       6             :       INTEGER, PARAMETER  :: dbgfh=6, errfh=6, warnfh=6
       7             : 
       8             :       CONTAINS
       9           3 :       SUBROUTINE lapw_input(
      10           3 :      >                      infh,nline,xl_buffer,bfh,buffer,
      11             :      <                      jspins,kcrel,ndvgrd,nkpt,div,kPointDensity,
      12             :      <                      frcor,ctail,chng,tria,kmax,gmax,gmaxxc,
      13             :      <                      dvac,dtild,tkb,namex,relcor)
      14             :      
      15             :       USE m_readrecord
      16             :       IMPLICIT NONE
      17             : 
      18             :       INTEGER, INTENT (IN)  :: xl_buffer,infh,bfh
      19             :       INTEGER, INTENT (OUT) :: jspins,kcrel,ndvgrd,nkpt,div(3)
      20             :       LOGICAL, INTENT (OUT) :: frcor,ctail,tria
      21             :       REAL,    INTENT (OUT) :: kmax,gmax,gmaxxc,tkb,chng
      22             :       REAL,    INTENT (OUT) :: kPointDensity(3)
      23             :       REAL,    INTENT (INOUT) :: dvac,dtild
      24             :       CHARACTER(len=4), INTENT (OUT) :: namex
      25             :       CHARACTER(len=12),INTENT (OUT) :: relcor
      26             :       CHARACTER(len=xl_buffer)       :: buffer
      27             :       
      28             :       INTEGER iflag,div1,div2,div3,nline,nbuffer,ios
      29             :       REAL den, denX, denY, denZ
      30             :       LOGICAL h_film,h_comp,h_exco,h_kpt,fatalerror,relxc
      31             :       CHARACTER(len=4) :: xctyp
      32             : 
      33             : !---> namelists for input
      34             :       NAMELIST /comp/   jspins, frcor, ctail, kcrel, 
      35             :      &                  gmax, gmaxxc, kmax
      36             :       NAMELIST /exco/   xctyp, relxc 
      37             :       NAMELIST /film/   dvac, dtild
      38             :       NAMELIST /kpt/    nkpt,div1,div2,div3,tkb,tria,den,denX,denY,denZ
      39             : 
      40             : 
      41           3 :       h_film=.false. ; h_comp=.false.
      42           3 :       h_exco=.false. ; h_kpt=.false.
      43           3 :       fatalerror=.false.
      44             :                         ! jspins, gmax, gmaxxc, kmax were set before
      45           3 :       frcor  = .false.  ! no frozen core
      46           3 :       ctail  = .true.   ! always core-tail correction
      47           3 :       kcrel = 0         ! no fully-magnetic dirac core
      48             : 
      49           3 :       relcor = 'non-relativi'
      50           3 :       namex = 'pbe '
      51           3 :       ndvgrd = 6 ; chng= -1.0e-12 
      52           3 :       nkpt = 0 ; div = 0 
      53           3 :       tkb = 0.001 ; tria = .false.
      54           3 :       kPointDensity = 0.0
      55             :  
      56             : 
      57             : !===> read input
      58             : 
      59           3 :       nbuffer = len_trim(buffer)
      60             : 
      61           2 :       loop: DO
      62             : 
      63           5 :       IF (nbuffer == 0) then
      64           0 :         DO
      65           2 :           CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
      66           2 :           IF (ios==1) GOTO 999
      67           1 :           IF (ios == 2)  CALL juDFT_error
      68             :      +         ("end of file while reading a record",calledby
      69           0 :      +         ="lapw_input")
      70           1 :           IF (buffer(1:1)=='&') EXIT
      71           0 :           CALL err(0)
      72           1 :           fatalerror = .true.
      73             :         ENDDO
      74             :       ENDIF
      75             : 
      76             : !===> comp
      77           4 :       IF (buffer(1:5)=='&comp') THEN
      78           1 :         IF (h_comp) CALL err(1)
      79             :          
      80           1 :         READ (bfh,comp,err=912, end=912, iostat=ios)
      81           1 :         h_comp = .true.
      82           1 :         IF (jspins>2 .OR. jspins<1)  CALL juDFT_error
      83           0 :      +       ("jspins>2 .OR. jspins<",calledby ="lapw_input")
      84           1 :         IF (kcrel <0 .or. kcrel >1)  CALL juDFT_error
      85           0 :      +       ("kcrel <0 .or. kcrel >1",calledby ="lapw_input")
      86             : 
      87             : !===> exco
      88           3 :       ELSEIF (buffer(1:5)=='&exco') THEN
      89           0 :         IF (h_exco) CALL err(1)
      90             :         
      91           0 :         READ (bfh,exco,err=912, end=912, iostat=ios)
      92           0 :         h_exco = .true.
      93             : 
      94           0 :         iflag=-9999
      95             :        IF ((xctyp == 'l91 ').OR.(xctyp == 'xa  ').OR.(xctyp == 'wign').
      96             :      &  OR.(xctyp == 'hl  ').OR.(xctyp == 'bh  ').OR.(xctyp == 'mjw ').
      97           0 :      &  OR.(xctyp == 'vwn ').OR.(xctyp == 'pz  ') ) iflag=1
      98             : 
      99             :        IF ((xctyp == 'pw91').OR.(xctyp == 'pbe ').OR.(xctyp == 'rpbe').
     100           0 :      &  OR.(xctyp == 'Rpbe').OR.(xctyp == 'wc  ') ) iflag=2
     101             :         
     102           0 :        IF (iflag < -1 )  CALL juDFT_error("error reading lda/gga",
     103           0 :      +      calledby="lapw_input")
     104             : 
     105           0 :         namex = xctyp
     106           0 :         IF (relxc) relcor = 'relativistic'
     107             : 
     108           0 :         IF (iflag==2) THEN
     109             :         ELSE
     110           0 :           ndvgrd = 0 ; chng= 0.0
     111             :         ENDIF
     112             : 
     113             : !===> film
     114           3 :       ELSEIF (buffer(1:5)=='&film') THEN
     115           0 :         IF (h_film) CALL err(1)
     116             : 
     117           0 :         READ (bfh,film,err=912, end=912, iostat=ios)
     118           0 :         h_film=.true.
     119           0 :         IF (dvac > dtild)  CALL juDFT_error("dvac > dtild",calledby
     120           0 :      +       ="lapw_input")
     121             : 
     122             : !===> kpt
     123           3 :       ELSEIF (buffer(1:4)=='&kpt') THEN
     124           1 :         IF (h_kpt) CALL err(1)
     125             : 
     126           1 :         div1 = 0 ; div2 = 0 ; div3 = 0
     127           1 :         denX = 0.0 ; denY = 0.0 ; denZ = 0.0
     128           1 :         den = 0.0
     129             : 
     130           1 :         READ (bfh,kpt,err=912, end=912, iostat=ios)
     131           1 :         h_kpt=.true.
     132           1 :         div(1) = div1 ; div(2) = div2 ; div(3) = div3
     133           1 :         IF (den.NE.0.0) THEN
     134           0 :            IF (denX.EQ.0.0) denX = den
     135           0 :            IF (denY.EQ.0.0) denY = den
     136           0 :            IF (denZ.EQ.0.0) denZ = den
     137             :         END IF
     138           1 :         kPointDensity(1) = denX
     139           1 :         kPointDensity(2) = denY
     140           1 :         kPointDensity(3) = denZ
     141             : 
     142             : !===> end
     143           2 :       ELSEIF (buffer(1:4)=='&end') THEN
     144           2 :         WRITE (dbgfh,*) 'end of input record in line:',nline
     145           2 :         EXIT loop
     146             : 
     147             : !===> atom, allatoms
     148           0 :       ELSEIF (buffer(1:5)=='&atom' .OR.
     149             :      &        buffer(1:9)=='&allatoms') THEN
     150           0 :         WRITE(errfh,*) 'buffer ',buffer(1:9),
     151           0 :      &       ' out of place in line:',nline
     152           0 :         fatalerror = .true.
     153             : 
     154             : !===> unknown namelist
     155             :       ELSE
     156           0 :           call err(2)
     157             :       ENDIF
     158             : !===>
     159           3 :       nbuffer = 0
     160             : 
     161             :       ENDDO loop
     162             : 
     163             :  999  CONTINUE
     164           3 :       IF (fatalerror) 
     165             :      &     CALL juDFT_error
     166             :      +     ("ERROR(S) reading input. Check output for details.",calledby
     167           0 :      +     ="lapw_input")
     168             : 
     169           3 :       RETURN
     170             : 
     171             : !===> error handling
     172             : 
     173             :  911  CONTINUE
     174             :       WRITE (errfh,*) 'atom_input: ERROR reading input. ios  =',ios,
     175             :      &               ', line =',nline
     176             :       CALL juDFT_error("atom_input: ERROR reading input",calledby
     177             :      +     ="lapw_input")
     178             : 
     179             :  912  CONTINUE
     180           0 :       WRITE (errfh,*) 'atom_input: ERROR reading namelist.',
     181           0 :      &               ' ios =',ios,
     182           0 :      &               ' line =',nline
     183           0 :       WRITE (errfh,*) buffer(1:nbuffer)
     184           0 :       WRITE (errfh,*) 'The cause of this error may be ...'
     185           0 :       WRITE (errfh,*) '        a variable not defined in this namelist,'
     186           0 :       WRITE (errfh,*) '        wrong type of data for a variable.'
     187             :       CALL juDFT_error("atom_input: ERROR reading input",calledby
     188           0 :      +     ="lapw_input")
     189             : 
     190             :  913  CONTINUE
     191           0 :       WRITE (errfh,*) 'atom_input: ERROR reading record.',
     192           0 :      &               ' ios =',ios,
     193           0 :      &               ' line =',nline
     194           0 :       WRITE (errfh,*) buffer(1:nbuffer)
     195             :       CALL juDFT_error("atom_input: ERROR reading input",calledby
     196           0 :      +     ="lapw_input")
     197             : 
     198             : !----------------------------------------------------------------
     199             :       CONTAINS   ! INTERNAL subroutines
     200             : !----------------------------------------------------------------
     201           0 :       SUBROUTINE err( n )
     202             : 
     203             :       INTEGER, INTENT (IN) :: n
     204             : 
     205           0 :       WRITE(errfh,*)
     206           0 :       IF (n==1) THEN
     207           0 :         WRITE (errfh,*) 'atom_input: ERROR multiple namelists.',
     208           0 :      &               ' line =',nline
     209           0 :       ELSEIF (n==2) THEN
     210           0 :         WRITE (errfh,*) 'atom_input: ERROR unknown namelist.',
     211           0 :      &               ' line =',nline
     212           0 :       ELSEIF (n==3) THEN
     213           0 :         WRITE (errfh,*) 'atom_input: ERROR reading namelist.',
     214           0 :      &               ' line =',nline
     215             :       ELSE
     216           0 :         WRITE (errfh,*) 'atom_input: ERROR reading input.',
     217           0 :      &               ' line =',nline
     218             :       ENDIF
     219           0 :       WRITE (errfh,*) buffer(1:nbuffer)
     220           0 :       WRITE (errfh,*)
     221           0 :       fatalerror = .true.
     222           0 :       RETURN
     223             :       END SUBROUTINE err
     224             : 
     225             :       END SUBROUTINE lapw_input
     226             :       END MODULE m_lapwinput      

Generated by: LCOV version 1.13