      SUBROUTINE TARPRSM(A1,A2,A,BA,CA,LA,DX,CDESCR,IOSHP,MXNAT,
     &                   NAT,IXYZ,ICOMP)
      IMPLICIT NONE

C Arguments:

      CHARACTER CDESCR*67
      INTEGER IOSHP,MXNAT,NAT
      INTEGER*2 ICOMP(MXNAT,3),IXYZ(MXNAT,3)
      REAL A,BA,CA,LA

C Array arguments:

      REAL A1(3),A2(3),DX(3)

C Local scalars:

      CHARACTER CMSGNM*70
      INTEGER JA,JX,JY,JZ,NFAC,NLAY,NX,NY,NZ

      REAL
     &   B,BETA,C,COTBETA,COTGAMMA,GAMMA,L,
     &   XMAX,XMIN,Y,YMAX,YMIN,Z,ZMAX,ZMIN

C***********************************************************************
C Routine to construct triangular prism from "atoms".
C triangle side lengths = a,b,c ; prism length = L
C prism axis is assumed to be in x direction
C normal to prism face of width a : (0,1,0)
C normal to prism face of width b : (0,-cos(gamma),sin(gamma))
C normal to prism face of width c : (0,-cos(beta),-sin(beta))
C angles alpha,beta,gamma are opposite sides a,b,c

