diff --git a/fortls/intrinsic.procedures.markdown.json b/fortls/intrinsic.procedures.markdown.json index b2ca4ad5..65869d82 100644 --- a/fortls/intrinsic.procedures.markdown.json +++ b/fortls/intrinsic.procedures.markdown.json @@ -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\n```fortran\n program demo_count\n implicit none\n character(len=*),parameter :: ints='(*(i2,1x))'\n ! two arrays and a mask all with the same shape\n integer, dimension(2,3) :: a, b\n logical, dimension(2,3) :: mymask\n integer :: i\n integer :: c(2,3,4)\n\n print *,'the numeric arrays we will compare'\n a = reshape( [ 1, 2, 3, 4, 5, 6 ], [ 2, 3 ])\n b = reshape( [ 0, 7, 3, 4, 5, 8 ], [ 2, 3 ])\n c = reshape( [( i,i=1,24)], [ 2, 3 ,4])\n print '(3i3)', a(1,:)\n print '(3i3)', a(2,:)\n print *\n print '(3i3)', b(1,:)\n print '(3i3)', b(2,:)\n !\n ! basic calls\n print *, 'count a few basic things creating a mask from an expression'\n print *, 'count a>b',count(a>b)\n print *, '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", @@ -81,7 +81,7 @@ "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(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", + "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", @@ -125,7 +125,7 @@ "LOG_GAMMA": "## log_gamma\n\n### **Name**\n\n**log_gamma** - \\[MATHEMATICS\\] Logarithm of the absolute value of\nthe Gamma function\n\n### **Synopsis**\n```fortran\n result = log_gamma(x)\n```\n```fortran\n elemental real(kind=KIND) function log_gamma(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_ type\n - the return value is of same type and kind as **x**.\n\n### **Description**\n\n **log_gamma** computes the natural logarithm of the absolute value\n of the Gamma function.\n\n### **Options**\n\n- **x**\n : neither negative nor zero value to render the result for.\n\n### **Result**\n\n The result has a value equal to a processor-dependent approximation\n to the natural logarithm of the absolute value of the gamma function\n of **x**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_log_gamma\nimplicit none\nreal :: x = 1.0\n write(*,*)x,log_gamma(x) ! returns 0.0\n write(*,*)x,log_gamma(3.0) ! returns 0.693 (approximately)\nend program demo_log_gamma\n```\nResults:\n```text\n > 1.000000 0.0000000E+00\n > 1.000000 0.6931472\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nGamma function: [**gamma**(3)](#gamma)\n\n _fortran-lang intrinsic descriptions_\n", "MASKL": "## maskl\n\n### **Name**\n\n**maskl** - \\[BIT:SET\\] Generates a left justified mask\n\n### **Synopsis**\n```fortran\n result = maskl( i [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function maskl(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\n- **kind** Shall be a scalar constant expression of type _integer_\n whose value is a supported _integer_ kind.\n- The result is an _integer_ of the same _kind_ as **i** unless **kind** is\n present, which is then used to specify the kind of the result.\n\n### **Description**\n\n **maskl** has its leftmost **i** bits set to **1**, and the remaining\n bits set to **0**.\n\n### **Options**\n\n- **i**\n : the number of left-most bits to set in the _integer_ result. It\n must be from 0 to the number of bits for the kind of the result.\n The default kind of the result is the same as **i** unless the result\n size is specified by **kind**. That is, these Fortran statements must\n be _.true._ :\n```fortran\n i >= 0 .and. i < bitsize(i) ! if KIND is not specified\n i >= 0 .and. i < bitsize(0_KIND) ! if KIND is specified\n```\n- **kind**\n : designates the kind of the _integer_ result.\n\n### **Result**\n\n The leftmost **i** bits of the output _integer_ are set to 1 and the\n other bits are set to 0.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_maskl\nimplicit none\ninteger :: i\n ! basics\n i=3\n write(*,'(i0,1x,b0)') i, maskl(i)\n\n ! elemental\n write(*,'(*(i11,1x,b0.32,1x,/))') maskl([(i,i,i=0,bit_size(0),4)])\nend program demo_maskl\n```\nResults:\n```text\n > 3 11100000000000000000000000000000\n > 0 00000000000000000000000000000000\n > -268435456 11110000000000000000000000000000\n > -16777216 11111111000000000000000000000000\n > -1048576 11111111111100000000000000000000\n > -65536 11111111111111110000000000000000\n > -4096 11111111111111111111000000000000\n > -256 11111111111111111111111100000000\n > -16 11111111111111111111111111110000\n > -1 11111111111111111111111111111111\n\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**maskr**(3)](#maskr)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MASKR": "## maskr\n\n### **Name**\n\n**maskr** - \\[BIT:SET\\] Generates a right-justified mask\n\n### **Synopsis**\n```fortran\n result = maskr( i [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function maskr(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\n- **kind** Shall be a scalar constant expression of type _integer_\n whose value is a supported _integer_ kind.\n- The result is an _integer_ of the same _kind_ as **i** unless **kind** is\n present, which is then used to specify the kind of the result.\n\n### **Description**\n\n **maskr** generates an _integer_ with its rightmost **i**\n bits set to 1, and the remaining bits set to 0.\n\n### **Options**\n\n- **i**\n : the number of right-most bits to set in the _integer_ result. It\n must be from 0 to the number of bits for the kind of the result.\n The default kind of the result is the same as **i** unless the result\n size is specified by **kind**. That is, these Fortran statements must\n be _.true._ :\n```fortran\n i >= 0 .and. i < bitsize(i) ! if KIND is not specified\n i >= 0 .and. i < bitsize(0_KIND) ! if KIND is specified\n```\n- **kind**\n : designates the kind of the _integer_ result.\n\n### **Result**\n\n The rightmost **i** bits of the output _integer_ are set to 1 and the\n other bits are set to 0.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_maskr\nimplicit none\ninteger :: i\n\n ! basics\n print *,'basics'\n write(*,'(i0,t5,b32.32)') 1, maskr(1)\n write(*,'(i0,t5,b32.32)') 5, maskr(5)\n write(*,'(i0,t5,b32.32)') 11, maskr(11)\n print *,\"should be equivalent on two's-complement processors\"\n write(*,'(i0,t5,b32.32)') 1, shiftr(-1,bit_size(0)-1)\n write(*,'(i0,t5,b32.32)') 5, shiftr(-1,bit_size(0)-5)\n write(*,'(i0,t5,b32.32)') 11, shiftr(-1,bit_size(0)-11)\n\n ! elemental\n print *,'elemental '\n print *,'(array argument accepted like called with each element)'\n write(*,'(*(i11,1x,b0.32,1x,/))') maskr([(i,i,i=0,bit_size(0),4)])\n\nend program demo_maskr\n```\nResults:\n```text\n > basics\n > 1 00000000000000000000000000000001\n > 5 00000000000000000000000000011111\n > 11 00000000000000000000011111111111\n > should be equivalent on two's-complement processors\n > 1 00000000000000000000000000000001\n > 5 00000000000000000000000000011111\n > 11 00000000000000000000011111111111\n > elemental\n > (array argument accepted like called with each element)\n > 0 00000000000000000000000000000000\n > 15 00000000000000000000000000001111\n > 255 00000000000000000000000011111111\n > 4095 00000000000000000000111111111111\n > 65535 00000000000000001111111111111111\n > 1048575 00000000000011111111111111111111\n > 16777215 00000000111111111111111111111111\n > 268435455 00001111111111111111111111111111\n > -1 11111111111111111111111111111111\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**maskl**(3)](#maskl)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "MATMUL": "## matmul\n\n### **Name**\n\n**matmul** - \\[TRANSFORMATIONAL\\] Numeric or logical matrix\nmultiplication\n\n### **Synopsis**\n```fortran\n result = matmul(matrix_a,matrix_b)\n```\n```fortran\n function matmul(matrix_a, matrix_b)\n\n type(TYPE1(kind=**) :: matrix_a(..)\n type(TYPE2(kind=**) :: matrix_b(..)\n type(TYPE(kind=PROMOTED)) :: matmul(..)\n```\n### **Characteristics**\n\n - **matrix_a** is a numeric (_integer_, _real_, or _complex_ ) or\n _logical_ array of rank one two.\n - **matrix_b** is a numeric (_integer_, _real_, or _complex_ ) or\n _logical_ array of rank one two.\n - At least one argument must be rank two.\n - the size of the first dimension of **matrix_b** must equal the size\n of the last dimension of **matrix_a**.\n - the type of the result is the same as if an element of each argument\n had been multiplied as a RHS expression (that is, if the arguments\n are not of the same type the result follows the same rules of promotion\n as a simple scalar multiplication of the two types would produce)\n - If one argument is _logical_, both must be _logical_. For logicals\n the resulting type is as if the _.and._ operator has been used on\n elements from the arrays.\n - The shape of the result depends on the shapes of the arguments\n as described below.\n\n### **Description**\n\n **matmul** performs a matrix multiplication on numeric or logical\n arguments.\n\n### **Options**\n\n- **matrix_a**\n : A numeric or logical array with a rank of one or two.\n\n- **matrix_b**\n : A numeric or logical array with a rank of one or two. The last\n dimension of **matrix_a** and the first dimension of **matrix_b**\n must be equal.\n\n Note that **matrix_a** and **matrix_b** may be different numeric\n types.\n\n### **Result**\n\n#### **Numeric Arguments**\n\n If **matrix_a** and **matrix_b** are numeric the result is an\n array containing the conventional matrix product of **matrix_a**\n and **matrix_b**.\n\n First, for the numeric expression **C=matmul(A,B)**\n\n - Any vector **A(n)** is treated as a row vector **A(1,n)**.\n - Any vector **B(n)** is treated as a column vector **B(n,1)**.\n\n##### **Shape and Rank**\n\n The shape of the result can then be determined as the number of rows\n of the first matrix and the number of columns of the second; but if\n any argument is of rank one (a vector) the result is also rank one.\n Conversely when both arguments are of rank two, the result has a rank\n of two. That is ...\n\n + If **matrix_a** has shape [n,m] and **matrix_b** has shape [m,k],\n the result has shape [n,k].\n + If **matrix_a** has shape [m] and **matrix_b** has shape [m,k],\n the result has shape [k].\n + If **matrix_a** has shape [n,m] and **matrix_b** has shape [m],\n the result has shape [n].\n\n##### **Values**\n\n Then element **C(i,j)** of the product is obtained by multiplying\n term-by-term the entries of the ith row of **A** and the jth column\n of **B**, and summing these products. In other words, **C(i,j)**\n is the dot product of the ith row of **A** and the jth column of **B**.\n\n#### **Logical Arguments**\n\n##### **Values**\n\n If **matrix_a** and **matrix_b** are of type logical, the array elements\n of the result are instead:\n```fortran\n Value_of_Element (i,j) = &\n ANY( (row_i_of_MATRIX_A) .AND. (column_j_of_MATRIX_B) )\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_matmul\nimplicit none\ninteger :: a(2,3), b(3,2), c(2), d(3), e(2,2), f(3), g(2), v1(4),v2(4)\n a = reshape([1, 2, 3, 4, 5, 6], [2, 3])\n b = reshape([10, 20, 30, 40, 50, 60], [3, 2])\n c = [1, 2]\n d = [1, 2, 3]\n e = matmul(a, b)\n f = matmul(c,a)\n g = matmul(a,d)\n\n call print_matrix_int('A is ',a)\n call print_matrix_int('B is ',b)\n call print_vector_int('C is ',c)\n call print_vector_int('D is ',d)\n call print_matrix_int('E is matmul(A,B)',e)\n call print_vector_int('F is matmul(C,A)',f)\n call print_vector_int('G is matmul(A,D)',g)\n\n ! look at argument shapes when one is a vector\n write(*,'(\" > shape\")')\n ! at least one argument must be of rank two\n ! so for two vectors at least one must be reshaped\n v1=[11,22,33,44]\n v2=[10,20,30,40]\n\n ! these return a vector C(1:1)\n ! treat A(1:n) as A(1:1,1:n)\n call print_vector_int('Cd is a vector (not a scalar)',&\n & matmul(reshape(v1,[1,size(v1)]),v2))\n ! or treat B(1:m) as B(1:m,1:1)\n call print_vector_int('cD is a vector too',&\n & matmul(v1,reshape(v2,[size(v2),1])))\n\n ! or treat A(1:n) as A(1:1,1:n) and B(1:m) as B(1:m,1:1)\n ! but note this returns a matrix C(1:1,1:1) not a vector!\n call print_matrix_int('CD is a matrix',matmul(&\n & reshape(v1,[1,size(v1)]), &\n & reshape(v2,[size(v2),1])))\n\ncontains\n\n! CONVENIENCE ROUTINES TO PRINT IN ROW-COLUMN ORDER\nsubroutine print_vector_int(title,arr)\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:)\n call print_matrix_int(title,reshape(arr,[1,shape(arr)]))\nend subroutine print_vector_int\n\nsubroutine print_matrix_int(title,arr)\n!@(#) print small 2d integer arrays in row-column format\ncharacter(len=*),parameter :: all='(\" > \",*(g0,1x))' ! a handy format\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n print all\n print all, trim(title)\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(real(maxval(abs(arr)))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\nend subroutine print_matrix_int\n\nend program demo_matmul\n```\nResults:\n```text\n >\n > A is\n > [ 1, 3, 5 ]\n > [ 2, 4, 6 ]\n >\n > B is\n > [ 10, 40 ]\n > [ 20, 50 ]\n > [ 30, 60 ]\n >\n > C is\n > [ 1, 2 ]\n >\n > D is\n > [ 1, 2, 3 ]\n >\n > E is matmul(A,B)\n > [ 220, 490 ]\n > [ 280, 640 ]\n >\n > F is matmul(C,A)\n > [ 5, 11, 17 ]\n >\n > G is matmul(A,D)\n > [ 22, 28 ]\n > shape\n >\n > Cd is a vector (not a scalar)\n > [ 3300 ]\n >\n > cD is a vector too\n > [ 3300 ]\n >\n > CD is a matrix\n > [ 3300 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**product**(3)](#product),\n[**transpose**(3)](#transpose)\n\n### **Resources**\n\n- [Matrix multiplication : Wikipedia](https://en.wikipedia.org/wiki/Matrix_multiplication)\n- The Winograd variant of Strassen's matrix-matrix multiply algorithm may\n be of interest for optimizing multiplication of very large matrices. See\n```text\n \"GEMMW: A portable level 3 BLAS Winograd variant of Strassen's\n matrix-matrix multiply algorithm\",\n\n Douglas, C. C., Heroux, M., Slishman, G., and Smith, R. M.,\n Journal of Computational Physics,\n Vol. 110, No. 1, January 1994, pages 1-10.\n\n The numerical instabilities of Strassen's method for matrix\n multiplication requires special processing.\n```\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "MATMUL": "## matmul\n\n### **Name**\n\n**matmul** - \\[TRANSFORMATIONAL\\] Numeric or logical matrix\nmultiplication\n\n### **Synopsis**\n```fortran\n result = matmul(matrix_a,matrix_b)\n```\n```fortran\n function matmul(matrix_a, matrix_b)\n\n type(TYPE1(kind=**) :: matrix_a(..)\n type(TYPE2(kind=**) :: matrix_b(..)\n type(TYPE(kind=PROMOTED)) :: matmul(..)\n```\n### **Characteristics**\n\n - **matrix_a** is a numeric (_integer_, _real_, or _complex_ ) or\n _logical_ array of rank one two.\n - **matrix_b** is a numeric (_integer_, _real_, or _complex_ ) or\n _logical_ array of rank one two.\n - At least one argument must be rank two.\n - the size of the first dimension of **matrix_b** must equal the size\n of the last dimension of **matrix_a**.\n - the type of the result is the same as if an element of each argument\n had been multiplied as a RHS expression (that is, if the arguments\n are not of the same type the result follows the same rules of promotion\n as a simple scalar multiplication of the two types would produce)\n - If one argument is _logical_, both must be _logical_. For logicals\n the resulting type is as if the _.and._ operator has been used on\n elements from the arrays.\n - The shape of the result depends on the shapes of the arguments\n as described below.\n\n### **Description**\n\n **matmul** performs a matrix multiplication on numeric or logical\n arguments.\n\n### **Options**\n\n- **matrix_a**\n : A numeric or logical array with a rank of one or two.\n\n- **matrix_b**\n : A numeric or logical array with a rank of one or two. The last\n dimension of **matrix_a** and the first dimension of **matrix_b**\n must be equal.\n\n Note that **matrix_a** and **matrix_b** may be different numeric\n types.\n\n### **Result**\n\n#### **Numeric Arguments**\n\n If **matrix_a** and **matrix_b** are numeric the result is an\n array containing the conventional matrix product of **matrix_a**\n and **matrix_b**.\n\n First, for the numeric expression **C=matmul(A,B)**\n\n - Any vector **A(n)** is treated as a row vector **A(1,n)**.\n - Any vector **B(n)** is treated as a column vector **B(n,1)**.\n\n##### **Shape and Rank**\n\n The shape of the result can then be determined as the number of rows\n of the first matrix and the number of columns of the second; but if\n any argument is of rank one (a vector) the result is also rank one.\n Conversely when both arguments are of rank two, the result has a rank\n of two. That is ...\n\n + If **matrix_a** has shape [n,m] and **matrix_b** has shape [m,k],\n the result has shape [n,k].\n + If **matrix_a** has shape [m] and **matrix_b** has shape [m,k],\n the result has shape [k].\n + If **matrix_a** has shape [n,m] and **matrix_b** has shape [m],\n the result has shape [n].\n\n##### **Values**\n\n Then element **C(i,j)** of the product is obtained by multiplying\n term-by-term the entries of the ith row of **A** and the jth column\n of **B**, and summing these products. In other words, **C(i,j)**\n is the dot product of the ith row of **A** and the jth column of **B**.\n\n#### **Logical Arguments**\n\n##### **Values**\n\n If **matrix_a** and **matrix_b** are of type logical, the array elements\n of the result are instead:\n```fortran\n Value_of_Element (i,j) = &\n ANY( (row_i_of_MATRIX_A) .AND. (column_j_of_MATRIX_B) )\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_matmul\nimplicit none\ninteger :: a(2,3), b(3,2), c(2), d(3), e(2,2), f(3), g(2), v1(4),v2(4)\n a = reshape([1, 2, 3, 4, 5, 6], [2, 3])\n b = reshape([10, 20, 30, 40, 50, 60], [3, 2])\n c = [1, 2]\n d = [1, 2, 3]\n e = matmul(a, b)\n f = matmul(c,a)\n g = matmul(a,d)\n\n call print_matrix_int('A is ',a)\n call print_matrix_int('B is ',b)\n call print_vector_int('C is ',c)\n call print_vector_int('D is ',d)\n call print_matrix_int('E is matmul(A,B)',e)\n call print_vector_int('F is matmul(C,A)',f)\n call print_vector_int('G is matmul(A,D)',g)\n\n ! look at argument shapes when one is a vector\n write(*,'(\" > shape\")')\n ! at least one argument must be of rank two\n ! so for two vectors at least one must be reshaped\n v1=[11,22,33,44]\n v2=[10,20,30,40]\n\n ! these return a vector C(1:1)\n ! treat A(1:n) as A(1:1,1:n)\n call print_vector_int('Cd is a vector (not a scalar)',&\n & matmul(reshape(v1,[1,size(v1)]),v2))\n ! or treat B(1:m) as B(1:m,1:1)\n call print_vector_int('cD is a vector too',&\n & matmul(v1,reshape(v2,[size(v2),1])))\n\n ! or treat A(1:n) as A(1:1,1:n) and B(1:m) as B(1:m,1:1)\n ! but note this returns a matrix C(1:1,1:1) not a vector!\n call print_matrix_int('CD is a matrix',matmul(&\n & reshape(v1,[1,size(v1)]), &\n & reshape(v2,[size(v2),1])))\n\ncontains\n\n! CONVENIENCE ROUTINES TO PRINT IN ROW-COLUMN ORDER\nsubroutine print_vector_int(title,arr)\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:)\n call print_matrix_int(title,reshape(arr,[1,shape(arr)]))\nend subroutine print_vector_int\n\nsubroutine print_matrix_int(title,arr)\n!@(#) print small 2d integer arrays in row-column format\ncharacter(len=*),parameter :: all='(\" > \",*(g0,1x))' ! a handy format\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n print all\n print all, trim(title)\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\nend subroutine print_matrix_int\n\nend program demo_matmul\n```\nResults:\n```text\n >\n > A is\n > [ 1, 3, 5 ]\n > [ 2, 4, 6 ]\n >\n > B is\n > [ 10, 40 ]\n > [ 20, 50 ]\n > [ 30, 60 ]\n >\n > C is\n > [ 1, 2 ]\n >\n > D is\n > [ 1, 2, 3 ]\n >\n > E is matmul(A,B)\n > [ 220, 490 ]\n > [ 280, 640 ]\n >\n > F is matmul(C,A)\n > [ 5, 11, 17 ]\n >\n > G is matmul(A,D)\n > [ 22, 28 ]\n > shape\n >\n > Cd is a vector (not a scalar)\n > [ 3300 ]\n >\n > cD is a vector too\n > [ 3300 ]\n >\n > CD is a matrix\n > [ 3300 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**product**(3)](#product),\n[**transpose**(3)](#transpose)\n\n### **Resources**\n\n- [Matrix multiplication : Wikipedia](https://en.wikipedia.org/wiki/Matrix_multiplication)\n- The Winograd variant of Strassen's matrix-matrix multiply algorithm may\n be of interest for optimizing multiplication of very large matrices. See\n```text\n \"GEMMW: A portable level 3 BLAS Winograd variant of Strassen's\n matrix-matrix multiply algorithm\",\n\n Douglas, C. C., Heroux, M., Slishman, G., and Smith, R. M.,\n Journal of Computational Physics,\n Vol. 110, No. 1, January 1994, pages 1-10.\n\n The numerical instabilities of Strassen's method for matrix\n multiplication requires special processing.\n```\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MAX": "## max\n\n### **Name**\n\n**max** - \\[NUMERIC\\] Maximum value of an argument list\n\n### **Synopsis**\n```fortran\n result = max(a1, a2, a3, ...)\n```\n```fortran\n elemental TYPE(kind=KIND) function max(a1, a2, a3, ... )\n\n TYPE(kind=KIND,intent(in),optional :: a1\n TYPE(kind=KIND,intent(in),optional :: a2\n TYPE(kind=KIND,intent(in),optional :: a3\n :\n :\n :\n```\n### **Characteristics**\n\n - **a3, a3, a4, ...** must be of the same type and kind as **a1**\n - the arguments may (all) be _integer_, _real_ or _character_\n - there must be at least two arguments\n - the length of a character result is the length of the longest argument\n - the type and kind of the result is the same as those of the arguments\n\n### **Description**\n\n **max** returns the argument with the largest (most positive) value.\n\n For arguments of character type, the result is as if the arguments had\n been successively compared with the intrinsic operational operators,\n taking into account the collating sequence of the _character_ kind.\n\n If the selected _character_ argument is shorter than the longest\n argument, the result is as all values were extended with blanks on\n the right to the length of the longest argument.\n\n It is unusual for a Fortran intrinsic to take an arbitrary number of\n options, and in addition **max** is elemental, meaning any number\n of arguments may be arrays as long as they are of the same shape.\n The examples have an extended description clarifying the resulting\n behavior for those not familiar with calling a \"scalar\" function\n elementally with arrays.\n\n See maxval(3) for simply getting the max value of an array.\n\n### **Options**\n\n- **a1**\n : The first argument determines the type and kind of the returned\n value, and of any remaining arguments as well as being a member of\n the set of values to find the maximum (most positive) value of.\n\n- **a2,a3,...**\n : the remaining arguments of which to find the maximum value(s) of.\n : There must be at least two arguments to **max(3)**.\n\n### **Result**\n\n The return value corresponds to an array of the same shape of any\n array argument, or a scalar if all arguments are scalar.\n\n The returned value when any argument is an array will be an array of\n the same shape where each element is the maximum value occurring at\n that location, treating all the scalar values as arrays of that same\n shape with all elements set to the scalar value.\n\n### **Examples**\n\nSample program\n```fortran\nprogram demo_max\nimplicit none\nreal :: arr1(4)= [10.0,11.0,30.0,-100.0]\nreal :: arr2(5)= [20.0,21.0,32.0,-200.0,2200.0]\ninteger :: box(3,4)= reshape([-6,-5,-4,-3,-2,-1,1,2,3,4,5,6],shape(box))\n\n ! basic usage\n ! this is simple enough when all arguments are scalar\n\n ! the most positive value is returned, not the one with the\n ! largest magnitude\n write(*,*)'scalars:',max(10.0,11.0,30.0,-100.0)\n write(*,*)'scalars:',max(-22222.0,-0.0001)\n\n ! strings do not need to be of the same length\n write(*,*)'characters:',max('the','words','order')\n\n ! leading spaces are significant; everyone is padded on the right\n ! to the length of the longest argument\n write(*,*)'characters:',max('c','bb','a')\n write(*,*)'characters:',max(' c','b','a')\n\n ! elemental\n ! there must be at least two arguments, so even if A1 is an array\n ! max(A1) is not valid. See MAXVAL(3) and/or MAXLOC(3) instead.\n\n ! strings in a single array do need to be of the same length\n ! but the different objects can still be of different lengths.\n write(*,\"(*('\"\"',a,'\"\"':,1x))\")MAX(['A','Z'],['BB','Y '])\n ! note the result is now an array with the max of every element\n ! position, as can be illustrated numerically as well:\n write(*,'(a,*(i3,1x))')'box= ',box\n write(*,'(a,*(i3,1x))')'box**2=',sign(1,box)*box**2\n write(*,'(a,*(i3,1x))')'max ',max(box,sign(1,box)*box**2)\n\n ! Remember if any argument is an array by the definition of an\n ! elemental function all the array arguments must be the same shape.\n\n ! to find the single largest value of arrays you could use something\n ! like MAXVAL([arr1, arr2]) or probably better (no large temp array),\n ! max(maxval(arr1),maxval(arr2)) instead\n\n ! so this returns an array of the same shape as any input array\n ! where each result is the maximum that occurs at that position.\n write(*,*)max(arr1,arr2(1:4))\n ! this returns an array just like arr1 except all values less than\n ! zero are set to zero:\n write(*,*)max(box,0)\n ! When mixing arrays and scalars you can think of the scalars\n ! as being a copy of one of the arrays with all values set to\n ! the scalar value.\n\nend program demo_max\n```\nResults:\n```text\n scalars: 30.00000\n scalars: -9.9999997E-05\n characters:words\n characters:c\n characters:b\n \"BB\" \"Z \"\n box= -6 -5 -4 -3 -2 -1 1 2 3 4 5 6\n box**2=-36 -25 -16 -9 -4 -1 1 4 9 16 25 36\n max -6 -5 -4 -3 -2 -1 1 4 9 16 25 36\n 20.00000 21.00000 32.00000 -100.0000\n 0 0 0 0 0 0\n 1 2 3 4 5 6\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**maxloc**(3)](#maxloc),\n[**minloc**(3)](#minloc),\n[**maxval**(3)](#maxval),\n[**minval**(3)](#minval),\n[**min**(3)](#min)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "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", @@ -154,7 +154,7 @@ "POPPAR": "## poppar\n\n### **Name**\n\n**poppar** - \\[BIT:COUNT\\] Parity of the number of bits set\n\n### **Synopsis**\n```fortran\n result = poppar(i)\n```\n```fortran\n elemental integer function poppar(i)\n\n integer(kind=KIND), intent(in) :: i\n```\n### **Characteristics**\n\n- **i** is an _integer_ of any kind\n- the return value is a default kind _integer_\n\n### **Description**\n\n **poppar** returns the parity of an integer's binary representation\n (i.e., the parity of the number of bits set).\n\n The parity is expressed as\n\n + **0** (zero) if **i** has an even number of bits set to **1**.\n + **1** (one) if the number of bits set to one **1** is odd,\n\n### **Options**\n\n- **i**\n : The value to query for its bit parity\n\n### **Result**\n\n The return value is equal to **0** if **i** has an even number of bits\n set and **1** if an odd number of bits are set.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_poppar\nuse, intrinsic :: iso_fortran_env, only : integer_kinds, &\n & int8, int16, int32, int64\nimplicit none\ncharacter(len=*),parameter :: pretty='(b64,1x,i0)'\n ! basic usage\n print pretty, 127, poppar(127)\n print pretty, 128, poppar(128)\n print pretty, int(b\"01010\"), poppar(int(b\"01010\"))\n\n ! any kind of an integer can be used\n print pretty, huge(0_int8), poppar(huge(0_int8))\n print pretty, huge(0_int16), poppar(huge(0_int16))\n print pretty, huge(0_int32), poppar(huge(0_int32))\n print pretty, huge(0_int64), poppar(huge(0_int64))\nend program demo_poppar\n```\nResults:\n```text\n > 1111111 1\n > 10000000 1\n > 1010 0\n > 1111111111111111111111111111111 1\n > 1111111 1\n > 111111111111111 1\n > 1111111111111111111111111111111 1\n > 111111111111111111111111111111111111111111111111111111111111111 1\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nThere are many procedures that operator or query values at the bit level:\n\n[**popcnt**(3)](#popcnt),\n[**leadz**(3)](#leadz),\n[**trailz**(3)](#trailz)\n[**atomic_and**(3)](#atomic_and),\n[**atomic_fetch_and**(3)](#atomic_fetch_and),\n[**atomic_fetch_or**(3)](#atomic_fetch_or),\n[**atomic_fetch_xor**(3)](#atomic_fetch_xor),\n[**atomic_or**(3)](#atomic_or),\n[**atomic_xor**(3)](#atomic_xor),\n[**bge**(3)](#bge),\n[**bgt**(3)](#bgt),\n[**bit_size**(3)](#bit_size),\n[**ble**(3)](#ble),\n[**blt**(3)](#blt),\n[**btest**(3)](#btest),\n[**dshiftl**(3)](#dshiftl),\n[**dshiftr**(3)](#dshiftr),\n[**iall**(3)](#iall),\n[**iand**(3)](#iand),\n[**iany**(3)](#iany),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**iparity**(3)](#iparity),\n[**ishftc**(3)](#ishftc),\n[**ishft**(3)](#ishft),\n[**maskl**(3)](#maskl),\n[**maskr**(3)](#maskr),\n[**merge_bits**(3)](#merge_bits),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not),\n[**shifta**(3)](#shifta),\n[**shiftl**(3)](#shiftl),\n[**shiftr**(3)](#shiftr),\n[**storage_size**(3)](#storage_size)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "PRECISION": "## precision\n\n### **Name**\n\n**precision** - \\[NUMERIC MODEL\\] Decimal precision of a real kind\n\n### **Synopsis**\n```fortran\n result = precision(x)\n```\n```fortran\n integer function precision(x)\n\n TYPE(kind=**),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** shall be of type _real_ or _complex_. It may be a scalar or an array.\n - the result is a default _integer_ scalar.\n\n### **Description**\n\n **precision** returns the decimal precision in the model of the type\n of **x**.\n\n### **Options**\n\n- **x**\n : the type and kind of the argument are used to determine which number\n model to query. The value of the argument is not unused; it may even\n be undefined.\n\n### **Result**\n\n The precision of values of the type and kind of **x**\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_precision\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=sp) :: x(2)\ncomplex(kind=dp) :: y\n\n print *, precision(x), range(x)\n print *, precision(y), range(y)\n\nend program demo_precision\n```\nResults:\n```text\n > 6 37\n > 15 307\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**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", "PRESENT": "## present\n\n### **Name**\n\n**present** - [STATE:INQUIRY\\] Determine whether an optional dummy argument\nis specified\n\n### **Synopsis**\n```fortran\n result = present(a)\n```\n```fortran\n logical function present (a)\n\n type(TYPE(kind=KIND)) :: a(..)\n```\n### **Characteristics**\n\n- **a** May be of any type and may be a pointer, scalar or array value,\n or a dummy procedure.\n\n### **Description**\n\n **present** can be used in a procedure to determine if an optional\n dummy argument was present on the current call to the procedure.\n\n **a** shall be the name of an optional dummy argument that is accessible\n in the subprogram in which the **present** function reference\n appears. There are no other requirements on **a**.\n\n Note when an argument is not present when the current procedure is\n invoked, you may only pass it as an optional argument to another\n procedure or pass it as an argument to **present**.\n\n### **Options**\n\n- **a**\n : the name of an optional dummy argument accessible within the current\n subroutine or function.\n\n### **Result**\n\n Returns _.true._ if the optional argument **a** is present (was passed\n on the call to the procedure) , or _.false._ otherwise.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_present\nimplicit none\ninteger :: answer\n ! argument to func() is not present\n answer=func()\n write(*,*) answer\n ! argument to func() is present\n answer=func(1492)\n write(*,*) answer\ncontains\n!\ninteger function func(x)\n! the optional characteristic on this definition allows this variable\n! to not be specified on a call; and also allows it to subsequently\n! be passed to PRESENT(3):\ninteger, intent(in), optional :: x\ninteger :: x_local\n !\n ! basic\n if(present(x))then\n ! if present, you can use x like any other variable.\n x_local=x\n else\n ! if not, you cannot define or reference x except to\n ! pass it as an optional parameter to another procedure\n ! or in a call to present(3f)\n x_local=0\n endif\n !\n func=x_local**2\n !\n ! passing the argument on to other procedures\n ! so something like this is a bad idea because x is used\n ! as the first argument to merge(3f) when it might not be\n ! present\n ! xlocal=merge(x,0,present(x)) ! NO!!\n !\n ! We can pass it to another procedure if another\n ! procedure declares the argument as optional as well,\n ! or we have tested that X is present\n call tattle('optional argument x',x)\n if(present(x))call not_optional(x)\nend function\n!\nsubroutine tattle(label,arg)\ncharacter(len=*),intent(in) :: label\ninteger,intent(in),optional :: arg\n if(present(arg))then\n write(*,*)label,' is present'\n else\n write(*,*)label,' is not present'\n endif\nend subroutine tattle\n!\nsubroutine not_optional(arg)\ninteger,intent(in) :: arg\n write(*,*)'already tested X is defined',arg\nend subroutine not_optional\n!\nend program demo_present\n```\nResults:\n```text\n optional argument x is not present\n 0\n optional argument x is present\n already tested X is defined 1492\n 2226064\n```\n### **Standard**\n\nFortran 95\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "PRODUCT": "## product\n\n### **Name**\n\n**product** - \\[ARRAY:REDUCTION\\] Product of array elements\n\n### **Synopsis**\n```fortran\n result = product(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function product(array, dim, mask)\n\n NUMERIC,intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **NUMERIC** is any numeric type and kind.\n\n### **Description**\n\n**product** multiplies together all the selected elements of **array**,\nor along dimension **dim** if the corresponding element in **mask**\nis _.true._.\n\nIf **dim** is absent, a scalar with the product of all elements in **array** is\nreturned. (Note a zero-sized **array** returns **1**).\n\nWhen **dim** is present, If the masked array has a dimension of one\n(ie. is a vector) the result is a scalar. Otherwise, an array of rank\n**n-1**, where **n** equals the rank of **array**, and a shape similar\nto that of **array** with dimension **dim** dropped is returned.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_ or _complex_.\n\n- **dim**\n : shall be a scalar of type _integer_ with a value in the\n range from **1 to n**, where **n** equals the rank of **array**.\n\n- **mask**\n : shall be of type _logical_ and either be a scalar or an\n array of the same shape as **array**.\n\n### **Result**\n\nThe result is of the same type as **array**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_product\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))' ! a handy format\ncharacter(len=1),parameter :: nl=new_line('a')\n\nNO_DIM: block\n! If DIM is not specified, the result is the product of all the\n! selected array elements.\ninteger :: i,n, p1, p2\ninteger,allocatable :: array(:)\n ! all elements are selected by default\n do n=1,10\n print all, 'factorial of ',n,' is ', product([(real(i),i=1,n)])\n enddo\n\n ! using a mask\n array=[10,12,13,15,20,25,30]\n p1=product(array, mask=mod(array, 2)==1) ! only odd elements\n p2=product(array, mask=mod(array, 2)/=1) ! only even elements\n print all, nl,'product of all elements',product(array) ! all elements\n print all, ' odd * even =',nl,p1,'*',p2,'=',p1*p2\n\n ! NOTE: If ARRAY is a zero-sized array, the result is equal to one\n print all\n print all, 'zero-sized array=>',product([integer :: ])\n ! NOTE: If nothing in the mask is true, this also results in a null\n ! array\n print all, 'all elements have a false mask=>', &\n & product(array,mask=.false.)\n\nendblock NO_DIM\n\nWITH_DIM: block\ninteger :: rect(2,3)\ninteger :: box(2,3,4)\n\n! lets fill a few arrays\n rect = reshape([ &\n 1, 2, 3, &\n 4, 5, 6 &\n ],shape(rect),order=[2,1])\n call print_matrix_int('rect',rect)\n\n! Find the product of each column in RECT.\n print all, 'product of columns=',product(rect, dim = 1)\n\n! Find the product of each row in RECT.\n print all, 'product of rows=',product(rect, dim = 2)\n\n! now lets try a box\n box(:,:,1)=rect\n box(:,:,2)=rect*(+10)\n box(:,:,3)=rect*(-10)\n box(:,:,4)=rect*2\n ! lets look at the values\n call print_matrix_int('box 1',box(:,:,1))\n call print_matrix_int('box 2',box(:,:,2))\n call print_matrix_int('box 3',box(:,:,3))\n call print_matrix_int('box 4',box(:,:,4))\n\n ! remember without dim= even a box produces a scalar\n print all, 'no dim gives a scalar',product(real(box))\n\n ! only one plane has negative values, so note all the \"1\" values\n ! for vectors with no elements\n call print_matrix_int('negative values', &\n & product(box,mask=box < 0,dim=1))\n\n! If DIM is specified and ARRAY has rank greater than one, the\n! result is a new array in which dimension DIM has been eliminated.\n\n ! pick a dimension to multiply though\n call print_matrix_int('dim=1',product(box,dim=1))\n\n call print_matrix_int('dim=2',product(box,dim=2))\n\n call print_matrix_int('dim=3',product(box,dim=3))\n\nendblock WITH_DIM\n\ncontains\n\n subroutine print_matrix_int(title,arr)\n implicit none\n\n !@(#) print small 2d integer arrays in row-column format\n\n character(len=*),intent(in) :: title\n integer,intent(in) :: arr(:,:)\n integer :: i\n character(len=:),allocatable :: biggest\n\n print all\n print all, trim(title),':(',shape(arr),')' ! print title\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(real(maxval(abs(arr)))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\n end subroutine print_matrix_int\n\nend program demo_product\n```\n\nResults:\n\n```text\nfactorial of 1 is 1.000000\nfactorial of 2 is 2.000000\nfactorial of 3 is 6.000000\nfactorial of 4 is 24.00000\nfactorial of 5 is 120.0000\nfactorial of 6 is 720.0000\nfactorial of 7 is 5040.000\nfactorial of 8 is 40320.00\nfactorial of 9 is 362880.0\nfactorial of 10 is 3628800.\n\n product of all elements 351000000\n odd * even =\n 4875 * 72000 = 351000000\n\nzero-sized array=> 1\nall elements have a false mask=> 1\n\nrect :( 2 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\nproduct of columns= 4 10 18\nproduct of rows= 6 120\n\nbox 1 :( 2 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n\nbox 2 :( 2 3 )\n > [ 10, 20, 30 ]\n > [ 40, 50, 60 ]\n\nbox 3 :( 2 3 )\n > [ -10, -20, -30 ]\n > [ -40, -50, -60 ]\n\nbox 4 :( 2 3 )\n > [ 2, 4, 6 ]\n > [ 8, 10, 12 ]\nno dim gives a scalar .1719927E+26\n\nnegative values :( 3 4 )\n > [ 1, 1, 400, 1 ]\n > [ 1, 1, 1000, 1 ]\n > [ 1, 1, 1800, 1 ]\n\ndim=1 :( 3 4 )\n > [ 4, 400, 400, 16 ]\n > [ 10, 1000, 1000, 40 ]\n > [ 18, 1800, 1800, 72 ]\n\ndim=2 :( 2 4 )\n > [ 6, 6000, -6000, 48 ]\n > [ 120, 120000, -120000, 960 ]\n\ndim=3 :( 2 3 )\n > [ -200, -3200, -16200 ]\n > [ -51200, -125000, -259200 ]\n```\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**sum**(3)](#sum), note that an element by element multiplication is done\ndirectly using the star character.\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "PRODUCT": "## product\n\n### **Name**\n\n**product** - \\[ARRAY:REDUCTION\\] Product of array elements\n\n### **Synopsis**\n```fortran\n result = product(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function product(array, dim, mask)\n\n NUMERIC,intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **NUMERIC** is any numeric type and kind.\n\n### **Description**\n\n**product** multiplies together all the selected elements of **array**,\nor along dimension **dim** if the corresponding element in **mask**\nis _.true._.\n\nIf **dim** is absent, a scalar with the product of all elements in **array** is\nreturned. (Note a zero-sized **array** returns **1**).\n\nWhen **dim** is present, If the masked array has a dimension of one\n(ie. is a vector) the result is a scalar. Otherwise, an array of rank\n**n-1**, where **n** equals the rank of **array**, and a shape similar\nto that of **array** with dimension **dim** dropped is returned.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_ or _complex_.\n\n- **dim**\n : shall be a scalar of type _integer_ with a value in the\n range from **1 to n**, where **n** equals the rank of **array**.\n\n- **mask**\n : shall be of type _logical_ and either be a scalar or an\n array of the same shape as **array**.\n\n### **Result**\n\nThe result is of the same type as **array**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_product\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))' ! a handy format\ncharacter(len=1),parameter :: nl=new_line('a')\n\nNO_DIM: block\n! If DIM is not specified, the result is the product of all the\n! selected array elements.\ninteger :: i,n, p1, p2\ninteger,allocatable :: array(:)\n ! all elements are selected by default\n do n=1,10\n print all, 'factorial of ',n,' is ', product([(real(i),i=1,n)])\n enddo\n\n ! using a mask\n array=[10,12,13,15,20,25,30]\n p1=product(array, mask=mod(array, 2)==1) ! only odd elements\n p2=product(array, mask=mod(array, 2)/=1) ! only even elements\n print all, nl,'product of all elements',product(array) ! all elements\n print all, ' odd * even =',nl,p1,'*',p2,'=',p1*p2\n\n ! NOTE: If ARRAY is a zero-sized array, the result is equal to one\n print all\n print all, 'zero-sized array=>',product([integer :: ])\n ! NOTE: If nothing in the mask is true, this also results in a null\n ! array\n print all, 'all elements have a false mask=>', &\n & product(array,mask=.false.)\n\nendblock NO_DIM\n\nWITH_DIM: block\ninteger :: rect(2,3)\ninteger :: box(2,3,4)\n\n! lets fill a few arrays\n rect = reshape([ &\n 1, 2, 3, &\n 4, 5, 6 &\n ],shape(rect),order=[2,1])\n call print_matrix_int('rect',rect)\n\n! Find the product of each column in RECT.\n print all, 'product of columns=',product(rect, dim = 1)\n\n! Find the product of each row in RECT.\n print all, 'product of rows=',product(rect, dim = 2)\n\n! now lets try a box\n box(:,:,1)=rect\n box(:,:,2)=rect*(+10)\n box(:,:,3)=rect*(-10)\n box(:,:,4)=rect*2\n ! lets look at the values\n call print_matrix_int('box 1',box(:,:,1))\n call print_matrix_int('box 2',box(:,:,2))\n call print_matrix_int('box 3',box(:,:,3))\n call print_matrix_int('box 4',box(:,:,4))\n\n ! remember without dim= even a box produces a scalar\n print all, 'no dim gives a scalar',product(real(box))\n\n ! only one plane has negative values, so note all the \"1\" values\n ! for vectors with no elements\n call print_matrix_int('negative values', &\n & product(box,mask=box < 0,dim=1))\n\n! If DIM is specified and ARRAY has rank greater than one, the\n! result is a new array in which dimension DIM has been eliminated.\n\n ! pick a dimension to multiply though\n call print_matrix_int('dim=1',product(box,dim=1))\n\n call print_matrix_int('dim=2',product(box,dim=2))\n\n call print_matrix_int('dim=3',product(box,dim=3))\n\nendblock WITH_DIM\n\ncontains\n\nsubroutine print_matrix_int(title,arr)\nimplicit none\n\n!@(#) print small 2d integer arrays in row-column format\n\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n print all\n print all, trim(title),':(',shape(arr),')' ! print title\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\nend subroutine print_matrix_int\n\nend program demo_product\n```\n\nResults:\n\n```text\nfactorial of 1 is 1.000000\nfactorial of 2 is 2.000000\nfactorial of 3 is 6.000000\nfactorial of 4 is 24.00000\nfactorial of 5 is 120.0000\nfactorial of 6 is 720.0000\nfactorial of 7 is 5040.000\nfactorial of 8 is 40320.00\nfactorial of 9 is 362880.0\nfactorial of 10 is 3628800.\n\n product of all elements 351000000\n odd * even =\n 4875 * 72000 = 351000000\n\nzero-sized array=> 1\nall elements have a false mask=> 1\n\nrect :( 2 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\nproduct of columns= 4 10 18\nproduct of rows= 6 120\n\nbox 1 :( 2 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n\nbox 2 :( 2 3 )\n > [ 10, 20, 30 ]\n > [ 40, 50, 60 ]\n\nbox 3 :( 2 3 )\n > [ -10, -20, -30 ]\n > [ -40, -50, -60 ]\n\nbox 4 :( 2 3 )\n > [ 2, 4, 6 ]\n > [ 8, 10, 12 ]\nno dim gives a scalar .1719927E+26\n\nnegative values :( 3 4 )\n > [ 1, 1, 400, 1 ]\n > [ 1, 1, 1000, 1 ]\n > [ 1, 1, 1800, 1 ]\n\ndim=1 :( 3 4 )\n > [ 4, 400, 400, 16 ]\n > [ 10, 1000, 1000, 40 ]\n > [ 18, 1800, 1800, 72 ]\n\ndim=2 :( 2 4 )\n > [ 6, 6000, -6000, 48 ]\n > [ 120, 120000, -120000, 960 ]\n\ndim=3 :( 2 3 )\n > [ -200, -3200, -16200 ]\n > [ -51200, -125000, -259200 ]\n```\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**sum**(3)](#sum), note that an element by element multiplication is done\ndirectly using the star character.\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "RADIX": "## radix\n\n### **Name**\n\n**radix** - \\[NUMERIC MODEL\\] Base of a numeric model\n\n### **Synopsis**\n```fortran\n result = radix(x)\n```\n```fortran\n integer function radix(x)\n\n TYPE(kind=**),intent(in) :: x(..)\n```\n### **Characteristics**\n\n - **x** may be scalar or an array of any _real_ or _integer_ type.\n - the result is a default integer scalar.\n\n### **Description**\n\n **radix** returns the base of the internal model representing the\n numeric entity **x**.\n\n In a positional numeral system, the radix or base is the number of\n unique digits, including the digit zero, used to represent numbers.\n\n This function helps to represent the internal computing model\n generically, but will be 2 (representing a binary machine) for any\n common platform for all the numeric types.\n\n### **Options**\n\n- **x**\n : used to identify the type of number to query.\n\n### **Result**\n\n The returned value indicates what base is internally used to represent\n the type of numeric value **x** represents.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_radix\nimplicit none\n print *, \"The radix for the default integer kind is\", radix(0)\n print *, \"The radix for the default real kind is\", radix(0.0)\n print *, \"The radix for the doubleprecision real kind is\", radix(0.0d0)\nend program demo_radix\n```\nResults:\n```text\n > The radix for the default integer kind is 2\n > The radix for the default real kind is 2\n > The radix for the doubleprecision real kind is 2\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "RANDOM_INIT": "## random_init\n\n### **Name**\n\n**random_init** - \\[MATHEMATICS:RANDOM\\] Initializes the state of\nthe pseudorandom number generator\n\n### **Synopsis**\n```fortran\n call random_init(repeatable, image_distinct)\n\n logical,intent(in) :: repeatable\n logical,intent(in) :: image_distinct\n```\n### **Characteristics**\n\n- **harvest** and **image_distinct** are logical scalars\n\n### Description\n\nInitializes the state of the pseudorandom number generator used by \n**random_number**.\n\n### **Options**\n\n**repeatable**\n: If it is **.true.**, the seed is set to a processor-dependent\nvalue that is the same each time **random_init** is called from the\nsame image. The term \"same image\" means a single instance of program\nexecution. The sequence of random numbers is different for repeated\nexecution of the program. \n\nIf it is **.false.**, the seed is set to a processor-dependent value.\n\n**image_distinct**\n: If is `.true.`, the seed is set to a processor-dependent value that\nis distinct from the seed set by a call to **random_init**in another\nimage. If it is **.false.**, the seed is set value that does depend\nwhich image called **random_init**.\n\n## **Standard**\n\nFortran 2018\n\n## **Example**\n```fortran\nprogram demo_random_seed\nimplicit none\nreal x(3), y(3)\n call random_init(.true., .true.)\n call random_number(x)\n call random_init(.true., .true.)\n call random_number(y)\n ! x and y should be the same sequence\n if ( any(x /= y) ) stop \"x(:) and y(:) are not all equal\"\nend program demo_random_seed\n```\n## **See also**\n\n[random_number](#random_number),\n[random_seed](random_seed)\n\n _fortran-lang intrinsic descriptions\n", "RANDOM_NUMBER": "## random_number\n\n### **Name**\n\n**random_number** - \\[MATHEMATICS:RANDOM\\] Pseudo-random number\n\n### **Synopsis**\n```fortran\n call random_number(harvest)\n```\n```fortran\n subroutine random_number(harvest)\n\n real,intent(out) :: harvest(..)\n```\n### **Characteristics**\n\n- **harvest** and the result are default _real_ variables\n\n### **Description**\n\n**random_number** returns a single pseudorandom number or an array of\npseudorandom numbers from the uniform distribution over the range\n0 \\<= x \\< 1.\n\n### **Options**\n\n- **harvest**\n : Shall be a scalar or an array of type _real_.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_random_number\nuse, intrinsic :: iso_fortran_env, only : dp=>real64\nimplicit none\ninteger, allocatable :: seed(:)\ninteger :: n\ninteger :: first,last\ninteger :: i\ninteger :: rand_int\ninteger,allocatable :: count(:)\nreal(kind=dp) :: rand_val\n call random_seed(size = n)\n allocate(seed(n))\n call random_seed(get=seed)\n first=1\n last=10\n allocate(count(last-first+1))\n ! To have a discrete uniform distribution on the integers\n ! [first, first+1, ..., last-1, last] carve the continuous\n ! distribution up into last+1-first equal sized chunks,\n ! mapping each chunk to an integer.\n !\n ! One way is:\n ! call random_number(rand_val)\n ! choose one from last-first+1 integers\n ! rand_int = first + FLOOR((last+1-first)*rand_val)\n count=0\n ! generate a lot of random integers from 1 to 10 and count them.\n ! with a large number of values you should get about the same\n ! number of each value\n do i=1,100000000\n call random_number(rand_val)\n rand_int=first+floor((last+1-first)*rand_val)\n if(rand_int.ge.first.and.rand_int.le.last)then\n count(rand_int)=count(rand_int)+1\n else\n write(*,*)rand_int,' is out of range'\n endif\n enddo\n write(*,'(i0,1x,i0)')(i,count(i),i=1,size(count))\nend program demo_random_number\n```\nResults:\n```\n 1 10003588\n 2 10000104\n 3 10000169\n 4 9997996\n 5 9995349\n 6 10001304\n 7 10001909\n 8 9999133\n 9 10000252\n 10 10000196\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**random_seed**(3)](#random_seed)\n\n _fortran-lang intrinsic descriptions_\n", @@ -164,7 +164,7 @@ "REAL": "## real\n\n### **Name**\n\n**real** - \\[TYPE:NUMERIC\\] Convert to real type\n\n### **Synopsis**\n```fortran\n result = real(x [,kind])\n```\n```fortran\n elemental real(kind=KIND) function real(x,KIND)\n\n TYPE(kind=**),intent(in) :: x\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - the type of **x** may be _integer_, _real_, or _complex_; or a BOZ-literal-constant.\n - **kind** is a _integer_ initialization expression (a constant expression)\n + If **kind** is present it defines the kind of the _real_ result\n + if **kind** is not present\n - when **x** is _complex_ the result is a _real_ of the same kind as **x**.\n - when **x** is _real_ or _integer_ the result is a _real_ of default kind\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**real** converts its argument **x** to a _real_ type.\n\nThe real part of a complex value is returned. For complex values this\nis similar to the modern complex-part-designator **%RE** which also\ndesignates the real part of a _complex_ value.\n\n```fortran\n z=(3.0,4.0) ! if z is a complex value\n print *, z%re == real(z) ! these expressions are equivalent\n```\n### **Options**\n\n- **x**\n : An _integer_, _real_, or _complex_ value to convert to _real_.\n\n- **kind**\n : When present the value of **kind** defines the kind of the result.\n\n### **Result**\n\n1. **real(x)** converts **x** to a default _real_ type if **x** is an _integer_\n or _real_ variable.\n\n2. **real(x)** converts a _complex_ value to a _real_ type with the\n magnitude of the real component of the input with kind type\n parameter the same as **x**.\n\n3. **real(x, kind)** is converted to a _real_ type with kind type\n parameter **kind** if **x** is a _complex_, _integer_, or _real_ variable.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_real\nuse,intrinsic :: iso_fortran_env, only : dp=>real64\nimplicit none\ncomplex :: zr = (1.0, 2.0)\ndoubleprecision :: xd=huge(3.0d0)\ncomplex(kind=dp) :: zd=cmplx(4.0e0_dp,5.0e0_dp,kind=dp)\n\n print *, real(zr), aimag(zr)\n print *, dble(zd), aimag(zd)\n\n write(*,*)xd,real(xd,kind=kind(0.0d0)),dble(xd)\nend program demo_real\n```\nResults:\n```\n 1.00000000 2.00000000\n 4.0000000000000000 5.0000000000000000\n 1.7976931348623157E+308 1.7976931348623157E+308 1.7976931348623157E+308\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- [**conjg**(3)](#conjg) - Complex conjugate function\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", "REDUCE": "## reduce\n\n### **Name**\n\n**reduce** - \\[TRANSFORMATIONAL\\] General reduction of an array\n\n### **Synopsis**\n\nThere are two forms to this function:\n```fortran\n result = reduce(array, operation [,mask] [,identity] [,ordered] )\n```\nor\n```fortran\n result = reduce (array, operation, dim &\n & [,mask] [,identity] [,ordered] )\n```\n```fortran\n type(TYPE(kind=KIND)) function reduce &\n & (array, operation, dim, mask, identity, ordered )\n\n type(TYPE(kind=KIND)),intent(in) :: array\n pure function :: operation\n integer,intent(in),optional :: dim\n logical,optional :: mask\n type(TYPE),intent(in),optional :: identity\n logical,intent(in),optional :: ordered\n```\n### **Characteristics**\n\n - **array** is an array of any type\n - **operation** is a pure function with exactly two arguments\n + each argument is scalar, non-allocatable, a nonpointer,\n nonpolymorphic and nonoptional with the same type and kind as array.\n + if one argument has the asynchronous, target, or value attribute so\n shall the other.\n - **dim** is an _integer_ scalar\n - **mask** is a logical conformable with **array**\n - **identity** is a scalar with the same type and type parameters as **array**\n - **ordered** is a logical scalar\n - the result is of the same type and type parameters as **array**.\n\n### **Description**\n\n **reduce** reduces a list of conditionally selected values from\n an array to a single value by iteratively applying a binary function.\n\n Common in functional programming, a **reduce** function applies a\n binary operator (a pure function with two arguments) to all elements\n cumulatively.\n\n **reduce** is a \"higher-order\" function; ie. it is a function that\n receives other functions as arguments.\n\n The **reduce** function receives a binary operator (a function with\n two arguments, just like the basic arithmetic operators). It is first\n applied to two unused values in the list to generate an accumulator\n value which is subsequently used as the first argument to the function\n as the function is recursively applied to all the remaining selected\n values in the input array.\n\n### **Options**\n\n- **array**\n : An array of any type and allowed rank to select values from.\n\n- **operation**\n : shall be a pure function with exactly two arguments;\n each argument shall be a scalar, nonallocatable,\n nonpointer, nonpolymorphic, nonoptional dummy data object\n with the same type and type parameters as **array**. If\n one argument has the ASYNCHRONOUS, TARGET, or VALUE\n attribute, the other shall have that attribute. Its result\n shall be a nonpolymorphic scalar and have the same type\n and type parameters as **array**. **operation** should\n implement a mathematically associative operation. It\n need not be commutative.\n\n NOTE\n\n If **operation** is not computationally associative, REDUCE\n without ORDERED=.TRUE. with the same argument values\n might not always produce the same result, as the processor\n can apply the associative law to the evaluation.\n\n Many operations that mathematically are associative are\n not when applied to floating-point numbers. The order\n you sum values in may affect the result, for example.\n\n- **dim**\n : An integer scalar with a value in the range\n 1<= **dim** <= n, where n is the rank of **array**.\n\n- **mask**\n : (optional) shall be of type logical and shall be\n conformable with **array**.\n\n When present only those elements of **array** are passed\n to **operation** for which the corresponding elements\n of **mask** are true, as if **array* was filtered with\n **pack(3)**.\n\n- **identity**\n : shall be scalar with the same type and type parameters as **array**.\n If the initial sequence is empty, the result has the value **identify**\n if **identify** is present, and otherwise, error termination is\n initiated.\n\n- **ordered**\n : shall be a logical scalar. If **ordered** is present with the value\n _.true._, the calls to the **operator** function begins with the first\n two elements of **array** and the process continues in row-column\n order until the sequence has only one element which is the value of the\n reduction. Otherwise, the compiler is free to assume that the operation\n is commutative and may evaluate the reduction in the most optimal way.\n\n### **Result**\n\nThe result is of the same type and type parameters as **array**. It is\nscalar if **dim** does not appear.\n\nIf **dim** is present, it indicates the one dimension along which to\nperform the reduction, and the resultant array has a rank reduced by\none relative to the input array.\n\n### **Examples**\n\n The following examples all use the function MY\\_MULT, which returns\n the product of its two real arguments.\n```fortran\n program demo_reduce\n implicit none\n character(len=*),parameter :: f='(\"[\",*(g0,\",\",1x),\"]\")'\n integer,allocatable :: arr(:), b(:,:)\n\n ! Basic usage:\n ! the product of the elements of an array\n arr=[1, 2, 3, 4 ]\n write(*,*) arr\n write(*,*) 'product=', reduce(arr, my_mult)\n write(*,*) 'sum=', reduce(arr, my_sum)\n\n ! Examples of masking:\n ! the product of only the positive elements of an array\n arr=[1, -1, 2, -2, 3, -3 ]\n write(*,*)'positive value product=',reduce(arr, my_mult, mask=arr>0)\n ! sum values ignoring negative values\n write(*,*)'sum positive values=',reduce(arr, my_sum, mask=arr>0)\n\n ! a single-valued array returns the single value as the\n ! calls to the operator stop when only one element remains\n arr=[ 1234 ]\n write(*,*)'single value sum',reduce(arr, my_sum )\n write(*,*)'single value product',reduce(arr, my_mult )\n\n ! Example of operations along a dimension:\n ! If B is the array 1 3 5\n ! 2 4 6\n b=reshape([1,2,3,4,5,6],[2,3])\n write(*,f) REDUCE(B, MY_MULT),'should be [720]'\n write(*,f) REDUCE(B, MY_MULT, DIM=1),'should be [2,12,30]'\n write(*,f) REDUCE(B, MY_MULT, DIM=2),'should be [15, 48]'\n\n contains\n\n pure function my_mult(a,b) result(c)\n integer,intent(in) :: a, b\n integer :: c\n c=a*b\n end function my_mult\n\n pure function my_sum(a,b) result(c)\n integer,intent(in) :: a, b\n integer :: c\n c=a+b\n end function my_sum\n\n end program demo_reduce\n```\nResults:\n```text\n > 1 2 3 4\n > product= 24\n > sum= 10\n > positive value sum= 6\n > sum positive values= 6\n > single value sum 1234\n > single value product 1234\n > [720, should be [720],\n > [2, 12, 30, should be [2,12,30],\n > [15, 48, should be [15, 48],\n```\n### **Standard**\n\n Fortran 2018\n\n### **See Also**\n- [co_reduce(3)](#co_reduce)\n\n### **Resources**\n\n- [associative:wikipedia](https://en.wikipedia.org/wiki/Associative_property)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "REPEAT": "## repeat\n\n### **Name**\n\n**repeat** - \\[CHARACTER\\] Repeated string concatenation\n\n### **Synopsis**\n```fortran\n result = repeat(string, ncopies)\n```\n```fortran\n character(len=len(string)*ncopies) function repeat(string, ncopies)\n\n character(len=*),intent(in) :: string\n integer(kind=**),intent(in) :: ncopies\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **string** is a scalar _character_ type.\n - **ncopies** is a scalar integer.\n - the result is a new scalar of type _character_ of the same kind as\n **string**\n\n### **Description**\n\n **repeat** concatenates copies of a string.\n\n### **Options**\n\n- **string**\n : The input string to repeat\n\n- **ncopies**\n : Number of copies to make of **string**, greater than or equal to zero (0).\n\n### **Result**\n\n A new string built up from **ncopies** copies of **string**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_repeat\nimplicit none\n write(*,'(a)') repeat(\"^v\", 35) ! line break\n write(*,'(a)') repeat(\"_\", 70) ! line break\n write(*,'(a)') repeat(\"1234567890\", 7) ! number line\n write(*,'(a)') repeat(\" |\", 7) !\nend program demo_repeat\n```\nResults:\n```text\n > ^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v\n > ______________________________________________________________________\n > 1234567890123456789012345678901234567890123456789012345678901234567890\n > | | | | | | |\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\nFunctions that perform operations on character strings:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n [**scan**(3)](#scan),\n [**verify**(3)](#verify)\n\n- **Non-elemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**](#repeat),\n [**trim**(3)](#trim)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n#\n", - "RESHAPE": "\n\n## reshape\n\n### **Name**\n\n**reshape** - \\[ARRAY:RESHAPE\\] Function to reshape an array\n\n### **Synopsis**\n```fortran\n result = reshape( source, shape [,pad] [,order] )\n```\n```fortran\n type(TYPE(kind=KIND) function reshape\n\n type(TYPE(kind=KIND),intent(in) :: source(..)\n integer(kind=**),intent(in) :: shape(:)\n type(TYPE(kind=KIND),intent(in),optional :: pad(..)\n integer(kind=**),intent(in),optional :: order(:)\n```\n### **Characteristics**\n\n - **source** is an array of any type\n - **shape** defines a Fortran shape and therefore an _integer_ vector\n (of rank one) of constant size of up to 16 non-negative values.\n - **pad** is the same type as **source**\n - **order** is the same shape as **shape**\n - The result is an array of shape **shape** with the same type as **source**.\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**reshape** constructs an array of arbitrary shape **shape** using the elements\nfrom **source** and possibly **pad** to fill it.\n\nIf necessary, the new array may be padded with elements from **pad**\nor permuted as defined by **order**.\n\nAmong many other uses, **reshape** can be used to reorder a Fortran array\nto match C array ordering before the array is passed from Fortran to a\nC procedure.\n\n### **Options**\n\n- **source**\n : an array containing the elements to be copied to the result.\n there must be enough elements in the source to fill the new shape\n if **pad** is omitted or has size zero. Expressed in Fortran ...\n```fortran\n if(.not.present(pad))then\n if(size(source) < product(shape))then\n stop 'not enough elements in the old array to fill the new one'\n endif\n endif\n```\n- **shape**\n : This is the shape of the new array being generated.\n Being by definition a shape; all elements are either positive integers\n or zero, the size but be 1 or greater, it may have up to 16 elements\n but must be of constant fixed size and rank one.\n\n- **pad**\n : used to fill in extra values if the result array is larger than **source**.\n It will be used repeatedly after all the elements of **source** have been\n placed in the result until the result has all elements assigned.\n : If it is absent or is a zero-sized array, you can only make\n **source** into another array of the same size as **source** or smaller.\n\n- **order**\n : used to insert elements in the result in an order other\n than the normal Fortran array element order, in which the first dimension\n varies fastest.\n : By definition of ranks the values have to be a permutation of the numbers\n from 1 to n, where n is the rank of **shape**.\n : the elements of **source** and pad are placed into the result in order;\n changing the left-most rank most rapidly by default. To change the order by\n which the elements are placed in the result use **order**.\n\n### **Result**\n\nThe result is an array of shape **shape** with the same type and type\nparameters as **source**. It is first filled with the values of elements\nof **source**, with the remainder filled with repeated copies of **pad**\nuntil all elements are filled. The new array may be smaller than\n**source**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_reshape\nimplicit none\n! notice the use of \"shape(box)\" on the RHS\ninteger :: box(3,4)=reshape([1,2,3,4,5,6,7,8,9,10,11,12],shape(box))\ninteger,allocatable :: v(:,:)\ninteger :: rc(2)\n ! basics0\n ! what is the current shape of the array?\n call printi('shape of box is ',box)\n ! change the shape\n call printi('reshaped ',reshape(box,[2,6]))\n call printi('reshaped ',reshape(box,[4,3]))\n\n ! fill in row column order using order\n v=reshape([1,2,3,4,10,20,30,40,100,200,300,400],[1,12])\n call printi('here is some data to shape',v)\n call printi('normally fills columns first ',reshape([v],[3,4]))\n call printi('fill rows first', reshape([v],[3,4],order=[2,1]))\n\n ! if we take the data and put in back in filling\n ! rows first instead of columns, and flipping the\n ! height and width of the box we not only fill in\n ! a vector using row-column order we actually\n ! transpose it.\n rc(2:1:-1)=shape(box)\n ! copy the data in changing column number fastest\n v=reshape(box,rc,order=[2,1])\n call printi('reshaped and reordered',v)\n ! of course we could have just done a transpose\n call printi('transposed',transpose(box))\n\n ! making the result bigger than source using pad\n v=reshape(box,rc*2,pad=[-1,-2,-3],order=[2,1])\n call printi('bigger and padded and reordered',v)\ncontains\n\nsubroutine printi(title,arr)\nimplicit none\n\n!@(#) print small 2d integer arrays in row-column format\n\ncharacter(len=*),parameter :: all='(*(g0,1x))' ! a handy format\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n print all\n print all, trim(title),':(',shape(arr),')' ! print title\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(real(maxval(abs(arr)))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\nend subroutine printi\n\nend program demo_reshape\n```\nResults:\n```text\n shape of box is :( 3 4 )\n > [ 1, 4, 7, 10 ]\n > [ 2, 5, 8, 11 ]\n > [ 3, 6, 9, 12 ]\n\n reshaped :( 2 6 )\n > [ 1, 3, 5, 7, 9, 11 ]\n > [ 2, 4, 6, 8, 10, 12 ]\n\n reshaped :( 4 3 )\n > [ 1, 5, 9 ]\n > [ 2, 6, 10 ]\n > [ 3, 7, 11 ]\n > [ 4, 8, 12 ]\n\n here is some data to shape :( 1 12 )\n > [ 1, 2, 3, 4, 10, 20, 30, 40, 100, 200, 300, 400 ]\n\n normally fills columns first :( 3 4 )\n > [ 1, 4, 30, 200 ]\n > [ 2, 10, 40, 300 ]\n > [ 3, 20, 100, 400 ]\n\n fill rows first :( 3 4 )\n > [ 1, 2, 3, 4 ]\n > [ 10, 20, 30, 40 ]\n > [ 100, 200, 300, 400 ]\n\n reshaped and reordered :( 4 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n > [ 7, 8, 9 ]\n > [ 10, 11, 12 ]\n\n transposed :( 4 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n > [ 7, 8, 9 ]\n > [ 10, 11, 12 ]\n\n bigger and padded and reordered :( 8 6 )\n > [ 1, 2, 3, 4, 5, 6 ]\n > [ 7, 8, 9, 10, 11, 12 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**shape**(3)](#shape),\n[**pack**(3)](#pack),\n[**transpose**(3)](#transpose)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", + "RESHAPE": "\n\n## reshape\n\n### **Name**\n\n**reshape** - \\[ARRAY:RESHAPE\\] Function to reshape an array\n\n### **Synopsis**\n```fortran\n result = reshape( source, shape [,pad] [,order] )\n```\n```fortran\n type(TYPE(kind=KIND) function reshape\n\n type(TYPE(kind=KIND),intent(in) :: source(..)\n integer(kind=**),intent(in) :: shape(:)\n type(TYPE(kind=KIND),intent(in),optional :: pad(..)\n integer(kind=**),intent(in),optional :: order(:)\n```\n### **Characteristics**\n\n - **source** is an array of any type\n - **shape** defines a Fortran shape and therefore an _integer_ vector\n (of rank one) of constant size of up to 16 non-negative values.\n - **pad** is the same type as **source**\n - **order** is the same shape as **shape**\n - The result is an array of shape **shape** with the same type as **source**.\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**reshape** constructs an array of arbitrary shape **shape** using the elements\nfrom **source** and possibly **pad** to fill it.\n\nIf necessary, the new array may be padded with elements from **pad**\nor permuted as defined by **order**.\n\nAmong many other uses, **reshape** can be used to reorder a Fortran array\nto match C array ordering before the array is passed from Fortran to a\nC procedure.\n\n### **Options**\n\n- **source**\n : an array containing the elements to be copied to the result.\n there must be enough elements in the source to fill the new shape\n if **pad** is omitted or has size zero. Expressed in Fortran ...\n```fortran\n if(.not.present(pad))then\n if(size(source) < product(shape))then\n stop 'not enough elements in the old array to fill the new one'\n endif\n endif\n```\n- **shape**\n : This is the shape of the new array being generated.\n Being by definition a shape; all elements are either positive integers\n or zero, the size but be 1 or greater, it may have up to 16 elements\n but must be of constant fixed size and rank one.\n\n- **pad**\n : used to fill in extra values if the result array is larger than **source**.\n It will be used repeatedly after all the elements of **source** have been\n placed in the result until the result has all elements assigned.\n : If it is absent or is a zero-sized array, you can only make\n **source** into another array of the same size as **source** or smaller.\n\n- **order**\n : used to insert elements in the result in an order other\n than the normal Fortran array element order, in which the first dimension\n varies fastest.\n : By definition of ranks the values have to be a permutation of the numbers\n from 1 to n, where n is the rank of **shape**.\n : the elements of **source** and pad are placed into the result in order;\n changing the left-most rank most rapidly by default. To change the order by\n which the elements are placed in the result use **order**.\n\n### **Result**\n\nThe result is an array of shape **shape** with the same type and type\nparameters as **source**. It is first filled with the values of elements\nof **source**, with the remainder filled with repeated copies of **pad**\nuntil all elements are filled. The new array may be smaller than\n**source**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_reshape\nimplicit none\n! notice the use of \"shape(box)\" on the RHS\ninteger :: box(3,4)=reshape([1,2,3,4,5,6,7,8,9,10,11,12],shape(box))\ninteger,allocatable :: v(:,:)\ninteger :: rc(2)\n ! basics0\n ! what is the current shape of the array?\n call printi('shape of box is ',box)\n ! change the shape\n call printi('reshaped ',reshape(box,[2,6]))\n call printi('reshaped ',reshape(box,[4,3]))\n\n ! fill in row column order using order\n v=reshape([1,2,3,4,10,20,30,40,100,200,300,400],[1,12])\n call printi('here is some data to shape',v)\n call printi('normally fills columns first ',reshape([v],[3,4]))\n call printi('fill rows first', reshape([v],[3,4],order=[2,1]))\n\n ! if we take the data and put in back in filling\n ! rows first instead of columns, and flipping the\n ! height and width of the box we not only fill in\n ! a vector using row-column order we actually\n ! transpose it.\n rc(2:1:-1)=shape(box)\n ! copy the data in changing column number fastest\n v=reshape(box,rc,order=[2,1])\n call printi('reshaped and reordered',v)\n ! of course we could have just done a transpose\n call printi('transposed',transpose(box))\n\n ! making the result bigger than source using pad\n v=reshape(box,rc*2,pad=[-1,-2,-3],order=[2,1])\n call printi('bigger and padded and reordered',v)\ncontains\n\nsubroutine printi(title,arr)\nimplicit none\n\n!@(#) print small 2d integer arrays in row-column format\n\ncharacter(len=*),parameter :: all='(*(g0,1x))' ! a handy format\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n print all\n print all, trim(title),':(',shape(arr),')' ! print title\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\nend subroutine printi\n\nend program demo_reshape\n```\nResults:\n```text\n shape of box is :( 3 4 )\n > [ 1, 4, 7, 10 ]\n > [ 2, 5, 8, 11 ]\n > [ 3, 6, 9, 12 ]\n\n reshaped :( 2 6 )\n > [ 1, 3, 5, 7, 9, 11 ]\n > [ 2, 4, 6, 8, 10, 12 ]\n\n reshaped :( 4 3 )\n > [ 1, 5, 9 ]\n > [ 2, 6, 10 ]\n > [ 3, 7, 11 ]\n > [ 4, 8, 12 ]\n\n here is some data to shape :( 1 12 )\n > [ 1, 2, 3, 4, 10, 20, 30, 40, 100, 200, 300, 400 ]\n\n normally fills columns first :( 3 4 )\n > [ 1, 4, 30, 200 ]\n > [ 2, 10, 40, 300 ]\n > [ 3, 20, 100, 400 ]\n\n fill rows first :( 3 4 )\n > [ 1, 2, 3, 4 ]\n > [ 10, 20, 30, 40 ]\n > [ 100, 200, 300, 400 ]\n\n reshaped and reordered :( 4 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n > [ 7, 8, 9 ]\n > [ 10, 11, 12 ]\n\n transposed :( 4 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n > [ 7, 8, 9 ]\n > [ 10, 11, 12 ]\n\n bigger and padded and reordered :( 8 6 )\n > [ 1, 2, 3, 4, 5, 6 ]\n > [ 7, 8, 9, 10, 11, 12 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**shape**(3)](#shape),\n[**pack**(3)](#pack),\n[**transpose**(3)](#transpose)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "RRSPACING": "## rrspacing\n\n### **Name**\n\n**rrspacing** - \\[MODEL_COMPONENTS\\] Reciprocal of the relative spacing of a numeric type\n\n### **Synopsis**\n```fortran\n result = rrspacing(x)\n```\n```fortran\n elemental real(kind=KIND) function rrspacing(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is type _real_ an any kind\n - The return value is of the same type and kind as **x**.\n\n### **Description**\n\n**rrspacing** returns the reciprocal of the relative spacing of model\nnumbers near **x**.\n\n\n\n### **Options**\n\n- **x**\n : Shall be of type _real_.\n\n### **Result**\n\n The return value is of the same type and kind as **x**. The value returned\n is equal to **abs(fraction(x)) \\* float(radix(x))\\*\\*digits(x)**.\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions_\n", "SAME_TYPE_AS": "## same_type_as\n\n### **Name**\n\n**same_type_as** - \\[STATE:INQUIRY\\] Query dynamic types for equality\n\n### **Synopsis**\n```fortran\n result = same_type_as(a, b)\n```\n```fortran\n logical same_type_as(a, b)\n\n type(TYPE(kind=KIND),intent(in) :: a\n type(TYPE(kind=KIND),intent(in) :: b\n```\n### **Characteristics**\n\n- **a** shall be an object of extensible declared type or unlimited\n polymorphic. If it is a polymorphic pointer, it shall not have\n an undefined association status.\n\n- **b** shall be an object of extensible declared type or unlimited\n polymorphic. If it is a polymorphic pointer, it shall not have\n an undefined association status.\n\n### **Description**\n\n**same_type_as** queries the dynamic types of objects for equality.\n\n### **Options**\n\n- **a**\n : object to compare to **b** for equality of type\n\n- **b**\n : object to be compared to for equality of type\n\n### **Result**\n\n If the dynamic type of **a** or **b** is extensible, the result is true\n if and only if the dynamic type of **a** is the same as the dynamic\n type of **b**. If neither **a** nor **b** has extensible dynamic type,\n the result is processor dependent.\n\n NOTE1\n\n The dynamic type of a disassociated pointer or unallocated allocatable\n variable is its declared type. An unlimited polymorphic entity has no\n declared type.\n\n NOTE2\n\n The test performed by SAME_TYPE_AS is not the same as the test performed\n by the type guard TYPE IS. The test performed by SAME_TYPE_AS does\n not consider kind type parameters.\n\nSample program:\n```fortran\n ! program demo_same_type_as\n module M_ether\n implicit none\n private\n\n type :: dot\n real :: x=0\n real :: y=0\n end type dot\n\n type, extends(dot) :: point\n real :: z=0\n end type point\n\n type something_else\n end type something_else\n\n public :: dot\n public :: point\n public :: something_else\n\n end module M_ether\n\n program demo_same_type_as\n use M_ether, only : dot, point, something_else\n implicit none\n type(dot) :: dad, mom\n type(point) :: me\n type(something_else) :: alien\n\n write(*,*)same_type_as(me,dad),'I am descended from Dad, but equal?'\n write(*,*)same_type_as(me,me) ,'I am what I am'\n write(*,*)same_type_as(dad,mom) ,'what a pair!'\n\n write(*,*)same_type_as(dad,me),'no paradox here'\n write(*,*)same_type_as(dad,alien),'no relation'\n\n call pointers()\n contains\n subroutine pointers()\n ! Given the declarations and assignments\n type t1\n real c\n end type\n type, extends(t1) :: t2\n end type\n class(t1), pointer :: p, q, r\n allocate (p, q)\n allocate (t2 :: r)\n ! the result of SAME_TYPE_AS (P, Q) will be true, and the result\n ! of SAME_TYPE_AS (P, R) will be false.\n write(*,*)'(P,Q)',same_type_as(p,q),\"mind your P's and Q's\"\n write(*,*)'(P,R)',same_type_as(p,r)\n end subroutine pointers\n\n end program demo_same_type_as\n```\nResults:\n```text\n F I am descended from Dad, but equal?\n T I am what I am\n T what a pair!\n F no paradox here\n F no relation\n (P,Q) T mind your P's and Q's\n (P,R) F\n```\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**extends_type_of**(3)](#extends_type_of)\n\n _fortran-lang intrinsic descriptions_\n", "SCALE": "## scale\n\n### **Name**\n\n**scale** - \\[MODEL_COMPONENTS\\] Scale a real value by a whole power of the radix\n\n### **Synopsis**\n```fortran\n result = scale(x, i)\n```\n```fortran\n elemental real(kind=KIND) function scale(x, i)\n\n real(kind=KIND),intent(in) :: x\n integer(kind=**),intent(in) :: i\n```\n### **Characteristics**\n\n - **x** is type _real_ of any kind\n - **i** is type an _integer_ of any kind\n - the result is _real_ of the same kind as **x**\n\n### **Description**\n\n **scale** returns x \\* **radix(x)\\*\\*i**.\n\n It is almost certain the radix(base) of the platform is two, therefore\n **scale** is generally the same as **x*2\\*\\*i**\n\n### **Options**\n\n- **x**\n : the value to multiply by **radix(x)\\*\\*i**. Its type and kind is used\n to determine the radix for values with its characteristics and determines\n the characteristics of the result, so care must be taken the returned\n value is within the range of the characteristics of **x**.\n\n- **i**\n : The power to raise the radix of the machine to\n\n### **Result**\n\nThe return value is **x \\* radix(x)\\*\\*i**, assuming that value can be\nrepresented by a value of the type and kind of **x**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_scale\nimplicit none\nreal :: x = 178.1387e-4\ninteger :: i = 5\n print *, scale(x,i), x*radix(x)**i\nend program demo_scale\n```\nResults:\n```\n 0.570043862 0.570043862\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -182,10 +182,10 @@ "SINH": "## sinh\n\n### **Name**\n\n**sinh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Hyperbolic sine function\n\n### **Synopsis**\n```fortran\n result = sinh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function sinh(x)\n\n TYPE(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_\n - **KIND** may be any kind supported by the associated type.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n **sinh** computes the hyperbolic sine of **x**.\n\n The hyperbolic sine of x is defined mathematically as:\n```fortran\n sinh(x) = (exp(x) - exp(-x)) / 2.0\n```\n\n### **Options**\n\n- **x**\n : The value to calculate the hyperbolic sine of\n\n### **Result**\n\n The result has a value equal to a processor-dependent approximation\n to sinh(X). If X is of type complex its imaginary part is regarded\n as a value in radians.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_sinh\nuse, intrinsic :: iso_fortran_env, only : &\n& real_kinds, real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = - 1.0_real64\nreal(kind=real64) :: nan, inf\ncharacter(len=20) :: line\n\n ! basics\n print *, sinh(x)\n print *, (exp(x)-exp(-x))/2.0\n\n ! sinh(3) is elemental and can handle an array\n print *, sinh([x,2.0*x,x/3.0])\n\n ! a NaN input returns NaN\n line='NAN'\n read(line,*) nan\n print *, sinh(nan)\n\n ! a Inf input returns Inf\n line='Infinity'\n read(line,*) inf\n print *, sinh(inf)\n\n ! an overflow returns Inf\n x=huge(0.0d0)\n print *, sinh(x)\n\nend program demo_sinh\n```\nResults:\n```text\n -1.1752011936438014\n -1.1752011936438014\n -1.1752011936438014 -3.6268604078470190 -0.33954055725615012\n NaN\n Infinity\n Infinity\n```\n### **Standard**\n\nFortran 95 , for a complex argument Fortran 2008\n\n### **See Also**\n\n[**asinh**(3)](#asinh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SIZE": "## size\n\n### **Name**\n\n**size** - \\[ARRAY:INQUIRY\\] Determine the size of an array or extent of one dimension\n\n### **Synopsis**\n```fortran\n result = size(array [,dim] [,kind])\n```\n```fortran\n integer(kind=KIND) function size(array,dim,kind)\n\n type(TYPE(kind=KIND),intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- **array** is an assumed-rank array or array of any type and associated\n kind.\n\n If **array** is a pointer it must be associated and allocatable arrays\n must be allocated.\n- **dim** is an integer scalar\n- **kind** is a scalar integer constant expression.\n- the result is an integer scalar of kind **KIND**. If **KIND** is absent\n a _integer_ of default kind is returned.\n- a kind designated as ** may be any supported kind for the type\n\n\n### **Description**\n\n **size(3)** returns the total number of elements in an array, or\n if **dim** is specified returns the number of elements along that\n dimension.\n\n **size** determines the extent of **array** along a specified\n dimension **dim**, or the total number of elements in **array** if\n **dim** is absent.\n\n### **Options**\n\n- **array**\n : the array to measure the number of elements of.\n If **array* is an assumed-size array, **dim** shall be present with a value less\n than the rank of **array**.\n\n- **dim**\n : a value shall be\n in the range from 1 to n, where n equals the rank of **array**.\n\n If not present the total number of elements of the entire array\n are returned.\n\n- **kind**\n : An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n If absent the kind type parameter of the returned value is that of\n default integer type.\n\n The **kind** must allow for the magnitude returned by **size** or\n results are undefined.\n\n If **kind** is absent, the return value is of default _integer_ kind.\n\n### **Result**\n\n If **dim** is not present **array** is assumed-rank, the result has a\n value equal to **PRODUCT(SHAPE(ARRAY,KIND))**. Otherwise, the result\n has a value equal to the total number of elements of **array**.\n\n If **dim** is present the number of elements along that dimension\n are returned, except that if ARRAY is assumed-rank and associated\n with an assumed-size array and DIM is present with a value equal to\n the rank of **array**, the value is -1.\n\n NOTE1\n\n If **array** is assumed-rank and has rank zero, **dim** cannot be\n present since it cannot satisfy the requirement\n\n 1 <= DIM <= 0.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_size\nimplicit none\ninteger :: arr(0:2,-5:5)\n write(*,*)'SIZE of simple two-dimensional array'\n write(*,*)'SIZE(arr) :total count of elements:',size(arr)\n write(*,*)'SIZE(arr,DIM=1) :number of rows :',size(arr,dim=1)\n write(*,*)'SIZE(arr,DIM=2) :number of columns :',size(arr,dim=2)\n\n ! pass the same array to a procedure that passes the value two\n ! different ways\n call interfaced(arr,arr)\ncontains\n\nsubroutine interfaced(arr1,arr2)\n! notice the difference in the array specification\n! for arr1 and arr2.\ninteger,intent(in) :: arr1(:,:)\ninteger,intent(in) :: arr2(2,*)\n !\n write(*,*)'interfaced assumed-shape array'\n write(*,*)'SIZE(arr1) :',size(arr1)\n write(*,*)'SIZE(arr1,DIM=1) :',size(arr1,dim=1)\n write(*,*)'SIZE(arr1,DIM=2) :',size(arr1,dim=2)\n\n! write(*,*)'SIZE(arr2) :',size(arr2)\n write(*,*)'SIZE(arr2,DIM=1) :',size(arr2,dim=1)\n!\n! CANNOT DETERMINE SIZE OF ASSUMED SIZE ARRAY LAST DIMENSION\n! write(*,*)'SIZE(arr2,DIM=2) :',size(arr2,dim=2)\n\nend subroutine interfaced\n\nend program demo_size\n```\nResults:\n```text\n SIZE of simple two-dimensional array\n SIZE(arr) :total count of elements: 33\n SIZE(arr,DIM=1) :number of rows : 3\n SIZE(arr,DIM=2) :number of columns : 11\n interfaced assumed-shape array\n SIZE(arr1) : 33\n SIZE(arr1,DIM=1) : 3\n SIZE(arr1,DIM=2) : 11\n SIZE(arr2,DIM=1) : 2\n```\n### **Standard**\n\nFortran 95 , with **kind** argument - Fortran 2003\n\n### **See Also**\n\n#### Array inquiry:\n\n- [**size**](#size) - Determine the size of an array\n- [**rank**(3)](#rank) - Rank of a data object\n- [**shape**(3)](#shape) - Determine the shape of an array\n- [**ubound**(3)](#ubound) - Upper dimension bounds of an array\n- [**lbound**(3)](#lbound) - Lower dimension bounds of an array\n\n#### State Inquiry:\n\n- [**allocated**(3)](#allocated) - Status of an allocatable entity\n- [**is_contiguous**(3)](#is_contiguous) - Test if object is contiguous\n\n#### Kind Inquiry:\n\n- [**kind**(3)](#kind) - Kind of an entity\n\n#### Bit Inquiry:\n\n- [**storage_size**(3)](#storage_size) - Storage size in bits\n- [**bit_size**(3)](#bit_size) - Bit size inquiry function\n- [**btest**(3)](#btest) - Tests a bit of an _integer_ value.\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SPACING": "## spacing\n\n### **Name**\n\n**spacing** - \\[MODEL_COMPONENTS\\] Smallest distance between two numbers of a given type\n\n### **Synopsis**\n```fortran\n result = spacing(x)\n```\n```fortran\n elemental real(kind=KIND) function spacing(x)\n\n real(kind=KIND), intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is type real of any valid kind\n - The result is of the same type as the input argument **x**.\n\n### **Description**\n\n **spacing** determines the distance between the argument **x**\n and the nearest adjacent number of the same type.\n\n### **Options**\n\n- **x**\n : Shall be of type _real_.\n\n### **Result**\n\n If **x** does not have the value zero and is not an IEEE infinity or NaN, the result has the value\n nearest to **x** for values of the same type and kind assuming the value is representable.\n\n Otherwise, the value is the same as **tiny(x)**.\n + zero produces **tiny(x)**\n + IEEE Infinity produces an IEEE Nan\n + if an IEEE NaN, that NaN is returned\n\n If there are two extended model values equally near to **x**, the\n value of greater absolute value is taken.\n\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_spacing\nimplicit none\ninteger, parameter :: sgl = selected_real_kind(p=6, r=37)\ninteger, parameter :: dbl = selected_real_kind(p=13, r=200)\n\n write(*,*) spacing(1.0_sgl)\n write(*,*) nearest(1.0_sgl,+1.0),nearest(1.0_sgl,+1.0)-1.0\n\n write(*,*) spacing(1.0_dbl)\nend program demo_spacing\n```\nResults:\n\nTypical values ...\n\n```text\n 1.1920929E-07\n 1.000000 1.1920929E-07\n 0.9999999 -5.9604645E-08\n 2.220446049250313E-016\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**tiny**(3)](#tiny)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "SPREAD": "## spread\n\n### **Name**\n\n**spread** - \\[ARRAY:CONSTRUCTION\\] Add a dimension and replicate data\n\n### **Synopsis**\n```fortran\n result = spread(source, dim, ncopies)\n```\n```fortran\n TYPE(kind=KIND) function spread(source, dim, ncopies)\n\n TYPE(kind=KIND) :: source(..)\n integer(kind=**),intent(in) :: dim\n integer(kind=**),intent(in) :: ncopies\n```\n### **Characteristics**\n\n- **source** is a scalar or array of any type.\n- **dim** is an _integer_ scalar\n- **ncopies** is an integer scalar\n\n### **Description**\n\n**spread** replicates a **source** array along a specified dimension\n**dim**. The copy is repeated **ncopies** times.\n\nSo to add additional rows to a matrix **dim=1** would be used, but to\nadd additional rows **dim=2** would be used, for example.\n\nIf **source** is scalar, the size of the resulting vector is **ncopies**\nand each element of the result has a value equal to **source**.\n\n### **Options**\n\n- **source**\n : a scalar or array of any type and a rank less than fifteen.\n\n- **dim**\n\n : The additional dimension value in the range from\n **1** to **n+1**, where **n** equals the rank of **source**.\n\n- **ncopies**\n : the number of copies of the original data to generate\n\n### **Result**\n\nThe result is an array of the same type as **source** and has rank **n+1**\nwhere **n** equals the rank of **source**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_spread\nimplicit none\n\ninteger a1(4,3), a2(3,4), v(4), s\n\n write(*,'(a)' ) &\n 'TEST SPREAD(3) ', &\n ' SPREAD(3) is a FORTRAN90 function which replicates', &\n ' an array by adding a dimension. ', &\n ' '\n\n s = 99\n call printi('suppose we have a scalar S',s)\n\n write(*,*) 'to add a new dimension (1) of extent 4 call'\n call printi('spread( s, dim=1, ncopies=4 )',spread ( s, 1, 4 ))\n\n v = [ 1, 2, 3, 4 ]\n call printi(' first we will set V to',v)\n\n write(*,'(a)')' and then do \"spread ( v, dim=2, ncopies=3 )\"'\n a1 = spread ( v, dim=2, ncopies=3 )\n call printi('this adds a new dimension (2) of extent 3',a1)\n\n a2 = spread ( v, 1, 3 )\n call printi(' spread(v,1,3) adds a new dimension (1) of extent 3',a2)\n ! add more\n a2 = spread ( v, 1, 3 )\n call printi(' spread(v,1,3) adds a new dimension (1) of extent 3',a2)\n\ncontains\n! CONVENIENCE ROUTINE; NOT DIRECTLY CONNECTED TO SPREAD(3)\nsubroutine printi(title,a)\nuse, intrinsic :: iso_fortran_env, only : stderr=>ERROR_UNIT,&\n & stdin=>INPUT_UNIT, stdout=>OUTPUT_UNIT\nimplicit none\n\n!@(#) print small 2d integer scalar, vector, matrix in row-column format\n\ncharacter(len=*),parameter :: all='(\" \",*(g0,1x))'\ncharacter(len=*),intent(in) :: title\ncharacter(len=20) :: row\ninteger,intent(in) :: a(..)\ninteger :: i\n\n write(*,all,advance='no')trim(title)\n ! select rank of input\n select rank(a)\n rank (0); write(*,'(a)')' (a scalar)'\n write(*,'(\" > [ \",i0,\" ]\")')a\n rank (1); write(*,'(a)')' (a vector)'\n ! find how many characters to use for integers\n write(row,'(i0)')ceiling(log10(real(maxval(abs(a)))))+2\n ! use this format to write a row\n row='(\" > [\",*(i'//trim(row)//':,\",\"))'\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 ! find how many characters to use for integers\n write(row,'(i0)')ceiling(log10(real(maxval(abs(a)))))+2\n ! use this format to write a row\n row='(\" > [\",*(i'//trim(row)//':,\",\"))'\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,*)'*printi* did not expect rank=', rank(a), &\n & 'shape=', shape(a),'size=',size(a)\n stop '*printi* unexpected rank'\n end select\n write(*,all) '>shape=',shape(a),',rank=',rank(a),',size=',size(a)\n write(*,*)\n\nend subroutine printi\n\nend program demo_spread\n```\nResults:\n```text\n TEST SPREAD(3)\n SPREAD(3) is a FORTRAN90 function which replicates\n an array by adding a dimension.\n\n suppose we have a scalar S (a scalar)\n > [ 99 ]\n >shape= ,rank= 0 ,size= 1\n\n to add a new dimension (1) of extent 4 call\n spread( s, dim=1, ncopies=4 ) (a vector)\n > [ 99 ]\n > [ 99 ]\n > [ 99 ]\n > [ 99 ]\n >shape= 4 ,rank= 1 ,size= 4\n\n first we will set V to (a vector)\n > [ 1 ]\n > [ 2 ]\n > [ 3 ]\n > [ 4 ]\n >shape= 4 ,rank= 1 ,size= 4\n\n and then do \"spread ( v, dim=2, ncopies=3 )\"\n this adds a new dimension (2) of extent 3 (a matrix)\n > [ 1, 1, 1 ]\n > [ 2, 2, 2 ]\n > [ 3, 3, 3 ]\n > [ 4, 4, 4 ]\n >shape= 4 3 ,rank= 2 ,size= 12\n\n spread(v,dim=1,ncopies=3) adds a new dimension (1) (a matrix)\n > [ 1, 2, 3, 4 ]\n > [ 1, 2, 3, 4 ]\n > [ 1, 2, 3, 4 ]\n >shape= 3 4 ,rank= 2 ,size= 12\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**merge**(3)](#merge),\n[**pack**(3)](#pack),\n[**unpack**(3)](#unpack)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", + "SPREAD": "## spread\n\n### **Name**\n\n**spread** - \\[ARRAY:CONSTRUCTION\\] Add a dimension and replicate data\n\n### **Synopsis**\n```fortran\n result = spread(source, dim, ncopies)\n```\n```fortran\n TYPE(kind=KIND) function spread(source, dim, ncopies)\n\n TYPE(kind=KIND) :: source(..)\n integer(kind=**),intent(in) :: dim\n integer(kind=**),intent(in) :: ncopies\n```\n### **Characteristics**\n\n- **source** is a scalar or array of any type.\n- **dim** is an _integer_ scalar\n- **ncopies** is an integer scalar\n\n### **Description**\n\n**spread** replicates a **source** array along a specified dimension\n**dim**. The copy is repeated **ncopies** times.\n\nSo to add additional rows to a matrix **dim=1** would be used, but to\nadd additional rows **dim=2** would be used, for example.\n\nIf **source** is scalar, the size of the resulting vector is **ncopies**\nand each element of the result has a value equal to **source**.\n\n### **Options**\n\n- **source**\n : a scalar or array of any type and a rank less than fifteen.\n\n- **dim**\n\n : The additional dimension value in the range from\n **1** to **n+1**, where **n** equals the rank of **source**.\n\n- **ncopies**\n : the number of copies of the original data to generate\n\n### **Result**\n\nThe result is an array of the same type as **source** and has rank **n+1**\nwhere **n** equals the rank of **source**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_spread\nimplicit none\n\ninteger a1(4,3), a2(3,4), v(4), s\n\n write(*,'(a)' ) &\n 'TEST SPREAD(3) ', &\n ' SPREAD(3) is a FORTRAN90 function which replicates', &\n ' an array by adding a dimension. ', &\n ' '\n\n s = 99\n call printi('suppose we have a scalar S',s)\n\n write(*,*) 'to add a new dimension (1) of extent 4 call'\n call printi('spread( s, dim=1, ncopies=4 )',spread ( s, 1, 4 ))\n\n v = [ 1, 2, 3, 4 ]\n call printi(' first we will set V to',v)\n\n write(*,'(a)')' and then do \"spread ( v, dim=2, ncopies=3 )\"'\n a1 = spread ( v, dim=2, ncopies=3 )\n call printi('this adds a new dimension (2) of extent 3',a1)\n\n a2 = spread ( v, 1, 3 )\n call printi(' spread(v,1,3) adds a new dimension (1) of extent 3',a2)\n ! add more\n a2 = spread ( v, 1, 3 )\n call printi(' spread(v,1,3) adds a new dimension (1) of extent 3',a2)\n\ncontains\n! CONVENIENCE ROUTINE; NOT DIRECTLY CONNECTED TO SPREAD(3)\nsubroutine printi(title,a)\nuse, intrinsic :: iso_fortran_env, only : stderr=>ERROR_UNIT,&\n & stdin=>INPUT_UNIT, stdout=>OUTPUT_UNIT\nimplicit none\n\n!@(#) print small 2d integer scalar, vector, matrix in row-column format\n\ncharacter(len=*),parameter :: all='(\" \",*(g0,1x))'\ncharacter(len=*),intent(in) :: title\ncharacter(len=20) :: row\ninteger,intent(in) :: a(..)\ninteger :: i\n\n write(*,all,advance='no')trim(title)\n ! select rank of input\n select rank(a)\n rank (0); write(*,'(a)')' (a scalar)'\n write(*,'(\" > [ \",i0,\" ]\")')a\n rank (1); write(*,'(a)')' (a vector)'\n ! find how many characters to use for integers\n write(row,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(a))))))+2\n ! use this format to write a row\n row='(\" > [\",*(i'//trim(row)//':,\",\"))'\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 ! find how many characters to use for integers\n write(row,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(a))))))+2\n ! use this format to write a row\n row='(\" > [\",*(i'//trim(row)//':,\",\"))'\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,*)'*printi* did not expect rank=', rank(a), &\n & 'shape=', shape(a),'size=',size(a)\n stop '*printi* unexpected rank'\n end select\n write(*,all) '>shape=',shape(a),',rank=',rank(a),',size=',size(a)\n write(*,*)\n\nend subroutine printi\n\nend program demo_spread\n```\nResults:\n```text\n TEST SPREAD(3)\n SPREAD(3) is a FORTRAN90 function which replicates\n an array by adding a dimension.\n\n suppose we have a scalar S (a scalar)\n > [ 99 ]\n >shape= ,rank= 0 ,size= 1\n\n to add a new dimension (1) of extent 4 call\n spread( s, dim=1, ncopies=4 ) (a vector)\n > [ 99 ]\n > [ 99 ]\n > [ 99 ]\n > [ 99 ]\n >shape= 4 ,rank= 1 ,size= 4\n\n first we will set V to (a vector)\n > [ 1 ]\n > [ 2 ]\n > [ 3 ]\n > [ 4 ]\n >shape= 4 ,rank= 1 ,size= 4\n\n and then do \"spread ( v, dim=2, ncopies=3 )\"\n this adds a new dimension (2) of extent 3 (a matrix)\n > [ 1, 1, 1 ]\n > [ 2, 2, 2 ]\n > [ 3, 3, 3 ]\n > [ 4, 4, 4 ]\n >shape= 4 3 ,rank= 2 ,size= 12\n\n spread(v,dim=1,ncopies=3) adds a new dimension (1) (a matrix)\n > [ 1, 2, 3, 4 ]\n > [ 1, 2, 3, 4 ]\n > [ 1, 2, 3, 4 ]\n >shape= 3 4 ,rank= 2 ,size= 12\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**merge**(3)](#merge),\n[**pack**(3)](#pack),\n[**unpack**(3)](#unpack)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "SQRT": "## sqrt\n\n### **Name**\n\n**sqrt** - \\[MATHEMATICS\\] Square-root function\n\n### **Synopsis**\n```fortran\n result = sqrt(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function sqrt(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_.\n - **KIND** may be any kind valid for the declared type.\n - the result has the same characteristics as **x**.\n\n### **Description**\n\n **sqrt** computes the principal square root of **x**.\n\n The number whose square root is being considered is known as the\n _radicand_.\n\n In mathematics, a square root of a radicand **x** is a number **y**\n such that **y\\*y = x**.\n\n Every nonnegative radicand **x** has two square roots of the same unique\n magnitude, one positive and one negative. The nonnegative square root\n is called the principal square root.\n\n The principal square root of 9 is 3, for example, even though (-3)\\*(-3)\n is also 9.\n\n Square roots of negative numbers are a special case of complex numbers,\n where with **complex** input the components of the _radicand_ need\n not be positive in order to have a valid square root.\n\n### **Options**\n\n- **x**\n : The radicand to find the principal square root of.\n If **x** is _real_ its value must be greater than or equal to zero.\n\n### **Result**\n\n The principal square root of **x** is returned.\n\n For a _complex_ result the real part is greater than or equal to zero.\n\n When the real part of the result is zero, the imaginary part has the\n same sign as the imaginary part of **x**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_sqrt\nuse, intrinsic :: iso_fortran_env, only : real_kinds, &\n & real32, real64, real128\nimplicit none\nreal(kind=real64) :: x, x2\ncomplex :: z, z2\n\n ! basics\n x = 2.0_real64\n ! complex\n z = (1.0, 2.0)\n write(*,*)'input values ',x,z\n\n x2 = sqrt(x)\n z2 = sqrt(z)\n write(*,*)'output values ',x2,z2\n\n ! elemental\n write(*,*)'elemental',sqrt([64.0,121.0,30.0])\n\n ! alternatives\n x2 = x**0.5\n z2 = z**0.5\n write(*,*)'alternatively',x2,z2\n\nend program demo_sqrt\n```\nResults:\n```text\n input values 2.00000000000000 (1.000000,2.000000)\n output values 1.41421356237310 (1.272020,0.7861513)\n elemental 8.000000 11.00000 5.477226\n alternatively 1.41421356237310 (1.272020,0.7861513)\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See also**\n\n[**exp**(3)](#exp),\n[**log**(3)](#log),\n[**log10**(3)](#log10)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "STORAGE_SIZE": "\n## storage_size\n\n### **Name**\n\n**storage_size** - \\[BIT:INQUIRY\\] Storage size in bits\n\n### **Synopsis**\n```fortran\n result = storage_size(a [,KIND] )\n```\n```fortran\n integer(kind=KIND) storage_size(a,KIND)\n\n type(TYPE(kind=**)) :: a\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n - a kind designated as ** may be any supported kind for the type\n\n - **a** may be of any type and kind. If it is polymorphic it shall not\n be an undefined pointer. If it is unlimited polymorphic or has any\n deferred type parameters, it shall not be an unallocated allocatable\n variable or a disassociated or undefined pointer.\n\n - The kind type parameter of the returned value is that specified by\n the value of **kind**; otherwise, the kind type parameter is that of\n default integer type.\n\n - The result is an _integer_ scalar of default kind unless **kind** is\n specified, in which case it has the kind specified by **kind**.\n\n### **Description**\n\n**storage_size** returns the storage size of argument **a** in bits.\n\n### **Options**\n\n- **a**\n : The entity to determine the storage size of\n\n- **kind**\n : a scalar integer constant expression that defines the kind of the\n output value.\n\n### **Result**\n\n The result value is the size expressed in bits for an element of an\n array that has the dynamic type and type parameters of **a**.\n\n If the type and type parameters are such that storage association\n applies, the result is consistent with the named constants\n defined in the intrinsic module ISO_FORTRAN_ENV.\n\n NOTE1\n\n An array element might take \"type\" more bits to store than an isolated\n scalar, since any hardware-imposed alignment requirements for array\n elements might not apply to a simple scalar variable.\n\n NOTE2\n\n This is intended to be the size in memory that an object takes when it\n is stored; this might differ from the size it takes during expression\n handling (which might be the native register size) or when stored in a\n file. If an object is never stored in memory but only in a register,\n this function nonetheless returns the size it would take if it were\n stored in memory.\n\n### **Examples**\n\nSample program\n```fortran\nprogram demo_storage_size\nimplicit none\n\n ! a default real, integer, and logical are the same storage size\n write(*,*)'size of integer ',storage_size(0)\n write(*,*)'size of real ',storage_size(0.0)\n write(*,*)'size of logical ',storage_size(.true.)\n write(*,*)'size of complex ',storage_size((0.0,0.0))\n\n ! note the size of an element of the array, not the storage size of\n ! the entire array is returned for array arguments\n write(*,*)'size of integer array ',storage_size([0,1,2,3,4,5,6,7,8,9])\n\nend program demo_storage_size\n```\nResults:\n```text\n size of integer 32\n size of real 32\n size of logical 32\n size of complex 64\n size of integer array 32\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**c_sizeof**(3)](#c_sizeof)\n\n _fortran-lang intrinsic descriptions_\n", - "SUM": "## sum\n\n### **Name**\n\n**sum** - \\[ARRAY:REDUCTION\\] Sum the elements of an array\n\n### **Synopsis**\n```fortran\n result = sum(array [,dim[,mask]] | [mask] )\n```\n```fortran\n TYPE(kind=KIND) function sum(array, dim, mask)\n\n TYPE(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** may be of any numeric type - _integer_, _real_ or _complex_.\n - **dim** is an _integer_\n - **mask** is _logical_ and conformable with **array**.\n - The result is of the same type and kind as **array**. It is scalar\n if **dim** is not present or **array** is a vector, else it is an array.\n\n### **Description**\n\n **sum** adds the elements of **array**.\n\n When only **array** is specified all elements are summed, but groups\n of sums may be returned along the dimension specified by **dim**\n and/or elements to add may be selected by a logical mask.\n\n No method is designated for how the sum is conducted, so whether or not\n accumulated error is compensated for is processor-dependent.\n\n### **Options**\n\n- **array**\n : an array containing the elements to add\n\n- **dim**\n : a value in the range from 1 to n, where n equals the rank (the number\n of dimensions) of **array**. **dim** designates the dimension\n along which to create sums. When absent a scalar sum of the elements\n optionally selected by **mask** is returned.\n\n- **mask**\n : an array of the same shape as **array** that designates\n which elements to add. If absent all elements are used in the sum(s).\n\n### **Result**\n\n If **dim** is absent, a scalar with the sum of all selected elements\n in **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. Since a vector has a rank\n of one, the result is a scalar (if n==1, n-1 is zero; and a rank of\n zero means a scalar).\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_sum\nimplicit none\ninteger :: vector(5) , matrix(3,4), box(5,6,7)\n\n vector = [ 1, 2, -3, 4, 5 ]\n\n matrix(1,:)=[ -1, 2, -3, 4 ]\n matrix(2,:)=[ 10, -20, 30, -40 ]\n matrix(3,:)=[ 100, 200, -300, 400 ]\n\n box=11\n\n ! basics\n print *, 'sum all elements:',sum(vector)\n print *, 'real :',sum([11.0,-5.0,20.0])\n print *, 'complex :',sum([(1.1,-3.3),(4.0,5.0),(8.0,-6.0)])\n ! with MASK option\n print *, 'sum odd elements:',sum(vector, mask=mod(vector, 2)==1)\n print *, 'sum positive values:', sum(vector, mask=vector>0)\n\n call printi('the input array', matrix )\n call printi('sum of all elements in matrix', sum(matrix) )\n call printi('sum of positive elements', sum(matrix,matrix>=0) )\n ! along dimensions\n call printi('sum along rows', sum(matrix,dim=1) )\n call printi('sum along columns', sum(matrix,dim=2) )\n call printi('sum of a vector is always a scalar', sum(vector,dim=1) )\n call printi('sum of a volume by row', sum(box,dim=1) )\n call printi('sum of a volume by column', sum(box,dim=2) )\n call printi('sum of a volume by depth', sum(box,dim=3) )\n\ncontains\n! CONVENIENCE ROUTINE; NOT DIRECTLY CONNECTED TO SPREAD(3)\nsubroutine printi(title,a)\nuse, intrinsic :: iso_fortran_env, only : stderr=>ERROR_UNIT,&\n & stdin=>INPUT_UNIT, stdout=>OUTPUT_UNIT\nimplicit none\n\n!@(#) print small 2d integer scalar, vector, matrix in row-column format\n\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: a(..)\n\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(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_sum\n```\nResults:\n```text\n sum all elements: 9\n real : 26.00000\n complex : (13.10000,-4.300000)\n sum odd elements: 6\n sum positive values: 12\n the input array (a matrix)\n > [ -1, 2, -3, 4 ]\n > [ 10, -20, 30, -40 ]\n > [ 100, 200, -300, 400 ]\n >shape= 3 4 ,rank= 2 ,size= 12\n\n sum of all elements in matrix (a scalar)\n > [ 382 ]\n >shape= ,rank= 0 ,size= 1\n\n sum of positive elements (a scalar)\n > [ 746 ]\n >shape= ,rank= 0 ,size= 1\n\n sum along rows (a vector)\n > [ 109 ]\n > [ 182 ]\n > [ -273 ]\n > [ 364 ]\n >shape= 4 ,rank= 1 ,size= 4\n\n sum along columns (a vector)\n > [ 2 ]\n > [ -20 ]\n > [ 400 ]\n >shape= 3 ,rank= 1 ,size= 3\n\n sum of a vector is always a scalar (a scalar)\n > [ 9 ]\n >shape= ,rank= 0 ,size= 1\n\n sum of a volume by row (a matrix)\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n >shape= 6 7 ,rank= 2 ,size= 42\n\n sum of a volume by column (a matrix)\n > [ 66, 66, 66, 66, 66, 66, 66 ]\n > [ 66, 66, 66, 66, 66, 66, 66 ]\n > [ 66, 66, 66, 66, 66, 66, 66 ]\n > [ 66, 66, 66, 66, 66, 66, 66 ]\n > [ 66, 66, 66, 66, 66, 66, 66 ]\n >shape= 5 7 ,rank= 2 ,size= 35\n\n sum of a volume by depth (a matrix)\n > [ 77, 77, 77, 77, 77, 77 ]\n > [ 77, 77, 77, 77, 77, 77 ]\n > [ 77, 77, 77, 77, 77, 77 ]\n > [ 77, 77, 77, 77, 77, 77 ]\n > [ 77, 77, 77, 77, 77, 77 ]\n >shape= 5 6 ,rank= 2 ,size= 30\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n - [**all**(3)](#all) - Determines if all the values are true\n - [**any**(3)](#any) - Determines if any of the values in the logical array are true.\n - [**count**(3)](#count) - Count true values in an array\n - [**maxval**(3)](#maxval) - Determines the maximum value in an array\n - [**minval**(3)](#minval) - Minimum value of an array\n - [**product**(3)](#product) - Product of array elements\n - [**merge**(3)](#merge) - Merge variables\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "SUM": "## sum\n\n### **Name**\n\n**sum** - \\[ARRAY:REDUCTION\\] Sum the elements of an array\n\n### **Synopsis**\n```fortran\n result = sum(array [,dim[,mask]] | [mask] )\n```\n```fortran\n TYPE(kind=KIND) function sum(array, dim, mask)\n\n TYPE(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** may be of any numeric type - _integer_, _real_ or _complex_.\n - **dim** is an _integer_\n - **mask** is _logical_ and conformable with **array**.\n - The result is of the same type and kind as **array**. It is scalar\n if **dim** is not present or **array** is a vector, else it is an array.\n\n### **Description**\n\n **sum** adds the elements of **array**.\n\n When only **array** is specified all elements are summed, but groups\n of sums may be returned along the dimension specified by **dim**\n and/or elements to add may be selected by a logical mask.\n\n No method is designated for how the sum is conducted, so whether or not\n accumulated error is compensated for is processor-dependent.\n\n### **Options**\n\n- **array**\n : an array containing the elements to add\n\n- **dim**\n : a value in the range from 1 to n, where n equals the rank (the number\n of dimensions) of **array**. **dim** designates the dimension\n along which to create sums. When absent a scalar sum of the elements\n optionally selected by **mask** is returned.\n\n- **mask**\n : an array of the same shape as **array** that designates\n which elements to add. If absent all elements are used in the sum(s).\n\n### **Result**\n\n If **dim** is absent, a scalar with the sum of all selected elements\n in **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. Since a vector has a rank\n of one, the result is a scalar (if n==1, n-1 is zero; and a rank of\n zero means a scalar).\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_sum\nimplicit none\ninteger :: vector(5) , matrix(3,4), box(5,6,7)\n\n vector = [ 1, 2, -3, 4, 5 ]\n\n matrix(1,:)=[ -1, 2, -3, 4 ]\n matrix(2,:)=[ 10, -20, 30, -40 ]\n matrix(3,:)=[ 100, 200, -300, 400 ]\n\n box=11\n\n ! basics\n print *, 'sum all elements:',sum(vector)\n print *, 'real :',sum([11.0,-5.0,20.0])\n print *, 'complex :',sum([(1.1,-3.3),(4.0,5.0),(8.0,-6.0)])\n ! with MASK option\n print *, 'sum odd elements:',sum(vector, mask=mod(vector, 2)==1)\n print *, 'sum positive values:', sum(vector, mask=vector>0)\n\n call printi('the input array', matrix )\n call printi('sum of all elements in matrix', sum(matrix) )\n call printi('sum of positive elements', sum(matrix,matrix>=0) )\n ! along dimensions\n call printi('sum along rows', sum(matrix,dim=1) )\n call printi('sum along columns', sum(matrix,dim=2) )\n call printi('sum of a vector is always a scalar', sum(vector,dim=1) )\n call printi('sum of a volume by row', sum(box,dim=1) )\n call printi('sum of a volume by column', sum(box,dim=2) )\n call printi('sum of a volume by depth', sum(box,dim=3) )\n\ncontains\n! CONVENIENCE ROUTINE; NOT DIRECTLY CONNECTED TO SPREAD(3)\nsubroutine printi(title,a)\nuse, intrinsic :: iso_fortran_env, only : stderr=>ERROR_UNIT,&\n & stdin=>INPUT_UNIT, stdout=>OUTPUT_UNIT\nimplicit none\n\n!@(#) print small 2d integer scalar, vector, matrix in row-column format\n\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: a(..)\n\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_sum\n```\nResults:\n```text\n sum all elements: 9\n real : 26.00000\n complex : (13.10000,-4.300000)\n sum odd elements: 6\n sum positive values: 12\n the input array (a matrix)\n > [ -1, 2, -3, 4 ]\n > [ 10, -20, 30, -40 ]\n > [ 100, 200, -300, 400 ]\n >shape= 3 4 ,rank= 2 ,size= 12\n\n sum of all elements in matrix (a scalar)\n > [ 382 ]\n >shape= ,rank= 0 ,size= 1\n\n sum of positive elements (a scalar)\n > [ 746 ]\n >shape= ,rank= 0 ,size= 1\n\n sum along rows (a vector)\n > [ 109 ]\n > [ 182 ]\n > [ -273 ]\n > [ 364 ]\n >shape= 4 ,rank= 1 ,size= 4\n\n sum along columns (a vector)\n > [ 2 ]\n > [ -20 ]\n > [ 400 ]\n >shape= 3 ,rank= 1 ,size= 3\n\n sum of a vector is always a scalar (a scalar)\n > [ 9 ]\n >shape= ,rank= 0 ,size= 1\n\n sum of a volume by row (a matrix)\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n > [ 55, 55, 55, 55, 55, 55, 55 ]\n >shape= 6 7 ,rank= 2 ,size= 42\n\n sum of a volume by column (a matrix)\n > [ 66, 66, 66, 66, 66, 66, 66 ]\n > [ 66, 66, 66, 66, 66, 66, 66 ]\n > [ 66, 66, 66, 66, 66, 66, 66 ]\n > [ 66, 66, 66, 66, 66, 66, 66 ]\n > [ 66, 66, 66, 66, 66, 66, 66 ]\n >shape= 5 7 ,rank= 2 ,size= 35\n\n sum of a volume by depth (a matrix)\n > [ 77, 77, 77, 77, 77, 77 ]\n > [ 77, 77, 77, 77, 77, 77 ]\n > [ 77, 77, 77, 77, 77, 77 ]\n > [ 77, 77, 77, 77, 77, 77 ]\n > [ 77, 77, 77, 77, 77, 77 ]\n >shape= 5 6 ,rank= 2 ,size= 30\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n - [**all**(3)](#all) - Determines if all the values are true\n - [**any**(3)](#any) - Determines if any of the values in the logical array are true.\n - [**count**(3)](#count) - Count true values in an array\n - [**maxval**(3)](#maxval) - Determines the maximum value in an array\n - [**minval**(3)](#minval) - Minimum value of an array\n - [**product**(3)](#product) - Product of array elements\n - [**merge**(3)](#merge) - Merge variables\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SYSTEM_CLOCK": "## system_clock\n\n### **Name**\n\n**system_clock** - \\[SYSTEM:TIME\\] Query system clock\n\n### **Synopsis**\n```fortran\n call system_clock([count] [,count_rate] [,count_max] )\n```\n```fortran\n subroutine system_clock(count, count_rate, count_max)\n\n integer(kind=**),intent(out),optional :: count\n type(TYPE(kind=**),intent(out),optional :: count_rate\n integer(kind=**),intent(out),optional :: count_max\n```\n### **Characteristics**\n\n - **count** is an _integer_ scalar\n - **count_rate** is an _integer_ or _real_ scalar\n - **count_max** is an _integer_ scalar\n\n### **Description**\n\n **system_clock** lets you measure durations of time with the\n precision of the smallest time increment generally available on a\n system by returning processor-dependent values based on the current\n value of the processor clock.\n\n **system_clock** is typically used to measure short time intervals\n (system clocks may be 24-hour clocks or measure processor clock ticks\n since boot, for example). It is most often used for measuring or\n tracking the time spent in code blocks in lieu of using profiling tools.\n\n **count_rate** and **count_max** are assumed constant (even though\n CPU rates can vary on a single platform).\n\n Whether an image has no clock, has a single clock of its own, or shares\n a clock with another image, is processor dependent.\n\n If there is no clock, or querying the clock fails, **count** is set to\n **-huge(count)**, and **count_rate** and **count_max** are set to zero.\n\n The accuracy of the measurements may depend on the kind of the\n arguments!\n\n Timing-related procedures are obviously processor and system-dependent.\n More specific information may generally be found in compiler-specific\n documentation.\n\n### **Options**\n\n- **count**\n If there is no clock, the returned value for **count** is the negative\n value **-huge(count)**.\n\n Otherwise, the **clock** value is incremented by one for each clock\n count until the value **count_max** is reached and is then reset to\n zero at the next count. **clock** therefore is a modulo value that\n lies in the range **0 to count_max**.\n\n- **count_rate**\n : is assigned a processor-dependent approximation to the number of\n processor clock counts per second, or zero if there is no clock.\n **count_rate** is system dependent and can vary depending on the kind\n of the arguments. Generally, a large _real_ may generate a more precise\n interval.\n\n- **count_max**\n : is assigned the maximum value that **COUNT** can have, or zero if\n there is no clock.\n\n### **Examples**\n\n If the processor clock is a 24-hour clock that registers time at\n approximately 18.20648193 ticks per second, at 11:30 A.M. the reference\n\n```fortran\n call system_clock (count = c, count_rate = r, count_max = m)\n```\n defines\n```text\n C = (11*3600+30*60)*18.20648193 = 753748,\n R = 18.20648193, and\n M = 24*3600*18.20648193-1 = 1573039.\n```\n\nSample program:\n```fortran\nprogram demo_system_clock\nuse, intrinsic :: iso_fortran_env, only: wp => real64, int32, int64\nimplicit none\ncharacter(len=*), parameter :: g = '(1x,*(g0,1x))'\n\ninteger(kind=int64) :: count64, count_rate64, count_max64\ninteger(kind=int64) :: start64, finish64\n\ninteger(kind=int32) :: count32, count_rate32, count_max32\ninteger(kind=int32) :: start32, finish32\n\nreal(kind=wp) :: time_read\nreal(kind=wp) :: sum\ninteger :: i\n\n print g, 'accuracy may vary with argument type!'\n\n print g, 'query all arguments'\n\n call system_clock(count64, count_rate64, count_max64)\n print g, 'COUNT_MAX(64bit)=', count_max64\n print g, 'COUNT_RATE(64bit)=', count_rate64\n print g, 'CURRENT COUNT(64bit)=', count64\n\n call system_clock(count32, count_rate32, count_max32)\n print g, 'COUNT_MAX(32bit)=', count_max32\n print g, 'COUNT_RATE(32bit)=', count_rate32\n print g, 'CURRENT COUNT(32bit)=', count32\n\n print g, 'time some computation'\n call system_clock(start64)\n\n ! some code to time\n sum = 0.0_wp\n do i = -0, huge(0) - 1\n sum = sum + sqrt(real(i))\n end do\n print g, 'SUM=', sum\n\n call system_clock(finish64)\n\n time_read = (finish64 - start64)/real(count_rate64, wp)\n write (*, '(1x,a,1x,g0,1x,a)') 'time : ', time_read, ' seconds'\n\nend program demo_system_clock\n```\nResults:\n```text\n > accuracy may vary with argument type!\n > query all arguments\n > COUNT_MAX(64bit)= 9223372036854775807\n > COUNT_RATE(64bit)= 1000000000\n > CURRENT COUNT(64bit)= 1105422387865806\n > COUNT_MAX(32bit)= 2147483647\n > COUNT_RATE(32bit)= 1000\n > CURRENT COUNT(32bit)= 1105422387\n > time some computation\n > SUM= 66344288183024.266\n > time : 6.1341038460000004 seconds\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**date_and_time**(3)](#date_and_time),\n[**cpu_time**(3)](#cpu_time)\n\n _fortran-lang intrinsic descriptions_\n", "TAN": "## tan\n\n### **Name**\n\n**tan** - \\[MATHEMATICS:TRIGONOMETRIC\\] Tangent function\n\n### **Synopsis**\n```fortran\nresult = tan(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function tan(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - the **TYPE** of **x** may be _real_ or _complex_ of any supported kind\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n**tan** computes the tangent of **x**.\n\n### **Options**\n\n- **x**\n : The angle in radians to compute the tangent of for _real_ input.\n If **x** is of type _complex_, its real part is regarded as a value\n in radians.\n\n### **Result**\n\n The return value is the tangent of the value **x**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_tan\nuse, intrinsic :: iso_fortran_env, only : real_kinds, &\n& real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 0.165_real64\n write(*,*)x, tan(x)\nend program demo_tan\n```\nResults:\n```text\n 0.16500000000000001 0.16651386310913616\n```\n### **Standard**\n\nFORTRAN 77 . For a complex argument, Fortran 2008 .\n\n### **See Also**\n\n[**atan**(3)](#atan),\n[**atan2**(3)](#atan2),\n[**cos**(3)](#cos),\n[**sin**(3)](#sin)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "TANH": "## tanh\n\n### **Name**\n\n**tanh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Hyperbolic tangent function\n\n### **Synopsis**\n```fortran\n result = tanh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function tanh(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be _real_ or _complex_ and any associated kind supported by\n the processor.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**tanh** computes the hyperbolic tangent of **x**.\n\n### **Options**\n\n- **x**\n : The value to compute the Hyperbolic tangent of.\n\n### **Result**\n\nReturns the hyperbolic tangent of **x**.\n\n If **x** is _complex_, the imaginary part of the result is regarded as\n a radian value.\n\n If **x** is _real_, the return value lies in the range\n```\n -1 <= tanh(x) <= 1.\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_tanh\nuse, intrinsic :: iso_fortran_env, only : &\n& real_kinds, real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 2.1_real64\n write(*,*)x, tanh(x)\nend program demo_tanh\n```\nResults:\n```text\n 2.1000000000000001 0.97045193661345386\n```\n### **Standard**\n\nFORTRAN 77 , for a complex argument Fortran 2008\n\n### **See Also**\n\n[**atanh**(3)](#atanh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _fortran-lang intrinsic descriptions_\n", @@ -193,10 +193,10 @@ "TINY": "## tiny\n\n### **Name**\n\n**tiny** - \\[NUMERIC MODEL\\] Smallest positive number of a real kind\n\n### **Synopsis**\n```fortran\n result = tiny(x)\n```\n```fortran\n real(kind=KIND) function tiny(x)\n\n real(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_ scalar or array\n - the result has the same type and kind as **x**\n\n### **Description**\n\n **tiny** returns the smallest positive (non zero) number of the\n type and kind of **x**.\n\n For real **x**\n```fortran\n result = 2.0**(minexponent(x)-1)\n```\n### **Options**\n\n- **x**\n : The value whose kind is used to determine the model type to query\n\n### **Result**\n\n The smallest positive value for the _real_ type of the specified kind.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_tiny\nimplicit none\n print *, 'default real is from', tiny(0.0), 'to',huge(0.0)\n print *, 'doubleprecision is from ', tiny(0.0d0), 'to',huge(0.0d0)\nend program demo_tiny\n```\nResults:\n\n```text\n default real is from 1.17549435E-38 to 3.40282347E+38\n doubleprecision is from 2.2250738585072014E-308 to\n 1.7976931348623157E+308\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "TRAILZ": "## trailz\n\n### **Name**\n\n**trailz** - \\[BIT:COUNT\\] Number of trailing zero bits of an integer\n\n### **Synopsis**\n```fortran\n result = trailz(i)\n```\n```fortran\n elemental integer function trailz(i)\n\n integer(kind=**),intent(in) :: i\n```\n### **Characteristics**\n\n - **i** is an _integer_ of any kind.\n - the result is an _integer_ of default kind\n\n### **Description**\n\n **trailz** returns the number of trailing zero bits of an _integer_\n value.\n\n### **Options**\n\n- **i**\n : the value to count trailing zero bits in\n\n### **Result**\n The number of trailing rightmost zero bits in an _integer_ value after\n the last non-zero bit.\n```text\n > right-most non-zero bit\n > V\n > |0|0|0|1|1|1|0|1|0|0|0|0|0|0|\n > ^ |___________| trailing zero bits\n > bit_size(i)\n```\n If all the bits of **i** are zero, the result is the size of the input\n value in bits, ie. **bit_size(i)**.\n\n The result may also be seen as the position of the rightmost 1 bit\n in **i**, starting with the rightmost bit being zero and counting to\n the left.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_trailz\n\n! some common integer kinds\nuse, intrinsic :: iso_fortran_env, only : &\n & integer_kinds, int8, int16, int32, int64\n\nimplicit none\n\n! a handy format\ncharacter(len=*),parameter :: &\n & show = '(1x,\"value=\",i4,\", value(bits)=\",b32.32,1x,\", trailz=\",i3)'\n\ninteger(kind=int64) :: bigi\n ! basics\n write(*,*)'Note default integer is',bit_size(0),'bits'\n print show, -1, -1, trailz(-1)\n print show, 0, 0, trailz(0)\n print show, 1, 1, trailz(1)\n print show, 96, 96, trailz(96)\n ! elemental\n print *, 'elemental and any integer kind:'\n bigi=2**5\n write(*,*) trailz( [ bigi, bigi*256, bigi/2 ] )\n write(*,'(1x,b64.64)')[ bigi, bigi*256, bigi/2 ]\n\nend program demo_trailz\n```\nResults:\n```text\n Note default integer is 32 bits\n value= -1, value(bits)=11111111111111111111111111111111 , trailz= 0\n value= 0, value(bits)=00000000000000000000000000000000 , trailz= 32\n value= 1, value(bits)=00000000000000000000000000000001 , trailz= 0\n value= 96, value(bits)=00000000000000000000000001100000 , trailz= 5\n elemental and any integer kind:\n 5 13 4\n 0000000000000000000000000000000000000000000000000000000000100000\n 0000000000000000000000000000000000000000000000000010000000000000\n 0000000000000000000000000000000000000000000000000000000000010000\n```\n### **Standard**\n\n Fortran 2008\n\n### **See Also**\n\n[**bit_size**(3)](#bit_size),\n[**popcnt**(3)](#popcnt),\n[**poppar**(3)](#poppar),\n[**leadz**(3)](#leadz)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "TRANSFER": "## transfer\n\n### **Name**\n\n**transfer** - \\[TYPE:MOLD\\] Transfer bit patterns\n\n### **Synopsis**\n```fortran\n result = transfer(source, mold [,size] )\n```\n```fortran\n type(TYPE(kind=KIND)) function transfer(source,mold,size)\n\n type(TYPE(kind=KIND)),intent(in) :: source(..)\n type(TYPE(kind=KIND)),intent(in) :: mold(..)\n integer(kind=**),intent(in),optional :: size\n```\n### **Characteristics**\n\n- **source** shall be a scalar or an array of any type.\n- **mold** shall be a scalar or an array of any type.\n- **size** shall be a scalar of type _integer_.\n- **result** has the same type as **mold**\n\n### **Description**\n\n**transfer** copies the bitwise representation of **source** in memory\ninto a variable or array of the same type and type parameters as **mold**.\n\nThis is approximately equivalent to the C concept of \"casting\" one type\nto another.\n\n### **Options**\n\n- **source**\n : Holds the bit pattern to be copied\n\n- **mold**\n : the type of **mold** is used to define the type of the returned\n value. In addition, if it is an array the returned value is a\n one-dimensional array. If it is a scalar the returned value is a scalar.\n\n- **size**\n : If **size** is present, the result is a one-dimensional array of\n length **size**.\n\nIf **size** is absent but **mold** is an array (of any size or\nshape), the result is a one-dimensional array of the minimum length\nneeded to contain the entirety of the bitwise representation of **source**.\n\nIf **size** is absent and **mold** is a scalar, the result is a scalar.\n\n### **Result**\n\nThe result has the bit level representation of **source**.\n\nIf the bitwise representation of the result is longer than that of\n**source**, then the leading bits of the result correspond to those of\n**source** but any trailing bits are filled arbitrarily.\n\nWhen the resulting bit representation does not correspond to a valid\nrepresentation of a variable of the same type as **mold**, the results are\nundefined, and subsequent operations on the result cannot be guaranteed to\nproduce sensible behavior. For example, it is possible to create _logical_\nvariables for which **var** and .not. var both appear to be true.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_transfer\nuse,intrinsic :: iso_fortran_env, only : int32, real32\ninteger(kind=int32) :: i = 2143289344\nreal(kind=real32) :: x\ncharacter(len=10) :: string\ncharacter(len=1) :: chars(10)\n x=transfer(i, 1.0) ! prints \"nan\" on i686\n ! the bit patterns are the same\n write(*,'(b0,1x,g0)')x,x ! create a NaN\n write(*,'(b0,1x,g0)')i,i\n\n ! a string to an array of characters\n string='abcdefghij'\n chars=transfer(string,chars)\n write(*,'(*(\"[\",a,\"]\":,1x))')string\n write(*,'(*(\"[\",a,\"]\":,1x))')chars\nend program demo_transfer\n```\n\nResults:\n\n```text\n 1111111110000000000000000000000 NaN\n 1111111110000000000000000000000 2143289344\n [abcdefghij]\n [a] [b] [c] [d] [e] [f] [g] [h] [i] [j]\n```\n\n### **Comments**\n\n_Joe Krahn_: Fortran uses **molding** rather than **casting**.\n\nCasting, as in C, is an in-place reinterpretation. A cast is a device\nthat is built around an object to change its shape.\n\nFortran **transfer** reinterprets data out-of-place. It can be\nconsidered **molding** rather than casting. A **mold** is a device that\nconfers a shape onto an object placed into it.\n\nThe advantage of molding is that data is always valid in the context\nof the variable that holds it. For many cases, a decent compiler should\noptimize **transfer** into a simple assignment.\n\nThere are disadvantages of this approach. It is problematic to define a\nunion of data types because you must know the largest data object, which\ncan vary by compiler or compile options. In many cases, an _EQUIVALENCE_\nwould be far more effective, but Fortran Standards committees seem\noblivious to the benefits of _EQUIVALENCE_ when used sparingly.\n\n### **Standard**\n\nFortran 90\n\n### **See also**\n\n[****(3)](#)\n\n _fortran-lang intrinsic descriptions_\n", - "TRANSPOSE": "## transpose\n\n### **Name**\n\n**transpose** - \\[ARRAY:MANIPULATION\\] Transpose an array of rank two\n\n### **Synopsis**\n```fortran\n result = transpose(matrix)\n```\n```fortran\n function transpose(matrix)\n\n type(TYPE(kind=KIND) :: transpose(N,M)\n type(TYPE(kind=KIND),intent(in) :: matrix(M,N)\n```\n### **Characteristics**\n\n - **matrix** is an array of any type with a rank of two.\n - The result will be the same type and kind as **matrix** and the\n reversed shape of the input array\n\n### **Description**\n\n **transpose** transposes an array of rank two.\n\n An array is transposed by interchanging the rows and columns of the\n given matrix. That is, element (i,j) of the result has the value of\n element (j,i) of the input for all (i,j).\n\n### **Options**\n\n- **matrix**\n : The array to transpose\n\n### **Result**\n\nThe transpose of the input array. The result has the same type as\n**matrix**, and has shape \\[ m, n \\] if **matrix** has shape \\[ n, m \\].\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_transpose\nimplicit none\ninteger,save :: xx(3,5)= reshape([&\n 1, 2, 3, 4, 5, &\n 10, 20, 30, 40, 50, &\n 11, 22, 33, 44, -1055 &\n ],shape(xx),order=[2,1])\n\ncall print_matrix_int('xx array:',xx)\ncall print_matrix_int('xx array transposed:',transpose(xx))\n\ncontains\n\nsubroutine print_matrix_int(title,arr)\n! print small 2d integer arrays in row-column format\nimplicit none\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n write(*,*)trim(title) ! print title\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(real(maxval(abs(arr)))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\nend subroutine print_matrix_int\n\nend program demo_transpose\n```\nResults:\n```\n xx array:\n > [ 1, 2, 3, 4, 5 ]\n > [ 10, 20, 30, 40, 50 ]\n > [ 11, 22, 33, 44, -1055 ]\n xx array transposed:\n > [ 1, 10, 11 ]\n > [ 2, 20, 22 ]\n > [ 3, 30, 33 ]\n > [ 4, 40, 44 ]\n > [ 5, 50, -1055 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See also**\n\n- [**merge**(3)](#merge) - Merge variables\n- [**pack**(3)](#pack) - Pack an array into an array of rank one\n- [**spread**(3)](#spread) - Add a dimension and replicate data\n- [**unpack**(3)](#unpack) - Scatter the elements of a vector\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "TRANSPOSE": "## transpose\n\n### **Name**\n\n**transpose** - \\[ARRAY:MANIPULATION\\] Transpose an array of rank two\n\n### **Synopsis**\n```fortran\n result = transpose(matrix)\n```\n```fortran\n function transpose(matrix)\n\n type(TYPE(kind=KIND) :: transpose(N,M)\n type(TYPE(kind=KIND),intent(in) :: matrix(M,N)\n```\n### **Characteristics**\n\n - **matrix** is an array of any type with a rank of two.\n - The result will be the same type and kind as **matrix** and the\n reversed shape of the input array\n\n### **Description**\n\n **transpose** transposes an array of rank two.\n\n An array is transposed by interchanging the rows and columns of the\n given matrix. That is, element (i,j) of the result has the value of\n element (j,i) of the input for all (i,j).\n\n### **Options**\n\n- **matrix**\n : The array to transpose\n\n### **Result**\n\nThe transpose of the input array. The result has the same type as\n**matrix**, and has shape \\[ m, n \\] if **matrix** has shape \\[ n, m \\].\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_transpose\nimplicit none\ninteger,save :: xx(3,5)= reshape([&\n 1, 2, 3, 4, 5, &\n 10, 20, 30, 40, 50, &\n 11, 22, 33, 44, -1055 &\n ],shape(xx),order=[2,1])\n\ncall print_matrix_int('xx array:',xx)\ncall print_matrix_int('xx array transposed:',transpose(xx))\n\ncontains\n\nsubroutine print_matrix_int(title,arr)\n! print small 2d integer arrays in row-column format\nimplicit none\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n write(*,*)trim(title) ! print title\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\nend subroutine print_matrix_int\n\nend program demo_transpose\n```\nResults:\n```\n xx array:\n > [ 1, 2, 3, 4, 5 ]\n > [ 10, 20, 30, 40, 50 ]\n > [ 11, 22, 33, 44, -1055 ]\n xx array transposed:\n > [ 1, 10, 11 ]\n > [ 2, 20, 22 ]\n > [ 3, 30, 33 ]\n > [ 4, 40, 44 ]\n > [ 5, 50, -1055 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See also**\n\n- [**merge**(3)](#merge) - Merge variables\n- [**pack**(3)](#pack) - Pack an array into an array of rank one\n- [**spread**(3)](#spread) - Add a dimension and replicate data\n- [**unpack**(3)](#unpack) - Scatter the elements of a vector\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "TRIM": "## trim\n\n### **Name**\n\n**trim** - \\[CHARACTER:WHITESPACE\\] Remove trailing blank characters from a string\n\n### **Synopsis**\n```fortran\n result = trim(string)\n```\n```fortran\n character(len=:,kind=KIND) function trim(string)\n\n character(len=*,kind=KIND),intent(in) :: string\n```\n### **Characteristics**\n\n - **KIND** can be any kind supported for the _character_ type.\n - The result has the same type and kind as the input argument **string**.\n\n### **Description**\n\n **trim** removes trailing blank characters from a string.\n\n### **Options**\n\n- **string**\n : A string to trim\n\n### **Result**\n\n The result is the same as **string** except trailing blanks are removed.\n\n If **string** is composed entirely of blanks or has zero length,\n the result has zero length.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_trim\nimplicit none\ncharacter(len=:), allocatable :: str, strs(:)\ncharacter(len=*),parameter :: brackets='( *(\"[\",a,\"]\":,1x) )'\ninteger :: i\n\n str=' trailing '\n print brackets, str,trim(str) ! trims it\n\n str=' leading'\n print brackets, str,trim(str) ! no effect\n\n str=' '\n print brackets, str,trim(str) ! becomes zero length\n print *, len(str), len(trim(' '))\n\n ! array elements are all the same length, so you often\n ! want to print them\n strs=[character(len=10) :: \"Z\",\" a b c\",\"ABC\",\"\"]\n\n write(*,*)'untrimmed:'\n ! everything prints as ten characters; nice for neat columns\n print brackets, (strs(i), i=1,size(strs))\n print brackets, (strs(i), i=size(strs),1,-1)\n write(*,*)'trimmed:'\n ! everything prints trimmed\n print brackets, (trim(strs(i)), i=1,size(strs))\n print brackets, (trim(strs(i)), i=size(strs),1,-1)\n\nend program demo_trim\n```\nResults:\n```text\n > [ trailing ] [ trailing]\n > [ leading] [ leading]\n > [ ] []\n > 12 0\n > untrimmed:\n > [Z ] [ a b c ] [ABC ] [ ]\n > [ ] [ABC ] [ a b c ] [Z ]\n > trimmed:\n > [Z] [ a b c] [ABC] []\n > [] [ABC] [ a b c] [Z]\n```\n### **Standard**\n\nFortran 95\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),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\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**](#trim)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "UBOUND": "## ubound\n\n### **Name**\n\n**ubound** - \\[ARRAY:INQUIRY\\] Upper dimension bounds of an array\n\n### **Synopsis**\n```fortran\n result = ubound(array [,dim] [,kind] )\n```\n```fortran\n elemental TYPE(kind=KIND) function ubound(array,dim,kind)\n\n TYPE(kind=KIND),intent(in) :: array\n integer(kind=**),intent(in),optional :: dim\n integer(kind=**),intent(in),optional :: kind\n```\n### **Characteristics**\n\n- **array** shall be assumed-rank or an array, of any type.\n It cannot be an unallocated allocatable array or a pointer that is not associated.\n\n- **dim** shall be a scalar _integer_.\n The corresponding actual argument shall not be an optional dummy\n argument, a disassociated pointer, or an unallocated allocatable.\n\n- **kind** an _integer_ initialization expression indicating the kind\n parameter of the result.\n\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 The result is scalar if **dim** is present; otherwise, the result is\n an array of rank one and size n, where n is the rank of **array**.\n\n- a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**ubound** returns the upper bounds of an array, or a single upper\nbound along the **dim** dimension.\n\n### **Options**\n\n- **array**\n : The assumed-rank or array of any type whose upper bounds are to be\n determined. If allocatable it must be allocated; if a pointer it must\n be associated. If an assumed-size array, **dim** must be present.\n\n- **dim**\n : a specific dimension of **array** to determine the bounds of.\n If **dim** is absent, the result is an array of the upper bounds of\n **array**. **dim** is required if **array** is an assumed-size array,\n and in that case must be less than or equal to the rank of **array**.\n\n- **kind**\n : indicates the kind parameter of the result. If absent, an _integer_\n of the default kind is returned.\n\n### **Result**\n\nThe return value is of type _integer_ and of kind **kind**. If **kind**\nis absent, the return value is of default integer kind.\n\nIf **dim** is absent, the result is an array of the upper bounds of\neach dimension of the **array**.\n\nIf **dim** is present, the result is a scalar corresponding to the upper\nbound of the array along that dimension.\n\nIf **array** is an expression rather than a whole array or array\nstructure component, or if it has a zero extent along the relevant\ndimension, the upper bound is taken to be the number of elements along\nthe relevant dimension.\n\n NOTE1\n If ARRAY is assumed-rank and has rank zero, DIM cannot be present\n since it cannot satisfy the requirement\n **1 <= DIM <= 0**.\n\n### **Examples**\n\nNote this function should not be used on assumed-size arrays or in any\nfunction without an explicit interface. Errors can occur if there is no\ninterface defined.\n\nSample program\n\n```fortran\n! program demo_ubound\nmodule m2_bounds\nimplicit none\n\ncontains\n\nsubroutine msub(arr)\n!!integer,intent(in) :: arr(*) ! cannot be assumed-size array\ninteger,intent(in) :: arr(:)\n write(*,*)'MSUB: LOWER=',lbound(arr),'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\nend subroutine msub\n\nend module m2_bounds\n!\nprogram demo_ubound\nuse m2_bounds, only : msub\nimplicit none\ninterface\n subroutine esub(arr)\n integer,intent(in) :: arr(:)\n end subroutine esub\nend interface\ninteger :: arr(-10:10)\n write(*,*)'MAIN: LOWER=',lbound(arr),'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\n call csub()\n call msub(arr)\n call esub(arr)\ncontains\nsubroutine csub\n write(*,*)'CSUB: LOWER=',lbound(arr),'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\nend subroutine csub\n\nend\n\nsubroutine esub(arr)\nimplicit none\ninteger,intent(in) :: arr(:)\n ! WARNING: IF CALLED WITHOUT AN EXPLICIT INTERFACE\n ! THIS WILL GIVE UNDEFINED ANSWERS (like 0,0,0)\n write(*,*)'ESUB: LOWER=',lbound(arr),'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\nend subroutine esub\n!end program demo_ubound\n```\nResults:\n```text\n > MAIN: LOWER= -10 UPPER= 10 SIZE= 21\n > CSUB: LOWER= -10 UPPER= 10 SIZE= 21\n > MSUB: LOWER= 1 UPPER= 21 SIZE= 21\n > ESUB: LOWER= 1 UPPER= 21 SIZE= 21\n```\n### **Standard**\n\nFortran 95 , with KIND argument Fortran 2003\n\n### **See Also**\n\n#### Array inquiry:\n\n- [**size**(3)](#size) - Determine the size of an array\n- [**rank**(3)](#rank) - Rank of a data object\n- [**shape**(3)](#shape) - Determine the shape of an array\n- [**lbound**(3)](#lbound) - Lower dimension bounds of an array\n\n[**co\\_ubound**(3)](#ucobound),\n[**co\\_lbound**(3)](lcobound)\n\n#### State Inquiry:\n\n- [**allocated**(3)](#allocated) - Status of an allocatable entity\n- [**is_contiguous**(3)](#is_contiguous) - Test if object is contiguous\n\n#### Kind Inquiry:\n\n- [**kind**(3)](#kind) - Kind of an entity\n\n#### Bit Inquiry:\n\n- [**storage_size**(3)](#storage_size) - Storage size in bits\n- [**bit_size**(3)](#bit_size) - Bit size inquiry function\n- [**btest**(3)](#btest) - Tests a bit of an _integer_ value.\n- [**lbound**(3)](#lbound),\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "UCOBOUND": "## ucobound\n\n### **Name**\n\n**ucobound** - \\[COLLECTIVE\\] Upper codimension bounds of an array\n\n### **Synopsis**\n```fortran\n result = ucobound(coarray [,dim] [,kind] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**ucobound** returns the upper cobounds of a coarray, or a single\nupper cobound along the **dim** codimension.\n\n### **Options**\n\n- **array**\n : Shall be an coarray, of any type.\n\n- **dim**\n : (Optional) Shall be a scalar _integer_.\n\n- **kind**\n : (Optional) An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\nThe return value is of type _integer_ and of kind **kind**. If **kind** is absent,\nthe return value is of default integer kind. If **dim** is absent, the\nresult is an array of the lower cobounds of **coarray**. If **dim** is present,\nthe result is a scalar corresponding to the lower cobound of the array\nalong that codimension.\n\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**lcobound**(3)](#lcobound),\n[**lbound**(3)](#lbound),\n[**ubound**(3)](#ubound)\n", - "UNPACK": "## unpack\n\n### **Name**\n\n**unpack** - \\[ARRAY:CONSTRUCTION\\] Scatter the elements of a vector\ninto an array using a mask\n\n### **Synopsis**\n```fortran\n result = unpack(vector, mask, field)\n```\n```fortran\n type(TYPE(kind=KIND)) unpack(vector, mask, field)\n\n type(TYPE(kind=KIND)),intent(in) :: vector(:)\n logical,intent(in) :: mask(..)\n type(TYPE(kind=KIND)),intent(in) :: field(..)\n```\n### **Characteristics**\n\n - **vector** is a rank-one array of any type\n - **mask** is a logical array\n - **field** is the same type and type parameters as VECTOR conformable with **mask**.\n - The result is an array of the same type and type parameters as **vector**\n and the same shape as **mask**.\n\n### **Description**\n\n**unpack** scatters the elements of **vector** into a copy of an\narray **field** of any rank using _.true._ values from **mask** in array\nelement order to specify placement of the **vector** values.\n\nSo a copy of **field** is generated with select elements replaced with\nvalues from **vector**. This allows for complex replacement patterns\nthat would be difficult when using array syntax or multiple assignment\nstatements, particularly when the replacements are conditional.\n\n### **Options**\n\n- **vector**\n : New values to place into specified locations in **field**.\n It shall have at least as many elements as **mask** has _.true._\n values.\n\n- **mask**\n : Shall be an array that specifies which values\n in **field** are to be replaced with values from **vector**.\n\n- **field**\n : The input array to be altered.\n\n### **Result**\n\n The element of the result that corresponds to the ith true element\n of **mask**, in array element order, has the value **vector(i)** for i =\n 1, 2, . . ., t, where t is the number of true values in **mask**. Each\n other element has a value equal to **field* if **field* is scalar or to the\n corresponding element of **field* if it is an array.\n\n The resulting array corresponds to **field** with _.true._ elements\n of **mask** replaced by values from **vector** in array element order.\n\n### **Examples**\nParticular values may be \"scattered\" to particular positions in an array by using\n```text\n 1 0 0\n If M is the array 0 1 0\n 0 0 1\n\n V is the array [1, 2, 3],\n . T .\n and Q is the logical mask T . .\n . . T\n where \"T\" represents true and \".\" represents false, then the result of\n\n UNPACK (V, MASK = Q, FIELD = M) has the value\n\n 1 2 0\n 1 1 0\n 0 0 3\n\n and the result of UNPACK (V, MASK = Q, FIELD = 0) has the value\n\n 0 2 0\n 1 0 0\n 0 0 3\n```\n\nSample program:\n\n```fortran\nprogram demo_unpack\nimplicit none\nlogical,parameter :: T=.true., F=.false.\n\ninteger :: vector(2) = [1,1]\n\n! mask and field must conform\ninteger,parameter :: r=2, c=2\nlogical :: mask(r,c) = reshape([ T,F,F,T ],[2,2])\ninteger :: field(r,c) = 0, unity(2,2)\n\n ! basic usage\n unity = unpack( vector, mask, field )\n call print_matrix_int('unity=', unity)\n\n ! if FIELD is a scalar it is used to fill all the elements\n ! not assigned to by the vector and mask.\n call print_matrix_int('scalar field', &\n & unpack( &\n & vector=[ 1, 2, 3, 4 ], &\n & mask=reshape([ T,F,T,F,F,F,T,F,T ], [3,3]), &\n & field=0) )\n\ncontains\n\n subroutine print_matrix_int(title,arr)\n ! convenience routine:\n ! just prints small integer arrays in row-column format\n implicit none\n character(len=*),intent(in) :: title\n integer,intent(in) :: arr(:,:)\n integer :: i\n character(len=:),allocatable :: biggest\n\n write(*,*)trim(title)\n ! make buffer to write integer into\n biggest=' '\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(real(maxval(abs(arr)))))+2\n ! use this format to write a row\n biggest='(\" [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n end subroutine print_matrix_int\n\nend program demo_unpack\n```\nResults:\n\n```text\n > unity=\n > [ 1, 0 ]\n > [ 0, 1 ]\n > scalar field\n > [ 1, 0, 3 ]\n > [ 0, 0, 0 ]\n > [ 2, 0, 4 ]\n```\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**merge**(3)](#merge),\n[**pack**(3)](#pack),\n[**spread**(3)](#spread)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "UNPACK": "## unpack\n\n### **Name**\n\n**unpack** - \\[ARRAY:CONSTRUCTION\\] Scatter the elements of a vector\ninto an array using a mask\n\n### **Synopsis**\n```fortran\n result = unpack(vector, mask, field)\n```\n```fortran\n type(TYPE(kind=KIND)) unpack(vector, mask, field)\n\n type(TYPE(kind=KIND)),intent(in) :: vector(:)\n logical,intent(in) :: mask(..)\n type(TYPE(kind=KIND)),intent(in) :: field(..)\n```\n### **Characteristics**\n\n - **vector** is a rank-one array of any type\n - **mask** is a logical array\n - **field** is the same type and type parameters as VECTOR conformable with **mask**.\n - The result is an array of the same type and type parameters as **vector**\n and the same shape as **mask**.\n\n### **Description**\n\n**unpack** scatters the elements of **vector** into a copy of an\narray **field** of any rank using _.true._ values from **mask** in array\nelement order to specify placement of the **vector** values.\n\nSo a copy of **field** is generated with select elements replaced with\nvalues from **vector**. This allows for complex replacement patterns\nthat would be difficult when using array syntax or multiple assignment\nstatements, particularly when the replacements are conditional.\n\n### **Options**\n\n- **vector**\n : New values to place into specified locations in **field**.\n It shall have at least as many elements as **mask** has _.true._\n values.\n\n- **mask**\n : Shall be an array that specifies which values\n in **field** are to be replaced with values from **vector**.\n\n- **field**\n : The input array to be altered.\n\n### **Result**\n\n The element of the result that corresponds to the ith true element\n of **mask**, in array element order, has the value **vector(i)** for i =\n 1, 2, . . ., t, where t is the number of true values in **mask**. Each\n other element has a value equal to **field* if **field* is scalar or to the\n corresponding element of **field* if it is an array.\n\n The resulting array corresponds to **field** with _.true._ elements\n of **mask** replaced by values from **vector** in array element order.\n\n### **Examples**\nParticular values may be \"scattered\" to particular positions in an array by using\n```text\n 1 0 0\n If M is the array 0 1 0\n 0 0 1\n\n V is the array [1, 2, 3],\n . T .\n and Q is the logical mask T . .\n . . T\n where \"T\" represents true and \".\" represents false, then the result of\n\n UNPACK (V, MASK = Q, FIELD = M) has the value\n\n 1 2 0\n 1 1 0\n 0 0 3\n\n and the result of UNPACK (V, MASK = Q, FIELD = 0) has the value\n\n 0 2 0\n 1 0 0\n 0 0 3\n```\n\nSample program:\n\n```fortran\nprogram demo_unpack\nimplicit none\nlogical,parameter :: T=.true., F=.false.\n\ninteger :: vector(2) = [1,1]\n\n! mask and field must conform\ninteger,parameter :: r=2, c=2\nlogical :: mask(r,c) = reshape([ T,F,F,T ],[2,2])\ninteger :: field(r,c) = 0, unity(2,2)\n\n ! basic usage\n unity = unpack( vector, mask, field )\n call print_matrix_int('unity=', unity)\n\n ! if FIELD is a scalar it is used to fill all the elements\n ! not assigned to by the vector and mask.\n call print_matrix_int('scalar field', &\n & unpack( &\n & vector=[ 1, 2, 3, 4 ], &\n & mask=reshape([ T,F,T,F,F,F,T,F,T ], [3,3]), &\n & field=0) )\n\ncontains\n\nsubroutine print_matrix_int(title,arr)\n! convenience routine:\n! just prints small integer arrays in row-column format\nimplicit none\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n write(*,*)trim(title)\n ! make buffer to write integer into\n biggest=' '\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\nend subroutine print_matrix_int\n\nend program demo_unpack\n```\nResults:\n\n```text\n > unity=\n > [ 1, 0 ]\n > [ 0, 1 ]\n > scalar field\n > [ 1, 0, 3 ]\n > [ 0, 0, 0 ]\n > [ 2, 0, 4 ]\n```\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**merge**(3)](#merge),\n[**pack**(3)](#pack),\n[**spread**(3)](#spread)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "VERIFY": "## verify\n\n### **Name**\n\n**verify** - \\[CHARACTER:SEARCH\\] Position of a character in a string\nof characters that does not appear in a given set of characters.\n\n### **Synopsis**\n```fortran\n result = verify(string, set [,back] [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function verify(string,set,back,KIND)\n\n character(len=*,kind=**),intent(in) :: string\n character(len=*,kind=**),intent(in) :: set\n logical,intent(in),optional :: back\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - **string** and **set** must be of type _character_ and have the same kind for any\n individual call, but that can be any supported _character_ kind.\n - **KIND** must be a constant _integer_ initialization expression and a\n valid kind for the _integer_ type.\n - **back** shall be of type logical.\n - the kind of the returned value is the same as **kind** if\n present. Otherwise a default _integer_ kind is returned.\n\n### **Description**\n\n **verify** verifies that all the characters in **string** belong\n to the set of characters in **set** by identifying the position of\n the first character in the string that is not in the set.\n\n This makes it easy to verify strings are all uppercase or lowercase,\n follow a basic syntax, only contain printable characters, and many\n of the conditions tested for with the C routines **isalnum**(3c),\n **isalpha**(3c), **isascii**(3c), **isblank**(3c), **iscntrl**(3c),\n **isdigit**(3c), **isgraph**(3c), **islower**(3c), **isprint**(3c),\n **ispunct**(3c), **isspace**(3c), **isupper**(3c), and **isxdigit**(3c);\n but for a string as well as an array of strings.\n\n### **Options**\n\n- **string**\n : The string to search in for an unmatched character.\n\n- **set**\n : The set of characters that must be matched.\n\n- **back**\n : The direction to look for an unmatched character. The left-most\n unmatched character position is returned unless **back** is present\n and _.false._, which causes the position of the right-most unmatched\n character to be returned instead of the left-most unmatched character.\n\n- **kind**\n : An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\nIf all characters of **string** are found in **set**, the result is zero.\n\nIf **string** is of zero length a zero (0) is always returned.\n\nOtherwise, if an unmatched character is found\nThe position of the first or last (if **back** is _.false._) unmatched\ncharacter in **string** is returned, starting with position one on the\nleft end of the string.\n\n### **Examples**\n\n#### Sample program I:\n```fortran\nprogram demo_verify\nimplicit none\n! some useful character sets\ncharacter,parameter :: &\n & int*(*) = '1234567890', &\n & low*(*) = 'abcdefghijklmnopqrstuvwxyz', &\n & upp*(*) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', &\n & punc*(*) = \"!\"\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~\", &\n & blank*(*) = ' ', &\n & tab = char(11), &\n & prnt*(*) = int//low//upp//blank//punc\n\ncharacter(len=:),allocatable :: string\ninteger :: i\n print *, 'basics:'\n print *, VERIFY ('ABBA', 'A') ! has the value 2.\n print *, VERIFY ('ABBA', 'A', BACK = .TRUE.) ! has the value 3.\n print *, VERIFY ('ABBA', 'AB') ! has the value 0.\n\n print *,'find first non-uppercase letter'\n ! will produce the location of \"d\", because there is no match in UPP\n write(*,*) 'something unmatched',verify(\"ABCdEFG\", upp)\n\n print *,'if everything is matched return zero'\n ! will produce 0 as all letters have a match\n write(*,*) 'everything matched',verify(\"ffoorrttrraann\", \"nartrof\")\n\n print *,'easily categorize strings as uppercase, lowercase, ...'\n ! easy C-like functionality but does entire strings not just characters\n write(*,*)'isdigit 123?',verify(\"123\", int) == 0\n write(*,*)'islower abc?',verify(\"abc\", low) == 0\n write(*,*)'isalpha aBc?',verify(\"aBc\", low//upp) == 0\n write(*,*)'isblank aBc dEf?',verify(\"aBc dEf\", blank//tab ) /= 0\n ! check if all printable characters\n string=\"aB;cde,fgHI!Jklmno PQRSTU vwxyz\"\n write(*,*)'isprint?',verify(string,prnt) == 0\n ! this now has a nonprintable tab character in it\n string(10:10)=char(11)\n write(*,*)'isprint?',verify(string,prnt) == 0\n\n print *,'VERIFY(3) is very powerful using expressions as masks'\n ! verify(3f) is often used in a logical expression\n string=\" This is NOT all UPPERCASE \"\n write(*,*)'all uppercase/spaces?',verify(string, blank//upp) == 0\n string=\" This IS all uppercase \"\n write(*,*) 'string=['//string//']'\n write(*,*)'all uppercase/spaces?',verify(string, blank//upp) == 0\n\n ! set and show complex string to be tested\n string=' Check this out. Let me know '\n ! show the string being examined\n write(*,*) 'string=['//string//']'\n write(*,*) ' '//repeat(int,4) ! number line\n\n ! the Fortran functions returns a position just not a logical like C\n print *, 'returning a position not just a logical is useful'\n ! which can be very useful for parsing strings\n write(*,*)'first non-blank character',verify(string, blank)\n write(*,*)'last non-blank character',verify(string, blank,back=.true.)\n write(*,*)'first non-letter non-blank',verify(string,low//upp//blank)\n\n !VERIFY(3) is elemental so you can check an array of strings in one call\n print *, 'elemental'\n ! are strings all letters (or blanks)?\n write(*,*) 'array of strings',verify( &\n ! strings must all be same length, so force to length 10\n & [character(len=10) :: \"YES\",\"ok\",\"000\",\"good one\",\"Nope!\"], &\n & low//upp//blank) == 0\n\n ! rarer, but the set can be an array, not just the strings to test\n ! you could do ISPRINT() this (harder) way :>\n write(*,*)'isprint?',.not.all(verify(\"aBc\", [(char(i),i=32,126)])==1)\n ! instead of this way\n write(*,*)'isprint?',verify(\"aBc\",prnt) == 0\n\nend program demo_verify\n```\nResults:\n```text\n > basics:\n > 2\n > 3\n > 0\n > find first non-uppercase letter\n > something unmatched 4\n > if everything is matched return zero\n > everything matched 0\n > easily categorize strings as uppercase, lowercase, ...\n > isdigit 123? T\n > islower abc? T\n > isalpha aBc? T\n > isblank aBc dEf? T\n > isprint? T\n > isprint? F\n > VERIFY(3) is very powerful using expressions as masks\n > all uppercase/spaces? F\n > string=[ This IS all uppercase ]\n > all uppercase/spaces? F\n > string=[ Check this out. Let me know ]\n > 1234567890123456789012345678901234567890\n > returning a position not just a logical is useful\n > first non-blank character 3\n > last non-blank character 29\n > first non-letter non-blank 17\n > elemental\n > array of strings T T F T F\n > isprint? T\n > isprint? T\n```\n#### Sample program II:\n\nDetermine if strings are valid integer representations\n\n```fortran\nprogram fortran_ints\nimplicit none\ninteger :: i\ncharacter(len=*),parameter :: ints(*)=[character(len=10) :: &\n '+1 ', &\n '3044848 ', &\n '30.40 ', &\n 'September ', &\n '1 2 3', &\n ' -3000 ', &\n ' ']\n ! show the strings to test\n write(*,'(\"|\",*(g0,\"|\"))') ints\n ! show if strings pass or fail the test done by isint(3f)\n write(*,'(\"|\",*(1x,l1,8x,\"|\"))') isint(ints)\n\ncontains\n\nelemental function isint(line) result (lout)\n!\n! determine if string is a valid integer representation\n! ignoring trailing spaces and leading spaces\n!\ncharacter(len=*),parameter :: digits='0123456789'\ncharacter(len=*),intent(in) :: line\ncharacter(len=:),allocatable :: name\nlogical :: lout\n lout=.false.\n ! make sure at least two characters long to simplify tests\n name=adjustl(line)//' '\n ! blank string\n if( name == '' )return\n ! allow one leading sign\n if( verify(name(1:1),'+-') == 0 ) name=name(2:)\n ! was just a sign\n if( name == '' )return\n lout=verify(trim(name), digits) == 0\nend function isint\n\nend program fortran_ints\n```\nResults:\n```text\n|+1 |3044848 |30.40 |September|1 2 3 | -3000 | |\n| T | T | F | F | F | T | F |\n```\n#### Sample program III:\n\nDetermine if strings represent valid Fortran symbol names\n\n```fortran\nprogram fortran_symbol_name\nimplicit none\ninteger :: i\ncharacter(len=*),parameter :: symbols(*)=[character(len=10) :: &\n 'A_ ', &\n '10 ', &\n 'September ', &\n 'A B', &\n '_A ', &\n ' ']\n\n write(*,'(\"|\",*(g0,\"|\"))') symbols\n write(*,'(\"|\",*(1x,l1,8x,\"|\"))') fortran_name(symbols)\n\ncontains\n\nelemental function fortran_name(line) result (lout)\n!\n! determine if a string is a valid Fortran name\n! ignoring trailing spaces (but not leading spaces)\n!\ncharacter(len=*),parameter :: int='0123456789'\ncharacter(len=*),parameter :: lower='abcdefghijklmnopqrstuvwxyz'\ncharacter(len=*),parameter :: upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ'\ncharacter(len=*),parameter :: allowed=upper//lower//int//'_'\n\ncharacter(len=*),intent(in) :: line\ncharacter(len=:),allocatable :: name\nlogical :: lout\n name=trim(line)\n if(len(name).ne.0)then\n ! first character is alphameric\n lout = verify(name(1:1), lower//upper) == 0 &\n ! other characters are allowed in a symbol name\n & .and. verify(name,allowed) == 0 &\n ! allowable length\n & .and. len(name) <= 63\n else\n lout = .false.\n endif\nend function fortran_name\n\nend program fortran_symbol_name\n```\nResults:\n```text\n |A_ |10 |September |A B |_A | |\n | T | F | T | F | F | F |\n```\n#### Sample program IV:\n\ncheck if string is of form NN-HHHHH\n\n```fortran\nprogram checkform\n! check if string is of form NN-HHHHH\nimplicit none\ncharacter(len=*),parameter :: int='1234567890'\ncharacter(len=*),parameter :: hex='abcdefABCDEF0123456789'\nlogical :: lout\ncharacter(len=80) :: chars\n\n chars='32-af43d'\n lout=.true.\n\n ! are the first two characters integer characters?\n lout = lout.and.(verify(chars(1:2), int) == 0)\n\n ! is the third character a dash?\n lout = lout.and.(verify(chars(3:3), '-') == 0)\n\n ! is remaining string a valid representation of a hex value?\n lout = lout.and.(verify(chars(4:8), hex) == 0)\n\n if(lout)then\n write(*,*)trim(chars),' passed'\n else\n write(*,*)trim(chars),' failed'\n endif\nend program checkform\n```\nResults:\n```text\n 32-af43d passed\n```\n#### Sample program V:\n\nexploring uses of elemental functionality and dusty corners\n\n```fortran\nprogram more_verify\nimplicit none\ncharacter(len=*),parameter :: &\n & int='0123456789', &\n & low='abcdefghijklmnopqrstuvwxyz', &\n & upp='ABCDEFGHIJKLMNOPQRSTUVWXYZ', &\n & blank=' '\n! note character variables in an array have to be of the same length\ncharacter(len=6) :: strings(3)=[\"Go \",\"right \",\"home! \"]\ncharacter(len=2) :: sets(3)=[\"do\",\"re\",\"me\"]\n\n ! elemental -- you can use arrays for both strings and for sets\n\n ! check each string from right to left for non-letter/non-blank\n write(*,*)'last non-letter',verify(strings,upp//low//blank,back=.true.)\n\n ! even BACK can be an array\n ! find last non-uppercase character in \"Howdy \"\n ! and first non-lowercase in \"there \"\n write(*,*) verify(strings(1:2),[upp,low],back=[.true.,.false.])\n\n ! using a null string for a set is not well defined. Avoid it\n write(*,*) 'null',verify(\"for tran \", \"\", .true.) ! 8,length of string?\n ! probably what you expected\n write(*,*) 'blank',verify(\"for tran \", \" \", .true.) ! 7,found 'n'\n\n ! first character in \"Go \" not in \"do\",\n ! and first letter in \"right \" not in \"ri\"\n ! and first letter in \"home! \" not in \"me\"\n write(*,*) verify(strings,sets)\n\nend program more_verify\n```\nResults:\n```text\n > last non-letter 0 0 5\n > 6 6\n > null 9\n > blank 8\n > 1 2 1\n```\n### **Standard**\n\nFortran 95 , with **kind** argument - Fortran 2003\n\n### **See Also**\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n [**scan**(3)](#scan),\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" }