hc2test2 Translation Listing



 FORTRAN CALCULUS 2 (MC7B) ----------------------------------------------------------------------------------------Thu Sep 12 17:10:06 2013
 ####  ---------+---------+---------+---------+---------+---------+---------+---------+---------+---------+---------+---------+---------+--
~
    1        PROBLEM HC2TEAM2(600000,20000)                                                 !^ synop
    2          COMMON/PRIN/GRAF,X,Y,G(6),F
    3          CHARACTER GRAF*6
    4          CHARFUN FCSINT*4
    5          OPEN (5,FILE="input.dat")
    6          PRINT *,’=============================’
    7          PRINT *,’TEAM 2 CORRAL 2 OPTIMIZATION’
    8          LOOP = 0
   20>         KCERES=0; KJOVE=0; KJUP=0; KTHOR=0; KZEUS=0; KAPOLLO=0; KATLAS=0; KARGUS=0; KCRONUS=0; KODIN=0; KHELIOS=0; KALL=0
   21*         DO WHILE(LOOP.EQ.0)  ! Loop to end of data file
   25>            XL=0 ; XH=100 ; YL=0 ; YH=100
   26*            READ(5,*, END=100) XS,YS
   27             PRINT *,’===============================’
   28             PRINT *,’GRID START XS=’,XS,’ YS=’,YS
   29             N=N+1
   30*            GRAF=’CE’//FCSINT(N)
   31*            @CONGRAF(GRAF,XS,YS,’Solver CERES’)    !~ Generate Contour Graph
   33>            X=XS ; Y=YS
   34*            FIND X,Y IN HB BY CERES(CSET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
   35             @RESULTS(GRAF,’CERES ’,X,Y,F,KCERES,KALL,SGNL)
      
   36             N=N+1
   37*            GRAF=’JV’//FCSINT(N)
   38*            @CONGRAF(GRAF,XS,YS,’Solver JOVE’)    !~ Generate Contour Graph
   40>            X=XS ; Y=YS
   41*            FIND X,Y IN HB BY JOVE(JVSET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
   42             @RESULTS(GRAF,’JOVE ’,X,Y,F,KJOVE,KALL,SGNL)
      
   43             N=N+1
   44*            GRAF=’JU’//FCSINT(N)
   45*            @CONGRAF(GRAF,XS,YS,’Solver JUPITER’)    !~ Generate Contour Graph
   47>            X=XS ; Y=YS
   48*            FIND X,Y IN HB BY JUPITER(JUSET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
   49             @RESULTS(GRAF,’JUPITER ’,X,Y,F,KJUP,KALL,SGNL)
      
   50             N=N+1
   51*            GRAF=’TH’//FCSINT(N)
   52*            @CONGRAF(GRAF,XS,YS,’Solver THOR’)    !~ Generate Contour Graph
   54>            X=XS ; Y=YS
   55*            FIND X,Y IN HB BY THOR(TSET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
   56             @RESULTS(GRAF,’THOR ’,X,Y,F,KTHOR,KALL,SGNL)
      
   57             N=N+1
   58*            GRAF=’ZE’//FCSINT(N)
   59*            @CONGRAF(GRAF,XS,YS,’Solver ZEUS’)    !~ Generate Contour Graph
   61>            X=XS ; Y=YS
   62*            FIND X,Y IN HB BY ZEUS(ZUSET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
   63             @RESULTS(GRAF,’ZEUS ’,X,Y,F,KZEUS,KALL,SGNL)
      
   64             N=N+1
   65*            GRAF=’AP’//FCSINT(N)
   66*            @CONGRAF(GRAF,XS,YS,’Solver APOLLO’)    !~ Generate Contour Graph
   68>            X=XS ; Y=YS
   69*            FIND X,Y IN HB BY APOLLO(APSET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
   70             @RESULTS(GRAF,’APOLLO ’,X,Y,F,KAPOLLO,KALL,SGNL)
~
      
   71             N=N+1
   72*            GRAF=’AT’//FCSINT(N)
   73*            @CONGRAF(GRAF,XS,YS,’Solver ATLAS’)    !~ Generate Contour Graph
   75>            X=XS ; Y=YS
   76*            FIND X,Y IN HB BY ATLAS(ATSET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
   77             @RESULTS(GRAF,’ATLAS ’,X,Y,F,KATLAS,KALL,SGNL)
      
      
       C           N=N+1
       C           GRAF=’DE’//FCSINT(N)
       C           @CONGRAF(GRAF,XS,YS,’Solver DEMETER’)    !~ Generate Contour Graph
       C           X=XS ; Y=YS
       C           FIND X,Y IN HB BY DEMETER(DESET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
       C           @RESULTS(GRAF,’DEMETER ’,X,Y,F,KDEMET,KALL,SGNL)
   78             N=N+1
   79*            GRAF=’AR’//FCSINT(N)
   80*            @CONGRAF(GRAF,XS,YS,’Solver ARGUS’)    !~ Generate Contour Graph
   82>            X=XS ; Y=YS
   83*            FIND X,Y IN HB BY ARGUS(ARSET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
   84             @RESULTS(GRAF,’ARGUS ’,X,Y,F,KARGUS,KALL,SGNL)
      
   85             N=N+1
   86*            GRAF=’CR’//FCSINT(N)
   87*            @CONGRAF(GRAF,XS,YS,’Solver CRONUS’)    !~ Generate Contour Graph
   89>            X=XS ; Y=YS
   90*            FIND X,Y IN HB BY CRONUS(CRSET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
   91             @RESULTS(GRAF,’CRONUS ’,X,Y,F,KCRONUS,KALL,SGNL)
      
   92             N=N+1
   93*            GRAF=’OD’//FCSINT(N)
   94*            @CONGRAF(GRAF,XS,YS,’Solver ODIN’)    !~ Generate Contour Graph
   96>            X=XS ; Y=YS
   97*            FIND X,Y IN HB BY ODIN(ODSET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
   98             @RESULTS(GRAF,’ODIN ’,X,Y,F,KODIN,KALL,SGNL)
      
      
       C           N=N+1
       C           GRAF=’HE’//FCSINT(N)
       C           @CONGRAF(GRAF,XS,YS,’Solver HELIOS’)    !~ Generate Contour Graph
       C           X=XS ; Y=YS
       C           FIND X,Y IN HB BY HELIOS(HESET) HOLDING G WITH FLAG SGNL AND LOWERS XL,YL AND UPPERS XH,YH TO MAXIMIZE F !~ Optimize
       C           @RESULTS(GRAF,’HELIOS ’,X,Y,F,KHELIOS,KALL,SGNL)
   99             PRINT *,’@@@@@@@@@@@@@@@@@@@@@@@@@@@@’
  100             PRINT *,N,’ OPTIMIZATION SEARCHES’
  101             PRINT *,’KALL    = ’,KALL
  102             PRINT *,’KCERES  = ’,KCERES
  103             PRINT *,’KJOVE   = ’,KJOVE
  104             PRINT *,’KJUP    = ’,KJUP
  105             PRINT *,’KTHOR   = ’,KTHOR
  106             PRINT *,’KZEUS   = ’,KZEUS
  107             PRINT *,’KAPOLLO = ’,KAPOLLO
  108             PRINT *,’KATLAS  = ’,KATLAS
  109             PRINT *,’KARGUS  = ’,KARGUS
  110             PRINT *,’KCRONUS = ’,KCRONUS
  111             PRINT *,’KODIN   = ’,KODIN
~
  112             PRINT *,’KHELIOS = ’,KHELIOS
  113             PRINT *,’@@@@@@@@@@@@@@@@@@@@@@@@@@@@’
      
  114          END DO
  115      100 LOOP = 1
  116*       END
~
      
  117        CONTROLLER CSET(CERES)
  118          DETAIL=0    ! Detailed report for every iteration
  119*         DETOUT=0    ! Detailed report to DETAIL stream
  120*         SUMOUT=1    ! Summary report to SUMMARY stream
  121*       END
~
      
  122        CONTROLLER JVSET(JOVE)
  123          DETAIL=0    ! Detailed report for every iteration
  124*         DETOUT=0    ! Detailed report to DETAIL stream
  125*         SUMOUT=1    ! Summary report to SUMMARY stream
  126*       END
~
      
  127        CONTROLLER TSET(THOR)
  128          DETAIL=0    ! Detailed report for every iteration
  129*         DETOUT=0    ! Detailed report to DETAIL stream
  130*         SUMOUT=1    ! Summary report to SUMMARY stream
  131*       END
~
      
  132        CONTROLLER JUSET(JUPITER)
  133          DETAIL=0    ! Detailed report for every iteration
  134*         DETOUT=0    ! Detailed report to DETAIL stream
  135*         SUMOUT=1    ! Summary report to SUMMARY stream
  136*       END
~
      
  137        CONTROLLER ZUSET(ZEUS)
  138          DETAIL=0    ! Detailed report for every iteration
  139*         DETOUT=0    ! Detailed report to DETAIL stream
  140*         SUMOUT=1    ! Summary report to SUMMARY stream
  141*       END
~
      
  142        CONTROLLER APSET(APOLLO)
  143          STRATEGY=1  ! Exterior penalty function method
  144*         DETAIL=0    ! Detailed report for every iteration
  145*         DETOUT=0    ! Detailed report to DETAIL stream
  146*         SUMOUT=1    ! Summary report to SUMMARY stream
  147*       END
~
      
  148        CONTROLLER ATSET(ATLAS)
  149          OPTIMIZR=1  ! Fletcher-Reeves Conjugate Gradient
  150*         DETAIL=0    ! Detailed report for every iteration
  151*         DETOUT=0    ! Detailed report to DETAIL stream
  152*         SUMOUT=1    ! Summary report to SUMMARY stream
  153*       END
~
      
  154        CONTROLLER DESET(DEMETER)
  155          DETAIL=0    ! Detailed report for every iteration
  156*         DETOUT=0    ! Detailed report to DETAIL stream
  157*         SUMOUT=1    ! Summary report to SUMMARY stream
  158*       END
~
      
  159        CONTROLLER ARSET(ARGUS)
  160          DETAIL=0    ! Detailed report for every iteration
  161*         DETOUT=0    ! Detailed report to DETAIL stream
  162*         SUMOUT=1    ! Summary report to SUMMARY stream
  163*       END
~
      
  164        CONTROLLER CRSET(CRONUS)
  165          DETAIL=0    ! Detailed report for every iteration
  166*         DETOUT=0    ! Detailed report to DETAIL stream
  167*         SUMOUT=1    ! Summary report to SUMMARY stream
  168*       END
~
      
  169        CONTROLLER ODSET(ODIN)
  170          DETAIL=0    ! Detailed report for every iteration
  171*         DETOUT=0    ! Detailed report to DETAIL stream
  172*         SUMOUT=1    ! Summary report to SUMMARY stream
  173*       END
~
      
  174        CONTROLLER HESET(HELIOS)
  175          DETAIL=0    ! Detailed report for every iteration
  176*         DETOUT=0    ! Detailed report to DETAIL stream
  177*         SUMOUT=1    ! Summary report to SUMMARY stream
  178*       END
~
      
      
  179        PROCEDURE RESULTS(GRAF,SOLVER,X,Y,F,KSOLV,KALL,SGNL)
  180          CHARACTER GRAF*6,RESULT*40
  181          CHARACTER*(*) SOLVER
  182          PRINT *,’~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~’
  183          PRINT *,GRAF,’ ’,SOLVER,’ ’,’ X=’,X,’ Y=’,Y,’ F=’,F,’ SGNL=’,SGNL
  184          IF(SGNL.EQ.0.0) THEN
  185             IF(ABS(X-75.0).LT.0.01.AND.ABS(Y-65.0).LT.0.01.AND.ABS(F-58.9).LT.0.01) THEN
  186                KSOLV=KSOLV+1
  187*               KALL=KALL+1
  188*               PRINT *,’*** BULLSEYE NUMBER ’,KSOLV,’ FOR THIS SOLVER’
  189                PRINT *,’*** BULLSEYE NUMBER ’,KALL,’ OVERALL’
  190                RESULT=SOLVER//’BULLSEYE on corral maximum’
  191*            ELSEIF(ABS(X-75.0).LT.1.0.AND.ABS(Y-65.0).LT.1.0.AND.ABS(F-58.9).LT.1.0) THEN
  192                PRINT *,’*** NEAR MISS WITHIN ONE FOOT OVERALL’
  193                RESULT=SOLVER//’NEAR MISS within one foot’
  194*            ELSEIF(ABS(X-75.0).LT.5.0.AND.ABS(Y-65.0).LT.5.0.AND.ABS(F-58.9).LT.5.0) THEN
  195                PRINT *,’*** NEAR MISS WITHIN FIVE FEET OVERALL’
  196                RESULT=SOLVER//’NEAR MISS within five feet’
  197*            ELSE
  198*               PRINT *,’*** NOT EVEN CLOSE’
  199                RESULT=SOLVER//’NOT EVEN CLOSE’
  200*            ENDIF
  201             @MESSAGE(GRAF,’XE= ’,-5,98,CL_RED)
  202             @NUMBER(GRAF,X,4,999.,999.,10,0,CL_RED)
  203             @MESSAGE(GRAF,’YE= ’,15,98,CL_RED)
  204             @NUMBER(GRAF,Y,4,999.,999.,10,0,CL_RED)
  205             @MESSAGE(GRAF,’F= ’,35,98,CL_RED)
  206             @NUMBER(GRAF,F,4,999.,999.,10,0,CL_RED)
  207             @SHOW(GRAF,RESULT)
  208             @CLEAR(GRAF)
  209          ELSE
  210*            PRINT *,’************************************************************************************’
  211             IF(SGNL.GT.0.0) THEN
  212                PRINT *,’FAILED - Maximum Iterations or Model Calls Exceeded without convergence’
  213             ELSE
  214*               PRINT *,’FAILED - Internal Model ABORT’
  215             ENDIF
  216             @CLEAR(GRAF)
  217          ENDIF
  218        END
~
      
  219        MODEL HB !~ Optimization model
  220          COMMON/PRIN/GRF,X,Y,G(6),F
  221          CHARACTER GRF*6
              !~ Inequality constraints defining the feasible region (corral)
  224>         G(1)=X*Y-700 ; G(2)=75-X ; G(3)=65-Y
  227>         G(4)=Y-X*X/125 ; G(5)=(Y-50)**2-5*X+275 ; G(6) = X-54
  228          F=HBOBJ(X,Y) !~ Formulas defining the objective function surface
  229          @CURVE(GRF,’SR’,X,Y)  ! Generate point on search trace
  230        END
~
      
  231        FMODEL HBOBJ(X,Y)  !~ Function to generate the contour map
  232          F1 = 75.1963666677 - 3.8112755343*X + 0.1269366345*X*X - 0.0020567665*X**3
  233          F2 = 1.0345E-5*X**4 - 6.8306567613*Y + 0.0302344793*X*Y - 0.0012813448*X*X*Y
  234          F3 = 3.52559E-5*X**3*Y - 2.266E-7*X**4*Y + 0.2564581253*Y*Y - 3.460403E-3*Y**3
  235          F4 = 1.35139E-5*Y**4 - 28.1064434908/(Y+1) - 5.2375E-6*X*X*Y*Y
  236          F5 = -6.3E-9*X**3*Y*Y + 7E-10*X**3*Y**3 + 3.405462E-4*X*Y*Y
  237          F6 = -1.6638E-6*X*Y**3 - 2.8673112392*EXP(5E-4*X*Y)
  238          HBOBJ=F1+F2+F3+F4+F5+F6
  239        END
~
      
  240        PROCEDURE CONGRAF(GRF,XS,YS,SOLVER)  !~ Contour graph generation
            !~ Procedure to setup graphics output
  241          CHARACTER GRF*6
  242          CHARACTER*(*) SOLVER
  243          DIMENSION CONS(9),LABL(9),LTYP(9),KLR(9)
  244          DATA X1,X2,Y1,Y2/-10,110,-10,110/
  245          DATA XA,XB,YA,YB/0,100,0,100/
  246          DATA CONS/-80,-40,0,10,20,30,40,50,55/
  247          DATA LABL/1,0,1,0,1,0,1,0,1/
  248          DATA LTYP/0,2,0,2,0,2,0,2,0/
  249          DATA KLR /3,3,3,3,3,3,3,3,3/
  250          EXTERNAL HBOBJ
  251          N=101
  252*         @GRAFIL(GRF,’SUM’,’IMAGE’,0,0) !~ PNG image of default size
  253          @FONT(GRF,’COMPLEX’,’STANDARD’,0,1) !~ Default charsize & color
  254          @AXNAME(GRF,’X’,’X’,’CENT’,30,36,10)
  255          @AXNAME(GRF,’Y’,’Y’,’CENT’,30,36,10)
  256          @XYPLOT(GRF,’RECT’,X1,X2,X1,10,Y1,Y2,Y1,10,1.0,0,0,0,0)
  257          @AXSET(GRF,’NAME’,’NAME’,’NAME’,’NAME’)
  258          @MESH(GRF,’CS’,XA,XB,YA,YB,N,N,HBOBJ)
  259          @CONTOUR(GRF,’CS’,CONS,LABL,KLR,LTYP,9)
  260          @HEAD(GRF,’HILLSIDE CORRAL WITH GAP’,50,40,10)
  261          @HEAD(GRF,SOLVER,50,100,10)
  262          @MESSAGE(GRF,’XS= ’,-5,103,CL_BLUE)
  263          @NUMBER(GRF,XS,4,999.,999.,10,0,CL_BLUE)
  264          @MESSAGE(GRF,’YS= ’,15,103,CL_BLUE)
  265          @NUMBER(GRF,YS,4,999.,999.,10,0,CL_BLUE)
  266          @SETUP(GRF,’G1’,2,7,0,1) !~ (orange dashed)
  267          DO 10 I=10,50
  269>             X=I ; Y=700/X
  270*             @CURVE(GRF,’G1’,X,Y)
  271   10     CONTINUE
  272*         @SETUP(GRF,’G2’,2,7,0,1) !~ (orange dashed)
  273          @CURVE(GRF,’G2’,75,70)
  274          @CURVE(GRF,’G2’,75,55)
  275          @SETUP(GRF,’G3’,2,7,0,1) !~ (orange dashed)
  276          @CURVE(GRF,’G3’,5,65)
  277          @CURVE(GRF,’G3’,80,65)
  278          @SETUP(GRF,’G4’,2,7,0,1) !~ (orange dashed)
  279          DO 20 I=40,75
  281>             X=I ; Y=X*X/125
  282*             @CURVE(GRF,’G4’,X,Y)
  283   20     CONTINUE
  284*         @SETUP(GRF,’G5’,2,7,0,1) !~ (orange dashed)
  285          DO 30 I=80,55,-1
  287>             X=I ; Y=SQRT(5*X-275)+50
  288*             @CURVE(GRF,’G5’,X,Y)
  289   30     CONTINUE
  290*         DO 40 I=55,80
  292>             X=I ; Y=-SQRT(5*X-275)+50
  293*             @CURVE(GRF,’G5’,X,Y)
  294   40     CONTINUE
  295*         @SETUP(GRF,’G6’,2,7,0,1) ! (orange dashed)
  296          @CURVE(GRF,’G6’,54,70)
~
  297          @CURVE(GRF,’G6’,54,20)
  298          @SETUP(GRF,’SR’,1,4,-5,1) !~ (blue dotted with cross points)
  299        END
~