SUBROUTINE  RN2GB(B, D, DR, IV, LIV, LV, N, ND, N1, N2, P, R,
     1                  RD, V, X)
C
C  ***  REVISED ITERATION DRIVER FOR NL2SOL WITH SIMPLE BOUNDS  ***
C
      INTEGER LIV, LV, N, ND, N1, N2, P
      INTEGER IV(LIV)
      REAL B(2,P), D(P), DR(ND,P), R(ND), RD(ND), V(LV),
     1                 X(P)
C
C--------------------------  PARAMETER USAGE  --------------------------
C
C B........ BOUNDS ON X.
C D........ SCALE VECTOR.
C DR....... DERIVATIVES OF R AT X.
C IV....... INTEGER VALUES ARRAY.
C LIV...... LENGTH OF IV... LIV MUST BE AT LEAST 4*P + 82.
C LV....... LENGTH OF V...  LV  MUST BE AT LEAST 105 + P*(2*P+20).
C N........ TOTAL NUMBER OF RESIDUALS.
C ND....... MAX. NO. OF RESIDUALS PASSED ON ONE CALL.
C N1....... LOWEST  ROW INDEX FOR RESIDUALS SUPPLIED THIS TIME.
C N2....... HIGHEST ROW INDEX FOR RESIDUALS SUPPLIED THIS TIME.
C P........ NUMBER OF PARAMETERS (COMPONENTS OF X) BEING ESTIMATED.
C R........ RESIDUALS.
C V........ FLOATING-POINT VALUES ARRAY.
C X........ PARAMETER VECTOR BEING ESTIMATED (INPUT = INITIAL GUESS,
C             OUTPUT = BEST VALUE FOUND).
C
C  ***  DISCUSSION  ***
C
C     THIS ROUTINE CARRIES OUT ITERATIONS FOR SOLVING NONLINEAR
C  LEAST SQUARES PROBLEMS.  IT IS SIMILAR TO   RN2G, EXCEPT THAT
C  THIS ROUTINE ENFORCES THE BOUNDS  B(1,I) .LE. X(I) .LE. B(2,I),
C  I = 1(1)P.
C
C  ***  GENERAL  ***
C
C     CODED BY DAVID M. GAY.
C
C+++++++++++++++++++++++++++++  DECLARATIONS  ++++++++++++++++++++++++++
C
C  ***  EXTERNAL FUNCTIONS AND SUBROUTINES  ***
C
      REAL  D7TPR,  V2NRM
      EXTERNAL IVSET,  D7TPR, D7UPD,  G7ITB, ITSUM, L7VML,  Q7APL,
     1         Q7RAD,  R7TVM, V7CPY,  V7SCP,  V2NRM
C
C IVSET.... PROVIDES DEFAULT IV AND V INPUT COMPONENTS.
C  D7TPR... COMPUTES INNER PRODUCT OF TWO VECTORS.
C D7UPD...  UPDATES SCALE VECTOR D.
C  G7ITB... PERFORMS BASIC MINIMIZATION ALGORITHM.
C ITSUM.... PRINTS ITERATION SUMMARY, INFO ABOUT INITIAL AND FINAL X.
C L7VML.... COMPUTES L * V, V = VECTOR, L = LOWER TRIANGULAR MATRIX.
C  Q7APL... APPLIES QR TRANSFORMATIONS STORED BY Q7RAD.
C Q7RAD.... ADDS A NEW BLOCK OF ROWS TO QR DECOMPOSITION.
C  R7TVM... MULT. VECTOR BY TRANS. OF UPPER TRIANG. MATRIX FROM QR FACT.
C V7CPY.... COPIES ONE VECTOR TO ANOTHER.
C  V7SCP... SETS ALL ELEMENTS OF A VECTOR TO A SCALAR.
C  V2NRM... RETURNS THE 2-NORM OF A VECTOR.
C
C
C  ***  LOCAL VARIABLES  ***
C
      INTEGER G1, GI, I, IV1, IVMODE, JTOL1, L, LH, NN, QTR1,
     1        RD1, RMAT1, YI, Y1
      REAL T
