MINICERN/mathlib/gen/j/findem.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:50  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE FINDEM(F,NUMBCS,CONTUR)
  11 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  12 C   PURPOSE                                                            C
  13 C     TO FIND REASONABLE CONTOUR VALUES FOR A USER WHO HAS NOT         C
  14 C     ALREADY MADE UP HIS MIND. (AUXILIARY TO CONT.)                   C
  15 C   USAGE                                                              C
  16 C     CALL FINDEM(F,NUMBCS,CONTUR)                                     C
  17 C   PARAMETERS                                                         C
  18 C     F      - THE FUNCTION TO BE PLOTTED BY CONT                      C
  19 C     NUMBCS - THE DESIRED NUMBER OF CONTOURS                          C
  20 C     CONTUR - AN ARRAY INTO WHICH THE CONTOUR VALUES WILL BE RETURNED.C
  21 C     THE CHOSEN NAME FOR F MUST APPEAR IN AN EXTERNAL STATEMENT IN    C
  22 C     THE PROGRAM CALLING FINDEM.                                      C
  23 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  24       EXTERNAL F
  25       DIMENSION CONTUR(10)
  26       COMMON /J509C1/XBL,YBL,XUR,YUR,NX(6),NY(6),LETT1,LETT2,LINE1,LINE2
  27 C=======================================================================
  28       IF(1.LE.NUMBCS .AND. NUMBCS.LE.10)GO TO 10
  29       WRITE(6,1010)NUMBCS
  30       RETURN
  31    10 CONTINUE
  32       CALL J509BD
  33       FMIN = F(XBL,YBL)
  34       FMAX=FMIN
  35       XVAL = XBL
  36       DXVAL = 2.*(XUR-XBL)/(LETT2-LETT1)
  37       YVAL = YBL
  38       DYVAL = 2.*(YUR-YBL)/(LINE2-LINE1)
  39       DO 30 LETT= LETT1,LETT2,2
  40       XVAL = XVAL + DXVAL
  41       YVAL = YBL
  42       DO 20 LINE= LINE1,LINE2,2
  43       YVAL = YVAL + DYVAL
  44       FNOW = F(XVAL,YVAL)
  45       IF(FNOW .LT. FMIN)FMIN=FNOW
  46       IF(FNOW .GT. FMAX)FMAX=FNOW
  47    20 CONTINUE
  48    30 CONTINUE
  49       SPAN=FMAX-FMIN
  50       CFIRST=FMIN+0.05*SPAN
  51       CLAST=FMAX-0.05*SPAN
  52       STEP=(CLAST-CFIRST)/(NUMBCS-1)
  53       DO 40 NUMBC=1,NUMBCS
  54    40 CONTUR(NUMBC)=CFIRST+(NUMBC-1)*STEP
  55       RETURN
  56  1010 FORMAT(' HOW MANY CONTOURS DID YOU WANT---',I10,'---(FINDEM)')
  57       END