mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
35 lines
1 KiB
Fortran
35 lines
1 KiB
Fortran
*DECK DMACON
|
|
SUBROUTINE DMACON
|
|
C***BEGIN PROLOGUE DMACON
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to DBVSUP
|
|
C***LIBRARY SLATEC
|
|
C***TYPE DOUBLE PRECISION (MACON-S, DMACON-D)
|
|
C***AUTHOR (UNKNOWN)
|
|
C***SEE ALSO DBVSUP
|
|
C***ROUTINES CALLED D1MACH
|
|
C***COMMON BLOCKS DML5MC
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 750601 DATE WRITTEN
|
|
C 890531 Changed all specific intrinsics to generic. (WRB)
|
|
C 890921 Realigned order of variables in certain COMMON blocks.
|
|
C (WRB)
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 900328 Added TYPE section. (WRB)
|
|
C***END PROLOGUE DMACON
|
|
DOUBLE PRECISION D1MACH
|
|
INTEGER KE, LPAR
|
|
DOUBLE PRECISION DD, EPS, FOURU, SQOVFL, SRU, TWOU, URO
|
|
COMMON /DML5MC/ URO,SRU,EPS,SQOVFL,TWOU,FOURU,LPAR
|
|
C***FIRST EXECUTABLE STATEMENT DMACON
|
|
URO = D1MACH(4)
|
|
SRU = SQRT(URO)
|
|
DD = -LOG10(URO)
|
|
LPAR = 0.5D0*DD
|
|
KE = 0.5D0 + 0.75D0*DD
|
|
EPS = 10.0D0**(-2*KE)
|
|
SQOVFL = SQRT(D1MACH(2))
|
|
TWOU = 2.0D0*URO
|
|
FOURU = 4.0D0*URO
|
|
RETURN
|
|
END
|