C
      REAL HALF, ZERO
C
C  ***  SUBSCRIPTS FOR IV AND V  ***
C
      INTEGER DINIT, DTYPE, DTINIT, D0INIT, F, G, JCN, JTOL, MODE,
     1        NEXTV, NF0, NF00, NF1, NFCALL, NFCOV, NFGCAL, QTR, RDREQ,
     1        REGD, RESTOR, RLIMIT, RMAT, TOOBIG, VNEED
C
C  ***  IV SUBSCRIPT VALUES  ***
C
C/6
C     DATA DTYPE/16/, G/28/, JCN/66/, JTOL/59/, MODE/35/, NEXTV/47/,
C    1     NF0/68/, NF00/81/, NF1/69/, NFCALL/6/, NFCOV/52/, NFGCAL/7/,
C    2     QTR/77/, RDREQ/57/, RESTOR/9/, REGD/67/, RMAT/78/, TOOBIG/2/,
C    3     VNEED/4/
C/7
      PARAMETER (DTYPE=16, G=28, JCN=66, JTOL=59, MODE=35, NEXTV=47,
     1           NF0=68, NF00=81, NF1=69, NFCALL=6, NFCOV=52, NFGCAL=7,
     2           QTR=77, RDREQ=57, RESTOR=9, REGD=67, RMAT=78, TOOBIG=2,
     3           VNEED=4)
C/
C
C  ***  V SUBSCRIPT VALUES  ***
C
C/6
C     DATA DINIT/38/, DTINIT/39/, D0INIT/40/, F/10/, RLIMIT/46/
C/7
      PARAMETER (DINIT=38, DTINIT=39, D0INIT=40, F=10, RLIMIT=46)
C/
C/6
C     DATA HALF/0.5E+0/, ZERO/0.E+0/
C/7
      PARAMETER (HALF=0.5E+0, ZERO=0.E+0)
C/
C
C+++++++++++++++++++++++++++++++  BODY  ++++++++++++++++++++++++++++++++
C
      LH = P * (P+1) / 2
      IF (IV(1) .EQ. 0) CALL IVSET(1, IV, LIV, LV, V)
      IV1 = IV(1)
      IF (IV1 .GT. 2) GO TO 10
         NN = N2 - N1 + 1
         IV(RESTOR) = 0
         I = IV1 + 4
         IF (IV(TOOBIG) .EQ. 0) GO TO (150, 130, 150, 120, 120, 150), I
         IF (I .NE. 5) IV(1) = 2
         GO TO 40
C
C  ***  FRESH START OR RESTART -- CHECK INPUT INTEGERS  ***
C
 10   IF (ND .LE. 0) GO TO 220
      IF (P .LE. 0) GO TO 220
      IF (N .LE. 0) GO TO 220
      IF (IV1 .EQ. 14) GO TO 30
      IF (IV1 .GT. 16) GO TO 270
      IF (IV1 .LT. 12) GO TO 40
      IF (IV1 .EQ. 12) IV(1) = 13
      IF (IV(1) .NE. 13) GO TO 20
      IV(VNEED) = IV(VNEED) + P*(P+15)/2
 20   CALL  G7ITB(B, D, X, IV, LIV, LV, P, P, V, X, X)
      IF (IV(1) .NE. 14) GO TO 999
C
C  ***  STORAGE ALLOCATION  ***
C
      IV(G) = IV(NEXTV)
      IV(JCN) = IV(G) + 2*P
      IV(RMAT) = IV(JCN) + P
      IV(QTR) = IV(RMAT) + LH
      IV(JTOL) = IV(QTR) + 2*P
      IV(NEXTV) = IV(JTOL) + 2*P
C  ***  TURN OFF COVARIANCE COMPUTATION  ***
      IV(RDREQ) = 0
      IF (IV1 .EQ. 13) GO TO 999
