c$debug
c***********************************************************************
      SUBROUTINE BCHCK3
c
c     Subroutine for control of routines for integration, solving the coupled
c     equations and calculating the cross sections, 
c     calls INTEG3, SOLVE and XSECT
c     
c***********************************************************************
c
C     KMAX  = Number of integration points
C     NCHAN = Number of sub channels in INTEG2
c     ispc  = Labeled common sizes
c     nlev  = Number of levels
c
      parameter (kmax = 300, nchan = 64, ispc0 = 16384, ispc1 = 3*16384
     1, ispc4 = 8192, nlkmax = ispc1/2/kmax, nlev = 12)
c
      COMMON ALPHA(15),HBARC,AMU,CHGSQ,DRT,RMAX
     1,ICON(20),LMAX,KT,MAXD,IOUT,JOUT,NLTR,IDAT(6)
     2,KLAM(nlev),LTRT(nlev),JTRT(nlev),NADD(nlev)
      COMMON EN(nlev),FM(nlev),Z(nlev),FMA(nlev),ZA(nlev),RY(nlev)
     1,FS(nlev),ECM(nlev),FMU(nlev),RC(nlev),FK2(nlev),FK(nlev)
     2,ETA(nlev),AFACT(nlev),PFACT(nlev),DRF(nlev),FN(nlev)
     3,PNLOC(nlev),DUM(nlev),TSIG(nlev)
     4,IS(nlev),NS(nlev),NLI(nlev),IN(nlev),INN(nlev,nlev)
     5,LAM(nlkmax),ISP(nlkmax),JSP(nlkmax),ILK(nlkmax)
     6,LKTAB(2*nlkmax),ICUP(2*nlkmax),JCUP(2*nlkmax)
c
      COMMON /label0/ space0(ispc0)
      COMMON /label1/ space1(ispc1)
      COMMON /LLL   /NLVAL,NBLKS,NLMIN,NLDEL,MAXTAB(nlev)
     1,INDTAB(nlev+2)
	common/ch3files/input, ioutp
c
      DIMENSION    D(ispc0)
c
      EQUIVALENCE (space0(   1),D(1))
C
      CALL SECOND(TIME)
      if(icon(19).eq.0) then
      WRITE(ioutp,9007)'Bchck3',TIME
      WRITE(ioutp,9007)'Integ3',TIME
      endif
c
      CALL INTEG3
c
      IF(IOUT.EQ.0) GO TO 481
      WRITE(ioutp,9030)IOUT
      RETURN
C
C
  481 CONTINUE
C
C
      CALL SECOND(TIME)
      if(icon(19).eq.0) then
      WRITE(ioutp,9007)'Solve ',TIME
      endif
      IOUT=0
c
      CALL SOLVE
c
C     ERROR TEST FOR SOLVE
      IF(IOUT.NE.0) RETURN
C
C
C
      IF(ICON( 8).EQ.0) GO TO 700
C
C     WRITE OUT AMPLITUDES
C
      MAX1=JTRT(1)+1
      if(icon(19).eq.0) then
      WRITE(ioutp,9019)ALPHA,(IDAT(I),I=1,3)
      endif
C
      if(icon(19).eq.0) then
      DO 610 NB=1,NBLKS
      JA1=1
      JA2=LMAX
      IF(NBLKS.EQ.1) GO TO 580
      DO 570 I=1,NLTR
      READ (2)I1,I2,JA1,JA2,(D(IT),IT=I1,I2)
  570 CONTINUE
  580 CONTINUE
      DO 605 I=1,NLTR
      IND=INDTAB(I)
      MAXI=JTRT(I)+1
      KST=2*MAXTAB(I)*MAXTAB(1)
      WRITE(ioutp,9060)I
      DO 590 L=JA1,JA2
      LTEMP=L-1
      K1=IND
      K2=IND+KST-1
      WRITE(ioutp,9061)LTEMP,(D(J+1),J=K1,K2)
      IND=K2+1
  590 CONTINUE
  605 CONTINUE
  610 CONTINUE
      REWIND 2
      endif
  700 CONTINUE
      CALL SECOND(TIME)
      if(icon(19).eq.0) then
      WRITE(ioutp,9007)'Xsect ',TIME
      endif
C
C
      CALL XSECT
C
C
      RETURN
 9007 FORMAT('0Subroutine ',A6,' called, elapsed time =',F9.2)
 9019 FORMAT(1H1,17X,15A4,I4.2,2(1H/,I2.2),I4.2,2(1H.,I2.2))
 9030 FORMAT(27H0TOO MANY CHANNELS, NCHAN=  ,I3,90(1H$))
 9060 FORMAT(5H0CHN=,I2,100(1H*))
 9061 FORMAT(5H  L2=,I3,2X,1P10E12.4/(10X,1P10E12.4))
      END

