LCOV - code coverage report
Current view: top level - dos - doswrite.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 13 51 25.5 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.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_doswrite
       8             :   USE m_juDFT
       9             :   !
      10             :   !-- now write cdninf for all kpts if on T3E
      11             :   !-- now read data from tmp_dos and write to vacdos&dosinp .. dw
      12             :   !
      13             : CONTAINS
      14           7 :   SUBROUTINE doswrite(eig_id,DIMENSION,kpts,atoms,vacuum,input,banddos,&
      15             :                       sliceplot,noco,sym,cell,dos,mcd,results,slab,orbcomp,oneD)
      16             :     USE m_evaldos
      17             :     USE m_cdninf
      18             :     USE m_types
      19             :     IMPLICIT NONE
      20             :   
      21             :     TYPE(t_dimension),INTENT(IN) :: DIMENSION
      22             :     TYPE(t_oneD),INTENT(IN)      :: oneD
      23             :     TYPE(t_banddos),INTENT(IN)   :: banddos
      24             :     TYPE(t_sliceplot),INTENT(IN) :: sliceplot
      25             :     TYPE(t_input),INTENT(IN)     :: input
      26             :     TYPE(t_vacuum),INTENT(IN)    :: vacuum
      27             :     TYPE(t_noco),INTENT(IN)      :: noco
      28             :     TYPE(t_sym),INTENT(IN)       :: sym
      29             :     TYPE(t_cell),INTENT(IN)      :: cell
      30             :     TYPE(t_dos),INTENT(IN)       :: dos
      31             :     TYPE(t_slab),INTENT(IN)      :: slab
      32             :     TYPE(t_orbcomp),INTENT(IN)   :: orbcomp
      33             :     TYPE(t_kpts),INTENT(IN)      :: kpts
      34             :     TYPE(t_atoms),INTENT(IN)     :: atoms
      35             :     TYPE(t_mcd),INTENT(IN)       :: mcd
      36             :     TYPE(t_results),INTENT(IN)   :: results
      37             : 
      38             :     !     .. Scalar Arguments ..
      39             :     INTEGER,PARAMETER :: n2max=13 
      40             :     INTEGER, INTENT (IN) :: eig_id
      41             : 
      42             :     !    locals
      43             :     REAL    :: wk,bkpt(3)
      44          14 :     REAL    :: eig(DIMENSION%neigd)
      45             :     INTEGER :: ne,ikpt,kspin,j,i,n
      46           7 :     COMPLEX, ALLOCATABLE :: ac(:,:),bc(:,:)
      47             : 
      48             : 
      49             :     !     check if there is anything todo here
      50           7 :     IF (.NOT.(banddos%dos.OR.input%cdinf.OR.banddos%vacdos.OR.(vacuum%nstm.EQ.3))) RETURN
      51             :     !     check if settings in inp-file make any sense
      52           7 :     IF (banddos%vacdos.AND..NOT.banddos%dos) THEN
      53           0 :        WRITE(6,*) "STOP DOS: only set banddos%vacdos = .true. if banddos%dos=.true."
      54           0 :        CALL juDFT_error("DOS",calledby ="doswrite")
      55             :     ENDIF
      56           7 :     IF (banddos%vacdos.AND.(.NOT.vacuum%starcoeff.AND.(vacuum%nstars.NE.1)))THEN
      57           0 :        WRITE(6,*) "STOP DOS: if stars = f set vacuum%nstars=1"
      58           0 :        CALL juDFT_error("DOS",calledby ="doswrite")
      59             :     ENDIF
      60             : 
      61           7 :     IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
      62             :        !---  >    open files for bandstucture+ old style vacdos
      63           0 :        OPEN (85,file='dosinp')
      64           0 :        IF (banddos%vacdos) THEN
      65           0 :           OPEN (86,file='vacDOS')
      66             :        ENDIF
      67             :     ENDIF
      68             : 
      69           7 :     IF ((banddos%dos.AND.(banddos%ndir.GE.0)).OR.input%cdinf) THEN
      70             : 
      71             :        !      write bandstructure or cdn-info to output-file
      72           0 :        DO kspin = 1,input%jspins
      73           0 :           IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
      74             :              ! write header information to vacdos & dosinp
      75           0 :              IF (input%film) THEN
      76           0 :                 WRITE (85,FMT=8080) vacuum%nvac,kpts%nkpt
      77             :              ELSE
      78           0 :                 WRITE (85,FMT=8080) input%jspins,kpts%nkpt
      79             :              ENDIF
      80             : 8080         FORMAT (12i6)
      81           0 :              WRITE (85,FMT=8080) atoms%ntype, (atoms%neq(n),n=1,atoms%ntype)
      82           0 :              IF (banddos%vacdos) THEN
      83           0 :                 WRITE (86,FMT=8080) vacuum%nvac,kpts%nkpt
      84           0 :                 WRITE (86,FMT=8080) vacuum%layers
      85           0 :                 WRITE (86,'(20(i3,1x))') (vacuum%izlay(i,1),i=1,vacuum%layers)
      86             :              ENDIF
      87             :           ENDIF
      88             : 
      89           0 :           DO ikpt=1,kpts%nkpt
      90             :              CALL cdninf(input,sym,noco,kspin,atoms,vacuum,sliceplot,banddos,ikpt,kpts%bk(:,ikpt),&
      91             :                          kpts%wtkpt(ikpt),cell,kpts,results%neig(ikpt,kspin),results%eig(:,ikpt,kspin),dos%qal(0:,:,:,ikpt,kspin),dos%qis,dos%qvac,&
      92           0 :                          dos%qvlay(:,:,:,ikpt,kspin),dos%qstars(:,:,:,:,ikpt,kspin),dos%ksym(:,ikpt,kspin),dos%jsym(:,ikpt,kspin))
      93             :           END DO
      94             : 
      95             :        END DO ! end spin loop (kspin = 1,input%jspins)
      96             : 
      97             :     END IF
      98             : 
      99           7 :     IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
     100           0 :        CLOSE(85)
     101           0 :        RETURN
     102             :        !     ok, all done in the bandstructure/cdninf case
     103             :     END IF
     104             : 
     105             :     !     write DOS/VACDOS     
     106          14 :     IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN
     107             :        CALL evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,&
     108           7 :                     DIMENSION,results%ef,results%bandgap,banddos%l_mcd,mcd,slab,orbcomp)
     109             :     END IF
     110             : 
     111             :     !     Now write to vacwave if nstm=3 
     112             :     !     all data has been written to tmp_vacwave and must be written now by PE=0 only!
     113           7 :     IF (vacuum%nstm.EQ.3) THEN
     114           0 :        call juDFT_error("nstm=3 not implemented in doswrite")
     115             :        !OPEN (89,file='tmp_vacwave',status='old',access='direct')!, recl=reclength_vw)
     116           0 :        ALLOCATE ( ac(n2max,DIMENSION%neigd),bc(n2max,DIMENSION%neigd) )
     117           0 :        DO ikpt = 1,kpts%nkpt
     118           0 :           WRITE(*,*) 'Read rec',ikpt,'from vacwave'
     119           0 :           READ(89,rec=ikpt) wk,ne,bkpt(1),bkpt(2),eig,ac,bc
     120           0 :           WRITE (87,'(i3,1x,f12.6)') ikpt,wk
     121           0 :           i=0
     122           0 :           DO n = 1, ne
     123           0 :              IF (ABS(eig(n)-vacuum%tworkf).LE.banddos%e2_dos) i=i+1
     124             :           END DO
     125           0 :           WRITE (87,FMT=990) bkpt(1), bkpt(2), i, n2max
     126           0 :           DO n = 1, ne
     127           0 :              IF (ABS(eig(n)-vacuum%tworkf).LE.banddos%e2_dos) THEN
     128           0 :                 WRITE (87,FMT=1000) eig(n)
     129           0 :                 DO j=1,n2max
     130           0 :                    WRITE (87,FMT=1010) ac(j,n),bc(j,n)
     131             :                 END DO
     132             :              END IF
     133             :           END DO
     134             : 990       FORMAT(2(f8.4,1x),i3,1x,i3)
     135             : 1000      FORMAT(e10.4)
     136             : 1010      FORMAT(2(2e20.8,1x))
     137             :        END DO
     138           0 :        DEALLOCATE ( ac,bc )
     139             :        !
     140           0 :        CLOSE(89)
     141             : 
     142             :     ENDIF
     143             :     RETURN
     144           7 :   END SUBROUTINE doswrite
     145             : END MODULE m_doswrite

Generated by: LCOV version 1.13