C
 30   JTOL1 = IV(JTOL)
      IF (V(DINIT) .GE. ZERO) CALL  V7SCP(P, D, V(DINIT))
      IF (V(DTINIT) .GT. ZERO) CALL  V7SCP(P, V(JTOL1), V(DTINIT))
      I = JTOL1 + P
      IF (V(D0INIT) .GT. ZERO) CALL  V7SCP(P, V(I), V(D0INIT))
      IV(NF0) = 0
      IV(NF1) = 0
      IF (ND .GE. N) GO TO 40
C
C  ***  SPECIAL CASE HANDLING OF FIRST FUNCTION AND GRADIENT EVALUATION
C  ***  -- ASK FOR BOTH RESIDUAL AND JACOBIAN AT ONCE
C
      G1 = IV(G)
      Y1 = G1 + P
      CALL  G7ITB(B, D, V(G1), IV, LIV, LV, P, P, V, X, V(Y1))
      IF (IV(1) .NE. 1) GO TO 260
      V(F) = ZERO
      CALL  V7SCP(P, V(G1), ZERO)
      IV(1) = -1
      QTR1 = IV(QTR)
      CALL  V7SCP(P, V(QTR1), ZERO)
      IV(REGD) = 0
      RMAT1 = IV(RMAT)
      GO TO 100
C
 40   G1 = IV(G)
      Y1 = G1 + P
      CALL  G7ITB(B, D, V(G1), IV, LIV, LV, P, P, V, X, V(Y1))
      IF (IV(1) - 2) 50, 60, 260
C
 50   V(F) = ZERO
      IF (IV(NF1) .EQ. 0) GO TO 240
      IF (IV(RESTOR) .NE. 2) GO TO 240
      IV(NF0) = IV(NF1)
      CALL V7CPY(N, RD, R)
      IV(REGD) = 0
      GO TO 240
C
 60   CALL  V7SCP(P, V(G1), ZERO)
      IF (IV(MODE) .GT. 0) GO TO 230
      RMAT1 = IV(RMAT)
      QTR1 = IV(QTR)
      RD1 = QTR1 + P
      CALL  V7SCP(P, V(QTR1), ZERO)
      IV(REGD) = 0
      IF (ND .LT. N) GO TO 90
      IF (N1 .NE. 1) GO TO 90
      IF (IV(MODE) .LT. 0) GO TO 100
      IF (IV(NF1) .EQ. IV(NFGCAL)) GO TO 70
         IF (IV(NF0) .NE. IV(NFGCAL)) GO TO 90
            CALL V7CPY(N, R, RD)
            GO TO 80
 70   CALL V7CPY(N, RD, R)
 80   CALL  Q7APL(ND, N, P, DR, RD, 0)
      CALL  R7TVM(ND, MIN0(N,P), V(Y1), V(RD1), DR, RD)
      IV(REGD) = 0
      GO TO 110
C
 90   IV(1) = -2
      IF (IV(MODE) .LT. 0) IV(1) = -3
 100  CALL  V7SCP(P, V(Y1), ZERO)
 110  CALL  V7SCP(LH, V(RMAT1), ZERO)
      GO TO 240
C
C  ***  COMPUTE F(X)  ***
C
 120  T =  V2NRM(NN, R)
      IF (T .GT. V(RLIMIT)) GO TO 210
      V(F) = V(F)  +  HALF * T**2
      IF (N2 .LT. N) GO TO 250
      IF (N1 .EQ. 1) IV(NF1) = IV(NFCALL)
      GO TO 40
C
C  ***  COMPUTE Y  ***
C
 130  Y1 = IV(G) + P
      YI = Y1
      DO 140 L = 1, P
         V(YI) = V(YI) +  D7TPR(NN, DR(1,L), R)
         YI = YI + 1
 140     CONTINUE
      IF (N2 .LT. N) GO TO 250
         IV(1) = 2
         IF (N1 .GT. 1) IV(1) = -3
         GO TO 240
