MINICERN/mathlib/gen/divon/divon.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:03:23  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE DIVON (D,UMINUS,UPLUS,ERROR,NMAX,FUN1,ERRINT)
  11       INTEGER D,NMAX
  12       REAL UMINUS(D),UPLUS(D),ERROR
  13       COMMON /ANSWER/ FINTGL,SPRD,DUMMY(5),NRGN,MAXRGN /FUNN/ NFUN,MO(2)
  14       COMMON /Z0001/ ERR,NMIN,MCOUNT /SAMPLE/ NPT /PRSTOP/ NSTOP
  15       COMMON /PRINT/ IPRINT /ZEETRM/ ITRMF
  16 #include "d151dt.inc"
  17       DATA FAC /1.0/
  18 C         INITIALISATION OF CONSTANTS
  19       CALL DVNBKD
  20 C
  21       ITRMF=0
  22       IF(NMAX.GT.0) GOTO 30
  23       IF(IPRINT.LE.0) GOTO 20
  24       WRITE(6,10) NMAX
  25  10   FORMAT('0--- DIVON --- ',I5,' FUNCTION EVALUATIONS SPECIFIED.')
  26  20   RETURN
  27  30   IF(IPRINT.LE.0) GOTO 80
  28       WRITE(6,40) IDATE,D,ERROR,NMAX
  29  40   FORMAT('1--- DIVON --- DIVONNE4 (',A8,')  MULTIPLE INTEGRATION'/
  30      11X,I2,'  DIMENSIONS, ERROR =',G13.5,',  NMAX = ',I8)
  31       WRITE(6,50)
  32  50   FORMAT('0INTEGRATION LIMITS :')
  33       DO 70 I=1,D
  34       WRITE(6,60) I,UMINUS(I),UPLUS(I)
  35  60   FORMAT(' X(',I2,') :',G13.5,'   TO',G14.5)
  36  70   CONTINUE
  37  80   NMIN=9999999
  38       MCOUNT=NSTOP
  39       ERR=ERROR
  40       ITRMF=1
  41       CALL PARTN(D,UMINUS,UPLUS,0.0,NMAX)
  42       IF(NFUN+2*NPT*NRGN.LE.NMAX) GOTO 110
  43       IF(IPRINT.LE.0) GOTO 100
  44       WRITE(6,90)
  45  90   FORMAT('0--- DIVON --- NOT ENOUGH FUNCTION EVALUATIONS LEFT'
  46      1/' FOR MORE PRECISE INTEGRAL ESTIMATE.')
  47  100  FUN1=FINTGL
  48       ERRINT=SPRD/NPT
  49       RETURN
  50  110  ERRR=ABS(ERR)
  51       IF(ERR.GT.0.0) ERRR=ERRR*FINTGL
  52       NINT=MIN(MAX(2.0*NPT,SPRD*FAC/ERRR),REAL(NMAX-NFUN)/NRGN)+.5
  53       IF(IPRINT.LE.0) GOTO 130
  54       WRITE(6,120) NINT
  55  120  FORMAT('0--- DIVON --- INTEGRAL AND ERROR ESTIMATE WITH',I6,
  56      1 ' POINTS / REGION :')
  57  130  CALL INTGRL(D,0,NINT,FUN1,ERRINT)
  58       RETURN
  59       END