Funções matemáticas em geral#
acos#
Nome#
acos(3) - [MATHEMATICS:TRIGONOMETRIC] Arccosine (inverse cosine) function
Synopsis#
result = acos(x)
elemental TYPE(kind=KIND) function acos(x)
TYPE(kind=KIND),intent(in) :: x
Characteristics#
TYPE may be real or complex
KIND may be any kind supported by the associated type.
The returned value will be of the same type and kind as the argument.
Descrição#
acos(3) computes the arccosine of x (inverse of cos(x)).
Opções#
- x
The value to compute the arctangent of.
If the type is real, the value must satisfy |x| <= 1.
Resultado#
The return value is of the same type and kind as x. The real part of the result is in radians and lies in the range 0 <= acos(x%re) <= PI .
Exemplos#
Exemplo de programa:
program demo_acos
use, intrinsic :: iso_fortran_env, only : real_kinds,real32,real64,real128
implicit none
character(len=*),parameter :: all='(*(g0,1x))'
real(kind=real64) :: x , d2r
! basics
x = 0.866_real64
print all,'acos(',x,') is ', acos(x)
! acos(-1) should be PI
print all,'for reference &
&PI ~= 3.14159265358979323846264338327950288419716939937510'
write(*,*) acos(-1.0_real64)
d2r=acos(-1.0_real64)/180.0_real64
print all,'90 degrees is ', d2r*90.0_real64, ' radians'
! elemental
print all,'elemental',acos([-1.0,-0.5,0.0,0.50,1.0])
! complex
print *,'complex',acos( (-1.0, 0.0) )
print *,'complex',acos( (-1.0, -1.0) )
print *,'complex',acos( ( 0.0, -0.0) )
print *,'complex',acos( ( 1.0, 0.0) )
end program demo_acos
Resultados:
acos( 0.86599999999999999 ) is 0.52364958093182890
for reference PI ~= 3.14159265358979323846264338327950288419716939937510
3.1415926535897931
90 degrees is 1.5707963267948966 radians
elemental 3.14159274 2.09439516 1.57079637 1.04719758 0.00000000
complex (3.14159274,-0.00000000)
complex (2.23703575,1.06127501)
complex (1.57079637,0.00000000)
complex (0.00000000,-0.00000000)
Padrão#
FORTRAN 77 ; for a complex argument - Fortran 2008
Veja Também#
Inverse function: cos(3)
Recursos#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
acosh#
Nome#
acosh(3) - [MATHEMATICS:TRIGONOMETRIC] Inverse hyperbolic cosine function
Synopsis#
result = acosh(x)
elemental TYPE(kind=KIND) function acosh(x)
TYPE(kind=KIND),intent(in) :: x
Characteristics#
TYPE may be real or complex
KIND may be any kind supported by the associated type.
The returned value will be of the same type and kind as the argument.
Descrição#
acosh(3) computes the inverse hyperbolic cosine of x in radians.
Opções#
- x
The value to compute the hyperbolic cosine of
Resultado#
The result has a value equal to a processor-dependent approximation to the inverse hyperbolic cosine function of X.
If x is complex, the imaginary part of the result is in radians and lies between
0 <= aimag(acosh(x)) <= PI
Exemplos#
Exemplo de programa:
program demo_acosh
use,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32
implicit none
real(kind=dp), dimension(3) :: x = [ 1.0d0, 2.0d0, 3.0d0 ]
write (*,*) acosh(x)
end program demo_acosh
Resultados:
0.000000000000000E+000 1.31695789692482 1.76274717403909
Padrão#
Fortran 2008
Veja Também#
Função inversa: cosh(3)
Recursos#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
asin#
Nome#
asin(3) - [MATHEMATICS:TRIGONOMETRIC] Arcsine function
Synopsis#
result = asin(x)
elemental TYPE(kind=KIND) function asin(x)
TYPE(kind=KIND) :: x
Characteristics#
TYPE may be real or complex
KIND may be any kind supported by the associated type.
The returned value will be of the same type and kind as the argument.
Descrição#
asin(3) computes the arcsine of its argument x.
The arcsine is the inverse function of the sine function. It is commonly used in trigonometry when trying to find the angle when the lengths of the hypotenuse and the opposite side of a right triangle are known.
Opções#
- x
The value to compute the arcsine of
The type shall be either real and a magnitude that is less than or equal to one; or be complex.
Resultado#
result The result has a value equal to a processor-dependent approximation to arcsin(x).
If x is real the result is real and it is expressed in radians and lies in the range
PI/2 <= ASIN (X) <= PI/2.
If the argument (and therefore the result) is imaginary the real part of the result is in radians and lies in the range
-PI/2 <= real(asin(x)) <= PI/2
Exemplos#
The arcsine will allow you to find the measure of a right angle when you know the ratio of the side opposite the angle to the hypotenuse.
So if you knew that a train track rose 1.25 vertical miles on a track that was 50 miles long, you could determine the average angle of incline of the track using the arcsine. Given
sin(theta) = 1.25 miles/50 miles (opposite/hypotenuse)
Exemplo de programa:
program demo_asin
use, intrinsic :: iso_fortran_env, only : dp=>real64
implicit none
! value to convert degrees to radians
real(kind=dp),parameter :: D2R=acos(-1.0_dp)/180.0_dp
real(kind=dp) :: angle, rise, run
character(len=*),parameter :: all='(*(g0,1x))'
! given sine(theta) = 1.25 miles/50 miles (opposite/hypotenuse)
! then taking the arcsine of both sides of the equality yields
! theta = arcsine(1.25 miles/50 miles) ie. arcsine(opposite/hypotenuse)
rise=1.250_dp
run=50.00_dp
angle = asin(rise/run)
print all, 'angle of incline(radians) = ', angle
angle = angle/D2R
print all, 'angle of incline(degrees) = ', angle
print all, 'percent grade=',rise/run*100.0_dp
end program demo_asin
Resultados:
angle of incline(radians) = 2.5002604899361139E-002
angle of incline(degrees) = 1.4325437375665075
percent grade= 2.5000000000000000
The percentage grade is the slope, written as a percent. To calculate the slope you divide the rise by the run. In the example the rise is 1.25 mile over a run of 50 miles so the slope is 1.25/50 = 0.025. Written as a percent this is 2.5 %.
For the US, two and 1/2 percent is generally thought of as the upper limit. This means a rise of 2.5 feet when going 100 feet forward. In the US this was the maximum grade on the first major US railroad, the Baltimore and Ohio. Note curves increase the frictional drag on a train reducing the allowable grade.
Padrão#
FORTRAN 77 , for a complex argument Fortran 2008
Veja Também#
Função inversa: sin(3)
Recursos#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
asinh#
Nome#
asinh(3) - [MATHEMATICS:TRIGONOMETRIC] Inverse hyperbolic sine function
Synopsis#
result = asinh(x)
elemental TYPE(kind=KIND) function asinh(x)
TYPE(kind=KIND) :: x
Characteristics#
x may be any real or complex type
KIND may be any kind supported by the associated type
The returned value will be of the same type and kind as the argument x
Descrição#
asinh(3) computes the inverse hyperbolic sine of x.
Opções#
- x
The value to compute the inverse hyperbolic sine of
Resultado#
The result has a value equal to a processor-dependent approximation to the inverse hyperbolic sine function of x.
If x is complex, the imaginary part of the result is in radians and lies between -PI/2 <= aimag(asinh(x)) <= PI/2.
Exemplos#
Exemplo de programa:
program demo_asinh
use,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32
implicit none
real(kind=dp), dimension(3) :: x = [ -1.0d0, 0.0d0, 1.0d0 ]
! elemental
write (*,*) asinh(x)
end program demo_asinh
Resultados:
-0.88137358701954305 0.0000000000000000 0.88137358701954305
Padrão#
Fortran 2008
Veja Também#
Função inversa: sinh(3)
Recursos#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
atan#
Nome#
atan(3) - [MATHEMATICS:TRIGONOMETRIC] Arctangent AKA inverse tangent function
Synopsis#
result = atan([x) | atan(y, x)
elemental TYPE(kind=KIND) function atan(y,x)
TYPE(kind=KIND),intent(in) :: x
TYPE(kind=**),intent(in),optional :: y
Characteristics#
If y is present x and y must both be real. Otherwise, x may be complex.
KIND can be any kind supported by the associated type.
The returned value is of the same type and kind as x.
Descrição#
atan(3) computes the arctangent of x.
Opções#
- x
The value to compute the arctangent of. if y is present, x shall be real.
- y
is of the same type and kind as x. If x is zero, y must not be zero.
Resultado#
The returned value is of the same type and kind as x. If y is present, the result is identical to atan2(y,x). Otherwise, it is the arc tangent of x, where the real part of the result is in radians and lies in the range -PI/2 <= atan(x) <= PI/2
Exemplos#
Exemplo de programa:
program demo_atan
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
character(len=*),parameter :: all='(*(g0,1x))'
real(kind=real64),parameter :: &
Deg_Per_Rad = 57.2957795130823208767981548_real64
real(kind=real64) :: x
x=2.866_real64
print all, atan(x)
print all, atan( 2.0d0, 2.0d0),atan( 2.0d0, 2.0d0)*Deg_Per_Rad
print all, atan( 2.0d0,-2.0d0),atan( 2.0d0,-2.0d0)*Deg_Per_Rad
print all, atan(-2.0d0, 2.0d0),atan(-2.0d0, 2.0d0)*Deg_Per_Rad
print all, atan(-2.0d0,-2.0d0),atan(-2.0d0,-2.0d0)*Deg_Per_Rad
end program demo_atan
Resultados:
1.235085437457879
.7853981633974483 45.00000000000000
2.356194490192345 135.0000000000000
-.7853981633974483 -45.00000000000000
-2.356194490192345 -135.0000000000000
Padrão#
FORTRAN 77 for a complex argument; and for two arguments Fortran 2008
Veja Também#
Recursos#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
atan2#
Nome#
atan2(3) - [MATHEMATICS:TRIGONOMETRIC] Arctangent (inverse tangent) function
Synopsis#
result = atan2(y, x)
elemental real(kind=KIND) function atan2(y, x)
real,kind=KIND) :: atan2
real,kind=KIND),intent(in) :: y, x
Characteristics#
x and y must be reals of the same kind.
The return value has the same type and kind as y and x.
Descrição#
atan2(3) computes in radians a processor-dependent approximation of the arctangent of the complex number ( x, y ) or equivalently the principal value of the arctangent of the value y/x (which determines a unique angle).
If y has the value zero, x shall not have the value zero.
The resulting phase lies in the range -PI <= ATAN2 (Y,X) <= PI and is equal to a processor-dependent approximation to a value of arctan(Y/X).
Opções#
- y
The imaginary component of the complex value (x,y) or the y component of the point <x,y>.
- x
The real component of the complex value (x,y) or the x component of the point <x,y>.
Resultado#
The value returned is by definition the principal value of the complex number (x, y), or in other terms, the phase of the phasor x+i*y.
The principal value is simply what we get when we adjust a radian value to lie between -PI and PI inclusive,
The classic definition of the arctangent is the angle that is formed in Cartesian coordinates of the line from the origin point <0,0> to the point <x,y> .
Pictured as a vector it is easy to see that if x and y are both zero the angle is indeterminate because it sits directly over the origin, so atan(0.0,0.0) will produce an error.
Range of returned values by quadrant:
> +PI/2
> |
> |
> PI/2 < z < PI | 0 > z < PI/2
> |
> +-PI -------------+---------------- +-0
> |
> PI/2 < -z < PI | 0 < -z < PI/2
> |
> |
> -PI/2
>
NOTES:
If the processor distinguishes -0 and +0 then the sign of the
returned value is that of Y when Y is zero, else when Y is zero
the returned value is always positive.
Exemplos#
Exemplo de programa:
program demo_atan2
real :: z
complex :: c
!
! basic usage
! ATAN2 (1.5574077, 1.0) has the value 1.0 (approximately).
z=atan2(1.5574077, 1.0)
write(*,*) 'radians=',z,'degrees=',r2d(z)
!
! elemental arrays
write(*,*)'elemental',atan2( [10.0, 20.0], [30.0,40.0] )
!
! elemental arrays and scalars
write(*,*)'elemental',atan2( [10.0, 20.0], 50.0 )
!
! break complex values into real and imaginary components
! (note TAN2() can take a complex type value )
c=(0.0,1.0)
write(*,*)'complex',c,atan2( x=c%re, y=c%im )
!
! extended sample converting cartesian coordinates to polar
COMPLEX_VALS: block
real :: ang, radius
complex,allocatable :: vals(:)
!
vals=[ &
( 1.0, 0.0 ), & ! 0
( 1.0, 1.0 ), & ! 45
( 0.0, 1.0 ), & ! 90
(-1.0, 1.0 ), & ! 135
(-1.0, 0.0 ), & ! 180
(-1.0,-1.0 ), & ! 225
( 0.0,-1.0 )] ! 270
do i=1,size(vals)
call cartesian_to_polar(vals(i)%re, vals(i)%im, radius,ang)
write(*,101)vals(i),ang,r2d(ang),radius
enddo
101 format( &
& 'X= ',f5.2, &
& ' Y= ',f5.2, &
& ' ANGLE= ',g0, &
& T38,'DEGREES= ',g0.4, &
& T54,'DISTANCE=',g0)
endblock COMPLEX_VALS
!
contains
!
elemental real function r2d(radians)
! input radians to convert to degrees
doubleprecision,parameter :: DEGREE=0.017453292519943d0 ! radians
real,intent(in) :: radians
r2d=radians / DEGREE ! do the conversion
end function r2d
!
subroutine cartesian_to_polar(x,y,radius,inclination)
! return angle in radians in range 0 to 2*PI
implicit none
real,intent(in) :: x,y
real,intent(out) :: radius,inclination
radius=sqrt(x**2+y**2)
if(radius.eq.0)then
inclination=0.0
else
inclination=atan2(y,x)
if(inclination < 0.0)inclination=inclination+2*atan2(0.0d0,-1.0d0)
endif
end subroutine cartesian_to_polar
!
end program demo_atan2
Resultados:
> radians= 1.000000 degrees= 57.29578
> elemental 0.3217506 0.4636476
> elemental 0.1973956 0.3805064
> complex (0.0000000E+00,1.000000) 1.570796
> X= 1.00 Y= 0.00 ANGLE= .000000 DEGREES= .000 DISTANCE=1.000000
> X= 1.00 Y= 1.00 ANGLE= .7853982 DEGREES= 45.00 DISTANCE=1.414214
> X= 0.00 Y= 1.00 ANGLE= 1.570796 DEGREES= 90.00 DISTANCE=1.000000
> X= -1.00 Y= 1.00 ANGLE= 2.356194 DEGREES= 135.0 DISTANCE=1.414214
> X= -1.00 Y= 0.00 ANGLE= 3.141593 DEGREES= 180.0 DISTANCE=1.000000
> X= -1.00 Y= -1.00 ANGLE= 3.926991 DEGREES= 225.0 DISTANCE=1.414214
> X= 0.00 Y= -1.00 ANGLE= 4.712389 DEGREES= 270.0 DISTANCE=1.000000
Padrão#
FORTRAN 77
Veja Também#
Recursos#
arctan:wikipedia fortran-lang intrinsic descriptions (license: MIT) @urbanjost
atanh#
Nome#
atanh(3) - [MATHEMATICS:TRIGONOMETRIC] Inverse hyperbolic tangent function
Synopsis#
result = atanh(x)
elemental TYPE(kind=KIND) function atanh(x)
TYPE(kind=KIND),intent(in) :: x
Characteristics#
x may be real or complex of any associated type
The returned value will be of the same type and kind as the argument.
Descrição#
atanh(3) computes the inverse hyperbolic tangent of x.
Opções#
- x
The type shall be real or complex.
Resultado#
The return value has same type and kind as x. If x is complex, the imaginary part of the result is in radians and lies between
**-PI/2 <= aimag(atanh(x)) <= PI/2**
Exemplos#
Exemplo de programa:
program demo_atanh
implicit none
real, dimension(3) :: x = [ -1.0, 0.0, 1.0 ]
write (*,*) atanh(x)
end program demo_atanh
Resultados:
> -Infinity 0.0000000E+00 Infinity
Padrão#
Fortran 2008
Veja Também#
Função inversa: tanh(3)
Recursos#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
cos#
Nome#
cos(3) - [MATHEMATICS:TRIGONOMETRIC] Cosine function
Synopsis#
result = cos(x)
elemental TYPE(kind=KIND) function cos(x)
TYPE(kind=KIND),intent(in) :: x
Characteristics#
x is of type real or complex of any valid kind.
KIND may be any kind supported by the associated type of x.
The returned value will be of the same type and kind as the argument x.
Descrição#
cos(3) computes the cosine of an angle x given the size of the angle in radians.
O cosseno de um valor real é a razão entre o cateto adjacente e a hipotenusa do triângulo retângulo.
Opções#
- x
The angle in radians to compute the cosine of.
Resultado#
The return value is the tangent of x.
If x is of the type real, the return value is in radians and lies in the range -1 <= cos(x) <= 1 .
If x is of type complex, its real part is regarded as a value in radians, often called the phase.
Exemplos#
Exemplo de programa:
program demo_cos
implicit none
character(len=*),parameter :: g2='(a,t20,g0)'
doubleprecision,parameter :: PI=atan(1.0d0)*4.0d0
write(*,g2)'COS(0.0)=',cos(0.0)
write(*,g2)'COS(PI)=',cos(PI)
write(*,g2)'COS(PI/2.0d0)=',cos(PI/2.0d0),'EPSILON=',epsilon(PI)
write(*,g2)'COS(2*PI)=',cos(2*PI)
write(*,g2)'COS(-2*PI)=',cos(-2*PI)
write(*,g2)'COS(-2000*PI)=',cos(-2000*PI)
write(*,g2)'COS(3000*PI)=',cos(3000*PI)
end program demo_cos
Resultados:
> COS(0.0)= 1.000000
> COS(PI)= -1.000000000000000
> COS(PI/2.0d0)= .6123233995736766E-16
> EPSILON= .2220446049250313E-15
> COS(2*PI)= 1.000000000000000
> COS(-2*PI)= 1.000000000000000
> COS(-2000*PI)= 1.000000000000000
> COS(3000*PI)= 1.000000000000000
Padrão#
FORTRAN 77
Veja Também#
Recursos#
fortran-lang intrinsic descriptions
cosh#
Nome#
cosh(3) - [MATHEMATICS:TRIGONOMETRIC] Hyperbolic cosine function
Synopsis#
result = cosh(x)
elemental TYPE(kind=KIND) function cosh(x)
TYPE(kind=KIND),intent(in) :: x
Characteristics#
TYPE may be real or complex of any kind.
The returned value will be of the same type and kind as the argument.
Descrição#
cosh(3) computes the hyperbolic cosine of x.
If x is of type complex its imaginary part is regarded as a value in radians.
Opções#
- x
the value to compute the hyperbolic cosine of
Resultado#
If x is complex, the imaginary part of the result is in radians.
If x is real, the return value has a lower bound of one, cosh(x) >= 1.
Exemplos#
Exemplo de programa:
program demo_cosh
use, intrinsic :: iso_fortran_env, only : &
& real_kinds, real32, real64, real128
implicit none
real(kind=real64) :: x = 1.0_real64
write(*,*)'X=',x,'COSH(X=)',cosh(x)
end program demo_cosh
Resultados:
> X= 1.00000000000000 COSH(X=) 1.54308063481524
Padrão#
FORTRAN 77 , for a complex argument - Fortran 2008
Veja Também#
Função inversa: acosh(3)
Recursos#
fortran-lang intrinsic descriptions
sin#
Nome#
sin(3) - [MATHEMATICS:TRIGONOMETRIC] Sine function
Synopsis#
result = sin(x)
elemental TYPE(kind=KIND) function sin(x)
TYPE(kind=KIND) :: x
Characteristics#
x may be any real or complex type
KIND may be any kind supported by the associated type of x.
The returned value will be of the same type and kind as the argument x.
Descrição#
sin(3) computes the sine of an angle given the size of the angle in radians.
O seno de um ângulo de um triângulo retângulo é a razão entre o tamanho do cateto oposto e o tamanho da hipotenusa.
Opções#
- x
The angle in radians to compute the sine of.
Resultado#
result The return value contains the processor-dependent approximation of the sine of x
If X is of type real, it is regarded as a value in radians.
If X is of type complex, its real part is regarded as a value in radians.
Exemplos#
Exemplo de programa:
program sample_sin
implicit none
real :: x = 0.0
x = sin(x)
write(*,*)'X=',x
end program sample_sin
Resultados:
> X= 0.0000000E+00
Extended Example#
Haversine Formula#
Do artigo «Fórmula de Haversine» na Wikipédia:
The haversine formula is an equation important in navigation,
giving great-circle distances between two points on a sphere from
their longitudes and latitudes.
So to show the great-circle distance between the Nashville International Airport (BNA) in TN, USA, and the Los Angeles International Airport (LAX) in CA, USA you would start with their latitude and longitude, commonly given as
BNA: N 36 degrees 7.2', W 86 degrees 40.2'
LAX: N 33 degrees 56.4', W 118 degrees 24.0'
which converted to floating-point values in degrees is:
Latitude Longitude
- BNA
36.12, -86.67
- LAX
33.94, -118.40
And then use the haversine formula to roughly calculate the distance along the surface of the Earth between the locations:
Exemplo de programa:
program demo_sin
implicit none
real :: d
d = haversine(36.12,-86.67, 33.94,-118.40) ! BNA to LAX
print '(A,F9.4,A)', 'distance: ',d,' km'
contains
function haversine(latA,lonA,latB,lonB) result (dist)
!
! calculate great circle distance in kilometers
! given latitude and longitude in degrees
!
real,intent(in) :: latA,lonA,latB,lonB
real :: a,c,dist,delta_lat,delta_lon,lat1,lat2
real,parameter :: radius = 6371 ! mean earth radius in kilometers,
! recommended by the International Union of Geodesy and Geophysics
! generate constant pi/180
real, parameter :: deg_to_rad = atan(1.0)/45.0
delta_lat = deg_to_rad*(latB-latA)
delta_lon = deg_to_rad*(lonB-lonA)
lat1 = deg_to_rad*(latA)
lat2 = deg_to_rad*(latB)
a = (sin(delta_lat/2))**2 + &
& cos(lat1)*cos(lat2)*(sin(delta_lon/2))**2
c = 2*asin(sqrt(a))
dist = radius*c
end function haversine
end program demo_sin
Resultados:
> distance: 2886.4446 km
Padrão#
FORTRAN 77
Veja Também#
asin(3), cos(3), tan(3), acosh(3), acos(3), asinh(3), atan2(3), atanh(3), acosh(3), asinh(3), atanh(3)
Recursos#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
sinh#
Nome#
sinh(3) - [MATHEMATICS:TRIGONOMETRIC] Hyperbolic sine function
Synopsis#
result = sinh(x)
elemental TYPE(kind=KIND) function sinh(x)
TYPE(kind=KIND) :: x
Characteristics#
TYPE may be real or complex
KIND may be any kind supported by the associated type.
The returned value will be of the same type and kind as the argument.
Descrição#
sinh(3) computes the hyperbolic sine of x.
The hyperbolic sine of x is defined mathematically as:
sinh(x) = (exp(x) - exp(-x)) / 2.0
Opções#
- x
The value to calculate the hyperbolic sine of
Resultado#
The result has a value equal to a processor-dependent approximation to sinh(X). If X is of type complex its imaginary part is regarded as a value in radians.
Exemplos#
Exemplo de programa:
program demo_sinh
use, intrinsic :: iso_fortran_env, only : &
& real_kinds, real32, real64, real128
implicit none
real(kind=real64) :: x = - 1.0_real64
real(kind=real64) :: nan, inf
character(len=20) :: line
! basics
print *, sinh(x)
print *, (exp(x)-exp(-x))/2.0
! sinh(3) is elemental and can handle an array
print *, sinh([x,2.0*x,x/3.0])
! a NaN input returns NaN
line='NAN'
read(line,*) nan
print *, sinh(nan)
! a Inf input returns Inf
line='Infinity'
read(line,*) inf
print *, sinh(inf)
! an overflow returns Inf
x=huge(0.0d0)
print *, sinh(x)
end program demo_sinh
Resultados:
-1.1752011936438014
-1.1752011936438014
-1.1752011936438014 -3.6268604078470190 -0.33954055725615012
NaN
Infinity
Infinity
Padrão#
Fortran 95 , for a complex argument Fortran 2008
Veja Também#
Recursos#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
tan#
Nome#
tan(3) - [MATHEMATICS:TRIGONOMETRIC] Tangent function
Synopsis#
result = tan(x)
elemental TYPE(kind=KIND) function tan(x)
TYPE(kind=KIND),intent(in) :: x
Characteristics#
the TYPE of x may be real or complex of any supported kind
The returned value will be of the same type and kind as the argument x.
Descrição#
tan(3) computes the tangent of x.
Opções#
- x
The angle in radians to compute the tangent of for real input. If x is of type complex, its real part is regarded as a value in radians.
Resultado#
The return value is the tangent of the value x.
Exemplos#
Exemplo de programa:
program demo_tan
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
real(kind=real64) :: x = 0.165_real64
write(*,*)x, tan(x)
end program demo_tan
Resultados:
0.16500000000000001 0.16651386310913616
Padrão#
FORTRAN 77 . For a complex argument, Fortran 2008 .
Veja Também#
atan(3), atan2(3), cos(3), sin(3)
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
tanh#
Nome#
tanh(3) - [MATHEMATICS:TRIGONOMETRIC] Hyperbolic tangent function
Synopsis#
result = tanh(x)
elemental TYPE(kind=KIND) function tanh(x)
TYPE(kind=KIND),intent(in) :: x
Characteristics#
x may be real or complex and any associated kind supported by the processor.
The returned value will be of the same type and kind as the argument.
Descrição#
tanh(3) computes the hyperbolic tangent of x.
Opções#
- x
The value to compute the Hyperbolic tangent of.
Resultado#
Returns the hyperbolic tangent of x.
If x is complex, the imaginary part of the result is regarded as a radian value.
If x is real, the return value lies in the range
-1 <= tanh(x) <= 1.
Exemplos#
Exemplo de programa:
program demo_tanh
use, intrinsic :: iso_fortran_env, only : &
& real_kinds, real32, real64, real128
implicit none
real(kind=real64) :: x = 2.1_real64
write(*,*)x, tanh(x)
end program demo_tanh
Resultados:
2.1000000000000001 0.97045193661345386
Padrão#
FORTRAN 77 , for a complex argument Fortran 2008
Veja Também#
Recursos#
fortran-lang intrinsic descriptions
random_number#
Nome#
random_number(3) - [MATHEMATICS:RANDOM] Pseudo-random number
Synopsis#
call random_number(harvest)
subroutine random_number(harvest)
real,intent(out) :: harvest(..)
Characteristics#
harvest and the result are default real variables
Descrição#
random_number(3) returns a single pseudorandom number or an array of pseudorandom numbers from the uniform distribution over the range 0 <= x < 1.
Opções#
- harvest
Shall be a scalar or an array of type real.
Exemplos#
Exemplo de programa:
program demo_random_number
use, intrinsic :: iso_fortran_env, only : dp=>real64
implicit none
integer, allocatable :: seed(:)
integer :: n
integer :: first,last
integer :: i
integer :: rand_int
integer,allocatable :: count(:)
real(kind=dp) :: rand_val
call random_seed(size = n)
allocate(seed(n))
call random_seed(get=seed)
first=1
last=10
allocate(count(last-first+1))
! To have a discrete uniform distribution on the integers
! [first, first+1, ..., last-1, last] carve the continuous
! distribution up into last+1-first equal sized chunks,
! mapping each chunk to an integer.
!
! One way is:
! call random_number(rand_val)
! choose one from last-first+1 integers
! rand_int = first + FLOOR((last+1-first)*rand_val)
count=0
! generate a lot of random integers from 1 to 10 and count them.
! with a large number of values you should get about the same
! number of each value
do i=1,100000000
call random_number(rand_val)
rand_int=first+floor((last+1-first)*rand_val)
if(rand_int.ge.first.and.rand_int.le.last)then
count(rand_int)=count(rand_int)+1
else
write(*,*)rand_int,' is out of range'
endif
enddo
write(*,'(i0,1x,i0)')(i,count(i),i=1,size(count))
end program demo_random_number
Resultados:
1 10003588
2 10000104
3 10000169
4 9997996
5 9995349
6 10001304
7 10001909
8 9999133
9 10000252
10 10000196
Padrão#
Fortran 95
Veja Também#
fortran-lang intrinsic descriptions
random_seed#
Nome#
random_seed(3) - [MATHEMATICS:RANDOM] Initialize a pseudo-random number sequence
Synopsis#
call random_seed( [size] [,put] [,get] )
subroutine random_seed( size, put, get )
integer,intent(out),optional :: size
integer,intent(in),optional :: put(*)
integer,intent(out),optional :: get(*)
Characteristics#
size a scalar default integer
put a rank-one default integer array
get a rank-one default integer array
the result
Descrição#
random_seed(3) restarts or queries the state of the pseudorandom number generator used by random_number.
If random_seed is called without arguments, it is seeded with random data retrieved from the operating system.
Opções#
- size
specifies the minimum size of the arrays used with the put and get arguments.
- put
the size of the array must be larger than or equal to the number returned by the size argument.
- get
It is intent(out) and the size of the array must be larger than or equal to the number returned by the size argument.
Exemplos#
Exemplo de programa:
program demo_random_seed
implicit none
integer, allocatable :: seed(:)
integer :: n
call random_seed(size = n)
allocate(seed(n))
call random_seed(get=seed)
write (*, *) seed
end program demo_random_seed
Resultados:
-674862499 -1750483360 -183136071 -317862567 682500039
349459 344020729 -1725483289
Padrão#
Fortran 95
Veja Também#
fortran-lang intrinsic descriptions
exp#
Nome#
exp(3) - [MATHEMATICS] Base-e exponential function
Synopsis#
result = exp(x)
elemental TYPE(kind=KIND) function exp(x)
TYPE(kind=KIND),intent(in) :: x
Characteristics#
x may be real or complex of any kind.
The return value has the same type and kind as x.
Descrição#
exp(3) returns the value of e (the base of natural logarithms) raised to the power of x.
«e» is also known as Euler’s constant.
If x is of type complex, its imaginary part is regarded as a value in radians such that if (see Euler’s formula):
cx=(re,im)
then
exp(cx) = exp(re) * cmplx(cos(im),sin(im),kind=kind(cx))
Since exp(3) is the inverse function of log(3) the maximum valid magnitude of the real component of x is log(huge(x)).
Opções#
- x
The type shall be real or complex.
Resultado#
The value of the result is e**x where e is Euler’s constant.
If x is of type complex, its imaginary part is regarded as a value in radians.
Exemplos#
Exemplo de programa:
program demo_exp
implicit none
real :: x, re, im
complex :: cx
x = 1.0
write(*,*)"Euler's constant is approximately",exp(x)
!! complex values
! given
re=3.0
im=4.0
cx=cmplx(re,im)
! complex results from complex arguments are Related to Euler's formula
write(*,*)'given the complex value ',cx
write(*,*)'exp(x) is',exp(cx)
write(*,*)'is the same as',exp(re)*cmplx(cos(im),sin(im),kind=kind(cx))
! exp(3) is the inverse function of log(3) so
! the real component of the input must be less than or equal to
write(*,*)'maximum real component',log(huge(0.0))
! or for double precision
write(*,*)'maximum doubleprecision component',log(huge(0.0d0))
! but since the imaginary component is passed to the cos(3) and sin(3)
! functions the imaginary component can be any real value
end program demo_exp
Resultados:
Euler's constant is approximately 2.718282
given the complex value (3.000000,4.000000)
exp(x) is (-13.12878,-15.20078)
is the same as (-13.12878,-15.20078)
maximum real component 88.72284
maximum doubleprecision component 709.782712893384
Padrão#
FORTRAN 77
Veja Também#
Recursos#
Wikipédia:Função Exponencial
Wikipédia:Fórmula de Euler
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
log#
Nome#
log(3) - [MATHEMATICS] Natural logarithm
Synopsis#
result = log(x)
elemental TYPE(kind=KIND) function log(x)
TYPE(kind=KIND),intent(in) :: x
Characteristics#
x may be any real or complex kind.
the result is the same type and characteristics as x.
Descrição#
log(3) computes the natural logarithm of x, i.e. the logarithm to the base «e».
Opções#
- x
The value to compute the natural log of. If x is real, its value shall be greater than zero. If x is complex, its value shall not be zero.
Resultado#
The natural logarithm of x. If x is the complex value (r,i) , the imaginary part «i» is in the range
-PI < i <= PI
If the real part of x is less than zero and the imaginary part of x is zero, then the imaginary part of the result is approximately PI if the imaginary part of PI is positive real zero or the processor does not distinguish between positive and negative real zero, and approximately -PI if the imaginary part of x is negative real zero.
Exemplos#
Exemplo de programa:
program demo_log
implicit none
real(kind(0.0d0)) :: x = 2.71828182845904518d0
complex :: z = (1.0, 2.0)
write(*,*)x, log(x) ! will yield (approximately) 1
write(*,*)z, log(z)
end program demo_log
Resultados:
2.7182818284590451 1.0000000000000000
(1.00000000,2.00000000) (0.804718971,1.10714877)
Padrão#
FORTRAN 77
See also#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
log10#
Nome#
log10(3) - [MATHEMATICS] Base 10 or common logarithm
Synopsis#
result = log10(x)
elemental real(kind=KIND) function log10(x)
real(kind=KIND),intent(in) :: x
Characteristics#
x may be any kind of real value
the result is the same type and characteristics as x.
Descrição#
log10(3) computes the base 10 logarithm of x. This is generally called the «common logarithm».
Opções#
- x
A real value > 0 to take the log of.
Resultado#
The logarithm to base 10 of x
Exemplos#
Exemplo de programa:
program demo_log10
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
real(kind=real64) :: x = 10.0_real64
x = log10(x)
write(*,'(*(g0))')'log10(',x,') is ',log10(x)
! elemental
write(*, *)log10([1.0, 10.0, 100.0, 1000.0, 10000.0, &
& 100000.0, 1000000.0, 10000000.0])
end program demo_log10
Resultados:
> log10(1.000000000000000) is .000000000000000
> 0.0000000E+00 1.000000 2.000000 3.000000 4.000000
> 5.000000 6.000000 7.000000
Padrão#
FORTRAN 77
See also#
fortran-lang intrinsic descriptions
sqrt#
Nome#
sqrt(3) - [MATHEMATICS] Square-root function
Synopsis#
result = sqrt(x)
elemental TYPE(kind=KIND) function sqrt(x)
TYPE(kind=KIND),intent(in) :: x
Characteristics#
TYPE may be real or complex.
KIND may be any kind valid for the declared type.
the result has the same characteristics as x.
Descrição#
sqrt(3) computes the principal square root of x.
The number whose square root is being considered is known as the radicand.
In mathematics, a square root of a radicand x is a number y such that y*y = x.
Every nonnegative radicand x has two square roots of the same unique magnitude, one positive and one negative. The nonnegative square root is called the principal square root.
The principal square root of 9 is 3, for example, even though (-3)*(-3) is also 9.
Square roots of negative numbers are a special case of complex numbers, where with complex input the components of the radicand need not be positive in order to have a valid square root.
Opções#
- x
The radicand to find the principal square root of. If x is real its value must be greater than or equal to zero.
Resultado#
The principal square root of x is returned.
For a complex result the real part is greater than or equal to zero.
When the real part of the result is zero, the imaginary part has the same sign as the imaginary part of x.
Exemplos#
Exemplo de programa:
program demo_sqrt
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
real(kind=real64) :: x, x2
complex :: z, z2
! basics
x = 2.0_real64
! complex
z = (1.0, 2.0)
write(*,*)'input values ',x,z
x2 = sqrt(x)
z2 = sqrt(z)
write(*,*)'output values ',x2,z2
! elemental
write(*,*)'elemental',sqrt([64.0,121.0,30.0])
! alternatives
x2 = x**0.5
z2 = z**0.5
write(*,*)'alternatively',x2,z2
end program demo_sqrt
Resultados:
input values 2.00000000000000 (1.000000,2.000000)
output values 1.41421356237310 (1.272020,0.7861513)
elemental 8.000000 11.00000 5.477226
alternatively 1.41421356237310 (1.272020,0.7861513)
Padrão#
FORTRAN 77
See also#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
hypot#
Nome#
hypot(3) - [MATHEMATICS] Returns the Euclidean distance - the distance between a point and the origin.
Synopsis#
result = hypot(x, y)
elemental real(kind=KIND) function hypot(x,y)
real(kind=KIND),intent(in) :: x
real(kind=KIND),intent(in) :: y
Characteristics#
x,y and the result shall all be real and of the same kind.
Descrição#
hypot(3) is referred to as the Euclidean distance function. It is equal to
sqrt(x**2+y**2)
without undue underflow or overflow.
In mathematics, the Euclidean distance between two points in Euclidean space is the length of a line segment between two points.
hypot(x,y) returns the distance between the point <x,y> and the origin.
Opções#
- x
O tipo deve ser real.
- y
The type and kind type parameter shall be the same as x.
Resultado#
The return value has the same type and kind type parameter as x.
The result is the positive magnitude of the distance of the point <x,y> from the origin <0.0,0.0> .
Exemplos#
Exemplo de programa:
program demo_hypot
use, intrinsic :: iso_fortran_env, only : &
& real_kinds, real32, real64, real128
implicit none
real(kind=real32) :: x, y
real(kind=real32),allocatable :: xs(:), ys(:)
integer :: i
character(len=*),parameter :: f='(a,/,SP,*(3x,g0,1x,g0:,/))'
x = 1.e0_real32
y = 0.5e0_real32
write(*,*)
write(*,'(*(g0))')'point <',x,',',y,'> is ',hypot(x,y)
write(*,'(*(g0))')'units away from the origin'
write(*,*)
! elemental
xs=[ x, x**2, x*10.0, x*15.0, -x**2 ]
ys=[ y, y**2, -y*20.0, y**2, -y**2 ]
write(*,f)"the points",(xs(i),ys(i),i=1,size(xs))
write(*,f)"have distances from the origin of ",hypot(xs,ys)
write(*,f)"the closest is",minval(hypot(xs,ys))
end program demo_hypot
Resultados:
point <1.00000000,0.500000000> is 1.11803401
units away from the origin
the points
+1.00000000 +0.500000000
+1.00000000 +0.250000000
+10.0000000 -10.0000000
+15.0000000 +0.250000000
-1.00000000 -0.250000000
have distances from the origin of
+1.11803401 +1.03077638
+14.1421356 +15.0020828
+1.03077638
the closest is
+1.03077638
Padrão#
Fortran 2008
See also#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
bessel_j0#
Nome#
bessel_j0(3) - [MATHEMATICS] Bessel function of the first kind of order 0
Synopsis#
result = bessel_j0(x)
elemental real(kind=KIND) function bessel_j0(x)
real(kind=KIND),intent(in) :: x
Characteristics#
KIND may be any KIND supported by the real type.
The result is the same type and kind as x.
Descrição#
bessel_j0(3) computes the Bessel function of the first kind of order 0 of x.
Opções#
- x
The value to operate on.
Resultado#
the Bessel function of the first kind of order 0 of x. The result lies in the range -0.4027 <= bessel(0,x) <= 1.
Exemplos#
Exemplo de programa:
program demo_bessel_j0
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
real(kind=real64) :: x
x = 0.0_real64
x = bessel_j0(x)
write(*,*)x
end program demo_bessel_j0
Resultados:
1.0000000000000000
Padrão#
Fortran 2008
Veja Também#
bessel_j1(3), bessel_jn(3), bessel_y0(3), bessel_y1(3), bessel_yn(3)
fortran-lang intrinsic descriptions
bessel_j1#
Nome#
bessel_j1(3) - [MATHEMATICS] Bessel function of the first kind of order 1
Synopsis#
result = bessel_j1(x)
elemental real(kind=KIND) function bessel_j1(x)
real(kind=KIND),intent(in) :: x
Characteristics#
KIND may be any supported real KIND.
the result is of the same type and kind as x
Descrição#
bessel_j1(3) computes the Bessel function of the first kind of order 1 of x.
Opções#
- x
O tipo deve ser real.
Resultado#
The return value is of type real and lies in the range -0.5818 <= bessel(0,x) <= 0.5818 . It has the same kind as x.
Exemplos#
Exemplo de programa:
program demo_bessel_j1
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
real(kind=real64) :: x = 1.0_real64
x = bessel_j1(x)
write(*,*)x
end program demo_bessel_j1
Resultados:
0.44005058574493350
Padrão#
Fortran 2008
Veja Também#
bessel_j0(3), bessel_jn(3), bessel_y0(3), bessel_y1(3), bessel_yn(3)
fortran-lang intrinsic descriptions
bessel_jn#
Nome#
bessel_jn(3) - [MATHEMATICS] Bessel function of the first kind
Synopsis#
result = bessel_jn(n, x)
elemental real(kind=KIND) function bessel_jn(n,x)
integer(kind=**),intent(in) :: n
real(kind=KIND),intent(in) :: x
KIND may be any valid value for type real
x is real
The return value has the same type and kind as x.
result = bessel_jn(n1, n2, x)
real(kind=KIND) function bessel_jn(n1, n2, ,x)
integer(kind=**),intent(in) :: n1
integer(kind=**),intent(in) :: n2
real(kind=KIND),intent(in) :: x
n1 is integer
n2 is integer
x is real
The return value has the same type and kind as x.
Descrição#
bessel_jn( n, x ) computes the Bessel function of the first kind of order n of x.
bessel_jn(n1, n2, x) returns an array with the Bessel function|Bessel functions of the first kind of the orders n1 to n2.
Opções#
- n
a non-negative scalar integer..
- n1
a non-negative scalar integer.
- n2
a non-negative scalar integer.
- x
Shall be a scalar for bessel_jn(n,x) or an array For bessel_jn(n1, n2, x).
Resultado#
The result value of BESSEL_JN (N, X) is a processor-dependent approximation to the Bessel function of the first kind and order N of X.
The result of BESSEL_JN (N1, N2, X) is a rank-one array with extent MAX (N2-N1+1, 0). Element i of the result value of BESSEL_JN (N1, N2, X) is a processor-dependent approximation to the Bessel function of the first kind and order N1+i-1 of X.
Exemplos#
Exemplo de programa:
program demo_bessel_jn
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
real(kind=real64) :: x = 1.0_real64
x = bessel_jn(5,x)
write(*,*)x
end program demo_bessel_jn
Resultados:
2.4975773021123450E-004
Padrão#
Fortran 2008
Veja Também#
bessel_j0(3), bessel_j1(3), bessel_y0(3), bessel_y1(3), bessel_yn(3)
fortran-lang intrinsic descriptions
bessel_y0#
Nome#
bessel_y0(3) - [MATHEMATICS] Bessel function of the second kind of order 0
Synopsis#
result = bessel_y0(x)
elemental real(kind=KIND) function bessel_y0(x)
real(kind=KIND),intent(in) :: x
Characteristics#
KIND may be any supported real KIND.
the result characteristics (type, kind) are the same as x
Descrição#
bessel_y0(3) computes the Bessel function of the second kind of order 0 of x.
Opções#
- x
The type shall be real. Its value shall be greater than zero.
Resultado#
The return value is of type real. It has the same kind as x.
Exemplos#
Exemplo de programa:
program demo_bessel_y0
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
real(kind=real64) :: x = 0.0_real64
x = bessel_y0(x)
write(*,*)x
end program demo_bessel_y0
Resultados:
-Infinity
Padrão#
Fortran 2008
Veja Também#
bessel_j0(3), bessel_j1(3), bessel_jn(3), bessel_y1(3), bessel_yn(3)
fortran-lang intrinsic descriptions
bessel_y1#
Nome#
bessel_y1(3) - [MATHEMATICS] Bessel function of the second kind of order 1
Synopsis#
result = bessel_y1(x)
elemental real(kind=KIND) function bessel_y1(x)
real(kind=KIND),intent(in) :: x
Characteristics#
KIND may be any supported real KIND.
the characteristics (type, kind) of the result are the same as x
Descrição#
bessel_y1(3) computes the Bessel function of the second kind of order 1 of x.
Opções#
- x
The type shall be real. Its value shall be greater than zero.
Resultado#
The return value is real. It has the same kind as x.
Exemplos#
Exemplo de programa:
program demo_bessel_y1
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
real(kind=real64) :: x = 1.0_real64
write(*,*)x, bessel_y1(x)
end program demo_bessel_y1
Resultados:
> 1.00000000000000 -0.781212821300289
Padrão#
Fortran 2008
Veja Também#
bessel_j0(3), bessel_j1(3), bessel_jn(3), bessel_y0(3), bessel_yn(3)
fortran-lang intrinsic descriptions
bessel_yn#
Nome#
bessel_yn(3) - [MATHEMATICS] Bessel function of the second kind
Synopsis#
result = bessel_yn(n, x)
elemental real(kind=KIND) function bessel_yn(n,x)
integer(kind=**),intent(in) :: n
real(kind=KIND),intent(in) :: x
Characteristics#
n is integer
x is real
The return value has the same type and kind as x.
result = bessel_yn(n1, n2, x)
real(kind=KIND) function bessel_yn(n1, n2, ,x)
integer(kind=**),intent(in) :: n1
integer(kind=**),intent(in) :: n2
real(kind=KIND),intent(in) :: x
n1 is integer
n2 is integer
x is real
The return value has the same type and kind as x.
Descrição#
bessel_yn(n, x) computes the Bessel function of the second kind of order n of x.
bessel_yn(n1, n2, x) returns an array with the Bessel function|Bessel functions of the first kind of the orders n1 to n2.
Opções#
- n
Shall be a scalar or an array of type integer and non-negative.
- n1
Shall be a non-negative scalar of type integer and non-negative.
- n2
Shall be a non-negative scalar of type integer and non-negative.
- x
A real non-negative value. Note bessel_yn(n1, n2, x) is not elemental, in which case it must be a scalar.
Resultado#
The result value of BESSEL_YN (N, X) is a processor-dependent approximation to the Bessel function of the second kind and order N of X.
The result of BESSEL_YN (N1, N2, X) is a rank-one array with extent MAX (N2-N1+1, 0). Element i of the result value of BESSEL_YN (N1, N2, X) is a processor-dependent approximation to the Bessel function of the second kind and order N1+i-1 of X.
Exemplos#
Exemplo de programa:
program demo_bessel_yn
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
real(kind=real64) :: x = 1.0_real64
write(*,*) x,bessel_yn(5,x)
end program demo_bessel_yn
Resultados:
1.0000000000000000 -260.40586662581222
Padrão#
Fortran 2008
Veja Também#
bessel_j0(3), bessel_j1(3), bessel_jn(3), bessel_y0(3), bessel_y1(3)
fortran-lang intrinsic descriptions
erf#
Nome#
erf(3) - [MATHEMATICS] Error function
Synopsis#
result = erf(x)
elemental real(kind=KIND) function erf(x)
real(kind=KIND),intent(in) :: x
Characteristics#
x is of type real
The result is of the same type and kind as x.
Descrição#
erf(3) computes the error function of x, defined as
Opções#
- x
O tipo deve ser real.
Resultado#
The return value is of type real, of the same kind as x and lies in the range -1 <= erf(x) <= 1 .
Exemplos#
Exemplo de programa:
program demo_erf
use, intrinsic :: iso_fortran_env, only : real_kinds, &
& real32, real64, real128
implicit none
real(kind=real64) :: x = 0.17_real64
write(*,*)x, erf(x)
end program demo_erf
Resultados:
0.17000000000000001 0.18999246120180879
Padrão#
Fortran 2008
See also#
Recursos#
fortran-lang intrinsic descriptions
erfc#
Nome#
erfc(3) - [MATHEMATICS] Complementary error function
Synopsis#
result = erfc(x)
elemental real(kind=KIND) function erfc(x)
real(kind=KIND),intent(in) :: x
Characteristics#
x is of type real and any valid kind
KIND is any value valid for type real
the result has the same characteristics as x
Descrição#
erfc(3) computes the complementary error function of x. Simply put this is equivalent to 1 - erf(x), but erfc is provided because of the extreme loss of relative accuracy if erf(x) is called for large x and the result is subtracted from 1.
erfc(x) is defined as
Opções#
- x
O tipo deve ser real.
Resultado#
The return value is of type real and of the same kind as x. It lies in the range
0 \<= **erfc**(x) \<= 2.
and is a processor-dependent approximation to the complementary error function of x ( **1-erf(x) ).
Exemplos#
Exemplo de programa:
program demo_erfc
use, intrinsic :: iso_fortran_env, only : &
& real_kinds, real32, real64, real128
implicit none
real(kind=real64) :: x = 0.17_real64
write(*,'(*(g0))')'X=',x, ' ERFC(X)=',erfc(x)
write(*,'(*(g0))')'equivalently 1-ERF(X)=',1-erf(x)
end program demo_erfc
Resultados:
> X=.1700000000000000 ERFC(X)=.8100075387981912
> equivalently 1-ERF(X)=.8100075387981912
Padrão#
Fortran 2008
See also#
Recursos#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
erfc_scaled#
Nome#
erfc_scaled(3) - [MATHEMATICS] Scaled complementary error function
Synopsis#
result = erfc_scaled(x)
elemental real(kind=KIND) function erfc_scaled(x)
real(kind=KIND),intent(in) :: x
Characteristics#
x is of type real of any valid kind
KIND is any kind valid for a real type
the result has the same characteristics as x
Descrição#
erfc_scaled(3) computes the exponentially-scaled complementary error function of x:
erfc_scaled(x)=exp(x*x)erfc(x)
NOTE1#
The complementary error function is asymptotic to exp(-X2)/(X/PI). As such it underflows at approximately X >= 9 when using ISO/IEC/IEEE 60559:2011 single precision arithmetic. The exponentially-scaled complementary error function is asymptotic to 1/(X PI). As such it does not underflow until X > HUGE (X)/PI.
Opções#
x the value to apply the erfc function to
Resultado#
The approximation to the exponentially-scaled complementary error function of x
Exemplos#
Exemplo de programa:
program demo_erfc_scaled
implicit none
real(kind(0.0d0)) :: x = 0.17d0
x = erfc_scaled(x)
print *, x
end program demo_erfc_scaled
Resultados:
> 0.833758302149981
Padrão#
Fortran 2008
See also#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost
gamma#
Nome#
gamma(3) - [MATHEMATICS] Gamma function, which yields factorials for positive whole numbers
Synopsis#
result = gamma(x)
elemental real(kind=KIND) function gamma( x)
type(real,kind=KIND),intent(in) :: x
Characteristics#
x is a real value
returns a real value with the kind as x.
Descrição#
gamma(x) computes Gamma of x. For positive whole number values of n the Gamma function can be used to calculate factorials, as (n-1)! == gamma(real(n)). That is
n! == gamma(real(n+1))
Opções#
- x
Shall be of type real and neither zero nor a negative integer.
Resultado#
The return value is of type real of the same kind as x. The result has a value equal to a processor-dependent approximation to the gamma function of x.
Exemplos#
Exemplo de programa:
program demo_gamma
use, intrinsic :: iso_fortran_env, only : wp=>real64
implicit none
real :: x, xa(4)
integer :: i
x = gamma(1.0)
write(*,*)'gamma(1.0)=',x
! elemental
xa=gamma([1.0,2.0,3.0,4.0])
write(*,*)xa
write(*,*)
! gamma(3) is related to the factorial function
do i=1,20
! check value is not too big for default integer type
if(factorial(i).gt.huge(0))then
write(*,*)i,factorial(i)
else
write(*,*)i,factorial(i),int(factorial(i))
endif
enddo
! more factorials
FAC: block
integer,parameter :: n(*)=[0,1,5,11,170]
integer :: j
do j=1,size(n)
write(*,'(*(g0,1x))')'factorial of', n(j),' is ', &
& product([(real(i,kind=wp),i=1,n(j))]), &
& gamma(real(n(j)+1,kind=wp))
enddo
endblock FAC
contains
function factorial(i) result(f)
integer,parameter :: dp=kind(0d0)
integer,intent(in) :: i
real :: f
if(i.le.0)then
write(*,'(*(g0))')'<ERROR> gamma(3) function value ',i,' <= 0'
stop '<STOP> bad value in gamma function'
endif
f=gamma(real(i+1))
end function factorial
end program demo_gamma
Resultados:
gamma(1.0)= 1.000000
1.000000 1.000000 2.000000 6.000000
1 1.000000 1
2 2.000000 2
3 6.000000 6
4 24.00000 24
5 120.0000 120
6 720.0000 720
7 5040.000 5040
8 40320.00 40320
9 362880.0 362880
10 3628800. 3628800
11 3.9916800E+07 39916800
12 4.7900160E+08 479001600
13 6.2270208E+09
14 8.7178289E+10
15 1.3076744E+12
16 2.0922791E+13
17 3.5568741E+14
18 6.4023735E+15
19 1.2164510E+17
20 2.4329020E+18
factorial of 0 is 1.000000000000000 1.000000000000000
factorial of 1 is 1.000000000000000 1.000000000000000
factorial of 5 is 120.0000000000000 120.0000000000000
factorial of 11 is 39916800.00000000 39916800.00000000
factorial of 170 is .7257415615307994E+307 .7257415615307999E+307
Padrão#
Fortran 2008
Veja Também#
Logarithm of the Gamma function: log_gamma(3)
Recursos#
fortran-lang intrinsic descriptions
log_gamma#
Nome#
log_gamma(3) - [MATHEMATICS] Logarithm of the absolute value of the Gamma function
Synopsis#
result = log_gamma(x)
elemental real(kind=KIND) function log_gamma(x)
real(kind=KIND),intent(in) :: x
Characteristics#
x may be any real type
the return value is of same type and kind as x.
Descrição#
log_gamma(3) computes the natural logarithm of the absolute value of the Gamma function.
Opções#
- x
neither negative nor zero value to render the result for.
Resultado#
The result has a value equal to a processor-dependent approximation to the natural logarithm of the absolute value of the gamma function of x.
Exemplos#
Exemplo de programa:
program demo_log_gamma
implicit none
real :: x = 1.0
write(*,*)x,log_gamma(x) ! returns 0.0
write(*,*)x,log_gamma(3.0) ! returns 0.693 (approximately)
end program demo_log_gamma
Resultados:
> 1.000000 0.0000000E+00
> 1.000000 0.6931472
Padrão#
Fortran 2008
Veja Também#
Função gama: gamma(3)
fortran-lang intrinsic descriptions
log_gamma#
Nome#
log_gamma(3) - [MATHEMATICS] Logarithm of the absolute value of the Gamma function
Synopsis#
result = log_gamma(x)
elemental real(kind=KIND) function log_gamma(x)
real(kind=KIND),intent(in) :: x
Characteristics#
x may be any real type
the return value is of same type and kind as x.
Descrição#
log_gamma(3) computes the natural logarithm of the absolute value of the Gamma function.
Opções#
- x
neither negative nor zero value to render the result for.
Resultado#
The result has a value equal to a processor-dependent approximation to the natural logarithm of the absolute value of the gamma function of x.
Exemplos#
Exemplo de programa:
program demo_log_gamma
implicit none
real :: x = 1.0
write(*,*)x,log_gamma(x) ! returns 0.0
write(*,*)x,log_gamma(3.0) ! returns 0.693 (approximately)
end program demo_log_gamma
Resultados:
> 1.000000 0.0000000E+00
> 1.000000 0.6931472
Padrão#
Fortran 2008
Veja Também#
Função gama: gamma(3)
fortran-lang intrinsic descriptions
norm2#
Nome#
norm2(3) - [MATHEMATICS] Euclidean vector norm
Synopsis#
result = norm2(array, [dim])
real(kind=KIND) function norm2(array, dim)
real(kind=KIND),intent(in) :: array(..)
integer(kind=**),intent(in),optional :: dim
Characteristics#
array shall be an array of type real.
dim shall be a scalar of type integer
O resultado é do mesmo tipo de array.
Descrição#
norm2(3) calculates the Euclidean vector norm (L_2 norm or generalized L norm) of array along dimension dim.
Opções#
- array
the array of input values for the L_2 norm computations
- dim
a value in the range from 1 to rank(array).
Resultado#
If dim is absent, a scalar with the square root of the sum of squares of the elements of array is returned.
Otherwise, an array of rank n-1, where n equals the rank of array, and a shape similar to that of array with dimension DIM dropped is returned.
Case (i): The result of NORM2 (X) has a value equal to a
processor-dependent approximation to the generalized
L norm of X, which is the square root of the sum of
the squares of the elements of X. If X has size zero,
the result has the value zero.
Case (ii): The result of NORM2 (X, DIM=DIM) has a value equal
to that of NORM2 (X) if X has rank one. Otherwise,
the resulting array is reduced in rank with dimension
**dim** removed, and each remaining elment is the
result of NORM2(X) for the values along dimension
**dim**.
It is recommended that the processor compute the result without undue overflow or underflow.
Exemplos#
Exemplo de programa:
program demo_norm2
implicit none
integer :: i
real :: x(2,3) = reshape([ &
1, 2, 3, &
4, 5, 6 &
],shape(x),order=[2,1])
write(*,*) 'input in row-column order'
write(*,*) 'x='
write(*,'(4x,3f4.0)')transpose(x)
write(*,*)
write(*,*) 'norm2(x)=',norm2(x)
write(*,*) 'which is equivalent to'
write(*,*) 'sqrt(sum(x**2))=',sqrt(sum(x**2))
write(*,*)
write(*,*) 'for reference the array squared is'
write(*,*) 'x**2='
write(*,'(4x,3f4.0)')transpose(x**2)
write(*,*)
write(*,*) 'norm2(x,dim=1)=',norm2(x,dim=1)
write(*,*) 'norm2(x,dim=2)=',norm2(x,dim=2)
write(*,*) '(sqrt(sum(x(:,i)**2)),i=1,3)=',(sqrt(sum(x(:,i)**2)),i=1,3)
write(*,*) '(sqrt(sum(x(i,:)**2)),i=1,2)=',(sqrt(sum(x(i,:)**2)),i=1,2)
end program demo_norm2
Resultados:
> input in row-column order
> x=
> 1. 2. 3.
> 4. 5. 6.
>
> norm2(x)= 9.539392
> which is equivalent to
> sqrt(sum(x**2))= 9.539392
>
> for reference the array squared is
> x**2=
> 1. 4. 9.
> 16. 25. 36.
>
> norm2(x,dim=1)= 4.123106 5.385165 6.708204
> norm2(x,dim=2)= 3.741657 8.774964
> (sqrt(sum(x(:,i)**2)),i=1,3)= 4.123106 5.385165 6.708204
> (sqrt(sum(x(i,:)**2)),i=1,2)= 3.741657 8.774964
Padrão#
Fortran 2008
Veja Também#
fortran-lang intrinsic descriptions (license: MIT) @urbanjost