$NOFLOATCALLS
C********************************************************************
C
      SUBROUTINE PUNT
C
C********************************************************************
C
C                -- THE AREA SEARCH ALGORITHM --
C
C THIS SUBROUTINE IS CALLED WHENEVER THE USUAL NEWTONIAN
C SEARCH ALGORITHM WITH VECTOR REDUCTION IS UNABLE TO FIND A SET
C OF PRICES WHICH REDUCE DISEQUILIBRIUM AFTER NPUNT TRIES.
C
C MODEL VERSION: A.84
C
C INPUTS
C       INTEGER NMKT
C       REAL    EDRI,ESRILM,PIM
C OUTPUTS
C       INTEGER (NONE)
C       REAL    PIM
C INTERNAL VARIABLES
C       INTEGER: NGRID= FOR EACH PIM THE NUMBER OF PRICES OVER WHICH
C                       THE SUBROUTINE WILL EXPLORE, NGRID MUST
C                       BE 2 OR MORE. NSH=NUMBER OF SEARCH POINTS
C                                     IS =SEARCH POINT INDEX
C                                     ISP=INTEGER HOLDING VARIABLE
C       REAL:    AREA = SCALE FACTOR USED TO DETERMINE MAXIMUM
C                       AND MINIMUM VALUES OF PIM TO BE EXPLORED
C                                     PMAX=PIM*AREA
C                                     PMIN=PIM/AREA
C                                     AREA MUST EXCEED 1.D0
C                GRIDST=INCREMENT EACH PRICE IS CHANGED FROM ONE
C                       GRID STEP TO THE NEXT
C                PMIN = MINIMUM PRICE SEARCHED
C                PSTAR= PRICE VECTOR WITH MINIMUM DIVERGENCE FROM
C                       EQUILIBRIUM. PIM IS SET EQUAL TO PSTAR
C                       AT THE END OF THE SEARCH
C                SP   = TEMPORARY HOLDING VARIABLE
C                U    = COUNTING VARIABLE FOR DEMAND
C                V    = COUNTING VARIABLE FOR SUPPLY
C                XX   = SQUARED EXCESS DEMAND (U-V)**2
C                XMIN = MINIMUM VALUE OF XX
C
C SUBROUTINES CALLED: PPPP,PSPS,SSSS,DDDD
C
C WRITTEN BY:
C   JAE EDMONDS
C   26 OCT 1984
C
C LATEST REVISION:
C   NONE
C
C*****************************************************************
C
C  MAKE ALL REAL VARIABLES DOUBLE PRECISION
C
      IMPLICIT   REAL*8 (A-H,O-Z),   INTEGER (I-N)
C
C COMMON BLOCKS
$INCLUDE:'COMMON.FOR'
C
C LOCAL VARIABLES
C
       REAL*8 AREA,GRIDST(3),PMIN(3),PSTAR(3),PSAVE(3),U,V,XX,XMIN
C
C SET AREA AND GRID SIZE
C
           WRITE (JUNIT,1001)PIM
1001       FORMAT(' ','PIM: ',6G12.6)
       AREA=5.00D0
       NGRID=5
C
C COMPUTE MINIMUM PRICES AND GRID STEPS
C
       SP=(NGRID-1)
       DO 10 I=1,NMKT
          PMIN(I)=PIM(I,M)/AREA
          GRIDST(I)=2.D0*(PIM(I,M)-PMIN(I))/SP
10     CONTINUE
C
C COMPUTE NUMBER OF SEARCH POINTS AND COMMENCE SEARCH
C
       NSH=NGRID**NMKT
       DO 60 IS=1,NSH
C ***************************************************************
C *** SET PRICES FOR SEARCH POINT IS ****************************
C ***************************************************************
         DO 20 I=1,NMKT
            ISP=((IS-1)/(NGRID**(I-1)))-((IS-1)/(NGRID**I))*NGRID
            SP=ISP
            PIM(I,M)=PMIN(I)+GRIDST(I)*SP
20       CONTINUE
C ***************************************************************
C *** CALL MODEL ************************************************
C ***************************************************************
         CALL PPPP
         CALL PSPS
         CALL SSSS
         NUB=0
         CALL DDDD
C ***************************************************************
C *** COMPUTE DISEQUILIBRIUM METRIC *****************************
C ***************************************************************
         XX=0.D0
         DO 40 I=1,NMKT
            U=1.D0
            V=1.D0
            DO 30 L=1,NL
               U=U+EDRIL(I,L)
               V=V+ESRILM(I,L,M)
30          CONTINUE
         XX=XX+(DLOG(U)-DLOG(V))**2
40       CONTINUE
C *************************************************************
C *** CHECK TO SEE IF SEARCH POINT IS MINIMUM DISEQUILIBRIUM ***
C **************************************************************
         IF((IS.EQ.1).OR.(XX.LT.XMIN)) XMIN=XX
         DO 50 I=1,NMKT
            IF(XX.LE.XMIN) PSTAR(I)=PIM(I,M)
50       CONTINUE
60       CONTINUE
C
C ASSIGN PRICES TO PIM AND RETURN
C
      DO 70 I=1,NMKT
         PIM(I,M)=PSTAR(I)
70    CONTINUE
C
        WRITE(JUNIT,100)PIM
100     FORMAT(' ','PIML:',6G12.6)
        RETURN
        END