SUBROUTINE DUBSC(INDIC,QQQ) C---------------------------------------------------------------------- C- C- Purpose and Methods : C- C- Inputs : C- Outputs : C- Controls: C- C- Created 30-MAR-1995 MIRKO BOEZIO C- C---------------------------------------------------------------------- IMPLICIT NONE INCLUDE 'INTEST.TXT' REAL QQQ REAL RIL(NCHA/2) REAL DBNCL(4) REAL DBCLUS(4,NCHA) REAL RR, RRR, DAD INTEGER I, J, K, M, L, LL, LK INTEGER ITL, LPIANO INTEGER INDIC, NGIR, ISTOP INTEGER LVMAX C REAL BAR(2,NPLAV) INTEGER IBAR(2,NPLAV) C COMMON / ANGOLO / BAR, IBAR SAVE / ANGOLO / C C Begin! C LPIANO = NPLA / 2 C DO K = 1,NCHA/2 RIL(K) = 0. ENDDO C DO J = 1,4 DO K = 1,NCHA DBCLUS(J,K) = CLUS4(1,J,K) ENDDO DBNCL(J) = NCL4(1,J) ENDDO C QQQ = 0. INDIC = 0 NGIR = 0 M = 1 C DO 5 J = 1,2 C DO I = 1,NGIR RIL(I) = 0. ENDDO C C IF (J.EQ.1) ITL = (LPIANO-6 + 1) / 2 IF (J.EQ.2) ITL = (LPIANO + LPIANO-6 + 1) / 2 DAD = BAR(M,ITL) C NGIR = NCL4(M,J) IF (NGIR.EQ.0) GO TO 5 DO L = 1,NGIR RR = ABS(DAD - CLUS4(M,J,L)) IF (RR.LE.15) THEN DBNCL(J) = DBNCL(J) - 1 DBCLUS(J,L) = 0. DBCLUS(J,L+NCHA/2) = 0. ENDIF ENDDO C 5 CONTINUE C NGIR = NCL4(M,1) DO I = 1,NCHA/2 RIL(I) = 0. ENDDO IF (NGIR.GE.1) THEN DO LL = 1,NGIR IF (DBCLUS(1,LL).GT.0) RIL(LL) = DBCLUS(1,LL+NCHA/2) ENDDO c 7 ENDIF ENDIF LK = LVMAX(RIL,NCHA/2) QQQ = QQQ + DBCLUS(1,LK+NCHA/2) RRR = DBCLUS(1,LK) C NGIR = NCL4(M,2) IF (NGIR.GE.1) THEN DO LL = 1,NGIR RR = ABS(RRR - DBCLUS(2,LL)) IF (RR.LE.20) THEN QQQ = QQQ + DBCLUS(2,LL+NCHA/2) ENDIF ENDDO ENDIF C ISTOP = 0 C IF (QQQ.GT.30.AND.ISTOP.EQ.0) INDIC = 1 C C c 400 CONTINUE CONTINUE C---------------------------------------------------------------------- c999 RETURN RETURN END