LCOV - code coverage report
Current view: top level - types - types_usdus.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 35 51 68.6 %
Date: 2024-03-29 04:21:46 Functions: 1 4 25.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_types_usdus
       8             :    TYPE t_usdus
       9             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)    :: us
      10             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)    :: dus
      11             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)    :: uds
      12             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)    :: duds !(0:lmaxd,ntype,jspd)
      13             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)    :: ddn  !(0:lmaxd,ntype,jspd)
      14             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)   :: ulos
      15             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)   :: dulos
      16             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)   :: uulon
      17             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)   :: dulon     ! (nlod,ntype,jspd)
      18             :       REAL, ALLOCATABLE, DIMENSION(:, :, :, :) :: uloulopn  ! (nlod,nlod,ntypd,jspd)
      19             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)   :: uuilon
      20             :       REAL, ALLOCATABLE, DIMENSION(:, :, :)   :: duilon    ! (nlod,ntype,jspd)
      21             :       REAL, ALLOCATABLE, DIMENSION(:, :, :, :) :: ulouilopn ! (nlod,nlod,ntypd,jspd)
      22             :    CONTAINS
      23             :       PROCEDURE :: init => usdus_init
      24             :       PROCEDURE :: free => usdus_free
      25             :    END TYPE t_usdus
      26             : 
      27             : CONTAINS
      28        1854 :    SUBROUTINE usdus_init(ud, atoms, jsp)
      29             :       USE m_judft
      30             :       USE m_types_setup
      31             :       IMPLICIT NONE
      32             :       CLASS(t_usdus)           :: ud
      33             :       TYPE(t_atoms), INTENT(IN) :: atoms
      34             :       INTEGER, INTENT(IN)       :: jsp
      35             : 
      36             :       INTEGER :: err(13)
      37             : 
      38        1854 :       err = 0
      39        1854 :       if(.not. allocated(ud%uloulopn)) &
      40       11064 :          allocate(ud%uloulopn(atoms%nlod, atoms%nlod, atoms%ntype, jsp), stat=err(1))
      41        1854 :       if(.not. allocated(ud%ddn)) &
      42        9220 :          allocate(ud%ddn(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(2))
      43        1854 :       if(.not. allocated(ud%us)) &
      44        9220 :          allocate(ud%us(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(3))
      45        1854 :       if(.not. allocated(ud%uds)) &
      46        9220 :          allocate(ud%uds(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(4))
      47        1854 :       if(.not. allocated(ud%dus)) &
      48        9220 :          allocate(ud%dus(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(5))
      49        1854 :       if(.not. allocated(ud%duds)) &
      50        9220 :          allocate(ud%duds(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(6))
      51        1854 :       if(.not. allocated(ud%ulos)) &
      52        9220 :          allocate(ud%ulos(atoms%nlod, atoms%ntype, jsp), stat=err(7))
      53        1854 :       if(.not. allocated(ud%dulos)) &
      54        9220 :          allocate(ud%dulos(atoms%nlod, atoms%ntype, jsp), stat=err(8))
      55        1854 :       if(.not. allocated(ud%uulon)) &
      56        9220 :          allocate(ud%uulon(atoms%nlod, atoms%ntype, jsp), stat=err(9))
      57        1854 :       if(.not. allocated(ud%dulon)) &
      58        9220 :          allocate(ud%dulon(atoms%nlod, atoms%ntype, jsp), stat=err(10))
      59        1854 :       if(.not. allocated(ud%uuilon)) &
      60        9220 :          allocate(ud%uuilon(atoms%nlod, atoms%ntype, jsp), stat=err(11))
      61        1854 :       if(.not. allocated(ud%duilon)) &
      62        9220 :          allocate(ud%duilon(atoms%nlod, atoms%ntype, jsp), stat=err(12))
      63        1854 :       if(.not. allocated(ud%ulouilopn)) &
      64       11064 :          allocate(ud%ulouilopn(atoms%nlod, atoms%nlod, atoms%ntype, jsp), stat=err(13))
      65             : 
      66             :       !write (*,*) "err array", err
      67       25956 :       IF(ANY(err > 0)) CALL judft_error("Not enough memory allocating usdus datatype")
      68             : 
      69      144026 :       ud%uloulopn  = 0; ud%ddn       = 0; ud%us        = 0
      70      177450 :       ud%uds       = 0; ud%dus       = 0; ud%duds      = 0
      71       44682 :       ud%ulos      = 0; ud%dulos     = 0; ud%uulon     = 0
      72       44682 :       ud%dulon     = 0; ud%uuilon    = 0; ud%duilon    = 0
      73       26962 :       ud%ulouilopn = 0
      74        1854 :    END SUBROUTINE usdus_init
      75             : 
      76           0 :    SUBROUTINE usdus_free(ud)
      77             :       IMPLICIT NONE
      78             :       CLASS(t_usdus)           :: ud
      79             : 
      80           0 :       if(allocated(ud%uloulopn)) deallocate(ud%uloulopn)
      81           0 :       if(allocated(ud%ddn)) deallocate(ud%ddn)
      82           0 :       if(allocated(ud%us)) deallocate(ud%us)
      83           0 :       if(allocated(ud%uds)) deallocate(ud%uds)
      84           0 :       if(allocated(ud%dus)) deallocate(ud%dus)
      85           0 :       if(allocated(ud%duds)) deallocate(ud%duds)
      86           0 :       if(allocated(ud%ulos)) deallocate(ud%ulos)
      87           0 :       if(allocated(ud%dulos)) deallocate(ud%dulos)
      88           0 :       if(allocated(ud%uulon)) deallocate(ud%uulon)
      89           0 :       if(allocated(ud%dulon)) deallocate(ud%dulon)
      90           0 :       if(allocated(ud%uuilon)) deallocate(ud%uuilon)
      91           0 :       if(allocated(ud%duilon)) deallocate(ud%duilon)
      92           0 :       if(allocated(ud%ulouilopn)) deallocate(ud%ulouilopn)
      93             : 
      94           0 :    END SUBROUTINE usdus_free
      95             : 
      96           0 : END MODULE m_types_usdus

Generated by: LCOV version 1.14