C
C  ***  COMPUTE GRADIENT INFORMATION  ***
C
 150  G1 = IV(G)
      IVMODE = IV(MODE)
      IF (IVMODE .LT. 0) GO TO 170
      IF (IVMODE .EQ. 0) GO TO 180
      IV(1) = 2
C
C  ***  COMPUTE GRADIENT ONLY (FOR USE IN COVARIANCE COMPUTATION)  ***
C
      GI = G1
      DO 160 L = 1, P
         V(GI) = V(GI) +  D7TPR(NN, R, DR(1,L))
         GI = GI + 1
 160     CONTINUE
      GO TO 200
C
C  *** COMPUTE INITIAL FUNCTION VALUE WHEN ND .LT. N ***
C
 170  IF (N .LE. ND) GO TO 180
         T =  V2NRM(NN, R)
         IF (T .GT. V(RLIMIT)) GO TO 210
         V(F) = V(F)  +  HALF * T**2
C
C  ***  UPDATE D IF DESIRED  ***
C
 180  IF (IV(DTYPE) .GT. 0)
     1      CALL D7UPD(D, DR, IV, LIV, LV, N, ND, NN, N2, P, V)
C
C  ***  COMPUTE RMAT AND QTR  ***
C
      QTR1 = IV(QTR)
      RMAT1 = IV(RMAT)
      CALL Q7RAD(NN, ND, P, V(QTR1), .TRUE., V(RMAT1), DR, R)
      IV(NF1) = 0
      IF (N1 .GT. 1) GO TO 200
      IF (N2 .LT. N) GO TO 250
C
C  ***  SAVE DIAGONAL OF R FOR COMPUTING Y LATER  ***
C
      RD1 = QTR1 + P
      L = RMAT1 - 1
      DO 190 I = 1, P
         L = L + I
         V(RD1) = V(L)
         RD1 = RD1 + 1
 190     CONTINUE
C
 200  IF (N2 .LT. N) GO TO 250
      IF (IVMODE .GT. 0) GO TO 40
      IV(NF00) = IV(NFGCAL)
C
C  ***  COMPUTE G FROM RMAT AND QTR  ***
C
      CALL L7VML(P, V(G1), V(RMAT1), V(QTR1))
      IV(1) = 2
      IF (IVMODE .EQ. 0) GO TO 40
      IF (N .LE. ND) GO TO 40
C
C  ***  FINISH SPECIAL CASE HANDLING OF FIRST FUNCTION AND GRADIENT
C
      Y1 = G1 + P
      IV(1) = 1
      CALL  G7ITB(B, D, V(G1), IV, LIV, LV, P, P, V, X, V(Y1))
      IF (IV(1) .NE. 2) GO TO 260
      GO TO 40
C
C  ***  MISC. DETAILS  ***
C
C     ***  X IS OUT OF RANGE (OVERSIZE STEP)  ***
C
 210  IV(TOOBIG) = 1
      GO TO 40
C
C     ***  BAD N, ND, OR P  ***
C
 220  IV(1) = 66
      GO TO 270
C
C  ***  RECORD EXTRA EVALUATIONS FOR FINITE-DIFFERENCE HESSIAN  ***
C
 230  IV(NFCOV) = IV(NFCOV) + 1
      IV(NFCALL) = IV(NFCALL) + 1
      IV(NFGCAL) = IV(NFCALL)
      IV(1) = -1
C
C  ***  RETURN FOR MORE FUNCTION OR GRADIENT INFORMATION  ***
C
 240  N2 = 0
 250  N1 = N2 + 1
      N2 = N2 + ND
      IF (N2 .GT. N) N2 = N
      GO TO 999
C
C  ***  PRINT SUMMARY OF FINAL ITERATION AND OTHER REQUESTED ITEMS  ***
C
 260  G1 = IV(G)
 270  CALL ITSUM(D, V(G1), IV, LIV, LV, P, V, X)
C
 999  RETURN
C  ***  LAST CARD OF  RN2GB FOLLOWS  ***
      END

.