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

          Line data    Source code
       1             :       MODULE m_writestruct
       2             : !********************************************************************
       3             : !     write structure in povray format
       4             : !     usage:  povray +i struct.pov
       5             : !     maybe:   +H750 +W1000 +L/usr/local/lib/povray3/include 
       6             : !********************************************************************
       7             :       CONTAINS
       8           0 :       SUBROUTINE write_struct(
       9           0 :      >                        ntype,nat,neq,
      10           0 :      >                        rmt,pos,natmap,amat)
      11             : 
      12             :      
      13             :       IMPLICIT NONE
      14             : 
      15             : !===> Arguments
      16             : 
      17             :       INTEGER, INTENT (IN) :: ntype,nat
      18             :       INTEGER, INTENT (IN) :: natmap(nat),neq(ntype)
      19             :       REAL,    INTENT (IN) :: rmt(ntype),pos(3,nat),amat(3,3)
      20             : 
      21             : !===> Local Variables
      22             : 
      23             :       INTEGER       :: i,n,na,nn
      24             :       REAL          :: posc(3),col(3,12)
      25             : 
      26             :       DATA col/ 1.0,0.0,0.0, 0.0,1.0,0.0, 0.0,0.0,1.0,
      27             :      +          0.0,1.0,1.0, 1.0,0.0,1.0, 1.0,1.0,0.0,
      28             :      +          0.0,0.5,1.0, 0.5,0.0,1.0, 0.5,1.0,0.0,
      29             :      +          0.0,1.0,0.5, 1.0,0.0,0.5, 1.0,0.5,0.0/
      30             : 
      31             : !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      32           0 :       OPEN (45,file='struct.pov',form='formatted',status='unknown')
      33             : !
      34             : ! --> header information
      35             : !
      36           0 :       WRITE (45,*) '#include "colors.inc"'
      37           0 :       WRITE (45,*) '#include "shapes.inc"'
      38           0 :       WRITE (45,*) 'global_settings { max_trace_level 20 '
      39           0 :       WRITE (45,*) '                  assumed_gamma 2.2 }'
      40           0 :       WRITE (45,*) 'light_source { <60,-10,-10>'
      41           0 :       WRITE (45,*) '              color rgb <2.5,2.5,2.5> }'
      42           0 :       WRITE (45,*) 'camera { location <90,10,10>'
      43           0 :       WRITE (45,*) '         look_at <0.0,0.0,0.0> angle 20 }'
      44           0 :       WRITE (45,*) 'background {color White}'
      45             : !
      46             : ! --> colors etc.
      47             : !
      48           0 :       WRITE (45,*) ' #declare R1 =  pigment{ color Black } '
      49           0 :       WRITE (45,*) ' #declare Rd =  0.05 ;'
      50           0 :       DO nn = 1,ntype
      51           0 :         i = mod(nn-1,12) + 1
      52           0 :         IF ( nn < 10 ) THEN
      53           0 :           WRITE (45,1005) nn,col(:,i)
      54             :         ELSE
      55           0 :           WRITE (45,1006) nn,col(:,i)
      56             :         ENDIF
      57             :       ENDDO
      58             :  1005 FORMAT ('#declare Acol',i1,'= color rgb <',3f4.1,'>;')     
      59             :  1006 FORMAT ('#declare Acol',i2,'= color rgb <',3f4.1,'>;')     
      60             : 
      61             : !---> output the atomic definitions 
      62             : 
      63           0 :       DO nn = 1,ntype
      64           0 :         IF ( nn < 10 ) THEN
      65           0 :           WRITE (45,1010) nn,nn
      66             :         ELSE
      67           0 :           WRITE (45,1011) nn,nn
      68             :         ENDIF
      69             :       ENDDO
      70             :  1010 FORMAT ('#declare Atom',i1,' = pigment { Acol',i1,' }')
      71             :  1011 FORMAT ('#declare Atom',i2,' = pigment { Acol',i2,' }')
      72             :       
      73           0 :       WRITE (45,1015)
      74             :  1015 FORMAT (/,'#declare Ascale = 0.80 ;')
      75             : 
      76           0 :       DO nn = 1,ntype
      77           0 :         IF ( nn < 10 ) THEN
      78           0 :           WRITE (45,1030) nn,rmt(nn)
      79             :         ELSE
      80           0 :           WRITE (45,1031) nn,rmt(nn)
      81             :         ENDIF
      82             :       ENDDO
      83             :  1030 FORMAT ('#declare Asize',i1,' = ',f6.3,'*Ascale ;')
      84             :  1031 FORMAT ('#declare Asize',i2,' = ',f6.3,'*Ascale ;')
      85             : 
      86             : 
      87             : !---> output the atomic positions
      88             : 
      89           0 :       na = 0
      90           0 :       DO nn = 1, ntype
      91           0 :          DO n = 1, neq(nn)
      92             :            !CALL cotra0(pos(:,natmap(na+n)),posc,amat)
      93           0 :            posc=matmul(amat,pos(:,natmap(na+n)))
      94             : !           DO i = 1, 2
      95             : !             IF (posc(i).LT.0) posc(i) = posc(i) + amat(i,i)
      96             : !           ENDDO
      97           0 :            IF ( nn < 10 ) THEN
      98             :             WRITE (45,1020)
      99           0 :      &           posc(:),nn,nn,nn,natmap(na+n)
     100             :           ELSE
     101             :             WRITE (45,1021)
     102           0 :      &           posc(:),nn,nn,nn,natmap(na+n)
     103             :           ENDIF
     104             :          ENDDO
     105           0 :          na = na + neq(nn)
     106             :       ENDDO
     107             :  1020 FORMAT('sphere { <',3(f8.3,','),'>, Asize',i1,' texture { Atom',
     108             :      &       i1,' } } // ',2i4)
     109             :  1021 FORMAT('sphere { <',3(f8.3,','),'>, Asize',i2,' texture { Atom',
     110             :      &       i2,' } } // ',2i4)
     111             : 
     112             : 
     113             : !---> output the primitive cell
     114             : 
     115           0 :       DO i = 1,3
     116           0 :          WRITE (45,2000) 0.0, 0.0, 0.0, amat(:,i)
     117           0 :          WRITE (45,2000) -amat(:,i)/2, amat(:,i)/2
     118             :       ENDDO
     119             :  2000 FORMAT('cylinder { ',2('<',3(f8.3,','),'>,'),
     120             :      &                   ' Rd texture { R1 } }')
     121             : 
     122           0 :       CLOSE (45)
     123             : 
     124           0 :       END SUBROUTINE write_struct
     125             :       END MODULE m_writestruct

Generated by: LCOV version 1.13