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

Generated by: LCOV version 1.14