* G13ASF Example Program Text * Mark 14 Revised. NAG Copyright 1989. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NPARMX, NPPCMX, NXMAX, IRES, LIW, LWORK, MMAX, + ICM, LDRCM PARAMETER (NPARMX=10,NPPCMX=NPARMX+1,NXMAX=50,IRES=550, + LIW=10,LWORK=500,MMAX=10,ICM=NPARMX+1,LDRCM=MMAX) * .. Local Scalars .. DOUBLE PRECISION C, CHI, S, SIGLEV INTEGER I, IDF, IFAIL, ISHOW, ITC, KFC, KPIV, M, N, NDF, + NIT, NPAR, NPPC, NST, NX, OUTCHN * .. Local Arrays .. DOUBLE PRECISION CM(ICM,ICM), PAR(NPARMX), R(MMAX), + RCM(LDRCM,MMAX), SD(NPPCMX), ST(NXMAX), V(IRES), + WORK(LWORK), X(NXMAX) INTEGER ISF(4), IW(LIW), MR(7) * .. External Subroutines .. EXTERNAL G13AFF, G13ASF, X04ABF * .. Executable Statements .. WRITE (NOUT,*) 'G13ASF Example Program Results' OUTCHN = NOUT * Skip heading in data file READ (NIN,*) READ (NIN,*) NX IF (NX.GT.0 .AND. NX.LE.NXMAX) THEN READ (NIN,*) (X(I),I=1,NX) READ (NIN,*) (MR(I),I=1,7) NPAR = MR(1) + MR(3) + MR(4) + MR(6) IF (NPAR.GT.0 .AND. NPAR.LE.NPARMX) THEN DO 20 I = 1, NPAR PAR(I) = 0.0D0 20 CONTINUE KFC = 1 C = 0.0D0 NPPC = NPAR + KFC * * Set KPIV to 1 to obtain monitoring information * KPIV = 0 NIT = 50 IFAIL = 1 * CALL G13AFF(MR,PAR,NPAR,C,KFC,X,NX,S,NDF,SD,NPPC,CM,ICM,ST, + NST,KPIV,NIT,ITC,ISF,V,IRES,N,IFAIL) * IF (IFAIL.LT.0) THEN WRITE (NOUT,*) WRITE (NOUT,99999) ' ** G13AFF returned with IFAIL = ', + IFAIL ELSE IF (IFAIL.NE.0) WRITE (NOUT,99999) + 'G13AFF fails.'//' IFAIL =', IFAIL * IF (IFAIL.EQ.0 .OR. IFAIL.EQ.9) THEN CALL X04ABF(1,OUTCHN) M = 10 ISHOW = 1 IFAIL = -1 * CALL G13ASF(N,V,MR,M,PAR,NPAR,ISHOW,R,RCM,LDRCM,CHI, + IDF,SIGLEV,IW,LIW,WORK,LWORK,IFAIL) * IF (IFAIL.NE.0) WRITE (NOUT,99999) + 'G13ASF fails. IFAIL =', IFAIL END IF END IF END IF END IF * 99999 FORMAT (1X,A,I5) END