LCOV - code coverage report
Current view: top level - io - wrtdop.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 38 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             :       MODULE m_wrtdop
       2             : !     ****************************************************
       3             : !     write formatted density or potential onto unit 'nu'
       4             : !     e. wimmer   march 1985
       5             : !     ****************************************************
       6             :       CONTAINS
       7           0 :         SUBROUTINE wrtdop(&
       8             :              &                  stars,vacuum,atoms,sphhar,&
       9             :              &                  input,sym,&
      10             :              &                  nu,&
      11           0 :              &                  it,fr,fpw,fz,fzxy)
      12             :           !
      13             :           USE m_constants,ONLY: namat_const
      14             :           USE m_types
      15             :           IMPLICIT NONE
      16             :           !
      17             :           !     .. Scalar Arguments ..
      18             :           TYPE(t_stars),INTENT(IN)  :: stars
      19             :           TYPE(t_vacuum),INTENT(IN) :: vacuum
      20             :           TYPE(t_atoms),INTENT(IN)  :: atoms
      21             :           TYPE(t_sphhar),INTENT(IN) :: sphhar
      22             :           TYPE(t_input),INTENT(IN)  :: input
      23             :           TYPE(t_sym),INTENT(IN)    :: sym
      24             :           INTEGER, INTENT (IN) :: nu 
      25             :           INTEGER, INTENT (IN) :: it   
      26             :           !     ..
      27             :           !     .. Array Arguments ..
      28             :           COMPLEX, INTENT (IN):: fpw(:,:),fzxy(:,:,:,:) !(stars%ng3,input%jspins),fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
      29             :           REAL,    INTENT (IN):: fr(:,0:,:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),
      30             :           REAL,    INTENT (IN):: fz(:,:,:)!(vacuum%nmzd,2,input%jspins)
      31             :           CHARACTER(len=8):: dop,iop,name(10)
      32             :           !     .. Local Scalars ..
      33             :           INTEGER i,ivac,izn,jsp,k,lh,n,na
      34             :           !     ..
      35             :           !     .. Intrinsic Functions ..
      36             :           INTRINSIC REAL
      37             :           !     ..
      38             :           !Defaults, as the character arrays are no longer used, we should
      39             :           !write some defaults for old fleur-versions
      40           0 :           name    ='        '
      41           0 :           name(10)='ordered*'
      42           0 :           dop     ='in/out  '
      43           0 :           iop     ='char/pot'
      44           0 :           WRITE (nu) name
      45             :           !          WRITE (6,FMT=8000) name
      46             : 8000      FORMAT (' wrtdop title:',10a8)
      47           0 :           WRITE (nu) iop,dop,it
      48           0 :           DO  jsp = 1,SIZE(fr,4)
      49           0 :              WRITE (nu) jsp
      50           0 :              WRITE (nu) atoms%ntype
      51           0 :              na = 1
      52           0 :              DO  n = 1,atoms%ntype
      53           0 :                 izn = atoms%zatom(n) + 0.01
      54           0 :                 WRITE (nu) namat_const(izn),n,atoms%jri(n),atoms%rmt(n),atoms%dx(n)
      55           0 :                 WRITE (nu) atoms%ntypsy(na),sphhar%nlh(atoms%ntypsy(na))
      56           0 :                 DO  lh = 0,sphhar%nlh(atoms%ntypsy(na))
      57           0 :                    WRITE (nu) lh
      58           0 :                    WRITE (nu) (fr(i,lh,n,jsp),i=1,atoms%jri(n))
      59             :                 ENDDO
      60           0 :                 na = na + atoms%neq (n)
      61             :              ENDDO
      62           0 :              IF (jsp<=SIZE(fpw,2)) THEN
      63           0 :                 WRITE (nu) stars%ng3
      64           0 :                 IF (sym%invs) THEN
      65           0 :                    WRITE (nu) (REAL(fpw(k,jsp)),k=1,stars%ng3)
      66             :                 ELSE
      67           0 :                    WRITE (nu) (fpw(k,jsp),k=1,stars%ng3)
      68             :                 END IF
      69             :              ENDIF
      70           0 :              IF (input%film) THEN
      71           0 :               IF (jsp<=SIZE(fz,3)) THEN
      72           0 :                  DO  ivac = 1,vacuum%nvac
      73           0 :                     WRITE (nu) ivac
      74           0 :                     WRITE (nu) vacuum%nmz,vacuum%dvac,vacuum%delz
      75           0 :                     WRITE (nu) (fz(i,ivac,jsp),i=1,vacuum%nmz)
      76           0 :                     IF (jsp<=SIZE(fzxy,4)) THEN
      77           0 :                        WRITE (nu) stars%ng2,vacuum%nmzxy
      78           0 :                        DO  k = 2,stars%ng2
      79           0 :                           IF (sym%invs2) THEN
      80           0 :                              WRITE (nu) (REAL(fzxy(i,k-1,ivac,jsp)),i=1,vacuum%nmzxy)
      81             :                           ELSE
      82           0 :                              WRITE (nu) (fzxy(i,k-1,ivac,jsp),i=1,vacuum%nmzxy)
      83             :                           END IF
      84             :                        ENDDO
      85             :                     ENDIF
      86             :                  ENDDO
      87             :               END IF
      88             :            ENDIF
      89             :           ENDDO
      90             :           !
      91           0 :           RETURN
      92             :         END SUBROUTINE wrtdop
      93             :       END MODULE m_wrtdop
      94             :       

Generated by: LCOV version 1.13