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

          Line data    Source code
       1             :       MODULE m_structinput
       2             :       use m_juDFT
       3             : !********************************************************************
       4             : !     read in lattice information and generate space group operations
       5             : !********************************************************************
       6             :       CONTAINS
       7           3 :       SUBROUTINE struct_input( 
       8             :      >                        infh,errfh,warnfh,symfh,symfn,bfh,
       9             :      >                        natmax,nop48,
      10           3 :      X                        nline,xl_buffer,buffer,
      11             :      <                        title,film,cal_symm,checkinp,symor,
      12             :      <                    cartesian,oldfleur,a1,a2,a3,dvac,aa,scale,i_c,
      13           6 :      <                       factor,natin,atomid,atompos,ngen,mmrot,ttr,
      14           3 :      <                       atomLabel,
      15             :      <                        l_hyb,l_soc,l_ss,theta,phi,qss,inistop)
      16             : 
      17             :       use m_calculator
      18             :       USE m_readrecord
      19             :       USE m_rwsymfile
      20             :       USE m_lattice, ONLY : lattice2
      21             :       IMPLICIT NONE
      22             : 
      23             : !===> Arguments
      24             :       INTEGER, INTENT (IN)    :: infh, errfh,  warnfh, symfh,bfh
      25             :       INTEGER, INTENT (IN)    :: natmax, nop48, xl_buffer
      26             :       INTEGER, INTENT (INOUT)  :: nline
      27             :       CHARACTER(len=xl_buffer) :: buffer
      28             :       LOGICAL                 :: cal_symm, checkinp, symor, film
      29             :       LOGICAL                 :: cartesian,oldfleur,inistop
      30             :       LOGICAL, INTENT (OUT)   :: l_hyb,l_soc,l_ss
      31             :       INTEGER, INTENT (OUT)   :: natin,i_c
      32             :       INTEGER, INTENT (OUT)   :: ngen
      33             :       REAL,    INTENT (OUT)   :: aa,theta,phi
      34             :       REAL,    INTENT (OUT)   :: dvac
      35             :       REAL,    INTENT (OUT)   :: a1(3),a2(3),a3(3)
      36             :       REAL,    INTENT (OUT)   :: scale(3),factor(3),qss(3)
      37             :       REAL,    INTENT (OUT)   :: atompos(3,natmax)
      38             :       REAL,    INTENT (OUT)   :: atomid(natmax)
      39             :       INTEGER, INTENT (OUT)   :: mmrot(3,3,nop48)
      40             :       REAL,    INTENT (OUT)   :: ttr(3,nop48)
      41             :       CHARACTER(len=80), INTENT (OUT) :: title
      42             :       CHARACTER(len=7),  INTENT (IN)  :: symfn
      43             :       CHARACTER(LEN=20), INTENT (OUT) :: atomLabel(natmax)
      44             : 
      45             : !===> data
      46             :       REAL,             PARAMETER :: eps=1.e-7
      47             :       CHARACTER(len=1), PARAMETER :: cops(-1:3)=(/'2','3','4','6','1'/)
      48             : 
      49             : !===> Local Variables
      50             :       INTEGER :: n, ng, op, nbuffer, ios,nop2, i, j
      51             :       REAL    :: shift(3),rdummy(3,3),z_max,z_min,mat(3,3),x(3), rest
      52             :       LOGICAL :: oldfleurset,l_symfile,l_gen,hybrid
      53             :       CHARACTER(len=10)        :: chtmp
      54             :       CHARACTER(len=3)         :: ch_test
      55             : !===> namelists
      56             :       NAMELIST /input/ film, cartesian, cal_symm, checkinp, inistop,
      57             :      &                 symor, oldfleur, hybrid
      58             : 
      59             : !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      60             : 
      61             : !--->    set defaults
      62           3 :       film      = .false.   ! bulk calculation is default
      63             : 
      64           3 :       cartesian = .false.   ! read in atomic positions 
      65             :                             ! in either lattice units (.false.)
      66             :                             ! or scaled cartesian coordinates (.true.)
      67             : 
      68           3 :       cal_symm  = .true.    ! calculate space group symmetry    (.true.)
      69             :                             ! read in space group symmetry info (.false.)
      70             : 
      71           3 :       checkinp  = .false.   ! =T program reads input and stops
      72             :       
      73           3 :       inistop = .FALSE.     ! = T program stops after strho,swsp,flip
      74             : 
      75           3 :       op = -911             ! =1 => checkinp=t
      76             :                             ! =2 => inistop=t
      77             :                             ! =4 => itmax=0
      78             : 
      79           3 :       oldfleur  = .true.    ! =T fleur21 compatibility
      80             : 
      81           3 :       symor     = .false.   ! =T select the largest symmorphic subgroup
      82             : 
      83           3 :       hybrid    = .false.   ! =T create inp file for hybrid functionals, too
      84           3 :       l_ss      = .false.   ! =T spin-spiral calculation ... may affect
      85           3 :       l_soc     = .false.   ! =T spin-orbit interaction ... the symmetry
      86             : 
      87          12 :       factor(:) = 1.0
      88           3 :       theta = 0.0 ; phi = 0.0
      89           3 :       qss(:) = (/0.0,0.0,0.0/)
      90           3 :       mat = 0.0
      91             : !initialize the calculator
      92           0 :       DO
      93           3 :          READ (UNIT = infh,FMT = "(a3)",iostat=ios) ch_test
      94           3 :          if (ios.ne.0) exit
      95           3 :          BACKSPACE(infh)
      96           3 :          IF (ch_test   /="def") EXIT
      97           0 :          READ(unit = infh,FMT="(4x,a)") buffer
      98           0 :          n = INDEX(buffer,"=")
      99           0 :          IF (n == 0.OR.n>len_TRIM(buffer)-1) STOP
     100           0 :      $        "Error in variable definitions"
     101           3 :          CALL ASSIGN_var(buffer(:n-1),evaluate(buffer(n+1:)))
     102             :       ENDDO
     103           3 :       backspace(infh)
     104             : 
     105             : 
     106             : !===> start reading input
     107             : 
     108             :       CALL read_record(
     109             :      >                 infh,xl_buffer,bfh,
     110             :      X                 nline,
     111           3 :      <                 nbuffer,buffer,ios )
     112             : 
     113           3 :       READ (buffer,'(a)') title
     114             : 
     115           3 :       IF ( buffer(1:1) == '&' ) THEN         ! already read some input
     116           0 :         title = 'unnamed project'
     117             :       ELSE   
     118           3 :         CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     119             :       ENDIF
     120             : 
     121           3 :       oldfleurset = .FALSE.
     122           3 :       l_hyb = .FALSE.
     123           3 :       IF ( buffer(1:6)=='&input' ) THEN      ! get namelist 'input'
     124           3 :         READ (bfh,input)
     125           3 :         l_hyb       = hybrid
     126           3 :         IF ( index(buffer,'oldfleur')>0 ) oldfleurset = .true.
     127           3 :         op = 0 
     128             :         IF ( op > 0 ) THEN
     129             :           IF ( btest(op,0) ) checkinp = .true.
     130             :           IF ( BTEST(op,1) ) inistop  = .TRUE.
     131             :           IF ( btest(op,2) ) WRITE (6,*) 'action N/A'
     132             : !dbg+
     133             :           IF ( btest(op,0) ) WRITE (6,*) 'bit 0 set'
     134             :           IF ( btest(op,1) ) WRITE (6,*) 'bit 1 set'
     135             :           IF ( btest(op,2) ) WRITE (6,*) 'bit 2 set'
     136             : !dbg-
     137             :         ENDIF
     138             : 
     139           3 :         CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     140             :       ENDIF
     141             : 
     142           3 :       IF ( buffer(1:1) == '&' ) THEN
     143             : 
     144           0 :         IF ( buffer(1:8)=='&lattice' ) THEN
     145             :           CALL lattice2( 
     146             :      >                  buffer,xl_buffer,errfh,bfh,nline,
     147           0 :      <                  a1,a2,a3,aa,scale,mat,i_c,ios )
     148           0 :           dvac = 0.00
     149           0 :           IF ( ios.NE.0 ) THEN
     150           0 :             WRITE (errfh,*)
     151           0 :             WRITE (errfh,*) 'struct_input: ERROR! ',
     152           0 :      &                   'while reading &lattice in line',nline,'.'
     153           0 :             WRITE (errfh,*)
     154             :             CALL juDFT_error("ERROR! while reading &lattice",calledby
     155           0 :      +           ="struct_input")
     156             :           ENDIF
     157             :         ELSE
     158           0 :           WRITE(errfh,*)
     159           0 :           WRITE(errfh,*) 'struct_input: ERROR! line',nline,'.'
     160             :           WRITE(errfh,*)
     161           0 :      &     'Expecting either namelist &lattice or dircet lattice input.'
     162           0 :           WRITE (errfh,*)
     163             :           CALL juDFT_error("ERROR! Cannot find lattice info.",calledby
     164           0 :      +         ="struct_input")
     165             :         ENDIF
     166             : 
     167             :       ELSE
     168             : 
     169             : !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     170             : !--->    title:
     171             : !        cannot begin with an & and should not contain an !
     172             : !
     173             : !--->    lattice vectors:
     174             : !--->
     175             : !--->    lattice vectors are input in scaled cartesian coordinates:
     176             : !--->
     177             : !--->    the overall scale is set by aa and scale(:) as follows:
     178             : !--->    assume that we want the lattice vectors to be given by
     179             : !--->      a_i = ( a_i(1) xa , a_i(2) xb , a_i(3) xc )
     180             : !--->    then choose aa, scale such that: xa = aa * scale(1), etc.
     181             : !--->    to make it easy to input sqrts, if scale(i)<0, then
     182             : !--->    scale = sqrt(|scale|)
     183             : !--->    Example: hexagonal lattice
     184             : !           a1 = ( sqrt(3)/2 a , -1/2 a , 0.      )
     185             : !           a2 = ( sqrt(3)/2 a ,  1/2 a , 0.      )
     186             : !           a3 = ( 0.          , 0.     , c=1.62a )
     187             : !
     188             : !        input:
     189             : !            0.5  -0.5  0.0     ! a1
     190             : !            0.5   0.5  0.0     ! a2
     191             : !            0.0   0.0  1.0     ! a3
     192             : !           6.2                 ! lattice constant
     193             : !          -3.0   0.0   1.62    ! scale(2) is 1 by default
     194             : 
     195             : !--->    read in (scaled) lattice vectors (and dvac, if present)
     196             : 
     197             :          !READ (buffer,*) a1
     198           3 :          a1(1)=evaluatefirst(buffer)
     199           3 :          a1(2)=evaluatefirst(buffer)
     200           3 :          a1(3)=evaluatefirst(buffer)
     201           3 :          CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     202             :          !READ (buffer,*) a2
     203           3 :          a2(1)=evaluatefirst(buffer)
     204           3 :          a2(2)=evaluatefirst(buffer)
     205           3 :          a2(3)=evaluatefirst(buffer)
     206           3 :          CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     207             :          !READ (buffer,*, err=811,end=811, iostat=ios) a3, dvac
     208           3 :          a3(1)=evaluatefirst(buffer)
     209           3 :          a3(2)=evaluatefirst(buffer)
     210           3 :          a3(3)=evaluatefirst(buffer)
     211           3 :          dvac=evaluatefirst(buffer)
     212           3 :          IF (film.AND.(dvac <= 0.00)) THEN
     213           0 :             WRITE(*,*)'Film calculation but no reasonable dVac provided'
     214           0 :             WRITE(*,*)'Setting default for dVac'
     215           0 :             dvac = ABS(a3(3)) ! This is later set to the real default by the chkmt result
     216             :          END IF
     217             :  811     CONTINUE              ! obviously no film calculation
     218             :          !READ(buffer,*) a3
     219             : 
     220             : !--->    read in overall lattice constant
     221             : 
     222           3 :          CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     223             :          !READ (buffer,*) aa
     224           3 :          aa=evaluatefirst(buffer)
     225             : 
     226             : !--->    read in scale
     227           3 :          scale = 0.00
     228           3 :          CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     229             :          !READ (buffer,*) scale
     230           3 :          scale(1)=evaluatefirst(buffer)
     231           3 :          scale(2)=evaluatefirst(buffer)
     232           3 :          scale(3)=evaluatefirst(buffer)
     233             :          
     234             :       ENDIF ! &lattice ...
     235             : 
     236             : !===>    program configuration
     237             : !     if oldfleur was not set in the input, set it here, dependent on 
     238             : !     film/bulk calculation
     239             : 
     240           3 :       IF ( .not.oldfleurset ) THEN
     241           3 :         oldfleur = .false.
     242           3 :         IF ( film ) oldfleur = .true.
     243             :       ENDIF
     244             : 
     245             : !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     246             : !--->    atomic positions:
     247             : !--->
     248             : !--->    atomic positions input can be either in scaled cartesian
     249             : !--->    or lattice vector units, as determined by logical cartesian.
     250             : !--->    (for supercells, sometimes more natural to input positions
     251             : !--->    in scaled cartesian.)
     252             : !--->
     253             : !--->    if ntin < 0, then the representative atoms only are given;
     254             : !--->    this requires that the space group symmetry be given as input.
     255             : 
     256             : !--->    read in number of atoms or types
     257             : 
     258           3 :       CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     259             :       !READ (buffer,*) natin
     260           3 :       natin=evaluatefirst(buffer)
     261             : !--->    read in atomic positions
     262             : !--->    and atomic identification number (atomid)
     263             : !--->    to distinguish different atom types. 
     264             : !--->    (atomid is used later as default for atom Z value (zatom)
     265             : 
     266           9 :       DO n = 1, abs(natin)
     267           6 :         CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     268             :         !READ (buffer,*) atomid(n), atompos(:,n)
     269           6 :         atomid(n)=evaluatefirst(buffer)
     270           6 :         atompos(1,n)=evaluatefirst(buffer)
     271           6 :         atompos(2,n)=evaluatefirst(buffer)
     272           6 :         atompos(3,n)=evaluatefirst(buffer)
     273           6 :         IF(TRIM(ADJUSTL(buffer)).NE.'') THEN
     274           0 :            atomLabel(n) = TRIM(ADJUSTL(buffer))
     275             :         ELSE
     276           6 :            WRITE(atomLabel(n),'(i0)') n
     277             :         END IF
     278         477 :         DO i = 2,40
     279        1644 :            DO j = 1, 3
     280         702 :               rest = ABS(i*atompos(j,n) - NINT(i*atompos(j,n)))
     281         936 :               IF (rest.LT.(i*0.000001)) THEN
     282          90 :                  atompos(j,n) = NINT(i*atompos(j,n)) / real(i)
     283             :               END IF
     284             :            END DO
     285             :         END DO
     286             :       ENDDO
     287             : 
     288           3 :       CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     289             : 
     290           3 :       IF ( buffer(1:6)=='&shift') then
     291           0 :         buffer = buffer(7:len_trim(buffer)-1)
     292           0 :         shift = -911.0
     293           0 :         READ (buffer,*, err=821,end=821, iostat=ios) shift
     294             :  821    CONTINUE
     295           0 :         READ (buffer,*) shift(1)
     296           0 :         IF ( shift(3)<-900.0 ) shift(3) = shift(1)
     297           0 :         IF ( shift(2)<-900.0 ) shift(2) = shift(1)
     298           0 :         DO n = 1, 3
     299           0 :           atompos(n,1:abs(natin)) = atompos(n,1:abs(natin))+shift(n)
     300             :         ENDDO
     301             :         
     302           0 :         CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     303             :       ENDIF
     304             : 
     305           3 :       IF ( buffer(1:7)=='&factor') THEN
     306           0 :         buffer = buffer(8:len_trim(buffer)-1)
     307           0 :         factor = -911.0 
     308           0 :         READ (buffer,*, err=831,end=831, iostat=ios) factor
     309             :  831    CONTINUE
     310           0 :         READ (buffer,*) factor(1)
     311           0 :         IF ( factor(3)<-900.0 ) factor(3) = factor(1)
     312           0 :         IF ( factor(2)<-900.0 ) factor(2) = factor(1)
     313           0 :         DO n = 1, 3
     314           0 :           atompos(n,1:abs(natin)) = atompos(n,1:abs(natin))/factor(n)
     315             :         ENDDO
     316             :         
     317           0 :         CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     318             :       ENDIF
     319             : 
     320           3 :       IF ( buffer(1:1).NE.'&') THEN
     321           0 :         WRITE (warnfh,*)
     322           0 :         WRITE (warnfh,*) 'struct_input: WARNING! ',
     323           0 :      &       'Number of atoms to small or too many atoms in list?.'
     324           0 :         WRITE (warnfh,*)
     325             :       ENDIF
     326             : 
     327           3 :       IF (abs(mat(1,1)).GT.0.0000001) THEN ! transform hex->trig
     328           0 :         CALL recip(a1,a2,a3,rdummy)
     329           0 :         DO n = 1, abs(natin)
     330             : !          CALL cotra0(atompos(1,n),x,mat)
     331           0 :           x = matmul(mat,atompos(:,n))
     332           0 :           write(*,'(3f10.5)') x(1:3)
     333           0 :           write(*,'(3f10.5)') rdummy
     334             : !          CALL cotra1(x,atompos(1,n),rdummy)
     335           0 :           atompos(:,n) = matmul(rdummy,x)
     336           0 :           write(*,'(3f10.5)') atompos(1:3,n)
     337             :         ENDDO
     338           0 :         i_c = 1
     339             :       ENDIF
     340             : 
     341           3 :       IF (film) THEN
     342             : 
     343           0 :         z_max = MAXVAL( atompos(3,1:abs(natin)) )  ! check the outmost atomic position
     344           0 :         z_min = MINVAL( atompos(3,1:abs(natin)) )  
     345           0 :         z_max = 2 * (MAX(z_max,-z_min) + 3.0)      ! how much space do we need in z-dir.
     346           0 :         a3(3) = MAX( a3(3), z_max/(aa*scale(3)) )  ! adjust a3(3) so that it fits
     347             : 
     348           0 :         IF(.NOT.cartesian) THEN
     349             :            atompos(3,1:abs(natin)) =                  ! rescale to internal coordinates
     350           0 :      +     atompos(3,1:abs(natin))/(a3(3)*aa*scale(3))
     351             :         END IF
     352             : 
     353             :       ENDIF
     354             : 
     355             : !===> read symmetry from file or from namelist
     356             : 
     357           3 :       INQUIRE ( file=trim(symfn), exist=l_symfile )
     358             : 
     359           3 :       IF ( l_symfile ) THEN
     360             : 
     361           0 :         WRITE (6,*) 'DBG: l_symfile=',l_symfile
     362             :         CALL rw_symfile(
     363             :      >                  'r',symfh,symfn,nop48,rdummy,
     364           0 :      X                   mmrot,ttr,ngen,nop2,symor)
     365           0 :         cal_symm = .false.
     366             : 
     367             :       ELSE
     368             : 
     369           3 :         l_gen = .false.
     370           3 :         IF ( buffer(1:4)=='&gen' ) l_gen = .true.
     371             : 
     372           3 :         IF ( buffer(1:4)=='&gen' .or.
     373             :      &       buffer(1:4)=='&sym'     ) THEN
     374             : 
     375           0 :           WRITE (6,*) 'DBG: &sym=',buffer(1:4)
     376             : 
     377           0 :           buffer  = ADJUSTL(buffer(5:nbuffer))
     378           0 :           nbuffer = LEN_TRIM(buffer)
     379             : 
     380           0 :           READ (buffer,*,err=913, end=913, iostat=ios) ngen
     381           0 :           n = scan(buffer,' ')
     382           0 :           IF ( n>0 ) buffer = buffer(n+1:nbuffer)
     383           0 :           buffer  = adjustl(buffer(1:nbuffer))
     384           0 :           nbuffer = len_trim(buffer)
     385             :           READ (buffer,*,err=913, end=913, iostat=ios) 
     386           0 :      &         ( mmrot(1,1,n),mmrot(1,2,n),mmrot(1,3,n),ttr(1,n),
     387           0 :      &           mmrot(2,1,n),mmrot(2,2,n),mmrot(2,3,n),ttr(2,n),
     388           0 :      &           mmrot(3,1,n),mmrot(3,2,n),mmrot(3,3,n),ttr(3,n),
     389           0 :      &           n = 2, ngen+1 )
     390             : 
     391           0 :         cal_symm = .false.
     392             : 
     393           0 :         CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     394             : 
     395             :         ENDIF ! &gen or &sym
     396             : 
     397             :       ENDIF ! from_symfile
     398           3 :       IF ( buffer(1:4)=='&soc' ) THEN
     399           0 :          l_soc=.true. 
     400           0 :          buffer  = ADJUSTL(buffer(5:nbuffer))
     401           0 :          nbuffer = LEN_TRIM(buffer)
     402           0 :          READ (buffer,*,err=913, end=913, iostat=ios) theta,phi
     403           0 :          CALL read_record(infh,xl_buffer,bfh,nline,nbuffer,buffer,ios)
     404             :       ENDIF
     405           3 :       IF ( buffer(1:4)=='&qss' ) THEN
     406           0 :          l_ss=.true.
     407           0 :          buffer  = ADJUSTL(buffer(5:nbuffer))
     408           0 :          nbuffer = LEN_TRIM(buffer)
     409           0 :          READ (buffer,*,err=913,end=913,iostat=ios) qss(1),qss(2),qss(3)
     410             :       ENDIF
     411             : 
     412             : 
     413           3 :       IF ( .not.cal_symm ) THEN   ! &gen or &sym
     414             : 
     415             : !---> make sure idenity is first operation          
     416           0 :         mmrot(:,:,1) = reshape((/ 1,0,0, 0,1,0, 0,0,1 /),(/ 3,3 /))
     417           0 :         ttr(:,1) = 0.0
     418             : 
     419           0 :         DO ng = 2, ngen + 1
     420           0 :           IF ( all( mmrot(:,:,ng)==mmrot(:,:,1) ) .AND.          ! identity was entered 
     421           0 :      &         all( abs( ttr(:,ng)-ttr(:,1) ) < eps ) ) THEN     ! explicitely as matrix 'ng'
     422           0 :             DO n = ng, ngen
     423           0 :               mmrot(:,:,n) = mmrot(:,:,n+1)                      ! shift by '-1' & exit
     424           0 :               ttr(:,n)     = ttr(:,n+1) 
     425             :             ENDDO
     426           0 :             ngen = ngen - 1
     427           0 :             EXIT
     428             :           ENDIF
     429             :         END DO
     430             : 
     431           0 :         IF ( l_gen ) mmrot(1,1,1) = 0 ! is used later to distinguish
     432             :                                       ! between generators and full group
     433             : 
     434           0 :         WRITE (6,*) 'DBG: mmrot(1,1,1)=',mmrot(1,1,1)
     435             : 
     436             :       ENDIF ! .not.cal_symm
     437             : 
     438           3 :       RETURN
     439             : 
     440             :  912  CONTINUE
     441             :       WRITE (errfh,*) 'struct_input: ERROR reading namelist.',
     442             :      &               ' ios =',ios,
     443             :      &               ' line =',nline
     444             :       WRITE (errfh,*) buffer(1:nbuffer)
     445             :       WRITE (errfh,*) 'The cause of this error may be ...'
     446             :       WRITE (errfh,*) '        a variable not defined in this namelist,'
     447             :       WRITE (errfh,*) '        wrong type of data for a variable.'
     448             :       CALL juDFT_error("ERROR reading input",calledby ="struct_input")
     449             : 
     450             :  913  CONTINUE
     451           0 :       WRITE (errfh,*) 'struct_input: ERROR reading record.',
     452           0 :      &               ' ios =',ios,
     453           0 :      &               ' line =',nline
     454           0 :       WRITE (errfh,*) buffer(1:nbuffer)
     455           0 :        CALL juDFT_error("ERROR reading input",calledby="struct_input")
     456             : 
     457             :       END SUBROUTINE struct_input
     458             : !-------------------------------------
     459           0 :       SUBROUTINE recip(a1,a2,a3,b)
     460             : 
     461             :       USE m_constants, ONLY : pimach
     462             :       IMPLICIT NONE
     463             :       REAL, INTENT (IN) :: a1(3),a2(3),a3(3)
     464             :       REAL, INTENT (OUT):: b(3,3)
     465             :       REAL volume
     466             : 
     467             : !  volume (without scaling factor aa^3)
     468             :       volume  = a1(1)*a2(2)*a3(3) + a2(1)*a3(2)*a1(3) +
     469             :      &          a3(1)*a1(2)*a2(3) - a1(3)*a2(2)*a3(1) -
     470           0 :      &          a2(3)*a3(2)*a1(1) - a3(3)*a1(2)*a2(1)
     471             : 
     472             : !  reciprocal lattice vectors in scaled Cartesian units
     473           0 :       b(1,1) = (a2(2)*a3(3) - a2(3)*a3(2))
     474           0 :       b(1,2) = (a2(3)*a3(1) - a2(1)*a3(3))
     475           0 :       b(1,3) = (a2(1)*a3(2) - a2(2)*a3(1))
     476           0 :       b(2,1) = (a3(2)*a1(3) - a3(3)*a1(2))
     477           0 :       b(2,2) = (a3(3)*a1(1) - a3(1)*a1(3))
     478           0 :       b(2,3) = (a3(1)*a1(2) - a3(2)*a1(1))
     479           0 :       b(3,1) = (a1(2)*a2(3) - a1(3)*a2(2))
     480           0 :       b(3,2) = (a1(3)*a2(1) - a1(1)*a2(3))
     481           0 :       b(3,3) = (a1(1)*a2(2) - a1(2)*a2(1))
     482             : !      b = 2.0*pimach()*b/volume
     483           0 :       b = b/volume
     484           0 :       END SUBROUTINE recip
     485             : 
     486             :       END MODULE m_structinput

Generated by: LCOV version 1.13