LCOV - code coverage report
Current view: top level - io - xsf_io.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 36 84 42.9 %
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_xsf_io
       8             :   USE m_types
       9             :   !-----------------------------------------------
      10             :   ! DESC:subroutines to write xsf-files for xcrysden
      11             :   !                 Daniel Wortmann, (06-01-26)
      12             :   !-----------------------------------------------
      13             :   ! Bohr radius a0, http://physics.nist.gov/cgi-bin/cuu/Value?eqbohrrada0
      14             :   REAL, PRIVATE, PARAMETER :: a0 = 0.52917720859 ! in Angstroem
      15             : 
      16             : CONTAINS
      17             :   !<-- S:S: xsf_WRITE_atoms(fileno,film,amat,neq(:ntype),zatom(:ntype),pos)
      18           5 :   SUBROUTINE xsf_WRITE_atoms(fileno,atoms,film,od,amat,forceAllAtoms)
      19             :     !-----------------------------------------------
      20             :     !     Writes the crystal dimensions&atomic positions
      21             :     !           (last modified: 2004-00-00) D. Wortmann
      22             :     !-----------------------------------------------
      23             :     IMPLICIT NONE
      24             :     !<--Arguments
      25             :     INTEGER,INTENT(IN)     :: fileno
      26             :     TYPE(t_atoms),INTENT(IN):: atoms
      27             :     LOGICAL,INTENT(IN)      :: film
      28             :     LOGICAL,INTENT(IN)     :: od
      29             :     REAL,INTENT(IN)        :: amat(3,3)
      30             :     REAL, OPTIONAL, INTENT(IN) :: forceAllAtoms(3,atoms%nat)
      31             :     !>
      32             :     !<-- Locals
      33             :     INTEGER             :: n,nn,na
      34             :     !>
      35           5 :     IF (film) THEN
      36           2 :        IF (od) THEN
      37           0 :           WRITE(fileno,*) "POLYMERE"
      38             :        ELSE
      39           2 :           WRITE(fileno,*) "SLAB"
      40             :        ENDIF
      41             :     ELSE
      42           3 :        WRITE(fileno,*) "CRYSTAL"
      43             :     ENDIF
      44             : 
      45           5 :     WRITE(fileno,*) "PRIMVEC"
      46             :     ! Write in atomic units
      47           5 :     WRITE(fileno,'(3(f0.7,1x))') amat(:,1)*a0
      48           5 :     WRITE(fileno,'(3(f0.7,1x))') amat(:,2)*a0
      49           5 :     WRITE(fileno,'(3(f0.7,1x))') amat(:,3)*a0
      50             : 
      51           5 :     WRITE(fileno,*) "PRIMCOORD"
      52           5 :     WRITE(fileno,*) SUM(atoms%neq)," 1"
      53           5 :     na = 1
      54          14 :     DO n = 1,SIZE(atoms%neq)
      55          32 :        DO nn = 1,atoms%neq(n)
      56          18 :           IF (PRESENT(forceAllAtoms)) THEN
      57           0 :              WRITE(fileno,'(i4,2x,6(f0.7,1x))') NINT(atoms%zatom(n)),atoms%pos(:,na)*a0,forceAllAtoms(:,na)/a0
      58             :           ELSE
      59          18 :              WRITE(fileno,'(i4,2x,3(f0.7,1x))') NINT(atoms%zatom(n)),atoms%pos(:,na)*a0
      60             :           END IF
      61          27 :           na=na+1
      62             :        ENDDO
      63             :     ENDDO
      64           5 :     WRITE(fileno,*)
      65           5 :   END SUBROUTINE xsf_WRITE_atoms
      66             :   !> 
      67             :   !<-- S: xsf_write_header(fileno,twodim,desc,vec1,vec2,vec3,zero,grid)
      68           4 :   SUBROUTINE xsf_WRITE_header(fileno,twodim,desc,vec1,vec2,vec3,zero&
      69           2 :        &     ,grid)
      70             :     !-----------------------------------------------
      71             :     !  writes the beginning of a gid-datablock
      72             :     !           (last modified: 2004-00-00) D. Wortmann
      73             :     !-----------------------------------------------
      74             :     IMPLICIT NONE
      75             :     !<--Arguments
      76             :     INTEGER,INTENT(IN)     :: fileno,grid(:)
      77             :     LOGICAL,INTENT(IN)     :: twodim
      78             :     REAL   ,INTENT(IN)     :: vec1(:),vec2(:),vec3(:),zero(:)
      79             :     CHARACTER(LEN =*),INTENT(IN) :: desc 
      80             :     !>
      81             : 
      82           2 :     IF (twodim) THEN
      83           0 :        WRITE(fileno,*) "BEGIN_BLOCK_DATAGRID_2D"
      84           0 :        WRITE(fileno,*) desc
      85           0 :        WRITE(fileno,*) "BEGIN_DATAGRID_2D_A"
      86           0 :        WRITE(fileno,'(3i7)') grid(1:2)
      87           0 :        WRITE(fileno,'(3(f12.7,1x))') zero*a0
      88           0 :        WRITE(fileno,'(3(f12.7,1x))') vec1*a0
      89           0 :        WRITE(fileno,'(3(f12.7,1x))') vec2*a0
      90             :     ELSE
      91           2 :        WRITE(fileno,*) "BEGIN_BLOCK_DATAGRID_3D"
      92           2 :        WRITE(fileno,*) desc
      93           2 :        WRITE(fileno,*) "BEGIN_DATAGRID_3D_A"
      94           2 :        WRITE(fileno,'(3i7)') grid(1:3)
      95           2 :        WRITE(fileno,'(3(f12.7,1x))') zero*a0
      96           2 :        WRITE(fileno,'(3(f12.7,1x))') vec1*a0
      97           2 :        WRITE(fileno,'(3(f12.7,1x))') vec2*a0
      98           2 :        WRITE(fileno,'(3(f12.7,1x))') vec3*a0
      99             :     ENDIF
     100           2 :   END SUBROUTINE xsf_WRITE_header
     101             :   !> 
     102             :   !<-- S: xsf_write_newblock(fileno,twodim,vec1,vec2,vec3,zero,grid)
     103           0 :   SUBROUTINE xsf_WRITE_newblock(fileno,twodim,vec1,vec2&
     104           0 :        &     ,vec3,zero,grid)
     105             :     !-----------------------------------------------
     106             :     !  writes the beginning of a new gid-datablock for second spin
     107             :     !           (last modified: 2004-00-00) D. Wortmann
     108             :     !-----------------------------------------------
     109             :     IMPLICIT NONE
     110             :     !<--Arguments
     111             :     INTEGER,INTENT(IN)     :: fileno,grid(:)
     112             :     LOGICAL,INTENT(IN)     :: twodim
     113             :     REAL   ,INTENT(IN)     :: vec1(:),vec2(:),vec3(:),zero(:)
     114             :     !>
     115             : 
     116           0 :     IF (twodim) THEN
     117           0 :        WRITE(fileno,*) "END_DATAGRID_2D"
     118           0 :        WRITE(fileno,*) "BEGIN_DATAGRID_2D_B"
     119           0 :        WRITE(fileno,'(3i7)') grid(1:2)
     120           0 :        WRITE(fileno,'(3(f12.7,1x))') zero*a0
     121           0 :        WRITE(fileno,'(3(f12.7,1x))') vec1*a0
     122           0 :        WRITE(fileno,'(3(f12.7,1x))') vec2*a0
     123             :     ELSE
     124           0 :        WRITE(fileno,*) "END_DATAGRID_3D"
     125           0 :        WRITE(fileno,*) "BEGIN_DATAGRID_3D_B"
     126           0 :        WRITE(fileno,'(3i7)') grid(1:3)
     127           0 :        WRITE(fileno,'(3(f12.7,1x))') zero*a0
     128           0 :        WRITE(fileno,'(3(f12.7,1x))') vec1*a0
     129           0 :        WRITE(fileno,'(3(f12.7,1x))') vec2*a0
     130           0 :        WRITE(fileno,'(3(f12.7,1x))') vec3*a0
     131             :     ENDIF
     132           0 :   END SUBROUTINE xsf_WRITE_newblock
     133             :   !> 
     134             :   !<-- S: xsf_write_endblock(fileno,twodim)
     135           2 :   SUBROUTINE xsf_write_endblock(fileno,twodim)
     136             :     !-----------------------------------------------
     137             :     !
     138             :     !           (last modified: 2004-00-00) D. Wortmann
     139             :     !-----------------------------------------------
     140             :     IMPLICIT NONE
     141             :     !<--Arguments
     142             :     INTEGER,INTENT(IN)     :: fileno
     143             :     LOGICAL,INTENT(IN)     :: twodim
     144             :     !>
     145             : 
     146           2 :     IF (twodim) THEN
     147           0 :        WRITE(fileno,*) "END_DATAGRID_2D"                      
     148           0 :        WRITE(fileno,*) "END_BLOCK_DATAGRID_2D" 
     149             :     ELSE
     150           2 :        WRITE(fileno,*) "END_DATAGRID_3D"                      
     151           2 :        WRITE(fileno,*) "END_BLOCK_DATAGRID_3D" 
     152             :     ENDIF
     153           2 :   END SUBROUTINE xsf_write_endblock
     154             :   !> 
     155             : 
     156           0 :   SUBROUTINE xsf_WRITE_force(fileno,atoms,film,od,amat,force)
     157             :     !-----------------------------------------------
     158             :     !     Writes the crystal dimensions&force positions
     159             :     !           (last modified: 2004-00-00) D. Wortmann
     160             :     !-----------------------------------------------
     161             :     IMPLICIT NONE
     162             :     !<--Arguments
     163             :     INTEGER,INTENT(IN)       :: fileno
     164             :     TYPE(t_atoms),INTENT(IN) :: atoms
     165             :     LOGICAL,INTENT(IN)       :: film
     166             :     LOGICAL,INTENT(IN)       :: od
     167             :     REAL,INTENT(IN)          :: amat(3,3)
     168             :     INTEGER,INTENT(IN)     :: force ! number of atoms + force vectors
     169             :     !>
     170             :     !<-- Locals
     171             :     INTEGER             :: n,nn,na
     172             :     !>
     173           0 :     IF (film) THEN
     174           0 :        IF (od) THEN
     175           0 :           WRITE(fileno,*) "POLYMERE"
     176             :        ELSE
     177           0 :           WRITE(fileno,*) "SLAB"
     178             :        ENDIF
     179             :     ELSE
     180           0 :        WRITE(fileno,*) "CRYSTAL"
     181             :     ENDIF
     182             : 
     183           0 :     WRITE(fileno,*) "PRIMVEC"
     184           0 :     WRITE(fileno,'(3(f0.7,1x))') amat(:,1)*a0
     185           0 :     WRITE(fileno,'(3(f0.7,1x))') amat(:,2)*a0
     186           0 :     WRITE(fileno,'(3(f0.7,1x))') amat(:,3)*a0
     187             : 
     188           0 :     WRITE(fileno,*) "PRIMCOORD"
     189           0 :     WRITE(fileno,*) force," 1"
     190           0 :     na = 1
     191           0 :     DO n = 1,SIZE(atoms%neq)
     192           0 :        DO nn = 1,atoms%neq(n)
     193           0 :           WRITE(fileno,'(i4,2x,3(f0.7,1x))') NINT(atoms%zatom(n)),&
     194           0 :                &            atoms%pos(:,na)*a0
     195           0 :           na=na+1
     196             :        ENDDO
     197             :     ENDDO
     198           0 :     WRITE(fileno,*)
     199           0 :   END SUBROUTINE xsf_WRITE_force
     200             :   !> 
     201             :   !-----------------------------------------------
     202             : END MODULE m_xsf_io
     203             : 
     204             :  

Generated by: LCOV version 1.13