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

          Line data    Source code
       1             :       MODULE m_loddop
       2             :       USE m_juDFT
       3             :       CONTAINS
       4           0 :         SUBROUTINE loddop(&
       5             :              &                  stars,vacuum,atoms,sphhar,&
       6             :              &                  input,sym,&
       7             :              &                  nu,&
       8           0 :              &                  it,fr,fpw,fz,fzxy)
       9             :           !     ***********************************************************
      10             :           !     reload formatted density or potential   c.l.fu
      11             :           !     ***********************************************************
      12             :           USE m_types
      13             :           IMPLICIT NONE
      14             :           !
      15             :           !     .. Scalar Arguments ..
      16             :           TYPE(t_stars),INTENT(IN)  :: stars
      17             :           TYPE(t_vacuum),INTENT(IN) :: vacuum
      18             :           TYPE(t_atoms),INTENT(IN)  :: atoms
      19             :           TYPE(t_sphhar),INTENT(IN) :: sphhar
      20             :           TYPE(t_input),INTENT(IN)  :: input
      21             :           TYPE(t_sym),INTENT(IN)    :: sym
      22             : 
      23             :           INTEGER, INTENT (IN) :: nu  
      24             :           INTEGER, INTENT (OUT):: it
      25             :           !     ..
      26             :           !     .. Array Arguments ..
      27             :           COMPLEX, INTENT (OUT):: fpw(:,:),fzxy(:,:,:,:)!(stars%ng3,input%jspins),fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
      28             :           REAL,    INTENT (OUT):: fr(:,0:,:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
      29             :           REAL,    INTENT (OUT):: fz(:,:,:)!(vacuum%nmzd,2,input%jspins)
      30             :           CHARACTER(len=8) :: dop,iop,name(10)
      31             :           !     ..
      32             :           !     .. Local Scalars ..
      33             :           REAL delzn,dxn,rmtn,z1n,dummy
      34             :           INTEGER i,ivac,ivdummy,j,jrin,jsp,jspdum,k,lh,lhdummy,n,ndum,nlhn,&
      35             :                &        nmzn,nmzxyn,nn,nq2n,nq3n,ntydum,n_diff,na
      36             :           CHARACTER(len=2) namaux
      37             :           !     ..
      38             :           !     .. Local Arrays ..
      39           0 :           REAL, ALLOCATABLE :: fpwr(:,:),fzxyr(:,:,:,:)
      40             : 
      41             :           CHARACTER(len=8) space(10)
      42             :           !     ..
      43             :           !     .. Intrinsic Functions ..
      44             :           INTRINSIC cmplx
      45             :           !     ..
      46             :           !     .. Data statements ..
      47             :           DATA space/10*'        '/
      48             :           !     ..
      49             : 
      50           0 :           fr = 0 ; fzxy = 0 ; fr = 0 ; fz = 0
      51             : 
      52           0 :           IF (sym%invs) ALLOCATE ( fpwr(stars%ng3,SIZE(fpw,2)) )
      53           0 :           IF (sym%invs2) ALLOCATE ( fzxyr(vacuum%nmzxyd,stars%ng2-1,2,SIZE(fzxy,4)) )
      54             : 
      55           0 :           name = space
      56           0 :           READ (nu,END=200,ERR=200) name
      57             :           !      WRITE (*,FMT=8000) name
      58             :           ! 8000 FORMAT (' loddop title:',10a8)
      59           0 :           READ (nu,END=200,ERR=200) iop,dop,it
      60           0 :           DO  jsp = 1,SIZE(fr,4)
      61           0 :              READ (nu,END=200,ERR=200) jspdum
      62           0 :              READ (nu,END=200,ERR=200) nn
      63           0 :              IF (nn/=atoms%ntype) CALL juDFT_error("nn.NE.ntype",calledby =&
      64           0 :                   &       "loddop" )
      65             : 
      66             :              na = 1
      67           0 :              DO  n = 1,nn
      68           0 :                 READ (nu,END=200,ERR=200) namaux,ndum,jrin,rmtn,dxn
      69           0 :                 READ (nu,END=200,ERR=200) ntydum,nlhn
      70             :                 !+gu
      71           0 :                 IF ( nlhn.GT.sphhar%nlh(atoms%ntypsy(na)) ) THEN
      72           0 :                    WRITE (*,*) 'nlh (',nlhn,') set to (',sphhar%nlh(atoms%ntypsy(na)),')'
      73           0 :                    n_diff = nlhn - sphhar%nlh(atoms%ntypsy(na))
      74           0 :                    nlhn = sphhar%nlh(atoms%ntypsy(na))
      75             :                 ELSE
      76             :                    n_diff = 0 
      77             :                 ENDIF
      78             :                 !-gu
      79           0 :                 DO  lh = 0,nlhn
      80           0 :                    READ (nu,END=200,ERR=200) lhdummy
      81           0 :                    READ (nu,END=200,ERR=200) (fr(i,lh,n,jsp),i=1,jrin)
      82             :                 ENDDO
      83           0 :                 IF (nlhn.LT.sphhar%nlh(atoms%ntypsy(na))) THEN
      84           0 :                    DO lh = nlhn + 1,sphhar%nlh(atoms%ntypsy(na))
      85           0 :                       DO i = 1,atoms%jri(n)
      86           0 :                          fr(i,lh,n,jsp) = 0.
      87             :                       ENDDO
      88             :                    ENDDO
      89             :                 ELSE
      90           0 :                    DO lh = 1, n_diff
      91           0 :                       READ (nu,END=200,ERR=200) lhdummy
      92           0 :                       READ (nu,END=200,ERR=200) dummy
      93             :                    ENDDO
      94             :                 ENDIF
      95             : 
      96           0 :                 na = na + atoms%neq(n)
      97             :              ENDDO
      98           0 :              IF (jsp<=SIZE(fpw,2)) THEN
      99           0 :                 READ (nu,END=200,ERR=200) nq3n
     100             :                 !+gu
     101           0 :                 IF (nq3n.GT.stars%ng3) THEN
     102           0 :                    WRITE (*,*) 'nq3n (',nq3n,') reduced to nq3 (',stars%ng3,')'
     103           0 :                    nq3n = stars%ng3
     104             :                 ENDIF
     105             :                 !-gu
     106           0 :                 IF (sym%invs) THEN
     107           0 :                    READ (nu,END=200,ERR=200) (fpwr(k,jsp),k=1,nq3n)
     108           0 :                    fpw(:nq3n,jsp) = CMPLX(fpwr(:nq3n,jsp),0.)
     109             :                    
     110             :                 ELSE
     111           0 :                    READ (nu,END=200,ERR=200) (fpw(k,jsp),k=1,nq3n)
     112             :                 END IF
     113           0 :                 IF (nq3n.LT.stars%ng3) THEN
     114           0 :                    fpw(nq3n+1:,jsp) = (0.,0.)
     115             :                 END IF
     116             :              ENDIF
     117           0 :              IF (input%film) THEN
     118           0 :                 IF (jsp<=SIZE(fz,3)) THEN
     119           0 :                    DO  ivac = 1,vacuum%nvac
     120           0 :                       READ (nu,END=200,ERR=200) ivdummy
     121           0 :                       READ (nu,END=200,ERR=200) nmzn,z1n,delzn
     122           0 :                       READ (nu,END=200,ERR=200) (fz(i,ivac,jsp),i=1,nmzn)
     123           0 :                       IF (vacuum%nvac.EQ.1) THEN
     124           0 :                          DO i=1,nmzn
     125           0 :                             fz(i,2,jsp)=fz(i,1,jsp)
     126             :                          ENDDO
     127             :                       ENDIF
     128           0 :                       IF (jsp<=SIZE(fzxy,4)) THEN
     129           0 :                          READ (nu,END=200,ERR=200) nq2n,nmzxyn
     130             :                          !+gu
     131           0 :                          IF (nq2n.GT.stars%ng2) THEN
     132           0 :                             WRITE (*,*) 'nq2n (',nq2n,') reduced to nq2 (',stars%ng2,')'
     133           0 :                             n_diff = nq2n - stars%ng2
     134           0 :                             nq2n = stars%ng2
     135             :                          ELSE
     136             :                             n_diff = 0
     137             :                          ENDIF
     138             :                          !-gu
     139           0 :                          DO  k = 2,nq2n
     140           0 :                             IF (sym%invs2) THEN
     141             :                                READ (nu,END=200,ERR=200) &
     142           0 :                                     &                              (fzxyr(j,k-1,ivac,jsp),j=1,nmzxyn)
     143             :                                fzxy(:nmzxyn,k-1,ivac,jsp) = CMPLX(fzxyr(:nmzxyn,k-1,ivac,&
     144           0 :                                     &                                         jsp),0.)
     145             :                             ELSE
     146             :                                READ (nu,END=200,ERR=200)  &
     147           0 :                                     &                               (fzxy(j,k-1,ivac,jsp),j=1,nmzxyn)
     148             :                             END IF
     149           0 :                             IF (vacuum%nvac.EQ.1) THEN
     150           0 :                                IF (sym%invs) THEN
     151           0 :                                   DO j = 1,nmzxyn
     152           0 :                                      fzxy(j,k-1,2,jsp) = CONJG(fzxy(j,k-1,1,jsp))
     153             :                                   ENDDO
     154             :                                ELSE
     155           0 :                                   DO j = 1,nmzxyn
     156           0 :                                      fzxy(j,k-1,2,jsp) = fzxy(j,k-1,1,jsp)
     157             :                                   ENDDO
     158             :                                ENDIF
     159             :                             ENDIF
     160             :                          ENDDO
     161             :                          !+gu
     162           0 :                          DO k = 1,n_diff
     163           0 :                             READ (nu,END=200,ERR=200) dummy
     164             :                          ENDDO
     165             :                          !-gu
     166           0 :                          IF (nq2n.LT.stars%ng2) THEN
     167           0 :                             fzxy(:nmzxyn,nq2n:,ivac,jsp) = (0.,0.)
     168             :                          END IF
     169             :                       ENDIF
     170             :                    ENDDO
     171             :                 END IF
     172             :              ENDIF
     173             :           ENDDO
     174             :           !
     175           0 :           IF (sym%invs) DEALLOCATE (fpwr)
     176           0 :           IF (sym%invs2) DEALLOCATE ( fzxyr )
     177           0 :           RETURN
     178             : 
     179           0 : 200       WRITE (6,*) 'error reading dop nr.',nu
     180           0 :           IF (nu /= 98)  CALL juDFT_error("error reading d/p-file!",calledby&
     181           0 :           &     ="loddop")
     182             : 
     183           0 :         END SUBROUTINE loddop
     184             :       END MODULE m_loddop

Generated by: LCOV version 1.13