*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/14 13:10:49  mclareni
* Initial revision
*
*
#include "higz/pilot.h"
*CMZ :  1.18/05 27/05/93  09.28.13  by  O.Couet
*-- Author :
      SUBROUTINE IHLEGR(IORDR,NA,NB,FUN,DRFACE,CHOPT)
************************************************************************
*                                                                      *
*     IHLEGR                                     Date:    04.11.90     *
*     Author: E. Chernyaev (IHEP/Protvino)       Revised: 31.03.93     *
*                                                                      *
*     Function: Draw stack of lego-plots in cylindrical coordinates    *
*                                                                      *
*     References: IHWPHI, IHWVR1, IHWVR2, IHWZN                        *
*                                                                      *
*     Input: IORDR - order of variables (0 - Z,PHI; 1 - PHI,Z)         *
*            NA    - number of steps along 1st variable                *
*            NPHI  - number of steps along 2nd variable                *
*                                                                      *
*            FUN(IA,IB,NV,AB,V,TT) - external routine                  *
*              IA      - cell number for 1st variable                  *
*              IB      - cell number for 2nd variable                  *
*              NV      - number of values for given cell               *
*              AB(2,4) - coordinates of the cell corners               *
*              V(NV)   - cell values                                   *
*              TT(4,*) - additional function                           *
*                                                                      *
*            DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing  *
*              ICODES(*) - set of codes for this face                  *
*                ICODES(1) - IA                                        *
*                ICODES(2) - IB                                        *
*                ICODES(3) - IV                                        *
*                ICODES(4) - side: 1,2,3,4 - ordinary sides            *
*                                  5-bottom,6-top                      *
*              XYZ(3,*)  - coordinates of nodes                        *
*              NP        - number of nodes in face                     *
*              IFACE(NP) - face                                        *
*              T(NP)     - additional function                         *
*                                                                      *
*            CHOPT       - options: 'BF' - from BACK to FRONT          *
*                                   'FB' - from FRONT to BACK          *
*                                                                      *
************************************************************************
#include "higz/hcphi.inc"
#include "higz/pnvmax.inc"
      REAL              AB(2,4),XYZ(3,8),V(NVMAX),TT(4,NVMAX),TFACE(4)
      REAL              COSPHI(4),SINPHI(4)
      INTEGER           ICODES(4),IFACE(4),IVIS(6)
      CHARACTER*(*)     CHOPT
      EXTERNAL          FUN,DRFACE
*-
      IF (IORDR .EQ. 0) THEN
        JZ     = 1
        JPHI   = 2
        NZ     = NA
        NPHI   = NB
      ELSE
        JZ     = 2
        JPHI   = 1
        NZ     = NB
        NPHI   = NA
      END IF
      IF (NPHI .GT. NPMAX)              GOTO 998
      RAD    = ATAN(1.)*4./180.
      IOPT   = 2
      IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b')     IOPT = 1
*
**       P R E P A R E   P H I   A R R A Y
**       F I N D    C R I T I C A L   S E C T O R S
*
      KPHI   = NPHI
      IF (IORDR .EQ. 0)                 IA = NZ
      IF (IORDR .NE. 0)                 IB = NZ
      DO 10 I=1,NPHI
        IF (IORDR .EQ. 0)               IB = I
        IF (IORDR .NE. 0)               IA = I
        CALL FUN(IA,IB,NV,AB,V,TT)
        IF (I .EQ. 1)                   APHI(1)   = AB(JPHI,1)
        APHI(I)   = (APHI(I) + AB(JPHI,1))/2.
        APHI(I+1) = AB(JPHI,3)
   10 CONTINUE
      CALL IHWPHI(IOPT,KPHI,APHI,IPHI1,IPHI2)
*
**      E N C O D E   V I S I B I L I T Y   O F   S I D E S
**      A N D   O R D E R   A L O N G   R
*
      DO 20 I=1,NPHI
        IF (IORDR .EQ. 0)               IB = I
        IF (IORDR .NE. 0)               IA = I
        CALL FUN(IA,IB,NV,AB,V,TT)
        CALL IHWVR1(IOPT,AB(JPHI,1)*RAD,AB(JPHI,3)*RAD,APHI(I))
   20 CONTINUE