C first layer of target array is at x=0 (target boundary at x=-0.5)
C layer along side a is at int(b*sin(gamma))
C      boundary is at ymax=int(b*sin(gamma))+0.5
C Input:
C        A      = a/d
C        BA     = b/a
C        CA     = c/a
C        LA     = L/a
C        DX(1-3)=(dx,dy,dz)/d where dx,dy,dz=lattice spacings in x,y,z
C                directions, and d=(dx*dy*dz)**(1/3)=effective lattice
C                spacing
C        IOSHP  =device number for "target.out" file
C               =-1 to suppress printing of "target.out"
C        MXNAT  =dimensioning information (max number of atoms)
C Output:
C        A1(1-3)=unit vector (1,0,0) defining target axis 1 (prism axis)
C        A2(1-3)=unit vector (0,1,0) defining target axis 2 (normal to
C                rectangular faces with sides a,L
C        NAT=number of atoms in target
C        IXYZ(1-NAT,1-3)=x/d,y/d,z/d for atoms of target
C        ICOMP(1-NAT,1-3)=dielectric function identifier for dipole
C                         locations and 3 directions in space
C        CDESCR=string describing target (up to 67 chars.)
C
C B.T.Draine, Princeton Univ. Obs., 2002.02.12
C
C History:
C 02.02.12 (BTD): adapted from tarprsm.f for ver5a10
C 04.02.25 (BTD): corrected typographical error found by In-Ho Lee
C 06.02.15 (BTD): modified write statement to elminate obvious error
C                 found by K. Lance Kelly
C end history
C
C Copyright (C) 2002,2004,2006 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C-----------------------------------------------------------------------

C Current version of TARPRSM is restricted to cubic lattices

      IF(DX(1).NE.1..OR.DX(2).NE.1.)THEN
         CALL ERRMSG('FATAL','TARPRSM',
     &               ' tarprsm does not support noncubic lattice')
      ENDIF

      DO JA=1,3
         A1(JA)=0.
         A2(JA)=0.
      ENDDO
      A1(1)=1.
      A2(2)=1.

C A = a/d
C B = b/d
C C = c/d
C L = L/d

      B=BA*A
      C=CA*A
      L=LA*A

c sanity check:

      IF((A.GE.B+C).OR.(B.GE.A+C).OR.(C.GE.A+B))
     &    CALL ERRMSG('FATAL','TARPRSM',
     &'prism sides a,b,c do not satisfy triangle inequality:check input'
     &)

      BETA=ACOS((A*A+C*C-B*B)/(2.*A*C))
      GAMMA=ACOS((A*A+B*B-C*C)/(2.*A*B))
      COTBETA=COS(BETA)/SIN(BETA)
      COTGAMMA=COS(GAMMA)/SIN(GAMMA)

c ideal prism extent:
c    x = xmin to x=xmax
c    triangle vertices at (0,ymax,zmin),(0,ymax,zmax),(0,ymin,za)
c    where xmin=-0.5
c          xmax=xmin+L
c          ymax=int[b*sin(gamma)]+0.5
c          ymin=ymax-b*sin(gamma)
c          zmax=a/2
c          zmin=-a/2
c          za=-a/2+c*cos(beta)

      XMIN=-0.5
      XMAX=XMIN+L
      YMAX=INT(B*SIN(GAMMA))+0.5
      YMIN=YMAX-B*SIN(GAMMA)
      ZMAX=0.5*A
      ZMIN=-ZMAX

C Now determine limits for testing x,y,z values
C Along axis (x), run from 0 to NX=INT(XMAX)
C Along y direction, run from 0 to NY=INT(YMAX)
C Along z direction, run from -NZ to NZ=INT(ZMAX)

      NX=INT(XMAX)
      NY=INT(YMAX)
      NZ=INT(ZMAX)

      NAT=0
      DO JZ=-NZ,NZ
         Z=REAL(JZ)
         DO JY=0,NY
            Y=REAL(JY)
            IF((Z.LE.ZMAX+(Y-YMAX)*COTGAMMA)
     &         .AND.
     &         (Z.GE.ZMIN-(Y-YMAX)*COTBETA))THEN
               DO JX=0,NX
                  NAT=NAT+1
                  IXYZ(NAT,1)=JX
                  IXYZ(NAT,2)=JY
                  IXYZ(NAT,3)=JZ
               ENDDO
            ENDIF
         ENDDO
      ENDDO

      NLAY=NX+1
      NFAC=NAT/NLAY

      DO JX=1,3
         DO JA=1,NAT
            ICOMP(JA,JX)=1
         ENDDO
      ENDDO

C Note: string CDESCR will be printed by subr. TARGET

      WRITE(CDESCR,FMT='(A,I7,A)')' Triangular prism of NAT=',NAT,
     &                             ' dipoles'

C Here print any additional target info which is desired by using
C subroutine WRIMSG

      WRITE(CMSGNM,FMT='(A,3F7.4,A)')
     &    ' A1 = (',A1,') = prism axis direction'
      CALL WRIMSG('TARPRSM',CMSGNM)
      WRITE(CMSGNM,FMT='(A,3F7.4,A)')
     &    ' A2 = (',A2,') = normal to face of width a'
      CALL WRIMSG('TARPRSM',CMSGNM)
      WRITE(CMSGNM,FMT='(A,I7,A,I4,A,I4)')
     &    ' NAT=',NAT,' NFAC=',NFAC,' NLAY=',NLAY
      CALL WRIMSG('TARPRSM',CMSGNM)
      WRITE(CDESCR,FMT='(A,F7.4,A,F8.4,A,F7.4,A,F8.4)')
     &    ' tri.prism: a/d=',A,
     &    ' b/a=',BA,' c/a=',CA,' L/a=',LA

C Now store atom coordinates in file

      IF(IOSHP.GT.0)THEN
         OPEN(UNIT=IOSHP,FILE='target.out',STATUS='UNKNOWN')

C*** 3 lines of general description allowed:

         WRITE(IOSHP,9020)A,BA,CA,LA,NAT,A1,A2

C***

         DO JX=1,NAT
            WRITE(IOSHP,FMT=9030)JX,IXYZ(JX,1),IXYZ(JX,2),IXYZ(JX,3),
     &                           ICOMP(JX,1),ICOMP(JX,2),ICOMP(JX,3)
         ENDDO
         CLOSE(UNIT=IOSHP)
      ENDIF
      RETURN
 9020 FORMAT(
     &   ' Triangular Prism:  a/d=',F7.4,' b/a=',F7.4,' c/a=',F7.4,
     &   ' L/a=',F7.4,/,
     &   I7,'= NAT. Prism axis along x, rect. face a normal to y',/,
     &   3F9.4,' = A_1 vector',/,
     &   3F9.4,' = A_2 vector',/,
     &   '1.00 1.00 1.00 = lattice spacings (d_x,d_y,d_z)/d',/,
     &   '     JA  IX  IY  IZ ICOMP(x,y,z)')
 9030 FORMAT(I7,3I4,3I2)
      END
