From 9dd49b3c4ed9481fdf82230fad517cecd8fdd900 Mon Sep 17 00:00:00 2001 From: gnikit Date: Thu, 8 Jun 2023 01:15:34 +0000 Subject: [PATCH] docs: update M_intrinsics --- fortls/intrinsic.procedures.markdown.json | 30 +++++++++++------------ 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/fortls/intrinsic.procedures.markdown.json b/fortls/intrinsic.procedures.markdown.json index 50d59ef2..b6070a13 100644 --- a/fortls/intrinsic.procedures.markdown.json +++ b/fortls/intrinsic.procedures.markdown.json @@ -7,7 +7,7 @@ "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", "AINT": "## aint\n\n### **Name**\n\n**aint** - \\[NUMERIC\\] Truncate toward zero to a whole number\n\n### **Synopsis**\n```fortran\n result = aint(x [,kind])\n```\n```fortran\n elemental real(kind=KIND) function iaint(x,KIND)\n\n real(kind=**),intent(in) :: x\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- the result is a real of the default kind unless **kind** is specified.\n- **kind** is an _integer_ initialization expression indicating the\n kind parameter of the result.\n\n### **Description**\n\n **aint** truncates its argument toward zero to a whole number.\n\n### **Options**\n\n- **x**\n : the _real_ value to truncate.\n\n- **kind**\n : indicates the kind parameter of the result.\n\n### **Result**\n\n The sign is the same as the sign of **x** unless the magnitude of **x**\n is less than one, in which case zero is returned.\n\n Otherwise **aint** returns the largest whole number that does not\n exceed the magnitude of **x** with the same sign as the input.\n\n That is, it truncates the value towards zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_aint\nuse, intrinsic :: iso_fortran_env, only : sp=>real32, dp=>real64\nimplicit none\nreal(kind=dp) :: x8\n print *,'basics:'\n print *,' just chops off the fractional part'\n print *, aint(-2.999), aint(-2.1111)\n print *,' if |x| < 1 a positive zero is returned'\n print *, aint(-0.999), aint( 0.9999)\n print *,' input may be of any real kind'\n x8 = 4.3210_dp\n print *, aint(-x8), aint(x8)\n print *,'elemental:'\n print *,aint([ &\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 ])\nend program demo_aint\n```\nResults:\n```text\n basics:\n just chops off the fractional part\n -2.000000 -2.000000\n if |x| < 1 a positive zero is returned\n 0.0000000E+00 0.0000000E+00\n input may be of any real kind\n -4.00000000000000 4.00000000000000\n elemental:\n -2.000000 -2.000000 -2.000000 -2.000000 -1.000000\n -1.000000 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.000000\n 1.000000 2.000000 2.000000 2.000000 2.000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**nint**(3)](#nint),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "ALL": "## all\n\n### **Name**\n\n**all** - \\[ARRAY:REDUCTION\\] Determines if all the values are true\n\n### **Synopsis**\n```fortran\n result = all(mask [,dim])\n```\n```fortran\n function all(mask ,dim)\n\n logical(kind=KIND),intent(in) :: mask(..)\n integer,intent(in),optional :: dim\n logical(kind=KIND) :: all(..)\n```\n### **Characteristics**\n\n - **mask** is a _logical_ array\n - **dim** is an _integer_\n - the result is a logical array if **dim** is supplied,\n otherwise it is a logical scalar. It has the same characteristics\n as **mask**\n\n### **Description**\n\n **all** determines if all the values are true in **mask** in the\n array along dimension **dim** if **dim** is specified; otherwise all\n elements are tested together.\n\n This testing type is called a logical conjunction of elements of\n **mask** along dimension **dim**.\n\n The mask is generally a _logical_ expression, allowing for comparing\n arrays and many other common operations.\n\n### **Options**\n\n- **mask**\n : the logical array to be tested for all elements being _.true_.\n\n- **dim**\n : **dim** indicates the direction through the elements of **mask**\n to group elements for testing.\n : **dim** has a value that lies between one and the rank of **mask**.\n : The corresponding actual argument shall not be an optional dummy\n argument.\n : If **dim** is not present all elements are tested and a single\n scalar value is returned.\n\n### **Result**\n\n\n1. If **dim** is not present **all(mask)** is _.true._ if all elements\n of **mask** are _.true._. It also is _.true._ if **mask** has zero size;\n otherwise, it is _.false._ .\n\n2. If the rank of **mask** is one, then **all(mask, dim)** is equivalent\n to **all(mask)**.\n\n3. If the rank of **mask** is greater than one and **dim** is present then\n **all(mask,dim)** returns an array with the rank (number of\n dimensions) of **mask** minus 1. The shape is determined from the\n shape of **mask** where the **dim** dimension is elided. A value is\n returned for each set of elements along the **dim** dimension.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_all\nimplicit none\nlogical,parameter :: T=.true., F=.false.\nlogical bool\n ! basic usage\n ! is everything true?\n bool = all([ T,T,T ])\n bool = all([ T,F,T ])\n print *, bool\n\n ! by a dimension\n ARRAYS: block\n integer :: a(2,3), b(2,3)\n ! set everything to one except one value in b\n a = 1\n b = 1\n b(2,2) = 2\n ! now compare those two arrays\n print *,'entire array :', all(a == b )\n print *,'compare columns:', all(a == b, dim=1)\n print *,'compare rows:', all(a == b, dim=2)\n end block ARRAYS\n\nend program demo_all\n```\nResults:\n```text\n > T\n > F\n > entire array : F\n > compare columns: T F T\n > compare rows: T F\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**any**(3)](#any)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "ALL": "## all\n\n### **Name**\n\n**all** - \\[ARRAY:REDUCTION\\] Determines if all the values are true\n\n### **Synopsis**\n```fortran\n result = all(mask [,dim])\n```\n```fortran\n function all(mask ,dim)\n\n logical(kind=KIND),intent(in) :: mask(..)\n integer,intent(in),optional :: dim\n logical(kind=KIND) :: all(..)\n```\n### **Characteristics**\n\n - **mask** is a _logical_ array\n - **dim** is an _integer_\n - the result is a logical array if **dim** is supplied,\n otherwise it is a logical scalar. It has the same characteristics\n as **mask**\n\n### **Description**\n\n **all** determines if all the values are true in **mask** in the\n array along dimension **dim** if **dim** is specified; otherwise all\n elements are tested together.\n\n This testing type is called a logical conjunction of elements of\n **mask** along dimension **dim**.\n\n The mask is generally a _logical_ expression, allowing for comparing\n arrays and many other common operations.\n\n### **Options**\n\n- **mask**\n : the logical array to be tested for all elements being _.true_.\n\n- **dim**\n : **dim** indicates the direction through the elements of **mask**\n to group elements for testing.\n : **dim** has a value that lies between one and the rank of **mask**.\n : The corresponding actual argument shall not be an optional dummy\n argument.\n : If **dim** is not present all elements are tested and a single\n scalar value is returned.\n\n### **Result**\n\n\n1. If **dim** is not present **all(mask)** is _.true._ if all elements\n of **mask** are _.true._. It also is _.true._ if **mask** has zero size;\n otherwise, it is _.false._ .\n\n2. If the rank of **mask** is one, then **all(mask, dim)** is equivalent\n to **all(mask)**.\n\n3. If the rank of **mask** is greater than one and **dim** is present then\n **all(mask,dim)** returns an array with the rank (number of\n dimensions) of **mask** minus 1. The shape is determined from the\n shape of **mask** where the **dim** dimension is elided. A value is\n returned for each set of elements along the **dim** dimension.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_all\nimplicit none\nlogical,parameter :: T=.true., F=.false.\nlogical bool\n\n ! basic usage\n ! is everything true?\n bool = all([ T,T,T ])\n print *, 'are all values true?', bool\n bool = all([ T,F,T ])\n print *, 'are all values true now?', bool\n\n ! compare matrices, even by a dimension\n ARRAYS: block\n integer :: a(2,3), b(2,3)\n ! set everything to one except one value in b\n a = 1\n b = 1\n b(2,2) = 2\n ! now compare those two arrays\n print *,'entire array :', all(a == b )\n print *,'compare columns:', all(a == b, dim=1)\n print *,'compare rows:', all(a == b, dim=2)\n end block ARRAYS\n\nend program demo_all\n```\nResults:\n```text\n > T\n > F\n > entire array : F\n > compare columns: T F T\n > compare rows: T F\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**any**(3)](#any)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ALLOCATED": "## allocated\n\n### **Name**\n\n**allocated** - \\[ARRAY:INQUIRY\\] Allocation status of an allocatable entity\n\n### **Synopsis**\n```fortran\n result = allocated(array|scalar)\n```\n```fortran\n logical function allocated(array,scalar)\n\n type(TYPE(kind=**)),allocatable,optional :: array(..)\n type(TYPE(kind=**)),allocatable,optional :: scalar\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **array** may be any allocatable array object of any type.\n - **scalar** may be any allocatable scalar of any type.\n - the result is a default logical scalar\n\n### **Description**\n\n **allocated** checks the allocation status of both arrays\n and scalars.\n\n At least one and only one of **array** or **scalar** must be specified.\n\n### **Options**\n\n- **entity**\n : the _allocatable_ object to test.\n\n### **Result**\n\n If the argument is allocated then the result is _.true._; otherwise,\n it returns _.false._.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_allocated\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=sp), allocatable :: x(:)\ncharacter(len=256) :: message\ninteger :: istat\n ! basics\n if( allocated(x)) then\n write(*,*)'do things if allocated'\n else\n write(*,*)'do things if not allocated'\n endif\n\n ! if already allocated, deallocate\n if ( allocated(x) ) deallocate(x,STAT=istat, ERRMSG=message )\n if(istat.ne.0)then\n write(*,*)trim(message)\n stop\n endif\n\n ! only if not allocated, allocate\n if ( .not. allocated(x) ) allocate(x(20))\n\n ! allocation and intent(out)\n call intentout(x)\n write(*,*)'note it is deallocated!',allocated(x)\n\n contains\n\n subroutine intentout(arr)\n ! note that if arr has intent(out) and is allocatable,\n ! arr is deallocated on entry\n real(kind=sp),intent(out),allocatable :: arr(:)\n write(*,*)'note it was allocated in calling program',allocated(arr)\n end subroutine intentout\n\nend program demo_allocated\n```\nResults:\n```text\n > do things if not allocated\n > note it was allocated in calling program F\n > note it is deallocated! F\n```\n### **Standard**\n\n Fortran 95. allocatable scalar entities were added in Fortran 2003.\n\n### **See Also**\n\n[**move_alloc**(3)](#move_alloc)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ANINT": "## anint\n\n### **Name**\n\n**anint** - \\[NUMERIC\\] Real nearest whole number\n\n### **Synopsis**\n```fortran\n result = anint(a [,kind])\n```\n```fortran\n elemental real(kind=KIND) function anint(x,KIND)\n\n real(kind=**),intent(in) :: x\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- **a** is type _real_ of any kind\n- **KIND** is a scalar integer constant expression.\n- the result is type _real_. The kind of the result is the same as **x**\n unless specified by **kind**.\n\n### **Description**\n\n **anint** rounds its argument to the nearest whole number.\n\n Unlike **nint**(3) which returns an _integer_ the full range or real\n values can be returned (_integer_ types typically have a smaller range\n of values than _real_ types).\n\n### **Options**\n\n- **a**\n : the value to round\n\n- **kind**\n : specifies the kind of the result. The default is the kind of **a**.\n\n### **Result**\n\nThe return value is the real whole number nearest **a**.\n\nIf **a** is greater than zero, **anint(a)**(3) returns **aint(a + 0.5)**.\n\nIf **a** is less than or equal to zero then it returns **aint(a - 0.5)**,\nexcept **aint** specifies that for |**a**| < 1 the result is zero (0).\n\nIt is processor-dependent whether anint(a) returns negative zero when\n-0.5 < a <= -0.0. Compiler switches are often available which enable\nor disable support of negative zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_anint\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal,allocatable :: arr(:)\n\n ! basics\n print *, 'ANINT (2.783) has the value 3.0 =>', anint(2.783)\n print *, 'ANINT (-2.783) has the value -3.0 =>', anint(-2.783)\n\n print *, 'by default the kind of the output is the kind of the input'\n print *, anint(1234567890.1234567890e0)\n print *, anint(1234567890.1234567890d0)\n\n print *, 'sometimes specifying the result kind is useful when passing'\n print *, 'results as an argument, for example.'\n print *, 'do you know why the results are different?'\n print *, anint(1234567890.1234567890,kind=real64)\n print *, anint(1234567890.1234567890d0,kind=real64)\n\n ! elemental\n print *, 'numbers on a cusp are always the most troublesome'\n print *, anint([ -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, 0.0 ])\n\n print *, 'negative zero is processor dependent'\n arr=[ 0.0, 0.1, 0.5, 1.0, 1.5, 2.0, 2.2, 2.5, 2.7 ]\n print *, anint(arr)\n arr=[ -0.0, -0.1, -0.5, -1.0, -1.5, -2.0, -2.2, -2.5, -2.7 ]\n print *, anint(arr)\n\nend program demo_anint\n```\nResults:\n```text\n > ANINT (2.783) has the value 3.0 => 3.000000\n > ANINT (-2.783) has the value -3.0 => -3.000000\n > by default the kind of the output is the kind of the input\n > 1.2345679E+09\n > 1234567890.00000\n > sometimes specifying the result kind is useful when passing\n > results as an argument, for example.\n > do you know why the results are different?\n > 1234567936.00000\n > 1234567890.00000\n > numbers on a cusp are always the most troublesome\n > -3.000000 -3.000000 -2.000000 -2.000000 -2.000000\n > -1.000000 -1.000000 0.0000000E+00\n > negative zero is processor dependent\n > 0.0000000E+00 0.0000000E+00 1.000000 1.000000 2.000000\n > 2.000000 2.000000 3.000000 3.000000\n > 0.0000000E+00 0.0000000E+00 -1.000000 -1.000000 -2.000000\n > -2.000000 -2.000000 -3.000000 -3.000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**int**(3)](#int),\n[**nint**(3)](#nint),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "ANY": "## any\n\n### **Name**\n\n**any** - \\[ARRAY:REDUCTION\\] Determines if any of the values in the logical array are _.true._\n\n### **Synopsis**\n```fortran\n result = any(mask [,dim])\n```\n```fortran\n function any(mask, dim)\n\n logical(kind=KIND),intent(in) :: mask(..)\n integer,intent(in),optional :: dim\n logical(kind=KIND) :: any(..)\n```\n### **Characteristics**\n\n- **mask** is a _logical_ array\n- **dim** is a scalar integer\n- the result is a logical array if **dim** is supplied,\n otherwise it is a logical scalar.\n\n### **Description**\n\n **any** determines if any of the values in the logical\n array **mask** along dimension **dim** are _.true._.\n\n### **Options**\n\n- **mask**\n : an array of _logical_ expressions or values to be tested in groups\n or in total for a _.true._ value.\n\n- **dim**\n : a whole number value that lies between one and **rank(mask)** that\n indicates to return an array of values along the indicated dimension\n instead of a scalar answer.\n\n### **Result**\n\n**any(mask)** returns a scalar value of type _logical_ where the kind type\nparameter is the same as the kind type parameter of **mask**. If **dim**\nis present, then **any(mask, dim)** returns an array with the rank of\n**mask** minus 1. The shape is determined from the shape of **mask**\nwhere the **dim** dimension is elided.\n\n1. **any(mask)** is _.true._ if any element of **mask** is _.true._;\n otherwise, it is _.false._. It also is _.false._ if **mask** has\n zero size.\n\n2. If the rank of **mask** is one, then **any(mask, dim)** is\n equivalent to **any(mask)**. If the rank is greater than one, then\n **any(mask, dim)** is determined by applying **any(mask)** to the\n array sections.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_any\nimplicit none\nlogical,parameter :: T=.true., F=.false.\ninteger :: a(2,3), b(2,3)\nlogical :: bool\n ! basic usage\n bool = any([F,F,T,F])\n print *,bool\n bool = any([F,F,F,F])\n print *,bool\n ! fill two integer arrays with values for testing\n a = 1\n b = 1\n b(:,2) = 2\n b(:,3) = 3\n ! using any(3) with logical expressions you can compare two arrays\n ! in a myriad of ways\n ! first, print where elements of b are bigger than in a\n call printl( 'first print b > a ', b > a )\n ! now use any() to test\n call printl( 'any true values? any(b > a) ', any(b > a ) )\n call printl( 'again by columns? any(b > a,1)', any(b > a, 1) )\n call printl( 'again by rows? any(b > a,2)', any(b > a, 2) )\ncontains\n! CONVENIENCE ROUTINE. this is not specific to ANY()\nsubroutine printl(title,a)\nuse, intrinsic :: iso_fortran_env, only : &\n & stderr=>ERROR_UNIT,&\n & stdin=>INPUT_UNIT,&\n & stdout=>OUTPUT_UNIT\nimplicit none\n\n!@(#) print small 2d logical scalar, vector, or matrix\n\ncharacter(len=*),parameter :: all='(*(g0,1x))'\ncharacter(len=*),parameter :: row='(\" > [ \",*(l1:,\",\"))'\ncharacter(len=*),intent(in) :: title\nlogical,intent(in) :: a(..)\ninteger :: i\n write(*,*)\n write(*,all,advance='no')trim(title),&\n & ' : shape=',shape(a),',rank=',rank(a),',size=',size(a)\n ! get size and shape of input\n select rank(a)\n rank (0); write(*,'(a)')'(a scalar)'\n write(*,fmt=row,advance='no')a\n write(*,'(\" ]\")')\n rank (1); write(*,'(a)')'(a vector)'\n do i=1,size(a)\n write(*,fmt=row,advance='no')a(i)\n write(*,'(\" ]\")')\n enddo\n rank (2); write(*,'(a)')'(a matrix) '\n do i=1,size(a,dim=1)\n write(*,fmt=row,advance='no')a(i,:)\n write(*,'(\" ]\")')\n enddo\n rank default\n write(stderr,*)'*printl* did not expect rank=', rank(a), &\n & 'shape=', shape(a),'size=',size(a)\n stop '*printl* unexpected rank'\n end select\n\nend subroutine printl\n\nend program demo_any\n```\nResults:\n```text\n > T\n > F\n >\n > first print b > a : shape=23,rank=2,size=6(a matrix)\n > > [ F,T,T ]\n > > [ F,T,T ]\n >\n > any true values? any(b > a) : shape=,rank=0,size=1(a scalar)\n > > [ T ]\n >\n > again by columns? any(b > a,1) : shape=3,rank=1,size=3(a vector)\n > > [ F ]\n > > [ T ]\n > > [ T ]\n >\n > again by rows? any(b > a,2) : shape=2,rank=1,size=2(a vector)\n > > [ T ]\n > > [ T ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**all**(3)](#all)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -39,9 +39,9 @@ "BIT_SIZE": "## bit_size\n\n### **Name**\n\n**bit_size** - \\[BIT:INQUIRY\\] Bit size inquiry function\n\n### **Synopsis**\n```fortran\n result = bit_size(i)\n```\n```fortran\n integer(kind=KIND) function bit_size(i)\n\n integer(kind=KIND),intent(in) :: i(..)\n```\n### **Characteristics**\n\n - **i** shall be of type integer. It may be a scalar or an array.\n - the value of **KIND** is any valid value for an _integer_ kind\n parameter on the processor.\n - the return value is a scalar of the same kind as the input value.\n\n### **Description**\n\n **bit_size** returns the number of bits (integer precision plus\n sign bit) represented by the type of the _integer_ **i**.\n\n### **Options**\n\n- **i**\n : An _integer_ value of any kind whose size in bits is to be determined.\n Because only the type of the argument is examined, the argument need not\n be defined; **i** can be a scalar or an array, but a scalar representing\n just a single element is always returned.\n\n### **Result**\n\nThe number of bits used to represent a value of the type and kind\nof _i_. The result is a _integer_ scalar of the same kind as _i_.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_bit_size\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nuse,intrinsic :: iso_fortran_env, only : integer_kinds\nimplicit none\ncharacter(len=*),parameter :: fmt=&\n& '(a,\": bit size is \",i3,\" which is kind=\",i3,\" on this platform\")'\n\n ! default integer bit size on this platform\n write(*,fmt) \"default\", bit_size(0), kind(0)\n\n write(*,fmt) \"int8 \", bit_size(0_int8), kind(0_int8)\n write(*,fmt) \"int16 \", bit_size(0_int16), kind(0_int16)\n write(*,fmt) \"int32 \", bit_size(0_int32), kind(0_int32)\n write(*,fmt) \"int64 \", bit_size(0_int64), kind(0_int64)\n\n write(*,'(a,*(i0:,\", \"))') \"The available kinds are \",integer_kinds\n\nend program demo_bit_size\n```\nTypical Results:\n```text\n default: bit size is 32 which is kind= 4 on this platform\n int8 : bit size is 8 which is kind= 1 on this platform\n int16 : bit size is 16 which is kind= 2 on this platform\n int32 : bit size is 32 which is kind= 4 on this platform\n int64 : bit size is 64 which is kind= 8 on this platform\n The available kinds are 1, 2, 4, 8, 16\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[****(3)](#)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "BLE": "## ble\n\n### **Name**\n\n**ble** - \\[BIT:COMPARE\\] Bitwise less than or equal to\n\n### **Synopsis**\n```fortran\n result = ble(i,j)\n```\n```fortran\n elemental logical function ble(i, j)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: j\n```\n### **Characteristics**\n\n - **i** and **j** may be of any supported _integer_ kind, not\n necessarily the same. An exception is that values may be a\n BOZ constant with a value valid for the _integer_ kind available with\n the most bits on the current platform.\n - the returned value is a logical scalar of default kind\n\n### **Description**\n\n **ble** determines whether an integer is bitwise less than or\n equal to another, assuming any shorter value is padded on the left\n with zeros to the length of the longer value.\n\n### **Options**\n\n- **i**\n : the value to compare **j** to\n\n- **j**\n : the value to be tested for being less than or equal to **i**\n\n### **Result**\n\nThe return value is _.true._ if any bit in **j** is less than any bit\nin **i** starting with the rightmost bit and continuing tests leftward.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ble\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i\ninteger(kind=int8) :: byte\n ! Compare some one-byte values to 64.\n ! Notice that the values are tested as bits not as integers\n ! so sign bits in the integer are treated just like any other\n do i=-128,127,32\n byte=i\n write(*,'(sp,i0.4,*(1x,1l,1x,b0.8))')i,ble(byte,64_int8),byte\n write(*,'(sp,i0.4,*(4x,b0.8))')64_int8,64_int8\n enddo\n\n ! see the BGE() description for an extended description\n ! of related information\n\nend program demo_ble\n```\nResults:\n```text\n -0128 F 10000000\n +0064 01000000\n -0096 F 10100000\n +0064 01000000\n -0064 F 11000000\n +0064 01000000\n -0032 F 11100000\n +0064 01000000\n +0000 T 00000000\n +0064 01000000\n +0032 T 00100000\n +0064 01000000\n +0064 T 01000000\n +0064 01000000\n +0096 F 01100000\n +0064 01000000\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bge**(3)](#bge),\n[**bgt**(3)](#bgt),\n[**blt**(3)](#blt)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "BLT": "## blt\n\n### **Name**\n\n**blt** - \\[BIT:COMPARE\\] Bitwise less than\n\n### **Synopsis**\n```fortran\n result = blt(i,j)\n```\n```fortran\n elemental logical function blt(i, j)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: j\n```\n### **Characteristics**\n\n - **i** is an _integer_ of any kind or a BOZ-literal-constant\n - **j** is an _integer_ of any kind or a BOZ-literal-constant, not\n necessarily the same as **i**.\n - the result is of default logical kind\n\n BOZ constants must have a value valid for the _integer_ kind available\n with the most bits on the current platform.\n\n### **Description**\n\n **blt** determines whether an _integer_ is bitwise less than another.\n\n\n### **Options**\n\n- **i**\n : Shall be of _integer_ type or a BOZ literal constant.\n\n- **j**\n : Shall be of _integer_ type or a BOZ constant.\n\n### **Result**\n\nThe return value is of type _logical_ and of the default kind.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_blt\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i\ninteger(kind=int8) :: byte\n ! Compare some one-byte values to 64.\n ! Notice that the values are tested as bits not as integers\n ! so sign bits in the integer are treated just like any other\n do i=-128,127,32\n byte=i\n write(*,'(sp,i0.4,*(1x,1l,1x,b0.8))')i,blt(byte,64_int8),byte\n enddo\n ! BOZ literals\n write(*,*)blt(z'1000', z'101011010')\n ! see the BGE() description for an extended description\n ! of related information\n\nend program demo_blt\n```\nResults:\n```text\n > -0128 F 10000000\n > -0096 F 10100000\n > -0064 F 11000000\n > -0032 F 11100000\n > +0000 T 00000000\n > +0032 T 00100000\n > +0064 F 01000000\n > +0096 F 01100000\n > T\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bge**(3)](#bge),\n[**bgt**(3)](#bgt),\n[**ble**(3)](#ble)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "BTEST": "## btest\n\n### **Name**\n\n**btest** - \\[BIT:INQUIRY\\] Tests a bit of an _integer_ value.\n\n### **Synopsis**\n```fortran\n result = btest(i,pos)\n```\n```fortran\n elemental logical function btest(i,pos)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n```\n### **Characteristics**\n\n - **i** is an _integer_ of any kind\n - **pos** is a _integer_ of any kind\n - the result is a default logical\n\n### **Description**\n\n **btest** returns logical _.true._ if the bit at **pos** in **i** is\n set to 1. Position zero is the right-most bit. Bit position increases\n from right to left up to **bitsize(i)-1**.\n\n### **Options**\n\n- **i**\n : The _integer_ containing the bit to be tested\n\n- **pos**\n : The position of the bit to query. it must be a valid position for the\n value **i**; ie. **0 <= pos <= bit_size(i)**.\n\n### **Result**\n\n The result is a _logical_ that has the value _.true._ if bit position\n **pos** of **i** has the value **1** and the value _.false._ if bit\n **pos** of **i** has the value **0**.\n\n Positions of bits in the sequence are numbered from right to left,\n with the position of the rightmost bit being zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_btest\nimplicit none\ninteger :: i, j, pos, a(2,2)\nlogical :: bool\ncharacter(len=*),parameter :: g='(*(g0))'\n\n i = 32768 + 1024 + 64\n write(*,'(a,i0,\"=>\",b32.32,/)')'Looking at the integer: ',i\n\n ! looking one bit at a time from LOW BIT TO HIGH BIT\n write(*,g)'from bit 0 to bit ',bit_size(i),'==>'\n do pos=0,bit_size(i)-1\n bool = btest(i, pos)\n write(*,'(l1)',advance='no')bool\n enddo\n write(*,*)\n\n ! a binary format the hard way.\n ! Note going from bit_size(i) to zero.\n write(*,*)\n write(*,g)'so for ',i,' with a bit size of ',bit_size(i)\n write(*,'(b32.32)')i\n write(*,g)merge('^','_',[(btest(i,j),j=bit_size(i)-1,0,-1)])\n write(*,*)\n write(*,g)'and for ',-i,' with a bit size of ',bit_size(i)\n write(*,'(b32.32)')-i\n write(*,g)merge('^','_',[(btest(-i,j),j=bit_size(i)-1,0,-1)])\n\n ! elemental:\n !\n a(1,:)=[ 1, 2 ]\n a(2,:)=[ 3, 4 ]\n write(*,*)\n write(*,'(a,/,*(i2,1x,i2,/))')'given the array a ...',a\n ! the second bit of all the values in a\n write(*,'(a,/,*(l2,1x,l2,/))')'the value of btest (a, 2)',btest(a,2)\n ! bits 1,2,3,4 of the value 2\n write(*,'(a,/,*(l2,1x,l2,/))')'the value of btest (2, a)',btest(2,a)\nend program demo_btest\n```\nResults:\n```text\n > Looking at the integer: 33856=>11111111111111110111101111000000\n >\n > 00000000000000001000010001000000\n > 11111111111111110111101111000000\n > 1000010001000000\n > 11111111111111110111101111000000\n > from bit 0 to bit 32==>\n > FFFFFFTFFFTFFFFTFFFFFFFFFFFFFFFF\n >\n > so for 33856 with a bit size of 32\n > 00000000000000001000010001000000\n > ________________^____^___^______\n >\n > and for -33856 with a bit size of 32\n > 11111111111111110111101111000000\n > ^^^^^^^^^^^^^^^^_^^^^_^^^^______\n >\n > given the array a ...\n > 1 3\n > 2 4\n >\n > the value of btest (a, 2)\n > F F\n > F T\n >\n > the value of btest (2, a)\n > T F\n > F F\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ieor**(3)](#ieor),\n[**ibclr**(3)](#ibclr),\n[**not**(3)](#not),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**iand**(3)](#iand),\n[**ior**(3)](#ior),\n[**ieor**(3)](#ieor),\n[**mvbits**(3)](#mvbits)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "BTEST": "## btest\n\n### **Name**\n\n**btest** - \\[BIT:INQUIRY\\] Tests a bit of an _integer_ value.\n\n### **Synopsis**\n```fortran\n result = btest(i,pos)\n```\n```fortran\n elemental logical function btest(i,pos)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n```\n### **Characteristics**\n\n - **i** is an _integer_ of any kind\n - **pos** is a _integer_ of any kind\n - the result is a default logical\n\n### **Description**\n\n **btest** returns logical _.true._ if the bit at **pos** in **i** is\n set to 1. Position zero is the right-most bit. Bit position increases\n from right to left up to **bitsize(i)-1**.\n\n### **Options**\n\n- **i**\n : The _integer_ containing the bit to be tested\n\n- **pos**\n : The position of the bit to query. it must be a valid position for the\n value **i**; ie. **0 <= pos <= bit_size(i)**.\n\n### **Result**\n\n The result is a _logical_ that has the value _.true._ if bit position\n **pos** of **i** has the value **1** and the value _.false._ if bit\n **pos** of **i** has the value **0**.\n\n Positions of bits in the sequence are numbered from right to left,\n with the position of the rightmost bit being zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_btest\nimplicit none\ninteger :: i, j, pos, a(2,2)\nlogical :: bool\ncharacter(len=*),parameter :: g='(*(g0))'\n\n i = 32768 + 1024 + 64\n write(*,'(a,i0,\"=>\",b32.32,/)')'Looking at the integer: ',i\n\n ! looking one bit at a time from LOW BIT TO HIGH BIT\n write(*,g)'from bit 0 to bit ',bit_size(i),'==>'\n do pos=0,bit_size(i)-1\n bool = btest(i, pos)\n write(*,'(l1)',advance='no')bool\n enddo\n write(*,*)\n\n ! a binary format the hard way.\n ! Note going from bit_size(i) to zero.\n write(*,*)\n write(*,g)'so for ',i,' with a bit size of ',bit_size(i)\n write(*,'(b32.32)')i\n write(*,g)merge('^','_',[(btest(i,j),j=bit_size(i)-1,0,-1)])\n write(*,*)\n write(*,g)'and for ',-i,' with a bit size of ',bit_size(i)\n write(*,'(b32.32)')-i\n write(*,g)merge('^','_',[(btest(-i,j),j=bit_size(i)-1,0,-1)])\n\n ! elemental:\n !\n a(1,:)=[ 1, 2 ]\n a(2,:)=[ 3, 4 ]\n write(*,*)\n write(*,'(a,/,*(i2,1x,i2,/))')'given the array a ...',a\n ! the second bit of all the values in a\n write(*,'(a,/,*(l2,1x,l2,/))')'the value of btest (a, 2)',btest(a,2)\n ! bits 1,2,3,4 of the value 2\n write(*,'(a,/,*(l2,1x,l2,/))')'the value of btest (2, a)',btest(2,a)\nend program demo_btest\n```\nResults:\n```text\n > Looking at the integer: 33856=>11111111111111110111101111000000\n >\n > 00000000000000001000010001000000\n > 11111111111111110111101111000000\n > 1000010001000000\n > 11111111111111110111101111000000\n > from bit 0 to bit 32==>\n > FFFFFFTFFFTFFFFTFFFFFFFFFFFFFFFF\n >\n > so for 33856 with a bit size of 32\n > 00000000000000001000010001000000\n > ________________^____^___^______\n >\n > and for -33856 with a bit size of 32\n > 11111111111111110111101111000000\n > ^^^^^^^^^^^^^^^^_^^^^_^^^^______\n >\n > given the array a ...\n > 1 3\n > 2 4\n >\n > the value of btest (a, 2)\n > F F\n > F T\n >\n > the value of btest (2, a)\n > T F\n > F F\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**iand**(3)](#iand),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "CEILING": "## ceiling\n\n### **Name**\n\n**ceiling** - \\[NUMERIC\\] Integer ceiling function\n\n### **Synopsis**\n```fortran\n result = ceiling(a [,kind])\n```\n```fortran\n elemental integer(KIND) function ceiling(a,KIND)\n\n real(kind=**),intent(in) :: a\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - ** a is of type _real_\n - **KIND** shall be a scalar integer constant expression.\n It specifies the kind of the result if present.\n - the result is _integer_. It is default kind if **KIND** is not\n specified\n\n### **Description**\n\n **ceiling** returns the least integer greater than or equal to **a**.\n\n On the number line -n <-- 0 -> +n the value returned is always at or\n to the right of the input value.\n\n### **Options**\n\n- **a**\n : A _real_ value to produce a ceiling for.\n\n- **kind**\n : indicates the kind parameter of the result.\n\n### **Result**\n\n The result will be the _integer_ value equal to **a** or the least\n integer greater than **a** if the input value is not equal to a\n whole number.\n\n If **a** is equal to a whole number, the returned value is **int(a)**.\n\n The result is undefined if it cannot be represented in the specified\n _integer_ type.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_ceiling\nimplicit none\n! just a convenient format for a list of integers\ncharacter(len=*),parameter :: ints='(*(\" > \",5(i0:,\",\",1x),/))'\nreal :: x\nreal :: y\n ! basic usage\n x = 63.29\n y = -63.59\n print ints, ceiling(x)\n print ints, ceiling(y)\n ! note the result was the next integer larger to the right\n\n ! real values equal to whole numbers\n x = 63.0\n y = -63.0\n print ints, ceiling(x)\n print ints, ceiling(y)\n\n ! elemental (so an array argument is allowed)\n print ints , &\n & ceiling([ &\n & -2.7, -2.5, -2.2, -2.0, -1.5, &\n & -1.0, -0.5, 0.0, +0.5, +1.0, &\n & +1.5, +2.0, +2.2, +2.5, +2.7 ])\n\nend program demo_ceiling\n```\nResults:\n```text\n > 64\n > -63\n > 63\n > -63\n > -2, -2, -2, -2, -1,\n > -1, 0, 0, 1, 1,\n > 2, 2, 3, 3, 3\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**floor**(3)](#floor),\n[**nint**(3)](#nint)\n\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", - "CHAR": "## char\n\n### **Name**\n\n**char** - \\[CHARACTER\\] Generate a character from a code value\n\n### **Synopsis**\n```fortran\n result = char(i [,kind])\n```\n```fortran\n elemental character(kind=KIND) function char(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 - **i** is an _integer_ of any kind\n - **kind** is an _integer_ initialization expression indicating the kind\n parameter of the result.\n - The returned value is a character with the kind specified by **kind**\n or if **kind** is not present, the default _character_ kind.\n\n### **Description**\n Generates a _character_ value given a numeric code representing the\n position **i** in the collating sequence associated with the specified\n kind **kind**.\n\n Note that **achar**(3) is a similar function specifically for ASCII\n characters that is preferred when only ASCII is being processed,\n which is equivalent to **char(i,kind=selected_char_kind(\"ascii\") )**\n\n The **ichar**(3) function is the reverse of **char**, converting\n characters to their collating sequence value.\n\n\n\n### **Options**\n\n- **i**\n : a value in the range **0 <= I <= n-1**, where **n** is the number of characters\n in the collating sequence associated with the specified kind type parameter.\n : For ASCII, **n** is 127. The default character set may or may not allow higher\n values.\n\n- **kind**\n : A constant _integer_ initialization expression indicating the kind\n parameter of the result. If not present, the default kind is assumed.\n\n### **Result**\n\nThe return value is a single _character_ of the specified kind, determined by the\nposition of **i** in the collating sequence associated with the specified **kind**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_char\nimplicit none\ninteger, parameter :: ascii = selected_char_kind (\"ascii\")\ncharacter(len=1, kind=ascii ) :: c\ninteger :: i\n ! basic\n i=74\n c=char(i)\n write(*,*)'ASCII character ',i,'is ',c\n !\n print *, 'a selection of ASCII characters (shows hex if not printable)'\n do i=0,127,10\n c = char(i,kind=ascii)\n select case(i)\n case(32:126)\n write(*,'(i3,1x,a)')i,c\n case(0:31,127)\n ! print hexadecimal value for unprintable characters\n write(*,'(i3,1x,z2.2)')i,c\n case default\n write(*,'(i3,1x,a,1x,a)')i,c,'non-standard ASCII'\n end select\n enddo\n\nend program demo_char\n```\n Results:\n```text\n ASCII character 74 is J\n a selection of ASCII characters (shows hex if not printable)\n 0 00\n 10 0A\n 20 14\n 30 1E\n 40 (\n 50 2\n 60 <\n 70 F\n 80 P\n 90 Z\n 100 d\n 110 n\n 120 x\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**achar**(3)](#achar),\n[**iachar**(3)](#iachar),\n[**ichar**(3)](#ichar)\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 [**scan**(3)](#scan), [**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", + "CHAR": "## char\n\n### **Name**\n\n**char** - \\[CHARACTER\\] Generate a character from a code value\n\n### **Synopsis**\n```fortran\n result = char(i [,kind])\n```\n```fortran\n elemental character(kind=KIND) function char(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 - **i** is an _integer_ of any kind\n - **kind** is an _integer_ initialization expression indicating the kind\n parameter of the result.\n - The returned value is a character with the kind specified by **kind**\n or if **kind** is not present, the default _character_ kind.\n\n### **Description**\n Generates a _character_ value given a numeric code representing the\n position **i** in the collating sequence associated with the specified\n kind **kind**.\n\n Note that **achar**(3) is a similar function specifically for ASCII\n characters that is preferred when only ASCII is being processed,\n which is equivalent to **char(i,kind=selected_char_kind(\"ascii\") )**\n\n The **ichar**(3) function is the reverse of **char**, converting\n characters to their collating sequence value.\n\n\n\n### **Options**\n\n- **i**\n : a value in the range **0 <= I <= n-1**, where **n** is the number of characters\n in the collating sequence associated with the specified kind type parameter.\n : For ASCII, **n** is 127. The default character set may or may not allow higher\n values.\n\n- **kind**\n : A constant _integer_ initialization expression indicating the kind\n parameter of the result. If not present, the default kind is assumed.\n\n### **Result**\n\nThe return value is a single _character_ of the specified kind, determined by the\nposition of **i** in the collating sequence associated with the specified **kind**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_char\nimplicit none\ninteger, parameter :: ascii = selected_char_kind (\"ascii\")\ncharacter(len=1, kind=ascii ) :: c\ninteger :: i\n ! basic\n i=74\n c=char(i)\n write(*,*)'ASCII character ',i,'is ',c\n !\n print *, 'a selection of ASCII characters (shows hex if not printable)'\n do i=0,127,10\n c = char(i,kind=ascii)\n select case(i)\n case(32:126)\n write(*,'(i3,1x,a)')i,c\n case(0:31,127)\n ! print hexadecimal value for unprintable characters\n write(*,'(i3,1x,z2.2)')i,c\n case default\n write(*,'(i3,1x,a,1x,a)')i,c,'non-standard ASCII'\n end select\n enddo\n\nend program demo_char\n```\nResults:\n```text\n ASCII character 74 is J\n a selection of ASCII characters (shows hex if not printable)\n 0 00\n 10 0A\n 20 14\n 30 1E\n 40 (\n 50 2\n 60 <\n 70 F\n 80 P\n 90 Z\n 100 d\n 110 n\n 120 x\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**achar**(3)](#achar),\n[**iachar**(3)](#iachar),\n[**ichar**(3)](#ichar)\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 [**scan**(3)](#scan), [**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", "CMPLX": "## cmplx\n\n### **Name**\n\n**cmplx** - \\[TYPE:NUMERIC\\] Conversion to a complex type\n\n### **Synopsis**\n```fortran\n result = cmplx(x [,kind]) | cmplx(x [,y] [,kind])\n```\n```fortran\n elemental complex(kind=KIND) function cmplx( x, y, kind )\n\n type(TYPE(kind=**)),intent(in) :: x\n type(TYPE(kind=**)),intent(in),optional :: y\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- **x** may be _integer_, _real_, or _complex_.\n- **y** may be _integer_ or _real_.\n **y** is allowed only if **x** is not _complex_.\n- **KIND** is a constant _integer_ initialization expression indicating the kind\n parameter of the result.\n\nThe type of the arguments does not affect the kind of the result except\nfor a _complex_ **x** value.\n\n- if **kind** is not present and **x** is _complex_ the result is of the kind\n of **x**.\n\n- if **kind** is not present and **x** is not _complex_ the result if of default\n _complex_ kind.\n\nNOTE: a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\nThe **cmplx** function converts numeric values to a _complex_ value.\n\nEven though constants can be used to define a complex variable using syntax like\n```fortran\n z = (1.23456789, 9.87654321)\n```\nthis will not work for variables. So you cannot enter\n```fortran\n z = (a, b) ! NO ! (unless a and b are constants, not variables)\n```\nso to construct a _complex_ value using non-complex values you must use\nthe **cmplx** function:\n```fortran\n z = cmplx(a, b)\n```\nor assign values separately to the imaginary and real components using\nthe **%IM** and **%RE** designators:\n```fortran\n z%re = a\n z%im = b\n```\nIf **x** is complex **y** is not allowed and **cmplx** essentially\nreturns the input value except for an optional change of kind, which can be\nuseful when passing a value to a procedure that requires the arguments\nto have a different kind (and does not return an altered value):\n```fortran\n call something(cmplx(z,kind=real64))\n```\nwould pass a copy of a value with kind=real64 even if z had a different kind\n\nbut otherwise is equivalent to a simple assign. So if z1 and z2 were _complex_:\n```fortran\n z2 = z1 ! equivalent statements\n z2 = cmplx(z1)\n```\nIf **x** is not _complex_ **x** is only used to define the real component\nof the result but **y** is still optional -- the imaginary part of the\nresult will just be assigned a value of zero.\n\nIf **y** is present it is converted to the imaginary component.\n\n#### **cmplx(3) and double precision**\n\nPrimarily in order to maintain upward compatibility you need to be careful\nwhen working with complex values of higher precision that the default.\n\nIt was necessary for Fortran to continue to specify that **cmplx**\nalways return a result of the default kind if the **kind** option\nis absent, since that is the behavior mandated by FORTRAN 77.\n\nIt might have been preferable to use the highest precision of the\narguments for determining the return kind, but that is not the case. So\nwith arguments with greater precision than default values you are\nrequired to use the **kind** argument or the greater precision values\nwill be reduced to default precision.\n\nThis means **cmplx(d1,d2)**, where **d1** and **d2** are\n_doubleprecision_, is treated as:\n```fortran\n cmplx(sngl(d1), sngl(d2))\n```\nwhich looses precision.\n\nSo Fortran 90 extends the **cmplx** intrinsic by adding an extra\nargument used to specify the desired kind of the complex result.\n\n```fortran\n integer,parameter :: dp=kind(0.0d0)\n complex(kind=dp) :: z8\n ! wrong ways to specify constant values\n ! note this was stored with default real precision !\n z8 = cmplx(1.2345678901234567d0, 1.2345678901234567d0)\n print *, 'NO, Z8=',z8,real(z8),aimag(z8)\n\n z8 = cmplx(1.2345678901234567e0_dp, 1.2345678901234567e0_dp)\n ! again, note output components are just real\n print *, 'NO, Z8=',z8,real(z8),aimag(z8)\n !\n ! YES\n !\n ! kind= makes it work\n z8 = cmplx(1.2345678901234567d0, 1.2345678901234567d0,kind=dp)\n print *, 'YES, Z8=',z8,real(z8),aimag(z8)\n```\nA more recent alternative to using **cmplx** is \"F2018 component\nsyntax\" where real and imaginary parts of a complex entity can be\naccessed independently:\n\n```fortran\nvalue%RE ! %RE specifies the real part\nor\nvalue%IM ! %IM specifies the imaginary part\n\n```\nWhere the designator value is of course of complex type.\n\nThe type of a complex-part-designator is _real_, and its kind and shape\nare those of the designator. That is, you retain the precision of the\ncomplex value by default, unlike with **cmplx**.\n\nThe following are examples of complex part designators:\n\n```fortran\n impedance%re !-- Same value as real(impedance)\n fft%im !-- Same value as AIMAG(fft)\n x%im = 0.0 !-- Sets the imaginary part of x to zero\n x(1:2)%re=[10,20] !-- even if x is an array\n```\n\n#### NOTE for I/O\n Note that if format statements are specified a complex value is\n treated as two real values.\n\n For list-directed I/O (ie. using an asterisk for a format) and NAMELIST\n output the values are expected to be delimited by \"(\" and \")\" and of\n the form \"(real_part,imaginary_part)\". For NAMELIST input parenthesized\n values or lists of multiple _real_ values are acceptable.\n\n### **Options**\n\n- **x**\n : The value assigned to the _real_ component of the result when **x** is\n not complex.\n\n If **x** is complex, the result is the same as if the real part of the\n input was passed as **x** and the imaginary part as **y**.\n```fortran\n result = CMPLX (REAL (X), AIMAG (X), KIND).\n```\n That is, a complex **x** value is copied to the result value with a\n possible change of kind.\n\n- **y**\n : **y** is only allowed if **x** is not _complex_. Its value\n is assigned to the imaginary component of the result and defaults\n to a value of zero if absent.\n\n- **kind**\n : An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\nThe return value is of _complex_ type, with magnitudes determined by the\nvalues **x** and **y**.\n\nThe common case when **x** is not complex is that the real\ncomponent of the result is assigned the value of **x** and the imaginary\npart is zero or the value of **y** if **y** is present.\n\nWhen **x** is complex **y** is not allowed and the result is the same\nvalue as **x** with a possible change of kind. That is, the real part\nis **real(x, kind)** and the imaginary part is **real(y, kind)**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_aimag\nimplicit none\ninteger,parameter :: dp=kind(0.0d0)\nreal(kind=dp) :: precise\ncomplex(kind=dp) :: z8\ncomplex :: z4, zthree(3)\n precise=1.2345678901234567d0\n\n ! basic\n z4 = cmplx(-3)\n print *, 'Z4=',z4\n z4 = cmplx(1.23456789, 1.23456789)\n print *, 'Z4=',z4\n ! with a format treat a complex as two real values\n print '(1x,g0,1x,g0,1x,g0)','Z4=',z4\n\n ! working with higher precision values\n ! using kind=dp makes it keep DOUBLEPRECISION precision\n ! otherwise the result would be of default kind\n z8 = cmplx(precise, -precise )\n print *, 'lost precision Z8=',z8\n z8 = cmplx(precise, -precise ,kind=dp)\n print *, 'kept precision Z8=',z8\n\n ! assignment of constant values does not require cmplx(3)00\n ! The following is intuitive and works without calling cmplx(3)\n ! but does not work for variables just constants\n z8 = (1.1111111111111111d0, 2.2222222222222222d0 )\n print *, 'Z8 defined with constants=',z8\n\n ! what happens when you assign a complex to a real?\n precise=z8\n print *, 'LHS=',precise,'RHS=',z8\n\n ! elemental\n zthree=cmplx([10,20,30],-1)\n print *, 'zthree=',zthree\n\n ! descriptors are an alternative\n zthree(1:2)%re=[100,200]\n print *, 'zthree=',zthree\n\nend program demo_aimag\n```\nResults:\n```text\n Z4= (-3.000000,0.0000000E+00)\n Z4= (1.234568,1.234568)\n Z4= 1.234568 1.234568\n lost precision Z8= (1.23456788063049,-1.23456788063049)\n kept precision Z8= (1.23456789012346,-1.23456789012346)\n Z8 defined with constants= (1.11111111111111,2.22222222222222)\n LHS= 1.11111111111111 RHS= (1.11111111111111,2.22222222222222)\n zthree= (10.00000,-1.000000) (20.00000,-1.000000) (30.00000,-1.000000)\n zthree= (100.0000,-1.000000) (200.0000,-1.000000) (30.00000,-1.000000)\n```\n### **Standard**\n\nFORTRAN 77, KIND added in Fortran 90.\n\n### **See Also**\n\n- [**aimag**(3)](#aimag) - Imaginary part of complex number\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", "COMMAND_ARGUMENT_COUNT": "## command_argument_count\n\n### **Name**\n\n**command_argument_count** - \\[SYSTEM:COMMAND LINE\\] Get number of command line arguments\n\n### **Synopsis**\n```fortran\n result = command_argument_count()\n```\n```fortran\n integer function command_argument_count()\n```\n### **Characteristics**\n\n - the result is of default integer scalar.\n\n### **Description**\n\n**command_argument_count** returns the number of arguments passed\non the command line when the containing program was invoked.\n\n### **Options**\n\nNone\n\n### **Result**\n\n : The return value is of type default _integer_. It is the number of\n arguments passed on the command line when the program was invoked.\n\n If there are no command arguments available or if the processor does\n not support command arguments, then the result has the value zero.\n\n If the processor has a concept of a command name, the command name\n does not count as one of the command arguments.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_command_argument_count\nimplicit none\ninteger :: count\n count = command_argument_count()\n print *, count\nend program demo_command_argument_count\n```\nSample output:\n\n```bash\n # the command verb does not count\n ./test_command_argument_count\n 0\n # quoted strings may count as one argument\n ./test_command_argument_count count arguments\n 2\n ./test_command_argument_count 'count arguments'\n 1\n```\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**get_command**(3)](#get_command),\n[**get_command_argument**(3)](#get_command_argument)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "COMPILER_OPTIONS": "## compiler_options\n\n### **Name**\n\n**compiler_options** - \\[COMPILER:INQUIRY\\] Options passed to the compiler\n\n### **Synopsis**\n```fortran\n result = compiler_options()\n```\n```fortran\n character(len=:) function compiler_options()\n```\n### **Characteristics**\n\n - the return value is a default-kind _character_ variable with\n system-dependent length.\n\n### **Description**\n\n **compiler_options** returns a string with the options used for\n compiling.\n\n### **Options**\n\n None.\n\n### **Result**\n\n The result contains the compiler flags used to compile the file\n containing the **compiler_options** call.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_compiler_version\nuse, intrinsic :: iso_fortran_env, only : compiler_version\nuse, intrinsic :: iso_fortran_env, only : compiler_options\nimplicit none\n print '(4a)', &\n 'This file was compiled by ', &\n compiler_version(), &\n ' using the options ', &\n compiler_options()\nend program demo_compiler_version\n```\nResults:\n```text\nThis file was compiled by GCC version 10.3.0 using\nthe options -I build/gfortran_2A42023B310FA28D\n-mtune=generic -march=x86-64 -auxbase-strip\nbuild/gfortran_2A42023B310FA28D/compiler_options/app_main.f90.o\n-g -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1\n-fcheck=bounds -fcheck=array-temps -fbacktrace\n-fcoarray=single -J build/gfortran_2A42023B310FA28D\n-fpre-include=/usr/include/finclude/math-vector-fortran.h\n\nThis file was compiled by nvfortran 21.5-0 LLVM\nusing the options app/main.f90 -c -Minform=inform\n-Mbackslash -Mbounds -Mchkptr -Mchkstk -traceback -module\nbuild/nvfortran_78229DCE997517A4 -Ibuild/nvfortran_78229DCE997517A4 -o\nbuild/nvfortran_78229DCE997517A4/compiler_options/app_main.f90.o\n\nThis file was compiled by Intel(R) Fortran Intel(R) 64 Compiler Classic\nfor applications running on Intel(R) 64, Version 2021.3.0 Build\n20210609_000000 using the options -Ibuild/ifort_5C58216731706F11\n-c -warn all -check all -error-limit 1 -O0 -g -assume\nbyterecl -traceback -module build/ifort_5C58216731706F11 -o\nbuild/ifort_5C58216731706F11/compiler_options/app_main.f90.o\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**compiler_version**(3)](#compiler_version),\n**iso_fortran_env**(7)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -49,7 +49,7 @@ "CONJG": "## conjg\n\n### **Name**\n\n**conjg** - \\[NUMERIC\\] Complex conjugate of a complex value\n\n### **Synopsis**\n```fortran\n result = conjg(z)\n```\n```fortran\n elemental complex(kind=KIND) function conjg(z)\n\n complex(kind=**),intent(in) :: z\n```\n### **Characteristics**\n\n- **z** is a _complex_ value of any valid kind.\n- The returned value has the same _complex_ type as the input.\n\n### **Description**\n\n**conjg** returns the complex conjugate of the _complex_ value **z**.\n\nThat is, If **z** is the _complex_ value **(x, y)** then the result is\n**(x, -y)**.\n\nIn mathematics, the complex conjugate of a complex number is a value\nwhose real and imaginary part are equal parts are equal in magnitude to\neach other but the **y** value has opposite sign.\n\nFor matrices of complex numbers, **conjg(array)** represents the\nelement-by-element conjugation of **array**; not the conjugate transpose\nof the **array** .\n\n### **Options**\n\n- **z**\n : The value to create the conjugate of.\n\n### **Result**\n\nReturns a value equal to the input value except the sign of\nthe imaginary component is the opposite of the input value.\n\nThat is, if **z** has the value **(x,y)**, the result has the value\n**(x, -y)**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_conjg\nuse, intrinsic :: iso_fortran_env, only : real_kinds, &\n& real32, real64, real128\nimplicit none\ncomplex :: z = (2.0, 3.0)\ncomplex(kind=real64) :: dz = ( &\n & 1.2345678901234567_real64, -1.2345678901234567_real64)\ncomplex :: arr(3,3)\ninteger :: i\n ! basics\n ! notice the sine of the imaginary component changes\n print *, z, conjg(z)\n\n ! any complex kind is supported. z is of default kind but\n ! dz is kind=real64.\n print *, dz\n dz = conjg(dz)\n print *, dz\n print *\n\n ! the function is elemental so it can take arrays\n arr(1,:)=[(-1.0, 2.0),( 3.0, 4.0),( 5.0,-6.0)]\n arr(2,:)=[( 7.0,-8.0),( 8.0, 9.0),( 9.0, 9.0)]\n arr(3,:)=[( 1.0, 9.0),( 2.0, 0.0),(-3.0,-7.0)]\n\n write(*,*)'original'\n write(*,'(3(\"(\",g8.2,\",\",g8.2,\")\",1x))')(arr(i,:),i=1,3)\n arr = conjg(arr)\n write(*,*)'conjugate'\n write(*,'(3(\"(\",g8.2,\",\",g8.2,\")\",1x))')(arr(i,:),i=1,3)\n\nend program demo_conjg\n```\nResults:\n```fortran\n > (2.000000,3.000000) (2.000000,-3.000000)\n >\n > (1.23456789012346,-1.23456789012346)\n > (1.23456789012346,1.23456789012346)\n >\n > original\n > (-1.0 , 2.0 ) ( 3.0 , 4.0 ) ( 5.0 ,-6.0 )\n > ( 7.0 ,-8.0 ) ( 8.0 , 9.0 ) ( 9.0 , 9.0 )\n > ( 1.0 , 9.0 ) ( 2.0 , 0.0 ) (-3.0 ,-7.0 )\n >\n > conjugate\n > (-1.0 ,-2.0 ) ( 3.0 ,-4.0 ) ( 5.0 , 6.0 )\n > ( 7.0 , 8.0 ) ( 8.0 ,-9.0 ) ( 9.0 ,-9.0 )\n > ( 1.0 ,-9.0 ) ( 2.0 , 0.0 ) (-3.0 , 7.0 )\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n- [**aimag**(3)](#aimag) - Imaginary part of complex number\n- [**cmplx**(3)](#cmplx) - Complex conversion 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", "COS": "## cos\n\n### **Name**\n\n**cos** - \\[MATHEMATICS:TRIGONOMETRIC\\] Cosine function\n\n### **Synopsis**\n```fortran\n result = cos(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function cos(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is of type _real_ or _complex_ of any valid kind.\n - **KIND** may be any kind supported by the associated type of **x**.\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n **cos** computes the cosine of an angle **x** given the size of\n the angle in radians.\n\n The cosine of a _real_ value is the ratio of the adjacent side to the\n hypotenuse of a right-angled triangle.\n\n### **Options**\n\n- **x**\n : The angle in radians to compute the cosine of.\n\n### **Result**\n\n The return value is the tangent of **x**.\n\n If **x** is of the type _real_, the return value is in radians and lies in\n the range **-1 \\<= cos(x) \\<= 1** .\n\n If **x** is of type complex, its real part is regarded as a value in\n radians, often called the phase.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_cos\nimplicit none\ncharacter(len=*),parameter :: g2='(a,t20,g0)'\ndoubleprecision,parameter :: PI=atan(1.0d0)*4.0d0\n write(*,g2)'COS(0.0)=',cos(0.0)\n write(*,g2)'COS(PI)=',cos(PI)\n write(*,g2)'COS(PI/2.0d0)=',cos(PI/2.0d0),'EPSILON=',epsilon(PI)\n write(*,g2)'COS(2*PI)=',cos(2*PI)\n write(*,g2)'COS(-2*PI)=',cos(-2*PI)\n write(*,g2)'COS(-2000*PI)=',cos(-2000*PI)\n write(*,g2)'COS(3000*PI)=',cos(3000*PI)\nend program demo_cos\n```\nResults:\n```text\n > COS(0.0)= 1.000000\n > COS(PI)= -1.000000000000000\n > COS(PI/2.0d0)= .6123233995736766E-16\n > EPSILON= .2220446049250313E-15\n > COS(2*PI)= 1.000000000000000\n > COS(-2*PI)= 1.000000000000000\n > COS(-2000*PI)= 1.000000000000000\n > COS(3000*PI)= 1.000000000000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**acos**(3)](#acos),\n[**sin**(3)](#sin),\n[**tan**(3)](#tan)\n\n### **Resources**\n\n- [Wikipedia:sine and cosine](https://en.wikipedia.org/wiki/Sine_and_cosine)\n\n _fortran-lang intrinsic descriptions_\n", "COSH": "## cosh\n\n### **Name**\n\n**cosh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Hyperbolic cosine function\n\n### **Synopsis**\n```fortran\n result = cosh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function cosh(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_ of any kind.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**cosh** computes the hyperbolic cosine of **x**.\n\nIf **x** is of type complex its imaginary part is regarded as a value\nin radians.\n\n### **Options**\n\n- **x**\n : the value to compute the hyperbolic cosine of\n\n### **Result**\n\n If **x** is _complex_, the imaginary part of the result is in radians.\n\n If **x** is _real_, the return value has a lower bound of one,\n **cosh(x) \\>= 1**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_cosh\nuse, intrinsic :: iso_fortran_env, only : &\n & real_kinds, real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 1.0_real64\n write(*,*)'X=',x,'COSH(X=)',cosh(x)\nend program demo_cosh\n```\nResults:\n```text\n > X= 1.00000000000000 COSH(X=) 1.54308063481524\n```\n### **Standard**\n\nFORTRAN 77 , for a complex argument - Fortran 2008\n\n### **See Also**\n\nInverse function: [**acosh**(3)](#acosh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _fortran-lang intrinsic descriptions_\n", - "COUNT": "## count\n\n### **Name**\n\n**count** - \\[ARRAY:REDUCTION\\] Count true values in an array\n\n### **Synopsis**\n```fortran\n result = count(mask [,dim] [,kind] )\n```\n```fortran\n integer(kind=KIND) function count(mask, dim, KIND )\n\n logical(kind=**),intent(in) :: mask(..)\n integer(kind=**),intent(in),optional :: dim\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 - **mask** is a _logical_ array of any shape and kind.\n - If **dim** is present, the result is an array with the specified rank\n removed.\n - **KIND** is a scalar integer constant expression valid as an _integer_ kind\n - The return value is of default _integer_ type unless **kind** is specified\n to declare the kind of the result.\n\n### **Description**\n\n **count** counts the number of _.true._ elements in a logical\n **mask**, or, if the **dim** argument is supplied, counts the number\n of elements along each row of the array in the **dim** direction. If\n the array has zero size or all of the elements of **mask** are false,\n then the result is **0**.\n\n### **Options**\n\n- **mask**\n : an array to count the number of _.true._ values in\n\n- **dim**\n : specifies to remove this dimension from the result and produce an\n array of counts of _.true._ values along the removed dimension.\n If not present, the result is a scalar count of the true elements in **mask**\n the value must be in the range 1 <= dim <= n, where n is the\n rank(number of dimensions) of **mask**.\n\n The corresponding actual argument shall not be an optional dummy\n argument, a disassociated pointer, or an unallocated allocatable.\n\n- **kind**\n : An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\n The return value is the number of _.true_. values in **mask** if **dim**\n is not present.\n\n If **dim** is present, the result is an array with a rank one less\n than the rank of the input array **mask**, and a size corresponding\n to the shape of **array** with the **dim** dimension removed, with the\n remaining elements containing the number of _.true._ elements along the\n removed dimension.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_count\nimplicit none\ncharacter(len=*),parameter :: ints='(*(i2,1x))'\n! two arrays and a mask all with the same shape\ninteger, dimension(2,3) :: a, b\nlogical, dimension(2,3) :: mymask\ninteger :: i\ninteger :: c(2,3,4)\n\nprint *,'the numeric arrays we will compare'\na = reshape( [ 1, 2, 3, 4, 5, 6 ], [ 2, 3 ])\nb = reshape( [ 0, 7, 3, 4, 5, 8 ], [ 2, 3 ])\nc = reshape( [( i,i=1,24)], [ 2, 3 ,4])\nprint '(3i3)', a(1,:)\nprint '(3i3)', a(2,:)\nprint *\nprint '(3i3)', b(1,:)\nprint '(3i3)', b(2,:)\n!\n! basic calls\nprint *, 'count a few basic things creating a mask from an expression'\nprint *, 'count a>b',count(a>b)\nprint *, 'count b the numeric arrays we will compare\n > 1 3 5\n > 2 4 6\n >\n > 0 3 5\n > 7 4 8\n > count a few basic things creating a mask from an expression\n > count a>b 1\n > count b count b==a 3\n > check sum = T\n > make a mask identifying unequal elements ...\n > the mask generated from a.ne.b\n > T F F\n > T F T\n > count total and along rows and columns ...\n > number of elements not equal\n > (ie. total true elements in the mask)\n > 3\n > count of elements not equal in each column\n > (ie. total true elements in each column)\n > 2 0 1\n > count of elements not equal in each row\n > (ie. total true elements in each row)\n > 1 2\n > lets try this with c(2,3,4)\n > taking the result of the modulo\n > z=1 z=2 z=3 z=4\n > 1 3 0 || 2 4 1 || 3 0 2 || 4 1 3 |\n > 2 4 1 || 3 0 2 || 4 1 3 || 0 2 4 |\n >\n > would result in the mask ..\n > F F T || F F F || F T F || F F F |\n > F F F || F T F || F F F || T F F |\n >\n > the total number of .true.values is\n > 4\n >\n > counting up along a row and removing rows :( 3 4 )\n > > [ 0, 0, 0, 1 ]\n > > [ 0, 1, 1, 0 ]\n > > [ 1, 0, 0, 0 ]\n >\n > counting up along a column and removing columns :( 2 4 )\n > > [ 1, 0, 1, 0 ]\n > > [ 0, 1, 0, 1 ]\n >\n > counting up along a depth and removing depths :( 2 3 )\n > > [ 0, 1, 1 ]\n > > [ 1, 1, 0 ]\n```\n### **Standard**\n\nFortran 95 , with KIND argument - Fortran 2003\n\n### **See Also**\n\n[**any**(3)](#any),\n[**all**(3)](#all),\n[**sum**(3)](#sum),\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "COUNT": "## count\n\n### **Name**\n\n**count** - \\[ARRAY:REDUCTION\\] Count true values in an array\n\n### **Synopsis**\n```fortran\n result = count(mask [,dim] [,kind] )\n```\n```fortran\n integer(kind=KIND) function count(mask, dim, KIND )\n\n logical(kind=**),intent(in) :: mask(..)\n integer(kind=**),intent(in),optional :: dim\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 - **mask** is a _logical_ array of any shape and kind.\n - If **dim** is present, the result is an array with the specified rank\n removed.\n - **KIND** is a scalar integer constant expression valid as an _integer_ kind\n - The return value is of default _integer_ type unless **kind** is specified\n to declare the kind of the result.\n\n### **Description**\n\n **count** counts the number of _.true._ elements in a logical\n **mask**, or, if the **dim** argument is supplied, counts the number\n of elements along each row of the array in the **dim** direction. If\n the array has zero size or all of the elements of **mask** are false,\n then the result is **0**.\n\n### **Options**\n\n- **mask**\n : an array to count the number of _.true._ values in\n\n- **dim**\n : specifies to remove this dimension from the result and produce an\n array of counts of _.true._ values along the removed dimension.\n If not present, the result is a scalar count of the true elements in **mask**\n the value must be in the range 1 <= dim <= n, where n is the\n rank(number of dimensions) of **mask**.\n\n The corresponding actual argument shall not be an optional dummy\n argument, a disassociated pointer, or an unallocated allocatable.\n\n- **kind**\n : An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\n The return value is the number of _.true_. values in **mask** if **dim**\n is not present.\n\n If **dim** is present, the result is an array with a rank one less\n than the rank of the input array **mask**, and a size corresponding\n to the shape of **array** with the **dim** dimension removed, with the\n remaining elements containing the number of _.true._ elements along the\n removed dimension.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_count\nimplicit none\ncharacter(len=*),parameter :: ints='(*(i2,1x))'\n! two arrays and a mask all with the same shape\ninteger, dimension(2,3) :: a, b\nlogical, dimension(2,3) :: mymask\ninteger :: i\ninteger :: c(2,3,4)\n\nprint *,'the numeric arrays we will compare'\na = reshape( [ 1, 2, 3, 4, 5, 6 ], [ 2, 3 ])\nb = reshape( [ 0, 7, 3, 4, 5, 8 ], [ 2, 3 ])\nc = reshape( [( i,i=1,24)], [ 2, 3 ,4])\nprint '(3i3)', a(1,:)\nprint '(3i3)', a(2,:)\nprint *\nprint '(3i3)', b(1,:)\nprint '(3i3)', b(2,:)\n!\n! basic calls\nprint *, 'count a few basic things creating a mask from an expression'\nprint *, 'count a>b',count(a>b)\nprint *, 'count b the numeric arrays we will compare\n > 1 3 5\n > 2 4 6\n >\n > 0 3 5\n > 7 4 8\n > count a few basic things creating a mask from an expression\n > count a>b 1\n > count b count b==a 3\n > check sum = T\n > make a mask identifying unequal elements ...\n > the mask generated from a.ne.b\n > T F F\n > T F T\n > count total and along rows and columns ...\n > number of elements not equal\n > (ie. total true elements in the mask)\n > 3\n > count of elements not equal in each column\n > (ie. total true elements in each column)\n > 2 0 1\n > count of elements not equal in each row\n > (ie. total true elements in each row)\n > 1 2\n > lets try this with c(2,3,4)\n > taking the result of the modulo\n > z=1 z=2 z=3 z=4\n > 1 3 0 || 2 4 1 || 3 0 2 || 4 1 3 |\n > 2 4 1 || 3 0 2 || 4 1 3 || 0 2 4 |\n >\n > would result in the mask ..\n > F F T || F F F || F T F || F F F |\n > F F F || F T F || F F F || T F F |\n >\n > the total number of .true.values is\n > 4\n >\n > counting up along a row and removing rows :( 3 4 )\n > > [ 0, 0, 0, 1 ]\n > > [ 0, 1, 1, 0 ]\n > > [ 1, 0, 0, 0 ]\n >\n > counting up along a column and removing columns :( 2 4 )\n > > [ 1, 0, 1, 0 ]\n > > [ 0, 1, 0, 1 ]\n >\n > counting up along a depth and removing depths :( 2 3 )\n > > [ 0, 1, 1 ]\n > > [ 1, 1, 0 ]\n```\n### **Standard**\n\nFortran 95 , with KIND argument - Fortran 2003\n\n### **See Also**\n\n[**any**(3)](#any),\n[**all**(3)](#all),\n[**sum**(3)](#sum),\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "CO_BROADCAST": "## co_broadcast\n\n### **Name**\n\n**co_broadcast** - \\[COLLECTIVE\\] Copy a value to all images the current set of images\n\n### **Synopsis**\n```fortran\n call co_broadcast(a, source_image [,stat] [,errmsg] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**co_broadcast** copies the value of argument **a** on the image with image\nindex source_image to all images in the current team. **a** becomes defined\nas if by intrinsic assignment. If the execution was successful and **stat**\nis present, it is assigned the value zero. If the execution failed, **stat**\ngets assigned a nonzero value and, if present, **errmsg** gets assigned a\nvalue describing the occurred error.\n\n### **Options**\n\n- **a**\n : **intent(inout)** argument; shall have the same dynamic type and\n type parameters on all images of the current team. If it is an\n array, it shall have the same shape on all images.\n\n- **source_image**\n : a scalar integer expression. It shall have the same the same value\n on all images and refer to an image of the current team.\n\n- **stat**\n : (optional) a scalar integer variable\n\n- **errmsg**\n : (optional) a scalar character variable\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_co_broadcast\nimplicit none\ninteger :: val(3)\n if (this_image() == 1) then\n val = [1, 5, 3]\n endif\n call co_broadcast (val, source_image=1)\n print *, this_image(), \":\", val\nend program demo_co_broadcast\n```\n### **Standard**\n\nFortran xx\n\n### **See Also**\n\n[**co_max**(3)](#co_max),\n[**co_min**(3)](#co_min),\n[**co_sum**(3)](#co_sum),\n[**co_reduce**(3)](#co_reduce)\n\n _fortran-lang intrinsic descriptions_\n", "CO_MAX": "## co_max\n\n### **Name**\n\n**co_max** - \\[COLLECTIVE\\] Maximal value on the current set of images\n\n### **Synopsis**\n```fortran\n call co_max(a, result_image [,stat] [,errmsg] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**co_max** determines element-wise the maximal value of **a** on all\nimages of the current team. If result_image is present, the maximum values\nare returned in **a** on the specified image only and the value of **a**\non the other images become undefined. If result_image is not present,\nthe value is returned on all images. If the execution was successful\nand **stat** is present, it is assigned the value zero. If the execution\nfailed, **stat** gets assigned a nonzero value and, if present, **errmsg**\ngets assigned a value describing the occurred error.\n\n### **Options**\n\n- **a**\n : shall be an integer, real or character variable, which has the same\n type and type parameters on all images of the team.\n\n- **result_image**\n : (optional) a scalar integer expression; if present, it shall have\n the same the same value on all images and refer to an image of the\n current team.\n\n- **stat**\n : (optional) a scalar integer variable\n\n- **errmsg**\n : (optional) a scalar character variable\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_co_max\nimplicit none\ninteger :: val\n val = this_image()\n call co_max(val, result_image=1)\n if (this_image() == 1) then\n write(*,*) \"Maximal value\", val ! prints num_images()\n endif\nend program demo_co_max\n```\n\nResults:\n\n```text\n Maximal value 2\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**co_min**(3)](#co_min),\n[**co_sum**(3)](#co_sum),\n[**co_reduce**(3)](#co_reduce),\n[**co_broadcast**(3)](#co_broadcast)\n\n _fortran-lang intrinsic descriptions_\n", "CO_MIN": "## co_min\n\n### **Name**\n\n**co_min** - \\[COLLECTIVE\\] Minimal value on the current set of images\n\n### **Synopsis**\n```fortran\n call co_min(a, result_image [,stat] [,errmsg] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**co_min** determines element-wise the minimal value of **a** on all\nimages of the current team. If result_image is present, the minimal values\nare returned in **a** on the specified image only and the value of **a**\non the other images become undefined. If result_image is not present,\nthe value is returned on all images. If the execution was successful\nand **stat** is present, it is assigned the value zero. If the execution\nfailed, **stat** gets assigned a nonzero value and, if present, **errmsg**\ngets assigned a value describing the occurred error.\n\n### **Options**\n\n- **a**\n : shall be an integer, real or character variable, which has the same\n type and type parameters on all images of the team.\n\n- **result_image**\n : (optional) a scalar integer expression; if present, it shall have\n the same the same value on all images and refer to an image of the\n current team.\n\n- **stat**\n : (optional) a scalar integer variable\n\n- **errmsg**\n : (optional) a scalar character variable\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_co_min\nimplicit none\ninteger :: val\n val = this_image()\n call co_min(val, result_image=1)\n if (this_image() == 1) then\n write(*,*) \"Minimal value\", val ! prints 1\n endif\nend program demo_co_min\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**co_max**(3)](#co_max),\n[**co_sum**(3)](#co_sum),\n[**co_reduce**(3)](#co_reduce),\n[**co_broadcast**(3)](#co_broadcast)\n\n _fortran-lang intrinsic descriptions_\n", @@ -77,32 +77,32 @@ "ERFC": "## erfc\n\n### **Name**\n\n**erfc** - \\[MATHEMATICS\\] Complementary error function\n\n### **Synopsis**\n```fortran\n result = erfc(x)\n```\n```fortran\n elemental real(kind=KIND) function erfc(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is of type _real_ and any valid kind\n - **KIND** is any value valid for type _real_\n - the result has the same characteristics as **x**\n\n### **Description**\n\n **erfc** computes the complementary error function of **x**. Simply\n put this is equivalent to **1 - erf(x)**, but **erfc** is provided\n because of the extreme loss of relative accuracy if **erf(x)** is\n called for large **x** and the result is subtracted from **1**.\n\n **erfc(x)** is defined as\n\n\n\n$$\n\\text{erfc}(x) = 1 - \\text{erf}(x) = 1 - \\frac{2}{\\sqrt{\\pi}} \\int_x^{\\infty} e^{-t^2} dt.\n$$\n\n### **Options**\n\n- **x**\n : The type shall be _real_.\n\n### **Result**\n\n The return value is of type _real_ and of the same kind as **x**. It lies in\n the range\n```fortran\n 0 \\<= **erfc**(x) \\<= 2.\n```\nand is a processor-dependent approximation to the complementary error\nfunction of **x** ( **1-erf(x) ).\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_erfc\nuse, intrinsic :: iso_fortran_env, only : &\n & real_kinds, real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 0.17_real64\n write(*,'(*(g0))')'X=',x, ' ERFC(X)=',erfc(x)\n write(*,'(*(g0))')'equivalently 1-ERF(X)=',1-erf(x)\nend program demo_erfc\n```\nResults:\n```text\n > X=.1700000000000000 ERFC(X)=.8100075387981912\n > equivalently 1-ERF(X)=.8100075387981912\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n[**erf**(3)](#erf)\n[**erf_scaled**(3)](#erf_scaled)\n\n### **Resources**\n\n- [Wikipedia:error function](https://en.wikipedia.org/wiki/Error_function)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ERFC_SCALED": "## erfc_scaled\n\n### **Name**\n\n**erfc_scaled** - \\[MATHEMATICS\\] Scaled complementary error function\n\n### **Synopsis**\n```fortran\n result = erfc_scaled(x)\n```\n```fortran\n elemental real(kind=KIND) function erfc_scaled(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is of type _real_ of any valid kind\n - **KIND** is any kind valid for a _real_ type\n - the result has the same characteristics as **x**\n\n### **Description**\n\n**erfc_scaled** computes the exponentially-scaled complementary\nerror function of **x**:\n\n$$\ne^{x^2} \\frac{2}{\\sqrt{\\pi}} \\int_{x}^{\\infty}\ne^{-t^2} dt.\n$$\n\nerfc_scaled(x)=exp(x*x)erfc(x)\n\n\n#### NOTE1\n\n The complementary error function is asymptotic to\n exp(-X2)/(X/PI). As such it underflows at approximately X >= 9 when\n using ISO/IEC/IEEE 60559:2011 single precision arithmetic. The\n exponentially-scaled complementary error function is asymptotic to\n 1/(X PI). As such it does not underflow until X > HUGE (X)/PI.\n\n### **Options**\n\n- **x**\n the value to apply the **erfc** function to\n\n### **Result**\n\nThe approximation to the exponentially-scaled complementary error function\nof **x**\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_erfc_scaled\nimplicit none\nreal(kind(0.0d0)) :: x = 0.17d0\n x = erfc_scaled(x)\n print *, x\nend program demo_erfc_scaled\n```\nResults:\n```text\n > 0.833758302149981\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n[**erf**(3)](#erf),\n[**exp**(3)](#exp),\n[**erfc**(3)](#erfc)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "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\u2019s\n path when the program calls it. You can check if it\u2019s installed by\n running it from the command prompt. If it runs successfully from the\n command prompt, it means that it\u2019s 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", + "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", "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", "FRACTION": "## fraction\n\n### **Name**\n\n**fraction** - \\[MODEL_COMPONENTS\\] Fractional part of the model representation\n\n### **Synopsis**\n```fortran\n result = fraction(x)\n```\n```fortran\n elemental real(kind=KIND) function fraction(x)\n\n real(kind=KIND),intent(in) :: fraction\n```\n### **Characteristics**\n\n - **x** is of type _real_\n - The result has the same characteristics as the argument.\n\n### **Description**\n\n **fraction** returns the fractional part of the model representation\n of **x**.\n\n### **Options**\n\n- **x**\n : The value to interrogate\n\n### **Result**\n\nThe fractional part of the model representation of **x** is returned;\nit is **x \\* radix(x)\\*\\*(-exponent(x))**.\n\nIf **x** has the value zero, the result is zero.\n\nIf **x** is an IEEE NaN, the result is that NaN.\n\nIf **x** is an IEEE infinity, the result is an IEEE NaN.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_fraction\nimplicit none\nreal :: x\n x = 178.1387e-4\n print *, fraction(x), x * radix(x)**(-exponent(x))\nend program demo_fraction\n```\nResults:\n```text\n 0.5700439 0.5700439\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\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", - "GAMMA": "## gamma\n\n### **Name**\n\n**gamma** - \\[MATHEMATICS\\] Gamma function, which yields factorials for positive whole numbers\n\n### **Synopsis**\n```fortran\n result = gamma(x)\n```\n```fortran\n elemental real(kind=KIND) function gamma( x)\n\n type(real,kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is a _real_ value\n - returns a _real_ value with the kind as **x**.\n\n### **Description**\n\n **gamma(x)** computes Gamma of **x**. For positive whole number values of **n** the\n Gamma function can be used to calculate factorials, as **(n-1)! == gamma(real(n))**.\n That is\n```text\nn! == gamma(real(n+1))\n```\n$$\n\\\\__Gamma__(x) = \\\\int\\_0\\*\\*\\\\infty\nt\\*\\*{x-1}{\\\\mathrm{e}}\\*\\*{__-t__}\\\\,{\\\\mathrm{d}}t\n$$\n\n### **Options**\n\n- **x**\n : Shall be of type _real_ and neither zero nor a negative integer.\n\n### **Result**\n\n The return value is of type _real_ of the same kind as _x_. The result\n has a value equal to a processor-dependent approximation to the gamma\n function of **x**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_gamma\nuse, intrinsic :: iso_fortran_env, only : wp=>real64\nimplicit none\nreal :: x, xa(4)\ninteger :: i\n\n x = gamma(1.0)\n write(*,*)'gamma(1.0)=',x\n\n ! elemental\n xa=gamma([1.0,2.0,3.0,4.0])\n write(*,*)xa\n write(*,*)\n\n ! gamma(3) is related to the factorial function\n do i=1,20\n ! check value is not too big for default integer type\n if(factorial(i).gt.huge(0))then\n write(*,*)i,factorial(i)\n else\n write(*,*)i,factorial(i),int(factorial(i))\n endif\n enddo\n ! more factorials\n FAC: block\n integer,parameter :: n(*)=[0,1,5,11,170]\n integer :: j\n do j=1,size(n)\n write(*,'(*(g0,1x))')'factorial of', n(j),' is ', &\n & product([(real(i,kind=wp),i=1,n(j))]), &\n & gamma(real(n(j)+1,kind=wp))\n enddo\n endblock FAC\n\n contains\n function factorial(i) result(f)\n integer,parameter :: dp=kind(0d0)\n integer,intent(in) :: i\n real :: f\n if(i.le.0)then\n write(*,'(*(g0))')' gamma(3) function value ',i,' <= 0'\n stop ' bad value in gamma function'\n endif\n f=gamma(real(i+1))\n end function factorial\nend program demo_gamma\n```\n\nResults:\n\n```text\n gamma(1.0)= 1.000000\n 1.000000 1.000000 2.000000 6.000000\n\n 1 1.000000 1\n 2 2.000000 2\n 3 6.000000 6\n 4 24.00000 24\n 5 120.0000 120\n 6 720.0000 720\n 7 5040.000 5040\n 8 40320.00 40320\n 9 362880.0 362880\n 10 3628800. 3628800\n 11 3.9916800E+07 39916800\n 12 4.7900160E+08 479001600\n 13 6.2270208E+09\n 14 8.7178289E+10\n 15 1.3076744E+12\n 16 2.0922791E+13\n 17 3.5568741E+14\n 18 6.4023735E+15\n 19 1.2164510E+17\n 20 2.4329020E+18\n factorial of 0 is 1.000000000000000 1.000000000000000\n factorial of 1 is 1.000000000000000 1.000000000000000\n factorial of 5 is 120.0000000000000 120.0000000000000\n factorial of 11 is 39916800.00000000 39916800.00000000\n factorial of 170 is .7257415615307994E+307 .7257415615307999E+307\n```\n\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nLogarithm of the Gamma function: [**log_gamma**(3)](#log_gamma)\n\n### **Resources**\n\n[Wikipedia: Gamma_function](https://en.wikipedia.org/wiki/Gamma_function)\n\n _fortran-lang intrinsic descriptions_\n", + "GAMMA": "## gamma\n\n### **Name**\n\n**gamma** - \\[MATHEMATICS\\] Gamma function, which yields factorials for positive whole numbers\n\n### **Synopsis**\n```fortran\n result = gamma(x)\n```\n```fortran\n elemental real(kind=KIND) function gamma( x)\n\n type(real,kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is a _real_ value\n - returns a _real_ value with the kind as **x**.\n\n### **Description**\n\n **gamma(x)** computes Gamma of **x**. For positive whole number values of **n** the\n Gamma function can be used to calculate factorials, as **(n-1)! == gamma(real(n))**.\n That is\n```text\nn! == gamma(real(n+1))\n```\n$$\n\\\\__Gamma__(x) = \\\\int\\_0\\*\\*\\\\infty\nt\\*\\*{x-1}{\\\\mathrm{e}}\\*\\*{__-t__}\\\\,{\\\\mathrm{d}}t\n$$\n\n### **Options**\n\n- **x**\n : Shall be of type _real_ and neither zero nor a negative integer.\n\n### **Result**\n\n The return value is of type _real_ of the same kind as _x_. The result\n has a value equal to a processor-dependent approximation to the gamma\n function of **x**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_gamma\nuse, intrinsic :: iso_fortran_env, only : wp=>real64, int64\nimplicit none\nreal :: x, xa(4)\ninteger :: i, j\n\n ! basic usage\n x = gamma(1.0)\n write(*,*)'gamma(1.0)=',x\n\n ! elemental\n xa=gamma([1.0,2.0,3.0,4.0])\n write(*,*)xa\n write(*,*)\n\n\n ! gamma() is related to the factorial function\n do i = 1, 171\n ! check value is not too big for default integer type\n if (factorial(i) <= huge(0)) then\n write(*,*) i, nint(factorial(i)), 'integer'\n elseif (factorial(i) <= huge(0_int64)) then\n write(*,*) i, nint(factorial(i),kind=int64),'integer(kind=int64)'\n else\n write(*,*) i, factorial(i) , 'user factorial function'\n write(*,*) i, product([(real(j, kind=wp), j=1, i)]), 'product'\n write(*,*) i, gamma(real(i + 1, kind=wp)), 'gamma directly'\n endif\n enddo\n\n\ncontains\nfunction factorial(i) result(f)\n! GAMMA(X) computes Gamma of X. For positive whole number values of N the\n! Gamma function can be used to calculate factorials, as (N-1)! ==\n! GAMMA(REAL(N)). That is\n!\n! n! == gamma(real(n+1))\n!\ninteger, intent(in) :: i\nreal(kind=wp) :: f\n if (i <= 0) then\n write(*,'(*(g0))') ' gamma(3) function value ', i, ' <= 0'\n stop ' bad value in gamma function'\n endif\n f = anint(gamma(real(i + 1,kind=wp)))\nend function factorial\n\nend program demo_gamma\n```\nResults:\n```text\n > gamma(1.0)= 1.00000000 \n > 1.00000000 1.00000000 2.00000000 6.00000000 \n > \n > 1 1 integer\n > 2 2 integer\n > 3 6 integer\n > 4 24 integer\n > 5 120 integer\n > 6 720 integer\n > 7 5040 integer\n > 8 40320 integer\n > 9 362880 integer\n > 10 3628800 integer\n > 11 39916800 integer\n > 12 479001600 integer\n > 13 6227020800 integer(kind=int64)\n > 14 87178291200 integer(kind=int64)\n > 15 1307674368000 integer(kind=int64)\n > 16 20922789888000 integer(kind=int64)\n > 17 355687428096000 integer(kind=int64)\n > 18 6402373705728001 integer(kind=int64)\n > 19 121645100408832000 integer(kind=int64)\n > 20 2432902008176640000 integer(kind=int64)\n > 21 5.1090942171709440E+019 user factorial function\n > 21 5.1090942171709440E+019 product\n > 21 5.1090942171709440E+019 gamma directly\n > :\n > :\n > :\n > 170 7.2574156153079990E+306 user factorial function\n > 170 7.2574156153079940E+306 product\n > 170 7.2574156153079990E+306 gamma directly\n > 171 Infinity user factorial function\n > 171 Infinity product\n > 171 Infinity gamma directly\n```\n\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nLogarithm of the Gamma function: [**log_gamma**(3)](#log_gamma)\n\n### **Resources**\n\n[Wikipedia: Gamma_function](https://en.wikipedia.org/wiki/Gamma_function)\n\n _fortran-lang intrinsic descriptions_\n", "GET_COMMAND": "## get_command\n\n### **Name**\n\n**get_command** - \\[SYSTEM:COMMAND LINE\\] Get the entire command line invocation\n\n### **Synopsis**\n```fortran\n call get_command([command] [,length] [,status] [,errmsg])\n```\n```fortran\n subroutine get_command( command ,length ,status, errmsg )\n\n character(len=*),intent(out),optional :: command\n integer(kind=**),intent(out),optional :: length\n integer(kind=**),intent(out),optional :: status\n character(len=*),intent(inout),optional :: errmsg\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n meeting the conditions described herein.\n - **command** and **errmsg** are scalar _character_ variables of default kind.\n - **length** and **status** are scalar _integer_ with a decimal exponent\n range of at least four.\n\n### **Description**\n\n**get_command** retrieves the entire command line that was used to\ninvoke the program.\n\nNote that what is typed on the command line is often processed by\na shell. The shell typically processes special characters and white\nspace before passing it to the program. The processing can typically be\nturned off by turning off globbing or quoting the command line arguments\nand/or changing the default field separators, but this should rarely\nbe necessary.\n\n### **Result**\n\n- **command**\n : If **command** is present, the entire command line that was used\n to invoke the program is stored into it. If the command cannot be\n determined, **command** is assigned all blanks.\n\n- **length**\n : If **length** is present, it is assigned the length of the command line.\n It is system-dependent as to whether trailing blanks will be counted.\n : If the command length cannot be determined, a length of 0 is assigned.\n\n- **status**\n : If **status** is present, it is assigned 0 upon success of the\n command, **-1** if **command** is too short to store the command line,\n or a positive value in case of an error.\n\n- **errmsg**\n : It is assigned a processor-dependent explanatory message if the\n command retrieval fails. Otherwise, it is unchanged.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_get_command\nimplicit none\ninteger :: command_line_length\ncharacter(len=:),allocatable :: command_line\n ! get command line length\n call get_command(length=command_line_length)\n ! allocate string big enough to hold command line\n allocate(character(len=command_line_length) :: command_line)\n ! get command line as a string\n call get_command(command=command_line)\n ! trim leading spaces just in case\n command_line=adjustl(command_line)\n write(*,'(\"OUTPUT:\",a)')command_line\nend program demo_get_command\n```\nResults:\n```bash\n # note that shell expansion removes some of the whitespace\n # without quotes\n ./test_get_command arguments on command line to echo\n\n OUTPUT:./test_get_command arguments on command line to echo\n\n # using the bash shell with single quotes\n ./test_get_command 'arguments *><`~[]!{}?\"\\'| '\n\n OUTPUT:./test_get_command arguments *><`~[]!{}?\"'|\n```\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**get_command_argument**(3)](#get_command_argument),\n[**command_argument_count**(3)](#command_argument_count)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n#\n", "GET_COMMAND_ARGUMENT": "## get_command_argument\n\n### **Name**\n\n**get_command_argument** - \\[SYSTEM:COMMAND LINE\\] Get command line arguments\n\n### **Synopsis**\n```fortran\n call get_command_argument(number [,value] [,length] &\n & [,status] [,errmsg])\n```\n```fortran\n subroutine get_command_argument( number, value, length, &\n & status ,errmsg)\n\n integer(kind=**),intent(in) :: number\n character(len=*),intent(out),optional :: value\n integer(kind=**),intent(out),optional :: length\n integer(kind=**),intent(out),optional :: status\n character(len=*),intent(inout),optional :: errmsg\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n meeting the conditions described herein.\n - **number**, **length**, and **status** are scalar _integer_\n with a decimal exponent range of at least four.\n - **value** and **errmsg** are scalar _character_ variables of default\n kind.\n\n### **Description**\n\n**get_command_argument** retrieves or queries the n-th argument that\nwas passed on the command line to the current program execution.\n\nThere is not anything specifically stated about what an argument is but\nin practice the arguments are strings split on whitespace unless the\narguments are quoted. IFS values (Internal Field Separators) used by\ncommon shells are typically ignored and unquoted whitespace is almost\nalways the separator.\n\nShells have often expanded command arguments and spell characters before\npassing them to the program, so the strings read are often not exactly\nwhat the user typed on the command line.\n\n### **Options**\n\n- **number**\n : is a non-negative number indicating which argument of the current\n program command line is to be retrieved or queried.\n : If **number = 0**, the argument pointed to is set to the name of the\n program (on systems that support this feature).\n : if the processor does not have such a concept as a command name the\n value of command argument 0 is processor dependent.\n : For values from 1 to the number of arguments passed to the program a\n value is returned in an order determined by the processor. Conventionally\n they are returned consecutively as they appear on the command line from\n left to right.\n\n### **Result**\n\n- **value**\n : The **value** argument holds the command line argument.\n If **value** can not hold the argument, it is truncated to fit the\n length of **value**.\n : If there are less than **number** arguments specified at the command\n line or if the argument specified does not exist for other reasons,\n **value** will be filled with blanks.\n\n- **length**\n : The **length** argument contains the length of the n-th command\n line argument. The length of **value** has no effect on this value,\n It is the length required to hold all the significant characters of\n the argument regardless of how much storage is provided by **value**.\n\n- **status**\n : If the argument retrieval fails, **status** is a positive number;\n if **value** contains a truncated command line argument, **status**\n is **-1**; and otherwise the **status** is zero.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_get_command_argument\nimplicit none\ncharacter(len=255) :: progname\ninteger :: count, i, argument_length, istat\ncharacter(len=:),allocatable :: arg\n\n ! command name assuming it is less than 255 characters in length\n call get_command_argument (0, progname, status=istat)\n if (istat == 0) then\n print *, \"The program's name is \" // trim (progname)\n else\n print *, \"Could not get the program's name \" // trim (progname)\n endif\n\n ! get number of arguments\n count = command_argument_count()\n write(*,*)'The number of arguments is ',count\n\n !\n ! allocate string array big enough to hold command line\n ! argument strings and related information\n !\n do i=1,count\n call get_command_argument(number=i,length=argument_length)\n if(allocated(arg))deallocate(arg)\n allocate(character(len=argument_length) :: arg)\n call get_command_argument(i, arg,status=istat)\n ! show the results\n write (*,'(i3.3,1x,i0.5,1x,i0.5,1x,\"[\",a,\"]\")') &\n & i,istat,argument_length,arg\n enddo\n\nend program demo_get_command_argument\n```\nResults:\n```text\n./demo_get_command_argument a test 'of getting arguments ' \" leading\"\n```\n```text\n The program's name is ./demo_get_command_argument\n The number of arguments is 4\n001 00000 00001 [a]\n002 00000 00004 [test]\n003 00000 00022 [of getting arguments ]\n004 00000 00008 [ leading]\n```\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**get_command**(3)](#get_command),\n[**command_argument_count**(3)](#command_argument_count)\n\n_fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n#\n", "GET_ENVIRONMENT_VARIABLE": "## get_environment_variable\n\n### **Name**\n\n**get_environment_variable** - \\[SYSTEM:ENVIRONMENT\\] Get value of an environment variable\n\n### **Synopsis**\n```fortran\n call get_environment_variable(name [,value] [,length] &\n & [,status] [,trim_name] [,errmsg] )\n```\n```fortran\n subroutine character(len=*) get_environment_variable( &\n & name, value, length, status, trim_name, errmsg )\n\n character(len=*),intent(in) :: name\n character(len=*),intent(out),optional :: value\n integer(kind=**),intent(out),optional :: length\n integer(kind=**),intent(out),optional :: status\n logical,intent(out),optional :: trim_name\n character(len=*),intent(inout),optional :: errmsg\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n meeting the conditions described herein.\n - **name**, **value**, and **errmsg** are a scalar _character_ of\n default kind.\n - **length** and **status** are _integer_ scalars with a decimal exponent\n range of at least four.\n - **trim_name** is a scalar of type _logical_ and of default kind.\n\n### **Description**\n\n**get_environment_variable** gets the **value** of the environment\nvariable **name**.\n\nNote that **get_environment_variable** need not be thread-safe. It\nis the responsibility of the user to ensure that the environment is not\nbeing updated concurrently.\n\nIf running in parallel be aware\nIt is processor dependent whether an environment variable that exists\non an image also exists on another image, and if it does exist on both\nimages whether the values are the same or different.\n\n### **Options**\n\n- **name**\n : The name of the environment variable to query.\n The interpretation of case is processor dependent.\n\n### **Result**\n\n- **value**\n : The value of the environment variable being queried. If **value**\n is not large enough to hold the data, it is truncated. If the variable\n **name** is not set or has no value, or the processor does not support\n environment variables **value** will be filled with blanks.\n\n- **length**\n : Argument **length** contains the length needed for storing the\n environment variable **name**. It is zero if the environment variable\n is not set.\n\n- **status**\n : **status** is **-1** if **value** is present but too short for the\n environment variable; it is **1** if the environment variable does\n not exist and **2** if the processor does not support environment\n variables; in all other cases **status** is zero.\n\n- **trim_name**\n : If **trim_name** is present with the value _.false._, the trailing\n blanks in **name** are significant; otherwise they are not part of\n the environment variable name.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_getenv\nimplicit none\ncharacter(len=:),allocatable :: homedir\ncharacter(len=:),allocatable :: var\n\n var='HOME'\n homedir=get_env(var)\n write (*,'(a,\"=\"\"\",a,\"\"\"\")')var,homedir\n\ncontains\n\nfunction get_env(name,default) result(value)\n! a function that makes calling get_environment_variable(3) simple\nimplicit none\ncharacter(len=*),intent(in) :: name\ncharacter(len=*),intent(in),optional :: default\ncharacter(len=:),allocatable :: value\ninteger :: howbig\ninteger :: stat\ninteger :: length\n length=0\n value=''\n if(name.ne.'')then\n call get_environment_variable( name, &\n & length=howbig,status=stat,trim_name=.true.)\n select case (stat)\n case (1)\n print *, name, \" is not defined in the environment. Strange...\"\n value=''\n case (2)\n print *, &\n \"This processor does not support environment variables. Boooh!\"\n value=''\n case default\n ! make string of sufficient size to hold value\n if(allocated(value))deallocate(value)\n allocate(character(len=max(howbig,1)) :: value)\n ! get value\n call get_environment_variable( &\n & name,value,status=stat,trim_name=.true.)\n if(stat.ne.0)value=''\n end select\n endif\n if(value.eq.''.and.present(default))value=default\nend function get_env\n\nend program demo_getenv\n```\nTypical Results:\n```text\n HOME=\"/home/urbanjs\"\n```\n### **Standard**\n\nFortran 2003\n\n### **See also**\n\n[**get_command_argument**(3)](#get_command_argument),\n[**get_command**(3)](#get_command)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n#\n", - "HUGE": "## huge\n\n### **Name**\n\n**huge** - \\[NUMERIC MODEL\\] Largest number of a type and kind\n\n### **Synopsis**\n```fortran\n result = huge(x)\n```\n```fortran\n TYPE(kind=KIND) function huge(x)\n\n TYPE(kind=KIND),intent(in) :: x(..)\n```\n### **Characteristics**\n\n - **x** may be any _real_ or _integer_ scalar or array and any kind.\n - The result will be a scalar of the same type and kind as the input **x**\n\n### **Description**\n\n **huge** returns the largest number that is not an overflow\n for the kind and type of **x**.\n\n### **Options**\n\n- **x**\n : **x** is an arbitrary value which is used merely to determine what\n _kind_ and _type_ of scalar is being queried. It need not be defined,\n as only its characteristics are used.\n\n### **Result**\n\n The result is the largest value supported by the specified type\n and kind.\n\n Note the result is as the same kind as the input to ensure the returned\n value does not overflow. Any assignment of the result to a variable\n should take this into consideration.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_huge\nimplicit none\ncharacter(len=*),parameter :: f='(i2,1x,2(i11,1x),f14.0:,1x,l1,1x,a)'\ninteger :: i,j,k,biggest\nreal :: v, w\ndoubleprecision :: sum\n ! basic\n print *, huge(0), huge(0.0), huge(0.0d0)\n print *, tiny(0.0), tiny(0.0d0)\n\n sum=0.0d0\n ! note subtracting one because counter is the end value+1 on exit\n do i=0,huge(0)-1\n sum=sum+i\n enddo\n write(*,*)'sum=',sum\n\n ! advanced\n biggest=huge(0)\n ! be careful of overflow when using integers in computation\n do i=1,14\n j=6**i ! Danger, Danger\n w=6**i ! Danger, Danger\n v=6.0**i\n k=v ! Danger, Danger\n\n if(v.gt.biggest)then\n write(*,f) i, j, k, v, v.eq.w, 'wrong j and k and w'\n else\n write(*,f) i, j, k, v, v.eq.w\n endif\n\n enddo\nend program demo_huge\n```\nResults:\n```\n 2147483647 3.4028235E+38 1.797693134862316E+308\n 1.1754944E-38 2.225073858507201E-308\n\n 1 6 6 6. T\n 2 36 36 36. T\n 3 216 216 216. T\n 4 1296 1296 1296. T\n 5 7776 7776 7776. T\n 6 46656 46656 46656. T\n 7 279936 279936 279936. T\n 8 1679616 1679616 1679616. T\n 9 10077696 10077696 10077696. T\n 10 60466176 60466176 60466176. T\n 11 362797056 362797056 362797056. T\n 12 -2118184960 -2147483648 2176782336. F wrong for j and k and w\n 13 175792128 -2147483648 13060694016. F wrong for j and k and w\n 14 1054752768 -2147483648 78364164096. F wrong for j and k and w\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[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "HUGE": "## huge\n\n### **Name**\n\n**huge** - \\[NUMERIC MODEL\\] Largest number of a type and kind\n\n### **Synopsis**\n```fortran\n result = huge(x)\n```\n```fortran\n TYPE(kind=KIND) function huge(x)\n\n TYPE(kind=KIND),intent(in) :: x(..)\n```\n### **Characteristics**\n\n - **x** may be any _real_ or _integer_ scalar or array and any kind.\n - The result will be a scalar of the same type and kind as the input **x**\n\n### **Description**\n\n **huge** returns the largest number that is not an overflow\n for the kind and type of **x**.\n\n### **Options**\n\n- **x**\n : **x** is an arbitrary value which is used merely to determine what\n _kind_ and _type_ of scalar is being queried. It need not be defined,\n as only its characteristics are used.\n\n### **Result**\n\n The result is the largest value supported by the specified type\n and kind.\n\n Note the result is as the same kind as the input to ensure the returned\n value does not overflow. Any assignment of the result to a variable\n should take this into consideration.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_huge\nimplicit none\ncharacter(len=*),parameter :: f='(i2,1x,2(i11,1x),f14.0:,1x,l1,1x,a)'\ninteger :: i,j,k,biggest\nreal :: v, w\ndoubleprecision :: tally\n ! basic\n print *, huge(0), huge(0.0), huge(0.0d0)\n print *, tiny(0.0), tiny(0.0d0)\n\n tally=0.0d0\n ! note subtracting one because counter is the end value+1 on exit\n do i=0,huge(0)-1\n tally=tally+i\n enddo\n write(*,*)'tally=',tally\n\n ! advanced\n biggest=huge(0)\n ! be careful of overflow when using integers in computation\n do i=1,14\n j=6**i ! Danger, Danger\n w=6**i ! Danger, Danger\n v=6.0**i\n k=v ! Danger, Danger\n\n if(v.gt.biggest)then\n write(*,f) i, j, k, v, v.eq.w, 'wrong j and k and w'\n else\n write(*,f) i, j, k, v, v.eq.w\n endif\n\n enddo\nend program demo_huge\n```\nResults:\n```\n 2147483647 3.4028235E+38 1.797693134862316E+308\n 1.1754944E-38 2.225073858507201E-308\n\n 1 6 6 6. T\n 2 36 36 36. T\n 3 216 216 216. T\n 4 1296 1296 1296. T\n 5 7776 7776 7776. T\n 6 46656 46656 46656. T\n 7 279936 279936 279936. T\n 8 1679616 1679616 1679616. T\n 9 10077696 10077696 10077696. T\n 10 60466176 60466176 60466176. T\n 11 362797056 362797056 362797056. T\n 12 -2118184960 -2147483648 2176782336. F wrong for j and k and w\n 13 175792128 -2147483648 13060694016. F wrong for j and k and w\n 14 1054752768 -2147483648 78364164096. F wrong for j and k and w\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[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "HYPOT": "## hypot\n\n### **Name**\n\n**hypot** - \\[MATHEMATICS\\] Returns the Euclidean distance - the distance between a point and the origin.\n\n### **Synopsis**\n```fortran\n result = hypot(x, y)\n```\n```fortran\n elemental real(kind=KIND) function hypot(x,y)\n\n real(kind=KIND),intent(in) :: x\n real(kind=KIND),intent(in) :: y\n```\n### **Characteristics**\n\n - **x,y** and the result shall all be _real_ and of the same **kind**.\n\n### **Description**\n\n**hypot** is referred to as the Euclidean distance function. It is\nequal to\n```fortran\nsqrt(x**2+y**2)\n```\nwithout undue underflow or overflow.\n\nIn mathematics, the _Euclidean distance_ between two points in Euclidean\nspace is the length of a line segment between two points.\n\n**hypot(x,y)** returns the distance between the point **** and\nthe origin.\n\n### **Options**\n\n- **x**\n: The type shall be _real_.\n\n- **y**\n : The type and kind type parameter shall be the same as **x**.\n\n### **Result**\n\nThe return value has the same type and kind type parameter as **x**.\n\nThe result is the positive magnitude of the distance of the point\n**** from the origin **<0.0,0.0>** .\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_hypot\nuse, intrinsic :: iso_fortran_env, only : &\n & real_kinds, real32, real64, real128\nimplicit none\nreal(kind=real32) :: x, y\nreal(kind=real32),allocatable :: xs(:), ys(:)\ninteger :: i\ncharacter(len=*),parameter :: f='(a,/,SP,*(3x,g0,1x,g0:,/))'\n\n x = 1.e0_real32\n y = 0.5e0_real32\n\n write(*,*)\n write(*,'(*(g0))')'point <',x,',',y,'> is ',hypot(x,y)\n write(*,'(*(g0))')'units away from the origin'\n write(*,*)\n\n ! elemental\n xs=[ x, x**2, x*10.0, x*15.0, -x**2 ]\n ys=[ y, y**2, -y*20.0, y**2, -y**2 ]\n\n write(*,f)\"the points\",(xs(i),ys(i),i=1,size(xs))\n write(*,f)\"have distances from the origin of \",hypot(xs,ys)\n write(*,f)\"the closest is\",minval(hypot(xs,ys))\n\nend program demo_hypot\n```\n\nResults:\n\n```text\n point <1.00000000,0.500000000> is 1.11803401\n units away from the origin\n\n the points\n +1.00000000 +0.500000000\n +1.00000000 +0.250000000\n +10.0000000 -10.0000000\n +15.0000000 +0.250000000\n -1.00000000 -0.250000000\n have distances from the origin of\n +1.11803401 +1.03077638\n +14.1421356 +15.0020828\n +1.03077638\n the closest is\n +1.03077638\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n[****(3)](#)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IACHAR": "## iachar\n\n### **Name**\n\n**iachar** - \\[CHARACTER:CONVERSION\\] Return integer ASCII code of a character\n\n### **Synopsis**\n```fortran\n result = iachar(c [,kind])\n```\n```fortran\n elemental integer(kind=KIND) function iachar(c,kind)\n\n character(len=1),intent(in) :: c\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - **c** is a single character\n - The return value is of type _integer_ and of kind **KIND**. If **KIND**\n is absent, the return value is of default integer kind.\n\n NOTE:\n : a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **iachar** returns the code for the ASCII character in the first\n character position of C.\n\n### **Options**\n\n- **c**\n : A character to determine the ASCII code of.\n : A common extension is to allow strings but all but the first character\n is then ignored.\n\n- **kind**\n : A constant initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\n the result is the position of the character **c** in the ASCII\n collating sequence. It is nonnegative and less than or equal to 127.\n\n By ASCII, it is meant that **c** is in the collating sequence defined\n by the codes specified in ISO/IEC 646:1991 (International Reference\n Version).\n\n The value of the result is processor dependent if **c** is not in the\n ASCII collating sequence.\n\n The results are consistent with the **lge**(3), **lgt**(3), **lle**(3),\n and **llt**(3) comparison functions. For example, if **lle(C, D)**\n is true, **iachar(C) <= iachar (D)** is true where **C** and **D**\n are any two characters representable by the processor.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_iachar\nimplicit none\n ! basic usage\n ! just does a string one character long\n write(*,*)iachar('A')\n ! elemental: can do an array of letters\n write(*,*)iachar(['A','Z','a','z'])\n\n ! convert all characters to lowercase\n write(*,'(a)')lower('abcdefg ABCDEFG')\ncontains\n!\npure elemental function lower(str) result (string)\n! Changes a string to lowercase\ncharacter(*), intent(In) :: str\ncharacter(len(str)) :: string\ninteger :: i\n string = str\n ! step thru each letter in the string in specified range\n do i = 1, len(str)\n select case (str(i:i))\n case ('A':'Z') ! change letter to miniscule\n string(i:i) = char(iachar(str(i:i))+32)\n case default\n end select\n end do\nend function lower\n!\nend program demo_iachar\n```\nResults:\n```text\n 65\n 65 90 97 122\n abcdefg abcdefg\n```\n### **Standard**\n\n Fortran 95 , with KIND argument - Fortran 2003\n\n### **See Also**\n\n[**achar**(3)](#achar),\n[**char**(3)](#char),\n[**ichar**(3)](#ichar)\n\n See [**ichar**(3)](#ichar) in particular for a discussion of converting\n between numerical values and formatted string representations.\n\n Functions that perform operations on character strings, return lengths\n of arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl), [**adjustr**(3)](#adjustr), [**index**(3)](#index),\n [**scan**(3)](#scan), [**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", "IALL": "## iall\n\n### **Name**\n\n**iall** - \\[BIT:LOGICAL\\] Bitwise and of array elements\n\n### **Synopsis**\n```fortran\n result = iall(array [,mask]) | iall(array ,dim [,mask])\n```\n```fortran\n integer(kind=KIND) function iall(array,dim,mask)\n\n integer(kind=KIND),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 - **array** must be an _integer_ array\n - **mask** is a _logical_ array that conforms to **array** of any\n _logical_ kind.\n - **dim** may be of any _integer_ kind.\n - The result will by of the same type and kind as **array**.\n\n### **Description**\n\n **iall** reduces with a bitwise _and_ the elements of **array** along\n dimension **dim** if the corresponding element in **mask** is _.true._.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_\n\n- **dim**\n : (Optional) 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 : (Optional) shall be of type _logical_ and either be a scalar or an\n array of the same shape as **array**.\n\n### **Result**\n\n The result is of the same type as **array**.\n\n If **dim** is absent, a scalar with the bitwise _all_ of all elements in\n **array** is returned. Otherwise, an array of rank **n-1**, where **n**\n equals the rank of **array**, and a shape similar to that of **array**\n with dimension **dim** dropped is returned.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_iall\nuse, intrinsic :: iso_fortran_env, only : integer_kinds, &\n & int8, int16, int32, int64\nimplicit none\ninteger(kind=int8) :: a(2)\n\n a(1) = int(b'00100100')\n a(2) = int(b'01101010')\n\n print '(b8.8)', iall(a)\n\nend program demo_iall\n```\nResults:\n```text\n > 00100000\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**iany**(3)](#iany),\n[**iparity**(3)](#iparity),\n[**iand**(3)](#iand)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "IAND": "## iand\n\n### **Name**\n\n**iand** - \\[BIT:LOGICAL\\] Bitwise logical AND\n\n### **Synopsis**\n```fortran\n result = iand(i, j)\n```\n```fortran\n elemental integer(kind=KIND) function iand(i,j)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=KIND),intent(in) :: j\n```\n### **Characteristics**\n\n- **i**, **j** and the result shall have the same _integer_ type and kind,\n with the exception that one of **i** or **j** may be a BOZ constant.\n\n### **Description**\n\n**iand** returns the bitwise logical **and** of two values.\n\n### **Options**\n\n- **i**\n : one of the pair of values to compare the bits of\n\n- **j**\n : one of the pair of values to compare the bits of\n\nIf either **i** or **j** is a BOZ-literal-constant, it is first converted\nas if by the intrinsic function **int**(3) to type _integer_ with the\nkind type parameter of the other.\n\n### **Result**\n\nThe result has the value obtained by combining **i** and **i**\nbit-by-bit according to the following table:\n```text\n I | J | IAND (I, J)\n ----------------------------\n 1 | 1 | 1\n 1 | 0 | 0\n 0 | 1 | 0\n 0 | 0 | 0\n```\nSo if both the bit in **i** and **j** are on the resulting bit is on\n(a one); else the resulting bit is off (a zero).\n\nThis is commonly called the \"bitwise logical AND\" of the two values.\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_iand\nimplicit none\ninteger :: a, b\n data a / z'f' /, b / z'3' /\n write (*,*) 'a=',a,' b=',b,'iand(a,b)=',iand(a, b)\n write (*,'(b32.32)') a,b,iand(a,b)\nend program demo_iand\n```\nResults:\n```text\n a= 15 b= 3 iand(a,b)= 3\n 00000000000000000000000000001111\n 00000000000000000000000000000011\n 00000000000000000000000000000011\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ieor**(3)](#ieor),\n[**ibclr**(3)](#ibclr),\n[**not**(3)](#not),\n[**btest**(3)](#btest),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ior**(3)](#ior),\n[**ieor**(3)](#ieor),\n[**mvbits**(3)](#mvbits)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "IAND": "## iand\n\n### **Name**\n\n**iand** - \\[BIT:LOGICAL\\] Bitwise logical AND\n\n### **Synopsis**\n```fortran\n result = iand(i, j)\n```\n```fortran\n elemental integer(kind=KIND) function iand(i,j)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=KIND),intent(in) :: j\n```\n### **Characteristics**\n\n- **i**, **j** and the result shall have the same _integer_ type and kind,\n with the exception that one of **i** or **j** may be a BOZ constant.\n\n### **Description**\n\n**iand** returns the bitwise logical **and** of two values.\n\n### **Options**\n\n- **i**\n : one of the pair of values to compare the bits of\n\n- **j**\n : one of the pair of values to compare the bits of\n\nIf either **i** or **j** is a BOZ-literal-constant, it is first converted\nas if by the intrinsic function **int**(3) to type _integer_ with the\nkind type parameter of the other.\n\n### **Result**\n\nThe result has the value obtained by combining **i** and **i**\nbit-by-bit according to the following table:\n```text\n I | J | IAND (I, J)\n ----------------------------\n 1 | 1 | 1\n 1 | 0 | 0\n 0 | 1 | 0\n 0 | 0 | 0\n```\nSo if both the bit in **i** and **j** are on the resulting bit is on\n(a one); else the resulting bit is off (a zero).\n\nThis is commonly called the \"bitwise logical AND\" of the two values.\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_iand\nimplicit none\ninteger :: a, b\n data a / z'f' /, b / z'3' /\n write (*,*) 'a=',a,' b=',b,'iand(a,b)=',iand(a, b)\n write (*,'(b32.32)') a,b,iand(a,b)\nend program demo_iand\n```\nResults:\n```text\n a= 15 b= 3 iand(a,b)= 3\n 00000000000000000000000000001111\n 00000000000000000000000000000011\n 00000000000000000000000000000011\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IANY": "## iany\n\n### **Name**\n\n**iany** - \\[BIT:LOGICAL\\] Bitwise OR of array elements\n\n### **Synopsis**\n```fortran\n result = iany(array [,mask]) | iany(array ,dim [,mask])\n```\n```fortran\n integer(kind=KIND) function iany(array,dim,mask)\n\n integer(kind=KIND),intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - **array** is an _integer_ array\n - **dim** may be of any _integer_ kind.\n - **mask** is a _logical_ array that conforms to **array**\n - The result will by of the same type and kind\n as **array**. It is scalar if **dim** does not appear or is 1.\n Otherwise, it is the shape and rank of array reduced by the\n dimension **dim**.\n\n note a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **iany** reduces with bitwise **OR** (inclusive **OR**) the\n elements of **array** along dimension **dim** if the corresponding\n element in **mask** is _.true._.\n\n### **Options**\n\n- **array**\n : an array of elements to selectively **OR** based on the mask.\n\n- **dim**\n : a value in the range from **1 to n**, where **n** equals the rank\n of **array**.\n\n- **mask**\n : a _logical_ scalar; or an array of the same shape as **array**.\n\n### **Result**\n\n The result is of the same type as **array**.\n\n If **dim** is absent, a scalar with the bitwise _or_ of all elements in\n **array** is returned. Otherwise, an array of rank **n-1**, where **n**\n equals the rank of **array**, and a shape similar to that of **array**\n with dimension **dim** dropped is returned.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_iany\nuse, intrinsic :: iso_fortran_env, only : integer_kinds, &\n & int8, int16, int32, int64\nimplicit none\nlogical,parameter :: T=.true., F=.false.\ninteger(kind=int8) :: a(3)\n a(1) = int(b'00100100',int8)\n a(2) = int(b'01101010',int8)\n a(3) = int(b'10101010',int8)\n write(*,*)'A='\n print '(1x,b8.8)', a\n print *\n write(*,*)'IANY(A)='\n print '(1x,b8.8)', iany(a)\n print *\n write(*,*)'IANY(A) with a mask'\n print '(1x,b8.8)', iany(a,mask=[T,F,T])\n print *\n write(*,*)'should match '\n print '(1x,b8.8)', iany([a(1),a(3)])\n print *\n write(*,*)'does it?'\n write(*,*)iany(a,[T,F,T]) == iany([a(1),a(3)])\nend program demo_iany\n```\nResults:\n```text\n A=\n 00100100\n 01101010\n 10101010\n\n IANY(A)=\n 11101110\n\n IANY(A) with a mask\n 10101110\n\n should match\n 10101110\n\n does it?\n T\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**iparity**(3)](#iparity),\n[**iall**(3)](#iall),\n[**ior**(3)](#ior)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "IBCLR": "## ibclr\n\n### **Name**\n\n**ibclr** - \\[BIT:SET\\] Clear a bit\n\n### **Synopsis**\n```fortran\n result = ibclr(i, pos)\n```\n```fortran\n elemental integer(kind=KIND) function ibclr(i,pos)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n```\n### **Characteristics**\n\n - **i** shall be type _integer_.\n - **pos** shall be type _integer_.\n - The return value is of the same kind as **i**.\n\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **ibclr** returns the value of **i** with the bit at position **pos**\n set to zero.\n\n### **Options**\n\n - **i**\n : The initial value to be modified\n\n - **pos**\n : The position of the bit to change in the input value. A value\n of zero refers to the right-most bit. The value of **pos** must be\n nonnegative and less than **(bit_size(i)**).\n\n### **Result**\n\nThe returned value has the same bit sequence as **i** except the\ndesignated bit is unconditionally set to **0**\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ibclr\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i\n ! basic usage\n print *,ibclr (16, 1), ' ==> ibclr(16,1) has the value 15'\n\n ! it is easier to see using binary representation\n i=int(b'0000000000111111',kind=int16)\n write(*,'(b16.16,1x,i0)') ibclr(i,3), ibclr(i,3)\n\n ! elemental\n print *,'an array of initial values may be given as well'\n print *,ibclr(i=[7,4096,9], pos=2)\n print *\n print *,'a list of positions results in multiple returned values'\n print *,'not multiple bits set in one value, as the routine is '\n print *,'a scalar function; calling it elementally essentially '\n print *,'calls it multiple times. '\n write(*,'(b16.16)') ibclr(i=-1_int16, pos=[1,2,3,4])\n\n ! both may be arrays if of the same size\n\nend program demo_ibclr\n```\nResults:\n```text\n > 16 ==> ibclr(16,1) has the value 15\n > 0000000000110111 55\n > an array of initial values may be given as well\n > 3 4096 9\n >\n > a list of positions results in multiple returned values\n > not multiple bits set in one value, as the routine is\n > a scalar function; calling it elementally essentially\n > calls it multiple times.\n > 1111111111111101\n > 1111111111111011\n > 1111111111110111\n > 1111111111101111\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ieor**(3)](#ieor),\n[**not**(3)](#not),\n[**btest**(3)](#btest),\n[**ibset**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**iand**(3)](#iand),\n[**ior**(3)](#ior),\n[**ieor**(3)](#ieor),\n[**mvbits**(3)](#mvbits)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "IBITS": "## ibits\n\n### **Name**\n\n**ibits** - \\[BIT:COPY\\] Extraction of a subset of bits\n\n### **Synopsis**\n```fortran\n result = ibits(i, pos, len)\n```\n```fortran\n elemental integer(kind=KIND) function ibits(i,pos,len)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n integer(kind=**),intent(in) :: len\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported _integer_ kind\n - **i** may be any supported _integer_ kind as well\n - the return value will be the same kind as **i**\n\n### **Description**\n\n**ibits** extracts a field of bits from **i**, starting\nfrom bit position **pos** and extending left for a total of **len** bits.\n\nThe result is then right-justified and the remaining left-most bits in the\nresult are zeroed.\n\nThe position **pos** is calculated assuming the right-most bit is zero and\nthe positions increment to the left.\n\n### **Options**\n\n - **i**\n : The value to extract bits from\n\n - **pos**\n : The position of the bit to start copying at. **pos** is\n non-negative.\n\n - **len**\n : the number of bits to copy from **i**. It must be non-negative.\n\n**pos + len** shall be less than or equal to **bit_size(i)**.\n\n### **Result**\n\nThe return value is composed of the selected bits right-justified,\nleft-padded with zeros.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ibits\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i,j\n ! basic usage\n print *,ibits (14, 1, 3) ! should be seven\n print *,ibits(-1,10,3) ! and so is this\n ! it is easier to see using binary representation\n i=int(b'0101010101011101',kind=int16)\n write(*,'(b16.16,1x,i0)') ibits(i,3,3), ibits(i,3,3)\n\n ! we can illustrate this as\n ! #-- position 15\n ! | #-- position 0\n ! | <-- +len |\n ! V V\n ! 5432109876543210\n i =int(b'1111111111111111',kind=int16)\n ! ^^^^\n j=ibits(i,10,4) ! start at 10th from left and proceed\n ! left for a total of 4 characters\n write(*,'(a,b16.16)')'j=',j\n ! lets do something less ambiguous\n i =int(b'0010011000000000',kind=int16)\n j=ibits(i,9,5)\n write(*,'(a,b16.16)')'j=',j\nend program demo_ibits\n```\nResults:\n```text\n > 7\n > 7\n > 0000000000000011 3\n > j=0000000000001111\n > j=0000000000010011\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ieor**(3)](#ieor),\n[**ibclr**(3)](#ibclr),\n[**not**(3)](#not),\n[**btest**(3)](#btest),\n[**ibclr**(3)](#ibclr),\n[**ibset**(3)](#ibset),\n[**iand**(3)](#iand),\n[**ior**(3)](#ior),\n[**ieor**(3)](#ieor),\n[**mvbits**(3)](#mvbits)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "IBSET": "## ibset\n\n### **Name**\n\n**ibset** - \\[BIT:SET\\] Set a bit to one in an integer value\n\n### **Synopsis**\n```fortran\n result = ibset(i, pos)\n```\n```fortran\n elemental integer(kind=KIND) function ibset(i,pos)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - The return value is of the same kind as **i**. Otherwise,\n any _integer_ kinds are allowed.\n\n### **Description**\n\n**ibset** returns the value of **i** with the bit at position **pos** set to one.\n\n### **Options**\n\n - **i**\n : The initial value to be modified\n\n - **pos**\n : The position of the bit to change in the input value. A value\n of zero refers to the right-most bit. The value of **pos** must be\n nonnegative and less than **(bit_size(i)**).\n\n### **Result**\n\nThe returned value has the same bit sequence as **i** except the\ndesignated bit is unconditionally set to **1**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ibset\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i\n ! basic usage\n print *,ibset (12, 1), 'ibset(12,1) has the value 14'\n\n ! it is easier to see using binary representation\n i=int(b'0000000000000110',kind=int16)\n write(*,'(b16.16,1x,i0,1x,i0)') ibset(i,12), ibset(i,12), i\n\n ! elemental\n print *,'an array of initial values may be given as well'\n print *,ibset(i=[0,4096], pos=2)\n print *\n print *,'a list of positions results in multiple returned values'\n print *,'not multiple bits set in one value, as the routine is '\n print *,'a scalar function; calling it elementally essentially '\n print *,'calls it multiple times. '\n write(*,'(b16.16)') ibset(i=0, pos=[1,2,3,4])\n\n ! both may be arrays if of the same size\n\nend program demo_ibset\n```\nResults:\n```text\n > 14 ibset(12,1) has the value 14\n > 0001000000000110 4102 6\n > an array of initial values may be given as well\n > 4 4100\n >\n > a list of positions results in multiple returned values\n > not multiple bits set in one value, as the routine is\n > a scalar function; calling it elementally essentially\n > calls it multiple times.\n > 0000000000000010\n > 0000000000000100\n > 0000000000001000\n > 0000000000010000\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ibclr**(3)](#ibclr)\n\n[**ieor**(3)](#ieor),\n[**not**(3)](#not),\n[**btest**(3)](#btest),\n[**ibits**(3)](#ibits),\n[**iand**(3)](#iand),\n[**ior**(3)](#ior),\n[**ieor**(3)](#ieor),\n[**mvbits**(3)](#mvbits)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "IBCLR": "## ibclr\n\n### **Name**\n\n**ibclr** - \\[BIT:SET\\] Clear a bit\n\n### **Synopsis**\n```fortran\n result = ibclr(i, pos)\n```\n```fortran\n elemental integer(kind=KIND) function ibclr(i,pos)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n```\n### **Characteristics**\n\n - **i** shall be type _integer_.\n - **pos** shall be type _integer_.\n - The return value is of the same kind as **i**.\n\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **ibclr** returns the value of **i** with the bit at position **pos**\n set to zero.\n\n### **Options**\n\n - **i**\n : The initial value to be modified\n\n - **pos**\n : The position of the bit to change in the input value. A value\n of zero refers to the right-most bit. The value of **pos** must be\n nonnegative and less than **(bit_size(i)**).\n\n### **Result**\n\nThe returned value has the same bit sequence as **i** except the\ndesignated bit is unconditionally set to **0**\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ibclr\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i\n ! basic usage\n print *,ibclr (16, 1), ' ==> ibclr(16,1) has the value 15'\n\n ! it is easier to see using binary representation\n i=int(b'0000000000111111',kind=int16)\n write(*,'(b16.16,1x,i0)') ibclr(i,3), ibclr(i,3)\n\n ! elemental\n print *,'an array of initial values may be given as well'\n print *,ibclr(i=[7,4096,9], pos=2)\n print *\n print *,'a list of positions results in multiple returned values'\n print *,'not multiple bits set in one value, as the routine is '\n print *,'a scalar function; calling it elementally essentially '\n print *,'calls it multiple times. '\n write(*,'(b16.16)') ibclr(i=-1_int16, pos=[1,2,3,4])\n\n ! both may be arrays if of the same size\n\nend program demo_ibclr\n```\nResults:\n```text\n > 16 ==> ibclr(16,1) has the value 15\n > 0000000000110111 55\n > an array of initial values may be given as well\n > 3 4096 9\n >\n > a list of positions results in multiple returned values\n > not multiple bits set in one value, as the routine is\n > a scalar function; calling it elementally essentially\n > calls it multiple times.\n > 1111111111111101\n > 1111111111111011\n > 1111111111110111\n > 1111111111101111\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibclr),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "IBITS": "## ibits\n\n### **Name**\n\n**ibits** - \\[BIT:COPY\\] Extraction of a subset of bits\n\n### **Synopsis**\n```fortran\n result = ibits(i, pos, len)\n```\n```fortran\n elemental integer(kind=KIND) function ibits(i,pos,len)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n integer(kind=**),intent(in) :: len\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported _integer_ kind\n - **i** may be any supported _integer_ kind as well\n - the return value will be the same kind as **i**\n\n### **Description**\n\n**ibits** extracts a field of bits from **i**, starting\nfrom bit position **pos** and extending left for a total of **len** bits.\n\nThe result is then right-justified and the remaining left-most bits in the\nresult are zeroed.\n\nThe position **pos** is calculated assuming the right-most bit is zero and\nthe positions increment to the left.\n\n### **Options**\n\n - **i**\n : The value to extract bits from\n\n - **pos**\n : The position of the bit to start copying at. **pos** is\n non-negative.\n\n - **len**\n : the number of bits to copy from **i**. It must be non-negative.\n\n**pos + len** shall be less than or equal to **bit_size(i)**.\n\n### **Result**\n\nThe return value is composed of the selected bits right-justified,\nleft-padded with zeros.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ibits\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i,j\n ! basic usage\n print *,ibits (14, 1, 3) ! should be seven\n print *,ibits(-1,10,3) ! and so is this\n ! it is easier to see using binary representation\n i=int(b'0101010101011101',kind=int16)\n write(*,'(b16.16,1x,i0)') ibits(i,3,3), ibits(i,3,3)\n\n ! we can illustrate this as\n ! #-- position 15\n ! | #-- position 0\n ! | <-- +len |\n ! V V\n ! 5432109876543210\n i =int(b'1111111111111111',kind=int16)\n ! ^^^^\n j=ibits(i,10,4) ! start at 10th from left and proceed\n ! left for a total of 4 characters\n write(*,'(a,b16.16)')'j=',j\n ! lets do something less ambiguous\n i =int(b'0010011000000000',kind=int16)\n j=ibits(i,9,5)\n write(*,'(a,b16.16)')'j=',j\nend program demo_ibits\n```\nResults:\n```text\n > 7\n > 7\n > 0000000000000011 3\n > j=0000000000001111\n > j=0000000000010011\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibclr**(3)](#ibclr),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "IBSET": "## ibset\n\n### **Name**\n\n**ibset** - \\[BIT:SET\\] Set a bit to one in an integer value\n\n### **Synopsis**\n```fortran\n result = ibset(i, pos)\n```\n```fortran\n elemental integer(kind=KIND) function ibset(i,pos)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - The return value is of the same kind as **i**. Otherwise,\n any _integer_ kinds are allowed.\n\n### **Description**\n\n**ibset** returns the value of **i** with the bit at position **pos** set to one.\n\n### **Options**\n\n - **i**\n : The initial value to be modified\n\n - **pos**\n : The position of the bit to change in the input value. A value\n of zero refers to the right-most bit. The value of **pos** must be\n nonnegative and less than **(bit_size(i)**).\n\n### **Result**\n\nThe returned value has the same bit sequence as **i** except the\ndesignated bit is unconditionally set to **1**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ibset\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i\n ! basic usage\n print *,ibset (12, 1), 'ibset(12,1) has the value 14'\n\n ! it is easier to see using binary representation\n i=int(b'0000000000000110',kind=int16)\n write(*,'(b16.16,1x,i0,1x,i0)') ibset(i,12), ibset(i,12), i\n\n ! elemental\n print *,'an array of initial values may be given as well'\n print *,ibset(i=[0,4096], pos=2)\n print *\n print *,'a list of positions results in multiple returned values'\n print *,'not multiple bits set in one value, as the routine is '\n print *,'a scalar function; calling it elementally essentially '\n print *,'calls it multiple times. '\n write(*,'(b16.16)') ibset(i=0, pos=[1,2,3,4])\n\n ! both may be arrays if of the same size\n\nend program demo_ibset\n```\nResults:\n```text\n > 14 ibset(12,1) has the value 14\n > 0001000000000110 4102 6\n > an array of initial values may be given as well\n > 4 4100\n >\n > a list of positions results in multiple returned values\n > not multiple bits set in one value, as the routine is\n > a scalar function; calling it elementally essentially\n > calls it multiple times.\n > 0000000000000010\n > 0000000000000100\n > 0000000000001000\n > 0000000000010000\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ibclr**(3)](#ibclr)\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibits**(3)](#ibits),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ICHAR": "## ichar\n\n### **Name**\n\n**ichar** - \\[CHARACTER:CONVERSION\\] Character-to-integer code conversion function\n\n### **Synopsis**\n```fortran\n result = ichar(c [,kind])\n```\n```fortran\n elemental integer(kind=KIND) function ichar(c,KIND)\n\n character(len=1,kind=**),intent(in) :: c\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- **c** is a scalar _character_\n- **kind** is a constant _integer_ initialization expression indicating\n the kind parameter of the result.\n- The return value is of type _integer_ and of kind **kind**. If **kind**\n is absent, the return value is of default _integer_ kind.\n\n### **Description**\n\n **ichar** returns the code for the character in the system's native\n character set. The correspondence between characters and their codes is\n not necessarily the same across different Fortran implementations. For\n example, a platform using EBCDIC would return different values than an\n ASCII platform.\n\n See **iachar**(3) for specifically working with the ASCII character set.\n\n### **Options**\n\n- **c**\n : The input character to determine the code for.\n Its value shall be that of a character capable of representation in the processor.\n\n- **kind**\n : indicates the kind parameter of the result. If **kind** is absent,\n the return value is of default _integer_ kind.\n\n### **Result**\n\n The code in the system default character set for the character being\n queried is returned.\n\n The result is the position of **c** in the processor collating sequence\n associated with the kind type parameter of **c**.\n\n it is nonnegative and less than n, where n is the number of characters\n in the collating sequence.\n\n The kind type parameter of the result shall specify an integer kind\n that is capable of representing n.\n\n For any characters C and D capable of representation in the processor,\n C <= D is true if and only if ICHAR (C) <= ICHAR (D) is true and C ==\n D is true if and only if ICHAR (C) == ICHAR (D) is true.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_ichar\nimplicit none\n\n write(*,*)ichar(['a','z','A','Z'])\n\nend program demo_ichar\n```\nResults:\n```text\n 97 122 65 90\n```\n### **Standard**\n\nFortran 95 , with KIND argument -Fortran 2003\n\n### **See Also**\n\n[**achar**(3)](#achar),\n[**char**(3)](#char),\n[**iachar**(3)](#iachar)\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n\n[**scan**(3)](#scan),\n[**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat),\n [**trim**(3)](#trim)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "IEOR": "## ieor\n\n### **Name**\n\n**ieor** - \\[BIT:LOGICAL\\] Bitwise exclusive OR\n\n### **Synopsis**\n```fortran\n result = ieor(i, j)\n```\n```fortran\n elemental integer(kind=**) function ieor(i,j)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: j\n```\n### **Characteristics**\n\n - **i**, **j** and the result must be of the same _integer_ kind.\n - An exception is that one of **i** and **j** may be a BOZ literal\n constant\n\n### **Description**\n\n **ieor** returns a bitwise exclusive-**or** of **i** and **j**.\n\n An exclusive OR or \"exclusive disjunction\" is a logical operation that\n is true if and only if its arguments differ. In this case a one-bit\n and a zero-bit substitute for true and false.\n\n This is often represented with the notation \"XOR\", for \"eXclusive OR\".\n\n An alternate way to view the process is that the result has the value\n obtained by combining **i** and **j** bit-by-bit according to the\n following table:\n\n > I | J |IEOR (I, J)\n > --#---#-----------\n > 1 | 1 | 0\n > 1 | 0 | 1\n > 0 | 1 | 1\n > 0 | 0 | 0\n\n### **Options**\n\n - **i**\n : the first of the two values to XOR\n\n - **j**\n : the second of the two values to XOR\n\n If either I or J is a boz-literal-constant, it is first converted\n as if by the intrinsic function INT to type integer with the kind\n type parameter of the other.\n\n### **Result**\n\n If a bit is different at the same location in **i** and **j**\n the corresponding bit in the result is **1**, otherwise it is **0**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ieor\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i,j\n ! basic usage\n print *,ieor (16, 1), ' ==> ieor(16,1) has the value 17'\n\n ! it is easier to see using binary representation\n i=int(b'0000000000111111',kind=int16)\n j=int(b'0000001111110000',kind=int16)\n write(*,'(a,b16.16,1x,i0)')'i= ',i, i\n write(*,'(a,b16.16,1x,i0)')'j= ',j, j\n write(*,'(a,b16.16,1x,i0)')'result=',ieor(i,j), ieor(i,j)\n\n ! elemental\n print *,'arguments may be arrays. If both are arrays they '\n print *,'must have the same shape. '\n print *,ieor(i=[7,4096,9], j=2)\n\n ! both may be arrays if of the same size\n\nend program demo_ieor\n```\nResults:\n```text\n > 17 ==> ieor(16,1) has the value 17\n > i= 0000000000111111 63\n > j= 0000001111110000 1008\n > result=0000001111001111 975\n > arguments may be arrays. If both are arrays they\n > must have the same shape.\n > 5 4098 11\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ieor**](#ieor),\n[**ibclr**(3)](#ibclr),\n[**not**(3)](#not),\n[**btest**(3)](#btest),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**iand**(3)](#iand),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "IEOR": "## ieor\n\n### **Name**\n\n**ieor** - \\[BIT:LOGICAL\\] Bitwise exclusive OR\n\n### **Synopsis**\n```fortran\n result = ieor(i, j)\n```\n```fortran\n elemental integer(kind=**) function ieor(i,j)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: j\n```\n### **Characteristics**\n\n - **i**, **j** and the result must be of the same _integer_ kind.\n - An exception is that one of **i** and **j** may be a BOZ literal\n constant\n\n### **Description**\n\n **ieor** returns a bitwise exclusive-**or** of **i** and **j**.\n\n An exclusive OR or \"exclusive disjunction\" is a logical operation that\n is true if and only if its arguments differ. In this case a one-bit\n and a zero-bit substitute for true and false.\n\n This is often represented with the notation \"XOR\", for \"eXclusive OR\".\n\n An alternate way to view the process is that the result has the value\n obtained by combining **i** and **j** bit-by-bit according to the\n following table:\n\n > I | J |IEOR (I, J)\n > --#---#-----------\n > 1 | 1 | 0\n > 1 | 0 | 1\n > 0 | 1 | 1\n > 0 | 0 | 0\n\n### **Options**\n\n - **i**\n : the first of the two values to XOR\n\n - **j**\n : the second of the two values to XOR\n\n If either I or J is a boz-literal-constant, it is first converted\n as if by the intrinsic function INT to type integer with the kind\n type parameter of the other.\n\n### **Result**\n\n If a bit is different at the same location in **i** and **j**\n the corresponding bit in the result is **1**, otherwise it is **0**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ieor\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i,j\n ! basic usage\n print *,ieor (16, 1), ' ==> ieor(16,1) has the value 17'\n\n ! it is easier to see using binary representation\n i=int(b'0000000000111111',kind=int16)\n j=int(b'0000001111110000',kind=int16)\n write(*,'(a,b16.16,1x,i0)')'i= ',i, i\n write(*,'(a,b16.16,1x,i0)')'j= ',j, j\n write(*,'(a,b16.16,1x,i0)')'result=',ieor(i,j), ieor(i,j)\n\n ! elemental\n print *,'arguments may be arrays. If both are arrays they '\n print *,'must have the same shape. '\n print *,ieor(i=[7,4096,9], j=2)\n\n ! both may be arrays if of the same size\n\nend program demo_ieor\n```\nResults:\n```text\n > 17 ==> ieor(16,1) has the value 17\n > i= 0000000000111111 63\n > j= 0000001111110000 1008\n > result=0000001111001111 975\n > arguments may be arrays. If both are arrays they\n > must have the same shape.\n > 5 4098 11\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IMAGE_INDEX": "## image_index\n\n### **Name**\n\n**image_index** - \\[COLLECTIVE\\] Cosubscript to image index conversion\n\n### **Synopsis**\n```fortran\n result = image_index(coarray, sub)\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**image_index** returns the image index belonging to a cosubscript.\n\n### **Options**\n\n- **coarray**\n : Coarray of any type.\n\n- **sub**\n : default integer rank-1 array of a size equal to the corank of\n **coarray**.\n\n### **Result**\n\nScalar default integer with the value of the image index which\ncorresponds to the cosubscripts. For invalid cosubscripts the result is\nzero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo image_index\nimplicit none\ninteger :: array[2,-1:4,8,*]\n ! Writes 28 (or 0 if there are fewer than 28 images)\n write (*,*) image_index(array, [2,0,3,1])\nend demo image_index\n```\n\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**this_image**(3)](#this_image),\n[**num_images**(3)](#num_images)\n\n _fortran-lang intrinsic descriptions_\n", "INDEX": "## index\n\n### **Name**\n\n**index** - \\[CHARACTER:SEARCH\\] Position of a substring within a string\n\n### **Synopsis**\n```fortran\nresult = index( string, substring [,back] [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function index(string,substring,back,kind)\n\n character(len=*,kind=KIND),intent(in) :: string\n character(len=*,kind=KIND),intent(in) :: substring\n logical(kind=**),intent(in),optional :: back\n integer(kind=**),intent(in),optional :: kind\n```\n### **Characteristics**\n\n- **string** is a _character_ variable of any kind\n- **substring** is a _character_ variable of the same kind as **string**\n- **back** is a _logical_ variable of any supported kind\n- **KIND** is a scalar integer constant expression.\n\n### **Description**\n\n **index** returns the position of the start of the leftmost\n or rightmost occurrence of string **substring** in **string**,\n counting from one. If **substring** is not present in **string**,\n zero is returned.\n\n### **Options**\n\n- **string**\n : string to be searched for a match\n\n- **substring**\n : string to attempt to locate in **string**\n\n- **back**\n : If the **back** argument is present and true, the return value is the\n start of the rightmost occurrence rather than the leftmost.\n\n- **kind**\n : if **kind** is present, the kind type parameter is that specified by the value of\n **kind**; otherwise the kind type parameter is that of default integer type.\n\n\n### **Result**\n\n The result is the starting position of the first substring\n **substring** found in **string**.\n\n If the length of **substring** is longer than **string** the result\n is zero.\n\n If the substring is not found the result is zero.\n\n If **back** is _.true._ the greatest starting position is returned\n (that is, the position of the right-most match). Otherwise,\n the smallest position starting a match (ie. the left-most match)\n is returned.\n\n The position returned is measured from the left with the first\n character of **string** being position one.\n\n Otherwise, if no match is found zero is returned.\n\n### **Examples**\n\nExample program\n```fortran\nprogram demo_index\nimplicit none\ncharacter(len=*),parameter :: str=&\n 'Search this string for this expression'\n !1234567890123456789012345678901234567890\n write(*,*)&\n index(str,'this').eq.8, &\n ! return value is counted from the left end even if BACK=.TRUE.\n index(str,'this',back=.true.).eq.24, &\n ! INDEX is case-sensitive\n index(str,'This').eq.0\nend program demo_index\n```\nExpected Results:\n\n```text\n T T T\n```\n### **Standard**\n\nFORTRAN 77 , 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**](#index),\n [**scan**(3)](#scan), [**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_\n", "INT": "## int\n\n### **Name**\n\n**int** - \\[TYPE:NUMERIC\\] Truncate towards zero and convert to integer\n\n### **Synopsis**\n```fortran\n result = int(a [,kind])\n```\n```fortran\n elemental integer(kind=KIND) function int(a, KIND )\n\n TYPE(kind=**),intent(in) :: a\n integer,optional :: KIND\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **a** shall be of type integer, real, or complex, or a boz-literal-constant.\n - **KIND** shall be a scalar integer constant expression.\n\n### **Description**\n\n **int** truncates towards zero and return an _integer_.\n\n### **Options**\n\n - **a**\n : is the value to truncate towards zero\n\n - **kind**\n : indicates the kind parameter of the result.\n If not present the returned type is that of default integer type.\n\n### **Result**\n\nreturns an _integer_ variable applying the following rules:\n\n**Case**:\n\n1. If **a** is of type _integer_, **int**(a) = a\n\n2. If **a** is of type _real_ and **|a| \\< 1, int(a)** equals **0**. If **|a| \\>=\n 1**, then **int(a)** equals the integer whose magnitude does not exceed\n **a** and whose sign is the same as the sign of **a**.\n\n3. If **a** is of type _complex_, rule 2 is applied to the _real_ part of **a**.\n\n4. If _a_ is a boz-literal constant, it is treated as an _integer_\n with the _kind_ specified.\n\n The interpretation of a bit sequence whose most significant bit is\n **1** is processor dependent.\n\nThe result is undefined if it cannot be represented in the specified integer type.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_int\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i = 42\ncomplex :: z = (-3.7, 1.0)\nreal :: x=-10.5, y=10.5\n\n print *, int(x), int(y)\n\n print *, int(i)\n\n print *, int(z), int(z,8)\n ! elemental\n print *, int([-10.9,-10.5,-10.3,10.3,10.5,10.9])\n ! note int(3) truncates towards zero\n\n ! CAUTION:\n ! a number bigger than a default integer can represent\n ! produces an incorrect result and is not required to\n ! be detected by the program.\n x=real(huge(0))+1000.0\n print *, int(x),x\n ! using a larger kind\n print *, int(x,kind=int64),x\n\n print *, int(&\n & B\"111111111111111111111111111111111111111111111111111111111111111\",&\n & kind=int64)\n print *, int(O\"777777777777777777777\",kind=int64)\n print *, int(Z\"7FFFFFFFFFFFFFFF\",kind=int64)\n\n ! elemental\n print *\n print *,int([ &\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\nend program demo_int\n```\n\nResults:\n\n```text\n > -10 10\n > 42\n > -3 -3\n > -10 -10 -10 10 10 10\n > -2147483648 2.14748467E+09\n > 2147484672 2.14748467E+09\n > 9223372036854775807\n > 9223372036854775807\n > 9223372036854775807\n >\n > -2 -2 -2 -2 -1\n > -1 0 0 0 1\n > 1 2 2 2 2\n```\n\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**nint**(3)](#nint),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "IOR": "## ior\n\n### **Name**\n\n**ior** - \\[BIT:LOGICAL\\] Bitwise logical inclusive OR\n\n### **Synopsis**\n```fortran\n result = ior(i, j)\n```\n```fortran\n elemental integer(kind=KIND) function ior(i,j)\n\n integer(kind=KIND ,intent(in) :: i\n integer(kind=KIND ,intent(in) :: j\n```\n### **Characteristics**\n\n- **i**, **j** and the result shall have the same _integer_ type and kind,\n with the exception that one of **i** or **j** may be a BOZ constant.\n\n### **Description**\n\n**ior** returns the bit-wise Boolean inclusive-or of **i** and **j**.\n\n### **Options**\n\n- **i**\n : one of the pair of values to compare the bits of\n\n- **j**\n : one of the pair of values to compare the bits of\n\nIf either **i** or **j** is a BOZ-literal-constant, it is first converted\nas if by the intrinsic function **int**(3) to type _integer_ with the\nkind type parameter of the other.\n\n### **Result**\n\n The result has the value obtained by combining I and J\n bit-by-bit according to the following table:\n```text\n I J IOR (I, J)\n 1 1 1\n 1 0 1\n 0 1 1\n 0 0 0\n```\n Where if the bit is set in either input value, it is set in the\n result. Otherwise the result bit is zero.\n\n This is commonly called the \"bitwise logical inclusive OR\" of the two values.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ior\nimplicit none\ninteger :: i, j, k\n i=53 ! i=00110101 binary (lowest order byte)\n j=45 ! j=00101101 binary (lowest order byte)\n k=ior(i,j) ! k=00111101 binary (lowest order byte), k=61 decimal\n write(*,'(i8,1x,b8.8)')i,i,j,j,k,k\nend program demo_ior\n```\nResults:\n```\n 53 00110101\n 45 00101101\n 61 00111101\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ieor**(3)](#ieor),\n[**ibclr**(3)](#ibclr),\n[**not**(3)](#not),\n[**btest**(3)](#btest),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**iand**(3)](#iand),\n[**ieor**(3)](#ieor),\n[**mvbits**(3)](#mvbits)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "IOR": "## ior\n\n### **Name**\n\n**ior** - \\[BIT:LOGICAL\\] Bitwise logical inclusive OR\n\n### **Synopsis**\n```fortran\n result = ior(i, j)\n```\n```fortran\n elemental integer(kind=KIND) function ior(i,j)\n\n integer(kind=KIND ,intent(in) :: i\n integer(kind=KIND ,intent(in) :: j\n```\n### **Characteristics**\n\n- **i**, **j** and the result shall have the same _integer_ type and kind,\n with the exception that one of **i** or **j** may be a BOZ constant.\n\n### **Description**\n\n**ior** returns the bit-wise Boolean inclusive-or of **i** and **j**.\n\n### **Options**\n\n- **i**\n : one of the pair of values to compare the bits of\n\n- **j**\n : one of the pair of values to compare the bits of\n\nIf either **i** or **j** is a BOZ-literal-constant, it is first converted\nas if by the intrinsic function **int**(3) to type _integer_ with the\nkind type parameter of the other.\n\n### **Result**\n\n The result has the value obtained by combining I and J\n bit-by-bit according to the following table:\n```text\n I J IOR (I, J)\n 1 1 1\n 1 0 1\n 0 1 1\n 0 0 0\n```\n Where if the bit is set in either input value, it is set in the\n result. Otherwise the result bit is zero.\n\n This is commonly called the \"bitwise logical inclusive OR\" of the two values.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ior\nimplicit none\ninteger :: i, j, k\n i=53 ! i=00110101 binary (lowest order byte)\n j=45 ! j=00101101 binary (lowest order byte)\n k=ior(i,j) ! k=00111101 binary (lowest order byte), k=61 decimal\n write(*,'(i8,1x,b8.8)')i,i,j,j,k,k\nend program demo_ior\n```\nResults:\n```\n 53 00110101\n 45 00101101\n 61 00111101\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IPARITY": "## iparity\n\n### **Name**\n\n**iparity** - \\[BIT:LOGICAL\\] Bitwise exclusive OR of array elements\n\n### **Synopsis**\n```fortran\n result = iparity( array [,mask] ) | iparity( array, dim [,mask] )\n```\n```fortran\n integer(kind=KIND) function iparity(array, dim, mask )\n\n integer(kind=KIND),intent(in) :: array(..)\n logical(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n - **array** - An _integer_ array.\n - **dim** - an _integer_ scalar from 1 to the rank of **array**\n - **mask** - _logical_ conformable with **array**.\n\n### **Description**\n\n**iparity** reduces with bitwise _xor_ (exclusive _or_) the elements\nof **array** along dimension **dim** if the corresponding element in\n**mask** is _.true._.\n\n### **Options**\n\n- **array**\n : an array of _integer_ values\n\n- **dim** a value from 1 to the rank of **array**.\n\n- **mask**\n : a _logical_ mask either a scalar or an array of the same shape\n as **array**.\n\n### **Result**\n\nThe result is of the same type as **array**.\n\nIf **dim** is absent, a scalar with the bitwise _xor_ of all elements in **array**\nis returned. Otherwise, an array of rank **n-1**, where **n** equals the\nrank of **array**, and a shape similar to that of **array** with dimension **dim**\ndropped is returned.\n\n Case (i): The result of IPARITY (ARRAY) has a value equal to the\n bitwise exclusive OR of all the elements of ARRAY. If\n ARRAY has size zero the result has the value zero.\n\n Case (ii): The result of IPARITY (ARRAY, MASK=MASK) has a value\n equal to that of\n```fortran\n IPARITY (PACK (ARRAY, MASK)).\n```\n Case (iii): The result of IPARITY (ARRAY, DIM=DIM [, MASK=MASK])\n has a value equal to that of IPARITY (ARRAY [, MASK=MASK])\n if ARRAY has rank one.\n\n Otherwise, an array of values reduced along the dimension\n **dim** is returned.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_iparity\nimplicit none\ninteger, dimension(2) :: a\n a(1) = int(b'00100100')\n a(2) = int(b'01101010')\n print '(b8.8)', iparity(a)\nend program demo_iparity\n```\nResults:\n```\n 01001110\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**iany**(3)](#iany),\n[**iall**(3)](#iall),\n[**ieor**(3)](#ieor),\n[**parity**(3)](#parity)\n\n _fortran-lang intrinsic descriptions_\n", "ISHFT": "## ishft\n\n### **Name**\n\n**ishft** - \\[BIT:SHIFT\\] Logical shift of bits in an integer\n\n### **Synopsis**\n```fortran\n result = ishftc( i, shift )\n```\n```fortran\n elemental integer(kind=KIND) function ishft(i, shift )\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **i** is an _integer_ of any kind. the kind for **i** dictates the kind of the returned value.\n - **shift** is an _integer_ of any kind.\n\n### **Description**\n\n **ishft** returns a value corresponding to **i** with all of the\n bits shifted **shift** places left or right as specified by the sign\n and magnitude of **shift**.\n\n Bits shifted out from the left end or right end are lost; zeros are\n shifted in from the opposite end.\n\n### **Options**\n\n- **i**\n : The value specifying the pattern of bits to shift\n\n- **shift**\n : A value of **shift** greater than zero corresponds to a left shift,\n a value of zero corresponds to no shift, and a value less than zero\n corresponds to a right shift.\n\n If the absolute value of **shift** is\n greater than **bit_size(i)**, the value is undefined.\n\n\n### **Result**\n\n The result has the value obtained by shifting the bits of **i** by **shift** positions.\n\n 1. If **shift** is positive, the shift is to the left\n 2. if **shift** is negative, the shift is to the right\n 3. if **shift** is zero, no shift is performed.\n\n Bits shifted out from the left or from the right, as appropriate,\n are lost. Zeros are shifted in from the opposite end.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ishft\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: shift\ncharacter(len=*),parameter :: g='(b32.32,1x,i0)'\n\n write(*,*) ishft(3, 1),' <== typically should have the value 6'\n\n shift=4\n write(*,g) ishft(huge(0),shift), shift\n shift=0\n write(*,g) ishft(huge(0),shift), shift\n shift=-4\n write(*,g) ishft(huge(0),shift), shift\nend program demo_ishft\n```\nResults:\n```text\n> 6 <== typically should have the value 6\n> 11111111111111111111111111110000 4\n> 01111111111111111111111111111111 0\n> 00000111111111111111111111111111 -4\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ishftc**(3)](#ishftc)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ISHFTC": "## ishftc\n\n### **Name**\n\n**ishftc** - \\[BIT:SHIFT\\] Shift rightmost bits circularly, AKA. a logical shift\n\n### **Synopsis**\n```fortran\n result = ishftc( i, shift [,size] )\n```\n```fortran\n elemental integer(kind=KIND) function ishftc(i, shift, size)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: shift\n integer(kind=**),intent(in),optional :: size\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **i** may be an _integer_ of any kind\n - **shift** and **size** may be _integers_ of any kind\n - the kind for **i** dictates the kind of the returned value.\n\n### **Description**\n\n **ishftc** circularly shifts just the specified rightmost bits of\n an integer.\n\n **ishftc** returns a value corresponding to **i** with the rightmost\n **size** bits shifted circularly **shift** places; that is, bits\n shifted out one end of the section are shifted into the opposite end\n of the section.\n\n A value of **shift** greater than zero corresponds to a left shift,\n a value of zero corresponds to no shift, and a value less than zero\n corresponds to a right shift.\n\n### **Options**\n\n- **i**\n : The value specifying the pattern of bits to shift\n\n- **shift**\n : If **shift** is positive, the shift is to the left; if **shift**\n is negative, the shift is to the right; and if **shift** is zero,\n no shift is performed.\n\n The absolute value of **shift** must be less than **size** (simply\n put, the number of positions to shift must be less than or equal to\n the number of bits specified to be shifted).\n\n- **size**\n : The value must be greater than zero and less than or equal to\n **bit_size**(i).\n\n The default if **bit_size(i)** is absent is to circularly shift the\n entire value **i**.\n\n### **Result**\n\n The result characteristics (kind, shape, size, rank, ...) are the\n same as **i**.\n\n The result has the value obtained by shifting the **size** rightmost\n bits of **i** circularly by **shift** positions.\n\n No bits are lost.\n\n The unshifted bits are unaltered.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ishftc\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i\ncharacter(len=*),parameter :: g='(b32.32,1x,i0)'\n ! basics\n write(*,*) ishftc(3, 1),' <== typically should have the value 6'\n\n print *, 'lets start with this:'\n write(*,'(b32.32)')huge(0)\n print *, 'shift the value by various amounts, negative and positive'\n do i= -bit_size(0), bit_size(0), 8\n write(*,g) ishftc(huge(0),i), i\n enddo\n print *,'elemental'\n i=huge(0)\n write(*,*)ishftc(i,[2,3,4,5])\n write(*,*)ishftc([2**1,2**3,-2**7],3)\n print *,'note the arrays have to conform when elemental'\n write(*,*)ishftc([2**1,2**3,-2**7],[5,20,0])\n\nend program demo_ishftc\n```\nResults:\n```text\n > 6 <== typically should have the value 6\n > lets start with this:\n > 01111111111111111111111111111111\n > shift the value by various amounts, negative and positive\n > 01111111111111111111111111111111 -32\n > 11111111111111111111111101111111 -24\n > 11111111111111110111111111111111 -16\n > 11111111011111111111111111111111 -8\n > 01111111111111111111111111111111 0\n > 11111111111111111111111101111111 8\n > 11111111111111110111111111111111 16\n > 11111111011111111111111111111111 24\n > 01111111111111111111111111111111 32\n > elemental\n > -3 -5 -9 -17\n > 16 64 -1017\n > note the arrays have to conform when elemental\n > 64 8388608 -128\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n- [**ishft**(3)](#ishft) - Logical shift of bits in an integer\n- [**shifta**(3)](#shifta) - Right shift with fill\n- [**shiftl**(3)](#shiftl) - Shift bits left\n- [**shiftr**(3)](#shiftr) - Combined right shift of the bits of two int...\n- [**dshiftl**(3)](#dshiftl) - Combined left shift of the bits of two inte...\n- [**dshiftr**(3)](#dshiftr) - Combined right shift of the bits of two int...\n- [**cshift**(3)](#cshift) - Circular shift elements of an array\n- [**eoshift**(3)](#eoshift) - End-off shift elements of an array\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -130,7 +130,7 @@ "MAXEXPONENT": "## maxexponent\n\n### **Name**\n\n**maxexponent** - \\[NUMERIC MODEL\\] Maximum exponent of a real kind\n\n### **Synopsis**\n```fortran\n result = maxexponent(x)\n```\n```fortran\n elemental integer function maxexponent(x)\n\n real(kind=**),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is a _real_ scalar or array of any _real_ kind\n - the result is a default _integer_ scalar\n\n### **Description**\n\n **maxexponent** returns the maximum exponent in the model of the\n type of **x**.\n\n### **Options**\n\n- **x**\n : A value used to select the kind of _real_ to return a value for.\n\n### **Result**\n\n The value returned is the maximum exponent for the kind of the value\n queried\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_maxexponent\nuse, intrinsic :: iso_fortran_env, only : real32,real64,real128\nimplicit none\ncharacter(len=*),parameter :: g='(*(g0,1x))'\n print g, minexponent(0.0_real32), maxexponent(0.0_real32)\n print g, minexponent(0.0_real64), maxexponent(0.0_real64)\n print g, minexponent(0.0_real128), maxexponent(0.0_real128)\nend program demo_maxexponent\n```\nResults:\n```text\n -125 128\n -1021 1024\n -16381 16384\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[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MAXLOC": "## maxloc\n\n### **Name**\n\n**maxloc** - \\[ARRAY:LOCATION\\] Location of the maximum value within an array\n\n### **Synopsis**\n```fortran\n result = maxloc(array [,mask]) | maxloc(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function maxloc(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** designates any intrinsic numeric type and kind.\n\n### **Description**\n\n**maxloc** determines the location of the element in the array with\nthe maximum value, or, if the **dim** argument is supplied, determines\nthe locations of the maximum element along each row of the array in the\n**dim** direction.\n\nIf **mask** is present, only the elements for which **mask**\nis _.true._ are considered. If more than one element in the array has\nthe maximum value, the location returned is that of the first such element\nin array element order.\n\nIf the array has zero size, or all of the elements\nof **mask** are .false., then the result is an array of zeroes. Similarly,\nif **dim** is supplied and all of the elements of **mask** along a given\nrow are zero, the result value for that row is zero.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_, or _character_.\n\n- **dim**\n : (Optional) Shall be a scalar of type _integer_, with a value between\n one and the rank of **array**, inclusive. It may not be an optional\n dummy argument.\n\n- **mask**\n : Shall be an array of type _logical_, and conformable with **array**.\n\n### **Result**\n\nIf **dim** is absent, the result is a rank-one array with a length equal\nto the rank of **array**. If **dim** is present, the result is an array\nwith a rank one less than the rank of **array**, and a size corresponding\nto the size of **array** with the **dim** dimension removed. If **dim**\nis present and **array** has a rank of one, the result is a scalar. In\nall cases, the result is of default _integer_ type.\n\nThe value returned is reference to the offset from the beginning of the\narray, not necessarily the subscript value if the array subscripts do\nnot start with one.\n\n### **Examples**\n\nsample program\n\n```fortran\nprogram demo_maxloc\nimplicit none\ninteger :: ii\ninteger,save :: i(-3:3)=[(abs(abs(ii)-50),ii=-3,3)]\ninteger,save :: ints(3,5)= reshape([&\n 1, 2, 3, 4, 5, &\n 10, 20, 30, 40, 50, &\n 11, 22, 33, 44, 55 &\n],shape(ints),order=[2,1])\n\n write(*,*) maxloc(ints)\n write(*,*) maxloc(ints,dim=1)\n write(*,*) maxloc(ints,dim=2)\n ! when array bounds do not start with one remember MAXLOC(3) returns\n ! the offset relative to the lower bound-1 of the location of the\n ! maximum value, not the subscript of the maximum value. When the\n ! lower bound of the array is one, these values are the same. In\n ! other words, MAXLOC(3) returns the subscript of the value assuming\n ! the first subscript of the array is one no matter what the lower\n ! bound of the subscript actually is.\n write(*,'(g0,1x,g0)') (ii,i(ii),ii=lbound(i,dim=1),ubound(i,dim=1))\n write(*,*)maxloc(i)\n\nend program demo_maxloc\n```\n\nResults:\n\n```text\n > 3 5\n > 3 3 3 3 3\n > 5 5 5\n > -3 47\n > -2 48\n > -1 49\n > 0 50\n > 1 49\n > 2 48\n > 3 47\n```\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n - [**findloc**(3)](#findloc) - Location of first element of ARRAY\n identified by MASK along dimension DIM matching a target\n - [**minloc**(3)](#minloc) - Location of the minimum value within an array\n - [**maxval**(3)](#maxval)\n - [**minval**(3)](#minval)\n - [**max**(3)](#max)\n\n _fortran-lang intrinsic descriptions_\n", "MAXVAL": "## maxval\n\n### **Name**\n\n**maxval** - \\[ARRAY:REDUCTION\\] Determines the maximum value in an array or row\n\n### **Synopsis**\n```fortran\n result = maxval(array [,mask]) | maxval(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function maxval(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** designates any numeric type and kind.\n\n### **Description**\n\n **maxval** determines the maximum value of the elements in an\n array value, or, if the **dim** argument is supplied, determines the\n maximum value along each row of the array in the **dim** direction. If\n **mask** is present, only the elements for which **mask** is _.true._\n are considered. If the array has zero size, or all of the elements of\n **mask** are _.false._, then the result is the most negative number\n of the type and kind of **array** if **array** is numeric, or a string\n of nulls if **array** is of character type.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_, or _character_.\n\n- **dim**\n : (Optional) Shall be a scalar of type _integer_, with a value between\n one and the rank of **array**, inclusive. It may not be an optional\n dummy argument.\n\n- **mask**\n : (Optional) Shall be an array of type _logical_, and conformable with\n **array**.\n\n### **Result**\n\nIf **dim** is absent, or if **array** has a rank of one, the result is a scalar.\nIf **dim** is present, the result is an array with a rank one less than the\nrank of **array**, and a size corresponding to the size of **array** with the\n**dim** dimension removed. In all cases, the result is of the same type and\nkind as **array**.\n\n### **Examples**\n\nsample program:\n\n```fortran\nprogram demo_maxval\nimplicit none\ninteger,save :: ints(3,5)= reshape([&\n 1, 2, 3, 4, 5, &\n 10, 20, 30, 40, 50, &\n 11, 22, 33, 44, 55 &\n],shape(ints),order=[2,1])\n\n write(*,*) maxval(ints)\n write(*,*) maxval(ints,dim=1)\n write(*,*) maxval(ints,dim=2)\n ! find biggest number less than 30 with mask\n write(*,*) maxval(ints,mask=ints.lt.30)\nend program demo_maxval\n```\nResults:\n```\n > 55\n > 11 22 33 44 55\n > 5 50 55\n > 22\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**maxloc**(3)](#maxloc),\n[**minloc**(3)](#minloc),\n[**minval**(3)](#minval),\n[**max**(3)](#max),\n[**min**(3)](#min)\n\n _fortran-lang intrinsic descriptions_\n", - "MERGE": "## merge\n\n### **Name**\n\n**merge** - \\[ARRAY:CONSTRUCTION\\] Merge variables\n\n### **Synopsis**\n```fortran\n result = merge(tsource, fsource, mask)\n```\n```fortran\n elemental type(TYPE(kind=KIND)) function merge(tsource,fsource,mask)\n\n type(TYPE(kind=KIND)),intent(in) :: tsource\n type(TYPE(kind=KIND)),intent(in) :: fsource\n logical(kind=**),intent(in) :: mask\n mask** : Shall be of type logical.\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **tsource** May be of any type, including user-defined.\n - **fsource** Shall be of the same type and type parameters as **tsource**.\n - **mask** shall be of type logical.\n - The result will by of the same type and type parameters as **tsource**.\n\n\n### **Description**\n\nThe elemental function **merge** selects values from two arrays or\nscalars according to a logical mask. The result is equal to an element\nof **tsource** where the corresponding element of **mask** is _.true._, or an\nelement of **fsource** when it is _.false._ .\n\nMulti-dimensional arrays are supported.\n\nNote that argument expressions to **merge** are not required to be\nshort-circuited so (as an example) if the array **x** contains zero values\nin the statement below the standard does not prevent floating point\ndivide by zero being generated; as **1.0/x** may be evaluated for all values\nof **x** before the mask is used to select which value to retain:\n\n```fortran\n y = merge( 1.0/x, 0.0, x /= 0.0 )\n```\n\nNote the compiler is also free to short-circuit or to generate an\ninfinity so this may work in many programming environments but is not\nrecommended.\n\nFor cases like this one may instead use masked assignment via the **where**\nconstruct:\n\n```fortran\n where(x .ne. 0.0)\n y = 1.0/x\n elsewhere\n y = 0.0\n endwhere\n```\n\ninstead of the more obscure\n\n```fortran\n merge(1.0/merge(x,1.0,x /= 0.0), 0.0, x /= 0.0)\n```\n### **Options**\n\n- **tsource**\n : May be of any type, including user-defined.\n\n- **fsource**\n : Shall be of the same type and type parameters as **tsource**.\n\n- **mask**\n : Shall be of type _logical_.\n\nNote that (currently) _character_ values must be of the same length.\n\n### **Result**\n The result is built from an element of **tsource** if **mask** is\n _.true._ and from **fsource** otherwise.\n\n Because **tsource** and **fsource** are required to have the same type\n and type parameters (for both the declared and dynamic types), the\n result is polymorphic if and only if both **tsource** and **fsource**\n are polymorphic.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_merge\nimplicit none\ninteger :: tvals(2,3), fvals(2,3), answer(2,3)\nlogical :: mask(2,3)\ninteger :: i\ninteger :: k\nlogical :: chooseleft\n\n ! Works with scalars\n k=5\n write(*,*)merge (1.0, 0.0, k > 0)\n k=-2\n write(*,*)merge (1.0, 0.0, k > 0)\n\n ! set up some simple arrays that all conform to the\n ! same shape\n tvals(1,:)=[ 10, -60, 50 ]\n tvals(2,:)=[ -20, 40, -60 ]\n\n fvals(1,:)=[ 0, 3, 2 ]\n fvals(2,:)=[ 7, 4, 8 ]\n\n mask(1,:)=[ .true., .false., .true. ]\n mask(2,:)=[ .false., .false., .true. ]\n\n ! lets use the mask of specific values\n write(*,*)'mask of logicals'\n answer=merge( tvals, fvals, mask )\n call printme()\n\n ! more typically the mask is an expression\n write(*, *)'highest values'\n answer=merge( tvals, fvals, tvals > fvals )\n call printme()\n\n write(*, *)'lowest values'\n answer=merge( tvals, fvals, tvals < fvals )\n call printme()\n\n write(*, *)'zero out negative values'\n answer=merge( 0, tvals, tvals < 0)\n call printme()\n\n write(*, *)'binary choice'\n chooseleft=.false.\n write(*, '(3i4)')merge([1,2,3],[10,20,30],chooseleft)\n chooseleft=.true.\n write(*, '(3i4)')merge([1,2,3],[10,20,30],chooseleft)\n\ncontains\n\nsubroutine printme()\n write(*, '(3i4)')(answer(i, :), i=1, size(answer, dim=1))\nend subroutine printme\n\nend program demo_merge\n```\nExpected Results:\n```text\n > 1.00000000 \n > 0.00000000 \n > mask of logicals\n > 10 3 50\n > 7 4 -60\n > highest values\n > 10 3 50\n > 7 40 8\n > lowest values\n > 0 -60 2\n > -20 4 -60\n > zero out negative values\n > 10 0 50\n > 0 40 0\n > binary choice\n > 10 20 30\n > 1 2 3\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n- [**pack**(3)](#pack) packs an array into an array of rank one\n- [**spread**(3)](#spread) is used to add a dimension and replicate data\n- [**unpack**(3)](#unpack) scatters the elements of a vector\n- [**transpose**(3)](#transpose) - Transpose an array of rank two\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "MERGE": "## merge\n\n### **Name**\n\n**merge** - \\[ARRAY:CONSTRUCTION\\] Merge variables\n\n### **Synopsis**\n```fortran\n result = merge(tsource, fsource, mask)\n```\n```fortran\n elemental type(TYPE(kind=KIND)) function merge(tsource,fsource,mask)\n\n type(TYPE(kind=KIND)),intent(in) :: tsource\n type(TYPE(kind=KIND)),intent(in) :: fsource\n logical(kind=**),intent(in) :: mask\n mask** : Shall be of type logical.\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **tsource** May be of any type, including user-defined.\n - **fsource** Shall be of the same type and type parameters as **tsource**.\n - **mask** shall be of type logical.\n - The result will by of the same type and type parameters as **tsource**.\n\n\n### **Description**\n\nThe elemental function **merge** selects values from two arrays or\nscalars according to a logical mask. The result is equal to an element\nof **tsource** where the corresponding element of **mask** is _.true._, or an\nelement of **fsource** when it is _.false._ .\n\nMulti-dimensional arrays are supported.\n\nNote that argument expressions to **merge** are not required to be\nshort-circuited so (as an example) if the array **x** contains zero values\nin the statement below the standard does not prevent floating point\ndivide by zero being generated; as **1.0/x** may be evaluated for all values\nof **x** before the mask is used to select which value to retain:\n\n```fortran\n y = merge( 1.0/x, 0.0, x /= 0.0 )\n```\n\nNote the compiler is also free to short-circuit or to generate an\ninfinity so this may work in many programming environments but is not\nrecommended.\n\nFor cases like this one may instead use masked assignment via the **where**\nconstruct:\n\n```fortran\n where(x .ne. 0.0)\n y = 1.0/x\n elsewhere\n y = 0.0\n endwhere\n```\n\ninstead of the more obscure\n\n```fortran\n merge(1.0/merge(x,1.0,x /= 0.0), 0.0, x /= 0.0)\n```\n### **Options**\n\n- **tsource**\n : May be of any type, including user-defined.\n\n- **fsource**\n : Shall be of the same type and type parameters as **tsource**.\n\n- **mask**\n : Shall be of type _logical_.\n\nNote that (currently) _character_ values must be of the same length.\n\n### **Result**\n The result is built from an element of **tsource** if **mask** is\n _.true._ and from **fsource** otherwise.\n\n Because **tsource** and **fsource** are required to have the same type\n and type parameters (for both the declared and dynamic types), the\n result is polymorphic if and only if both **tsource** and **fsource**\n are polymorphic.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_merge\nimplicit none\ninteger :: tvals(2,3), fvals(2,3), answer(2,3)\nlogical :: mask(2,3)\ninteger :: i\ninteger :: k\nlogical :: chooseleft\n\n ! Works with scalars\n k=5\n write(*,*)merge (1.0, 0.0, k > 0)\n k=-2\n write(*,*)merge (1.0, 0.0, k > 0)\n\n ! set up some simple arrays that all conform to the\n ! same shape\n tvals(1,:)=[ 10, -60, 50 ]\n tvals(2,:)=[ -20, 40, -60 ]\n\n fvals(1,:)=[ 0, 3, 2 ]\n fvals(2,:)=[ 7, 4, 8 ]\n\n mask(1,:)=[ .true., .false., .true. ]\n mask(2,:)=[ .false., .false., .true. ]\n\n ! lets use the mask of specific values\n write(*,*)'mask of logicals'\n answer=merge( tvals, fvals, mask )\n call printme()\n\n ! more typically the mask is an expression\n write(*, *)'highest values'\n answer=merge( tvals, fvals, tvals > fvals )\n call printme()\n\n write(*, *)'lowest values'\n answer=merge( tvals, fvals, tvals < fvals )\n call printme()\n\n write(*, *)'zero out negative values'\n answer=merge( 0, tvals, tvals < 0)\n call printme()\n\n write(*, *)'binary choice'\n chooseleft=.false.\n write(*, '(3i4)')merge([1,2,3],[10,20,30],chooseleft)\n chooseleft=.true.\n write(*, '(3i4)')merge([1,2,3],[10,20,30],chooseleft)\n\ncontains\n\nsubroutine printme()\n write(*, '(3i4)')(answer(i, :), i=1, size(answer, dim=1))\nend subroutine printme\n\nend program demo_merge\n```\nResults:\n```text\n > 1.00000000 \n > 0.00000000 \n > mask of logicals\n > 10 3 50\n > 7 4 -60\n > highest values\n > 10 3 50\n > 7 40 8\n > lowest values\n > 0 -60 2\n > -20 4 -60\n > zero out negative values\n > 10 0 50\n > 0 40 0\n > binary choice\n > 10 20 30\n > 1 2 3\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n- [**pack**(3)](#pack) packs an array into an array of rank one\n- [**spread**(3)](#spread) is used to add a dimension and replicate data\n- [**unpack**(3)](#unpack) scatters the elements of a vector\n- [**transpose**(3)](#transpose) - Transpose an array of rank two\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MERGE_BITS": "## merge_bits\n\n### **Name**\n\n**merge_bits** - \\[BIT:COPY\\] Merge bits using a mask\n\n### **Synopsis**\n```fortran\n result = merge_bits(i, j, mask)\n```\n```fortran\n elemental integer(kind=KIND) function merge_bits(i,j,mask)\n\n integer(kind=KIND), intent(in) :: i, j, mask\n```\n### **Characteristics**\n\n - the result and all input values have the same _integer_ type and\n KIND with the exception that the mask and either **i** or **j** may be\n a BOZ constant.\n\n### **Description**\n\nA common graphics operation in Ternary Raster Operations is to combine\nbits from two different sources, generally referred to as bit-blending.\n**merge_bits** performs a masked bit-blend of **i** and **j** using\nthe bits of the **mask** value to determine which of the input values\nto copy bits from.\n\nSpecifically, The k-th bit of the result is equal to the k-th bit of\n**i** if the k-th bit of **mask** is **1**; it is equal to the k-th bit\nof **j** otherwise (so all three input values must have the same number\nof bits).\n\nThe resulting value is the same as would result from\n```fortran\n ior (iand (i, mask),iand (j, not (mask)))\n```\nAn exception to all values being of the same _integer_ type is that **i**\nor **j** and/or the mask may be a BOZ constant (A BOZ constant means it is\neither a Binary, Octal, or Hexadecimal literal constant). The BOZ values\nare converted to the _integer_ type of the non-BOZ value(s) as if called\nby the intrinsic function **int()** with the kind of the non-BOZ value(s),\nso the BOZ values must be in the range of the type of the result.\n\n### **Options**\n\n- **i**\n : value to select bits from when the associated bit in the mask is **1**.\n\n- **j**\n : value to select bits from when the associated bit in the mask is **0**.\n\n- **mask**\n : a value whose bits are used as a mask to select bits from **i** and **j**\n\n### **Result**\n\nThe bits blended from **i** and **j** using the mask **mask**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_merge_bits\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: if_one,if_zero,msk\ncharacter(len=*),parameter :: fmt='(*(g0, 1X))'\n\n ! basic usage\n print *,'MERGE_BITS( 5,10,41) should be 3.=>',merge_bits(5,10,41)\n print *,'MERGE_BITS(13,18,22) should be 4.=>',merge_bits(13,18,22)\n\n ! use some values in base2 illustratively:\n if_one =int(b'1010101010101010',kind=int16)\n if_zero=int(b'0101010101010101',kind=int16)\n\n msk=int(b'0101010101010101',kind=int16)\n print '(\"should get all zero bits =>\",b16.16)', &\n & merge_bits(if_one,if_zero,msk)\n\n msk=int(b'1010101010101010',kind=int16)\n print '(\"should get all ones bits =>\",b16.16)', &\n & merge_bits(if_one,if_zero,msk)\n\n ! using BOZ values\n print fmt, &\n & merge_bits(32767_int16, o'12345', 32767_int16), &\n & merge_bits(o'12345', 32767_int16, b'0000000000010101'), &\n & merge_bits(32767_int16, o'12345', z'1234')\n\n ! a do-it-yourself equivalent for comparison and validation\n print fmt, &\n & ior(iand(32767_int16, 32767_int16), &\n & iand(o'12345', not(32767_int16))), &\n\n & ior(iand(o'12345', int(o'12345', kind=int16)), &\n & iand(32767_int16, not(int(o'12345', kind=int16)))), &\n\n & ior(iand(32767_int16, z'1234'), &\n & iand(o'12345', not(int( z'1234', kind=int16))))\n\nend program demo_merge_bits\n```\nResults:\n```text\n MERGE_BITS( 5,10,41) should be 3.=> 3\n MERGE_BITS(13,18,22) should be 4.=> 4\n should get all zero bits =>0000000000000000\n should get all ones bits =>1111111111111111\n 32767 32751 5877\n 32767 32767 5877\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n[****(3)](#)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MIN": "## min\n\n### **Name**\n\n**min** - \\[NUMERIC\\] Minimum value of an argument list\n\n### **Synopsis**\n```fortran\n result = min(a1, a2, a3, ... )\n```\n```fortran\n elemental TYPE(kind=KIND) function min(a1, a2, a3, ... )\n\n TYPE(kind=KIND,intent(in) :: a1\n TYPE(kind=KIND,intent(in) :: a2\n TYPE(kind=KIND,intent(in) :: a3\n :\n :\n :\n```\n### **Characteristics**\n\n- **TYPE** may be _integer_, _real_ or _character_.\n\n### **Description**\n\n**min** returns the argument with the smallest (most negative) value.\n\nSee **max**(3) for an extended example of the behavior of **min** as\nand **max**(3).\n\n### **Options**\n\n- **a1**\n : the first element of the set of values to determine the minimum of.\n\n- **a2, a3, ...**\n : An expression of the same type and kind as **a1** completing the\n set of values to find the minimum of.\n\n### **Result**\n\nThe return value corresponds to the minimum value among the arguments,\nand has the same type and kind as the first argument.\n\n### **Examples**\n\nSample program\n```fortran\nprogram demo_min\nimplicit none\n write(*,*)min(10.0,11.0,30.0,-100.0)\nend program demo_min\n```\nResults:\n```\n -100.0000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**maxloc**(3)](#maxloc),\n[**minloc**(3)](#minloc),\n[**minval**(3)](#minval),\n[**max**(3)](#max),\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MINEXPONENT": "## minexponent\n\n### **Name**\n\n**minexponent** - \\[NUMERIC MODEL\\] Minimum exponent of a real kind\n\n### **Synopsis**\n```fortran\n result = minexponent(x)\n```\n```fortran\n elemental integer function minexponent(x)\n\n real(kind=**),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is a _real_ scalar or array of any _real_ kind\n - the result is a default _integer_ scalar\n\n### **Description**\n\n **minexponent** returns the minimum exponent in the model of the\n type of **x**.\n\n### **Options**\n\n- **x**\n : A value used to select the kind of _real_ to return a value for.\n\n### **Result**\n\n The value returned is the maximum exponent for the kind of the value\n queried\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_minexponent\nuse, intrinsic :: iso_fortran_env, only : &\n &real_kinds, real32, real64, real128\nimplicit none\nreal(kind=real32) :: x\nreal(kind=real64) :: y\n print *, minexponent(x), maxexponent(x)\n print *, minexponent(y), maxexponent(y)\nend program demo_minexponent\n```\nExpected Results:\n```\n -125 128\n -1021 1024\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[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -139,7 +139,7 @@ "MOD": "## mod\n\n### **Name**\n\n**mod** - \\[NUMERIC\\] Remainder function\n\n### **Synopsis**\n```fortran\n result = mod(a, p)\n```\n```fortran\n elemental type(TYPE(kind=KIND)) function mod(a,p)\n\n type(TYPE(kind=KIND)),intent(in) :: a\n type(TYPE(kind=KIND)),intent(in) :: p\n```\n### **Characteristics**\n\n - The result and arguments are all of the same type and kind.\n - The type may be any kind of _real_ or _integer_.\n\n### **Description**\n\n**mod** computes the remainder of the division of **a** by **p**.\n\n In mathematics, the remainder is the amount \"left over\" after\n performing some computation. In arithmetic, the remainder is the\n integer \"left over\" after dividing one integer by another to produce\n an integer quotient (integer division). In algebra of polynomials, the\n remainder is the polynomial \"left over\" after dividing one polynomial\n by another. The modulo operation is the operation that produces such\n a remainder when given a dividend and divisor.\n\n - (remainder). (2022, October 10). In Wikipedia.\n https://en.wikipedia.org/wiki/Remainder\n\n### **Options**\n\n- **a**\n : The dividend\n\n- **p**\n : the divisor (not equal to zero).\n\n### **Result**\n\n The return value is the result of **a - (int(a/p) \\* p)**.\n\n As can be seen by the formula the sign of **p** is canceled out.\n Therefore the returned value always has the sign of **a**.\n\n Of course, the magnitude of the result will be less than the magnitude\n of **p**, as the result has been reduced by all multiples of **p**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_mod\nimplicit none\n\n ! basics\n print *, mod( -17, 3 ), modulo( -17, 3 )\n print *, mod( 17, -3 ), modulo( 17, -3 )\n print *, mod( 17, 3 ), modulo( 17, 3 )\n print *, mod( -17, -3 ), modulo( -17, -3 )\n\n print *, mod(-17.5, 5.2), modulo(-17.5, 5.2)\n print *, mod( 17.5,-5.2), modulo( 17.5,-5.2)\n print *, mod( 17.5, 5.2), modulo( 17.5, 5.2)\n print *, mod(-17.5,-5.2), modulo(-17.5,-5.2)\n\n ! with a divisor of 1 the fractional part is returned\n print *, mod(-17.5, 1.0), modulo(-17.5, 1.0)\n print *, mod( 17.5,-1.0), modulo( 17.5,-1.0)\n print *, mod( 17.5, 1.0), modulo( 17.5, 1.0)\n print *, mod(-17.5,-1.0), modulo(-17.5,-1.0)\n\nend program demo_mod\n```\nResults:\n```text\n -2 1\n 2 -1\n 2 2\n -2 -2\n -1.900001 3.299999\n 1.900001 -3.299999\n 1.900001 1.900001\n -1.900001 -1.900001\n -0.5000000 0.5000000\n 0.5000000 -0.5000000\n 0.5000000 0.5000000\n -0.5000000 -0.5000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n - [**modulo**(3)](#modulo) - Modulo function\n - [**aint**(3)](#aint) - truncate toward zero to a whole _real_ number\n - [**int**(3)](#int) - truncate toward zero to a whole _integer_ number\n - [**anint**(3)](#anint) - _real_ nearest whole number\n - [**nint**(3)](#nint) - _integer_ nearest whole number\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MODULO": "## modulo\n\n### **Name**\n\n**modulo** - \\[NUMERIC\\] Modulo function\n\n### **Synopsis**\n```fortran\n result = modulo(a, p)\n```\n```fortran\n elemental TYPE(kind=KIND) function modulo(a,p)\n\n TYPE(kind=KIND),intent(in) :: a\n TYPE(kind=KIND),intent(in) :: p\n```\n### **Characteristics**\n\n - **a** may be any kind of _real_ or _integer_.\n - **p** is the same type and kind as **a**\n - The result and arguments are all of the same type and kind.\n\n### **Description**\n\n**modulo** computes the **a** modulo **p**.\n\n### **Options**\n\n- **a**\n : the value to take the **modulo** of\n\n- **p**\n : The value to reduce **a** by till the remainder is <= **p**.\n It shall not be zero.\n\n### **Result**\n\nThe type and kind of the result are those of the arguments.\n\n- If **a** and **p** are of type _integer_: **modulo(a,p)** has the value of\n **a - floor (real(a) / real(p)) \\* p**.\n\n- If **a** and **p** are of type _real_: **modulo(a,p)** has the value of\n **a - floor (a / p) \\* p**.\n\nThe returned value has the same sign as **p** and a magnitude less than the\nmagnitude of **p**.\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_modulo\nimplicit none\n print *, modulo(17,3) ! yields 2\n print *, modulo(17.5,5.5) ! yields 1.0\n\n print *, modulo(-17,3) ! yields 1\n print *, modulo(-17.5,5.5) ! yields 4.5\n\n print *, modulo(17,-3) ! yields -1\n print *, modulo(17.5,-5.5) ! yields -4.5\nend program demo_modulo\n```\nResults:\n```text\n > 2\n > 1.000000\n > 1\n > 4.500000\n > -1\n > -4.500000\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**mod**(3)](#mod)\n\n _fortran-lang intrinsic descriptions_\n", "MOVE_ALLOC": "## move_alloc\n\n### **Name**\n\n**move_alloc** - \\[MEMORY\\] Move allocation from one object to another\n\n### **Synopsis**\n```fortran\n call move_alloc(from, to [,stat] [,errmsg] )\n```\n```fortran\n subroutine move_alloc(from, to)\n\n type(TYPE(kind=**)),intent(inout),allocatable :: from(..)\n type(TYPE(kind=**)),intent(out),allocatable :: to(..)\n integer(kind=**),intent(out) :: stat\n character(len=*),intent(inout) :: errmsg\n```\n### **Characteristics**\n\n- **from** may be of any type and kind.\n- **to** shall be of the same type, kind and rank as **from**.\n\n### **Description**\n\n**move_alloc** moves the allocation from **from** to\n**to**. **from** will become deallocated in the process.\n\nThis is potentially more efficient than other methods of assigning\nthe values in **from** to **to** and explicitly deallocating **from**,\nwhich are far more likely to require a temporary object or a copy of\nthe elements of the array.\n\n### **Options**\n\n- **from**\n : The data object to be moved to **to** and deallocated.\n\n- **to**\n : The destination data object to move the allocated data object **from**\n to. Typically, it is a different shape than **from**.\n\n- **stat**\n : If **stat** is present and execution is successful, it is assigned the\n value zero.\n : If an error condition occurs,\n\n o if **stat** is absent, error termination is initiated;\n o otherwise, if **from** is a coarray and the current team contains a\n stopped image, **stat** is assigned the value STAT\\_STOPPED\\_IMAGE\n from the intrinsic module ISO\\_FORTRAN\\_ENV;\n o otherwise, if **from** is a coarray and the current team contains\n a failed image, and no other error condition\n occurs, **stat** is assigned the value STAT\\_FAILED\\_IMAGE from the\n intrinsic module ISO\\_FORTRAN\\_ENV;\n o otherwise, **stat** is assigned a processor-dependent positive value\n that differs from that of STAT\\_STOPPED\\_IMAGE or STAT\\_FAILED\\_IMAGE.\n\n- **errmsg**\n : If the **errmsg** argument is present and an error condition occurs,\n it is assigned an explanatory message. If no error condition occurs,\n the definition status and value of **errmsg** are unchanged.\n\n### **Examples**\n\nBasic sample program to allocate a bigger grid\n\n```fortran\nprogram demo_move_alloc\nimplicit none\n! Example to allocate a bigger GRID\nreal, allocatable :: grid(:), tempgrid(:)\ninteger :: n, i\n\n ! initialize small GRID\n n = 3\n allocate (grid(1:n))\n grid = [ (real (i), i=1,n) ]\n\n ! initialize TEMPGRID which will be used to replace GRID\n allocate (tempgrid(1:2*n)) ! Allocate bigger grid\n tempgrid(::2) = grid ! Distribute values to new locations\n tempgrid(2::2) = grid + 0.5 ! initialize other values\n\n ! move TEMPGRID to GRID\n call MOVE_ALLOC (from=tempgrid, to=grid)\n\n ! TEMPGRID should no longer be allocated\n ! and GRID should be the size TEMPGRID was\n if (size (grid) /= 2*n .or. allocated (tempgrid)) then\n print *, \"Failure in move_alloc!\"\n endif\n print *, allocated(grid), allocated(tempgrid)\n print '(99f8.3)', grid\nend program demo_move_alloc\n```\n\nResults:\n\n```text\n T F\n 1.000 1.500 2.000 2.500 3.000 3.500\n```\n\n### **Standard**\n\nFortran 2003, STAT and ERRMSG options added 2018\n\n### **See Also**\n\n[**allocated**(3)](#allocated)\n\n _fortran-lang intrinsic descriptions_\n\n", - "MVBITS": "## mvbits\n\n### **Name**\n\n**mvbits** - \\[BIT:COPY\\] Reproduce bit patterns found in one integer in another\n\n### **Synopsis**\n```fortran\n call mvbits(from, frompos, len, to, topos)\n```\n```fortran\n elemental subroutine mvbits( from, frompos, len, to, topos )\n\n integer(kind=KIND),intent(in) :: from\n integer(kind=**),intent(in) :: frompos\n integer(kind=**),intent(in) :: len\n integer(kind=KIND),intent(inout) :: to\n integer(kind=**),intent(in) :: topos\n```\n### **Characteristics**\n\n - **from** is an _integer_\n - **frompos** is an integer\n - **len** is an integer\n - **to** is an integer of the same kind as **from**.\n - **topos** is an integer\n\n### **Description**\n\n**mvbits** copies a bit pattern found in a range of adjacent bits in\nthe _integer_ **from** to a specified position in another integer **to**\n(which is of the same kind as **from**). It otherwise leaves the bits\nin **to** as-is.\n\nThe bit positions copied must exist within the value of **from**.\nThat is, the values of **frompos+len-1** and **topos+len-1** must be\nnonnegative and less than **bit_size**(from).\n\nThe bits are numbered **0** to **bit_size(i)-1**, from right to left.\n\n### **Options**\n\n- **from**\n : An _integer_ to read bits from.\n\n- **frompos**\n : **frompos** is the position of the first bit to copy. It is a\n nonnegative _integer_ value < **bit_size(from)**.\n\n- **len**\n : A nonnegative _integer_ value that indicates how many bits to\n copy from **from**. It must not specify copying bits past the end\n of **from**. That is, **frompos + len** must be less than or equal\n to **bit_size(from)**.\n\n- **to**\n : The _integer_ variable to place the copied bits into. It must\n be of the same kind as **from** and may even be the same variable\n as **from**, or associated to it.\n\n **to** is set by copying the sequence of bits of length **len**,\n starting at position **frompos** of **from** to position **topos** of\n **to**. No other bits of **to** are altered. On return, the **len**\n bits of **to** starting at **topos** are equal to the value that\n the **len** bits of **from** starting at **frompos** had on entry.\n\n- **topos**\n : A nonnegative _integer_ value indicating the starting location in\n **to** to place the specified copy of bits from **from**.\n **topos + len** must be less than or equal to **bit_size(to)**.\n\n### **Examples**\n\nSample program that populates a new 32-bit integer with its bytes\nin reverse order from the input value (ie. changes the Endian of the integer).\n```fortran\nprogram demo_mvbits\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int32) :: intfrom, intto, abcd_int\ncharacter(len=*),parameter :: bits= '(g0,t30,b32.32)'\ncharacter(len=*),parameter :: fmt= '(g0,t30,a,t40,b32.32)'\n\n intfrom=huge(0) ! all bits are 1 accept the sign bit\n intto=0 ! all bits are 0\n\n !! CHANGE BIT 0\n ! show the value and bit pattern\n write(*,bits)intfrom,intfrom\n write(*,bits)intto,intto\n\n ! copy bit 0 from intfrom to intto to show the rightmost bit changes\n ! (from, frompos, len, to, topos)\n call mvbits(intfrom, 0, 1, intto, 0) ! change bit 0\n write(*,bits)intto,intto\n\n !! COPY PART OF A VALUE TO ITSELF\n ! can copy bit from a value to itself\n call mvbits(intfrom,0,1,intfrom,31)\n write(*,bits)intfrom,intfrom\n\n !! MOVING BYTES AT A TIME\n ! make native integer value with bit patterns\n ! that happen to be the same as the beginning of the alphabet\n ! to make it easy to see the bytes are reversed\n abcd_int=transfer('abcd',0)\n ! show the value and bit pattern\n write(*,*)'native'\n write(*,fmt)abcd_int,abcd_int,abcd_int\n\n ! change endian of the value\n abcd_int=int_swap32(abcd_int)\n ! show the values and their bit pattern\n write(*,*)'non-native'\n write(*,fmt)abcd_int,abcd_int,abcd_int\n\n contains\n\n pure elemental function int_swap32(intin) result(intout)\n ! Convert a 32 bit integer from big Endian to little Endian,\n ! or conversely from little Endian to big Endian.\n !\n integer(kind=int32), intent(in) :: intin\n integer(kind=int32) :: intout\n ! copy bytes from input value to new position in output value\n ! (from, frompos, len, to, topos)\n call mvbits(intin, 0, 8, intout, 24) ! byte1 to byte4\n call mvbits(intin, 8, 8, intout, 16) ! byte2 to byte3\n call mvbits(intin, 16, 8, intout, 8) ! byte3 to byte2\n call mvbits(intin, 24, 8, intout, 0) ! byte4 to byte1\n end function int_swap32\n\n end program demo_mvbits\n```\nResults:\n```text\n\n 2147483647 01111111111111111111111111111111\n 0 00000000000000000000000000000000\n 1 00000000000000000000000000000001\n -1 11111111111111111111111111111111\n native\n 1684234849 abcd 01100100011000110110001001100001\n non-native\n 1633837924 dcba 01100001011000100110001101100100\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ieor**(3)](#ieor),\n[**ibclr**(3)](#ibclr),\n[**not**(3)](#not),\n[**btest**(3)](#btest),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**iand**(3)](#iand),\n[**ior**(3)](#ior),\n[**ieor**(3)](#ieor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "MVBITS": "## mvbits\n\n### **Name**\n\n**mvbits** - \\[BIT:COPY\\] Reproduce bit patterns found in one integer in another\n\n### **Synopsis**\n```fortran\n call mvbits(from, frompos, len, to, topos)\n```\n```fortran\n elemental subroutine mvbits( from, frompos, len, to, topos )\n\n integer(kind=KIND),intent(in) :: from\n integer(kind=**),intent(in) :: frompos\n integer(kind=**),intent(in) :: len\n integer(kind=KIND),intent(inout) :: to\n integer(kind=**),intent(in) :: topos\n```\n### **Characteristics**\n\n - **from** is an _integer_\n - **frompos** is an integer\n - **len** is an integer\n - **to** is an integer of the same kind as **from**.\n - **topos** is an integer\n\n### **Description**\n\n**mvbits** copies a bit pattern found in a range of adjacent bits in\nthe _integer_ **from** to a specified position in another integer **to**\n(which is of the same kind as **from**). It otherwise leaves the bits\nin **to** as-is.\n\nThe bit positions copied must exist within the value of **from**.\nThat is, the values of **frompos+len-1** and **topos+len-1** must be\nnonnegative and less than **bit_size**(from).\n\nThe bits are numbered **0** to **bit_size(i)-1**, from right to left.\n\n### **Options**\n\n- **from**\n : An _integer_ to read bits from.\n\n- **frompos**\n : **frompos** is the position of the first bit to copy. It is a\n nonnegative _integer_ value < **bit_size(from)**.\n\n- **len**\n : A nonnegative _integer_ value that indicates how many bits to\n copy from **from**. It must not specify copying bits past the end\n of **from**. That is, **frompos + len** must be less than or equal\n to **bit_size(from)**.\n\n- **to**\n : The _integer_ variable to place the copied bits into. It must\n be of the same kind as **from** and may even be the same variable\n as **from**, or associated to it.\n\n **to** is set by copying the sequence of bits of length **len**,\n starting at position **frompos** of **from** to position **topos** of\n **to**. No other bits of **to** are altered. On return, the **len**\n bits of **to** starting at **topos** are equal to the value that\n the **len** bits of **from** starting at **frompos** had on entry.\n\n- **topos**\n : A nonnegative _integer_ value indicating the starting location in\n **to** to place the specified copy of bits from **from**.\n **topos + len** must be less than or equal to **bit_size(to)**.\n\n### **Examples**\n\nSample program that populates a new 32-bit integer with its bytes\nin reverse order from the input value (ie. changes the Endian of the integer).\n```fortran\nprogram demo_mvbits\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int32) :: intfrom, intto, abcd_int\ncharacter(len=*),parameter :: bits= '(g0,t30,b32.32)'\ncharacter(len=*),parameter :: fmt= '(g0,t30,a,t40,b32.32)'\n\n intfrom=huge(0) ! all bits are 1 accept the sign bit\n intto=0 ! all bits are 0\n\n !! CHANGE BIT 0\n ! show the value and bit pattern\n write(*,bits)intfrom,intfrom\n write(*,bits)intto,intto\n\n ! copy bit 0 from intfrom to intto to show the rightmost bit changes\n ! (from, frompos, len, to, topos)\n call mvbits(intfrom, 0, 1, intto, 0) ! change bit 0\n write(*,bits)intto,intto\n\n !! COPY PART OF A VALUE TO ITSELF\n ! can copy bit from a value to itself\n call mvbits(intfrom,0,1,intfrom,31)\n write(*,bits)intfrom,intfrom\n\n !! MOVING BYTES AT A TIME\n ! make native integer value with bit patterns\n ! that happen to be the same as the beginning of the alphabet\n ! to make it easy to see the bytes are reversed\n abcd_int=transfer('abcd',0)\n ! show the value and bit pattern\n write(*,*)'native'\n write(*,fmt)abcd_int,abcd_int,abcd_int\n\n ! change endian of the value\n abcd_int=int_swap32(abcd_int)\n ! show the values and their bit pattern\n write(*,*)'non-native'\n write(*,fmt)abcd_int,abcd_int,abcd_int\n\n contains\n\n pure elemental function int_swap32(intin) result(intout)\n ! Convert a 32 bit integer from big Endian to little Endian,\n ! or conversely from little Endian to big Endian.\n !\n integer(kind=int32), intent(in) :: intin\n integer(kind=int32) :: intout\n ! copy bytes from input value to new position in output value\n ! (from, frompos, len, to, topos)\n call mvbits(intin, 0, 8, intout, 24) ! byte1 to byte4\n call mvbits(intin, 8, 8, intout, 16) ! byte2 to byte3\n call mvbits(intin, 16, 8, intout, 8) ! byte3 to byte2\n call mvbits(intin, 24, 8, intout, 0) ! byte4 to byte1\n end function int_swap32\n\n end program demo_mvbits\n```\nResults:\n```text\n\n 2147483647 01111111111111111111111111111111\n 0 00000000000000000000000000000000\n 1 00000000000000000000000000000001\n -1 11111111111111111111111111111111\n native\n 1684234849 abcd 01100100011000110110001001100001\n non-native\n 1633837924 dcba 01100001011000100110001101100100\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**not**(3)](#not)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "NEAREST": "## nearest\n\n### **Name**\n\n**nearest** - \\[MODEL_COMPONENTS\\] Nearest representable number\n\n### **Synopsis**\n```fortran\n result = nearest(x, s)\n```\n```fortran\n elemental real(kind=KIND) function nearest(x,s)\n\n real(kind=KIND),intent(in) :: x\n real(kind=**),intent(in) :: s\n```\n### **Characteristics**\n\n- **x** may be a _real_ value of any kind.\n- **s** may be a _real_ value of any kind.\n- The return value is of the same type and kind as **x**.\n- a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**nearest** returns the processor-representable number nearest to\n**x** in the direction indicated by the sign of **s**.\n\n### **Options**\n\n- **x**\n : the value to find the nearest representable value of\n\n- **s**\n : a non-zero value whose sign is used to determine the direction in\n which to search from **x** to the representable value.\n\n If **s** is positive, **nearest** returns the processor-representable\n number greater than **x** and nearest to it.\n\n If **s** is negative, **nearest** returns the processor-representable\n number smaller than **x** and nearest to it.\n\n### **Result**\n\nThe return value is of the same type as **x**. If **s** is positive, **nearest**\nreturns the processor-representable number greater than **x** and nearest to\nit. If **s** is negative, **nearest** returns the processor-representable number\nsmaller than **x** and nearest to it.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_nearest\nimplicit none\n\n real :: x, y\n x = nearest(42.0, 1.0)\n y = nearest(42.0, -1.0)\n write (*,\"(3(g20.15))\") x, y, x - y\n\n! write (*,\"(3(g20.15))\") &\n! nearest(tiny(0.0),1.0), &\n! nearest(tiny(0.0),-1.0), &\n! nearest(tiny(0.0),1.0) -nearest(tiny(0.0),-1.0)\n\n! write (*,\"(3(g20.15))\") &\n! nearest(huge(0.0),1.0), &\n! nearest(huge(0.0),-1.0), &\n! nearest(huge(0.0),1.0)- nearest(huge(0.0),-1.0)\n\nend program demo_nearest\n```\nResults:\n```text\n 42.0000038146973 41.9999961853027 .762939453125000E-05\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[**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", "NEW_LINE": "## new_line\n\n### **Name**\n\n**new_line** - \\[CHARACTER:INQUIRY\\] Newline character\n\n### **Synopsis**\n```fortran\n result = new_line(c)\n```\n```fortran\n character(len=1,kind=KIND) function new_line(c)\n\n character(len=1,kind=KIND),intent(in) :: c(..)\n```\n### **Characteristics**\n\n - **c** shall be of type _character_. It may be a scalar or an array.\n - the result is a _character_ scalar of length one with the same kind type parameter as **c**.\n\n### **Description**\n\n**new_line** returns the newline character.\n\nNormally, newlines are generated with regular formatted I/O statements like\nWRITE() and PRINT() when each statement completes:\n```fortran\n print *, 'x=11'\n print *\n print *, 'y=22'\n end\n```\nproduces:\n x=11\n\n y=22\n```\nAlternatively, a \"/\" descriptor in a format is used to generate a\nnewline on the output. For example:\n```fortran\n write(*,'(a,1x,i0,/,a)') 'x =',11,'is the answer'\n end\n```\nproduces:\n```text\n x = 11\n is the answer\n```\nAlso, for formatted sequential output if more data is listed on the\noutput statement than can be represented by the format statement a\nnewline is generated and then the format is reused until the output\nlist is exhausted.\n```fortran\n write(*,'(a,\"=\",i0)') 'x', 10, 'y', 20\n end\n```\nproduces\n```text\n x=10\n y=20\n```\nBut there are occasions, particularly when non-advancing I/O or stream\nI/O is being generated (which does not generate a newline at the end\nof each WRITE statement, as normally occurs) where it is preferable to\nplace a newline explicitly in the output at specified points.\n\nTo do so you must make sure you are generating the correct newline\ncharacter, which the techniques above do automatically.\n\nThe newline character varies between some platforms, and can even\ndepend on the encoding (ie. which character set is being used) of the\noutput file. In these cases selecting the correct character to output\ncan be determined by the **new_line** procedure.\n\n### **Options**\n\n- **c**\n : an arbitrary character whose kind is used to decide on the output\n character that represents a newline.\n\n### **Result**\n\nCase (i)\n : If **a** is default _character_ and the character in position **10**\n of the ASCII collating sequence is representable in the default\n character set, then the result is **achar(10)**.\n\n This is the typical case, and just requires using \"new_line('a')\".\n\nCase (ii)\n : If **a** is an ASCII character or an ISO 10646 character, then the\n result is **char(10, kind (a))**.\n\nCase (iii)\n : Otherwise, the result is a processor-dependent character that\n represents a newline in output to files connected for formatted\n stream output if there is such a character.\n\nCase (iv)\n : If not of the previous cases apply, the result is the blank character.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_new_line\nimplicit none\ncharacter,parameter :: nl=new_line('a')\ncharacter(len=:),allocatable :: string\nreal :: r\ninteger :: i, count\n\n ! basics\n ! print a string with a newline embedded in it\n string='This is record 1.'//nl//'This is record 2.'\n write(*,'(a)') string\n\n ! print a newline character string\n write(*,'(*(a))',advance='no') &\n nl,'This is record 1.',nl,'This is record 2.',nl\n\n ! output a number of words of random length as a paragraph\n ! by inserting a new_line before line exceeds 70 characters\n\n ! simplistic paragraph print using non-advancing I/O\n count=0\n do i=1,100\n\n ! make some fake word of random length\n call random_number(r)\n string=repeat('x',int(r*10)+1)\n\n count=count+len(string)+1\n if(count.gt.70)then\n write(*,'(a)',advance='no')nl\n count=len(string)+1\n endif\n write(*,'(1x,a)',advance='no')string\n enddo\n write(*,'(a)',advance='no')nl\n\nend program demo_new_line\n```\nResults:\n```text\n This is record 1.\n This is record 2.\n\n This is record 1.\n This is record 2.\n x x xxxx xxxxxxx xxxxxxxxxx xxxxxxxxx xxxx xxxxxxxxxx xxxxxxxx\n xxxxxxxxx xxxx xxxxxxxxx x xxxxxxxxx xxxxxxxx xxxxxxxx xxxx x\n xxxxxxxxxx x x x xxxxxx xxxxxxxxxx x xxxxxxxxxx x xxxxxxx xxxxxxxxx\n xx xxxxxxxxxx xxxxxxxx x xx xxxxxxxxxx xxxxxxxx xxx xxxxxxx xxxxxx\n xxxxx xxxxxxxxx x xxxxxxxxxx xxxxxx xxxxxxxx xxxxx xxxxxxxx xxxxxxxx\n xxxxx xxx xxxxxxxx xxxxxxx xxxxxxxx xxx xxxx xxx xxxxxxxx xxxxxx\n xxxxxxx xxxxxxx xxxxx xxxxx xx xxxxxx xx xxxxxxxxxx xxxxxx x xxxx\n xxxxxx xxxxxxx x xxx xxxxx xxxxxxxxx xxx xxxxxxx x xxxxxx xxxxxxxxx\n xxxx xxxxxxxxx xxxxxxxx xxxxxxxx xxx xxxxxxx xxxxxxx xxxxxxxxxx\n xxxxxxxxxx xxxxxx xxxxx xxxx xxxxxxx xx xxxxxxxxxx xxxxxx xxxxxx\n xxxxxx xxxx xxxxx\n```\n### **Standard**\n\nFortran 2003\n\n### **See also**\n\n[**achar**(3)](#achar),\n[**char**(3)](#char),\n[**iachar**(3)](#iachar),\n[**ichar**(3)](#ichar),\n[**selected_char_kind**(3)](#selected_char_kind)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "NINT": "## nint\n\n### **Name**\n\n**nint** - \\[TYPE:NUMERIC\\] Nearest whole number\n\n### **Synopsis**\n```fortran\n result = nint( a [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function nint(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 type real of any kind\n - **KIND** is a scalar integer constant expression\n - The result is default _integer_ kind or the value of **kind**\n if **kind** is present.\n\n### **Description**\n\n **nint** rounds its argument to the nearest whole number with its\n sign preserved.\n\n The user must ensure the value is a valid value for the range of the\n **kind** returned. If the processor cannot represent the result in the kind\n specified, the result is undefined.\n\n If **a** is greater than zero, **nint(a)** has the value **int(a+0.5)**.\n\n If **a** is less than or equal to zero, **nint(a)** has the value\n **int(a-0.5)**.\n\n### **Options**\n\n- **a**\n : The value to round to the nearest whole number\n\n- **kind**\n : can specify the kind of the output value. If not present, the\n output is the default type of _integer_.\n\n### **Result**\n\n The result is the integer nearest **a**, or if there are two integers\n equally near **a**, the result is whichever such _integer_ has the greater\n magnitude.\n\n The result is undefined if it cannot be represented in the specified\n integer type.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_nint\nimplicit none\ninteger,parameter :: dp=kind(0.0d0)\nreal,allocatable :: in(:)\ninteger,allocatable :: out(:)\ninteger :: i\nreal :: x4\nreal(kind=dp) :: x8\n\n ! basic use\n x4 = 1.234E0\n x8 = 4.721_dp\n print *, nint(x4), nint(-x4)\n print *, nint(x8), nint(-x8)\n\n ! elemental\n in = [ -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, -0.4, &\n & 0.0, &\n & +0.04, +0.5, +1.0, +1.5, +2.0, +2.2, +2.5, +2.7 ]\n out = nint(in)\n do i=1,size(in)\n write(*,*)in(i),out(i)\n enddo\n\n ! dusty corners\n ISSUES: block\n use,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\n integer :: icheck\n ! make sure input is in range for the type returned\n write(*,*)'Range limits for typical KINDS:'\n write(*,'(1x,g0,1x,g0)') &\n & int8,huge(0_int8), &\n & int16,huge(0_int16), &\n & int32,huge(0_int32), &\n & int64,huge(0_int64)\n\n ! the standard does not require this to be an error ...\n x8=12345.67e15 ! too big of a number\n icheck=selected_int_kind(ceiling(log10(x8)))\n write(*,*)'Any KIND big enough? ICHECK=',icheck\n print *, 'These are all wrong answers for ',x8\n print *, nint(x8,kind=int8)\n print *, nint(x8,kind=int16)\n print *, nint(x8,kind=int32)\n print *, nint(x8,kind=int64)\n endblock ISSUES\n\nend program demo_nint\n```\nResults:\n```text\n > 1 -1\n > 5 -5\n > -2.700000 -3\n > -2.500000 -3\n > -2.200000 -2\n > -2.000000 -2\n > -1.500000 -2\n > -1.000000 -1\n > -0.5000000 -1\n > -0.4000000 0\n > 0.0000000E+00 0\n > 3.9999999E-02 0\n > 0.5000000 1\n > 1.000000 1\n > 1.500000 2\n > 2.000000 2\n > 2.200000 2\n > 2.500000 3\n > 2.700000 3\n > Range limits for typical KINDS:\n > 1 127\n > 2 32767\n > 4 2147483647\n > 8 9223372036854775807\n > Any KIND big enough? ICHECK= -1\n > These are all wrong answers for 1.234566949990144E+019\n > 0\n > 0\n > -2147483648\n > -9223372036854775808\n```\n### **Standard**\n\nFORTRAN 77 , with KIND argument - Fortran 90\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n",