diff --git a/fortls/intrinsic.procedures.markdown.json b/fortls/intrinsic.procedures.markdown.json index 8c2e6cda..863da32e 100644 --- a/fortls/intrinsic.procedures.markdown.json +++ b/fortls/intrinsic.procedures.markdown.json @@ -9,7 +9,7 @@ "AINT": "## aint\n\n### **Name**\n\n**aint** - \\[NUMERIC\\] Truncate toward zero to a whole number\n\n### **Synopsis**\n```fortran\n result = aint(x [,kind])\n```\n```fortran\n elemental real(kind=KIND) function iaint(x,KIND)\n\n real(kind=**),intent(in) :: x\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- a kind designated as ** may be any supported kind for the type\n- the result is a real of the default kind unless **kind** is specified.\n- **kind** is an _integer_ initialization expression indicating the\n kind parameter of the result.\n\n### **Description**\n\n **aint** truncates its argument toward zero to a whole number.\n\n### **Options**\n\n- **x**\n : the _real_ value to truncate.\n\n- **kind**\n : indicates the kind parameter of the result.\n\n### **Result**\n\n The sign is the same as the sign of **x** unless the magnitude of **x**\n is less than one, in which case zero is returned.\n\n Otherwise **aint** returns the largest whole number that does not\n exceed the magnitude of **x** with the same sign as the input.\n\n That is, it truncates the value towards zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_aint\nuse, intrinsic :: iso_fortran_env, only : sp=>real32, dp=>real64\nimplicit none\nreal(kind=dp) :: x8\n print *,'basics:'\n print *,' just chops off the fractional part'\n print *, aint(-2.999), aint(-2.1111)\n print *,' if |x| < 1 a positive zero is returned'\n print *, aint(-0.999), aint( 0.9999)\n print *,' input may be of any real kind'\n x8 = 4.3210_dp\n print *, aint(-x8), aint(x8)\n print *,'elemental:'\n print *,aint([ &\n & -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, &\n & 0.0, &\n & +0.5, +1.0, +1.5, +2.0, +2.2, +2.5, +2.7 ])\nend program demo_aint\n```\nResults:\n```text\n basics:\n just chops off the fractional part\n -2.000000 -2.000000\n if |x| < 1 a positive zero is returned\n 0.0000000E+00 0.0000000E+00\n input may be of any real kind\n -4.00000000000000 4.00000000000000\n elemental:\n -2.000000 -2.000000 -2.000000 -2.000000 -1.000000\n -1.000000 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.000000\n 1.000000 2.000000 2.000000 2.000000 2.000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**nint**(3)](#nint),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ALL": "## all\n\n### **Name**\n\n**all** - \\[ARRAY:REDUCTION\\] Determines if all the values are true\n\n### **Synopsis**\n```fortran\n result = all(mask [,dim])\n```\n```fortran\n function all(mask ,dim)\n\n logical(kind=KIND),intent(in) :: mask(..)\n integer,intent(in),optional :: dim\n logical(kind=KIND) :: all(..)\n```\n### **Characteristics**\n\n - **mask** is a _logical_ array\n - **dim** is an _integer_ \n - the result is a logical array if **dim** is supplied,\n otherwise it is a logical scalar. It has the same characteristics\n as **mask**\n\n### **Description**\n\n **all** determines if all the values are true in **mask** in the\n array along dimension **dim** if **dim** is specified; otherwise all\n elements are tested together.\n\n This testing type is called a logical conjunction of elements of\n **mask** along dimension **dim**.\n\n The mask is generally a _logical_ expression, allowing for comparing\n arrays and many other common operations.\n\n### **Options**\n\n- **mask**\n : the logical array to be tested for all elements being _.true_.\n\n- **dim**\n : **dim** indicates the direction through the elements of **mask**\n to group elements for testing.\n : **dim** has a value that lies between one and the rank of **mask**.\n : The corresponding actual argument shall not be an optional dummy\n argument.\n : If **dim** is not present all elements are tested and a single\n scalar value is returned.\n\n### **Result**\n\n\n1. If **dim** is not present **all(mask)** is _.true._ if all elements\n of **mask** are _.true._. It also is _.true._ if **mask** has zero size;\n otherwise, it is _.false._ .\n\n2. If the rank of **mask** is one, then **all(mask, dim)** is equivalent\n to **all(mask)**. \n\n3. If the rank of **mask** is greater than one and **dim** is present then \n **all(mask,dim)** returns an array with the rank (number of\n dimensions) of **mask** minus 1. The shape is determined from the\n shape of **mask** where the **dim** dimension is elided. A value is\n returned for each set of elements along the **dim** dimension.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_all\nimplicit none\nlogical,parameter :: T=.true., F=.false.\nlogical bool\n ! basic usage\n ! is everything true?\n bool = all([ T,T,T ])\n bool = all([ T,F,T ])\n print *, bool\n\n ! by a dimension\n ARRAYS: block\n integer :: a(2,3), b(2,3)\n ! set everything to one except one value in b\n a = 1\n b = 1\n b(2,2) = 2\n ! now compare those two arrays\n print *,'entire array :', all(a == b )\n print *,'compare columns:', all(a == b, dim=1)\n print *,'compare rows:', all(a == b, dim=2)\n end block ARRAYS\n\nend program demo_all\n```\nResults:\n```text\n > T\n > F\n > entire array : F\n > compare columns: T F T\n > compare rows: T F\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**any**(3)](#any)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ALLOCATED": "## allocated\n\n### **Name**\n\n**allocated** - \\[ARRAY:INQUIRY\\] Allocation status of an allocatable entity\n\n### **Synopsis**\n```fortran\n result = allocated(array|scalar)\n```\n```fortran\n logical function allocated(array,scalar)\n\n type(TYPE(kind=**)),allocatable,optional :: array(..)\n type(TYPE(kind=**)),allocatable,optional :: scalar\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **array** may be any allocatable array object of any type.\n - **scalar** may be any allocatable scalar of any type.\n - the result is a default logical scalar\n\n### **Description**\n\n **allocated** checks the allocation status of both arrays\n and scalars.\n\n At least one and only one of **array** or **scalar** must be specified.\n\n### **Options**\n\n- **entity**\n : the _allocatable_ object to test.\n\n### **Result**\n\n If the argument is allocated then the result is _.true._; otherwise,\n it returns _.false._.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_allocated\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=sp), allocatable :: x(:)\ncharacter(len=256) :: message\ninteger :: istat\n ! basics\n if( allocated(x)) then\n write(*,*)'do things if allocated'\n else\n write(*,*)'do things if not allocated'\n endif\n\n ! if already allocated, deallocate\n if ( allocated(x) ) deallocate(x,STAT=istat, ERRMSG=message )\n if(istat.ne.0)then\n write(*,*)trim(message)\n stop\n endif\n\n ! only if not allocated, allocate\n if ( .not. allocated(x) ) allocate(x(20))\n\n ! allocation and intent(out)\n call intentout(x)\n write(*,*)'note it is deallocated!',allocated(x)\n\n contains\n\n subroutine intentout(arr)\n ! note that if arr has intent(out) and is allocatable,\n ! arr is deallocated on entry\n real(kind=sp),intent(out),allocatable :: arr(:)\n write(*,*)'note it was allocated in calling program',allocated(arr)\n end subroutine intentout\n\nend program demo_allocated\n```\nResults:\n```text\n > do things if not allocated\n > note it was allocated in calling program F\n > note it is deallocated! F\n```\n### **Standard**\n\n Fortran 95. allocatable scalar entities were added in Fortran 2003.\n\n### **See Also**\n\n[**move_alloc**(3)](#move_alloc)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "ANINT": "## anint\n\n### **Name**\n\n**anint** - \\[NUMERIC\\] Real nearest whole number\n\n### **Synopsis**\n```fortran\n result = anint(a [,kind])\n```\n```fortran\n elemental real(kind=KIND) function anint(x,KIND)\n\n real(kind=**),intent(in) :: x\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- **a** is type _real_ of any kind\n- **KIND** is a scalar integer constant expression.\n- the result is type _real_. The kind of the result is the same as **x**\n unless specified by **kind**.\n\n### **Description**\n\n **anint** rounds its argument to the nearest whole number.\n\n Unlike **nint**(3) which returns an _integer_ the full range or real\n values can be returned (_integer_ types typically have a smaller range\n of values than _real_ types).\n\n### **Options**\n\n- **a**\n : the value to round\n\n- **kind**\n : specifies the kind of the result. The default is the kind of **a**.\n\n### **Result**\n\nThe return value is the whole number nearest **a**.\n\nIf **a** is greater than zero, **anint(a)**(3) returns **aint(a + 0.5)**.\n\nIf **a** is less than or equal to zero then it returns **aint(a - 0.5)**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_anint\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal,allocatable :: arr(:)\n\n ! basics\n print *, 'ANINT (2.783) has the value 3.0 =>', anint(2.783)\n print *, 'ANINT (-2.783) has the value -3.0 =>', anint(-2.783)\n\n print *, 'by default the kind of the output is the kind of the input'\n print *, anint(1234567890.1234567890e0)\n print *, anint(1234567890.1234567890d0)\n\n print *, 'sometimes specifying the result kind is useful when passing'\n print *, 'results as an argument, for example.'\n print *, 'do you know why the results are different?'\n print *, anint(1234567890.1234567890,kind=real64)\n print *, anint(1234567890.1234567890d0,kind=real64)\n\n ! elemental\n print *, 'numbers on a cusp are always the most troublesome'\n print *, anint([ -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, 0.0 ])\n\n arr=[ 0.0, 0.5, 1.0, 1.5, 2.0, 2.2, 2.5, 2.7 ]\n print *, anint(arr)\n\nend program demo_anint\n```\nResults:\n```text\n ANINT (2.783) has the value 3.0 => 3.000000\n ANINT (-2.783) has the value -3.0 => -3.000000\n by default the kind of the output is the kind of the input\n 1.2345679E+09\n 1234567890.00000\n sometimes specifying the result kind is useful when passing\n results as an argument, for example.\n do you know why the results are different?\n 1234567936.00000\n 1234567890.00000\n numbers on a cusp are always the most troublesome\n -3.000000 -3.000000 -2.000000 -2.000000 -2.000000\n -1.000000 -1.000000 0.0000000E+00\n 0.0000000E+00 1.000000 1.000000 2.000000 2.000000\n 2.000000 3.000000 3.000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**int**(3)](#int),\n[**nint**(3)](#nint),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "ANINT": "## anint\n\n### **Name**\n\n**anint** - \\[NUMERIC\\] Real nearest whole number\n\n### **Synopsis**\n```fortran\n result = anint(a [,kind])\n```\n```fortran\n elemental real(kind=KIND) function anint(x,KIND)\n\n real(kind=**),intent(in) :: x\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- **a** is type _real_ of any kind\n- **KIND** is a scalar integer constant expression.\n- the result is type _real_. The kind of the result is the same as **x**\n unless specified by **kind**.\n\n### **Description**\n\n **anint** rounds its argument to the nearest whole number.\n\n Unlike **nint**(3) which returns an _integer_ the full range or real\n values can be returned (_integer_ types typically have a smaller range\n of values than _real_ types).\n\n### **Options**\n\n- **a**\n : the value to round\n\n- **kind**\n : specifies the kind of the result. The default is the kind of **a**.\n\n### **Result**\n\nThe return value is the real whole number nearest **a**.\n\nIf **a** is greater than zero, **anint(a)**(3) returns **aint(a + 0.5)**.\n\nIf **a** is less than or equal to zero then it returns **aint(a - 0.5)**,\nexcept **aint** specifies that for |**a**| < 1 the result is zero (0).\n\nIt is processor-dependent whether anint(a) returns negative zero when\n-0.5 < a <= -0.0. Compiler switches are often available which enable\nor disable support of negative zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_anint\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal,allocatable :: arr(:)\n\n ! basics\n print *, 'ANINT (2.783) has the value 3.0 =>', anint(2.783)\n print *, 'ANINT (-2.783) has the value -3.0 =>', anint(-2.783)\n\n print *, 'by default the kind of the output is the kind of the input'\n print *, anint(1234567890.1234567890e0)\n print *, anint(1234567890.1234567890d0)\n\n print *, 'sometimes specifying the result kind is useful when passing'\n print *, 'results as an argument, for example.'\n print *, 'do you know why the results are different?'\n print *, anint(1234567890.1234567890,kind=real64)\n print *, anint(1234567890.1234567890d0,kind=real64)\n\n ! elemental\n print *, 'numbers on a cusp are always the most troublesome'\n print *, anint([ -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, 0.0 ])\n\n print *, 'negative zero is processor dependent'\n arr=[ 0.0, 0.1, 0.5, 1.0, 1.5, 2.0, 2.2, 2.5, 2.7 ]\n print *, anint(arr)\n arr=[ -0.0, -0.1, -0.5, -1.0, -1.5, -2.0, -2.2, -2.5, -2.7 ]\n print *, anint(arr)\n\nend program demo_anint\n```\nResults:\n```text\n > ANINT (2.783) has the value 3.0 => 3.000000 \n > ANINT (-2.783) has the value -3.0 => -3.000000 \n > by default the kind of the output is the kind of the input\n > 1.2345679E+09\n > 1234567890.00000 \n > sometimes specifying the result kind is useful when passing\n > results as an argument, for example.\n > do you know why the results are different?\n > 1234567936.00000 \n > 1234567890.00000 \n > numbers on a cusp are always the most troublesome\n > -3.000000 -3.000000 -2.000000 -2.000000 -2.000000 \n > -1.000000 -1.000000 0.0000000E+00\n > negative zero is processor dependent\n > 0.0000000E+00 0.0000000E+00 1.000000 1.000000 2.000000 \n > 2.000000 2.000000 3.000000 3.000000 \n > 0.0000000E+00 0.0000000E+00 -1.000000 -1.000000 -2.000000 \n > -2.000000 -2.000000 -3.000000 -3.000000 \n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**int**(3)](#int),\n[**nint**(3)](#nint),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "ANY": "## any\n\n### **Name**\n\n**any** - \\[ARRAY:REDUCTION\\] Determines if any of the values in the logical array are _.true._\n\n### **Synopsis**\n```fortran\n result = any(mask [,dim])\n```\n```fortran\n function any(mask, dim)\n\n logical(kind=KIND),intent(in) :: mask(..)\n integer,intent(in),optional :: dim\n logical(kind=KIND) :: any(..)\n```\n### **Characteristics**\n\n- **mask** is a _logical_ array\n- **dim** is a scalar integer\n- the result is a logical array if **dim** is supplied,\n otherwise it is a logical scalar.\n\n### **Description**\n\n **any** determines if any of the values in the logical\n array **mask** along dimension **dim** are _.true._.\n\n### **Options**\n\n- **mask**\n : an array of _logical_ expressions or values to be tested in groups\n or in total for a _.true._ value.\n\n- **dim**\n : a whole number value that lies between one and **rank(mask)** that\n indicates to return an array of values along the indicated dimension\n instead of a scalar answer.\n\n### **Result**\n\n**any(mask)** returns a scalar value of type _logical_ where the kind type\nparameter is the same as the kind type parameter of **mask**. If **dim**\nis present, then **any(mask, dim)** returns an array with the rank of\n**mask** minus 1. The shape is determined from the shape of **mask**\nwhere the **dim** dimension is elided.\n\n1. **any(mask)** is _.true._ if any element of **mask** is _.true._;\n otherwise, it is _.false._. It also is _.false._ if **mask** has\n zero size.\n\n2. If the rank of **mask** is one, then **any(mask, dim)** is\n equivalent to **any(mask)**. If the rank is greater than one, then\n **any(mask, dim)** is determined by applying **any(mask)** to the\n array sections.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_any\nimplicit none\nlogical,parameter :: T=.true., F=.false.\ninteger :: a(2,3), b(2,3)\nlogical :: bool\n ! basic usage\n bool = any([F,F,T,F])\n print *,bool\n bool = any([F,F,F,F])\n print *,bool\n ! fill two integer arrays with values for testing\n a = 1\n b = 1\n b(:,2) = 2\n b(:,3) = 3\n ! using any(3) with logical expressions you can compare two arrays\n ! in a myriad of ways\n ! first, print where elements of b are bigger than in a\n call printl( 'first print b > a ', b > a )\n ! now use any() to test\n call printl( 'any true values? any(b > a) ', any(b > a ) )\n call printl( 'again by columns? any(b > a,1)', any(b > a, 1) )\n call printl( 'again by rows? any(b > a,2)', any(b > a, 2) )\ncontains\n! CONVENIENCE ROUTINE. this is not specific to ANY()\nsubroutine printl(title,a)\nuse, intrinsic :: iso_fortran_env, only : &\n & stderr=>ERROR_UNIT,&\n & stdin=>INPUT_UNIT,&\n & stdout=>OUTPUT_UNIT\nimplicit none\n\n!@(#) print small 2d logical scalar, vector, or matrix\n\ncharacter(len=*),parameter :: all='(*(g0,1x))'\ncharacter(len=*),parameter :: row='(\" > [ \",*(l1:,\",\"))'\ncharacter(len=*),intent(in) :: title\nlogical,intent(in) :: a(..)\ninteger :: i\n write(*,*)\n write(*,all,advance='no')trim(title),&\n & ' : shape=',shape(a),',rank=',rank(a),',size=',size(a)\n ! get size and shape of input\n select rank(a)\n rank (0); write(*,'(a)')'(a scalar)'\n write(*,fmt=row,advance='no')a\n write(*,'(\" ]\")')\n rank (1); write(*,'(a)')'(a vector)'\n do i=1,size(a)\n write(*,fmt=row,advance='no')a(i)\n write(*,'(\" ]\")')\n enddo\n rank (2); write(*,'(a)')'(a matrix) '\n do i=1,size(a,dim=1)\n write(*,fmt=row,advance='no')a(i,:)\n write(*,'(\" ]\")')\n enddo\n rank default\n write(stderr,*)'*printl* did not expect rank=', rank(a), &\n & 'shape=', shape(a),'size=',size(a)\n stop '*printl* unexpected rank'\n end select\n\nend subroutine printl\n\nend program demo_any\n```\nResults:\n```text\n > T\n > F\n >\n > first print b > a : shape=23,rank=2,size=6(a matrix)\n > > [ F,T,T ]\n > > [ F,T,T ]\n >\n > any true values? any(b > a) : shape=,rank=0,size=1(a scalar)\n > > [ T ]\n >\n > again by columns? any(b > a,1) : shape=3,rank=1,size=3(a vector)\n > > [ F ]\n > > [ T ]\n > > [ T ]\n >\n > again by rows? any(b > a,2) : shape=2,rank=1,size=2(a vector)\n > > [ T ]\n > > [ T ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**all**(3)](#all)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ASIN": "## asin\n\n### **Name**\n\n**asin** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arcsine function\n\n### **Synopsis**\n```fortran\n result = asin(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function asin(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**asin** computes the arcsine of its argument **x**.\n\nThe arcsine is the inverse function of the sine function. It is commonly\nused in trigonometry when trying to find the angle when the lengths of\nthe hypotenuse and the opposite side of a right triangle are known.\n\n### **Options**\n\n- **x**\n : The value to compute the arcsine of\n : The type shall be either _real_ and a magnitude that is less than or\n equal to one; or be _complex_.\n\n### **Result**\n\n- **result**\n The result has a value equal to a processor-dependent approximation\n to arcsin(x).\n\n If **x** is real the result is _real_ and it is expressed in radians\n and lies in the range\n```fortran\n PI/2 <= ASIN (X) <= PI/2.\n```\n If the argument (and therefore the result) is imaginary the real part\n of the result is in radians and lies in the range\n```fortran\n -PI/2 <= real(asin(x)) <= PI/2\n```\n### **Examples**\n\nThe arcsine will allow you to find the measure of a right angle when you\nknow the ratio of the side opposite the angle to the hypotenuse.\n\nSo if you knew that a train track rose 1.25 vertical miles on a track\nthat was 50 miles long, you could determine the average angle of incline\nof the track using the arcsine. Given\n\n sin(theta) = 1.25 miles/50 miles (opposite/hypotenuse)\n\nSample program:\n```fortran\nprogram demo_asin\nuse, intrinsic :: iso_fortran_env, only : dp=>real64\nimplicit none\n! value to convert degrees to radians\nreal(kind=dp),parameter :: D2R=acos(-1.0_dp)/180.0_dp\nreal(kind=dp) :: angle, rise, run\ncharacter(len=*),parameter :: all='(*(g0,1x))'\n ! given sine(theta) = 1.25 miles/50 miles (opposite/hypotenuse)\n ! then taking the arcsine of both sides of the equality yields\n ! theta = arcsine(1.25 miles/50 miles) ie. arcsine(opposite/hypotenuse)\n rise=1.250_dp\n run=50.00_dp\n angle = asin(rise/run)\n print all, 'angle of incline(radians) = ', angle\n angle = angle/D2R\n print all, 'angle of incline(degrees) = ', angle\n\n print all, 'percent grade=',rise/run*100.0_dp\nend program demo_asin\n```\nResults:\n```\n angle of incline(radians) = 2.5002604899361139E-002\n angle of incline(degrees) = 1.4325437375665075\n percent grade= 2.5000000000000000\n```\nThe percentage grade is the slope, written as a percent. To calculate\nthe slope you divide the rise by the run. In the example the rise is\n1.25 mile over a run of 50 miles so the slope is 1.25/50 = 0.025.\nWritten as a percent this is 2.5 %.\n\nFor the US, two and 1/2 percent is generally thought of as the upper\nlimit. This means a rise of 2.5 feet when going 100 feet forward. In\nthe US this was the maximum grade on the first major US railroad, the\nBaltimore and Ohio. Note curves increase the frictional drag on a\ntrain reducing the allowable grade.\n\n### **Standard**\n\nFORTRAN 77 , for a _complex_ argument Fortran 2008\n\n### **See Also**\n\nInverse function: [**sin**(3)](#sin)\n\n### **Resources**\n\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ASINH": "## asinh\n\n### **Name**\n\n**asinh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Inverse hyperbolic sine function\n\n### **Synopsis**\n```fortran\n result = asinh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function asinh(x)\n\n TYPE(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_ or _complex_ type\n - **KIND** may be any kind supported by the associated type\n - The returned value will be of the same type and kind as the argument **x**\n\n### **Description**\n\n**asinh** computes the inverse hyperbolic sine of **x**.\n\n### **Options**\n\n- **x**\n : The value to compute the inverse hyperbolic sine of\n\n### **Result**\n\n The result has a value equal to a processor-dependent approximation\n to the inverse hyperbolic sine function of **x**.\n\n If **x** is _complex_, the imaginary part of the result is in radians and lies\nbetween **-PI/2 \\<= aimag(asinh(x)) \\<= PI/2**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_asinh\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=dp), dimension(3) :: x = [ -1.0d0, 0.0d0, 1.0d0 ]\n\n ! elemental\n write (*,*) asinh(x)\n\nend program demo_asinh\n```\nResults:\n```text\n -0.88137358701954305 0.0000000000000000 0.88137358701954305\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nInverse function: [**sinh**(3)](#sinh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -104,7 +104,7 @@ "IMAGE_INDEX": "## image_index\n\n### **Name**\n\n**image_index** - \\[COLLECTIVE\\] Cosubscript to image index conversion\n\n### **Synopsis**\n```fortran\n result = image_index(coarray, sub)\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**image_index** returns the image index belonging to a cosubscript.\n\n### **Options**\n\n- **coarray**\n : Coarray of any type.\n\n- **sub**\n : default integer rank-1 array of a size equal to the corank of\n **coarray**.\n\n### **Result**\n\nScalar default integer with the value of the image index which\ncorresponds to the cosubscripts. For invalid cosubscripts the result is\nzero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo image_index\nimplicit none\ninteger :: array[2,-1:4,8,*]\n ! Writes 28 (or 0 if there are fewer than 28 images)\n write (*,*) image_index(array, [2,0,3,1])\nend demo image_index\n```\n\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**this_image**(3)](#this_image),\n[**num_images**(3)](#num_images)\n\n _fortran-lang intrinsic descriptions_\n", "INDEX": "## index\n\n### **Name**\n\n**index** - \\[CHARACTER:SEARCH\\] Position of a substring within a string\n\n### **Synopsis**\n```fortran\nresult = index( string, substring [,back] [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function index(string,substring,back,kind)\n\n character(len=*,kind=KIND),intent(in) :: string\n character(len=*,kind=KIND),intent(in) :: substring\n logical(kind=**),intent(in),optional :: back\n integer(kind=**),intent(in),optional :: kind\n```\n### **Characteristics**\n\n- **string** is a _character_ variable of any kind\n- **substring** is a _character_ variable of the same kind as **string**\n- **back** is a _logical_ variable of any supported kind\n- **KIND** is a scalar integer constant expression.\n\n### **Description**\n\n **index** returns the position of the start of the leftmost\n or rightmost occurrence of string **substring** in **string**,\n counting from one. If **substring** is not present in **string**,\n zero is returned.\n\n### **Options**\n\n- **string**\n : string to be searched for a match\n\n- **substring**\n : string to attempt to locate in **string**\n\n- **back**\n : If the **back** argument is present and true, the return value is the\n start of the rightmost occurrence rather than the leftmost.\n\n- **kind**\n : if **kind** is present, the kind type parameter is that specified by the value of\n **kind**; otherwise the kind type parameter is that of default integer type.\n \n\n### **Result**\n\n The result is the starting position of the first substring\n **substring** found in **string**.\n\n If the length of **substring** is longer than **string** the result\n is zero.\n\n If the substring is not found the result is zero.\n\n If **back** is _.true._ the greatest starting position is returned\n (that is, the position of the right-most match). Otherwise,\n the smallest position starting a match (ie. the left-most match)\n is returned.\n\n The position returned is measured from the left with the first\n character of **string** being position one.\n\n Otherwise, if no match is found zero is returned.\n\n### **Examples**\n\nExample program\n```fortran\nprogram demo_index\nimplicit none\ncharacter(len=*),parameter :: str=&\n 'Search this string for this expression'\n !1234567890123456789012345678901234567890\n write(*,*)&\n index(str,'this').eq.8, &\n ! return value is counted from the left end even if BACK=.TRUE.\n index(str,'this',back=.true.).eq.24, &\n ! INDEX is case-sensitive\n index(str,'This').eq.0\nend program demo_index\n```\nExpected Results:\n\n```text\n T T T\n```\n### **Standard**\n\nFORTRAN 77 , with KIND argument Fortran 2003\n\n### **See Also**\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl), [**adjustr**(3)](#adjustr), [**index**](#index),\n [**scan**(3)](#scan), [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat), [**trim**(3)](#trim)\n\n _fortran-lang intrinsic descriptions_\n", "INT": "## int\n\n### **Name**\n\n**int** - \\[TYPE:NUMERIC\\] Truncate towards zero and convert to integer\n\n### **Synopsis**\n```fortran\n result = int(a [,kind])\n```\n```fortran\n elemental integer(kind=KIND) function int(a, KIND )\n\n TYPE(kind=**),intent(in) :: a\n integer,optional :: KIND\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **a** shall be of type integer, real, or complex, or a boz-literal-constant.\n - **KIND** shall be a scalar integer constant expression.\n\n### **Description**\n\n **int** truncates towards zero and return an _integer_.\n\n### **Options**\n\n - **a**\n : is the value to truncate towards zero\n\n - **kind**\n : indicates the kind parameter of the result.\n If not present the returned type is that of default integer type.\n\n### **Result**\n\nreturns an _integer_ variable applying the following rules:\n\n**Case**:\n\n1. If **a** is of type _integer_, **int**(a) = a\n\n2. If **a** is of type _real_ and **|a| \\< 1, int(a)** equals **0**. If **|a| \\>=\n 1**, then **int(a)** equals the integer whose magnitude does not exceed\n **a** and whose sign is the same as the sign of **a**.\n\n3. If **a** is of type _complex_, rule 2 is applied to the _real_ part of **a**.\n\n4. If _a_ is a boz-literal constant, it is treated as an _integer_\n with the _kind_ specified.\n\n The interpretation of a bit sequence whose most significant bit is\n **1** is processor dependent.\n\nThe result is undefined if it cannot be represented in the specified integer type.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_int\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i = 42\ncomplex :: z = (-3.7, 1.0)\nreal :: x=-10.5, y=10.5\n\n print *, int(x), int(y)\n\n print *, int(i)\n\n print *, int(z), int(z,8)\n ! elemental\n print *, int([-10.9,-10.5,-10.3,10.3,10.5,10.9])\n ! note int(3) truncates towards zero\n\n ! CAUTION:\n ! a number bigger than a default integer can represent\n ! produces an incorrect result and is not required to\n ! be detected by the program.\n x=real(huge(0))+1000.0\n print *, int(x),x\n ! using a larger kind\n print *, int(x,kind=int64),x\n\n print *, int(&\n & B\"111111111111111111111111111111111111111111111111111111111111111\",&\n & kind=int64)\n print *, int(O\"777777777777777777777\",kind=int64)\n print *, int(Z\"7FFFFFFFFFFFFFFF\",kind=int64)\n\n ! elemental\n print *\n print *,int([ &\n & -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, &\n & 0.0, &\n & +0.5, +1.0, +1.5, +2.0, +2.2, +2.5, +2.7 ])\n\nend program demo_int\n```\n\nResults:\n\n```text\n > -10 10\n > 42\n > -3 -3\n > -10 -10 -10 10 10 10\n > -2147483648 2.14748467E+09\n > 2147484672 2.14748467E+09\n > 9223372036854775807\n > 9223372036854775807\n > 9223372036854775807\n >\n > -2 -2 -2 -2 -1\n > -1 0 0 0 1\n > 1 2 2 2 2\n```\n\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**nint**(3)](#nint),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "IOR": "## ior\n\n### **Name**\n\n**ior** - \\[BIT:LOGICAL\\] Bitwise logical inclusive OR\n\n### **Synopsis**\n```fortran\n result = ior(i, j)\n```\n```fortran\n elemental integer(kind=KIND) function ior(i,j)\n\n integer(kind=KIND ,intent(in) :: i\n integer(kind=KIND ,intent(in) :: j\n```\n### **Characteristics**\n\n- **i**, **j** and the result shall have the same _integer_ type and kind,\n with the exception that one of **i** or **j** may be a BOZ constant.\n\n### **Description**\n\n**ior** returns the bit-wise Boolean inclusive-or of **i** and **j**.\n\n### **Options**\n\n- **i**\n : one of the pair of values to compare the bits of\n\n- **j**\n : one of the pair of values to compare the bits of\n\nIf either **i** or **j** is a BOZ-literal-constant, it is first converted\nas if by the intrinsic function **int**(3) to type _integer_ with the\nkind type parameter of the other.\n\n### **Result**\n\n The result has the value obtained by combining I and J\n bit-by-bit according to the following table:\n```text\n I J IOR (I, J)\n 1 1 1\n 1 0 1\n 0 1 1\n 0 0 0\n```\n This is commonly called the \"bitwise logical inclusive OR\" of the two values.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ior\nimplicit none\ninteger :: i, j, k\n i=53 ! i=00110101 binary (lowest order byte)\n j=45 ! j=00101101 binary (lowest order byte)\n k=ior(i,j) ! k=00111101 binary (lowest order byte), k=61 decimal\n write(*,'(i8,1x,b8.8)')i,i,j,j,k,k\nend program demo_ior\n```\nResults:\n```\n 53 00110101\n 45 00101101\n 61 00111101\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ieor**(3)](#ieor),\n[**ibclr**(3)](#ibclr),\n[**not**(3)](#not),\n[**btest**(3)](#btest),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**iand**(3)](#iand),\n[**ieor**(3)](#ieor),\n[**mvbits**(3)](#mvbits)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "IOR": "## ior\n\n### **Name**\n\n**ior** - \\[BIT:LOGICAL\\] Bitwise logical inclusive OR\n\n### **Synopsis**\n```fortran\n result = ior(i, j)\n```\n```fortran\n elemental integer(kind=KIND) function ior(i,j)\n\n integer(kind=KIND ,intent(in) :: i\n integer(kind=KIND ,intent(in) :: j\n```\n### **Characteristics**\n\n- **i**, **j** and the result shall have the same _integer_ type and kind,\n with the exception that one of **i** or **j** may be a BOZ constant.\n\n### **Description**\n\n**ior** returns the bit-wise Boolean inclusive-or of **i** and **j**.\n\n### **Options**\n\n- **i**\n : one of the pair of values to compare the bits of\n\n- **j**\n : one of the pair of values to compare the bits of\n\nIf either **i** or **j** is a BOZ-literal-constant, it is first converted\nas if by the intrinsic function **int**(3) to type _integer_ with the\nkind type parameter of the other.\n\n### **Result**\n\n The result has the value obtained by combining I and J\n bit-by-bit according to the following table:\n```text\n I J IOR (I, J)\n 1 1 1\n 1 0 1\n 0 1 1\n 0 0 0\n```\n Where if the bit is set in either input value, it is set in the\n result. Otherwise the result bit is zero.\n\n This is commonly called the \"bitwise logical inclusive OR\" of the two values.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ior\nimplicit none\ninteger :: i, j, k\n i=53 ! i=00110101 binary (lowest order byte)\n j=45 ! j=00101101 binary (lowest order byte)\n k=ior(i,j) ! k=00111101 binary (lowest order byte), k=61 decimal\n write(*,'(i8,1x,b8.8)')i,i,j,j,k,k\nend program demo_ior\n```\nResults:\n```\n 53 00110101\n 45 00101101\n 61 00111101\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ieor**(3)](#ieor),\n[**ibclr**(3)](#ibclr),\n[**not**(3)](#not),\n[**btest**(3)](#btest),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**iand**(3)](#iand),\n[**ieor**(3)](#ieor),\n[**mvbits**(3)](#mvbits)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IPARITY": "## iparity\n\n### **Name**\n\n**iparity** - \\[BIT:LOGICAL\\] Bitwise exclusive OR of array elements\n\n### **Synopsis**\n```fortran\n result = iparity( array [,mask] ) | iparity( array, dim [,mask] )\n```\n```fortran\n integer(kind=KIND) function iparity(array, dim, mask )\n\n integer(kind=KIND),intent(in) :: array(..)\n logical(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n - **array** - An _integer_ array.\n - **dim** - an _integer_ scalar from 1 to the rank of **array**\n - **mask** - _logical_ conformable with **array**.\n\n### **Description**\n\n**iparity** reduces with bitwise _xor_ (exclusive _or_) the elements\nof **array** along dimension **dim** if the corresponding element in\n**mask** is _.true._.\n\n### **Options**\n\n- **array**\n : an array of _integer_ values\n\n- **dim** a value from 1 to the rank of **array**.\n\n- **mask**\n : a _logical_ mask either a scalar or an array of the same shape\n as **array**.\n\n### **Result**\n\nThe result is of the same type as **array**.\n\nIf **dim** is absent, a scalar with the bitwise _xor_ of all elements in **array**\nis returned. Otherwise, an array of rank **n-1**, where **n** equals the\nrank of **array**, and a shape similar to that of **array** with dimension **dim**\ndropped is returned.\n\n Case (i): The result of IPARITY (ARRAY) has a value equal to the\n bitwise exclusive OR of all the elements of ARRAY. If\n ARRAY has size zero the result has the value zero.\n\n Case (ii): The result of IPARITY (ARRAY, MASK=MASK) has a value\n equal to that of\n```fortran\n IPARITY (PACK (ARRAY, MASK)).\n```\n Case (iii): The result of IPARITY (ARRAY, DIM=DIM [, MASK=MASK])\n has a value equal to that of IPARITY (ARRAY [, MASK=MASK])\n if ARRAY has rank one.\n\n Otherwise, an array of values reduced along the dimension\n **dim** is returned.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_iparity\nimplicit none\ninteger, dimension(2) :: a\n a(1) = int(b'00100100')\n a(2) = int(b'01101010')\n print '(b8.8)', iparity(a)\nend program demo_iparity\n```\nResults:\n```\n 01001110\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**iany**(3)](#iany),\n[**iall**(3)](#iall),\n[**ieor**(3)](#ieor),\n[**parity**(3)](#parity)\n\n _fortran-lang intrinsic descriptions_\n", "ISHFT": "## ishft\n\n### **Name**\n\n**ishft** - \\[BIT:SHIFT\\] Logical shift of bits in an integer\n\n### **Synopsis**\n```fortran\n result = ishftc( i, shift )\n```\n```fortran\n elemental integer(kind=KIND) function ishft(i, shift )\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **i** is an _integer_ of any kind. the kind for **i** dictates the kind of the returned value.\n - **shift** is an _integer_ of any kind.\n\n### **Description**\n\n **ishft** returns a value corresponding to **i** with all of the\n bits shifted **shift** places left or right as specified by the sign\n and magnitude of **shift**.\n\n Bits shifted out from the left end or right end are lost; zeros are\n shifted in from the opposite end.\n\n### **Options**\n\n- **i**\n : The value specifying the pattern of bits to shift\n\n- **shift**\n : A value of **shift** greater than zero corresponds to a left shift,\n a value of zero corresponds to no shift, and a value less than zero\n corresponds to a right shift.\n\n If the absolute value of **shift** is\n greater than **bit_size(i)**, the value is undefined.\n\n\n### **Result**\n\n The result has the value obtained by shifting the bits of **i** by **shift** positions.\n\n 1. If **shift** is positive, the shift is to the left\n 2. if **shift** is negative, the shift is to the right\n 3. if **shift** is zero, no shift is performed.\n\n Bits shifted out from the left or from the right, as appropriate,\n are lost. Zeros are shifted in from the opposite end.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ishft\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: shift\ncharacter(len=*),parameter :: g='(b32.32,1x,i0)'\n\n write(*,*) ishft(3, 1),' <== typically should have the value 6'\n\n shift=4\n write(*,g) ishft(huge(0),shift), shift\n shift=0\n write(*,g) ishft(huge(0),shift), shift\n shift=-4\n write(*,g) ishft(huge(0),shift), shift\nend program demo_ishft\n```\nResults:\n```text\n> 6 <== typically should have the value 6\n> 11111111111111111111111111110000 4\n> 01111111111111111111111111111111 0\n> 00000111111111111111111111111111 -4\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ishftc**(3)](#ishftc)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ISHFTC": "## ishftc\n\n### **Name**\n\n**ishftc** - \\[BIT:SHIFT\\] Shift rightmost bits circularly, AKA. a logical shift\n\n### **Synopsis**\n```fortran\n result = ishftc( i, shift [,size] )\n```\n```fortran\n elemental integer(kind=KIND) function ishftc(i, shift, size)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: shift\n integer(kind=**),intent(in),optional :: size\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **i** may be an _integer_ of any kind\n - **shift** and **size** may be _integers_ of any kind\n - the kind for **i** dictates the kind of the returned value.\n\n### **Description**\n\n **ishftc** circularly shifts just the specified rightmost bits of\n an integer.\n\n **ishftc** returns a value corresponding to **i** with the rightmost\n **size** bits shifted circularly **shift** places; that is, bits\n shifted out one end of the section are shifted into the opposite end\n of the section.\n\n A value of **shift** greater than zero corresponds to a left shift,\n a value of zero corresponds to no shift, and a value less than zero\n corresponds to a right shift.\n\n### **Options**\n\n- **i**\n : The value specifying the pattern of bits to shift\n\n- **shift**\n : If **shift** is positive, the shift is to the left; if **shift**\n is negative, the shift is to the right; and if **shift** is zero,\n no shift is performed.\n\n The absolute value of **shift** must be less than **size** (simply\n put, the number of positions to shift must be less than or equal to\n the number of bits specified to be shifted).\n\n- **size**\n : The value must be greater than zero and less than or equal to\n **bit_size**(i).\n\n The default if **bit_size(i)** is absent is to circularly shift the\n entire value **i**.\n\n### **Result**\n\n The result characteristics (kind, shape, size, rank, ...) are the\n same as **i**.\n\n The result has the value obtained by shifting the **size** rightmost\n bits of **i** circularly by **shift** positions.\n\n No bits are lost.\n\n The unshifted bits are unaltered.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ishftc\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i\ncharacter(len=*),parameter :: g='(b32.32,1x,i0)'\n ! basics\n write(*,*) ishftc(3, 1),' <== typically should have the value 6'\n\n print *, 'lets start with this:'\n write(*,'(b32.32)')huge(0)\n print *, 'shift the value by various amounts, negative and positive'\n do i= -bit_size(0), bit_size(0), 8\n write(*,g) ishftc(huge(0),i), i\n enddo\n print *,'elemental'\n i=huge(0)\n write(*,*)ishftc(i,[2,3,4,5])\n write(*,*)ishftc([2**1,2**3,-2**7],3)\n print *,'note the arrays have to conform when elemental'\n write(*,*)ishftc([2**1,2**3,-2**7],[5,20,0])\n\nend program demo_ishftc\n```\nResults:\n```text\n > 6 <== typically should have the value 6\n > lets start with this:\n > 01111111111111111111111111111111\n > shift the value by various amounts, negative and positive\n > 01111111111111111111111111111111 -32\n > 11111111111111111111111101111111 -24\n > 11111111111111110111111111111111 -16\n > 11111111011111111111111111111111 -8\n > 01111111111111111111111111111111 0\n > 11111111111111111111111101111111 8\n > 11111111111111110111111111111111 16\n > 11111111011111111111111111111111 24\n > 01111111111111111111111111111111 32\n > elemental\n > -3 -5 -9 -17\n > 16 64 -1017\n > note the arrays have to conform when elemental\n > 64 8388608 -128\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n- [**ishft**(3)](#ishft) - Logical shift of bits in an integer\n- [**shifta**(3)](#shifta) - Right shift with fill\n- [**shiftl**(3)](#shiftl) - Shift bits left\n- [**shiftr**(3)](#shiftr) - Combined right shift of the bits of two int...\n- [**dshiftl**(3)](#dshiftl) - Combined left shift of the bits of two inte...\n- [**dshiftr**(3)](#dshiftr) - Combined right shift of the bits of two int...\n- [**cshift**(3)](#cshift) - Circular shift elements of an array\n- [**eoshift**(3)](#eoshift) - End-off shift elements of an array\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -168,7 +168,7 @@ "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", - "SCAN": "## scan\n\n### **Name**\n\n**scan** - \\[CHARACTER:SEARCH\\] Scan a string for the presence of a set of characters\n\n### **Synopsis**\n```fortran\n result = scan( string, set, [,back] [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function scan(string,set,back,kind)\n\n character(len=*,kind=**),intent(in) :: string\n character(len=*,kind=**),intent(in) :: set\n logical,intent(in),optional :: back\n integer,intent(in),optional :: kind\n```\n### **Characteristics**\n\n - **string** is a _character_ string of any kind\n - **set** must be a _character_ string with the same kind as **string**\n - **back** is a _logical_ \n - **kind** is a scalar _integer_ constant expression\n - the result is an _integer_ with the kind specified by **kind**. If\n **kind** is not present the result is a default _integer_.\n\n### **Description**\n\n **scan** scans a **string** for any of the characters in a **set**\n of characters.\n\n If **back** is either absent or equals _.false._, this function\n returns the position of the leftmost character of **STRING** that is\n in **set**. If **back** equals _.true._, the rightmost position is\n returned. If no character of **set** is found in **string**, the result\n is zero.\n\n### **Options**\n\n- **string**\n : the string to be scanned\n\n- **set**\n : the set of characters which will be matched\n\n- **back**\n : if _.true._ the position of the rightmost character matched is\n returned, instead of the leftmost.\n\n- **kind**\n : the kind of the returned value is the same as **kind** if\n present. Otherwise a default _integer_ kind is returned.\n\n### **Result**\n\n If **back** is absent or is present with the value false and if\n **string** contains at least one character that is in **set**, the value\n of the result is the position of the leftmost character of **string**\n that is in **set**.\n\n If **back** is present with the value true and if **string** contains at\n least one character that is in **set**, the value of the result is the\n position of the rightmost character of **string** that is in **set**.\n\n The value of the result is zero if no character of STRING is in SET\n or if the length of STRING or SET is zero.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_scan\nimplicit none\n write(*,*) scan(\"fortran\", \"ao\") ! 2, found 'o'\n write(*,*) scan(\"fortran\", \"ao\", .true.) ! 6, found 'a'\n write(*,*) scan(\"fortran\", \"c++\") ! 0, found none\nend program demo_scan\n```\nResults:\n```text\n > 2\n > 6\n > 0\n```\n### **Standard**\n\nFortran 95 , with KIND argument - Fortran 2003\n\n### **See Also**\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl), [**adjustr**(3)](#adjustr), [**index**(3)](#index),\n [**scan**](#scan), [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat), [**trim**(3)](#trim)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "SCAN": "## scan\n\n### **Name**\n\n**scan** - \\[CHARACTER:SEARCH\\] Scan a string for the presence of a set of characters\n\n### **Synopsis**\n```fortran\n result = scan( string, set, [,back] [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function scan(string,set,back,kind)\n\n character(len=*,kind=**),intent(in) :: string\n character(len=*,kind=**),intent(in) :: set\n logical,intent(in),optional :: back\n integer,intent(in),optional :: kind\n```\n### **Characteristics**\n\n - **string** is a _character_ string of any kind\n - **set** must be a _character_ string with the same kind as **string**\n - **back** is a _logical_ \n - **kind** is a scalar _integer_ constant expression\n - the result is an _integer_ with the kind specified by **kind**. If\n **kind** is not present the result is a default _integer_.\n\n### **Description**\n\n **scan** scans a **string** for any of the characters in a **set**\n of characters.\n\n If **back** is either absent or equals _.false._, this function\n returns the position of the leftmost character of **STRING** that is\n in **set**. If **back** equals _.true._, the rightmost position is\n returned. If no character of **set** is found in **string**, the result\n is zero.\n\n### **Options**\n\n- **string**\n : the string to be scanned\n\n- **set**\n : the set of characters which will be matched\n\n- **back**\n : if _.true._ the position of the rightmost character matched is\n returned, instead of the leftmost.\n\n- **kind**\n : the kind of the returned value is the same as **kind** if\n present. Otherwise a default _integer_ kind is returned.\n\n### **Result**\n\n If **back** is absent or is present with the value false and if\n **string** contains at least one character that is in **set**, the value\n of the result is the position of the leftmost character of **string**\n that is in **set**.\n\n If **back** is present with the value true and if **string** contains at\n least one character that is in **set**, the value of the result is the\n position of the rightmost character of **string** that is in **set**.\n\n The value of the result is zero if no character of STRING is in SET\n or if the length of STRING or SET is zero.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_scan\nimplicit none\n write(*,*) scan(\"fortran\", \"ao\") ! 2, found 'o'\n write(*,*) scan(\"fortran\", \"ao\", .true.) ! 6, found 'a'\n write(*,*) scan(\"fortran\", \"c++\") ! 0, found none\nend program demo_scan\n```\nResults:\n```text\n > 2\n > 6\n > 0\n```\n### **Standard**\n\nFortran 95 , with KIND argument - Fortran 2003\n\n### **See Also**\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl), [**adjustr**(3)](#adjustr), [**index**(3)](#index),\n [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len\\_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat), [**trim**(3)](#trim)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SELECTED_CHAR_KIND": "## selected_char_kind\n\n### **Name**\n\n**selected_char_kind** - \\[KIND\\] Select character kind such as \"Unicode\"\n\n### **Synopsis**\n```fortran\n result = selected_char_kind(name)\n```\n```fortran\n integer function selected_char_kind(name)\n\n character(len=*),intent(in) :: name\n```\n### **Characteristics**\n\n - **name** is a default _character_ scalar\n - the result is a default _integer_ scalar\n\n### **Description**\n\n **selected_char_kind** returns a kind parameter value for the\n character set named **name**.\n\n If a name is not supported, -1 is returned. Otherwise the result is a\n value equal to that kind type parameter value.\n\n The list of supported names is processor-dependent except for \"DEFAULT\".\n\n + If **name** has the value \"DEFAULT\", then the result has a value equal to\n that of the kind type parameter of default character. This name is\n always supported.\n\n + If **name** has the value \"ASCII\", then the result has a value equal\n to that of the kind type parameter of ASCII character.\n\n + If **name** has the value \"ISO_10646\", then the result has a value equal\n to that of the kind type parameter of the ISO 10646 character kind\n (corresponding to UCS-4 as specified in ISO/IEC 10646).\n\n + If **name** is a processor-defined name of some other character kind\n supported by the processor, then the result has a value equal to that\n kind type parameter value.\n Pre-defined names include \"ASCII\" and \"ISO_10646\".\n\n The NAME is interpreted without respect to case or trailing blanks.\n\n### **Options**\n\n- **name**\n : A name to query the processor-dependent kind value of, and/or to determine\n if supported. **name**, interpreted without respect to case or\n trailing blanks.\n\n Currently, supported character sets include \"ASCII\" and \"DEFAULT\" and\n \"ISO_10646\" (Universal Character Set, UCS-4) which is commonly known as\n \"Unicode\". Supported names other than \"DEFAULT\" are processor dependent.\n\n### **Result**\n\n\n### **Examples**\n\nSample program:\n\n```fortran\nLinux\nprogram demo_selected_char_kind\nuse iso_fortran_env\nimplicit none\n\nintrinsic date_and_time,selected_char_kind\n\n! set some aliases for common character kinds\n! as the numbers can vary from platform to platform\n\ninteger, parameter :: default = selected_char_kind (\"default\")\ninteger, parameter :: ascii = selected_char_kind (\"ascii\")\ninteger, parameter :: ucs4 = selected_char_kind ('ISO_10646')\ninteger, parameter :: utf8 = selected_char_kind ('utf-8')\n\n! assuming ASCII and UCS4 are supported (ie. not equal to -1)\n! define some string variables\ncharacter(len=26, kind=ascii ) :: alphabet\ncharacter(len=30, kind=ucs4 ) :: hello_world\ncharacter(len=30, kind=ucs4 ) :: string\n\n write(*,*)'ASCII ',&\n & merge('Supported ','Not Supported',ascii /= -1)\n write(*,*)'ISO_10646 ',&\n & merge('Supported ','Not Supported',ucs4 /= -1)\n write(*,*)'UTF-8 ',&\n & merge('Supported ','Not Supported',utf8 /= -1)\n\n if(default.eq.ascii)then\n write(*,*)'ASCII is the default on this processor'\n endif\n\n ! for constants the kind precedes the value, somewhat like a\n ! BOZ constant\n alphabet = ascii_\"abcdefghijklmnopqrstuvwxyz\"\n write (*,*) alphabet\n\n hello_world = ucs4_'Hello World and Ni Hao -- ' &\n // char (int (z'4F60'), ucs4) &\n // char (int (z'597D'), ucs4)\n\n ! an encoding option is required on OPEN for non-default I/O\n if(ucs4 /= -1 )then\n open (output_unit, encoding='UTF-8')\n write (*,*) trim (hello_world)\n else\n write (*,*) 'cannot use utf-8'\n endif\n\n call create_date_string(string)\n write (*,*) trim (string)\n\ncontains\n\n! The following produces a Japanese date stamp.\nsubroutine create_date_string(string)\nintrinsic date_and_time,selected_char_kind\ninteger,parameter :: ucs4 = selected_char_kind(\"ISO_10646\")\ncharacter(len=1,kind=ucs4),parameter :: &\n nen = char(int( z'5e74' ),ucs4), & ! year\n gatsu = char(int( z'6708' ),ucs4), & ! month\n nichi = char(int( z'65e5' ),ucs4) ! day\ncharacter(len= *, kind= ucs4) string\ninteger values(8)\n call date_and_time(values=values)\n write(string,101) values(1),nen,values(2),gatsu,values(3),nichi\n 101 format(*(i0,a))\nend subroutine create_date_string\n\nend program demo_selected_char_kind\n```\nResults:\n\nThe results are very processor-dependent\n```text\n > ASCII Supported\n > ISO_10646 Supported\n > UTF-8 Not Supported\n > ASCII is the default on this processor\n > abcdefghijklmnopqrstuvwxyz\n > Hello World and Ni Hao -- \u4f60\u597d\n > 2022\u5e7410\u670815\u65e5\n```\n### **Standard**\n\nFortran 2003\n\n### **See also**\n\n[**selected_int_kind**(3)](#selected_int_kind),\n[**selected_real_kind**(3)](#selected_real_kind)\n\n[**achar**(3)](#achar),\n[**char**(3)](#char),\n[**ichar**(3)](#ichar),\n[**iachar**(3)](#iachar)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SELECTED_INT_KIND": "## selected_int_kind\n\n### **Name**\n\n**selected_int_kind** - \\[KIND\\] Choose integer kind\n\n### **Synopsis**\n```fortran\n result = selected_int_kind(r)\n```\n```fortran\n integer function selected_int_kind(r)\n\n integer(kind=KIND),intent(in) :: r\n```\n### **Characteristics**\n\n - **r** is an _integer_ scalar.\n - the result is an default integer scalar.\n\n### **Description**\n\n **selected_int_kind** return the kind value of the smallest\n integer type that can represent all values ranging from **-10\\*\\*r**\n (exclusive) to **10\\*\\*r** (exclusive). If there is no integer kind\n that accommodates this range, selected_int_kind returns **-1**.\n\n### **Options**\n\n- **r**\n : The value specifies the required range of powers of ten that need\n supported by the kind type being returned.\n\n### **Result**\n\n The result has a value equal to the value of the kind type parameter\n of an integer type that represents all values in the requested range.\n\n if no such kind type parameter is available on the processor, the\n result is -1.\n\n If more than one kind type parameter meets the criterion, the value\n returned is the one with the smallest decimal exponent range, unless\n there are several such values, in which case the smallest of these\n kind values is returned.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_selected_int_kind\nimplicit none\ninteger,parameter :: k5 = selected_int_kind(5)\ninteger,parameter :: k15 = selected_int_kind(15)\ninteger(kind=k5) :: i5\ninteger(kind=k15) :: i15\n\n print *, huge(i5), huge(i15)\n\n ! the following inequalities are always true\n print *, huge(i5) >= 10_k5**5-1\n print *, huge(i15) >= 10_k15**15-1\nend program demo_selected_int_kind\n```\nResults:\n```text\n > 2147483647 9223372036854775807\n > T\n > T\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**nint**(3)](#nint),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SELECTED_REAL_KIND": "## selected_real_kind\n\n### **Name**\n\n**selected_real_kind** - \\[KIND\\] Choose real kind\n\n### **Synopsis**\n```fortran\n result = selected_real_kind([p] [,r] [,radix] )\n```\n```fortran\n integer function selected_int_kind(r)\n\n real(kind=KIND),intent(in),optional :: p\n real(kind=KIND),intent(in),optional :: r\n real(kind=KIND),intent(in),optional :: radix\n```\n### **Characteristics**\n\n - **p** is an _integer_ scalar\n - **r** is an _integer_ scalar\n - **radix** is an _integer_ scalar\n - the result is an default _integer_ scalar\n \n### **Description**\n\n **selected_real_kind** return the kind value of a _real_ data type with\n decimal precision of at least **p** digits, exponent range of at least\n **r**, and with a radix of **radix**. That is, if such a kind exists \n\n + it has the decimal precision as returned by **precision**(3) of at\n least **p** digits.\n + a decimal exponent range, as returned by the function **range**(3)\n of at least **r**\n + a radix, as returned by the function **radix**(3) , of **radix**, \n\n If the requested kind does not exist, -1 is returned.\n\n At least one argument shall be present.\n\n### **Options**\n\n- **p**\n : the requested precision\n\n- **r**\n : the requested range\n\n- **radix**\n : the desired radix\n\n Before **Fortran 2008**, at least one of the arguments **r** or **p** shall\n be present; since **Fortran 2008**, they are assumed to be zero if\n absent.\n\n### **Result**\n\n selected_real_kind returns the value of the kind type parameter of\n a real data type with decimal precision of at least **p** digits,\n a decimal exponent range of at least R, and with the requested\n **radix**. \n\n If **p** or **r** is absent, the result value is the same as if it\n were present with the value zero.\n\n\n If the **radix** parameter is absent, there is no requirement on\n the radix of the selected kind and real kinds with any radix can be\n returned. \n\n If more than one real data type meet the criteria, the kind\n of the data type with the smallest decimal precision is returned. If\n no real data type matches the criteria, the result is\n\n - **-1**\n : if the processor does not support a real data type with a\n precision greater than or equal to **p**, but the **r** and **radix**\n requirements can be fulfilled\n\n - **-2**\n : if the processor does not support a real type with an\n exponent range greater than or equal to **r**, but **p** and **radix** are\n fulfillable\n\n - **-3**\n : if **radix** but not **p** and **r** requirements are fulfillable\n\n - **-4**\n : if **radix** and either **p** or **r** requirements are fulfillable\n\n - **-5**\n : if there is no real type with the given **radix**\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_selected_real_kind\nimplicit none\ninteger,parameter :: p6 = selected_real_kind(6)\ninteger,parameter :: p10r100 = selected_real_kind(10,100)\ninteger,parameter :: r400 = selected_real_kind(r=400)\nreal(kind=p6) :: x\nreal(kind=p10r100) :: y\nreal(kind=r400) :: z\n\n print *, precision(x), range(x)\n print *, precision(y), range(y)\n print *, precision(z), range(z)\nend program demo_selected_real_kind\n```\nResults:\n```text\n > 6 37\n > 15 307\n > 18 4931\n```\n### **Standard**\n\nFortran 95 ; with RADIX - Fortran 2008\n\n### **See Also**\n\n[**precision**(3)](#precision),\n[**range**(3)](#range),\n[**radix**(3)](#radix)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -197,5 +197,5 @@ "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)](#co_ubound),\n[**co\\_lbound**(3)](co_lbound)\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", "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", - "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 [**verify**](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat),\n [**trim**(3)](#trim)\n\n _fortran-lang intrinsic descriptions (license: MIT) \\@urbanjost_\n" + "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" }