*
**       F I N D   O R D E R   A L O N G   Z
*
      INCRZ  = 1
      IZ1    = 1
      CALL IHWZN(0.,0.,1.,Z)
      IF ((Z.LE.0. .AND. IOPT.EQ.1) .OR. (Z.GT.0. .AND. IOPT.EQ.2)) THEN
        INCRZ  =-1
        IZ1    = NZ
      END IF
      IZ2    = NZ - IZ1 + 1
*
**       D R A W   S T A C K   O F   L E G O - P L O T S
*
      INCR   = 1
      IPHI   = IPHI1
  100 IF (IPHI .GT. NPHI)               GOTO 400
*       D E C O D E   V I S I B I L I T Y   O F   S I D E S
      CALL IHWVR2(APHI(IPHI),
     &    IVIS(5),IVIS(2),IVIS(6),IVIS(4),IVIS(1),IVIS(3),IDUMMY)
      DO 300 IZ=IZ1,IZ2,INCRZ
        IF (IORDR .EQ. 0) THEN
          IA     = IZ
          IB     = IPHI
        ELSE
          IA     = IPHI
          IB     = IZ
        END IF
        CALL FUN(IA,IB,NV,AB,V,TT)
        IF (NV.LT.2 .OR. NV.GT.NVMAX)   GOTO 300
        ICODES(1) = IA
        ICODES(2) = IB
        DO 210 I=1,4
          J          = I
          IF (IORDR.NE.0 .AND. I.EQ.2)  J = 4
          IF (IORDR.NE.0 .AND. I.EQ.4)  J = 2
          COSPHI(J)  = COS(AB(JPHI,I)*RAD)
          SINPHI(J)  = SIN(AB(JPHI,I)*RAD)
          XYZ(3,J)   = AB(JZ,I)
          XYZ(3,J+4) = AB(JZ,I)
  210   CONTINUE
*        D R A W   S T A C K
        DO 240 IV=1,NV-1
          DO 220 I=1,4
            XYZ(1,I)   = V(IV)*COSPHI(I)
            XYZ(2,I)   = V(IV)*SINPHI(I)
            XYZ(1,I+4) = V(IV+1)*COSPHI(I)
            XYZ(2,I+4) = V(IV+1)*SINPHI(I)
  220     CONTINUE
          IF (V(IV) .GE. V(IV+1))       GOTO 240
          ICODES(3) = IV
          DO 230 I=1,4
            IF (IVIS(I) .EQ. 0)           GOTO 230
            K1        = I
            K2        = I - 1
            IF (I .EQ. 1)                 K2 = 4
            IFACE(1)  = K1
            IFACE(2)  = K2
            IFACE(3)  = K2 + 4
            IFACE(4)  = K1 + 4
            TFACE(1)  = TT(K1,IV)
            TFACE(2)  = TT(K2,IV)
            TFACE(3)  = TT(K2,IV+1)
            TFACE(4)  = TT(K1,IV+1)
            ICODES(4) = I
            CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
  230     CONTINUE
  240   CONTINUE
*        D R A W   B O T T O M   F A C E
        IF (IVIS(5).NE.0 .AND. V(1).GT.0.) THEN
          ICODES(3) = 1
          ICODES(4) = 5
          DO 250 I=1,4
            XYZ(1,I) = V(1)*COSPHI(I)
            XYZ(2,I) = V(1)*SINPHI(I)
            IFACE(I) = I
            TFACE(I) = TT(I,1)
  250     CONTINUE
          CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
        END IF
*        D R A W   T O P   F A C E
        IF (IVIS(6).NE.0 .AND. V(NV).GT.0.) THEN
          ICODES(3) = NV - 1
          ICODES(4) = 6
          DO 260 I=1,4
            IFACE(I) = 5 - I + 4
            TFACE(I) = TT(5-I,NV)
  260     CONTINUE
          CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
        END IF
  300 CONTINUE
*        N E X T   P H I
  400 IPHI   = IPHI + INCR
      IF (IPHI .EQ. 0)                  IPHI = KPHI
      IF (IPHI .GT. KPHI)               IPHI = 1
      IF (IPHI .NE. IPHI2)              GOTO 100
      IF (INCR) 410,999,420
  410 INCR   = 0
      GOTO 100
  420 INCR   =-1
      IPHI   = IPHI1
      GOTO 400
*
  998 WRITE(*,*) 'IHLEGR: too many PHI sectors'
  999 RETURN
      END
