diff --git a/fortls/intrinsic.procedures.markdown.json b/fortls/intrinsic.procedures.markdown.json index b6070a13..6a5fe5bf 100644 --- a/fortls/intrinsic.procedures.markdown.json +++ b/fortls/intrinsic.procedures.markdown.json @@ -2,7 +2,7 @@ "ABS": "## abs\n\n### **Name**\n\n**abs** - \\[NUMERIC\\] Absolute value\n\n### **Synopsis**\n```fortran\n result = abs(a)\n```\n```fortran\n elemental TYPE(kind=KIND) function abs(a)\n\n TYPE(kind=KIND),intent(in) :: a\n```\n### **Characteristics**\n\n- **a** may be any _real_, _integer_, or _complex_ value.\n\n- If **a** is _complex_ the returned value will be a _real_ with the\n same kind as **a**.\n\n Otherwise the returned type and kind is the same as for **a**.\n\n### **Description**\n\n **abs** computes the absolute value of numeric argument **a**.\n\n In mathematics, the absolute value or modulus of a real number **x**,\n denoted **|x|**, is the magnitude of **x** without regard to its sign.\n\n The absolute value of a number may be thought of as its distance from\n zero. So for a complex value the absolute value is a real number\n with magnitude **sqrt(x%re\\*\\*2,x%im\\*\\*2)**, as if the real component\n is the x value and the imaginary value is the y value for the point\n \\.\n\n### **Options**\n\n- **a**\n : The value to compute the absolute value of.\n\n### **Result**\n\n If **a** is of type _integer_ or _real_, the value of the result\n is the absolute value **|a|** and of the same type and kind as the\n input argument.\n\n If **a** is _complex_ with value **(x, y)**, the result is a _real_\n equal to a processor-dependent approximation to\n```fortran\n sqrt(x**2 + y**2)\n```\n computed without undue overflow or underflow (that means the\n computation of the result can overflow the allowed magnitude of the\n real value returned, and that very small values can produce underflows\n if they are squared while calculating the returned value, for example).\n\n That is, if you think of non-complex values as being complex values\n on the x-axis and complex values as being x-y points \n the result of **abs** is the (positive) magnitude of the distance\n of the value from the origin.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_abs\nimplicit none\ninteger,parameter :: dp=kind(0.0d0)\n\ninteger :: i = -1\nreal :: x = -1.0\ncomplex :: z = (-3.0,-4.0)\ndoubleprecision :: rr = -45.78_dp\n\ncharacter(len=*),parameter :: &\n ! some formats\n frmt = '(1x,a15,1x,\" In: \",g0, T51,\" Out: \",g0)', &\n frmtc = '(1x,a15,1x,\" In: (\",g0,\",\",g0,\")\",T51,\" Out: \",g0)', &\n g = '(*(g0,1x))'\n\n ! basic usage\n ! any integer, real, or complex type\n write(*, frmt) 'integer ', i, abs(i)\n write(*, frmt) 'real ', x, abs(x)\n write(*, frmt) 'doubleprecision ', rr, abs(rr)\n write(*, frmtc) 'complex ', z, abs(z)\n\n ! You can take the absolute value of any value whose positive value\n ! is representable with the same type and kind.\n write(*, *) 'abs range test : ', abs(huge(0)), abs(-huge(0))\n write(*, *) 'abs range test : ', abs(huge(0.0)), abs(-huge(0.0))\n write(*, *) 'abs range test : ', abs(tiny(0.0)), abs(-tiny(0.0))\n ! A dusty corner is that abs(-huge(0)-1) of an integer would be\n ! a representable negative value on most machines but result in a\n ! positive value out of range.\n\n ! elemental\n write(*, g) ' abs is elemental:', abs([20, 0, -1, -3, 100])\n\n ! COMPLEX input produces REAL output\n write(*, g)' complex input produces real output', &\n & abs(cmplx(30.0_dp,40.0_dp,kind=dp))\n ! dusty corner: \"kind=dp\" is required or the value returned by\n ! CMPLX() is a default real instead of double precision\n\n ! the returned value for complex input can be thought of as the\n ! distance from the origin <0,0>\n write(*, g) ' distance of (', z, ') from zero is', abs( z )\n write(*, g) ' so beware of overflow with complex values'\n !write(*, g) abs(cmplx( huge(0.0), huge(0.0) ))\n write(*, g) ' because the biggest default real is',huge(0.0)\n\nend program demo_abs\n```\nResults:\n```text\n integer In: -1 Out: 1\n real In: -1.000000 Out: 1.000000\n doubleprecision In: -45.78000000000000 Out: 45.78000000000000\n complex In: (-3.000000,-4.000000) Out: 5.000000\n abs range test : 2147483647 2147483647\n abs range test : 3.4028235E+38 3.4028235E+38\n abs range test : 1.1754944E-38 1.1754944E-38\n abs is elemental: 20 0 1 3 100\n complex input produces real output 50.00000000000000\n distance of ( -3.000000 -4.000000 ) from zero is 5.000000\n so beware of overflow with complex values\n Inf\n because the biggest default real is .3402823E+39\n```\n### **Standard**\n\n FORTRAN 77\n\n### **See Also**\n\n[**sign**(3)](#sign)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ACHAR": "## achar\n\n### **Name**\n\n**achar** - \\[CHARACTER:CONVERSION\\] Returns a character in a specified position in the ASCII collating sequence\n\n### **Synopsis**\n```fortran\n result = achar(i [,kind])\n```\n```fortran\n elemental character(len=1,kind=KIND) function achar(i,KIND)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- a kind designated as ** may be any supported kind for the type\n\n- The _character_ kind returned is the value of **kind** if present.\n otherwise, a single default _character_ is returned.\n\n### **Description**\n\n **achar** returns the character located at position **i** (commonly\n called the _ADE_ or ASCII Decimal Equivalent) in the ASCII collating\n sequence.\n\n The **achar** function is often used for generating in-band escape\n sequences to control terminal attributes, as it makes it easy to print\n unprintable characters such as escape and tab. For example:\n```fortran\n write(*,'(*(a))')achar(27),'[2J'\n```\n will clear the screen on an ANSI-compatible terminal display,\n\n### **Note**\n\nThe ADEs (ASCII Decimal Equivalents) for ASCII are\n```text\n*-------*-------*-------*-------*-------*-------*-------*-------*\n| 00 nul| 01 soh| 02 stx| 03 etx| 04 eot| 05 enq| 06 ack| 07 bel|\n| 08 bs | 09 ht | 10 nl | 11 vt | 12 np | 13 cr | 14 so | 15 si |\n| 16 dle| 17 dc1| 18 dc2| 19 dc3| 20 dc4| 21 nak| 22 syn| 23 etb|\n| 24 can| 25 em | 26 sub| 27 esc| 28 fs | 29 gs | 30 rs | 31 us |\n| 32 sp | 33 ! | 34 \" | 35 # | 36 $ | 37 % | 38 & | 39 ' |\n| 40 ( | 41 ) | 42 * | 43 + | 44 , | 45 - | 46 . | 47 / |\n| 48 0 | 49 1 | 50 2 | 51 3 | 52 4 | 53 5 | 54 6 | 55 7 |\n| 56 8 | 57 9 | 58 : | 59 ; | 60 < | 61 = | 62 > | 63 ? |\n| 64 @ | 65 A | 66 B | 67 C | 68 D | 69 E | 70 F | 71 G |\n| 72 H | 73 I | 74 J | 75 K | 76 L | 77 M | 78 N | 79 O |\n| 80 P | 81 Q | 82 R | 83 S | 84 T | 85 U | 86 V | 87 W |\n| 88 X | 89 Y | 90 Z | 91 [ | 92 \\ | 93 ] | 94 ^ | 95 _ |\n| 96 ` | 97 a | 98 b | 99 c |100 d |101 e |102 f |103 g |\n|104 h |105 i |106 j |107 k |108 l |109 m |110 n |111 o |\n|112 p |113 q |114 r |115 s |116 t |117 u |118 v |119 w |\n|120 x |121 y |122 z |123 { |124 | |125 } |126 ~ |127 del|\n*-------*-------*-------*-------*-------*-------*-------*-------*\n```\n### **Options**\n\n- **i**\n : the _integer_ value to convert to an ASCII character, in the range\n 0 to 127.\n : **achar** shall have the value C for any character\n C capable of representation as a default character.\n\n- **kind**\n : a _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n Assuming **i** has a value in the range 0 <= I <= 127, the result is the\n character in position **i** of the ASCII collating sequence, provided\n the processor is capable of representing that character in the character\n kind of the result; otherwise, the result is processor dependent.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_achar\nuse,intrinsic::iso_fortran_env,only:int8,int16,int32,int64\nimplicit none\ninteger :: i\n i=65\n write(*,'(\"decimal =\",i0)')i\n write(*,'(\"character =\",a1)')achar(i)\n write(*,'(\"binary =\",b0)')achar(i)\n write(*,'(\"octal =\",o0)')achar(i)\n write(*,'(\"hexadecimal =\",z0)')achar(i)\n\n write(*,'(8(i3,1x,a,1x),/)')(i,achar(i), i=32,126)\n\n write(*,'(a)')upper('Mixed Case')\ncontains\n! a classic use of achar(3) is to convert the case of a string\n\npure elemental function upper(str) result (string)\n!\n!$@(#) upper(3f): function to return a trimmed uppercase-only string\n!\n! input string to convert to all uppercase\ncharacter(*), intent(in) :: str\n! output string that contains no miniscule letters\ncharacter(len(str)) :: string\ninteger :: i, iend\ninteger,parameter :: toupper = iachar('A')-iachar('a')\n iend=len_trim(str)\n ! initialize output string to trimmed input string\n string = str(:iend)\n ! process each letter in the string\n do concurrent (i = 1:iend)\n select case (str(i:i))\n ! located miniscule letter\n case ('a':'z')\n ! change miniscule to majuscule letter\n string(i:i) = achar(iachar(str(i:i))+toupper)\n end select\n enddo\nend function upper\nend program demo_achar\n```\nResults:\n```\n decimal =65\n character =A\n binary =1000001\n octal =101\n hexadecimal =41\n 32 33 ! 34 \" 35 # 36 $ 37 % 38 & 39 '\n\n 40 ( 41 ) 42 * 43 + 44 , 45 - 46 . 47 /\n\n 48 0 49 1 50 2 51 3 52 4 53 5 54 6 55 7\n\n 56 8 57 9 58 : 59 ; 60 < 61 = 62 > 63 ?\n\n 64 @ 65 A 66 B 67 C 68 D 69 E 70 F 71 G\n\n 72 H 73 I 74 J 75 K 76 L 77 M 78 N 79 O\n\n 80 P 81 Q 82 R 83 S 84 T 85 U 86 V 87 W\n\n 88 X 89 Y 90 Z 91 [ 92 \\ 93 ] 94 ^ 95 _\n\n 96 ` 97 a 98 b 99 c 100 d 101 e 102 f 103 g\n\n 104 h 105 i 106 j 107 k 108 l 109 m 110 n 111 o\n\n 112 p 113 q 114 r 115 s 116 t 117 u 118 v 119 w\n\n 120 x 121 y 122 z 123 { 124 | 125 } 126 ~\n MIXED CASE\n```\n### **Standard**\n\nFORTRAN 77. KIND argument added Fortran 2003\n\n### **See Also**\n\n[**char**(3)](#char),\n[**iachar**(3)](#iachar),\n[**ichar**(3)](#ichar)\n\n### **Resources**\n\n- [ANSI escape sequences](https://en.wikipedia.org/wiki/ANSI_escape_code)\n- [M_attr module](https://github.com/urbanjost/M_attr) for controlling ANSI-compatible terminals\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ACOS": "## acos\n\n### **Name**\n\n**acos** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arccosine (inverse cosine) function\n\n### **Synopsis**\n```fortran\n result = acos(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function acos(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_\n - **KIND** may be any kind supported by the associated type.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**acos** computes the arccosine of **x** (inverse of **cos(x)**).\n\n### **Options**\n\n- **x**\n : The value to compute the arctangent of.\n : If the type is _real_, the value must satisfy |**x**| <= 1.\n\n### **Result**\n\nThe return value is of the same type and kind as **x**. The _real_ part of\nthe result is in radians and lies in the range **0 \\<= acos(x%re) \\<= PI** .\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_acos\nuse, intrinsic :: iso_fortran_env, only : real_kinds,real32,real64,real128\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))'\nreal(kind=real64) :: x , d2r\n\n ! basics\n x = 0.866_real64\n print all,'acos(',x,') is ', acos(x)\n\n ! acos(-1) should be PI\n print all,'for reference &\n &PI ~= 3.14159265358979323846264338327950288419716939937510'\n write(*,*) acos(-1.0_real64)\n d2r=acos(-1.0_real64)/180.0_real64\n print all,'90 degrees is ', d2r*90.0_real64, ' radians'\n ! elemental\n print all,'elemental',acos([-1.0,-0.5,0.0,0.50,1.0])\n ! complex\n print *,'complex',acos( (-1.0, 0.0) )\n print *,'complex',acos( (-1.0, -1.0) )\n print *,'complex',acos( ( 0.0, -0.0) )\n print *,'complex',acos( ( 1.0, 0.0) )\n\nend program demo_acos\n```\nResults:\n```text\n acos( 0.86599999999999999 ) is 0.52364958093182890\n for reference PI ~= 3.14159265358979323846264338327950288419716939937510\n 3.1415926535897931\n 90 degrees is 1.5707963267948966 radians\n elemental 3.14159274 2.09439516 1.57079637 1.04719758 0.00000000\n complex (3.14159274,-0.00000000)\n complex (2.23703575,1.06127501)\n complex (1.57079637,0.00000000)\n complex (0.00000000,-0.00000000)\n```\n### **Standard**\n\nFORTRAN 77 ; for a _complex_ argument - Fortran 2008\n\n### **See Also**\nInverse function: [**cos**(3)](cos)\n\n### **Resources**\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "ACOSH": "## acosh\n\n### **Name**\n\n**acosh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Inverse hyperbolic cosine function\n\n### **Synopsis**\n```fortran\n result = acosh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function acosh(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_\n - **KIND** may be any kind supported by the associated type.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**acosh** computes the inverse hyperbolic cosine of **x** in radians.\n\n### **Options**\n\n- **x**\n : The value to compute the hyperbolic cosine of\n\n### **Result**\n\nThe result has a value equal to a processor-dependent approximation to\nthe inverse hyperbolic cosine function of X.\n\nIf **x** is _complex_, the imaginary part of the result is in radians\nand lies between\n```fortran\n 0 <= aimag(acosh(x)) <= PI\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_acosh\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=dp), dimension(3) :: x = [ 1.0d0, 2.0d0, 3.0d0 ]\n write (*,*) acosh(x)\nend program demo_acosh\n```\nResults:\n```text\n 0.000000000000000E+000 1.31695789692482 1.76274717403909\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\nInverse function: [**cosh**(3)](#cosh)\n\n### **Resources**\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "ACOSH": "## acosh\n\n### **Name**\n\n**acosh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Inverse hyperbolic cosine function\n\n### **Synopsis**\n```fortran\n result = acosh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function acosh(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_\n - **KIND** may be any kind supported by the associated type.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**acosh** computes the inverse hyperbolic cosine of **x** in radians.\n\n### **Options**\n\n- **x**\n : The value to compute the hyperbolic cosine of. A real value should \n be \\>= 1 or the result with be a Nan.\n\n### **Result**\n\nThe result has a value equal to a processor-dependent approximation to\nthe inverse hyperbolic cosine function of X.\n\nIf **x** is _complex_, the imaginary part of the result is in radians\nand lies between\n```fortran\n 0 <= aimag(acosh(x)) <= PI\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_acosh\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=dp), dimension(3) :: x = [ 1.0d0, 2.0d0, 3.0d0 ]\n if(any(x).lt.1)then\n write (*,*) ' warning: values < 1 are present'\n endif\n write (*,*) acosh(x)\nend program demo_acosh\n```\nResults:\n```text\n 0.000000000000000E+000 1.31695789692482 1.76274717403909\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\nInverse function: [**cosh**(3)](#cosh)\n\n### **Resources**\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ADJUSTL": "## adjustl\n\n### **Name**\n\n**adjustl** - \\[CHARACTER:WHITESPACE\\] Left-justified a string\n\n### **Synopsis**\n```fortran\n result = adjustl(string)\n```\n```fortran\n elemental character(len=len(string),kind=KIND) function adjustl(string)\n\n character(len=*,kind=KIND),intent(in) :: string\n```\n### **Characteristics**\n - **string** is a _character_ variable of any supported kind\n - The return value is a _character_ variable of the same kind\n and length as **string**\n\n### **Description**\n\n **adjustl** will left-justify a string by removing leading\n spaces. Spaces are inserted at the end of the string as needed.\n\n### **Options**\n\n- **string**\n : the string to left-justify\n\n### **Result**\n\n A copy of **string** where leading spaces are removed and the same\n number of spaces are inserted on the end of **string**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_adjustl\nimplicit none\ncharacter(len=20) :: str = ' sample string'\ncharacter(len=:),allocatable :: astr\ninteger :: length\n\n ! basic use\n write(*,'(a,\"[\",a,\"]\")') 'original: ',str\n str=adjustl(str)\n write(*,'(a,\"[\",a,\"]\")') 'adjusted: ',str\n\n ! a fixed-length string can be printed\n ! trimmed using trim(3f) or len_trim(3f)\n write(*,'(a,\"[\",a,\"]\")') 'trimmed: ',trim(str)\n length=len_trim(str)\n write(*,'(a,\"[\",a,\"]\")') 'substring:',str(:length)\n\n ! note an allocatable string stays the same length too\n ! and is not trimmed by just an adjustl(3f) call.\n astr=' allocatable string '\n write(*,'(a,\"[\",a,\"]\")') 'original:',astr\n astr = adjustl(astr)\n write(*,'(a,\"[\",a,\"]\")') 'adjusted:',astr\n ! trim(3f) can be used to change the length\n astr = trim(astr)\n write(*,'(a,\"[\",a,\"]\")') 'trimmed: ',astr\n\nend program demo_adjustl\n```\nResults:\n```text\n original: [ sample string ]\n adjusted: [sample string ]\n trimmed: [sample string]\n substring:[sample string]\n original:[ allocatable string ]\n adjusted:[allocatable string ]\n trimmed: [allocatable string]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**adjustr**(3)](#adjustr),\n[**trim**(3)](#trim)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ADJUSTR": "## adjustr\n\n### **Name**\n\n**adjustr** - \\[CHARACTER:WHITESPACE\\] Right-justify a string\n\n### **Synopsis**\n```fortran\n result = adjustr(string)\n```\n```fortran\n elemental character(len=len(string),kind=KIND) function adjustr(string)\n\n character(len=*,kind=KIND),intent(in) :: string\n```\n### **Characteristics**\n\n- **string** is a _character_ variable\n- The return value is a _character_ variable of the same kind and\n length as **string**\n\n### **Description**\n\n**adjustr** right-justifies a string by removing trailing spaces. Spaces\nare inserted at the start of the string as needed to retain the original\nlength.\n\n### **Options**\n\n- **string**\n : the string to right-justify\n\n### **Result**\n\nTrailing spaces are removed and the same number of spaces are inserted\nat the start of **string**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_adjustr\nimplicit none\ncharacter(len=20) :: str\n ! print a short number line\n write(*,'(a)')repeat('1234567890',2)\n\n ! basic usage\n str = ' sample string '\n write(*,'(a)') str\n str = adjustr(str)\n write(*,'(a)') str\n\n !\n ! elemental\n !\n write(*,'(a)')repeat('1234567890',5)\n write(*,'(a)')adjustr([character(len=50) :: &\n ' first ', &\n ' second ', &\n ' third ' ])\n write(*,'(a)')repeat('1234567890',5)\n\nend program demo_adjustr\n```\nResults:\n```text\n 12345678901234567890\n sample string\n sample string\n 12345678901234567890123456789012345678901234567890\n first\n second\n third\n 12345678901234567890123456789012345678901234567890\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**adjustl**(3)](#adjustl),\n[**trim**(3)](#trim)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "AIMAG": "## aimag\n\n### **Name**\n\n**aimag** - \\[TYPE:NUMERIC\\] Imaginary part of complex number\n\n### **Synopsis**\n```fortran\n result = aimag(z)\n```\n```fortran\n elemental complex(kind=KIND) function aimag(z)\n\n complex(kind=KIND),intent(in) :: z\n```\n### **Characteristics**\n\n- The type of the argument **z** shall be _complex_ and any supported\n _complex_ kind\n\n- The return value is of type _real_ with the kind type parameter of\n the argument.\n\n### **Description**\n\n **aimag** yields the imaginary part of the complex argument **z**.\n\n This is similar to the modern complex-part-designator **%IM** which also\n designates the imaginary part of a value, accept a designator can appear\n on the left-hand side of an assignment as well, as in **val%im=10.0**.\n\n### **Options**\n\n- **z**\n : The _complex_ value to extract the imaginary component of.\n\n### **Result**\n\n The return value is a _real_ value with the magnitude and sign of the\n imaginary component of the argument **z**.\n\n That is, If **z** has the value **(x,y)**, the result has the value\n **y**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_aimag\nuse, intrinsic :: iso_fortran_env, only : real_kinds, &\n & real32, real64, real128\nimplicit none\ncharacter(len=*),parameter :: g='(*(1x,g0))'\ncomplex :: z4\ncomplex(kind=real64) :: z8\n ! basics\n z4 = cmplx(1.e0, 2.e0)\n print *, 'value=',z4\n print g, 'imaginary part=',aimag(z4),'or', z4%im\n\n ! other kinds other than the default may be supported\n z8 = cmplx(3.e0_real64, 4.e0_real64,kind=real64)\n print *, 'value=',z8\n print g, 'imaginary part=',aimag(z8),'or', z8%im\n\n ! an elemental function can be passed an array\n print *\n print *, [z4,z4/2.0,z4+z4,z4**3]\n print *\n print *, aimag([z4,z4/2.0,z4+z4,z4**3])\n\nend program demo_aimag\n```\nResults:\n```text\n value= (1.00000000,2.00000000)\n imaginary part= 2.00000000 or 2.00000000\n value= (3.0000000000000000,4.0000000000000000)\n imaginary part= 4.0000000000000000 or 4.0000000000000000\n\n (1.00000000,2.00000000) (0.500000000,1.00000000) (2.00000000,4.00000000)\n (-11.0000000,-2.00000000)\n\n 2.00000000 1.00000000 4.00000000 -2.00000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n- [**cmplx**(3)](#cmplx) - Complex conversion function\n- [**conjg**(3)](#conjg) - Complex conjugate function\n- [**real**(3)](#real) - Convert to real type\n\nFortran has strong support for _complex_ values, including many intrinsics\nthat take or produce _complex_ values in addition to algebraic and\nlogical expressions:\n\n[**abs**(3)](#abs),\n[**acosh**(3)](#acosh),\n[**acos**(3)](#acos),\n[**asinh**(3)](#asinh),\n[**asin**(3)](#asin),\n[**atan2**(3)](#atan2),\n[**atanh**(3)](#atanh),\n[**atan**(3)](#atan),\n[**cosh**(3)](#cosh),\n[**cos**(3)](#cos),\n[**co_sum**(3)](#co_sum),\n[**dble**(3)](#dble),\n[**dot_product**(3)](#dot_product),\n[**exp**(3)](#exp),\n[**int**(3)](#int),\n[**is_contiguous**(3)](#is_contiguous),\n[**kind**(3)](#kind),\n[**log**(3)](#log),\n[**matmul**(3)](#matmul),\n[**precision**(3)](#precision),\n[**product**(3)](#product),\n[**range**(3)](#range),\n[**rank**(3)](#rank),\n[**sinh**(3)](#sinh),\n[**sin**(3)](#sin),\n[**sqrt**(3)](#sqrt),\n[**storage_size**(3)](#storage_size),\n[**sum**(3)](#sum),\n[**tanh**(3)](#tanh),\n[**tan**(3)](#tan),\n[**unpack**(3)](#unpack),\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -69,7 +69,7 @@ "DIM": "## dim\n\n### **Name**\n\n**dim** - \\[NUMERIC\\] Positive difference of X - Y\n\n### **Synopsis**\n```fortran\n result = dim(x, y)\n```\n```fortran\n elemental TYPE(kind=KIND) function dim(x, y )\n\n TYPE(kind=KIND),intent(in) :: x, y\n```\n### **Characteristics**\n\n- **x** and **y** may be any _real_ or _integer_ but of the same type\n and kind\n- the result is of the same type and kind as the arguments\n\n### **Description**\n\n **dim** returns the maximum of **x - y** and zero.\n That is, it returns the difference **x - y** if the result is positive;\n otherwise it returns zero. It is equivalent to\n```fortran\n max(0,x-y)\n```\n### **Options**\n\n- **x**\n : the subtrahend, ie. the number being subtracted from.\n\n- **y**\n : the minuend; ie. the number being subtracted\n\n### **Result**\n\nReturns the difference **x - y** or zero, whichever is larger.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_dim\nuse, intrinsic :: iso_fortran_env, only : real64\nimplicit none\ninteger :: i\nreal(kind=real64) :: x\n\n ! basic usage\n i = dim(4, 15)\n x = dim(4.321_real64, 1.111_real64)\n print *, i\n print *, x\n\n ! elemental\n print *, dim([1,2,3],2)\n print *, dim([1,2,3],[3,2,1])\n print *, dim(-10,[0,-10,-20])\n\nend program demo_dim\n```\nResults:\n```text\n > 0\n > 3.21000000000000\n > 0 0 1\n > 0 0 2\n > 0 0 10\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[****(3)](#)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "DOT_PRODUCT": "## dot_product\n\n### **Name**\n\n**dot_product** - \\[TRANSFORMATIONAL\\] Dot product of two vectors\n\n### **Synopsis**\n```fortran\n result = dot_product(vector_a, vector_b)\n```\n```fortran\n TYPE(kind=KIND) function dot_product(vector_a, vector_b)\n\n TYPE(kind=KIND),intent(in) :: vector_a(:)\n TYPE(kind=KIND),intent(in) :: vector_b(:)\n```\n### **Characteristics**\n\n - **vector_a**, **vector_b** may be any numeric or logical type array\n of rank one of the same size\n - the two vectors need not be of the same kind, but both must be logical\n or numeric for any given call.\n - the result is the same type and kind of the vector that is the higher\n type that the other vector is optionally promoted to if they differ.\n\nThe two vectors may be either numeric or logical and must be arrays\nof rank one and of equal size.\n\n### **Description**\n\n**dot_product** computes the dot product\nmultiplication of two vectors **vector_a** and **vector_b**.\n\n### **Options**\n\n- **vector_a**\n : A rank 1 vector of values\n\n- **vector_b**\n : The type shall be numeric if **vector_a** is of numeric type\n or _logical_ if vector_a is of type _logical_. vector_b shall be a\n rank-one array of the same size as **vector_a**.\n\n### **Result**\n\nIf the arguments are numeric, the return value is a scalar of numeric\ntype. If the arguments are _logical_, the\nreturn value is _.true._ or _.false._.\n\nIf the vectors are _integer_ or _real_, the result is\n```fortran\n sum(vector_a*vector_b)\n```\nIf the vectors are _complex_, the result is\n```fortran\n sum(conjg(vector_a)*vector_b)**\n```\nIf the vectors are _logical_, the result is\n```fortran\n any(vector_a .and. vector_b)\n```\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_dot_prod\nimplicit none\n integer, dimension(3) :: a, b\n a = [ 1, 2, 3 ]\n b = [ 4, 5, 6 ]\n print '(3i3)', a\n print *\n print '(3i3)', b\n print *\n print *, dot_product(a,b)\nend program demo_dot_prod\n```\nResults:\n```text\n > 1 2 3\n >\n > 4 5 6\n >\n > 32\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**sum**(3)](#sum),\n[**conjg**(3)](#conjg),\n[**any**(3)](#any)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "DPROD": "## dprod\n\n### **Name**\n\n**dprod** - \\[NUMERIC\\] Double precision real product\n\n### **Synopsis**\n```fortran\n result = dprod(x,y)\n```\n```fortran\n elemental function dprod(x,y)\n\n real,intent(in) :: x\n real,intent(in) :: y\n doubleprecision :: dprod\n```\n### **Characteristics**\n\n - **x** is a default real.\n - **y** is a default real.\n - the result is a _doubleprecision_ real.\n\n The setting of compiler options specifying the size of a default _real_\n can affect this function.\n\n### **Description**\n\n **dprod** produces a _doubleprecision_ product of default _real_\n values **x** and **y**.\n\n That is, it is expected to convert the arguments to double precision\n before multiplying, which a simple expression **x\\*y** would not be\n required to do. This can be significant in specialized computations\n requiring high precision.\n\n The result has a value equal to a processor-dependent approximation\n to the product of **x** and **y**. Note it is recommended in the\n standard that the processor compute the product in double precision,\n rather than in single precision then converted to double precision;\n but is only a recommendation.\n\n### **Options**\n\n- **x**\n : the multiplier\n\n- **y**\n : the multiplicand\n\n### **Result**\n\nThe returned value of the product should have the same value as\n**dble(x)\\*dble(y)**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_dprod\nimplicit none\ninteger,parameter :: dp=kind(0.0d0)\nreal :: x = 5.2\nreal :: y = 2.3\ndoubleprecision :: xx\nreal(kind=dp) :: dd\n\n print *,'algebraically 5.2 x 2.3 is exactly 11.96'\n print *,'as floating point values results may differ slightly:'\n ! basic usage\n dd = dprod(x,y)\n print *, 'compare dprod(xy)=',dd, &\n & 'to x*y=',x*y, &\n & 'to dble(x)*dble(y)=',dble(x)*dble(y)\n\n print *,'test if an expected result is produced'\n xx=-6.0d0\n write(*,*)DPROD(-3.0, 2.0),xx\n write(*,*)merge('PASSED','FAILED',DPROD(-3.0, 2.0) == xx)\n\n print *,'elemental'\n print *, dprod( [2.3,3.4,4.5], 10.0 )\n print *, dprod( [2.3,3.4,4.5], [9.8,7.6,5.4] )\n\nend program demo_dprod\n```\nResults:\n(this can vary between programming environments):\n```text\n > algebraically 5.2 x 2.3 is exactly 11.96\n > as floating point values results may differ slightly:\n > compare dprod(xy)= 11.9599993133545 to x*y= 11.96000\n > to dble(x)*dble(y)= 11.9599993133545\n > test if an expected result is produced\n > -6.00000000000000 -6.00000000000000\n > PASSED\n > elemental\n > 22.9999995231628 34.0000009536743 45.0000000000000\n > 22.5399999713898 25.8400004005432 24.3000004291534\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**dble**(3)](#dble)\n[**real**(3)](#real)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "DSHIFTL": "## dshiftl\n\n### **Name**\n\n**dshiftl** - \\[BIT:COPY\\] Combined left shift of the bits of two integers\n\n### **Synopsis**\n```fortran\n result = dshiftl(i, j, shift)\n```\n```fortran\n elemental integer(kind=KIND) function dshiftl(i, j, shift)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=KIND),intent(in) :: j\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - the kind of **i**, **j**, and the return value are the same. An\n exception is that one of **i** and **j** may be a BOZ literal constant\n (A BOZ literal constant is a binary, octal or hex constant).\n\n - If either I or J is a BOZ-literal-constant (but not both), it is\n first converted as if by the intrinsic function **int**(3) to type\n _integer_ with the kind type parameter of the other.\n\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **dshiftl** combines bits of **i** and **j**. The rightmost **shift**\n bits of the result are the leftmost **shift** bits of **j**, and the\n remaining bits are the rightmost **bitsize(i)-shift** of **i**.\n\n Hence **dshiftl** is designated as a \"combined left shift\", because\n it is like we appended **i** and **j** together, shifted it **shift**\n bits to the left, and then kept the same number of bits as **i** or\n **j** had.\n\n For example, for two 16-bit values if **shift=6**\n```text\n SHIFT=6\n I = 1111111111111111\n J = 0000000000000000\n COMBINED 11111111111111110000000000000000\n DROP LEFT BITS 11111111110000000000000000\n KEEP LEFT 16 1111111111000000\n```\n#### NOTE\n This is equivalent to\n```fortran\n ior( shiftl(i, shift), shiftr(j, bit_size(j) - shift) )\n```\n Also note that using this last representation of the operation is can\n be derived that when both **i** and **j** have the same value as in\n```fortran\n dshiftl(i, i, shift)\n```\n the result has the same value as a circular shift:\n```fortran\n ishftc(i, shift)\n```\n### **Options**\n\n- **i**\n : used to define the left pattern of bits in the combined pattern\n\n- **j**\n : used for the right pattern of bits in the combined pattern\n\n- **shift**\n : shall be nonnegative and less than or equal to the number of bits\n in an _integer_ input value (ie. the bit size of either one that is\n not a BOZ literal constant).\n\n### **Result**\n\n The leftmost **shift** bits of **j** are copied to the rightmost bits\n of the result, and the remaining bits are the rightmost bits of **i**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_dshiftl\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int32) :: i, j\ninteger :: shift\n\n ! basic usage\n write(*,*) dshiftl (1, 2**30, 2) ! int32 values on little-endian => 5\n\n ! print some simple calls as binary to better visual the results\n i=-1\n j=0\n shift=5\n call printit()\n\n ! the leftmost SHIFT bits of J are copied to the rightmost result bits\n j=int(b\"11111000000000000000000000000000\")\n ! and the other bits are the rightmost bits of I\n i=int(b\"00000000000000000000000000000000\")\n call printit()\n\n j=int(b\"11111000000000000000000000000000\")\n i=int(b\"00000111111111111111111111111111\")\n ! result should be all 1s\n call printit()\n\ncontains\nsubroutine printit()\n ! print i,j,shift and then i,j, and the result as binary values\n write(*,'(*(g0))')'I=',i,' J=',j,' SHIFT=',shift\n write(*,'(b32.32)') i,j, dshiftl (i, j, shift)\nend subroutine printit\n\nend program demo_dshiftl\n```\nResults:\n```text\n > I=-1 J=0 SHIFT=5\n > 11111111111111111111111111111111\n > 00000000000000000000000000000000\n > 11111111111111111111111111100000\n > I=0 J=-134217728 SHIFT=5\n > 00000000000000000000000000000000\n > 11111000000000000000000000000000\n > 00000000000000000000000000011111\n > I=134217727 J=-134217728 SHIFT=5\n > 00000111111111111111111111111111\n > 11111000000000000000000000000000\n > 11111111111111111111111111111111\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**dshiftr**(3)](#dshiftr)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "DSHIFTL": "## dshiftl\n\n### **Name**\n\n**dshiftl** - \\[BIT:COPY\\] Combined left shift of the bits of two integers\n\n### **Synopsis**\n```fortran\n result = dshiftl(i, j, shift)\n```\n```fortran\n elemental integer(kind=KIND) function dshiftl(i, j, shift)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=KIND),intent(in) :: j\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - the kind of **i**, **j**, and the return value are the same. An\n exception is that one of **i** and **j** may be a BOZ literal constant\n (A BOZ literal constant is a binary, octal or hex constant).\n\n - If either I or J is a BOZ-literal-constant (but not both), it is\n first converted as if by the intrinsic function **int**(3) to type\n _integer_ with the kind type parameter of the other.\n\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **dshiftl** combines bits of **i** and **j**. The rightmost **shift**\n bits of the result are the leftmost **shift** bits of **j**, and the\n remaining bits are the rightmost **bitsize(i)-shift** of **i**.\n\n Hence **dshiftl** is designated as a \"combined left shift\", because\n it is like we appended **i** and **j** together, shifted it **shift**\n bits to the left, and then kept the same number of bits as **i** or\n **j** had.\n\n For example, for two 16-bit values if **shift=6**\n```text\n SHIFT=6\n I = 1111111111111111\n J = 0000000000000000\n COMBINED 11111111111111110000000000000000\n DROP LEFT BITS 11111111110000000000000000\n KEEP LEFT 16 1111111111000000\n```\n#### NOTE\n This is equivalent to\n```fortran\n ior( shiftl(i, shift), shiftr(j, bit_size(j) - shift) )\n```\n Also note that using this last representation of the operation is can\n be derived that when both **i** and **j** have the same value as in\n```fortran\n dshiftl(i, i, shift)\n```\n the result has the same value as a circular shift:\n```fortran\n ishftc(i, shift)\n```\n### **Options**\n\n- **i**\n : used to define the left pattern of bits in the combined pattern\n\n- **j**\n : used for the right pattern of bits in the combined pattern\n\n- **shift**\n : shall be nonnegative and less than or equal to the number of bits\n in an _integer_ input value (ie. the bit size of either one that is\n not a BOZ literal constant).\n\n### **Result**\n\n The leftmost **shift** bits of **j** are copied to the rightmost bits\n of the result, and the remaining bits are the rightmost bits of **i**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_dshiftl\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int32) :: i, j\ninteger :: shift\n\n ! basic usage\n write(*,*) dshiftl (1, 2**30, 2) ! int32 values on little-endian => 5\n\n ! print some simple calls as binary to better visual the results\n i=-1\n j=0\n shift=5\n call printit()\n\n ! the leftmost SHIFT bits of J are copied to the rightmost result bits\n j=int(b\"11111000000000000000000000000000\")\n ! and the other bits are the rightmost bits of I\n i=int(b\"00000000000000000000000000000000\")\n call printit()\n\n j=int(b\"11111000000000000000000000000000\")\n i=int(b\"00000111111111111111111111111111\")\n ! result should be all 1s\n call printit()\n\ncontains\nsubroutine printit()\n ! print i,j,shift and then i,j, and the result as binary values\n write(*,'(*(g0))')'I=',i,' J=',j,' SHIFT=',shift\n write(*,'(b32.32)') i,j, dshiftl (i, j, shift)\nend subroutine printit\n\nend program demo_dshiftl\n```\nResults:\n```text\n > 5\n > I=-1 J=0 SHIFT=5\n > 11111111111111111111111111111111\n > 00000000000000000000000000000000\n > 11111111111111111111111111100000\n > I=0 J=-134217728 SHIFT=5\n > 00000000000000000000000000000000\n > 11111000000000000000000000000000\n > 00000000000000000000000000011111\n > I=134217727 J=-134217728 SHIFT=5\n > 00000111111111111111111111111111\n > 11111000000000000000000000000000\n > 11111111111111111111111111111111\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**dshiftr**(3)](#dshiftr)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "DSHIFTR": "## dshiftr\n\n### **Name**\n\n**dshiftr** - \\[BIT:COPY\\] Combined right shift of the bits of two integers\n\n### **Synopsis**\n```fortran\n result = dshiftr(i, j, shift)\n```\n```fortran\n elemental integer(kind=KIND) function dshiftr(i, j, shift)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=KIND),intent(in) :: j\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - a kind designated as ** may be any kind value for the _integer_ type\n\n - the kind of **i**, **j**, and the return value are the same. An\n exception is that one of **i** and **j** may be a BOZ literal constant\n (A BOZ literal constant is a binary, octal or hex constant).\n\n - If either I or J is a BOZ-literal-constant, it is first converted\n as if by the intrinsic function **int**(3) to type _integer_ with the\n kind type parameter of the other.\n\n### **Description**\n\n **dshiftr** combines bits of **i** and **j**. The leftmost **shift**\n bits of the result are the rightmost **shift** bits of **i**, and the\n remaining bits are the leftmost bits of **j**.\n\n It may be thought of as appending the bits of **i** and **j**, dropping\n off the **shift** rightmost bits, and then retaining the same number\n of rightmost bits as an input value, hence the name \"combined right\n shift\"...\n\nGiven two 16-bit values labeled alphabetically ...\n```text\n i=ABCDEFGHIJKLMNOP\n j=abcdefghijklmnop\n```\nAppend them together\n```text\n ABCDEFGHIJKLMNOPabcdefghijklmnop\n```\nShift them N=6 bits to the right dropping off bits\n```text\n ABCDEFGHIJKLMNOPabcdefghij\n```\nKeep the 16 right-most bits\n```text\n KLMNOPabcdefghij\n```\n#### NOTE\n\n**dshifr(i,j,shift)** is equivalent to\n```fortran\n ior(shiftl (i, bit_size(i) - shift), shiftr(j, shift) )\n```\nit can also be seen that if **i** and **j** have the same\nvalue\n```fortran\n dshiftr( i, i, shift )\n```\nthis has the same result as a negative circular shift\n```fortran\n ishftc( i, -shift ).\n```\n### **Options**\n\n- **i**\n : left value of the pair of values to be combine-shifted right\n\n- **j**\n : right value of the pair of values to be combine-shifted right\n\n- **shift**\n : the shift value is non-negative and less than or equal to the number\n of bits in an input value as can be computed by **bit_size**(3).\n\n### **Result**\n\nThe result is a combined right shift of **i** and **j** that is the\nsame as the bit patterns of the inputs being combined left to right,\ndropping off **shift** bits on the right and then retaining the same\nnumber of bits as an input value from the rightmost bits.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_dshiftr\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int32) :: i, j\ninteger :: shift\n\n ! basic usage\n write(*,*) dshiftr (1, 2**30, 2)\n\n ! print some calls as binary to better visualize the results\n i=-1\n j=0\n shift=5\n\n ! print values\n write(*,'(*(g0))')'I=',i,' J=',j,' SHIFT=',shift\n write(*,'(b32.32)') i,j, dshiftr (i, j, shift)\n\n ! visualizing a \"combined right shift\" ...\n i=int(b\"00000000000000000000000000011111\")\n j=int(b\"11111111111111111111111111100000\")\n ! appended together ( i//j )\n ! 0000000000000000000000000001111111111111111111111111111111100000\n ! shifted right SHIFT values dropping off shifted values\n ! 00000000000000000000000000011111111111111111111111111111111\n ! keep enough rightmost bits to fill the kind\n ! 11111111111111111111111111111111\n ! so the result should be all 1s bits ...\n\n write(*,'(*(g0))')'I=',i,' J=',j,' SHIFT=',shift\n write(*,'(b32.32)') i,j, dshiftr (i, j, shift)\n\nend program demo_dshiftr\n```\nResults:\n```text\n > 1342177280\n > I=-1 J=0 SHIFT=5\n > 11111111111111111111111111111111\n > 00000000000000000000000000000000\n > 11111000000000000000000000000000\n > I=31 J=-32 SHIFT=5\n > 00000000000000000000000000011111\n > 11111111111111111111111111100000\n > 11111111111111111111111111111111\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**dshiftl**(3)](#dshiftl)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "EOSHIFT": "## eoshift\n\n### **Name**\n\n**eoshift** - \\[TRANSFORMATIONAL\\] End-off shift of elements of an array\n\n### **Synopsis**\n```fortran\n result = eoshift( array, shift [,boundary] [,dim] )\n```\n```fortran\n type(TYPE(kind=KIND)) function eoshift(array,shift,boundary,dim)\n\n type(TYPE(kind=KIND)),intent(in) :: array(..)\n integer(kind=**),intent(in) :: shift(..)\n type(TYPE(kind=KIND)),intent(in) :: boundary(..)\n integer(kind=**),intent(in) :: dim\n```\n### **Characteristics**\n\n - **array** an array of any type\n - **shift** is an integer of any kind. It may be a scalar.\n If the rank of **array** is greater than one, and **dim** is\n specified it is the same shape as **array** reduced by removing\n dimension **dim**.\n - **boundary** May be a scalar of the same type and kind as **array**.\n It must be a scalar when **array** has a rank of one. Otherwise, it\n may be an array of the same shape as **array** reduced by dimension\n **dim**. It may only be absent for certain types, as described below.\n - **dim** is an integer of any kind. It defaults to one.\n - the result has the same type, type parameters, and shape as **array**.\n - a kind designated as ** may be any supported kind for the type\n\n - The result is an array of same type, kind and rank as the **array**\n argument.\n\n### **Description**\n\n **eoshift** performs an end-off shift on elements of **array**\n along the dimension of **dim**.\n\n Elements shifted out one end of each rank one section are dropped.\n\n If **boundary** is present then the corresponding value from\n **boundary** is copied back in the other end, else default values\n are used.\n\n### **Options**\n\n- **array**\n : array of any type whose elements are to be shifted.\n If the rank of **array** is one, then all elements of **array** are\n shifted by **shift** places. If rank is greater than one, then all\n complete rank one sections of **array** along the given dimension\n are shifted.\n\n- **shift**\n : the number of elements to shift. A negative value shifts to the\n right, a positive value to the left of the vector(s) being shifted.\n\n- **boundary**\n : the value to use to fill in the elements vacated by the shift.\n If **boundary** is not present then the following are copied in\n depending on the type of **array**.\n```text\n Array Type | Boundary Value\n -----------------------------------------------------\n Numeric | 0, 0.0, or (0.0, 0.0) of the type and kind of \"array\"\n Logical | .false.\n Character(len)| LEN blanks\n```\n These are the only types for which **boundary** may not be present.\n For these types the kind is converted as neccessary to the kind of\n **array**.\n- **dim**\n : **dim** is in the range of\n```fortran\n 1 <= DIM <= n\n```\n where **\"n\"** is the rank of **array**. If **dim** is omitted it\n is taken to be **1**.\n\n### **Result**\n\n Returns an array of the same characteristics as the input with the\n specified number of elements dropped off along the specified direction\n indicated, backfilling the vacated elements with a value indicated by\n the **boundary** value.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_eoshift\nimplicit none\ninteger, dimension(3,3) :: a\ninteger :: i\n\n a = reshape( [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ], [ 3, 3 ])\n print '(3i3)', (a(i,:),i=1,3)\n\n print *\n\n ! shift it\n a = eoshift(a, SHIFT=[1, 2, 1], BOUNDARY=-5, DIM=2)\n print '(3i3)', (a(i,:),i=1,3)\n\nend program demo_eoshift\n```\nResults:\n\n```text\n > 1 4 7\n > 2 5 8\n > 3 6 9\n >\n > 4 7 -5\n > 8 -5 -5\n > 6 9 -5\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**dshiftr**(3)](#dshiftr),\n[**dshiftl**(3)](#dshiftl)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "EPSILON": "## epsilon\n\n### **Name**\n\n**epsilon** - \\[NUMERIC MODEL\\] Epsilon function\n\n### **Synopsis**\n```fortran\n result = epsilon(x)\n```\n```fortran\n real(kind=kind(x)) function epsilon(x)\n\n real(kind=kind(x),intent(in) :: x(..)\n```\n### **Characteristics**\n\n - **x** shall be of type _real_. It may be a scalar or an array.\n - the result is a scalar of the same type and kind type parameter as **x**.\n\n### **Description**\n\n**epsilon** returns the floating point relative accuracy.\nIt is the nearly negligible number relative to **1**\nsuch that **1+ little_number** is not equal to **1**; or more\nprecisely\n```fortran\n real( 1.0, kind(x)) + epsilon(x) /= real( 1.0, kind(x))\n```\nIt may be thought of as the distance from 1.0 to the next largest\nfloating point number.\n\nOne use of **epsilon** is to select a _delta_ value for algorithms that\nsearch until the calculation is within _delta_ of an estimate.\n\nIf _delta_ is too small the algorithm might never halt, as a computation\nsumming values smaller than the decimal resolution of the data type does\nnot change.\n\n### **Options**\n\n- **x**\n : The type shall be _real_.\n\n### **Result**\n\nThe return value is of the same type as the argument.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_epsilon\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=sp) :: x = 3.143\nreal(kind=dp) :: y = 2.33d0\n\n ! so if x is of type real32, epsilon(x) has the value 2**-23\n print *, epsilon(x)\n ! note just the type and kind of x matter, not the value\n print *, epsilon(huge(x))\n print *, epsilon(tiny(x))\n\n ! the value changes with the kind of the real value though\n print *, epsilon(y)\n\n ! adding and subtracting epsilon(x) changes x\n write(*,*)x == x + epsilon(x)\n write(*,*)x == x - epsilon(x)\n\n ! these next two comparisons will be .true. !\n write(*,*)x == x + epsilon(x) * 0.999999\n write(*,*)x == x - epsilon(x) * 0.999999\n\n ! you can calculate epsilon(1.0d0)\n write(*,*)my_dp_eps()\n\ncontains\n\n function my_dp_eps()\n ! calculate the epsilon value of a machine the hard way\n real(kind=dp) :: t\n real(kind=dp) :: my_dp_eps\n\n ! starting with a value of 1, keep dividing the value\n ! by 2 until no change is detected. Note that with\n ! infinite precision this would be an infinite loop,\n ! but floating point values in Fortran have a defined\n ! and limited precision.\n my_dp_eps = 1.0d0\n SET_ST: do\n my_dp_eps = my_dp_eps/2.0d0\n t = 1.0d0 + my_dp_eps\n if (t <= 1.0d0) exit\n enddo SET_ST\n my_dp_eps = 2.0d0*my_dp_eps\n\n end function my_dp_eps\nend program demo_epsilon\n```\nResults:\n```text\n 1.1920929E-07\n 1.1920929E-07\n 1.1920929E-07\n 2.220446049250313E-016\n F\n F\n T\n T\n 2.220446049250313E-016\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n",