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(stars,vacuum,atoms,sphhar,input,sym,nu,&
       8           0 :                           it,fr,fpw,fvac)
       9             : 
      10             :           USE m_constants
      11             :           USE m_types
      12             : 
      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             :           INTEGER, INTENT (IN) :: nu 
      23             :           INTEGER, INTENT (IN) :: it   
      24             :           !     ..
      25             :           !     .. Array Arguments ..
      26             :           COMPLEX, INTENT (IN):: fpw(:,:),fvac(:,:,:,:) !(stars%ng3,input%jspins)
      27             :           REAL,    INTENT (IN):: fr(:,0:,:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),
      28             :           !REAL,    INTENT (IN):: fz(:,:,:)!(vacuum%nmzd,2,input%jspins)
      29             :           CHARACTER(len=8):: dop,iop,name(10)
      30             :           !     .. Local Scalars ..
      31             :           INTEGER i,ivac,izn,jsp,k,lh,n,na
      32             :           !     ..
      33             :           !     .. Intrinsic Functions ..
      34             :           INTRINSIC REAL
      35             :           !     ..
      36             :           !Defaults, as the character arrays are no longer used, we should
      37             :           !write some defaults for old fleur-versions
      38           0 :           name    ='        '
      39           0 :           name(10)='ordered*'
      40           0 :           dop     ='in/out  '
      41           0 :           iop     ='char/pot'
      42           0 :           WRITE (nu) name
      43             :           !          WRITE (oUnit,FMT=8000) name
      44             : 8000      FORMAT (' wrtdop title:',10a8)
      45           0 :           WRITE (nu) iop,dop,it
      46           0 :           DO jsp = 1,SIZE(fr,4)
      47           0 :              WRITE (nu) jsp
      48           0 :              WRITE (nu) atoms%ntype
      49           0 :              DO n = 1,atoms%ntype
      50           0 :                 na = atoms%firstAtom(n)
      51           0 :                 izn = atoms%zatom(n) + 0.01
      52           0 :                 WRITE (nu) namat_const(izn),n,atoms%jri(n),atoms%rmt(n),atoms%dx(n)
      53           0 :                 WRITE (nu) sym%ntypsy(na),sphhar%nlh(sym%ntypsy(na))
      54           0 :                 DO  lh = 0,sphhar%nlh(sym%ntypsy(na))
      55           0 :                    WRITE (nu) lh
      56           0 :                    WRITE (nu) (fr(i,lh,n,jsp),i=1,atoms%jri(n))
      57             :                 ENDDO
      58             :              ENDDO
      59           0 :              IF (jsp<=SIZE(fpw,2)) THEN
      60           0 :                 WRITE (nu) stars%ng3
      61           0 :                 IF (sym%invs) THEN
      62           0 :                    WRITE (nu) (REAL(fpw(k,jsp)),k=1,stars%ng3)
      63             :                 ELSE
      64           0 :                    WRITE (nu) (fpw(k,jsp),k=1,stars%ng3)
      65             :                 END IF
      66             :              ENDIF
      67           0 :              IF (input%film) THEN
      68           0 :               IF (jsp<=SIZE(fvac,4)) THEN
      69           0 :                  DO  ivac = 1,vacuum%nvac
      70           0 :                     WRITE (nu) ivac
      71           0 :                     WRITE (nu) vacuum%nmz,vacuum%dvac,vacuum%delz
      72           0 :                     WRITE (nu) (fvac(i,1,ivac,jsp),i=1,vacuum%nmz)
      73           0 :                     IF (jsp<=SIZE(fvac,4)) THEN
      74           0 :                        WRITE (nu) stars%ng2,vacuum%nmzxy
      75             :                        !IF (sym%invs2) THEN
      76             :                        !   WRITE (nu) (REAL(fvac(i,1,ivac,jsp)),i=1,vacuum%nmz)
      77             :                        !ELSE
      78             :                        !   WRITE (nu) (fvac(i,1,ivac,jsp),i=1,vacuum%nmz)
      79             :                        !END IF
      80           0 :                        DO  k = 2,stars%ng2
      81           0 :                           IF (sym%invs2) THEN
      82           0 :                              WRITE (nu) (REAL(fvac(i,k,ivac,jsp)),i=1,vacuum%nmzxy)
      83             :                           ELSE
      84           0 :                              WRITE (nu) (fvac(i,k,ivac,jsp),i=1,vacuum%nmzxy)
      85             :                           END IF
      86             :                        ENDDO
      87             :                     ENDIF
      88             :                  ENDDO
      89             :               END IF
      90             :            ENDIF
      91             :           ENDDO
      92             :           !
      93           0 :           RETURN
      94             :         END SUBROUTINE wrtdop
      95             :       END MODULE m_wrtdop
      96             :