LCOV - code coverage report
Current view: top level - io - cdnpot_io_common.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 86 103 83.5 %
Date: 2019-09-08 04:53:50 Functions: 3 5 60.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2017 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             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       8             : !!!
       9             : !!! This module contains common subroutines required for density IO
      10             : !!! as well as for potential IO
      11             : !!!
      12             : !!!                             GM'17
      13             : !!!
      14             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      15             : 
      16             : MODULE m_cdnpot_io_common
      17             : 
      18             :    USE m_types
      19             :    USE m_juDFT
      20             :    USE m_cdnpot_io_hdf
      21             : #ifdef CPP_HDF
      22             :    USE hdf5
      23             : #endif
      24             : 
      25             :    IMPLICIT NONE
      26             : 
      27             :    CONTAINS
      28             : 
      29         233 :    SUBROUTINE compareStars(stars, refStars, l_same)
      30             : 
      31             :       TYPE(t_stars),INTENT(IN)  :: stars
      32             :       TYPE(t_stars),INTENT(IN)  :: refStars
      33             : 
      34             :       LOGICAL,      INTENT(OUT) :: l_same
      35             : 
      36         233 :       l_same = .TRUE.
      37             : 
      38         233 :       IF(ABS(stars%gmaxInit-refStars%gmaxInit).GT.1e-10) l_same = .FALSE.
      39         233 :       IF(stars%ng3.NE.refStars%ng3) l_same = .FALSE.
      40         233 :       IF(stars%ng2.NE.refStars%ng2) l_same = .FALSE.
      41         233 :       IF(stars%mx1.NE.refStars%mx1) l_same = .FALSE.
      42         233 :       IF(stars%mx2.NE.refStars%mx2) l_same = .FALSE.
      43         233 :       IF(stars%mx3.NE.refStars%mx3) l_same = .FALSE.
      44             : 
      45         233 :    END SUBROUTINE compareStars
      46             : 
      47           0 :    SUBROUTINE compareStepfunctions(stars, refStars, l_same)
      48             : 
      49             :       TYPE(t_stars),INTENT(IN)  :: stars
      50             :       TYPE(t_stars),INTENT(IN)  :: refStars
      51             : 
      52             :       LOGICAL,      INTENT(OUT) :: l_same
      53             : 
      54         222 :       l_same = .TRUE.
      55             : 
      56         222 :       IF(stars%ng3.NE.refStars%ng3) l_same = .FALSE.
      57         222 :       IF(stars%mx1.NE.refStars%mx1) l_same = .FALSE.
      58         222 :       IF(stars%mx2.NE.refStars%mx2) l_same = .FALSE.
      59         222 :       IF(stars%mx3.NE.refStars%mx3) l_same = .FALSE.
      60             : 
      61           0 :    END SUBROUTINE compareStepfunctions
      62             : 
      63         238 :    SUBROUTINE compareStructure(input, atoms, vacuum, cell, sym, refInput, refAtoms, refVacuum,&
      64             :                                refCell, refSym, l_same,l_shift_only)
      65             : 
      66             :       TYPE(t_input),INTENT(IN)  :: input, refInput
      67             :       TYPE(t_atoms),INTENT(IN)  :: atoms, refAtoms
      68             :       TYPE(t_vacuum),INTENT(IN) :: vacuum, refVacuum
      69             :       TYPE(t_cell),INTENT(IN)   :: cell, refCell
      70             :       TYPE(t_sym),INTENT(IN)    :: sym, refSym
      71             : 
      72             :       LOGICAL,      INTENT(OUT) :: l_same
      73             :       LOGICAL,OPTIONAL,INTENT(OUT) ::l_shift_only
      74             : 
      75             :       INTEGER                   :: i
      76             : 
      77         238 :       l_same = .TRUE.
      78             :   
      79             : 
      80         238 :       IF(atoms%ntype.NE.refAtoms%ntype) l_same = .FALSE.
      81         238 :       IF(atoms%nat.NE.refAtoms%nat) l_same = .FALSE.
      82         238 :       IF(atoms%lmaxd.NE.refAtoms%lmaxd) l_same = .FALSE.
      83         238 :       IF(atoms%jmtd.NE.refAtoms%jmtd) l_same = .FALSE.
      84         238 :       IF(atoms%n_u.NE.refAtoms%n_u) l_same = .FALSE.
      85         238 :       IF(vacuum%dvac.NE.refVacuum%dvac) l_same = .FALSE.
      86         238 :       IF(sym%nop.NE.refSym%nop) l_same = .FALSE.
      87         238 :       IF(sym%nop2.NE.refSym%nop2) l_same = .FALSE.
      88             : 
      89         238 :       IF(atoms%n_u.EQ.refAtoms%n_u) THEN
      90         414 :          DO i = 1, atoms%n_u
      91          88 :             IF (atoms%lda_u(i)%atomType.NE.refAtoms%lda_u(i)%atomType) l_same = .FALSE.
      92         326 :             IF (atoms%lda_u(i)%l.NE.refAtoms%lda_u(i)%l) l_same = .FALSE.
      93             :          END DO
      94             :       END IF
      95             : 
      96         952 :       IF(ANY(ABS(cell%amat(:,:)-refCell%amat(:,:)).GT.1e-10)) l_same = .FALSE.
      97         238 :       IF(l_same) THEN
      98         238 :          IF(ANY(atoms%nz(:).NE.refAtoms%nz(:))) l_same = .FALSE.
      99         238 :          IF(ANY(sym%mrot(:,:,:sym%nop).NE.refSym%mrot(:,:,:sym%nop))) l_same = .FALSE.
     100         238 :          IF(ANY(ABS(sym%tau(:,:sym%nop)-refSym%tau(:,:sym%nop)).GT.1e-10)) l_same = .FALSE.
     101             :       END IF
     102             :   
     103         238 :       IF (PRESENT(l_shift_only)) l_shift_only=l_same
     104             :       !Now the positions are checked...
     105         238 :       IF(l_same) THEN
     106        1350 :          DO i = 1, atoms%nat
     107         794 :             IF(ANY(ABS(atoms%pos(:,i)-refAtoms%pos(:,i)).GT.1e-10)) l_same = .FALSE.
     108             :          END DO
     109             :       END IF
     110             : 
     111             :       ! NOTE: This subroutine certainly is not yet complete. Especially symmetry should
     112             :       !       also be stored and compared for structure considerations.
     113             : 
     114         238 :    END SUBROUTINE compareStructure
     115             : 
     116           0 :    SUBROUTINE compareLatharms(latharms, refLatharms, l_same)
     117             : 
     118             :       TYPE(t_sphhar)       :: latharms, refLatharms
     119             : 
     120             :       LOGICAL,      INTENT(OUT) :: l_same
     121             : 
     122         194 :       l_same = .TRUE.
     123             : 
     124         194 :       IF(latharms%ntypsd.NE.refLatharms%ntypsd) l_same = .FALSE.
     125         194 :       IF(latharms%memd.NE.refLatharms%memd) l_same = .FALSE.
     126         194 :       IF(latharms%nlhd.NE.refLatharms%nlhd) l_same = .FALSE.
     127             : 
     128           0 :    END SUBROUTINE compareLatharms
     129             : 
     130             : #ifdef CPP_HDF
     131         223 :    SUBROUTINE checkAndWriteMetadataHDF(fileID, input, atoms, cell, vacuum, oneD, stars, latharms, sym,&
     132             :                                        currentStarsIndex,currentLatharmsIndex,currentStructureIndex,&
     133             :                                        currentStepfunctionIndex,l_storeIndices,l_CheckBroyd)
     134             : 
     135             :       TYPE(t_input),INTENT(IN)  :: input
     136             :       TYPE(t_atoms),INTENT(IN)  :: atoms
     137             :       TYPE(t_cell), INTENT(IN)  :: cell
     138             :       TYPE(t_vacuum),INTENT(IN) :: vacuum
     139             :       TYPE(t_oneD),INTENT(IN)   :: oneD
     140             :       TYPE(t_stars),INTENT(IN)  :: stars
     141             :       TYPE(t_sphhar),INTENT(IN) :: latharms
     142             :       TYPE(t_sym),INTENT(IN)    :: sym
     143             : 
     144             :       INTEGER(HID_T), INTENT(IN) :: fileID
     145             :       INTEGER, INTENT(INOUT)     :: currentStarsIndex,currentLatharmsIndex
     146             :       INTEGER, INTENT(INOUT)     :: currentStructureIndex,currentStepfunctionIndex
     147             :       LOGICAL, INTENT(IN)        :: l_CheckBroyd
     148             :       LOGICAL, INTENT(OUT)       :: l_storeIndices
     149             : 
     150         223 :       TYPE(t_stars)        :: starsTemp
     151         223 :       TYPE(t_vacuum)       :: vacuumTemp
     152         223 :       TYPE(t_atoms)        :: atomsTemp
     153         223 :       TYPE(t_sphhar)       :: latharmsTemp
     154             :       TYPE(t_input)        :: inputTemp
     155             :       TYPE(t_cell)         :: cellTemp
     156             :       TYPE(t_oneD)         :: oneDTemp
     157         223 :       TYPE(t_sym)          :: symTemp
     158             : 
     159             :       INTEGER                    :: starsIndexTemp, structureIndexTemp
     160             :       LOGICAL                    :: l_same, l_writeAll, l_exist
     161             : 
     162         223 :       l_storeIndices = .FALSE.
     163         223 :       l_writeAll = .FALSE.
     164             : 
     165         223 :       IF(currentStructureIndex.EQ.0) THEN
     166           1 :          currentStructureIndex = 1
     167           1 :          l_storeIndices = .TRUE.
     168           1 :          CALL writeStructureHDF(fileID, input, atoms, cell, vacuum, oneD, sym, currentStructureIndex,l_CheckBroyd)
     169             :       ELSE
     170         222 :          CALL readStructureHDF(fileID, inputTemp, atomsTemp, cellTemp, vacuumTemp, oneDTemp, symTemp, currentStructureIndex)
     171         222 :          CALL compareStructure(input, atoms, vacuum, cell, sym, inputTemp, atomsTemp, vacuumTemp, cellTemp, symTemp, l_same)
     172             : 
     173         222 :          IF(.NOT.l_same) THEN
     174           0 :             currentStructureIndex = currentStructureIndex + 1
     175           0 :             l_storeIndices = .TRUE.
     176           0 :             l_writeAll = .TRUE.
     177           0 :             CALL writeStructureHDF(fileID, input, atoms, cell, vacuum, oneD, sym, currentStructureIndex,l_CheckBroyd)
     178             :          END IF
     179             :       END IF
     180         223 :       IF (currentStarsIndex.EQ.0) THEN
     181           1 :          currentStarsIndex = 1
     182           1 :          l_storeIndices = .TRUE.
     183           1 :          CALL writeStarsHDF(fileID, currentStarsIndex, currentStructureIndex, stars,l_CheckBroyd)
     184             :       ELSE
     185         222 :          CALL peekStarsHDF(fileID, currentStarsIndex, structureIndexTemp)
     186         222 :          l_same = structureIndexTemp.EQ.currentStructureIndex
     187         222 :          IF(l_same) THEN
     188         222 :             CALL readStarsHDF(fileID, currentStarsIndex, starsTemp)
     189         222 :             CALL compareStars(stars, starsTemp, l_same)
     190             :          END IF
     191         222 :          IF((.NOT.l_same).OR.l_writeAll) THEN
     192           0 :             currentStarsIndex = currentStarsIndex + 1
     193           0 :             l_storeIndices = .TRUE.
     194           0 :             CALL writeStarsHDF(fileID, currentStarsIndex, currentStructureIndex, stars,l_CheckBroyd)
     195             :          END IF
     196             :       END IF
     197         223 :       IF (currentLatharmsIndex.EQ.0) THEN
     198          29 :          currentLatharmsIndex = 1
     199          29 :          l_storeIndices = .TRUE.
     200          29 :          CALL writeLatharmsHDF(fileID, currentLatharmsIndex, currentStructureIndex, latharms,l_checkBroyd)
     201             :       ELSE
     202         194 :          CALL peekLatharmsHDF(fileID, currentLatharmsIndex, structureIndexTemp)
     203         194 :          l_same = structureIndexTemp.EQ.currentStructureIndex
     204         194 :          IF(l_same) THEN
     205         194 :             CALL readLatharmsHDF(fileID, currentLatharmsIndex, latharmsTemp)
     206             :             CALL compareLatharms(latharms, latharmsTemp, l_same)
     207             :          END IF
     208         194 :          IF((.NOT.l_same).OR.l_writeAll) THEN
     209           0 :             currentLatharmsIndex = currentLatharmsIndex + 1
     210           0 :             l_storeIndices = .TRUE.
     211           0 :             CALL writeLatharmsHDF(fileID, currentLatharmsIndex, currentStructureIndex, latharms,l_CheckBroyd)
     212             :          END IF
     213             :       END IF
     214         223 :       IF(currentStepfunctionIndex.EQ.0) THEN
     215           1 :          currentStepfunctionIndex = 1
     216           1 :          l_storeIndices = .TRUE.
     217             :          CALL writeStepfunctionHDF(fileID, currentStepfunctionIndex, currentStarsIndex,&
     218           1 :                                    currentStructureIndex, stars,l_CheckBroyd)
     219             :       ELSE
     220         222 :          CALL peekStepfunctionHDF(fileID, currentStepfunctionIndex, starsIndexTemp, structureIndexTemp)
     221         222 :          l_same = (starsIndexTemp.EQ.currentStarsIndex).AND.(structureIndexTemp.EQ.currentStructureIndex)
     222         222 :          IF(l_same) THEN
     223         222 :             CALL readStepfunctionHDF(fileID, currentStepfunctionIndex, starsTemp)
     224             :             CALL compareStepfunctions(stars, starsTemp, l_same)
     225             :          END IF
     226         222 :          IF((.NOT.l_same).OR.l_writeAll) THEN
     227           0 :             currentStepfunctionIndex = currentStepfunctionIndex + 1
     228           0 :             l_storeIndices = .TRUE.
     229             :             CALL writeStepfunctionHDF(fileID, currentStepfunctionIndex, currentStarsIndex,&
     230           0 :                                       currentStructureIndex, stars,l_CheckBroyd)
     231             :          END IF
     232             :       END IF
     233             : 
     234         446 :    END SUBROUTINE checkAndWriteMetadataHDF
     235             : #endif
     236             : 
     237             : 
     238             : END MODULE m_cdnpot_io_common

Generated by: LCOV version 1.13