CalorimeterLevel2/src/baric.for

C
C------------------------------------------------------
      SUBROUTINE BARIC(Q,INF,ISUP,BAR,EPLA4,INDEX)
C------------------------------------------------------
      INCLUDE 'INTEST.TXT'
      REAL Q(NCHA)
      REAL BAR

      COMMON / SHIFT / SHIFT
      SAVE / SHIFT /

      CM = 0.
      EPLA4 = 0.
      DO LL = INF,ISUP
        ENN = Q(LL)
        IF (ENN.GT.EMIN) THEN
C
          CALL MILLIM(LL,RMM)
          CM = CM + RMM * ENN
          EPLA4 = EPLA4 + ENN
        ENDIF
      ENDDO
      IF (EPLA4.EQ.0) GO TO 300
      BAR = CM / EPLA4
      GOTO 400
C
  300 INDEX = 0
      GOTO 500
C
  400 INDEX = 1
C
  500 CONTINUE
      RETURN
      END
C
1	mocchiut	1.1	C
2			C------------------------------------------------------
3			SUBROUTINE BARIC(Q,INF,ISUP,BAR,EPLA4,INDEX)
4			C------------------------------------------------------
5			INCLUDE 'INTEST.TXT'
6			REAL Q(NCHA)
7			REAL BAR
8
9			COMMON / SHIFT / SHIFT
10			SAVE / SHIFT /
11
12			CM = 0.
13			EPLA4 = 0.
14			DO LL = INF,ISUP
15			ENN = Q(LL)
16			IF (ENN.GT.EMIN) THEN
17			C
18			CALL MILLIM(LL,RMM)
19			CM = CM + RMM * ENN
20			EPLA4 = EPLA4 + ENN
21			ENDIF
22			ENDDO
23			IF (EPLA4.EQ.0) GO TO 300
24			BAR = CM / EPLA4
25			GOTO 400
26			C
27			300 INDEX = 0
28			GOTO 500
29			C
30			400 INDEX = 1
31			C
32			500 CONTINUE
33			RETURN
34			END
35			C