diff --git a/fortls/intrinsic.procedures.markdown.json b/fortls/intrinsic.procedures.markdown.json index 6a5fe5bf..d87d18d9 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. 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", + "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", @@ -15,7 +15,7 @@ "ASINH": "## asinh\n\n### **Name**\n\n**asinh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Inverse hyperbolic sine function\n\n### **Synopsis**\n```fortran\n result = asinh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function asinh(x)\n\n TYPE(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_ or _complex_ type\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 **x**\n\n### **Description**\n\n**asinh** computes the inverse hyperbolic sine of **x**.\n\n### **Options**\n\n- **x**\n : The value to compute the inverse hyperbolic sine of\n\n### **Result**\n\n The result has a value equal to a processor-dependent approximation\n to the inverse hyperbolic sine function of **x**.\n\n If **x** is _complex_, the imaginary part of the result is in radians and lies\nbetween **-PI/2 \\<= aimag(asinh(x)) \\<= PI/2**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_asinh\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=dp), dimension(3) :: x = [ -1.0d0, 0.0d0, 1.0d0 ]\n\n ! elemental\n write (*,*) asinh(x)\n\nend program demo_asinh\n```\nResults:\n```text\n -0.88137358701954305 0.0000000000000000 0.88137358701954305\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nInverse function: [**sinh**(3)](#sinh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ASSOCIATED": "## associated\n\n### **Name**\n\n**associated** - \\[STATE:INQUIRY\\] Association status of a pointer or pointer/target pair\n\n### **Synopsis**\n```fortran\n result = associated(pointer [,target])\n```\n```fortran\n logical function associated(pointer,target)\n\n type(TYPE(kind=KIND)),pointer :: pointer\n type(TYPE(kind=KIND)),pointer,optional :: target\n```\n### **Characteristics**\n\n - **pointer** shall have the _pointer_ attribute and it can be any type\n or may be a procedure pointer\n - **target** shall be a pointer or a target. It must have the\n same type, kind type parameter, and array rank as **pointer**.\n - The association status of neither **pointer** nor **target** shall\n be undefined.\n - the result is a default _logical_ value\n\n### **Description**\n\n **associated** determines the status of the pointer **pointer**\n or if **pointer** is associated with the target **target**.\n\n### **Options**\n\n- **pointer**\n : A pointer to test for association.\n Its pointer association status shall not be undefined.\n\n- **target**\n : A target that is to be tested for occupying the same storage\n units as the pointer **pointer**. That is, it is tested as to whether it\n is pointed to by **pointer**.\n\n### **Result**\n\n**associated**(3f) returns a scalar value of type _logical_.\nThere are several cases:\n\n1. When the optional **target** is not present then **associated(pointer)**\n is _.true._ if **pointer** is associated with a target; otherwise, it\n returns _.false._.\n\n2. If **target** is present and a scalar target, the result is _.true._ if\n **target** is not a zero-sized storage sequence and the target\n associated with **pointer** occupies the same storage units. If **pointer**\n is disassociated, the result is _.false._.\n\n3. If **target** is present and an array target, the result is _.true._ if\n **target** and **pointer** have the same shape, are not zero-sized arrays,\n are arrays whose elements are not zero-sized storage sequences, and\n **target** and **pointer** occupy the same storage units in array element\n order.\n\n As in case 2, the result is _.false._, if **pointer** is disassociated.\n\n4. If **target** is present and an scalar pointer, the result is _.true._ if\n **target** is associated with **pointer**, the target associated with **target**\n are not zero-sized storage sequences and occupy the same storage\n units.\n\n The result is _.false._, if either **target** or **pointer** is disassociated.\n\n5. If **target** is present and an array pointer, the result is _.true._ if\n target associated with **pointer** and the target associated with **target**\n have the same shape, are not zero-sized arrays, are arrays whose\n elements are not zero-sized storage sequences, and **target** and\n **pointer** occupy the same storage units in array element order.\n\n6. If **target** is present and is a procedure, the result is true if and\n only if **pointer** is associated with **target** and, if **target** is an\n internal procedure, they have the same host instance.\n\n7. If **target** is present and is a procedure pointer, the result is true\n if and only if **pointer** and **target** are associated with the same\n procedure and, if the procedure is an internal procedure, they have\n the same host instance.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_associated\nimplicit none\nreal, target :: tgt(2) = [1., 2.]\nreal, pointer :: ptr(:)\n ptr => tgt\n if (associated(ptr) .eqv. .false.) &\n & stop 'POINTER NOT ASSOCIATED'\n if (associated(ptr,tgt) .eqv. .false.) &\n & stop 'POINTER NOT ASSOCIATED TO TARGET'\nend program demo_associated\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**null**(3)](#null)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ATAN": "## atan\n\n### **Name**\n\n**atan** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arctangent AKA inverse tangent function\n\n### **Synopsis**\n```fortran\n result = atan([x) | atan(y, x)\n```\n```fortran\n elemental TYPE(kind=KIND) function atan(y,x)\n\n TYPE(kind=KIND),intent(in) :: x\n TYPE(kind=**),intent(in),optional :: y\n```\n### **Characteristics**\n\n - If **y** is present **x** and **y** must both be _real_.\n Otherwise, **x** may be _complex_.\n - **KIND** can be any kind supported by the associated type.\n - The returned value is of the same type and kind as **x**.\n\n### **Description**\n\n**atan** computes the arctangent of **x**.\n\n### **Options**\n\n- **x**\n : The value to compute the arctangent of.\n if **y** is present, **x** shall be _real_.\n\n- **y**\n : is of the same type and kind as **x**. If **x** is zero, **y**\n must not be zero.\n\n### **Result**\n\nThe returned value is of the same type and kind as **x**. If **y** is\npresent, the result is identical to **atan2(y,x)**. Otherwise, it is the\narc tangent of **x**, where the real part of the result is in radians\nand lies in the range\n**-PI/2 \\<= atan(x) \\<= PI/2**\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atan\nuse, intrinsic :: iso_fortran_env, only : real_kinds, &\n & real32, real64, real128\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))'\nreal(kind=real64),parameter :: &\n Deg_Per_Rad = 57.2957795130823208767981548_real64\nreal(kind=real64) :: x\n x=2.866_real64\n print all, atan(x)\n\n print all, atan( 2.0d0, 2.0d0),atan( 2.0d0, 2.0d0)*Deg_Per_Rad\n print all, atan( 2.0d0,-2.0d0),atan( 2.0d0,-2.0d0)*Deg_Per_Rad\n print all, atan(-2.0d0, 2.0d0),atan(-2.0d0, 2.0d0)*Deg_Per_Rad\n print all, atan(-2.0d0,-2.0d0),atan(-2.0d0,-2.0d0)*Deg_Per_Rad\n\nend program demo_atan\n```\nResults:\n```text\n 1.235085437457879\n .7853981633974483 45.00000000000000\n 2.356194490192345 135.0000000000000\n -.7853981633974483 -45.00000000000000\n -2.356194490192345 -135.0000000000000\n```\n### **Standard**\n\nFORTRAN 77 for a complex argument; and for two\narguments Fortran 2008\n\n### **See Also**\n\n[**atan2**(3)](#atan2), [**tan**(3)](#tan)\n\n### **Resources**\n\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "ATAN2": "## atan2\n\n### **Name**\n\n**atan2** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arctangent (inverse tangent)\nfunction\n\n### **Synopsis**\n```fortran\n result = atan2(y, x)\n```\n```fortran\n elemental real(kind=KIND) function atan2(y, x)\n\n real,kind=KIND) :: atan2\n real,kind=KIND),intent(in) :: y, x\n```\n### **Characteristics**\n\n - **x** and **y** must be reals of the same kind.\n - The return value has the same type and kind as **y** and **x**.\n\n### **Description**\n\n **atan2** computes in radians a processor-dependent approximation of\n the arctangent of the complex number ( **x**, **y** ) or equivalently the\n principal value of the arctangent of the value **y/x** (which determines\n a unique angle).\n\n If **y** has the value zero, **x** shall not have the value zero.\n\n The resulting phase lies in the range -PI <= ATAN2 (Y,X) <= PI and is equal to a\n processor-dependent approximation to a value of arctan(Y/X).\n\n### **Options**\n\n- **y**\n : The imaginary component of the complex value **(x,y)** or the **y**\n component of the point **\\**.\n\n- **x**\n : The real component of the complex value **(x,y)** or the **x**\n component of the point **\\**.\n\n### **Result**\n\nThe value returned is by definition the principal value of the complex\nnumber **(x, y)**, or in other terms, the phase of the phasor x+i*y.\n\nThe principal value is simply what we get when we adjust a radian value\nto lie between **-PI** and **PI** inclusive,\n\nThe classic definition of the arctangent is the angle that is formed\nin Cartesian coordinates of the line from the origin point **\\<0,0\\>**\nto the point **\\** .\n\nPictured as a vector it is easy to see that if **x** and **y** are both\nzero the angle is indeterminate because it sits directly over the origin,\nso **atan(0.0,0.0)** will produce an error.\n\nRange of returned values by quadrant:\n```text\n> +PI/2\n> |\n> |\n> PI/2 < z < PI | 0 > z < PI/2\n> |\n> +-PI -------------+---------------- +-0\n> |\n> PI/2 < -z < PI | 0 < -z < PI/2\n> |\n> |\n> -PI/2\n>\n NOTES:\n\n If the processor distinguishes -0 and +0 then the sign of the\n returned value is that of Y when Y is zero, else when Y is zero\n the returned value is always positive.\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_atan2\nreal :: z\ncomplex :: c\n !\n ! basic usage\n ! ATAN2 (1.5574077, 1.0) has the value 1.0 (approximately).\n z=atan2(1.5574077, 1.0)\n write(*,*) 'radians=',z,'degrees=',r2d(z)\n !\n ! elemental arrays\n write(*,*)'elemental',atan2( [10.0, 20.0], [30.0,40.0] )\n !\n ! elemental arrays and scalars\n write(*,*)'elemental',atan2( [10.0, 20.0], 50.0 )\n !\n ! break complex values into real and imaginary components\n ! (note TAN2() can take a complex type value )\n c=(0.0,1.0)\n write(*,*)'complex',c,atan2( x=c%re, y=c%im )\n !\n ! extended sample converting cartesian coordinates to polar\n COMPLEX_VALS: block\n real :: ang, radius\n complex,allocatable :: vals(:)\n !\n vals=[ &\n ( 1.0, 0.0 ), & ! 0\n ( 1.0, 1.0 ), & ! 45\n ( 0.0, 1.0 ), & ! 90\n (-1.0, 1.0 ), & ! 135\n (-1.0, 0.0 ), & ! 180\n (-1.0,-1.0 ), & ! 225\n ( 0.0,-1.0 )] ! 270\n do i=1,size(vals)\n call cartesian_to_polar(vals(i)%re, vals(i)%im, radius,ang)\n write(*,101)vals(i),ang,r2d(ang),radius\n enddo\n 101 format( &\n & 'X= ',f5.2, &\n & ' Y= ',f5.2, &\n & ' ANGLE= ',g0, &\n & T38,'DEGREES= ',g0.4, &\n & T54,'DISTANCE=',g0)\n endblock COMPLEX_VALS\n!\ncontains\n!\nelemental real function r2d(radians)\n! input radians to convert to degrees\ndoubleprecision,parameter :: DEGREE=0.017453292519943d0 ! radians\nreal,intent(in) :: radians\n r2d=radians / DEGREE ! do the conversion\nend function r2d\n!\nsubroutine cartesian_to_polar(x,y,radius,inclination)\n! return angle in radians in range 0 to 2*PI\nimplicit none\nreal,intent(in) :: x,y\nreal,intent(out) :: radius,inclination\n radius=sqrt(x**2+y**2)\n if(radius.eq.0)then\n inclination=0.0\n else\n inclination=atan2(y,x)\n if(inclination < 0.0)inclination=inclination+2*atan2(0.0d0,-1.0d0)\n endif\nend subroutine cartesian_to_polar\n!\nend program demo_atan2\n```\nResults:\n```text\n > radians= 1.000000 degrees= 57.29578\n > elemental 0.3217506 0.4636476\n > elemental 0.1973956 0.3805064\n > complex (0.0000000E+00,1.000000) 1.570796\n > X= 1.00 Y= 0.00 ANGLE= .000000 DEGREES= .000 DISTANCE=1.000000\n > X= 1.00 Y= 1.00 ANGLE= .7853982 DEGREES= 45.00 DISTANCE=1.414214\n > X= 0.00 Y= 1.00 ANGLE= 1.570796 DEGREES= 90.00 DISTANCE=1.000000\n > X= -1.00 Y= 1.00 ANGLE= 2.356194 DEGREES= 135.0 DISTANCE=1.414214\n > X= -1.00 Y= 0.00 ANGLE= 3.141593 DEGREES= 180.0 DISTANCE=1.000000\n > X= -1.00 Y= -1.00 ANGLE= 3.926991 DEGREES= 225.0 DISTANCE=1.414214\n > X= 0.00 Y= -1.00 ANGLE= 4.712389 DEGREES= 270.0 DISTANCE=1.000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n- [**atan**(3)](#atan)\n\n### **Resources**\n\n- [arctan:wikipedia](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "ATAN2": "## atan2\n\n### **Name**\n\n**atan2** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arctangent (inverse tangent)\nfunction\n\n### **Synopsis**\n```fortran\n result = atan2(y, x)\n```\n```fortran\n elemental real(kind=KIND) function atan2(y, x)\n\n real,kind=KIND) :: atan2\n real,kind=KIND),intent(in) :: y, x\n```\n### **Characteristics**\n\n - **x** and **y** must be reals of the same kind.\n - The return value has the same type and kind as **y** and **x**.\n\n### **Description**\n\n **atan2** computes in radians a processor-dependent approximation of\n the arctangent of the complex number ( **x**, **y** ) or equivalently the\n principal value of the arctangent of the value **y/x** (which determines\n a unique angle).\n\n If **y** has the value zero, **x** shall not have the value zero.\n\n The resulting phase lies in the range -PI <= ATAN2 (Y,X) <= PI and is equal to a\n processor-dependent approximation to a value of arctan(Y/X).\n\n### **Options**\n\n- **y**\n : The imaginary component of the complex value **(x,y)** or the **y**\n component of the point **\\**.\n\n- **x**\n : The real component of the complex value **(x,y)** or the **x**\n component of the point **\\**.\n\n### **Result**\n\nThe value returned is by definition the principal value of the complex\nnumber **(x, y)**, or in other terms, the phase of the phasor x+i*y.\n\nThe principal value is simply what we get when we adjust a radian value\nto lie between **-PI** and **PI** inclusive,\n\nThe classic definition of the arctangent is the angle that is formed\nin Cartesian coordinates of the line from the origin point **\\<0,0\\>**\nto the point **\\** .\n\nPictured as a vector it is easy to see that if **x** and **y** are both\nzero the angle is indeterminate because it sits directly over the origin,\nso **atan(0.0,0.0)** will produce an error.\n\nRange of returned values by quadrant:\n```text\n> +PI/2\n> |\n> |\n> PI/2 < z < PI | 0 > z < PI/2\n> |\n> +-PI -------------+---------------- +-0\n> |\n> PI/2 < -z < PI | 0 < -z < PI/2\n> |\n> |\n> -PI/2\n>\n NOTES:\n\n If the processor distinguishes -0 and +0 then the sign of the\n returned value is that of Y when Y is zero, else when Y is zero\n the returned value is always positive.\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_atan2\nreal :: z\ncomplex :: c\n !\n ! basic usage\n ! ATAN2 (1.5574077, 1.0) has the value 1.0 (approximately).\n z=atan2(1.5574077, 1.0)\n write(*,*) 'radians=',z,'degrees=',r2d(z)\n !\n ! elemental arrays\n write(*,*)'elemental',atan2( [10.0, 20.0], [30.0,40.0] )\n !\n ! elemental arrays and scalars\n write(*,*)'elemental',atan2( [10.0, 20.0], 50.0 )\n !\n ! break complex values into real and imaginary components\n ! (note TAN2() can take a complex type value )\n c=(0.0,1.0)\n write(*,*)'complex',c,atan2( x=c%re, y=c%im )\n !\n ! extended sample converting cartesian coordinates to polar\n COMPLEX_VALS: block\n real :: ang, radius\n complex,allocatable :: vals(:)\n integer :: i\n !\n vals=[ &\n ( 1.0, 0.0 ), & ! 0\n ( 1.0, 1.0 ), & ! 45\n ( 0.0, 1.0 ), & ! 90\n (-1.0, 1.0 ), & ! 135\n (-1.0, 0.0 ), & ! 180\n (-1.0,-1.0 ), & ! 225\n ( 0.0,-1.0 )] ! 270\n do i=1,size(vals)\n call cartesian_to_polar(vals(i)%re, vals(i)%im, radius,ang)\n write(*,101)vals(i),ang,r2d(ang),radius\n enddo\n 101 format( &\n & 'X= ',f5.2, &\n & ' Y= ',f5.2, &\n & ' ANGLE= ',g0, &\n & T38,'DEGREES= ',g0.4, &\n & T54,'DISTANCE=',g0)\n endblock COMPLEX_VALS\n!\ncontains\n!\nelemental real function r2d(radians)\n! input radians to convert to degrees\ndoubleprecision,parameter :: DEGREE=0.017453292519943d0 ! radians\nreal,intent(in) :: radians\n r2d=radians / DEGREE ! do the conversion\nend function r2d\n!\nsubroutine cartesian_to_polar(x,y,radius,inclination)\n! return angle in radians in range 0 to 2*PI\nimplicit none\nreal,intent(in) :: x,y\nreal,intent(out) :: radius,inclination\n radius=sqrt(x**2+y**2)\n if(radius.eq.0)then\n inclination=0.0\n else\n inclination=atan2(y,x)\n if(inclination < 0.0)inclination=inclination+2*atan2(0.0d0,-1.0d0)\n endif\nend subroutine cartesian_to_polar\n!\nend program demo_atan2\n```\nResults:\n```text\n > radians= 1.000000 degrees= 57.29578\n > elemental 0.3217506 0.4636476\n > elemental 0.1973956 0.3805064\n > complex (0.0000000E+00,1.000000) 1.570796\n > X= 1.00 Y= 0.00 ANGLE= .000000 DEGREES= .000 DISTANCE=1.000000\n > X= 1.00 Y= 1.00 ANGLE= .7853982 DEGREES= 45.00 DISTANCE=1.414214\n > X= 0.00 Y= 1.00 ANGLE= 1.570796 DEGREES= 90.00 DISTANCE=1.000000\n > X= -1.00 Y= 1.00 ANGLE= 2.356194 DEGREES= 135.0 DISTANCE=1.414214\n > X= -1.00 Y= 0.00 ANGLE= 3.141593 DEGREES= 180.0 DISTANCE=1.000000\n > X= -1.00 Y= -1.00 ANGLE= 3.926991 DEGREES= 225.0 DISTANCE=1.414214\n > X= 0.00 Y= -1.00 ANGLE= 4.712389 DEGREES= 270.0 DISTANCE=1.000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n- [**atan**(3)](#atan)\n\n### **Resources**\n\n- [arctan:wikipedia](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ATANH": "## atanh\n\n### **Name**\n\n**atanh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Inverse hyperbolic tangent function\n\n### **Synopsis**\n```fortran\n result = atanh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function atanh(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be _real_ or _complex_ of any associated type\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n **atanh** computes the inverse hyperbolic tangent of **x**.\n\n### **Options**\n\n- **x**\n : The type shall be _real_ or _complex_.\n\n### **Result**\n\n The return value has same type and kind as **x**. If **x** is _complex_, the\n imaginary part of the result is in radians and lies between\n```fortran\n **-PI/2 <= aimag(atanh(x)) <= PI/2**\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_atanh\nimplicit none\nreal, dimension(3) :: x = [ -1.0, 0.0, 1.0 ]\n\n write (*,*) atanh(x)\n\nend program demo_atanh\n```\nResults:\n```text\n > -Infinity 0.0000000E+00 Infinity\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nInverse function: [**tanh**(3)](#tanh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ATOMIC_ADD": "## atomic_add\n\n### **Name**\n\n**atomic_add** - \\[ATOMIC\\] Atomic ADD operation\n\n### **Synopsis**\n```fortran\n call atomic_add (atom, value [,stat] )\n```\n```fortran\n subroutine atomic_add(atom,value,stat)\n\n integer(atomic_int_kind) :: atom[*]\n integer(atomic_int_kind),intent(in) :: value\n integer,intent(out),intent(out) :: stat\n```\n### **Characteristics**\n\n- **atom** is a scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value** is a scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat** is a Scalar default-kind integer variable.\n\n### **Description**\n\n**atomic_add** atomically adds the value of VAR to the\nvariable **atom**. When **stat** is present and the invocation was successful,\nit is assigned the value 0. If it is present and the invocation has\nfailed, it is assigned a positive value; in particular, for a coindexed\nATOM, if the remote image has stopped, it is assigned the value of\niso_fortran_env's STAT_STOPPED_IMAGE and if the remote image has\nfailed, the value STAT_FAILED_IMAGE.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_atomic_add\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*]\n call atomic_add (atom[1], this_image())\nend program demo_atomic_add\n```\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_define**(3)](#atomic_define),\n[**atomic_fetch_add**(3)](#atomic_fetch),\n[**atomic_and**(3)](#atomic_and),\n[**atomic_or**(3)](#atomic_or),\n[**atomic_xor**(3)](#atomic_xor)\n**iso_fortran_env**(3),\n\n _fortran-lang intrinsic descriptions_\n", "ATOMIC_AND": "## atomic_and\n\n### **Name**\n\n**atomic_and** - \\[ATOMIC:BIT MANIPULATION\\] Atomic bitwise AND operation\n\n### **Synopsis**\n```fortran\n call atomic_and(atom, value [,stat])\n```\n```fortran\n subroutine atomic_and(atom,value,stat)\n\n integer(atomic_int_kind) :: atom[*]\n integer(atomic_int_kind),intent(in) :: value\n integer,intent(out),intent(out) :: stat\n```\n### **Characteristics**\n\n- **atom** is a scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value** is a scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat** is a Scalar default-kind integer variable.\n\n### **Description**\n\n**atomic_and** atomically defines **atom** with the bitwise\n**and** between the values of **atom** and **value**. When **stat** is present and the\ninvocation was successful, it is assigned the value 0. If it is present\nand the invocation has failed, it is assigned a positive value; in\nparticular, for a coindexed **atom**, if the remote image has stopped, it is\nassigned the value of iso_fortran_env's stat_stopped_image and if\nthe remote image has failed, the value stat_failed_image.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_and\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*]\n call atomic_and(atom[1], int(b'10100011101'))\nend program demo_atomic_and\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_fetch_and**(3)](#atomic_fetch_and),\n[**atomic_define**(3)](#atomic_define),\n[**atomic_ref**(3)](#atomic_ref),\n[**atomic_cas**(3)](#atomic_cas),\n**iso_fortran_env**(3),\n[**atomic_add**(3)](#atomic_add),\n[**atomic_or**(3)](#atomic_or),\n[**atomic_xor**(3)](#atomic_xor)\n\n _fortran-lang intrinsic descriptions_\n", @@ -79,7 +79,7 @@ "EVENT_QUERY": "## event_query\n\n### **Name**\n\n**event_query** - \\[COLLECTIVE\\] Query whether a coarray event has occurred\n\n### **Synopsis**\n```fortran\n call event_query(event, count [,stat] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**event_query** assigns the number of events to **count** which have been\nposted to the **event** variable and not yet been removed by calling\n**event_wait**. When **stat** is present and the invocation was successful, it\nis assigned the value **0**. If it is present and the invocation has failed,\nit is assigned a positive value and **count** is assigned the value **-1**.\n\n### **Options**\n\n- **event**\n : (intent(in)) Scalar of type event_type, defined in\n iso_fortran_env; shall not be coindexed.\n\n- **count**\n : (intent(out))Scalar integer with at least the precision of default\n _integer_.\n\n- **stat**\n : (OPTIONAL) Scalar default-kind _integer_ variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_event_query\nuse iso_fortran_env\nimplicit none\ntype(event_type) :: event_value_has_been_set[*]\ninteger :: cnt\n if (this_image() == 1) then\n call event_query(event_value_has_been_set, cnt)\n if (cnt > 0) write(*,*) \"Value has been set\"\n elseif (this_image() == 2) then\n event post(event_value_has_been_set[1])\n endif\nend program demo_event_query\n```\n### **Standard**\n\nTS 18508\n\n### **See also**\n\n[****(3)](#)\n\n _fortran-lang intrinsic descriptions_\n", "EXECUTE_COMMAND_LINE": "## execute_command_line\n\n### **Name**\n\n**execute_command_line** - \\[SYSTEM:PROCESSES\\] Execute a shell command\n\n### **Synopsis**\n```fortran\n call execute_command_line( &\n & command [,wait] [,exitstat] [,cmdstat] [,cmdmsg] )\n```\n```fortran\n subroutine execute_command_line(command,wait,exitstat,cmdstat,cmdmsg)\n\n character(len=*),intent(in) :: command\n logical,intent(in),optional :: wait\n integer,intent(inout),optional :: exitstat\n integer,intent(inout),optional :: cmdstat\n character(len=*),intent(inout),optional :: cmdmsg\n```\n### **Characteristics**\n - **command** is a default _character_ scalar\n - **wait** is a default _logical_ scalar. If **wait** is present with the\n - **exitstat** is an _integer_ of the default kind.\n It must be of a kind with at least a decimal exponent range of 9.\n - **cmdstat** is an _integer_ of default kind\n The kind of the variable must support at least a decimal exponent range of four.\n\n - **cmdmsg** is a _character_ scalar of the default kind.\n\n### **Description**\n\n For **execute_command_line** the **command** argument is passed\n to the shell and executed. (The shell is generally **sh**(1) on Unix\n systems, and cmd.exe on Windows.) If **wait** is present and has the\n value _.false._, the execution of the command is asynchronous if the\n system supports it; otherwise, the command is executed synchronously.\n\n The three last arguments allow the user to get status information. After\n synchronous execution, **exitstat** contains the integer exit code of\n the command, as returned by **system**. **cmdstat** is set to zero if\n the command line was executed (whatever its exit status was). **cmdmsg**\n is assigned an error message if an error has occurred.\n\n Note that the system call need not be thread-safe. It is the\n responsibility of the user to ensure that the system is not called\n concurrently if required.\n\n When the command is executed synchronously, **execute_command_line**\n returns after the command line has completed execution. Otherwise,\n **execute_command_line** returns without waiting.\n\n Because this intrinsic is making a system call, it is very system\n dependent. Its behavior with respect to signaling is processor\n dependent. In particular, on POSIX-compliant systems, the SIGINT and\n SIGQUIT signals will be ignored, and the SIGCHLD will be blocked. As\n such, if the parent process is terminated, the child process might\n not be terminated alongside.\n\n One of the most common causes of errors is that the program requested\n is not in the search path. You should make sure that the program to be\n executed is installed on your system and that it is in the system's\n path when the program calls it. You can check if it is installed by\n running it from the command prompt. If it runs successfully from the\n command prompt, it means that it is installed, and so you should\n next check that it is in the search path when the program executes\n (usually this means checking the environment variable PATH).\n\n### **Options**\n\n- **command**\n : the command line to be executed. The interpretation is\n programming-environment dependent.\n\n- **wait**\n : If **wait** is present with the\n value _.false._, and the processor supports asynchronous execution of\n the command, the command is executed asynchronously; otherwise it is\n executed synchronously.\n\n When the command is executed synchronously, **execute_command_line**\n returns after the command line has completed execution. Otherwise,\n **execute_command_line** returns without waiting.\n\n- **exitstat**\n : If the command is executed synchronously, it is assigned the value\n of the processor-dependent exit status. Otherwise, the value of\n **exitstat** is unchanged.\n\n- **cmdstat**\n : If an error condition occurs and **cmdstat** is not present, error\n termination of execution of the image is initiated.\n\n It is assigned the value **-1** if the processor does not support\n command line execution, a processor-dependent positive value if an\n error condition occurs, or the value **-2** if no error condition\n occurs but **wait** is present with the value false and the processor\n does not support asynchronous execution. Otherwise it is assigned\n the value 0.\n\n- **cmdmsg**\n : If an error condition occurs, it is assigned a processor-dependent\n explanatory message. Otherwise, it is unchanged.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_exec\nimplicit none\n integer :: i\n\n call execute_command_line(\"external_prog.exe\", exitstat=i)\n print *, \"Exit status of external_prog.exe was \", i\n\n call execute_command_line(\"reindex_files.exe\", wait=.false.)\n print *, \"Now reindexing files in the background\"\nend program demo_exec\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n[**get_environment_variable**(3)](#get_environment_variable)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "EXP": "## exp\n\n### **Name**\n\n**exp** - \\[MATHEMATICS\\] Base-e exponential function\n\n### **Synopsis**\n```fortran\n result = exp(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function exp(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be _real_ or _complex_ of any kind.\n - The return value has the same type and kind as **x**.\n\n### **Description**\n\n**exp** returns the value of _e_ (the base of natural logarithms)\nraised to the power of **x**.\n\n\"_e_\" is also known as _Euler's constant_.\n\nIf **x** is of type _complex_, its imaginary part is regarded as a value\nin radians such that if (see _Euler's formula_):\n```fortran\n cx=(re,im)\n```\nthen\n```fortran\n exp(cx) = exp(re) * cmplx(cos(im),sin(im),kind=kind(cx))\n```\nSince **exp** is the inverse function of **log**(3) the maximum valid magnitude\nof the _real_ component of **x** is **log(huge(x))**.\n\n### **Options**\n\n- **x**\n : The type shall be _real_ or _complex_.\n\n### **Result**\n\nThe value of the result is **e\\*\\*x** where **e** is Euler's constant.\n\nIf **x** is of type complex, its imaginary part is\nregarded as a value in radians.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_exp\nimplicit none\nreal :: x, re, im\ncomplex :: cx\n\n x = 1.0\n write(*,*)\"Euler's constant is approximately\",exp(x)\n\n !! complex values\n ! given\n re=3.0\n im=4.0\n cx=cmplx(re,im)\n\n ! complex results from complex arguments are Related to Euler's formula\n write(*,*)'given the complex value ',cx\n write(*,*)'exp(x) is',exp(cx)\n write(*,*)'is the same as',exp(re)*cmplx(cos(im),sin(im),kind=kind(cx))\n\n ! exp(3) is the inverse function of log(3) so\n ! the real component of the input must be less than or equal to\n write(*,*)'maximum real component',log(huge(0.0))\n ! or for double precision\n write(*,*)'maximum doubleprecision component',log(huge(0.0d0))\n\n ! but since the imaginary component is passed to the cos(3) and sin(3)\n ! functions the imaginary component can be any real value\n\nend program demo_exp\n```\n\nResults:\n\n```text\n Euler's constant is approximately 2.718282\n given the complex value (3.000000,4.000000)\n exp(x) is (-13.12878,-15.20078)\n is the same as (-13.12878,-15.20078)\n maximum real component 88.72284\n maximum doubleprecision component 709.782712893384\n```\n\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n- [**log**(3)](#log)\n\n### **Resources**\n\n- Wikipedia:[Exponential function](https://en.wikipedia.org/wiki/Exponential_function)\n\n- Wikipedia:[Euler's formula](https://en.wikipedia.org/wiki/Euler%27s_formula)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "EXPONENT": "## exponent\n\n### **Name**\n\n**exponent** - \\[MODEL_COMPONENTS\\] Exponent of floating-point number\n\n### **Synopsis**\n```fortran\n result = exponent(x)\n```\n```fortran\n elemental integer function exponent(x)\n\n real(kind=**),intent(in) :: x\n```\n### **Characteristics**\n - **x** shall be of type _real_ of any valid kind\n - the result is a default _integer_ type\n\n### **Description**\n\n **exponent** returns the value of the exponent part of **x**, provided\n the exponent is within the range of default _integers_.\n\n### **Options**\n\n- **x**\n : the value to query the exponent of\n\n### **Result**\n\n **exponent** returns the value of the exponent part of **x**\n\n If **x** is zero the value returned is zero.\n\n If **x** is an IEEE infinity or NaN, the result has the value HUGE(0).\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_exponent\nimplicit none\nreal :: x = 1.0\ninteger :: i\n i = exponent(x)\n print *, i\n print *, exponent(0.0)\n print *, exponent([10.0,100.0,1000.0,-10000.0])\n print *, 2**[10.0,100.0,1000.0,-10000.0]\n print *, exponent(huge(0.0))\n print *, exponent(tiny(0.0))\nend program demo_exponent\n```\nResults:\n```text\n > 4 7 10 14\n > 128\n > -125\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\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_\n", + "EXPONENT": "## exponent\n\n### **Name**\n\n**exponent** - \\[MODEL_COMPONENTS\\] Exponent of floating-point number\n\n### **Synopsis**\n```fortran\n result = exponent(x)\n```\n```fortran\n elemental integer function exponent(x)\n\n real(kind=**),intent(in) :: x\n```\n### **Characteristics**\n - **x** shall be of type _real_ of any valid kind\n - the result is a default _integer_ type\n\n### **Description**\n\n **exponent** returns the value of the exponent part of **x**, provided\n the exponent is within the range of default _integers_.\n\n### **Options**\n\n- **x**\n : the value to query the exponent of\n\n### **Result**\n\n **exponent** returns the value of the exponent part of **x**\n\n If **x** is zero the value returned is zero.\n\n If **x** is an IEEE infinity or NaN, the result has the value HUGE(0).\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_exponent\nimplicit none\nreal :: x = 1.0\ninteger :: i\n i = exponent(x)\n print *, i\n print *, exponent(0.0)\n print *, exponent([10.0,100.0,1000.0,-10000.0])\n ! beware of overflow, it may occur silently\n !print *, 2**[10.0,100.0,1000.0,-10000.0]\n print *, exponent(huge(0.0))\n print *, exponent(tiny(0.0))\nend program demo_exponent\n```\nResults:\n```text\n > 4 7 10 14\n > 128\n > -125\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\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_\n", "EXTENDS_TYPE_OF": "## extends_type_of\n\n### **Name**\n\n**extends_type_of** - \\[STATE:INQUIRY\\] Determine if the dynamic type\nof **a** is an extension of the dynamic type of **mold**.\n\n### **Synopsis**\n```fortran\n result = extends_type_of(a, mold)\n```\n```fortran\n logical extends_type_of(a, mold)\n\n type(TYPE(kind=KIND)),intent(in) :: a\n type(TYPE(kind=KIND)),intent(in) :: mold\n```\n### **Characteristics**\n -**a** shall be an object or pointer to an extensible declared type,\n or unlimited polymorphic. If it is a polymorphic pointer, it\n shall not have an undefined association status.\n -**mole** shall be an object or pointer to an extensible declared type\n or unlimited polymorphic. If it is a polymorphic pointer,\n it shall not have an undefined association status.\n - the result is a scalar default logical type.\n\n### **Description**\n\n **extends_type_of** is .true. if and only if the dynamic type of\n **a** is or could be (for unlimited polymorphic) an extension of the\n dynamic type of **mold**.\n\n#### NOTE1\n\n The dynamic type of a disassociated pointer or unallocated allocatable\n variable is its declared type.\n\n#### NOTE2\n\n The test performed by **extends_type_of** is not the same as the\n test performed by the type guard **class is**. The test performed by\n **extends_type_of** does not consider kind type parameters.\n\n### **options**\n- **a**\n : be an object of extensible declared type or unlimited\n polymorphic. If it is a polymorphic pointer, it shall not have an\n undefined association status.\n\n- **mold**\n : be an object of extensible declared type or unlimited\n polymorphic. If it is a polymorphic pointer, it shall not have an\n undefined association status.\n\n### **Result**\n\n If **mold** is unlimited polymorphic and is either a disassociated\n pointer or unallocated allocatable variable, the result is true.\n\n Otherwise if **a** is unlimited polymorphic and is either a\n disassociated pointer or unallocated allocatable variable, the result\n is false.\n\n Otherwise the result is true if and only if the dynamic type of **a**\n\n if the dynamic type of A or MOLD is extensible, the result is true if\n and only if the dynamic type of A is an extension type of the dynamic\n type of MOLD; otherwise the result is processor dependent.\n\n\n### **Examples**\n\nSample program:\n```fortran\n ! program demo_extends_type_of\n module M_demo_extends_type_of\n implicit none\n private\n\n type nothing\n end type nothing\n\n type, extends(nothing) :: dot\n real :: x=0\n real :: y=0\n end type dot\n\n type, extends(dot) :: point\n real :: z=0\n end type point\n\n type something_else\n end type something_else\n\n public :: nothing\n public :: dot\n public :: point\n public :: something_else\n\n end module M_demo_extends_type_of\n\n program demo_extends_type_of\n use M_demo_extends_type_of, only : nothing, dot, point, something_else\n implicit none\n type(nothing) :: grandpa\n type(dot) :: dad\n type(point) :: me\n type(something_else) :: alien\n\n write(*,*)'these should all be true'\n write(*,*)extends_type_of(me,grandpa),'I am descended from Grandpa'\n write(*,*)extends_type_of(dad,grandpa),'Dad is descended from Grandpa'\n write(*,*)extends_type_of(me,dad),'Dad is my ancestor'\n\n write(*,*)'is an object an extension of itself?'\n write(*,*)extends_type_of(grandpa,grandpa) ,'self-propagating!'\n write(*,*)extends_type_of(dad,dad) ,'clone!'\n\n write(*,*)' you did not father your grandfather'\n write(*,*)extends_type_of(grandpa,dad),'no paradox here'\n\n write(*,*)extends_type_of(dad,me),'no paradox here'\n write(*,*)extends_type_of(grandpa,me),'no relation whatsoever'\n write(*,*)extends_type_of(grandpa,alien),'no relation'\n write(*,*)extends_type_of(me,alien),'not what everyone thinks'\n\n call pointers()\n contains\n\n subroutine pointers()\n ! Given the declarations and assignments\n type t1\n real c\n end type\n type, extends(t1) :: t2\n end type\n class(t1), pointer :: p, q\n allocate (p)\n allocate (t2 :: q)\n ! the result of EXTENDS_TYPE_OF (P, Q) will be false, and the result\n ! of EXTENDS_TYPE_OF (Q, P) will be true.\n write(*,*)'(P,Q)',extends_type_of(p,q),\"mind your P's and Q's\"\n write(*,*)'(Q,P)',extends_type_of(q,p)\n end subroutine pointers\n\n end program demo_extends_type_of\n```\nResults:\n```text\n these should all be true\n T I am descended from Grandpa\n T Dad is descended from Grandpa\n T Dad is my ancestor\n is an object an extension of itself?\n T self-propagating!\n T clone!\n you did not father your grandfather\n F no paradox here\n F no paradox here\n F no relation whatsoever\n F no relation\n F not what everyone thinks\n (P,Q) F mind your P's and Q's\n (Q,P) T\n```\n### **Standard**\n\n Fortran 2003\n\n### **See Also**\n\n[**same_type_as**(3)](#same_type_as)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "FINDLOC": "## findloc\n\n### **Name**\n\n**findloc** - \\[ARRAY:LOCATION\\] Location of first element of ARRAY\nidentified by MASK along dimension DIM matching a target value\n\n### **Synopsis**\n\n```fortran\n result = findloc (array, value, dim [,mask] [,kind] [,back]) |\n findloc (array, value [,mask] [,kind] [,back])\n```\n```fortran\n function findloc (array, value, dim, mask, kind, back)\n\n type(TYPE(kind=KIND)),intent(in) :: array(..)\n type(TYPE(kind=KIND)),intent(in) :: value\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n integer(kind=**),intent(in),optional :: kind\n logical(kind=**),intent(in),optional :: back\n```\n### **Characteristics**\n\n- **array** is an array of any intrinsic type.\n- **value** shall be scalar but in type conformance with **array**,\n as specified for the operator == or the operator .EQV..\n- **dim** an _integer_ corresponding to a dimension of **array**.\n The corresponding actual argument shall not be an optional dummy\n argument.\n- **mask** is logical and shall be conformable with **array**.\n- **kind** a scalar integer initialization expression (ie. a constant)\n- **back** a logical scalar.\n- the result is _integer_ of default kind or kind **kind** if the\n **kind** argument is present. If **dim** does not appear, the result\n is an array of rank one and of size equal to the rank of **array**;\n otherwise, the result is an array of the same rank and shape as\n **array** reduced by the dimension **dim**.\n\n**NOTE**: a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**findloc** returns the location of the first element of **array**\nidentified by **mask** along dimension **dim** having a value equal\nto **value**.\n\nIf both **array** and **value** are of type logical, the comparison is\nperformed with the **.eqv.** operator; otherwise, the comparison is\nperformed with the == operator. If the value of the comparison is\n_.true._, that element of **array** matches **value**.\n\nIf only one element matches **value**, that element's subscripts are\nreturned. Otherwise, if more than one element matches **value** and\n**back** is absent or present with the value _.false._, the element whose\nsubscripts are returned is the first such element, taken in array\nelement order. If **back** is present with the value _.true._, the element\nwhose subscripts are returned is the last such element, taken in array\nelement order.\n\n### **Options**\n\n- **array**\n : shall be an array of intrinsic type.\n\n- **value**\n : shall be scalar and in type conformance with **array**.\n\n- **dim**\n : shall be an integer scalar with a value in the range 1 <= **DIM** <=\n n, where n is the rank of **array**. The corresponding actual argument\n shall not be an optional dummy argument.\n\n- **mask**\n : (optional) shall be of type logical and shall be conformable with\n **array**.\n\n- **kind**\n : (optional) shall be a scalar integer initialization expression.\n\n- **back**\n : (optional) shall be a logical scalar.\n\n### **Result**\n\n**kind** is present, the kind type\nparameter is that specified by the value of **kind**; otherwise the kind\ntype parameter is that of default integer type. If **dim** does not appear,\nthe result is an array of rank one and of size equal to the rank of\n**array**; otherwise, the result is of rank n - 1 and shape\n```\n [d1, d2, . . ., dDIM-1, dDIM+1, . . ., dn ]\n```\nwhere\n```\n [d1, d2, . . ., dn ]\n```\nis the shape of **array**.\n\n### **Result**\n\n- **Case (i):**\n The result of **findloc (array, value)** is a rank-one array whose\n element values are the values of the subscripts of an element of\n **array** whose value matches **value**. If there is such a value, the\n ith subscript returned lies in the range 1 to ei, where ei is the\n extent of the ith dimension of **array**. If no elements match **value**\n or **array** has size zero, all elements of the result are zero.\n\n- **Case (ii):**\n the result of **findloc (array, value, mask = mask)** is a\n rank-one array whose element values are the values of the subscripts\n of an element of **array**, corresponding to a true element of **mask**,\n whose value matches **value**. If there is such a value, the ith\n subscript returned lies in the range 1 to ei, where ei is the\n extent of the ith dimension of **array**. If no elements match\n **value**, **array** has size zero, or every element of **mask** has the\n value false, all elements of the result are zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_findloc\nlogical,parameter :: T=.true., F=.false.\ninteger,allocatable :: ibox(:,:)\nlogical,allocatable :: mask(:,:)\n ! basics\n ! the first element matching the value is returned AS AN ARRAY\n call printi('== 6',findloc ([2, 6, 4, 6], value = 6))\n call printi('== 6',findloc ([2, 6, 4, 6], value = 6,back=.true.))\n ! the first element matching the value is returned AS A SCALAR\n call printi('== 6',findloc ([2, 6, 4, 6], value = 6,dim=1))\n call printi('== 6',findloc ([2, 6, 4, 6], value = 6,back=.true.,dim=1))\n\n ibox=reshape([ 0,-5, 7, 7, &\n 3, 4, -1, 2, &\n 1, 5, 6, 7] ,shape=[3,4],order=[2,1])\n\n mask=reshape([ T, T, F, T, &\n T, T, F, T, &\n T, T, F, T] ,shape=[3,4],order=[2,1])\n\n call printi('array is', ibox )\n call printl('mask is', mask )\n print *, 'so for == 7 and back=.false.'\n call printi('so for == 7 the address of the element is', &\n & findloc (ibox, 7, mask = mask) )\n print *, 'so for == 7 and back=.true.'\n call printi('so for == 7 the address of the element is', &\n & findloc (ibox, 7, mask = mask, back=.true.) )\n\n print *,'This is independent of declared lower bounds for the array'\n\n print *, ' using dim=N'\n ibox=reshape([ 1, 2, -9, &\n 2, 2, 6 ] ,shape=[2,3],order=[2,1])\n\n call printi('array is', ibox )\n ! has the value [2, 1, 0] and\n call printi('',findloc (ibox, value = 2, dim = 1) )\n ! has the value [2, 1].\n call printi('',findloc (ibox, value = 2, dim = 2) )\ncontains\n! GENERIC ROUTINES TO PRINT MATRICES\nsubroutine printl(title,a)\nimplicit none\n!@(#) print small 2d logical scalar, vector, matrix in row-column format\ncharacter(len=*),intent(in) :: title\nlogical,intent(in) :: a(..)\n\ncharacter(len=*),parameter :: row='(\" > [ \",*(l1:,\",\"))'\ncharacter(len=*),parameter :: all='(\" \",*(g0,1x))'\nlogical,allocatable :: b(:,:)\ninteger :: i\n write(*,all,advance='no')trim(title)\n ! copy everything to a matrix to keep code simple\n select rank(a)\n rank (0); write(*,'(a)')' (a scalar)'; b=reshape([a],[1,1])\n rank (1); write(*,'(a)')' (a vector)'; b=reshape(a,[size(a),1])\n rank (2); write(*,'(a)')' (a matrix)'; b=a\n rank default; stop '*printl* unexpected rank'\n end select\n do i=1,size(b,dim=1)\n write(*,fmt=row,advance='no')b(i,:)\n write(*,'(\" ]\")')\n enddo\n write(*,all) '>shape=',shape(a),',rank=',rank(a),',size=',size(a)\n write(*,*)\nend subroutine printl\n\nsubroutine printi(title,a)\nimplicit none\n!@(#) print small 2d integer scalar, vector, matrix in row-column format\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: a(..)\ncharacter(len=*),parameter :: all='(\" \",*(g0,1x))'\ncharacter(len=20) :: row\ninteger,allocatable :: b(:,:)\ninteger :: i\n write(*,all,advance='no')trim(title)\n ! copy everything to a matrix to keep code simple\n select rank(a)\n rank (0); write(*,'(a)')' (a scalar)'; b=reshape([a],[1,1])\n rank (1); write(*,'(a)')' (a vector)'; b=reshape(a,[size(a),1])\n rank (2); write(*,'(a)')' (a matrix)'; b=a\n rank default; stop '*printi* unexpected rank'\n end select\n ! find how many characters to use for integers\n write(row,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(b))))))+2\n ! use this format to write a row\n row='(\" > [\",*(i'//trim(row)//':,\",\"))'\n do i=1,size(b,dim=1)\n write(*,fmt=row,advance='no')b(i,:)\n write(*,'(\" ]\")')\n enddo\n write(*,all) '>shape=',shape(a),',rank=',rank(a),',size=',size(a)\n write(*,*)\nend subroutine printi\nend program demo_findloc\n```\nResults:\n```text\n > == 6 (a vector)\n > > [ 2 ]\n > >shape= 1 ,rank= 1 ,size= 1\n >\n > == 6 (a vector)\n > > [ 4 ]\n > >shape= 1 ,rank= 1 ,size= 1\n >\n > == 6 (a scalar)\n > > [ 2 ]\n > >shape= ,rank= 0 ,size= 1\n >\n > == 6 (a scalar)\n > > [ 4 ]\n > >shape= ,rank= 0 ,size= 1\n >\n > array is (a matrix)\n > > [ 0, -5, 7, 7 ]\n > > [ 3, 4, -1, 2 ]\n > > [ 1, 5, 6, 7 ]\n > >shape= 3 4 ,rank= 2 ,size= 12\n >\n > mask is (a matrix)\n > > [ T,T,F,T ]\n > > [ T,T,F,T ]\n > > [ T,T,F,T ]\n > >shape= 3 4 ,rank= 2 ,size= 12\n >\n > so for == 7 and back=.false.\n > so for == 7 the address of the element is (a vector)\n > > [ 1 ]\n > > [ 4 ]\n > >shape= 2 ,rank= 1 ,size= 2\n >\n > so for == 7 and back=.true.\n > so for == 7 the address of the element is (a vector)\n > > [ 3 ]\n > > [ 4 ]\n > >shape= 2 ,rank= 1 ,size= 2\n >\n > This is independent of declared lower bounds for the array\n > using dim=N\n > array is (a matrix)\n > > [ 1, 2, -9 ]\n > > [ 2, 2, 6 ]\n > >shape= 2 3 ,rank= 2 ,size= 6\n >\n > (a vector)\n > > [ 2 ]\n > > [ 1 ]\n > > [ 0 ]\n > >shape= 3 ,rank= 1 ,size= 3\n >\n > (a vector)\n > > [ 2 ]\n > > [ 1 ]\n > >shape= 2 ,rank= 1 ,size= 2\n >\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n - [**maxloc**(3)](#maxloc) - Location of the maximum value within an array\n - [**minloc**(3)](#minloc) - Location of the minimum value within an array\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "FLOOR": "## floor\n\n### **Name**\n\n**floor** - \\[NUMERIC\\] Function to return largest integral value\nnot greater than argument\n\n### **Synopsis**\n```fortran\n result = floor(a [,kind])\n```\n```fortran\n elemental integer(kind=KIND) function floor( a ,kind )\n\n real(kind=**),intent(in) :: a\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- **a** is a _real_ of any kind\n- _KIND_ is any valid value for type _integer_.\n- the result is an _integer_ of the specified or default kind\n\n### **Description**\n\n**floor** returns the greatest integer less than or equal to **a**.\n\nIn other words, it picks the whole number at or to the left of the value on\nthe number line.\n\nThis means care has to be taken that the magnitude of the _real_ value **a**\ndoes not exceed the range of the output value, as the range of values supported\nby _real_ values is typically larger than the range for _integers_.\n\n### **Options**\n\n- **a**\n : The value to operate on. Valid values are restricted by the size of\n the returned _integer_ kind to the range **-huge(int(a,kind=KIND))-1**\n to **huge(int(a),kind=KIND)**.\n\n- **kind**\n : A scalar _integer_ constant initialization expression\n indicating the kind parameter of the result.\n\n### **Result**\n\nThe return value is of type _integer(kind)_ if **kind** is present and of\ndefault-kind _integer_ otherwise.\n\nThe result is undefined if it cannot be represented in the specified\ninteger type.\n\nIf in range for the kind of the result the result is the whole number\nat or to the left of the input value on the number line.\n\nIf **a** is positive the result is the value with the fractional part\nremoved.\n\nIf **a** is negative, it is the whole number at or to the left of the\ninput value.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_floor\nimplicit none\nreal :: x = 63.29\nreal :: y = -63.59\n print *, x, floor(x)\n print *, y, floor(y)\n ! elemental\n print *,floor([ &\n & -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, &\n & 0.0, &\n & +0.5, +1.0, +1.5, +2.0, +2.2, +2.5, +2.7 ])\n\n ! note even a small deviation from the whole number changes the result\n print *, [2.0,2.0-epsilon(0.0),2.0-2*epsilon(0.0)]\n print *,floor([2.0,2.0-epsilon(0.0),2.0-2*epsilon(0.0)])\n\n ! A=Nan, Infinity or huge(0_KIND) is undefined\nend program demo_floor\n```\nResults:\n```text\n > 63.29000 63\n > -63.59000 -64\n > -3 -3 -3 -2 -2 -1\n > -1 0 0 1 1 2\n > 2 2 2\n > 2.000000 2.000000 2.000000\n > 2 1 1\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ceiling**(3)](#ceiling),\n[**nint**(3)](#nint),\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**selected_int_kind**(3)](#selected_int_kind)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", @@ -156,7 +156,7 @@ "PRESENT": "## present\n\n### **Name**\n\n**present** - [STATE:INQUIRY\\] Determine whether an optional dummy argument\nis specified\n\n### **Synopsis**\n```fortran\n result = present(a)\n```\n```fortran\n logical function present (a)\n\n type(TYPE(kind=KIND)) :: a(..)\n```\n### **Characteristics**\n\n- **a** May be of any type and may be a pointer, scalar or array value,\n or a dummy procedure.\n\n### **Description**\n\n **present** can be used in a procedure to determine if an optional\n dummy argument was present on the current call to the procedure.\n\n **a** shall be the name of an optional dummy argument that is accessible\n in the subprogram in which the **present** function reference\n appears. There are no other requirements on **a**.\n\n Note when an argument is not present when the current procedure is\n invoked, you may only pass it as an optional argument to another\n procedure or pass it as an argument to **present**.\n\n### **Options**\n\n- **a**\n : the name of an optional dummy argument accessible within the current\n subroutine or function.\n\n### **Result**\n\n Returns _.true._ if the optional argument **a** is present (was passed\n on the call to the procedure) , or _.false._ otherwise.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_present\nimplicit none\ninteger :: answer\n ! argument to func() is not present\n answer=func()\n write(*,*) answer\n ! argument to func() is present\n answer=func(1492)\n write(*,*) answer\ncontains\n!\ninteger function func(x)\n! the optional characteristic on this definition allows this variable\n! to not be specified on a call; and also allows it to subsequently\n! be passed to PRESENT(3):\ninteger, intent(in), optional :: x\ninteger :: x_local\n !\n ! basic\n if(present(x))then\n ! if present, you can use x like any other variable.\n x_local=x\n else\n ! if not, you cannot define or reference x except to\n ! pass it as an optional parameter to another procedure\n ! or in a call to present(3f)\n x_local=0\n endif\n !\n func=x_local**2\n !\n ! passing the argument on to other procedures\n ! so something like this is a bad idea because x is used\n ! as the first argument to merge(3f) when it might not be\n ! present\n ! xlocal=merge(x,0,present(x)) ! NO!!\n !\n ! We can pass it to another procedure if another\n ! procedure declares the argument as optional as well,\n ! or we have tested that X is present\n call tattle('optional argument x',x)\n if(present(x))call not_optional(x)\nend function\n!\nsubroutine tattle(label,arg)\ncharacter(len=*),intent(in) :: label\ninteger,intent(in),optional :: arg\n if(present(arg))then\n write(*,*)label,' is present'\n else\n write(*,*)label,' is not present'\n endif\nend subroutine tattle\n!\nsubroutine not_optional(arg)\ninteger,intent(in) :: arg\n write(*,*)'already tested X is defined',arg\nend subroutine not_optional\n!\nend program demo_present\n```\nResults:\n```text\n optional argument x is not present\n 0\n optional argument x is present\n already tested X is defined 1492\n 2226064\n```\n### **Standard**\n\nFortran 95\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "PRODUCT": "## product\n\n### **Name**\n\n**product** - \\[ARRAY:REDUCTION\\] Product of array elements\n\n### **Synopsis**\n```fortran\n result = product(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function product(array, dim, mask)\n\n NUMERIC,intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **NUMERIC** is any numeric type and kind.\n\n### **Description**\n\n**product** multiplies together all the selected elements of **array**,\nor along dimension **dim** if the corresponding element in **mask**\nis _.true._.\n\nIf **dim** is absent, a scalar with the product of all elements in **array** is\nreturned. (Note a zero-sized **array** returns **1**).\n\nWhen **dim** is present, If the masked array has a dimension of one\n(ie. is a vector) the result is a scalar. Otherwise, an array of rank\n**n-1**, where **n** equals the rank of **array**, and a shape similar\nto that of **array** with dimension **dim** dropped is returned.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_ or _complex_.\n\n- **dim**\n : shall be a scalar of type _integer_ with a value in the\n range from **1 to n**, where **n** equals the rank of **array**.\n\n- **mask**\n : shall be of type _logical_ and either be a scalar or an\n array of the same shape as **array**.\n\n### **Result**\n\nThe result is of the same type as **array**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_product\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))' ! a handy format\ncharacter(len=1),parameter :: nl=new_line('a')\n\nNO_DIM: block\n! If DIM is not specified, the result is the product of all the\n! selected array elements.\ninteger :: i,n, p1, p2\ninteger,allocatable :: array(:)\n ! all elements are selected by default\n do n=1,10\n print all, 'factorial of ',n,' is ', product([(real(i),i=1,n)])\n enddo\n\n ! using a mask\n array=[10,12,13,15,20,25,30]\n p1=product(array, mask=mod(array, 2)==1) ! only odd elements\n p2=product(array, mask=mod(array, 2)/=1) ! only even elements\n print all, nl,'product of all elements',product(array) ! all elements\n print all, ' odd * even =',nl,p1,'*',p2,'=',p1*p2\n\n ! NOTE: If ARRAY is a zero-sized array, the result is equal to one\n print all\n print all, 'zero-sized array=>',product([integer :: ])\n ! NOTE: If nothing in the mask is true, this also results in a null\n ! array\n print all, 'all elements have a false mask=>', &\n & product(array,mask=.false.)\n\nendblock NO_DIM\n\nWITH_DIM: block\ninteger :: rect(2,3)\ninteger :: box(2,3,4)\n\n! lets fill a few arrays\n rect = reshape([ &\n 1, 2, 3, &\n 4, 5, 6 &\n ],shape(rect),order=[2,1])\n call print_matrix_int('rect',rect)\n\n! Find the product of each column in RECT.\n print all, 'product of columns=',product(rect, dim = 1)\n\n! Find the product of each row in RECT.\n print all, 'product of rows=',product(rect, dim = 2)\n\n! now lets try a box\n box(:,:,1)=rect\n box(:,:,2)=rect*(+10)\n box(:,:,3)=rect*(-10)\n box(:,:,4)=rect*2\n ! lets look at the values\n call print_matrix_int('box 1',box(:,:,1))\n call print_matrix_int('box 2',box(:,:,2))\n call print_matrix_int('box 3',box(:,:,3))\n call print_matrix_int('box 4',box(:,:,4))\n\n ! remember without dim= even a box produces a scalar\n print all, 'no dim gives a scalar',product(real(box))\n\n ! only one plane has negative values, so note all the \"1\" values\n ! for vectors with no elements\n call print_matrix_int('negative values', &\n & product(box,mask=box < 0,dim=1))\n\n! If DIM is specified and ARRAY has rank greater than one, the\n! result is a new array in which dimension DIM has been eliminated.\n\n ! pick a dimension to multiply though\n call print_matrix_int('dim=1',product(box,dim=1))\n\n call print_matrix_int('dim=2',product(box,dim=2))\n\n call print_matrix_int('dim=3',product(box,dim=3))\n\nendblock WITH_DIM\n\ncontains\n\nsubroutine print_matrix_int(title,arr)\nimplicit none\n\n!@(#) print small 2d integer arrays in row-column format\n\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n print all\n print all, trim(title),':(',shape(arr),')' ! print title\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\nend subroutine print_matrix_int\n\nend program demo_product\n```\n\nResults:\n\n```text\nfactorial of 1 is 1.000000\nfactorial of 2 is 2.000000\nfactorial of 3 is 6.000000\nfactorial of 4 is 24.00000\nfactorial of 5 is 120.0000\nfactorial of 6 is 720.0000\nfactorial of 7 is 5040.000\nfactorial of 8 is 40320.00\nfactorial of 9 is 362880.0\nfactorial of 10 is 3628800.\n\n product of all elements 351000000\n odd * even =\n 4875 * 72000 = 351000000\n\nzero-sized array=> 1\nall elements have a false mask=> 1\n\nrect :( 2 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\nproduct of columns= 4 10 18\nproduct of rows= 6 120\n\nbox 1 :( 2 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n\nbox 2 :( 2 3 )\n > [ 10, 20, 30 ]\n > [ 40, 50, 60 ]\n\nbox 3 :( 2 3 )\n > [ -10, -20, -30 ]\n > [ -40, -50, -60 ]\n\nbox 4 :( 2 3 )\n > [ 2, 4, 6 ]\n > [ 8, 10, 12 ]\nno dim gives a scalar .1719927E+26\n\nnegative values :( 3 4 )\n > [ 1, 1, 400, 1 ]\n > [ 1, 1, 1000, 1 ]\n > [ 1, 1, 1800, 1 ]\n\ndim=1 :( 3 4 )\n > [ 4, 400, 400, 16 ]\n > [ 10, 1000, 1000, 40 ]\n > [ 18, 1800, 1800, 72 ]\n\ndim=2 :( 2 4 )\n > [ 6, 6000, -6000, 48 ]\n > [ 120, 120000, -120000, 960 ]\n\ndim=3 :( 2 3 )\n > [ -200, -3200, -16200 ]\n > [ -51200, -125000, -259200 ]\n```\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**sum**(3)](#sum), note that an element by element multiplication is done\ndirectly using the star character.\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "RADIX": "## radix\n\n### **Name**\n\n**radix** - \\[NUMERIC MODEL\\] Base of a numeric model\n\n### **Synopsis**\n```fortran\n result = radix(x)\n```\n```fortran\n integer function radix(x)\n\n TYPE(kind=**),intent(in) :: x(..)\n```\n### **Characteristics**\n\n - **x** may be scalar or an array of any _real_ or _integer_ type.\n - the result is a default integer scalar.\n\n### **Description**\n\n **radix** returns the base of the internal model representing the\n numeric entity **x**.\n\n In a positional numeral system, the radix or base is the number of\n unique digits, including the digit zero, used to represent numbers.\n\n This function helps to represent the internal computing model\n generically, but will be 2 (representing a binary machine) for any\n common platform for all the numeric types.\n\n### **Options**\n\n- **x**\n : used to identify the type of number to query.\n\n### **Result**\n\n The returned value indicates what base is internally used to represent\n the type of numeric value **x** represents.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_radix\nimplicit none\n print *, \"The radix for the default integer kind is\", radix(0)\n print *, \"The radix for the default real kind is\", radix(0.0)\n print *, \"The radix for the doubleprecision real kind is\", radix(0.0d0)\nend program demo_radix\n```\nResults:\n```text\n > The radix for the default integer kind is 2\n > The radix for the default real kind is 2\n > The radix for the doubleprecision real kind is 2\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\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[**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", - "RANDOM_INIT": "## random_init\n\n### **Name**\n\n**random_init** - \\[MATHEMATICS:RANDOM\\] Initializes the state of\nthe pseudorandom number generator\n\n### **Synopsis**\n```fortran\n call random_init(repeatable, image_distinct)\n\n logical,intent(in) :: repeatable\n logical,intent(in) :: image_distinct\n```\n### **Characteristics**\n\n- **harvest** and **image_distinct** are logical scalars\n\n### Description\n\nInitializes the state of the pseudorandom number generator used by \n**random_number**.\n\n### **Options**\n\n**repeatable**\n: If it is **.true.**, the seed is set to a processor-dependent\nvalue that is the same each time **random_init** is called from the\nsame image. The term \"same image\" means a single instance of program\nexecution. The sequence of random numbers is different for repeated\nexecution of the program. \n\nIf it is **.false.**, the seed is set to a processor-dependent value.\n\n**image_distinct**\n: If is `.true.`, the seed is set to a processor-dependent value that\nis distinct from the seed set by a call to **random_init**in another\nimage. If it is **.false.**, the seed is set value that does depend\nwhich image called **random_init**.\n\n## **Standard**\n\nFortran 2018\n\n## **Example**\n```fortran\n program demo_random_init\n implicit none\n real x(3), y(3)\n call random_init(.true., .true.)\n call random_number(x)\n call random_init(.true., .true.)\n call random_number(y)\n ! x and y should be the same sequence\n if ( any(x /= y) ) stop \"x(:) and y(:) are not all equal\"\n end program demo_random_init\n```\n## **See also**\n\n[random_number](#random_number),\n[random_seed](random_seed)\n\n _fortran-lang intrinsic descriptions\n", + "RANDOM_INIT": "## random_init\n\n### **Name**\n\n**random_init** - \\[MATHEMATICS:RANDOM\\] Initializes the state of\nthe pseudorandom number generator\n\n### **Synopsis**\n```fortran\n call random_init(repeatable, image_distinct)\n\n logical,intent(in) :: repeatable\n logical,intent(in) :: image_distinct\n```\n### **Characteristics**\n\n- **harvest** and **image_distinct** are logical scalars\n\n### Description\n\nInitializes the state of the pseudorandom number generator used by \n**random_number**.\n\n### **Options**\n\n**repeatable**\n: If it is **.true.**, the seed is set to a processor-dependent\nvalue that is the same each time **random_init** is called from the\nsame image. The term \"same image\" means a single instance of program\nexecution. The sequence of random numbers is different for repeated\nexecution of the program. \n\nIf it is **.false.**, the seed is set to a processor-dependent value.\n\n**image_distinct**\n: If is `.true.`, the seed is set to a processor-dependent value that\nis distinct from the seed set by a call to **random_init**in another\nimage. If it is **.false.**, the seed is set value that does depend\nwhich image called **random_init**.\n\n\n### **Examples**\n\nSample program:\n\n```fortran\n program demo_random_init\n implicit none\n real x(3), y(3)\n call random_init(.true., .true.)\n call random_number(x)\n call random_init(.true., .true.)\n call random_number(y)\n ! x and y should be the same sequence\n if ( any(x /= y) ) stop \"x(:) and y(:) are not all equal\"\n end program demo_random_init\n```\n## **Standard**\n\nFortran 2018\n```\n## **See also**\n\n[random_number](#random_number),\n[random_seed](random_seed)\n\n _fortran-lang intrinsic descriptions\n", "RANDOM_NUMBER": "## random_number\n\n### **Name**\n\n**random_number** - \\[MATHEMATICS:RANDOM\\] Pseudo-random number\n\n### **Synopsis**\n```fortran\n call random_number(harvest)\n```\n```fortran\n subroutine random_number(harvest)\n\n real,intent(out) :: harvest(..)\n```\n### **Characteristics**\n\n- **harvest** and the result are default _real_ variables\n\n### **Description**\n\n**random_number** returns a single pseudorandom number or an array of\npseudorandom numbers from the uniform distribution over the range\n0 \\<= x \\< 1.\n\n### **Options**\n\n- **harvest**\n : Shall be a scalar or an array of type _real_.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_random_number\nuse, intrinsic :: iso_fortran_env, only : dp=>real64\nimplicit none\ninteger, allocatable :: seed(:)\ninteger :: n\ninteger :: first,last\ninteger :: i\ninteger :: rand_int\ninteger,allocatable :: count(:)\nreal(kind=dp) :: rand_val\n call random_seed(size = n)\n allocate(seed(n))\n call random_seed(get=seed)\n first=1\n last=10\n allocate(count(last-first+1))\n ! To have a discrete uniform distribution on the integers\n ! [first, first+1, ..., last-1, last] carve the continuous\n ! distribution up into last+1-first equal sized chunks,\n ! mapping each chunk to an integer.\n !\n ! One way is:\n ! call random_number(rand_val)\n ! choose one from last-first+1 integers\n ! rand_int = first + FLOOR((last+1-first)*rand_val)\n count=0\n ! generate a lot of random integers from 1 to 10 and count them.\n ! with a large number of values you should get about the same\n ! number of each value\n do i=1,100000000\n call random_number(rand_val)\n rand_int=first+floor((last+1-first)*rand_val)\n if(rand_int.ge.first.and.rand_int.le.last)then\n count(rand_int)=count(rand_int)+1\n else\n write(*,*)rand_int,' is out of range'\n endif\n enddo\n write(*,'(i0,1x,i0)')(i,count(i),i=1,size(count))\nend program demo_random_number\n```\nResults:\n```\n 1 10003588\n 2 10000104\n 3 10000169\n 4 9997996\n 5 9995349\n 6 10001304\n 7 10001909\n 8 9999133\n 9 10000252\n 10 10000196\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**random_seed**(3)](#random_seed)\n\n _fortran-lang intrinsic descriptions_\n", "RANDOM_SEED": "## random_seed\n\n### **Name**\n\n**random_seed** - \\[MATHEMATICS:RANDOM\\] Initialize a pseudo-random number sequence\n\n### **Synopsis**\n```fortran\n call random_seed( [size] [,put] [,get] )\n```\n```fortran\n subroutine random_seed( size, put, get )\n\n integer,intent(out),optional :: size\n integer,intent(in),optional :: put(*)\n integer,intent(out),optional :: get(*)\n```\n### **Characteristics**\n - **size** a scalar default _integer_\n - **put** a rank-one default _integer_ array\n - **get** a rank-one default _integer_ array\n - the result\n\n### **Description**\n\n**random_seed** restarts or queries the state of the pseudorandom\nnumber generator used by random_number.\n\nIf random_seed is called without arguments, it is seeded with random\ndata retrieved from the operating system.\n\n### **Options**\n\n- **size**\n : specifies the minimum size of the arrays used with the **put**\n and **get** arguments.\n\n- **put**\n : the size of the array must be larger than or equal to the number\n returned by the **size** argument.\n\n- **get**\n : It is **intent(out)** and the size of the array must be larger than\n or equal to the number returned by the **size** argument.\n\n### **Examples**\n\nSample program:\n\n```fortran\n program demo_random_seed\n implicit none\n integer, allocatable :: seed(:)\n integer :: n\n \n call random_seed(size = n)\n allocate(seed(n))\n call random_seed(get=seed)\n write (*, *) seed\n \n end program demo_random_seed\n```\nResults:\n```text\n -674862499 -1750483360 -183136071 -317862567 682500039\n 349459 344020729 -1725483289\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**random_number**(3)](#random_number)\n\n _fortran-lang intrinsic descriptions_\n", "RANGE": "## range\n\n### **Name**\n\n**range** - \\[NUMERIC MODEL\\] Decimal exponent range of a numeric kind\n\n### **Synopsis**\n```fortran\n result = range(x)\n```\n```fortran\n integer function range (x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be of type _integer_, _real_, or _complex_. It may be a scalar or an array.\n - **KIND** is any kind supported by the type of **x**\n - the result is a default _integer_ scalar\n\n### **Description**\n\n **range** returns the decimal exponent range in the model of the\n type of **x**.\n\n Since **x** is only used to determine the type and kind being\n interrogated, the value need not be defined.\n\n### **Options**\n\n- **x**\n : the value whose type and kind are used for the query\n\n### **Result**\n\n Case (i)\n : For an integer argument, the result has the value\n```fortran\n int (log10 (huge(x)))\n```\n Case (ii)\n : For a real argument, the result has the value\n```fortran\n int(min (log10 (huge(x)), -log10(tiny(x) )))\n ```\n Case (iii)\n : For a complex argument, the result has the value\n```fortran\n range(real(x))\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_range\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=sp) :: x(2)\ncomplex(kind=dp) :: y\n print *, precision(x), range(x)\n print *, precision(y), range(y)\nend program demo_range\n```\nResults:\n```text\n > 6 37\n > 15 307\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\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[**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", @@ -167,7 +167,7 @@ "RESHAPE": "\n\n## reshape\n\n### **Name**\n\n**reshape** - \\[ARRAY:RESHAPE\\] Function to reshape an array\n\n### **Synopsis**\n```fortran\n result = reshape( source, shape [,pad] [,order] )\n```\n```fortran\n type(TYPE(kind=KIND)) function reshape\n\n type(TYPE(kind=KIND)),intent(in) :: source(..)\n integer(kind=**),intent(in) :: shape(:)\n type(TYPE(kind=KIND)),intent(in),optional :: pad(..)\n integer(kind=**),intent(in),optional :: order(:)\n```\n### **Characteristics**\n\n - **source** is an array of any type\n - **shape** defines a Fortran shape and therefore an _integer_ vector\n (of rank one) of constant size of up to 16 non-negative values.\n - **pad** is the same type as **source**\n - **order** is the same shape as **shape**\n - The result is an array of shape **shape** with the same type as **source**.\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**reshape** constructs an array of arbitrary shape **shape** using the elements\nfrom **source** and possibly **pad** to fill it.\n\nIf necessary, the new array may be padded with elements from **pad**\nor permuted as defined by **order**.\n\nAmong many other uses, **reshape** can be used to reorder a Fortran array\nto match C array ordering before the array is passed from Fortran to a\nC procedure.\n\n### **Options**\n\n- **source**\n : an array containing the elements to be copied to the result.\n there must be enough elements in the source to fill the new shape\n if **pad** is omitted or has size zero. Expressed in Fortran ...\n```fortran\n if(.not.present(pad))then\n if(size(source) < product(shape))then\n stop 'not enough elements in the old array to fill the new one'\n endif\n endif\n```\n- **shape**\n : This is the shape of the new array being generated.\n Being by definition a shape; all elements are either positive integers\n or zero, the size but be 1 or greater, it may have up to 16 elements\n but must be of constant fixed size and rank one.\n\n- **pad**\n : used to fill in extra values if the result array is larger than **source**.\n It will be used repeatedly after all the elements of **source** have been\n placed in the result until the result has all elements assigned.\n : If it is absent or is a zero-sized array, you can only make\n **source** into another array of the same size as **source** or smaller.\n\n- **order**\n : used to insert elements in the result in an order other\n than the normal Fortran array element order, in which the first dimension\n varies fastest.\n : By definition of ranks the values have to be a permutation of the numbers\n from 1 to n, where n is the rank of **shape**.\n : the elements of **source** and pad are placed into the result in order;\n changing the left-most rank most rapidly by default. To change the order by\n which the elements are placed in the result use **order**.\n\n### **Result**\n\nThe result is an array of shape **shape** with the same type and type\nparameters as **source**. It is first filled with the values of elements\nof **source**, with the remainder filled with repeated copies of **pad**\nuntil all elements are filled. The new array may be smaller than\n**source**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_reshape\nimplicit none\n! notice the use of \"shape(box)\" on the RHS\ninteger :: box(3,4)=reshape([1,2,3,4,5,6,7,8,9,10,11,12],shape(box))\ninteger,allocatable :: v(:,:)\ninteger :: rc(2)\n ! basics0\n ! what is the current shape of the array?\n call printi('shape of box is ',box)\n ! change the shape\n call printi('reshaped ',reshape(box,[2,6]))\n call printi('reshaped ',reshape(box,[4,3]))\n\n ! fill in row column order using order\n v=reshape([1,2,3,4,10,20,30,40,100,200,300,400],[1,12])\n call printi('here is some data to shape',v)\n call printi('normally fills columns first ',reshape([v],[3,4]))\n call printi('fill rows first', reshape([v],[3,4],order=[2,1]))\n\n ! if we take the data and put in back in filling\n ! rows first instead of columns, and flipping the\n ! height and width of the box we not only fill in\n ! a vector using row-column order we actually\n ! transpose it.\n rc(2:1:-1)=shape(box)\n ! copy the data in changing column number fastest\n v=reshape(box,rc,order=[2,1])\n call printi('reshaped and reordered',v)\n ! of course we could have just done a transpose\n call printi('transposed',transpose(box))\n\n ! making the result bigger than source using pad\n v=reshape(box,rc*2,pad=[-1,-2,-3],order=[2,1])\n call printi('bigger and padded and reordered',v)\ncontains\n\nsubroutine printi(title,arr)\nimplicit none\n\n!@(#) print small 2d integer arrays in row-column format\n\ncharacter(len=*),parameter :: all='(*(g0,1x))' ! a handy format\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n print all\n print all, trim(title),':(',shape(arr),')' ! print title\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\nend subroutine printi\n\nend program demo_reshape\n```\nResults:\n```text\n shape of box is :( 3 4 )\n > [ 1, 4, 7, 10 ]\n > [ 2, 5, 8, 11 ]\n > [ 3, 6, 9, 12 ]\n\n reshaped :( 2 6 )\n > [ 1, 3, 5, 7, 9, 11 ]\n > [ 2, 4, 6, 8, 10, 12 ]\n\n reshaped :( 4 3 )\n > [ 1, 5, 9 ]\n > [ 2, 6, 10 ]\n > [ 3, 7, 11 ]\n > [ 4, 8, 12 ]\n\n here is some data to shape :( 1 12 )\n > [ 1, 2, 3, 4, 10, 20, 30, 40, 100, 200, 300, 400 ]\n\n normally fills columns first :( 3 4 )\n > [ 1, 4, 30, 200 ]\n > [ 2, 10, 40, 300 ]\n > [ 3, 20, 100, 400 ]\n\n fill rows first :( 3 4 )\n > [ 1, 2, 3, 4 ]\n > [ 10, 20, 30, 40 ]\n > [ 100, 200, 300, 400 ]\n\n reshaped and reordered :( 4 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n > [ 7, 8, 9 ]\n > [ 10, 11, 12 ]\n\n transposed :( 4 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n > [ 7, 8, 9 ]\n > [ 10, 11, 12 ]\n\n bigger and padded and reordered :( 8 6 )\n > [ 1, 2, 3, 4, 5, 6 ]\n > [ 7, 8, 9, 10, 11, 12 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**shape**(3)](#shape),\n[**pack**(3)](#pack),\n[**transpose**(3)](#transpose)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "RRSPACING": "## rrspacing\n\n### **Name**\n\n**rrspacing** - \\[MODEL_COMPONENTS\\] Reciprocal of the relative spacing of a numeric type\n\n### **Synopsis**\n```fortran\n result = rrspacing(x)\n```\n```fortran\n elemental real(kind=KIND) function rrspacing(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is type _real_ an any kind\n - The return value is of the same type and kind as **x**.\n\n### **Description**\n\n**rrspacing** returns the reciprocal of the relative spacing of model\nnumbers near **x**.\n\n\n\n### **Options**\n\n- **x**\n : Shall be of type _real_.\n\n### **Result**\n\n The return value is of the same type and kind as **x**. The value returned\n is equal to **abs(fraction(x)) \\* float(radix(x))\\*\\*digits(x)**.\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\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[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions_\n", "SAME_TYPE_AS": "## same_type_as\n\n### **Name**\n\n**same_type_as** - \\[STATE:INQUIRY\\] Query dynamic types for equality\n\n### **Synopsis**\n```fortran\n result = same_type_as(a, b)\n```\n```fortran\n logical same_type_as(a, b)\n\n type(TYPE(kind=KIND)),intent(in) :: a\n type(TYPE(kind=KIND)),intent(in) :: b\n```\n### **Characteristics**\n\n- **a** shall be an object of extensible declared type or unlimited\n polymorphic. If it is a polymorphic pointer, it shall not have\n an undefined association status.\n\n- **b** shall be an object of extensible declared type or unlimited\n polymorphic. If it is a polymorphic pointer, it shall not have\n an undefined association status.\n\n### **Description**\n\n**same_type_as** queries the dynamic types of objects for equality.\n\n### **Options**\n\n- **a**\n : object to compare to **b** for equality of type\n\n- **b**\n : object to be compared to for equality of type\n\n### **Result**\n\n If the dynamic type of **a** or **b** is extensible, the result is true\n if and only if the dynamic type of **a** is the same as the dynamic\n type of **b**. If neither **a** nor **b** has extensible dynamic type,\n the result is processor dependent.\n\n NOTE1\n\n The dynamic type of a disassociated pointer or unallocated allocatable\n variable is its declared type. An unlimited polymorphic entity has no\n declared type.\n\n NOTE2\n\n The test performed by SAME_TYPE_AS is not the same as the test performed\n by the type guard TYPE IS. The test performed by SAME_TYPE_AS does\n not consider kind type parameters.\n\nSample program:\n```fortran\n ! program demo_same_type_as\n module M_ether\n implicit none\n private\n\n type :: dot\n real :: x=0\n real :: y=0\n end type dot\n\n type, extends(dot) :: point\n real :: z=0\n end type point\n\n type something_else\n end type something_else\n\n public :: dot\n public :: point\n public :: something_else\n\n end module M_ether\n\n program demo_same_type_as\n use M_ether, only : dot, point, something_else\n implicit none\n type(dot) :: dad, mom\n type(point) :: me\n type(something_else) :: alien\n\n write(*,*)same_type_as(me,dad),'I am descended from Dad, but equal?'\n write(*,*)same_type_as(me,me) ,'I am what I am'\n write(*,*)same_type_as(dad,mom) ,'what a pair!'\n\n write(*,*)same_type_as(dad,me),'no paradox here'\n write(*,*)same_type_as(dad,alien),'no relation'\n\n call pointers()\n contains\n subroutine pointers()\n ! Given the declarations and assignments\n type t1\n real c\n end type\n type, extends(t1) :: t2\n end type\n class(t1), pointer :: p, q, r\n allocate (p, q)\n allocate (t2 :: r)\n ! the result of SAME_TYPE_AS (P, Q) will be true, and the result\n ! of SAME_TYPE_AS (P, R) will be false.\n write(*,*)'(P,Q)',same_type_as(p,q),\"mind your P's and Q's\"\n write(*,*)'(P,R)',same_type_as(p,r)\n end subroutine pointers\n\n end program demo_same_type_as\n```\nResults:\n```text\n F I am descended from Dad, but equal?\n T I am what I am\n T what a pair!\n F no paradox here\n F no relation\n (P,Q) T mind your P's and Q's\n (P,R) F\n```\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**extends_type_of**(3)](#extends_type_of)\n\n _fortran-lang intrinsic descriptions_\n", - "SCALE": "## scale\n\n### **Name**\n\n**scale** - \\[MODEL_COMPONENTS\\] Scale a real value by a whole power of the radix\n\n### **Synopsis**\n```fortran\n result = scale(x, i)\n```\n```fortran\n elemental real(kind=KIND) function scale(x, i)\n\n real(kind=KIND),intent(in) :: x\n integer(kind=**),intent(in) :: i\n```\n### **Characteristics**\n\n - **x** is type _real_ of any kind\n - **i** is type an _integer_ of any kind\n - the result is _real_ of the same kind as **x**\n\n### **Description**\n\n **scale** returns x \\* **radix(x)\\*\\*i**.\n\n It is almost certain the radix(base) of the platform is two, therefore\n **scale** is generally the same as **x*2\\*\\*i**\n\n### **Options**\n\n- **x**\n : the value to multiply by **radix(x)\\*\\*i**. Its type and kind is used\n to determine the radix for values with its characteristics and determines\n the characteristics of the result, so care must be taken the returned\n value is within the range of the characteristics of **x**.\n\n- **i**\n : The power to raise the radix of the machine to\n\n### **Result**\n\nThe return value is **x \\* radix(x)\\*\\*i**, assuming that value can be\nrepresented by a value of the type and kind of **x**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_scale\nimplicit none\nreal :: x = 178.1387e-4\ninteger :: i = 5\n print *, scale(x,i), x*radix(x)**i\nend program demo_scale\n```\nResults:\n```\n 0.570043862 0.570043862\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\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[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "SCALE": "## scale\n\n### **Name**\n\n**scale** - \\[MODEL_COMPONENTS\\] Scale a real value by a whole power of the radix\n\n### **Synopsis**\n```fortran\n result = scale(x, i)\n```\n```fortran\n elemental real(kind=KIND) function scale(x, i)\n\n real(kind=KIND),intent(in) :: x\n integer(kind=**),intent(in) :: i\n```\n### **Characteristics**\n\n - **x** is type _real_ of any kind\n - **i** is type an _integer_ of any kind\n - the result is _real_ of the same kind as **x**\n\n### **Description**\n\n **scale** returns x \\* **radix(x)\\*\\*i**.\n\n It is almost certain the radix(base) of the platform is two, therefore\n **scale** is generally the same as **x*2\\*\\*i**\n\n### **Options**\n\n- **x**\n : the value to multiply by **radix(x)\\*\\*i**. Its type and kind is used\n to determine the radix for values with its characteristics and determines\n the characteristics of the result, so care must be taken the returned\n value is within the range of the characteristics of **x**.\n\n- **i**\n : The power to raise the radix of the machine to\n\n### **Result**\n\nThe return value is **x \\* radix(x)\\*\\*i**, assuming that value can be\nrepresented by a value of the type and kind of **x**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_scale\nimplicit none\nreal :: x \ncomplex :: c\ninteger :: i\n x = 1.0\n print *, (scale(x,i),i=1,5)\n x = 3.0\n print *, (scale(x,i),i=1,5)\n print *, (scale(log(1.0),i),i=1,5)\n ! on modern machines radix(x) is almost certainly 2\n x = 178.1387e-4\n i = 5\n print *, x, i, scale(x, i), x*radix(x)**i\n ! x*radix(x)**i is the same except roundoff errors are not restricted\n i = 2\n print *, x, i, scale(x, i), x*radix(x)**i\n ! relatively easy to do complex values as well\n c=(3.0,4.0)\n print *, c, i, scale_complex(c, i)!, c*radix(c)**i\ncontains\n function scale_complex(x, n)\n ! example supporting complex value for default kinds\n complex, intent(in) :: x\n integer, intent(in) :: n\n complex :: scale_complex\n scale_complex = cmplx(scale(x%re, n), scale(x%im, n), kind=kind(x%im))\n end function scale_complex\nend program demo_scale\n```\nResults:\n```text\n > 2.00000000 4.00000000 8.00000000 16.0000000 32.0000000 \n > 6.00000000 12.0000000 24.0000000 48.0000000 96.0000000 \n > 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 \n > 1.78138707E-02 5 0.570043862 0.570043862 \n > 1.78138707E-02 2 7.12554827E-02 7.12554827E-02\n > (3.00000000,4.00000000) 2 (12.0000000,16.0000000)\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\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[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SCAN": "## scan\n\n### **Name**\n\n**scan** - \\[CHARACTER:SEARCH\\] Scan a string for the presence of a set of characters\n\n### **Synopsis**\n```fortran\n result = scan( string, set, [,back] [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function scan(string,set,back,kind)\n\n character(len=*,kind=**),intent(in) :: string\n character(len=*,kind=**),intent(in) :: set\n logical,intent(in),optional :: back\n integer,intent(in),optional :: kind\n```\n### **Characteristics**\n\n - **string** is a _character_ string of any kind\n - **set** must be a _character_ string with the same kind as **string**\n - **back** is a _logical_\n - **kind** is a scalar _integer_ constant expression\n - the result is an _integer_ with the kind specified by **kind**. If\n **kind** is not present the result is a default _integer_.\n\n### **Description**\n\n **scan** scans a **string** for any of the characters in a **set**\n of characters.\n\n If **back** is either absent or equals _.false._, this function\n returns the position of the leftmost character of **STRING** that is\n in **set**. If **back** equals _.true._, the rightmost position is\n returned. If no character of **set** is found in **string**, the result\n is zero.\n\n### **Options**\n\n- **string**\n : the string to be scanned\n\n- **set**\n : the set of characters which will be matched\n\n- **back**\n : if _.true._ the position of the rightmost character matched is\n returned, instead of the leftmost.\n\n- **kind**\n : the kind of the returned value is the same as **kind** if\n present. Otherwise a default _integer_ kind is returned.\n\n### **Result**\n\n If **back** is absent or is present with the value false and if\n **string** contains at least one character that is in **set**, the value\n of the result is the position of the leftmost character of **string**\n that is in **set**.\n\n If **back** is present with the value true and if **string** contains at\n least one character that is in **set**, the value of the result is the\n position of the rightmost character of **string** that is in **set**.\n\n The value of the result is zero if no character of STRING is in SET\n or if the length of STRING or SET is zero.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_scan\nimplicit none\n write(*,*) scan(\"fortran\", \"ao\") ! 2, found 'o'\n write(*,*) scan(\"fortran\", \"ao\", .true.) ! 6, found 'a'\n write(*,*) scan(\"fortran\", \"c++\") ! 0, found none\nend program demo_scan\n```\nResults:\n```text\n > 2\n > 6\n > 0\n```\n### **Standard**\n\nFortran 95 , with KIND argument - Fortran 2003\n\n### **See Also**\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl), [**adjustr**(3)](#adjustr), [**index**(3)](#index),\n [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len\\_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat), [**trim**(3)](#trim)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SELECTED_CHAR_KIND": "## selected_char_kind\n\n### **Name**\n\n**selected_char_kind** - \\[KIND\\] Select character kind such as \"Unicode\"\n\n### **Synopsis**\n```fortran\n result = selected_char_kind(name)\n```\n```fortran\n integer function selected_char_kind(name)\n\n character(len=*),intent(in) :: name\n```\n### **Characteristics**\n\n - **name** is a default _character_ scalar\n - the result is a default _integer_ scalar\n\n### **Description**\n\n **selected_char_kind** returns a kind parameter value for the\n character set named **name**.\n\n If a name is not supported, -1 is returned. Otherwise the result is a\n value equal to that kind type parameter value.\n\n The list of supported names is processor-dependent except for \"DEFAULT\".\n\n + If **name** has the value \"DEFAULT\", then the result has a value equal to\n that of the kind type parameter of default character. This name is\n always supported.\n\n + If **name** has the value \"ASCII\", then the result has a value equal\n to that of the kind type parameter of ASCII character.\n\n + If **name** has the value \"ISO_10646\", then the result has a value equal\n to that of the kind type parameter of the ISO 10646 character kind\n (corresponding to UCS-4 as specified in ISO/IEC 10646).\n\n + If **name** is a processor-defined name of some other character kind\n supported by the processor, then the result has a value equal to that\n kind type parameter value.\n Pre-defined names include \"ASCII\" and \"ISO_10646\".\n\n The NAME is interpreted without respect to case or trailing blanks.\n\n### **Options**\n\n- **name**\n : A name to query the processor-dependent kind value of, and/or to determine\n if supported. **name**, interpreted without respect to case or\n trailing blanks.\n\n Currently, supported character sets include \"ASCII\" and \"DEFAULT\" and\n \"ISO_10646\" (Universal Character Set, UCS-4) which is commonly known as\n \"Unicode\". Supported names other than \"DEFAULT\" are processor dependent.\n\n### **Result**\n\n\n### **Examples**\n\nSample program:\n\n```fortran\nLinux\nprogram demo_selected_char_kind\nuse iso_fortran_env\nimplicit none\n\nintrinsic date_and_time,selected_char_kind\n\n! set some aliases for common character kinds\n! as the numbers can vary from platform to platform\n\ninteger, parameter :: default = selected_char_kind (\"default\")\ninteger, parameter :: ascii = selected_char_kind (\"ascii\")\ninteger, parameter :: ucs4 = selected_char_kind ('ISO_10646')\ninteger, parameter :: utf8 = selected_char_kind ('utf-8')\n\n! assuming ASCII and UCS4 are supported (ie. not equal to -1)\n! define some string variables\ncharacter(len=26, kind=ascii ) :: alphabet\ncharacter(len=30, kind=ucs4 ) :: hello_world\ncharacter(len=30, kind=ucs4 ) :: string\n\n write(*,*)'ASCII ',&\n & merge('Supported ','Not Supported',ascii /= -1)\n write(*,*)'ISO_10646 ',&\n & merge('Supported ','Not Supported',ucs4 /= -1)\n write(*,*)'UTF-8 ',&\n & merge('Supported ','Not Supported',utf8 /= -1)\n\n if(default.eq.ascii)then\n write(*,*)'ASCII is the default on this processor'\n endif\n\n ! for constants the kind precedes the value, somewhat like a\n ! BOZ constant\n alphabet = ascii_\"abcdefghijklmnopqrstuvwxyz\"\n write (*,*) alphabet\n\n hello_world = ucs4_'Hello World and Ni Hao -- ' &\n // char (int (z'4F60'), ucs4) &\n // char (int (z'597D'), ucs4)\n\n ! an encoding option is required on OPEN for non-default I/O\n if(ucs4 /= -1 )then\n open (output_unit, encoding='UTF-8')\n write (*,*) trim (hello_world)\n else\n write (*,*) 'cannot use utf-8'\n endif\n\n call create_date_string(string)\n write (*,*) trim (string)\n\ncontains\n\n! The following produces a Japanese date stamp.\nsubroutine create_date_string(string)\nintrinsic date_and_time,selected_char_kind\ninteger,parameter :: ucs4 = selected_char_kind(\"ISO_10646\")\ncharacter(len=1,kind=ucs4),parameter :: &\n nen = char(int( z'5e74' ),ucs4), & ! year\n gatsu = char(int( z'6708' ),ucs4), & ! month\n nichi = char(int( z'65e5' ),ucs4) ! day\ncharacter(len= *, kind= ucs4) string\ninteger values(8)\n call date_and_time(values=values)\n write(string,101) values(1),nen,values(2),gatsu,values(3),nichi\n 101 format(*(i0,a))\nend subroutine create_date_string\n\nend program demo_selected_char_kind\n```\nResults:\n\nThe results are very processor-dependent\n```text\n > ASCII Supported\n > ISO_10646 Supported\n > UTF-8 Not Supported\n > ASCII is the default on this processor\n > abcdefghijklmnopqrstuvwxyz\n > Hello World and Ni Hao -- \u4f60\u597d\n > 2022\u5e7410\u670815\u65e5\n```\n### **Standard**\n\nFortran 2003\n\n### **See also**\n\n[**selected_int_kind**(3)](#selected_int_kind),\n[**selected_real_kind**(3)](#selected_real_kind)\n\n[**achar**(3)](#achar),\n[**char**(3)](#char),\n[**ichar**(3)](#ichar),\n[**iachar**(3)](#iachar)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SELECTED_INT_KIND": "## selected_int_kind\n\n### **Name**\n\n**selected_int_kind** - \\[KIND\\] Choose integer kind\n\n### **Synopsis**\n```fortran\n result = selected_int_kind(r)\n```\n```fortran\n integer function selected_int_kind(r)\n\n integer(kind=KIND),intent(in) :: r\n```\n### **Characteristics**\n\n - **r** is an _integer_ scalar.\n - the result is an default integer scalar.\n\n### **Description**\n\n **selected_int_kind** return the kind value of the smallest\n integer type that can represent all values ranging from **-10\\*\\*r**\n (exclusive) to **10\\*\\*r** (exclusive). If there is no integer kind\n that accommodates this range, selected_int_kind returns **-1**.\n\n### **Options**\n\n- **r**\n : The value specifies the required range of powers of ten that need\n supported by the kind type being returned.\n\n### **Result**\n\n The result has a value equal to the value of the kind type parameter\n of an integer type that represents all values in the requested range.\n\n if no such kind type parameter is available on the processor, the\n result is -1.\n\n If more than one kind type parameter meets the criterion, the value\n returned is the one with the smallest decimal exponent range, unless\n there are several such values, in which case the smallest of these\n kind values is returned.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_selected_int_kind\nimplicit none\ninteger,parameter :: k5 = selected_int_kind(5)\ninteger,parameter :: k15 = selected_int_kind(15)\ninteger(kind=k5) :: i5\ninteger(kind=k15) :: i15\n\n print *, huge(i5), huge(i15)\n\n ! the following inequalities are always true\n print *, huge(i5) >= 10_k5**5-1\n print *, huge(i15) >= 10_k15**15-1\nend program demo_selected_int_kind\n```\nResults:\n```text\n > 2147483647 9223372036854775807\n > T\n > T\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**nint**(3)](#nint),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n",