*$ CREATE LATTIC.FOR
*COPY LATTIC
*
*=== lattic ===========================================================*
*
      SUBROUTINE LATTIC ( XB, WB, DIST, SB, UB, IR, IRLTGG, IFLAG )

      INCLUDE '(DBLPRC)'
      INCLUDE '(DIMPAR)'
      INCLUDE '(IOUNIT)'
      INCLUDE '(RTGMMV)'
*----------------------------------------------------------------------*
*     LATTIC: user written routine which must return the tracking point*
*     and direction ( SB, UB ) corresponding to region number IR, cell *
*     number IRLTGG and real position/direction XB, WB                 *
*                                                                      *
*     Created on 16 December 1993  by    Alfredo Ferrari & Paola Sala  *
*                                                   Infn - Milan       *
*                                                                      *
*     Last change on 26-may-98     by    Alfredo Ferrari               *
*----------------------------------------------------------------------*
*
      LOGICAL LFIRST
      DIMENSION XB (3), WB (3), SB (3), UB (3), UN (3)
      DATA LFIRST /.TRUE./
*
      IF ( LFIRST ) THEN
         LFIRST = .FALSE.
      END IF
*
      IF ( IRLTGG.GT.100.AND.IRLTGG.LT.111 ) THEN
*      IRLTGG + 1
*      WRITE(LUNOUT,*)' *** Lattice geometry non supported !!! ***'
*     &     ,IRLTGG
*      STOP
         IF(MOD((IRLTGG+1),2).EQ.0) THEN
            SB (1) = XB (1) - 0.06
         ELSE
            SB (1) = XB (1)
         ENDIF
         SB (2) = XB (2)
         SB (3) = XB (3) - 1.200000000000001D-01 * ( IRLTGG - 100 ) 
         UB (1) = WB (1)
         UB (2) = WB (2)
         UB (3) = WB (3)
      ELSE
          WRITE (LUNOUT,*)' NON-EXISTENT LATTICE: ',IRLTGG
*          CALL FLABRT( 'LATTIC','LATTIC')
      ENDIF  
*      GO TO 9999
* 9999 CONTINUE
      RETURN
*
      ENTRY LATNOR ( UN, IRLTNO )
*
*----------------------------------------------------------------------*
*     LATtice cell NORmal transformation:                              *
*                                                                      *
*     Input variables:  un(i) = normal components in the tracking re-  *
*                               ference system                         *
*                       irltno = present lattice cell #                *
*     Output variables:  un(i) = normal components in the problem re-  *
*                                ference system                        *
*----------------------------------------------------------------------*
*
      IF ( IRLTNO .GT.  100 ) THEN
*           WRITE(LUNOUT,*)' *** Lattice geometry non supported !!! ***'
*     &                   ,IRLTNO
*         STOP
         UN (1) = UN (1)
         UN (2) = UN (2)
         UN (3) = UN (3)
      ENDIF
      RETURN
*=== End of subroutine lattic =========================================*
      END