************************************************************************ C C TEST PROGRAM FOR THE SUBROUTINE PINDU C INTEGER NF,NC,IH(1001),JH(20000),ICG(1001),JCG(7000), & IPAR(7),IPRNT,ITERM DOUBLE PRECISION X(1000),CF(1001),RPAR(5),F,GMAX,CMAX DOUBLE PRECISION FMIN INTEGER NEXT,IERR,I,ITIME,MM,MC INTEGER NITER,NFVAL,NSUCC COMMON /PROB/ NEXT INTEGER NRES,NDEC,NIIT,NIT,NFV,NFG,NFH COMMON /STAT/ NRES,NDEC,NIIT,NIT,NFV,NFG,NFH NITER=0 NFVAL=0 NSUCC=0 CALL TYTIM1(ITIME) C C LOOP FOR 18 TEST PROBLEMS C DO 3 NEXT=1,18 C C CHOICE OF INTEGER AND REAL PARAMETERS C DO 1 I=1,7 IPAR(I)=0 1 CONTINUE DO 2 I=1,5 RPAR(I)=0.0D 0 2 CONTINUE IPRNT=1 C C PROBLEM DIMENSION C NF=1000 NC=1000 C C INITIATION OF X AND CHOICE OF RPAR(1) C CALL TIUS20(NF,MM,X,IH,JH,FMIN,RPAR(1),NEXT,IERR) CALL TINS20(NF,NC,MC,ICG,JCG,NEXT) RPAR(1)=0.0D 0 IF (NEXT.EQ. 2) RPAR(1)=1.0D 1 IF (NEXT.EQ. 6) RPAR(1)=1.0D 1 IF (NEXT.EQ. 8) RPAR(1)=2.0D 0 IF (IERR.NE.0) GO TO 3 C C SOLUTION C CALL PINDU(NF,NC,X,IH,JH,CF,ICG,JCG,IPAR,RPAR,F,GMAX,CMAX, & IPRNT,ITERM) NITER=NITER+NIT NFVAL=NFVAL+NFV IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1 3 CONTINUE WRITE(6,10) NITER,NFVAL,NSUCC 10 FORMAT(' NITER =',I5,3X,' NFVAL =',I5,3X,' NSUCC =',I5) CALL TYTIM2(ITIME) STOP END C C USER SUPPLIED SUBROUTINE (CALCULATION OF FF) C SUBROUTINE OBJ(NF,X,FF) INTEGER NF DOUBLE PRECISION X(*),FF INTEGER NEXT COMMON /PROB/ NEXT C C FUNCTION EVALUATION C CALL TFFU20(NF,X,FF,NEXT) RETURN END C C USER SUPPLIED SUBROUTINE (CALCULATION OF GF) C SUBROUTINE DOBJ(NF,X,GF) INTEGER NF DOUBLE PRECISION X(*),GF(*) INTEGER NEXT COMMON /PROB/ NEXT C C GRADIENT EVALUATION C CALL TFGU20(NF,X,GF,NEXT) RETURN END C C USER SUPPLIED SUBROUTINE (CALCULATION OF FC) C SUBROUTINE CON(NF,KC,X,FC) INTEGER NF,KC DOUBLE PRECISION X(*),FC INTEGER NEXT COMMON /PROB/ NEXT C C FUNCTION EVALUATION C CALL TCFU20(NF,KC,X,FC,NEXT) RETURN END C C USER SUPPLIED SUBROUTINE (CALCULATION OF GC) C SUBROUTINE DCON(NF,KC,X,GC) INTEGER NF,KC DOUBLE PRECISION X(*),GC(*) INTEGER NEXT COMMON /PROB/ NEXT C C GRADIENT EVALUATION C CALL TCGU20(NF,KC,X,GC,NEXT) RETURN END C C EMPTY SUBROUTINES C SUBROUTINE FUN(NF,KA,X,FA) INTEGER KA,NF DOUBLE PRECISION FA,X(*) KA=NF FA=X(1) RETURN END SUBROUTINE DFUN(NF,KA,X,GA) INTEGER KA,NF DOUBLE PRECISION GA(*),X(*) KA=NF GA(1)=X(1) RETURN END 