diff --git a/fortls/parsers/internal/intrinsic.procedures.markdown.json b/fortls/parsers/internal/intrinsic.procedures.markdown.json index 3c75f091..f27dc90e 100644 --- a/fortls/parsers/internal/intrinsic.procedures.markdown.json +++ b/fortls/parsers/internal/intrinsic.procedures.markdown.json @@ -97,8 +97,8 @@ "GAMMA": "## gamma\n\n### **Name**\n\n**gamma** - \\[MATHEMATICS\\] Gamma function, which yields factorials for positive whole numbers\n\n### **Synopsis**\n```fortran\n result = gamma(x)\n```\n```fortran\n elemental real(kind=**) function gamma( x)\n\n type(real,kind=**),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is a _real_ value of any available KIND\n - returns a _real_ value with the same kind as **x**.\n\n### **Description**\n\n **gamma(x)** computes Gamma of **x**. For positive whole number values of **n** the\n Gamma function can be used to calculate factorials, as **(n-1)! == gamma(real(n))**.\n That is\n```text\nn! == gamma(real(n+1))\n```\n$$\n\\\\__Gamma__(x) = \\\\int\\_0\\*\\*\\\\infty\nt\\*\\*{x-1}{\\\\mathrm{e}}\\*\\*{__-t__}\\\\,{\\\\mathrm{d}}t\n$$\n\n### **Options**\n\n- **x**\n : Shall be of type _real_ and neither zero nor a negative integer.\n\n### **Result**\n\n The return value is of type _real_ of the same kind as _x_. The result\n has a value equal to a processor-dependent approximation to the gamma\n function of **x**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_gamma\nuse, intrinsic :: iso_fortran_env, only : wp=>real64, int64\nimplicit none\nreal :: x, xa(4)\ninteger :: i, j\n\n ! basic usage\n x = gamma(1.0)\n write(*,*)'gamma(1.0)=',x\n\n ! elemental\n xa=gamma([1.0,2.0,3.0,4.0])\n write(*,*)xa\n write(*,*)\n\n\n ! gamma() is related to the factorial function\n do i = 1, 171\n ! check value is not too big for default integer type\n if (factorial(i) <= huge(0)) then\n write(*,*) i, nint(factorial(i)), 'integer'\n elseif (factorial(i) <= huge(0_int64)) then\n write(*,*) i, nint(factorial(i),kind=int64),'integer(kind=int64)'\n else\n write(*,*) i, factorial(i) , 'user factorial function'\n write(*,*) i, product([(real(j, kind=wp), j=1, i)]), 'product'\n write(*,*) i, gamma(real(i + 1, kind=wp)), 'gamma directly'\n endif\n enddo\n\n\ncontains\nfunction factorial(i) result(f)\n! GAMMA(X) computes Gamma of X. For positive whole number values of N the\n! Gamma function can be used to calculate factorials, as (N-1)! ==\n! GAMMA(REAL(N)). That is\n!\n! n! == gamma(real(n+1))\n!\ninteger, intent(in) :: i\nreal(kind=wp) :: f\n if (i <= 0) then\n write(*,'(*(g0))') ' gamma(3) function value ', i, ' <= 0'\n stop ' bad value in gamma function'\n endif\n f = anint(gamma(real(i + 1,kind=wp)))\nend function factorial\n\nend program demo_gamma\n```\nResults:\n```text\n > gamma(1.0)= 1.00000000\n > 1.00000000 1.00000000 2.00000000 6.00000000\n >\n > 1 1 integer\n > 2 2 integer\n > 3 6 integer\n > 4 24 integer\n > 5 120 integer\n > 6 720 integer\n > 7 5040 integer\n > 8 40320 integer\n > 9 362880 integer\n > 10 3628800 integer\n > 11 39916800 integer\n > 12 479001600 integer\n > 13 6227020800 integer(kind=int64)\n > 14 87178291200 integer(kind=int64)\n > 15 1307674368000 integer(kind=int64)\n > 16 20922789888000 integer(kind=int64)\n > 17 355687428096000 integer(kind=int64)\n > 18 6402373705728001 integer(kind=int64)\n > 19 121645100408832000 integer(kind=int64)\n > 20 2432902008176640000 integer(kind=int64)\n > 21 5.1090942171709440E+019 user factorial function\n > 21 5.1090942171709440E+019 product\n > 21 5.1090942171709440E+019 gamma directly\n > :\n > :\n > :\n > 170 7.2574156153079990E+306 user factorial function\n > 170 7.2574156153079940E+306 product\n > 170 7.2574156153079990E+306 gamma directly\n > 171 Infinity user factorial function\n > 171 Infinity product\n > 171 Infinity gamma directly\n```\n\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nLogarithm of the Gamma function: [**log_gamma**(3)](#log_gamma)\n\n### **Resources**\n\n[Wikipedia: Gamma_function](https://en.wikipedia.org/wiki/Gamma_function)\n\n _Fortran intrinsic descriptions_\n", "GET_COMMAND": "## get_command\n\n### **Name**\n\n**get_command** - \\[SYSTEM:COMMAND LINE\\] Get the entire command line invocation\n\n### **Synopsis**\n```fortran\n call get_command([command] [,length] [,status] [,errmsg])\n```\n```fortran\n subroutine get_command( command ,length ,status, errmsg )\n\n character(len=*),intent(out),optional :: command\n integer(kind=**),intent(out),optional :: length\n integer(kind=**),intent(out),optional :: status\n character(len=*),intent(inout),optional :: errmsg\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n meeting the conditions described herein.\n - **command** and **errmsg** are scalar _character_ variables of default kind.\n - **length** and **status** are scalar _integer_ with a decimal exponent\n range of at least four.\n\n### **Description**\n\n**get_command** retrieves the entire command line that was used to\ninvoke the program.\n\nNote that what is typed on the command line is often processed by\na shell. The shell typically processes special characters and white\nspace before passing it to the program. The processing can typically be\nturned off by turning off globbing or quoting the command line arguments\nand/or changing the default field separators, but this should rarely\nbe necessary.\n\n### **Result**\n\n- **command**\n : If **command** is present, the entire command line that was used\n to invoke the program is stored into it. If the command cannot be\n determined, **command** is assigned all blanks.\n\n- **length**\n : If **length** is present, it is assigned the length of the command line.\n It is system-dependent as to whether trailing blanks will be counted.\n : If the command length cannot be determined, a length of 0 is assigned.\n\n- **status**\n : If **status** is present, it is assigned 0 upon success of the\n command, **-1** if **command** is too short to store the command line,\n or a positive value in case of an error.\n\n- **errmsg**\n : It is assigned a processor-dependent explanatory message if the\n command retrieval fails. Otherwise, it is unchanged.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_get_command\nimplicit none\ninteger :: command_line_length\ncharacter(len=:),allocatable :: command_line\n ! get command line length\n call get_command(length=command_line_length)\n ! allocate string big enough to hold command line\n allocate(character(len=command_line_length) :: command_line)\n ! get command line as a string\n call get_command(command=command_line)\n ! trim leading spaces just in case\n command_line=adjustl(command_line)\n write(*,'(\"OUTPUT:\",a)')command_line\nend program demo_get_command\n```\nResults:\n```bash\n # note that shell expansion removes some of the whitespace\n # without quotes\n ./test_get_command arguments on command line to echo\n\n OUTPUT:./test_get_command arguments on command line to echo\n\n # using the bash shell with single quotes\n ./test_get_command 'arguments *><`~[]!{}?\"\\'| '\n\n OUTPUT:./test_get_command arguments *><`~[]!{}?\"'|\n```\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**get_command_argument**(3)](#get_command_argument),\n[**command_argument_count**(3)](#command_argument_count)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n#\n", "GET_COMMAND_ARGUMENT": "## get_command_argument\n\n### **Name**\n\n**get_command_argument** - \\[SYSTEM:COMMAND LINE\\] Get command line arguments\n\n### **Synopsis**\n```fortran\n call get_command_argument(number [,value] [,length] &\n & [,status] [,errmsg])\n```\n```fortran\n subroutine get_command_argument( number, value, length, &\n & status ,errmsg)\n\n integer(kind=**),intent(in) :: number\n character(len=*),intent(out),optional :: value\n integer(kind=**),intent(out),optional :: length\n integer(kind=**),intent(out),optional :: status\n character(len=*),intent(inout),optional :: errmsg\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n meeting the conditions described herein.\n - **number**, **length**, and **status** are scalar _integer_\n with a decimal exponent range of at least four.\n - **value** and **errmsg** are scalar _character_ variables of default\n kind.\n\n### **Description**\n\n**get_command_argument** retrieves or queries the n-th argument that\nwas passed on the command line to the current program execution.\n\nThere is not anything specifically stated about what an argument is but\nin practice the arguments are strings split on whitespace unless the\narguments are quoted. IFS values (Internal Field Separators) used by\ncommon shells are typically ignored and unquoted whitespace is almost\nalways the separator.\n\nShells have often expanded command arguments and spell characters before\npassing them to the program, so the strings read are often not exactly\nwhat the user typed on the command line.\n\n### **Options**\n\n- **number**\n : is a non-negative number indicating which argument of the current\n program command line is to be retrieved or queried.\n : If **number = 0**, the argument pointed to is set to the name of the\n program (on systems that support this feature).\n : if the processor does not have such a concept as a command name the\n value of command argument 0 is processor dependent.\n : For values from 1 to the number of arguments passed to the program a\n value is returned in an order determined by the processor. Conventionally\n they are returned consecutively as they appear on the command line from\n left to right.\n\n### **Result**\n\n- **value**\n : The **value** argument holds the command line argument.\n If **value** can not hold the argument, it is truncated to fit the\n length of **value**.\n : If there are less than **number** arguments specified at the command\n line or if the argument specified does not exist for other reasons,\n **value** will be filled with blanks.\n\n- **length**\n : The **length** argument contains the length of the n-th command\n line argument. The length of **value** has no effect on this value,\n It is the length required to hold all the significant characters of\n the argument regardless of how much storage is provided by **value**.\n\n- **status**\n : If the argument retrieval fails, **status** is a positive number;\n if **value** contains a truncated command line argument, **status**\n is **-1**; and otherwise the **status** is zero.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_get_command_argument\nimplicit none\ncharacter(len=255) :: progname\ninteger :: count, i, argument_length, istat\ncharacter(len=:),allocatable :: arg\n\n ! command name assuming it is less than 255 characters in length\n call get_command_argument (0, progname, status=istat)\n if (istat == 0) then\n print *, \"The program's name is \" // trim (progname)\n else\n print *, \"Could not get the program's name \" // trim (progname)\n endif\n\n ! get number of arguments\n count = command_argument_count()\n write(*,*)'The number of arguments is ',count\n\n !\n ! allocate string array big enough to hold command line\n ! argument strings and related information\n !\n do i=1,count\n call get_command_argument(number=i,length=argument_length)\n if(allocated(arg))deallocate(arg)\n allocate(character(len=argument_length) :: arg)\n call get_command_argument(i, arg,status=istat)\n ! show the results\n write (*,'(i3.3,1x,i0.5,1x,i0.5,1x,\"[\",a,\"]\")') &\n & i,istat,argument_length,arg\n enddo\n\nend program demo_get_command_argument\n```\nResults:\n```text\n./demo_get_command_argument a test 'of getting arguments ' \" leading\"\n```\n```text\n The program's name is ./demo_get_command_argument\n The number of arguments is 4\n001 00000 00001 [a]\n002 00000 00004 [test]\n003 00000 00022 [of getting arguments ]\n004 00000 00008 [ leading]\n```\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**get_command**(3)](#get_command),\n[**command_argument_count**(3)](#command_argument_count)\n\n_Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n#\n", - "GET_ENVIRONMENT_VARIABLE": "## get_environment_variable\n\n### **Name**\n\n**get_environment_variable** - \\[SYSTEM:ENVIRONMENT\\] Get value of an environment variable\n\n### **Synopsis**\n```fortran\n call get_environment_variable(name [,value] [,length] &\n & [,status] [,trim_name] [,errmsg] )\n```\n```fortran\n subroutine character(len=*) get_environment_variable( &\n & name, value, length, status, trim_name, errmsg )\n\n character(len=*),intent(in) :: name\n character(len=*),intent(out),optional :: value\n integer(kind=**),intent(out),optional :: length\n integer(kind=**),intent(out),optional :: status\n logical,intent(out),optional :: trim_name\n character(len=*),intent(inout),optional :: errmsg\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n meeting the conditions described herein.\n - **name**, **value**, and **errmsg** are a scalar _character_ of\n default kind.\n - **length** and **status** are _integer_ scalars with a decimal exponent\n range of at least four.\n - **trim_name** is a scalar of type _logical_ and of default kind.\n\n### **Description**\n\n**get_environment_variable** gets the **value** of the environment\nvariable **name**.\n\nNote that **get_environment_variable** need not be thread-safe. It\nis the responsibility of the user to ensure that the environment is not\nbeing updated concurrently.\n\nIf running in parallel be aware\nIt is processor dependent whether an environment variable that exists\non an image also exists on another image, and if it does exist on both\nimages whether the values are the same or different.\n\n### **Options**\n\n- **name**\n : The name of the environment variable to query.\n The interpretation of case is processor dependent.\n\n### **Result**\n\n- **value**\n : The value of the environment variable being queried. If **value**\n is not large enough to hold the data, it is truncated. If the variable\n **name** is not set or has no value, or the processor does not support\n environment variables **value** will be filled with blanks.\n\n- **length**\n : Argument **length** contains the length needed for storing the\n environment variable **name**. It is zero if the environment variable\n is not set.\n\n- **status**\n : **status** is **-1** if **value** is present but too short for the\n environment variable; it is **1** if the environment variable does\n not exist and **2** if the processor does not support environment\n variables; in all other cases **status** is zero.\n\n- **trim_name**\n : If **trim_name** is present with the value _.false._, the trailing\n blanks in **name** are significant; otherwise they are not part of\n the environment variable name.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_getenv\nimplicit none\ncharacter(len=:),allocatable :: homedir\ncharacter(len=:),allocatable :: var\n\n var='HOME'\n homedir=get_env(var)\n write (*,'(a,\"=\"\"\",a,\"\"\"\")')var,homedir\n\ncontains\n\nfunction get_env(name,default) result(value)\n! a function that makes calling get_environment_variable(3) simple\nimplicit none\ncharacter(len=*),intent(in) :: name\ncharacter(len=*),intent(in),optional :: default\ncharacter(len=:),allocatable :: value\ninteger :: howbig\ninteger :: stat\ninteger :: length\n length=0\n value=''\n if(name.ne.'')then\n call get_environment_variable( name, &\n & length=howbig,status=stat,trim_name=.true.)\n select case (stat)\n case (1)\n print *, name, \" is not defined in the environment. Strange...\"\n value=''\n case (2)\n print *, &\n \"This processor does not support environment variables. Boooh!\"\n value=''\n case default\n ! make string of sufficient size to hold value\n if(allocated(value))deallocate(value)\n allocate(character(len=max(howbig,1)) :: value)\n ! get value\n call get_environment_variable( &\n & name,value,status=stat,trim_name=.true.)\n if(stat.ne.0)value=''\n end select\n endif\n if(value.eq.''.and.present(default))value=default\nend function get_env\n\nend program demo_getenv\n```\nTypical Results:\n```text\n HOME=\"/home/urbanjs\"\n```\n### **Standard**\n\nFortran 2003\n\n### **See also**\n\n[**get_command_argument**(3)](#get_command_argument),\n[**get_command**(3)](#get_command)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n#\n", - "HUGE": "## huge\n\n### **Name**\n\n**huge** - \\[NUMERIC MODEL\\] Largest number of a type and kind\n\n### **Synopsis**\n```fortran\n result = huge(x)\n```\n```fortran\n TYPE(kind=KIND) function huge(x)\n\n TYPE(kind=KIND),intent(in) :: x(..)\n```\n### **Characteristics**\n\n - **x** may be any _real_ or _integer_ scalar or array and any kind.\n - The result will be a scalar of the same type and kind as the input **x**\n\n### **Description**\n\n **huge** returns the largest number that is not an overflow\n for the kind and type of **x**.\n\n### **Options**\n\n- **x**\n : **x** is an arbitrary value which is used merely to determine what\n _kind_ and _type_ of scalar is being queried. It need not be defined,\n as only its characteristics are used.\n\n### **Result**\n\n The result is the largest value supported by the specified type\n and kind.\n\n Note the result is as the same kind as the input to ensure the returned\n value does not overflow. Any assignment of the result to a variable\n should take this into consideration.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_huge\nimplicit none\ncharacter(len=*),parameter :: f='(i2,1x,2(i11,1x),f14.0:,1x,l1,1x,a)'\ninteger :: i,j,k,biggest\nreal :: v, w\ndoubleprecision :: tally\n ! basic\n print *, huge(0), huge(0.0), huge(0.0d0)\n print *, tiny(0.0), tiny(0.0d0)\n\n tally=0.0d0\n ! note subtracting one because counter is the end value+1 on exit\n do i=0,huge(0)-1\n tally=tally+i\n enddo\n write(*,*)'tally=',tally\n\n ! advanced\n biggest=huge(0)\n ! be careful of overflow when using integers in computation\n do i=1,14\n j=6**i ! Danger, Danger\n w=6**i ! Danger, Danger\n v=6.0**i\n k=v ! Danger, Danger\n\n if(v.gt.biggest)then\n write(*,f) i, j, k, v, v.eq.w, 'wrong j and k and w'\n else\n write(*,f) i, j, k, v, v.eq.w\n endif\n\n enddo\nend program demo_huge\n```\nResults:\n```\n 2147483647 3.4028235E+38 1.797693134862316E+308\n 1.1754944E-38 2.225073858507201E-308\n\n 1 6 6 6. T\n 2 36 36 36. T\n 3 216 216 216. T\n 4 1296 1296 1296. T\n 5 7776 7776 7776. T\n 6 46656 46656 46656. T\n 7 279936 279936 279936. T\n 8 1679616 1679616 1679616. T\n 9 10077696 10077696 10077696. T\n 10 60466176 60466176 60466176. T\n 11 362797056 362797056 362797056. T\n 12 -2118184960 -2147483648 2176782336. F wrong for j and k and w\n 13 175792128 -2147483648 13060694016. F wrong for j and k and w\n 14 1054752768 -2147483648 78364164096. F wrong for j and k and w\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "GET_ENVIRONMENT_VARIABLE": "## get_environment_variable\n\n### **Name**\n\n**get_environment_variable** - \\[SYSTEM:ENVIRONMENT\\] Get value of an environment variable\n\n### **Synopsis**\n```fortran\n call get_environment_variable(name [,value] [,length] &\n & [,status] [,trim_name] [,errmsg] )\n```\n```fortran\n subroutine character(len=*) get_environment_variable( &\n & name, value, length, status, trim_name, errmsg )\n\n character(len=*),intent(in) :: name\n character(len=*),intent(out),optional :: value\n integer(kind=**),intent(out),optional :: length\n integer(kind=**),intent(out),optional :: status\n logical,intent(out),optional :: trim_name\n character(len=*),intent(inout),optional :: errmsg\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n meeting the conditions described herein.\n - **name**, **value**, and **errmsg** are a scalar _character_ of\n default kind.\n - **length** and **status** are _integer_ scalars with a decimal exponent\n range of at least four.\n - **trim_name** is a scalar of type _logical_ and of default kind.\n\n### **Description**\n\n**get_environment_variable** gets the **value** of the environment\nvariable **name**.\n\nNote that **get_environment_variable** need not be thread-safe. It\nis the responsibility of the user to ensure that the environment is not\nbeing updated concurrently.\n\nIf running in parallel be aware It is processor dependent whether an\nenvironment variable that exists on an image also exists on another\nimage, and if it does exist on both images whether the values are the\nsame or different.\n\n### **Options**\n\n- **name**\n : The name of the environment variable to query.\n The interpretation of case is processor dependent.\n\n### **Result**\n\n- **value**\n : The value of the environment variable being queried. If **value**\n is not large enough to hold the data, it is truncated. If the variable\n **name** is not set or has no value, or the processor does not support\n environment variables **value** will be filled with blanks.\n\n- **length**\n : Argument **length** contains the length needed for storing the\n environment variable **name**. It is zero if the environment variable\n is not set.\n\n- **status**\n : **status** is **-1** if **value** is present but too short for the\n environment variable; it is **1** if the environment variable does\n not exist and **2** if the processor does not support environment\n variables; in all other cases **status** is zero.\n\n- **trim_name**\n : If **trim_name** is present with the value _.false._, the trailing\n blanks in **name** are significant; otherwise they are not part of\n the environment variable name.\n\n- **errmsg**\n : is assigned a processor-dependent explanatory message if the optional\n argument **status** is, or would be if present, assigned a positive\n value. Otherwise, it is unchanged.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_getenv\nimplicit none\ncharacter(len=:),allocatable :: homedir\ncharacter(len=:),allocatable :: var\n\n var='HOME'\n homedir=get_env(var)\n write (*,'(a,\"=\"\"\",a,\"\"\"\")')var,homedir\n\ncontains\n\nfunction get_env(name,default) result(value)\n! a function that makes calling get_environment_variable(3) simple\nimplicit none\ncharacter(len=*),intent(in) :: name\ncharacter(len=*),intent(in),optional :: default\ncharacter(len=:),allocatable :: value\ninteger :: howbig\ninteger :: stat\ninteger :: length\n length=0\n value=''\n if(name.ne.'')then\n call get_environment_variable( name, &\n & length=howbig,status=stat,trim_name=.true.)\n select case (stat)\n case (1)\n print *, name, \" is not defined in the environment. Strange...\"\n value=''\n case (2)\n print *, &\n \"This processor does not support environment variables. Boooh!\"\n value=''\n case default\n ! make string of sufficient size to hold value\n if(allocated(value))deallocate(value)\n allocate(character(len=max(howbig,1)) :: value)\n ! get value\n call get_environment_variable( &\n & name,value,status=stat,trim_name=.true.)\n if(stat.ne.0)value=''\n end select\n endif\n if(value.eq.''.and.present(default))value=default\nend function get_env\n\nend program demo_getenv\n```\nTypical Results:\n```text\n HOME=\"/home/urbanjs\"\n```\n### **Standard**\n\nFortran 2003\n\n### **See also**\n\n[**get_command_argument**(3)](#get_command_argument),\n[**get_command**(3)](#get_command)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n#\n", + "HUGE": "## huge\n\n### **Name**\n\n**huge** - \\[NUMERIC MODEL\\] Largest number of a type and kind\n\n### **Synopsis**\n```fortran\n result = huge(x)\n```\n```fortran\n TYPE(kind=KIND) function huge(x)\n\n TYPE(kind=KIND),intent(in) :: x(..)\n```\n### **Characteristics**\n\n - **x** may be any _real_ or _integer_ scalar or array and any kind.\n - The result will be a scalar of the same type and kind as the input **x**\n\n### **Description**\n\n **huge** returns the largest number that is not an overflow\n for the kind and type of **x**.\n\n### **Options**\n\n- **x**\n : **x** is an arbitrary value which is used merely to determine what\n _kind_ and _type_ of scalar is being queried. It need not be defined,\n as only its characteristics are used.\n\n### **Result**\n\n The result is the largest value supported by the specified type\n and kind.\n\n Note the result is as the same kind as the input to ensure the returned\n value does not overflow. Any assignment of the result to a variable\n requires the variable must be able to hold the value as well. For\n example:\n```fortran\n real :: r\n r=huge(0.0d0)\n```\n where R is single-precision would almost certainly result in overflow. \n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_huge\nimplicit none\ncharacter(len=*),parameter :: f='(i2,1x,2(i11,1x),f14.0:,1x,l1,1x,a)'\ninteger :: i, j, k, biggest\nreal :: v, w\ndoubleprecision :: tally\n ! basic\n print *, huge(0), huge(0.0), huge(0.0d0)\n print *, tiny(0.0), tiny(0.0d0)\n\n tally=0.0d0\n ! note subtracting one because counter is the end value+1 on exit\n do i=0,huge(0)-1\n tally=tally+i\n enddo\n write(*,*)'tally=',tally\n\n ! advanced\n biggest=huge(0)\n ! be careful of overflow when using integers in computation\n do i=1,14\n j=6**i ! Danger, Danger\n w=6**i ! Danger, Danger\n v=6.0**i\n k=v ! Danger, Danger\n\n if(v.gt.biggest)then\n write(*,f) i, j, k, v, v.eq.w, 'wrong j and k and w'\n else\n write(*,f) i, j, k, v, v.eq.w\n endif\n enddo\n ! a simple check of the product of two 32-bit integers\n print *,checkprod([2,4,5,8],[10000,20000,3000000,400000000])\n\ncontains\nimpure elemental function checkprod(i,j) result(ij32)\n!@(#) checkprod(3f) - check for overflow when multiplying two 32-bit integers\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\ninteger(kind=int32),intent(in) :: i, j\ninteger(kind=int64) :: ij64\ninteger(kind=int32) :: ij32\ninteger,parameter :: toobig=huge(0_int32)\ncharacter(len=80) :: message\n ij64=int(i,kind=int64)*int(j,kind=int64)\n if(ij64.gt.toobig)then\n write(message,'(*(g0))')&\n & 'checkprod(3f):',i,'*',j,'=',ij64,'>',toobig\n stop message\n else\n ij32=ij64\n endif\nend function checkprod\nend program demo_huge\n```\nResults:\n```text\n > 2147483647 3.40282347E+38 1.7976931348623157E+308\n > 1.17549435E-38 2.2250738585072014E-308\n > tally= 2.3058430049858406E+018\n > 1 6 6 6. T\n > 2 36 36 36. T\n > 3 216 216 216. T\n > 4 1296 1296 1296. T\n > 5 7776 7776 7776. T\n > 6 46656 46656 46656. T\n > 7 279936 279936 279936. T\n > 8 1679616 1679616 1679616. T\n > 9 10077696 10077696 10077696. T\n > 10 60466176 60466176 60466176. T\n > 11 362797056 362797056 362797056. T\n > 12 -2118184960 -2147483648 2176782336. F wrong j and k and w\n > 13 175792128 -2147483648 13060694016. F wrong j and k and w\n > 14 1054752768 -2147483648 78364164096. F wrong j and k and w\n > STOP checkprod(3f):8*400000000=3200000000>2147483647 \n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "HYPOT": "## hypot\n\n### **Name**\n\n**hypot** - \\[MATHEMATICS\\] Returns the Euclidean distance - the distance between a point and the origin.\n\n### **Synopsis**\n```fortran\n result = hypot(x, y)\n```\n```fortran\n elemental real(kind=KIND) function hypot(x,y)\n\n real(kind=KIND),intent(in) :: x\n real(kind=KIND),intent(in) :: y\n```\n### **Characteristics**\n\n - **x,y** and the result shall all be _real_ and of the same **kind**.\n\n### **Description**\n\n**hypot** is referred to as the Euclidean distance function. It is\nequal to\n```fortran\nsqrt(x**2+y**2)\n```\nwithout undue underflow or overflow.\n\nIn mathematics, the _Euclidean distance_ between two points in Euclidean\nspace is the length of a line segment between two points.\n\n**hypot(x,y)** returns the distance between the point **** and\nthe origin.\n\n### **Options**\n\n- **x**\n: The type shall be _real_.\n\n- **y**\n : The type and kind type parameter shall be the same as **x**.\n\n### **Result**\n\nThe return value has the same type and kind type parameter as **x**.\n\nThe result is the positive magnitude of the distance of the point\n**** from the origin **<0.0,0.0>** .\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_hypot\nuse, intrinsic :: iso_fortran_env, only : &\n & real_kinds, real32, real64, real128\nimplicit none\nreal(kind=real32) :: x, y\nreal(kind=real32),allocatable :: xs(:), ys(:)\ninteger :: i\ncharacter(len=*),parameter :: f='(a,/,SP,*(3x,g0,1x,g0:,/))'\n\n x = 1.e0_real32\n y = 0.5e0_real32\n\n write(*,*)\n write(*,'(*(g0))')'point <',x,',',y,'> is ',hypot(x,y)\n write(*,'(*(g0))')'units away from the origin'\n write(*,*)\n\n ! elemental\n xs=[ x, x**2, x*10.0, x*15.0, -x**2 ]\n ys=[ y, y**2, -y*20.0, y**2, -y**2 ]\n\n write(*,f)\"the points\",(xs(i),ys(i),i=1,size(xs))\n write(*,f)\"have distances from the origin of \",hypot(xs,ys)\n write(*,f)\"the closest is\",minval(hypot(xs,ys))\n\nend program demo_hypot\n```\n\nResults:\n\n```text\n point <1.00000000,0.500000000> is 1.11803401\n units away from the origin\n\n the points\n +1.00000000 +0.500000000\n +1.00000000 +0.250000000\n +10.0000000 -10.0000000\n +15.0000000 +0.250000000\n -1.00000000 -0.250000000\n have distances from the origin of\n +1.11803401 +1.03077638\n +14.1421356 +15.0020828\n +1.03077638\n the closest is\n +1.03077638\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n - [acos(3)](#acos) - Arccosine (inverse cosine) function\n - [acosh(3)](#acosh) - Inverse hyperbolic cosine function\n - [asin(3)](#asin) - Arcsine function\n - [asinh(3)](#asinh) - Inverse hyperbolic sine function\n - [atan(3)](#atan) - Arctangent AKA inverse tangent function\n - [atan2(3)](#atan2) - Arctangent (inverse tangent) function\n - [atanh(3)](#atanh) - Inverse hyperbolic tangent function\n - [cos(3)](#cos) - Cosine function\n - [cosh(3)](#cosh) - Hyperbolic cosine function\n - [sin(3)](#sin) - Sine function\n - [sinh(3)](#sinh) - Hyperbolic sine function\n - [tan(3)](#tan) - Tangent function\n - [tanh(3)](#tanh) - Hyperbolic tangent function\n - [bessel_j0(3)](#bessel_j0) - Bessel function of the first kind of order 0\n - [bessel_j1(3)](#bessel_j1) - Bessel function of the first kind of order 1\n - [bessel_jn(3)](#bessel_jn) - Bessel function of the first kind\n - [bessel_y0(3)](#bessel_y0) - Bessel function of the second kind of order 0\n - [bessel_y1(3)](#bessel_y1) - Bessel function of the second kind of order 1\n - [bessel_yn(3)](#bessel_y2) - Bessel function of the second kind\n - [erf(3)](#erf) - Error function\n - [erfc(3)](#erfc) - Complementary error function\n - [erfc_scaled(3)](#erfc_scaled) - Scaled complementary error function\n - [exp(3)](#exp) - Base-e exponential function\n - [gamma(3)](#gamma) - Gamma function, which yields factorials for positive whole numbers\n - [hypot(3)](#hypot) - Returns the Euclidean distance - the distance between a point and the origin.\n - [log(3)](#log) - Natural logarithm\n - [log10(3)](#log10) - Base 10 or common logarithm\n - [log_gamma(3)](#log_gamma) - Logarithm of the absolute value of the Gamma function\n - [norm2(3)](#norm2) - Euclidean vector norm\n - [sqrt(3)](#sqrt) - Square-root function\n - [random_init(3)](#random_init) - Initializes the state of the pseudorandom number generator\n - [random_number(3)](#random_number) - Pseudo-random number\n - [random_seed(3)](#random_seed) - Initialize a pseudo-random number sequence\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IACHAR": "## iachar\n\n### **Name**\n\n**iachar** - \\[CHARACTER:CONVERSION\\] Return integer ASCII code of a character\n\n### **Synopsis**\n```fortran\n result = iachar(c [,kind])\n```\n```fortran\n elemental integer(kind=KIND) function iachar(c,kind)\n\n character(len=1),intent(in) :: c\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - **c** is a single character\n - The return value is of type _integer_ and of kind **KIND**. If **KIND**\n is absent, the return value is of default integer kind.\n\n NOTE:\n : a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **iachar** returns the code for the ASCII character in the first\n character position of C.\n\n### **Options**\n\n- **c**\n : A character to determine the ASCII code of.\n : A common extension is to allow strings but all but the first character\n is then ignored.\n\n- **kind**\n : A constant initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\n the result is the position of the character **c** in the ASCII\n collating sequence. It is nonnegative and less than or equal to 127.\n\n By ASCII, it is meant that **c** is in the collating sequence defined\n by the codes specified in ISO/IEC 646:1991 (International Reference\n Version).\n\n The value of the result is processor dependent if **c** is not in the\n ASCII collating sequence.\n\n The results are consistent with the **lge**(3), **lgt**(3), **lle**(3),\n and **llt**(3) comparison functions. For example, if **lle(C, D)**\n is true, **iachar(C) <= iachar (D)** is true where **C** and **D**\n are any two characters representable by the processor.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_iachar\nimplicit none\n ! basic usage\n ! just does a string one character long\n write(*,*)iachar('A')\n ! elemental: can do an array of letters\n write(*,*)iachar(['A','Z','a','z'])\n\n ! convert all characters to lowercase\n write(*,'(a)')lower('abcdefg ABCDEFG')\ncontains\n!\npure elemental function lower(str) result (string)\n! Changes a string to lowercase\ncharacter(*), intent(In) :: str\ncharacter(len(str)) :: string\ninteger :: i\n string = str\n ! step thru each letter in the string in specified range\n do i = 1, len(str)\n select case (str(i:i))\n case ('A':'Z') ! change letter to miniscule\n string(i:i) = char(iachar(str(i:i))+32)\n case default\n end select\n end do\nend function lower\n!\nend program demo_iachar\n```\nResults:\n```text\n 65\n 65 90 97 122\n abcdefg abcdefg\n```\n### **Standard**\n\n Fortran 95 , with KIND argument - Fortran 2003\n\n### **See Also**\n\n[**achar**(3)](#achar),\n[**char**(3)](#char),\n[**ichar**(3)](#ichar)\n\n See [**ichar**(3)](#ichar) in particular for a discussion of converting\n between numerical values and formatted string representations.\n\n Functions that perform operations on character strings, return lengths\n of arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl), [**adjustr**(3)](#adjustr), [**index**(3)](#index),\n [**scan**(3)](#scan), [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat), [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IALL": "## iall\n\n### **Name**\n\n**iall** - \\[BIT:LOGICAL\\] Bitwise and of array elements\n\n### **Synopsis**\n```fortran\n result = iall(array [,mask]) | iall(array ,dim [,mask])\n```\n```fortran\n integer(kind=KIND) function iall(array,dim,mask)\n\n integer(kind=KIND),intent(in) :: array(*)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(*)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **array** must be an _integer_ array\n - **mask** is a _logical_ array that conforms to **array** of any\n _logical_ kind.\n - **dim** may be of any _integer_ kind.\n - The result will by of the same type and kind as **array**.\n\n### **Description**\n\n **iall** reduces with a bitwise _and_ the elements of **array** along\n dimension **dim** if the corresponding element in **mask** is _.true._.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_\n\n- **dim**\n : (Optional) shall be a scalar of type _integer_ with a value in the\n range from **1 to n**, where **n** equals the rank of **array**.\n\n- **mask**\n : (Optional) shall be of type _logical_ and either be a scalar or an\n array of the same shape as **array**.\n\n### **Result**\n\n The result is of the same type as **array**.\n\n If **dim** is absent, a scalar with the bitwise _all_ of all elements in\n **array** is returned. Otherwise, an array of rank **n-1**, where **n**\n equals the rank of **array**, and a shape similar to that of **array**\n with dimension **dim** dropped is returned.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_iall\nuse, intrinsic :: iso_fortran_env, only : integer_kinds, &\n & int8, int16, int32, int64\nimplicit none\ninteger(kind=int8) :: a(2)\n\n a(1) = int(b'00100100')\n a(2) = int(b'01101010')\n\n print '(b8.8)', iall(a)\n\nend program demo_iall\n```\nResults:\n```text\n > 00100000\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**iany**(3)](#iany),\n[**iparity**(3)](#iparity),\n[**iand**(3)](#iand)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -139,13 +139,13 @@ "MAX": "## max\n\n### **Name**\n\n**max** - \\[NUMERIC\\] Maximum value of an argument list\n\n### **Synopsis**\n```fortran\n result = max(a1, a2, a3, ...)\n```\n```fortran\n elemental TYPE(kind=KIND) function max(a1, a2, a3, ... )\n\n TYPE(kind=KIND,intent(in),optional :: a1\n TYPE(kind=KIND,intent(in),optional :: a2\n TYPE(kind=KIND,intent(in),optional :: a3\n :\n :\n```\n### **Characteristics**\n\n - **a3, a3, a4, ...** must be of the same type and kind as **a1**\n - the arguments may (all) be _integer_, _real_ or _character_\n - there must be at least two arguments\n - the length of a character result is the length of the longest argument\n - the type and kind of the result is the same as those of the arguments\n\n### **Description**\n\n **max** returns the argument with the largest (most positive) value.\n\n For arguments of character type, the result is as if the arguments had\n been successively compared with the intrinsic operational operators,\n taking into account the collating sequence of the _character_ kind.\n\n If the selected _character_ argument is shorter than the longest\n argument, the result is as all values were extended with blanks on\n the right to the length of the longest argument.\n\n It is unusual for a Fortran intrinsic to take an arbitrary number of\n options, and in addition **max** is elemental, meaning any number\n of arguments may be arrays as long as they are of the same shape.\n The examples have an extended description clarifying the resulting\n behavior for those not familiar with calling a \"scalar\" function\n elementally with arrays.\n\n See maxval(3) for simply getting the max value of an array.\n\n### **Options**\n\n- **a1**\n : The first argument determines the type and kind of the returned\n value, and of any remaining arguments as well as being a member of\n the set of values to find the maximum (most positive) value of.\n\n- **a2,a3,...**\n : the remaining arguments of which to find the maximum value(s) of.\n : There must be at least two arguments to **max(3)**.\n\n### **Result**\n\n The return value corresponds to an array of the same shape of any\n array argument, or a scalar if all arguments are scalar.\n\n The returned value when any argument is an array will be an array of\n the same shape where each element is the maximum value occurring at\n that location, treating all the scalar values as arrays of that same\n shape with all elements set to the scalar value.\n\n### **Examples**\n\nSample program\n```fortran\nprogram demo_max\nimplicit none\nreal :: arr1(4)= [10.0,11.0,30.0,-100.0]\nreal :: arr2(5)= [20.0,21.0,32.0,-200.0,2200.0]\ninteger :: box(3,4)= reshape([-6,-5,-4,-3,-2,-1,1,2,3,4,5,6],shape(box))\n\n ! basic usage\n ! this is simple enough when all arguments are scalar\n\n ! the most positive value is returned, not the one with the\n ! largest magnitude\n write(*,*)'scalars:',max(10.0,11.0,30.0,-100.0)\n write(*,*)'scalars:',max(-22222.0,-0.0001)\n\n ! strings do not need to be of the same length\n write(*,*)'characters:',max('the','words','order')\n\n ! leading spaces are significant; everyone is padded on the right\n ! to the length of the longest argument\n write(*,*)'characters:',max('c','bb','a')\n write(*,*)'characters:',max(' c','b','a')\n\n ! elemental\n ! there must be at least two arguments, so even if A1 is an array\n ! max(A1) is not valid. See MAXVAL(3) and/or MAXLOC(3) instead.\n\n ! strings in a single array do need to be of the same length\n ! but the different objects can still be of different lengths.\n write(*,\"(*('\"\"',a,'\"\"':,1x))\")MAX(['A','Z'],['BB','Y '])\n ! note the result is now an array with the max of every element\n ! position, as can be illustrated numerically as well:\n write(*,'(a,*(i3,1x))')'box= ',box\n write(*,'(a,*(i3,1x))')'box**2=',sign(1,box)*box**2\n write(*,'(a,*(i3,1x))')'max ',max(box,sign(1,box)*box**2)\n\n ! Remember if any argument is an array by the definition of an\n ! elemental function all the array arguments must be the same shape.\n\n ! to find the single largest value of arrays you could use something\n ! like MAXVAL([arr1, arr2]) or probably better (no large temp array),\n ! max(maxval(arr1),maxval(arr2)) instead\n\n ! so this returns an array of the same shape as any input array\n ! where each result is the maximum that occurs at that position.\n write(*,*)max(arr1,arr2(1:4))\n ! this returns an array just like arr1 except all values less than\n ! zero are set to zero:\n write(*,*)max(box,0)\n ! When mixing arrays and scalars you can think of the scalars\n ! as being a copy of one of the arrays with all values set to\n ! the scalar value.\n\nend program demo_max\n```\nResults:\n```text\n scalars: 30.00000\n scalars: -9.9999997E-05\n characters:words\n characters:c\n characters:b\n \"BB\" \"Z \"\n box= -6 -5 -4 -3 -2 -1 1 2 3 4 5 6\n box**2=-36 -25 -16 -9 -4 -1 1 4 9 16 25 36\n max -6 -5 -4 -3 -2 -1 1 4 9 16 25 36\n 20.00000 21.00000 32.00000 -100.0000\n 0 0 0 0 0 0\n 1 2 3 4 5 6\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**maxloc**(3)](#maxloc),\n[**minloc**(3)](#minloc),\n[**maxval**(3)](#maxval),\n[**minval**(3)](#minval),\n[**min**(3)](#min)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MAXEXPONENT": "## maxexponent\n\n### **Name**\n\n**maxexponent** - \\[NUMERIC MODEL\\] Maximum exponent of a real kind\n\n### **Synopsis**\n```fortran\n result = maxexponent(x)\n```\n```fortran\n elemental integer function maxexponent(x)\n\n real(kind=**),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is a _real_ scalar or array of any _real_ kind\n - the result is a default _integer_ scalar\n\n### **Description**\n\n **maxexponent** returns the maximum exponent in the model of the\n type of **x**.\n\n### **Options**\n\n- **x**\n : A value used to select the kind of _real_ to return a value for.\n\n### **Result**\n\n The value returned is the maximum exponent for the kind of the value\n queried\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_maxexponent\nuse, intrinsic :: iso_fortran_env, only : real32,real64,real128\nimplicit none\ncharacter(len=*),parameter :: g='(*(g0,1x))'\n print g, minexponent(0.0_real32), maxexponent(0.0_real32)\n print g, minexponent(0.0_real64), maxexponent(0.0_real64)\n print g, minexponent(0.0_real128), maxexponent(0.0_real128)\nend program demo_maxexponent\n```\nResults:\n```text\n -125 128\n -1021 1024\n -16381 16384\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MAXLOC": "## maxloc\n\n### **Name**\n\n**maxloc** - \\[ARRAY:LOCATION\\] Location of the maximum value within an array\n\n### **Synopsis**\n```fortran\n result = maxloc(array [,mask]) | maxloc(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function maxloc(array, dim, mask)\n\n NUMERIC,intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **NUMERIC** designates any intrinsic numeric type and kind.\n\n### **Description**\n\n**maxloc** determines the location of the element in the array with\nthe maximum value, or, if the **dim** argument is supplied, determines\nthe locations of the maximum element along each row of the array in the\n**dim** direction.\n\nIf **mask** is present, only the elements for which **mask**\nis _.true._ are considered. If more than one element in the array has\nthe maximum value, the location returned is that of the first such element\nin array element order.\n\nIf the array has zero size, or all of the elements\nof **mask** are .false., then the result is an array of zeroes. Similarly,\nif **dim** is supplied and all of the elements of **mask** along a given\nrow are zero, the result value for that row is zero.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_, or _character_.\n\n- **dim**\n : (Optional) Shall be a scalar of type _integer_, with a value between\n one and the rank of **array**, inclusive. It may not be an optional\n dummy argument.\n\n- **mask**\n : Shall be an array of type _logical_, and conformable with **array**.\n\n### **Result**\n\nIf **dim** is absent, the result is a rank-one array with a length equal\nto the rank of **array**. If **dim** is present, the result is an array\nwith a rank one less than the rank of **array**, and a size corresponding\nto the size of **array** with the **dim** dimension removed. If **dim**\nis present and **array** has a rank of one, the result is a scalar. In\nall cases, the result is of default _integer_ type.\n\nThe value returned is reference to the offset from the beginning of the\narray, not necessarily the subscript value if the array subscripts do\nnot start with one.\n\n### **Examples**\n\nsample program\n\n```fortran\nprogram demo_maxloc\nimplicit none\ninteger :: ii\ninteger,save :: i(-3:3)=[(abs(abs(ii)-50),ii=-3,3)]\ninteger,save :: ints(3,5)= reshape([&\n 1, 2, 3, 4, 5, &\n 10, 20, 30, 40, 50, &\n 11, 22, 33, 44, 55 &\n],shape(ints),order=[2,1])\n\n write(*,*) maxloc(ints)\n write(*,*) maxloc(ints,dim=1)\n write(*,*) maxloc(ints,dim=2)\n ! when array bounds do not start with one remember MAXLOC(3) returns\n ! the offset relative to the lower bound-1 of the location of the\n ! maximum value, not the subscript of the maximum value. When the\n ! lower bound of the array is one, these values are the same. In\n ! other words, MAXLOC(3) returns the subscript of the value assuming\n ! the first subscript of the array is one no matter what the lower\n ! bound of the subscript actually is.\n write(*,'(g0,1x,g0)') (ii,i(ii),ii=lbound(i,dim=1),ubound(i,dim=1))\n write(*,*)maxloc(i)\n\nend program demo_maxloc\n```\n\nResults:\n\n```text\n > 3 5\n > 3 3 3 3 3\n > 5 5 5\n > -3 47\n > -2 48\n > -1 49\n > 0 50\n > 1 49\n > 2 48\n > 3 47\n```\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n - [**findloc**(3)](#findloc) - Location of first element of ARRAY\n identified by MASK along dimension DIM matching a target\n - [**minloc**(3)](#minloc) - Location of the minimum value within an array\n - [**maxval**(3)](#maxval)\n - [**minval**(3)](#minval)\n - [**max**(3)](#max)\n\n _Fortran intrinsic descriptions_\n", - "MAXVAL": "## maxval\n\n### **Name**\n\n**maxval** - \\[ARRAY:REDUCTION\\] Determines the maximum value in an array or row\n\n### **Synopsis**\n```fortran\n result = maxval(array [,mask]) | maxval(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function maxval(array ,dim, mask)\n\n NUMERIC,intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **NUMERIC** designates any numeric type and kind.\n\n### **Description**\n\n **maxval** determines the maximum value of the elements in an\n array value, or, if the **dim** argument is supplied, determines the\n maximum value along each row of the array in the **dim** direction. If\n **mask** is present, only the elements for which **mask** is _.true._\n are considered. If the array has zero size, or all of the elements of\n **mask** are _.false._, then the result is the most negative number\n of the type and kind of **array** if **array** is numeric, or a string\n of nulls if **array** is of character type.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_, or _character_.\n\n- **dim**\n : (Optional) Shall be a scalar of type _integer_, with a value between\n one and the rank of **array**, inclusive. It may not be an optional\n dummy argument.\n\n- **mask**\n : (Optional) Shall be an array of type _logical_, and conformable with\n **array**.\n\n### **Result**\n\nIf **dim** is absent, or if **array** has a rank of one, the result is a scalar.\nIf **dim** is present, the result is an array with a rank one less than the\nrank of **array**, and a size corresponding to the size of **array** with the\n**dim** dimension removed. In all cases, the result is of the same type and\nkind as **array**.\n\n### **Examples**\n\nsample program:\n\n```fortran\nprogram demo_maxval\nimplicit none\ninteger,save :: ints(3,5)= reshape([&\n 1, 2, 3, 4, 5, &\n 10, 20, 30, 40, 50, &\n 11, 22, 33, 44, 55 &\n],shape(ints),order=[2,1])\n\n write(*,*) maxval(ints)\n write(*,*) maxval(ints,dim=1)\n write(*,*) maxval(ints,dim=2)\n ! find biggest number less than 30 with mask\n write(*,*) maxval(ints,mask=ints.lt.30)\nend program demo_maxval\n```\nResults:\n```\n > 55\n > 11 22 33 44 55\n > 5 50 55\n > 22\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**maxloc**(3)](#maxloc),\n[**minloc**(3)](#minloc),\n[**minval**(3)](#minval),\n[**max**(3)](#max),\n[**min**(3)](#min)\n\n _Fortran intrinsic descriptions_\n", + "MAXVAL": "## maxval\n\n### **Name**\n\n**maxval** - \\[ARRAY:REDUCTION\\] Determines the maximum value in an array or row\n\n### **Synopsis**\n```fortran\n result = maxval(array [,mask]) | maxval(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function maxval(array ,dim, mask)\n\n NUMERIC,intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **NUMERIC** designates any numeric type and kind.\n\n### **Description**\n\n **maxval** determines the maximum value of the elements in an\n array value, or, if the **dim** argument is supplied, determines the\n maximum value along each row of the array in the **dim** direction. If\n **mask** is present, only the elements for which **mask** is _.true._\n are considered. \n\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_, or _character_.\n\n- **dim**\n : (Optional) Shall be a scalar of type _integer_, with a value between\n one and the rank of **array**, inclusive. It may not be an optional\n dummy argument.\n\n- **mask**\n : (Optional) Shall be an array of type _logical_, and conformable with\n **array**.\n\n### **Result**\n\n If **dim** is absent, or if **array** has a rank of one, the result is\n a scalar. If **dim** is present, the result is an array with a rank\n one less than the rank of **array**, and a size corresponding to the\n size of **array** with the **dim** dimension removed. In all cases,\n the result is of the same type and kind as **array**.\n\n If the considered array has zero size then the result is the most\n negative number of the type and kind of **array** if **array** is\n numeric, or a string of nulls if **array** is of ASCII character type.\n or equal to **CHAR(0, KIND(ARRAY))** otherwise.\n\n### **Examples**\n\nsample program:\n\n```fortran\nprogram demo_maxval\nimplicit none\ninteger,save :: ints(3,5)= reshape([&\n 1, 2, 3, 4, 5, &\n 10, 20, 30, 40, 50, &\n 11, 22, 33, 44, 55 &\n],shape(ints),order=[2,1])\ncharacter(len=:),allocatable :: strs(:)\ninteger :: i\ncharacter(len=*),parameter :: gen='(*(g0,1x))'\ncharacter(len=*),parameter :: ind='(3x,*(g0,1x))'\n\n print gen,'Given the array'\n write(*,'(1x,*(g4.4,1x))') &\n & (ints(i,:),new_line('a'),i=1,size(ints,dim=1))\n print gen,'Basics:'\n print ind, 'biggest value in array'\n print ind, maxval(ints)\n print ind, 'biggest value in each column'\n print ind, maxval(ints,dim=1)\n print ind, 'biggest value in each row'\n print ind, maxval(ints,dim=2)\n\n print gen,'With a mask:'\n print ind, ' find biggest number less than 30 with mask'\n print ind, maxval(ints,mask=ints.lt.30)\n\n print gen,'If zero size considered:'\n print ind, 'if zero size numeric array'\n print ind, maxval([integer :: ]),'and -huge(0) is',-huge(0),&\n & '(often not the same!)'\n print ind, 'if zero-size character array all nulls'\n strs=[character(len=5)::]\n strs=maxval(strs)\n print ind, ichar([(strs(i),i=1,len(strs))])\n print ind, 'if everything is false,'\n print ind, 'same as zero-size array for each subarray'\n print ind, maxval(ints,mask=.false.)\n print ind, maxval(ints,mask=.false.,dim=1)\nend program demo_maxval\n```\nResults:\n```\n > Given the array:\n > 1, 2, 3, 4, 5, &\n > 10, 20, 30, 40, 50, &\n > 11, 22, 33, 44, 55 &\n > biggest value in array\n > 55\n > biggest value in each column\n > 11 22 33 44 55\n > biggest value in each row\n > 5 50 55\n > find biggest number less than 30 with mask\n > 22\n > if zero size numeric array\n > -2147483648 and -huge(0) is -2147483647 (often not the same!)\n > if zero-size character array all nulls\n > 0 0 0 0 0\n > if everything is false, same as zero-size array\n > -2147483648\n > -2147483648 -2147483648 -2147483648 -2147483648 -2147483648\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**minval**(3)](#minval),\n[**minloc**(3)](#minloc),\n[**maxloc**(3)](#maxloc),\n[**min**(3)](#min)\n[**max**(3)](#max),\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MERGE": "## merge\n\n### **Name**\n\n**merge** - \\[ARRAY:CONSTRUCTION\\] Merge variables\n\n### **Synopsis**\n```fortran\n result = merge(tsource, fsource, mask)\n```\n```fortran\n elemental type(TYPE(kind=KIND)) function merge(tsource,fsource,mask)\n\n type(TYPE(kind=KIND)),intent(in) :: tsource\n type(TYPE(kind=KIND)),intent(in) :: fsource\n logical(kind=**),intent(in) :: mask\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **tsource** May be of any type, including user-defined.\n - **fsource** Shall be of the same type and type parameters as **tsource**.\n - **mask** shall be of type logical.\n - The result will by of the same type and type parameters as **tsource**.\n\n\n### **Description**\n\nThe elemental function **merge** selects values from two arrays or\nscalars according to a logical mask. The result is equal to an element\nof **tsource** where the corresponding element of **mask** is _.true._, or an\nelement of **fsource** when it is _.false._ .\n\nMulti-dimensional arrays are supported.\n\nNote that argument expressions to **merge** are not required to be\nshort-circuited so (as an example) if the array **x** contains zero values\nin the statement below the standard does not prevent floating point\ndivide by zero being generated; as **1.0/x** may be evaluated for all values\nof **x** before the mask is used to select which value to retain:\n\n```fortran\n y = merge( 1.0/x, 0.0, x /= 0.0 )\n```\n\nNote the compiler is also free to short-circuit or to generate an\ninfinity so this may work in many programming environments but is not\nrecommended.\n\nFor cases like this one may instead use masked assignment via the **where**\nconstruct:\n\n```fortran\n where(x .ne. 0.0)\n y = 1.0/x\n elsewhere\n y = 0.0\n endwhere\n```\n\ninstead of the more obscure\n\n```fortran\n merge(1.0/merge(x,1.0,x /= 0.0), 0.0, x /= 0.0)\n```\n### **Options**\n\n- **tsource**\n : May be of any type, including user-defined.\n\n- **fsource**\n : Shall be of the same type and type parameters as **tsource**.\n\n- **mask**\n : Shall be of type _logical_.\n\nNote that (currently) _character_ values must be of the same length.\n\n### **Result**\n The result is built from an element of **tsource** if **mask** is\n _.true._ and from **fsource** otherwise.\n\n Because **tsource** and **fsource** are required to have the same type\n and type parameters (for both the declared and dynamic types), the\n result is polymorphic if and only if both **tsource** and **fsource**\n are polymorphic.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_merge\nimplicit none\ninteger :: tvals(2,3), fvals(2,3), answer(2,3)\nlogical :: mask(2,3)\ninteger :: i\ninteger :: k\nlogical :: chooseleft\n\n ! Works with scalars\n k=5\n write(*,*)merge (1.0, 0.0, k > 0)\n k=-2\n write(*,*)merge (1.0, 0.0, k > 0)\n\n ! set up some simple arrays that all conform to the\n ! same shape\n tvals(1,:)=[ 10, -60, 50 ]\n tvals(2,:)=[ -20, 40, -60 ]\n\n fvals(1,:)=[ 0, 3, 2 ]\n fvals(2,:)=[ 7, 4, 8 ]\n\n mask(1,:)=[ .true., .false., .true. ]\n mask(2,:)=[ .false., .false., .true. ]\n\n ! lets use the mask of specific values\n write(*,*)'mask of logicals'\n answer=merge( tvals, fvals, mask )\n call printme()\n\n ! more typically the mask is an expression\n write(*, *)'highest values'\n answer=merge( tvals, fvals, tvals > fvals )\n call printme()\n\n write(*, *)'lowest values'\n answer=merge( tvals, fvals, tvals < fvals )\n call printme()\n\n write(*, *)'zero out negative values'\n answer=merge( 0, tvals, tvals < 0)\n call printme()\n\n write(*, *)'binary choice'\n chooseleft=.false.\n write(*, '(3i4)')merge([1,2,3],[10,20,30],chooseleft)\n chooseleft=.true.\n write(*, '(3i4)')merge([1,2,3],[10,20,30],chooseleft)\n\ncontains\n\nsubroutine printme()\n write(*, '(3i4)')(answer(i, :), i=1, size(answer, dim=1))\nend subroutine printme\n\nend program demo_merge\n```\nResults:\n```text\n > 1.00000000\n > 0.00000000\n > mask of logicals\n > 10 3 50\n > 7 4 -60\n > highest values\n > 10 3 50\n > 7 40 8\n > lowest values\n > 0 -60 2\n > -20 4 -60\n > zero out negative values\n > 10 0 50\n > 0 40 0\n > binary choice\n > 10 20 30\n > 1 2 3\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n- [**pack**(3)](#pack) packs an array into an array of rank one\n- [**spread**(3)](#spread) is used to add a dimension and replicate data\n- [**unpack**(3)](#unpack) scatters the elements of a vector\n- [**transpose**(3)](#transpose) - Transpose an array of rank two\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MERGE_BITS": "## merge_bits\n\n### **Name**\n\n**merge_bits** - \\[BIT:COPY\\] Merge bits using a mask\n\n### **Synopsis**\n```fortran\n result = merge_bits(i, j, mask)\n```\n```fortran\n elemental integer(kind=KIND) function merge_bits(i,j,mask)\n\n integer(kind=KIND), intent(in) :: i, j, mask\n```\n### **Characteristics**\n\n - the result and all input values have the same _integer_ type and\n KIND with the exception that the mask and either **i** or **j** may be\n a BOZ constant.\n\n### **Description**\n\nA common graphics operation in Ternary Raster Operations is to combine\nbits from two different sources, generally referred to as bit-blending.\n**merge_bits** performs a masked bit-blend of **i** and **j** using\nthe bits of the **mask** value to determine which of the input values\nto copy bits from.\n\nSpecifically, The k-th bit of the result is equal to the k-th bit of\n**i** if the k-th bit of **mask** is **1**; it is equal to the k-th bit\nof **j** otherwise (so all three input values must have the same number\nof bits).\n\nThe resulting value is the same as would result from\n```fortran\n ior (iand (i, mask),iand (j, not (mask)))\n```\nAn exception to all values being of the same _integer_ type is that **i**\nor **j** and/or the mask may be a BOZ constant (A BOZ constant means it is\neither a Binary, Octal, or Hexadecimal literal constant). The BOZ values\nare converted to the _integer_ type of the non-BOZ value(s) as if called\nby the intrinsic function **int()** with the kind of the non-BOZ value(s),\nso the BOZ values must be in the range of the type of the result.\n\n### **Options**\n\n- **i**\n : value to select bits from when the associated bit in the mask is **1**.\n\n- **j**\n : value to select bits from when the associated bit in the mask is **0**.\n\n- **mask**\n : a value whose bits are used as a mask to select bits from **i** and **j**\n\n### **Result**\n\nThe bits blended from **i** and **j** using the mask **mask**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_merge_bits\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: if_one,if_zero,msk\ncharacter(len=*),parameter :: fmt='(*(g0, 1X))'\n\n ! basic usage\n print *,'MERGE_BITS( 5,10,41) should be 3.=>',merge_bits(5,10,41)\n print *,'MERGE_BITS(13,18,22) should be 4.=>',merge_bits(13,18,22)\n\n ! use some values in base2 illustratively:\n if_one =int(b'1010101010101010',kind=int16)\n if_zero=int(b'0101010101010101',kind=int16)\n\n msk=int(b'0101010101010101',kind=int16)\n print '(\"should get all zero bits =>\",b16.16)', &\n & merge_bits(if_one,if_zero,msk)\n\n msk=int(b'1010101010101010',kind=int16)\n print '(\"should get all ones bits =>\",b16.16)', &\n & merge_bits(if_one,if_zero,msk)\n\n ! using BOZ values\n print fmt, &\n & merge_bits(32767_int16, o'12345', 32767_int16), &\n & merge_bits(o'12345', 32767_int16, b'0000000000010101'), &\n & merge_bits(32767_int16, o'12345', z'1234')\n\n ! a do-it-yourself equivalent for comparison and validation\n print fmt, &\n & ior(iand(32767_int16, 32767_int16), &\n & iand(o'12345', not(32767_int16))), &\n\n & ior(iand(o'12345', int(o'12345', kind=int16)), &\n & iand(32767_int16, not(int(o'12345', kind=int16)))), &\n\n & ior(iand(32767_int16, z'1234'), &\n & iand(o'12345', not(int( z'1234', kind=int16))))\n\nend program demo_merge_bits\n```\nResults:\n```text\n MERGE_BITS( 5,10,41) should be 3.=> 3\n MERGE_BITS(13,18,22) should be 4.=> 4\n should get all zero bits =>0000000000000000\n should get all ones bits =>1111111111111111\n 32767 32751 5877\n 32767 32767 5877\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n - [dshiftl(3)](#dshiftl) - Combined left shift of the bits of two integers\n - [dshiftr(3)](#dshiftr) - Combined right shift of the bits of two integers\n - [ibits(3)](#ibits) - Extraction of a subset of bits\n - [merge_bits(3)](#merge_bits) - Merge bits using a mask\n - [mvbits(3)](#mvbits) - Reproduce bit patterns found in one integer in another\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MIN": "## min\n\n### **Name**\n\n**min** - \\[NUMERIC\\] Minimum value of an argument list\n\n### **Synopsis**\n```fortran\n result = min(a1, a2, a3, ... )\n```\n```fortran\n elemental TYPE(kind=KIND) function min(a1, a2, a3, ... )\n\n TYPE(kind=KIND,intent(in) :: a1\n TYPE(kind=KIND,intent(in) :: a2\n TYPE(kind=KIND,intent(in) :: a3\n :\n :\n :\n```\n### **Characteristics**\n\n- **TYPE** may be _integer_, _real_ or _character_.\n\n### **Description**\n\n**min** returns the argument with the smallest (most negative) value.\n\nSee **max**(3) for an extended example of the behavior of **min** as\nand **max**(3).\n\n### **Options**\n\n- **a1**\n : the first element of the set of values to determine the minimum of.\n\n- **a2, a3, ...**\n : An expression of the same type and kind as **a1** completing the\n set of values to find the minimum of.\n\n### **Result**\n\nThe return value corresponds to the minimum value among the arguments,\nand has the same type and kind as the first argument.\n\n### **Examples**\n\nSample program\n```fortran\nprogram demo_min\nimplicit none\n write(*,*)min(10.0,11.0,30.0,-100.0)\nend program demo_min\n```\nResults:\n```\n -100.0000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**maxloc**(3)](#maxloc),\n[**minloc**(3)](#minloc),\n[**minval**(3)](#minval),\n[**max**(3)](#max),\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MINEXPONENT": "## minexponent\n\n### **Name**\n\n**minexponent** - \\[NUMERIC MODEL\\] Minimum exponent of a real kind\n\n### **Synopsis**\n```fortran\n result = minexponent(x)\n```\n```fortran\n elemental integer function minexponent(x)\n\n real(kind=**),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is a _real_ scalar or array of any _real_ kind\n - the result is a default _integer_ scalar\n\n### **Description**\n\n **minexponent** returns the minimum exponent in the model of the\n type of **x**.\n\n### **Options**\n\n- **x**\n : A value used to select the kind of _real_ to return a value for.\n\n### **Result**\n\n The value returned is the maximum exponent for the kind of the value\n queried\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_minexponent\nuse, intrinsic :: iso_fortran_env, only : &\n &real_kinds, real32, real64, real128\nimplicit none\nreal(kind=real32) :: x\nreal(kind=real64) :: y\n print *, minexponent(x), maxexponent(x)\n print *, minexponent(y), maxexponent(y)\nend program demo_minexponent\n```\nExpected Results:\n```\n -125 128\n -1021 1024\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MINLOC": "## minloc\n\n### **Name**\n\n**minloc** - \\[ARRAY:LOCATION\\] Location of the minimum value within an array\n\n### **Synopsis**\n```fortran\n result = minloc(array [,mask]) | minloc(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function minloc(array, dim, mask)\n\n NUMERIC,intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **NUMERIC** is any numeric type and kind.\n\n### **Description**\n\n **minloc** determines the location of the element in the array with\n the minimum value, or, if the **dim** argument is supplied, determines\n the locations of the minimum element along each row of the array in\n the **dim** direction.\n\n If **mask** is present, only the elements for which **mask** is _true._\n are considered.\n\n If more than one element in the array has the minimum value, the\n location returned is that of the first such element in array element\n order.\n\n If the array has zero size, or all of the elements of **mask** are\n _.false._, then the result is an array of zeroes. Similarly, if **dim**\n is supplied and all of the elements of **mask** along a given row are\n zero, the result value for that row is zero.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_, or _character_.\n\n- **dim**\n : (Optional) Shall be a scalar of type _integer_, with a value between\n one and the rank of **array**, inclusive. It may not be an optional\n dummy argument.\n\n- **mask**\n : Shall be an array of type _logical_, and conformable with **array**.\n\n### **Result**\n\nIf **dim** is absent, the result is a rank-one array with a length equal\nto the rank of **array**. If **dim** is present, the result is an array\nwith a rank one less than the rank of **array**, and a size corresponding\nto the size of **array** with the **dim** dimension removed. If **dim**\nis present and **array** has a rank of one, the result is a scalar. In\nall cases, the result is of default _integer_ type.\n\n### **Examples**\n\nsample program:\n\n```fortran\nprogram demo_minloc\nimplicit none\ninteger,save :: ints(3,5)= reshape([&\n 4, 10, 1, 7, 13, &\n 9, 15, 6, 12, 3, &\n 14, 5, 11, 2, 8 &\n],shape(ints),order=[2,1])\n write(*,*) minloc(ints)\n write(*,*) minloc(ints,dim=1)\n write(*,*) minloc(ints,dim=2)\n ! where in each column is the smallest number .gt. 10 ?\n write(*,*) minloc(ints,dim=2,mask=ints.gt.10)\n ! a one-dimensional array with dim=1 explicitly listed returns a scalar\n write(*,*) minloc(pack(ints,.true.),dim=1) ! scalar\nend program demo_minloc\n```\nResults:\n```text\n > 1 3\n > 1 3 1 3 2\n > 3 5 4\n > 5 4 3\n > 7\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n - [**findloc**(3)](#findloc) - Location of first element of ARRAY\n identified by MASK along dimension DIM matching a target\n - [**maxloc**(3)](#maxloc) - Location of the maximum value within an array\n - [**minloc**](#minloc) - Location of the minimum value within an array\n - [**min**(3)](#min)\n - [**minval**(3)](#minval)\n - [**maxval**(3)](#maxval)\n - [**max**(3)](#max)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "MINVAL": "## minval\n\n### **Name**\n\n**minval** - \\[ARRAY:REDUCTION\\] Minimum value of an array\n\n### **Synopsis**\n```fortran\n result = minval(array, [mask]) | minval(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function minval(array, dim, mask)\n\n NUMERIC,intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **NUMERIC** is any numeric type and kind.\n\n### **Description**\n\n **minval** determines the minimum value of the elements in an array\n value, or, if the **dim** argument is supplied, determines the minimum\n value along each row of the array in the **dim** direction.\n\n If **mask** is present, only the elements for which **mask** is\n _.true._ are considered.\n\n If the array has zero size, or all of the elements of **mask**\n are _.false._, then the result is **huge(array)** if **array** is\n numeric, or a string of **char(len=255)** characters if **array**\n is of character type.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_, or _character_.\n\n- **dim**\n : (Optional) Shall be a scalar of type _integer_, with a value between\n one and the rank of ARRAY, inclusive. It may not be an optional\n dummy argument.\n\n- **mask**\n : Shall be an array of type _logical_, and conformable with **array**.\n\n### **Result**\n\nIf **dim** is absent, or if **array** has a rank of one, the result is a scalar.\n\nIf **dim** is present, the result is an array with a rank one less than the\nrank of **array**, and a size corresponding to the size of **array** with the\n**dim** dimension removed. In all cases, the result is of the same type and\nkind as **array**.\n\n### **Examples**\n\nsample program:\n```fortran\nprogram demo_minval\nimplicit none\ninteger :: i\ncharacter(len=*),parameter :: g='(3x,*(g0,1x))'\n\ninteger,save :: ints(3,5)= reshape([&\n 1, -2, 3, 4, 5, &\n 10, 20, -30, 40, 50, &\n 11, 22, 33, -44, 55 &\n],shape(ints),order=[2,1])\n\ninteger,save :: box(3,5,2)\n\n box(:,:,1)=ints\n box(:,:,2)=-ints\n\n write(*,*)'Given the array'\n write(*,'(1x,*(g4.4,1x))') &\n & (ints(i,:),new_line('a'),i=1,size(ints,dim=1))\n\n write(*,*)'What is the smallest element in the array?'\n write(*,g) minval(ints),'at <',minloc(ints),'>'\n\n write(*,*)'What is the smallest element in each column?'\n write(*,g) minval(ints,dim=1)\n\n write(*,*)'What is the smallest element in each row?'\n write(*,g) minval(ints,dim=2)\n\n ! notice the shape of the output has less columns\n ! than the input in this case\n write(*,*)'What is the smallest element in each column,'\n write(*,*)'considering only those elements that are'\n write(*,*)'greater than zero?'\n write(*,g) minval(ints, dim=1, mask = ints > 0)\n\n write(*,*)&\n & 'if everything is false a zero-sized array is NOT returned'\n write(*,*) minval(ints, dim=1, mask = .false.)\n write(*,*)'even for a zero-sized input'\n write(*,g) minval([integer ::], dim=1, mask = .false.)\n\n write(*,*)'a scalar answer for everything false is huge()'\n write(*,g) minval(ints, mask = .false.)\n write(*,g) minval([integer ::], mask = .false.)\n\n write(*,*)'some calls with three dimensions'\n write(*,g) minval(box, mask = .true. )\n write(*,g) minval(box, dim=1, mask = .true. )\n\n write(*,g) minval(box, dim=2, mask = .true. )\n write(*,g) 'shape of answer is ', &\n & shape(minval(box, dim=2, mask = .true. ))\n\nend program demo_minval\n```\nResults:\n```text\n > Given the array\n > 1 -2 3 4 5\n > 10 20 -30 40 50\n > 11 22 33 -44 55\n >\n > What is the smallest element in the array?\n > -44 at < 3 4 >\n > What is the smallest element in each column?\n > 1 -2 -30 -44 5\n > What is the smallest element in each row?\n > -2 -30 -44\n > What is the smallest element in each column,\n > considering only those elements that are\n > greater than zero?\n > 1 20 3 4 5\n > if everything is false a zero-sized array is NOT returned\n > 2147483647 2147483647 2147483647 2147483647 2147483647\n > even for a zero-sized input\n > 2147483647\n > a scalar answer for everything false is huge()\n > 2147483647\n > 2147483647\n > some calls with three dimensions\n > -55\n > 1 -2 -30 -44 5 -11 -22 -33 -40 -55\n > -2 -30 -44 -5 -50 -55\n > shape of answer is 3 2\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**min**(3)](#min),\n[**minloc**(3)](#minloc)\n[**maxloc**(3)](#maxloc),\n[**maxval**(3)](#maxval),\n[**min**(3)](#min)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "MINVAL": "## minval\n\n### **Name**\n\n**minval** - \\[ARRAY REDUCTION\\] Minimum value of all the elements\nof ARRAY along dimension DIM corresponding to true elements of MASK.\n\n### **Synopsis**\nforms\n```fortran\n result = minval(array, [mask]) \n```\nor\n```fortran\n result = minval(array [,dim] [,mask])\n```\n```fortran\n type(TYPE(kind=**)) function minval(array, dim, mask)\n\n NUMERIC,intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - **TYPE** may be real, integer, or character.\n - a kind designated as ** may be any supported kind for the type\n - **dim** is an integer scalar indicating a dimension of the array.\n It may not be an optional dummy argument.\n - **mask** is an array of type _logical_, and conformable with **array**.\n - the result is of the same type and kind as **array**.\n\n### **Description**\n\n **minval** determines the minimum value of the elements in an array\n or, if the **dim** argument is supplied, determines the minimum value\n in the subarrays indicated by stepping along the **dim**th dimension.\n\n Note that the result of \n```fortran\n MINVAL(ARRAY, MASK = MASK) \n```\n has a value equal to that of \n```fortran\n MINVAL (PACK (ARRAY, MASK)).\n```\n and The result of \n```fortran\n MINVAL (ARRAY, DIM = DIM [, MASK = MASK])\n```\n has a value equal to that of\n```fortran\n MINVAL (ARRAY [, MASK = MASK])\n```\n if ARRAY has rank one. Otherwise, the value of element\n (s1 , s2 , . . . , sDIM-1 , sDIM+1 , . . . , sn ) of the result is equal to\n```fortran\n MINVAL (ARRAY (s1 , s2 , . . . , sDIM-1 , :, sDIM+1 , . . . , sn )\n [, MASK= MASK (s1 , s2 , . . . , sDIM-1 , :, sDIM+1 , . . . , sn ) ] ).\n```\n### **Options**\n\n- **array**\n : array to search for minimum values. If the array has zero size,\n or all of the elements of **mask** are .false., then the result is\n **huge(array)** if **array** is numeric, or an array of strings of\n **char(len=len(array))** characters, with each character equal to\n CHAR (n - 1, KIND (ARRAY)), where n is the number of characters in\n the collating sequence for characters with the kind type parameter\n of **array**.\n\n If ARRAY is of type character, the result is the value that would be\n selected by application of intrinsic relational operators; that is,\n the collating sequence for characters with the kind type parameter of\n the arguments is applied.\n\n- **dim**\n : Indicates which dimension to split the array into subarrays along.\n It has a value between one and the rank of **array**, inclusive.\n\n- **mask**\n ; If **mask** is present, only the elements for which **mask** is _.true._\n are considered when searching for the minimal value.\n\n### **Result**\n\nIf **dim** is absent, or if **array** has a rank of one, the result is a scalar.\n\nIf **dim** is present, the result is an array with a rank one less than the\nrank of **array**, and a size corresponding to the size of **array** with the\n**dim** dimension removed. In all cases, the result is of the same type and\nkind as **array**.\n\n### **Examples**\n\nsample program:\n```fortran\nprogram demo_minval\nimplicit none\ninteger :: i\ncharacter(len=:),allocatable :: strs(:)\ncharacter(len=*),parameter :: g='(3x,*(g0,1x))'\n\ninteger,save :: ints(3,5)= reshape([&\n 1, -2, 3, 4, 5, &\n 10, 20, -30, 40, 50, &\n 11, 22, 33, -44, 55 &\n],shape(ints),order=[2,1])\n\ninteger,save :: box(3,5,2)\n\n box(:,:,1)=ints\n box(:,:,2)=-ints\n\n write(*,*)'Given the array'\n write(*,'(1x,*(g4.4,1x))') &\n & (ints(i,:),new_line('a'),i=1,size(ints,dim=1))\n\n write(*,*)'What is the smallest element in the array?'\n write(*,g) minval(ints),'at <',minloc(ints),'>'\n\n write(*,*)'What is the smallest element in each column?'\n write(*,g) minval(ints,dim=1)\n\n write(*,*)'What is the smallest element in each row?'\n write(*,g) minval(ints,dim=2)\n\n ! notice the shape of the output has less columns\n ! than the input in this case\n write(*,*)'What is the smallest element in each column,'\n write(*,*)'considering only those elements that are'\n write(*,*)'greater than zero?'\n write(*,g) minval(ints, dim=1, mask = ints > 0)\n\n write(*,*)&\n & 'if everything is false a zero-sized array is NOT returned'\n write(*,*) minval(ints, dim=1, mask = .false.)\n write(*,*)'even for a zero-sized input'\n write(*,g) minval([integer ::], dim=1, mask = .false.)\n\n write(*,*)'a scalar answer for everything false is huge()'\n write(*,g) minval(ints, mask = .false.)\n write(*,g) minval([integer ::], mask = .false.)\n\n print *, 'if zero-size character array all dels if ASCII'\n strs=[character(len=5)::]\n strs=minval(strs)\n print g, ichar([(strs(i),i=1,len(strs))])\n\n write(*,*)'some calls with three dimensions'\n write(*,g) minval(box, mask = .true. )\n write(*,g) minval(box, dim=1, mask = .true. )\n\n write(*,g) minval(box, dim=2, mask = .true. )\n write(*,g) 'shape of answer is ', &\n & shape(minval(box, dim=2, mask = .true. ))\n\nend program demo_minval\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**min**(3)](#min),\n[**minloc**(3)](#minloc)\n[**maxloc**(3)](#maxloc),\n[**maxval**(3)](#maxval),\n[**min**(3)](#min)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MOD": "## mod\n\n### **Name**\n\n**mod** - \\[NUMERIC\\] Remainder function\n\n### **Synopsis**\n```fortran\n result = mod(a, p)\n```\n```fortran\n elemental type(TYPE(kind=KIND)) function mod(a,p)\n\n type(TYPE(kind=KIND)),intent(in) :: a\n type(TYPE(kind=KIND)),intent(in) :: p\n```\n### **Characteristics**\n\n - The result and arguments are all of the same type and kind.\n - The type may be any kind of _real_ or _integer_.\n\n### **Description**\n\n**mod** computes the remainder of the division of **a** by **p**.\n\n In mathematics, the remainder is the amount \"left over\" after\n performing some computation. In arithmetic, the remainder is the\n integer \"left over\" after dividing one integer by another to produce\n an integer quotient (integer division). In algebra of polynomials, the\n remainder is the polynomial \"left over\" after dividing one polynomial\n by another. The modulo operation is the operation that produces such\n a remainder when given a dividend and divisor.\n\n - (remainder). (2022, October 10). In Wikipedia.\n https://en.wikipedia.org/wiki/Remainder\n\n### **Options**\n\n- **a**\n : The dividend\n\n- **p**\n : the divisor (not equal to zero).\n\n### **Result**\n\n The return value is the result of **a - (int(a/p) \\* p)**.\n\n As can be seen by the formula the sign of **p** is canceled out.\n Therefore the returned value always has the sign of **a**.\n\n Of course, the magnitude of the result will be less than the magnitude\n of **p**, as the result has been reduced by all multiples of **p**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_mod\nimplicit none\n\n ! basics\n print *, mod( -17, 3 ), modulo( -17, 3 )\n print *, mod( 17, -3 ), modulo( 17, -3 )\n print *, mod( 17, 3 ), modulo( 17, 3 )\n print *, mod( -17, -3 ), modulo( -17, -3 )\n\n print *, mod(-17.5, 5.2), modulo(-17.5, 5.2)\n print *, mod( 17.5,-5.2), modulo( 17.5,-5.2)\n print *, mod( 17.5, 5.2), modulo( 17.5, 5.2)\n print *, mod(-17.5,-5.2), modulo(-17.5,-5.2)\n\n ! with a divisor of 1 the fractional part is returned\n print *, mod(-17.5, 1.0), modulo(-17.5, 1.0)\n print *, mod( 17.5,-1.0), modulo( 17.5,-1.0)\n print *, mod( 17.5, 1.0), modulo( 17.5, 1.0)\n print *, mod(-17.5,-1.0), modulo(-17.5,-1.0)\n\nend program demo_mod\n```\nResults:\n```text\n -2 1\n 2 -1\n 2 2\n -2 -2\n -1.900001 3.299999\n 1.900001 -3.299999\n 1.900001 1.900001\n -1.900001 -1.900001\n -0.5000000 0.5000000\n 0.5000000 -0.5000000\n 0.5000000 0.5000000\n -0.5000000 -0.5000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n - [**modulo**(3)](#modulo) - Modulo function\n - [**aint**(3)](#aint) - truncate toward zero to a whole _real_ number\n - [**int**(3)](#int) - truncate toward zero to a whole _integer_ number\n - [**anint**(3)](#anint) - _real_ nearest whole number\n - [**nint**(3)](#nint) - _integer_ nearest whole number\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MODULO": "## modulo\n\n### **Name**\n\n**modulo** - \\[NUMERIC\\] Modulo function\n\n### **Synopsis**\n```fortran\n result = modulo(a, p)\n```\n```fortran\n elemental TYPE(kind=KIND) function modulo(a,p)\n\n TYPE(kind=KIND),intent(in) :: a\n TYPE(kind=KIND),intent(in) :: p\n```\n### **Characteristics**\n\n - **a** may be any kind of _real_ or _integer_.\n - **p** is the same type and kind as **a**\n - The result and arguments are all of the same type and kind.\n\n### **Description**\n\n**modulo** computes the **a** modulo **p**.\n\n### **Options**\n\n- **a**\n : the value to take the **modulo** of\n\n- **p**\n : The value to reduce **a** by till the remainder is <= **p**.\n It shall not be zero.\n\n### **Result**\n\nThe type and kind of the result are those of the arguments.\n\n- If **a** and **p** are of type _integer_: **modulo(a,p)** has the value of\n **a - floor (real(a) / real(p)) \\* p**.\n\n- If **a** and **p** are of type _real_: **modulo(a,p)** has the value of\n **a - floor (a / p) \\* p**.\n\nThe returned value has the same sign as **p** and a magnitude less than the\nmagnitude of **p**.\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_modulo\nimplicit none\n print *, modulo(17,3) ! yields 2\n print *, modulo(17.5,5.5) ! yields 1.0\n\n print *, modulo(-17,3) ! yields 1\n print *, modulo(-17.5,5.5) ! yields 4.5\n\n print *, modulo(17,-3) ! yields -1\n print *, modulo(17.5,-5.5) ! yields -4.5\nend program demo_modulo\n```\nResults:\n```text\n > 2\n > 1.000000\n > 1\n > 4.500000\n > -1\n > -4.500000\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**mod**(3)](#mod)\n\n _Fortran intrinsic descriptions_\n", "MOVE_ALLOC": "## move_alloc\n\n### **Name**\n\n**move_alloc** - \\[MEMORY\\] Move allocation from one object to another\n\n### **Synopsis**\n```fortran\n call move_alloc(from, to [,stat] [,errmsg] )\n```\n```fortran\n subroutine move_alloc(from, to)\n\n type(TYPE(kind=**)),intent(inout),allocatable :: from(..)\n type(TYPE(kind=**)),intent(out),allocatable :: to(..)\n integer(kind=**),intent(out) :: stat\n character(len=*),intent(inout) :: errmsg\n```\n### **Characteristics**\n\n- **from** may be of any type and kind.\n- **to** shall be of the same type, kind and rank as **from**.\n\n### **Description**\n\n**move_alloc** moves the allocation from **from** to\n**to**. **from** will become deallocated in the process.\n\nThis is potentially more efficient than other methods of assigning\nthe values in **from** to **to** and explicitly deallocating **from**,\nwhich are far more likely to require a temporary object or a copy of\nthe elements of the array.\n\n### **Options**\n\n- **from**\n : The data object to be moved to **to** and deallocated.\n\n- **to**\n : The destination data object to move the allocated data object **from**\n to. Typically, it is a different shape than **from**.\n\n- **stat**\n : If **stat** is present and execution is successful, it is assigned the\n value zero.\n\n : If an error condition occurs,\n\n o if **stat** is absent, error termination is initiated;\n o otherwise, if **from** is a coarray and the current team contains a\n stopped image, **stat** is assigned the value STAT\\_STOPPED\\_IMAGE\n from the intrinsic module ISO\\_FORTRAN\\_ENV;\n o otherwise, if **from** is a coarray and the current team contains\n a failed image, and no other error condition\n occurs, **stat** is assigned the value STAT\\_FAILED\\_IMAGE from the\n intrinsic module ISO\\_FORTRAN\\_ENV;\n o otherwise, **stat** is assigned a processor-dependent positive value\n that differs from that of STAT\\_STOPPED\\_IMAGE or STAT\\_FAILED\\_IMAGE.\n\n- **errmsg**\n : If the **errmsg** argument is present and an error condition occurs,\n it is assigned an explanatory message. If no error condition occurs,\n the definition status and value of **errmsg** are unchanged.\n\n### **Examples**\n\nBasic sample program to allocate a bigger grid\n\n```fortran\nprogram demo_move_alloc\nimplicit none\n! Example to allocate a bigger GRID\nreal, allocatable :: grid(:), tempgrid(:)\ninteger :: n, i\n\n ! initialize small GRID\n n = 3\n allocate (grid(1:n))\n grid = [ (real (i), i=1,n) ]\n\n ! initialize TEMPGRID which will be used to replace GRID\n allocate (tempgrid(1:2*n)) ! Allocate bigger grid\n tempgrid(::2) = grid ! Distribute values to new locations\n tempgrid(2::2) = grid + 0.5 ! initialize other values\n\n ! move TEMPGRID to GRID\n call MOVE_ALLOC (from=tempgrid, to=grid)\n\n ! TEMPGRID should no longer be allocated\n ! and GRID should be the size TEMPGRID was\n if (size (grid) /= 2*n .or. allocated (tempgrid)) then\n print *, \"Failure in move_alloc!\"\n endif\n print *, allocated(grid), allocated(tempgrid)\n print '(99f8.3)', grid\nend program demo_move_alloc\n```\n\nResults:\n\n```text\n T F\n 1.000 1.500 2.000 2.500 3.000 3.500\n```\n\n### **Standard**\n\nFortran 2003, STAT and ERRMSG options added 2018\n\n### **See Also**\n\n[**allocated**(3)](#allocated)\n\n _Fortran intrinsic descriptions_\n\n", @@ -158,7 +158,7 @@ "NULL": "## null\n\n### **Name**\n\n**null** - \\[TRANSFORMATIONAL\\] Function that returns a disassociated pointer\n\n### **Synopsis**\n```fortran\n ptr => null( [mold] )\n```\n```fortran\n function null(mold)\n\n type(TYPE(kind=**)),pointer,optional :: mold\n```\n### **Characteristics**\n\n- **mold** is a pointer of any association status and of any type.\n- The result is a disassociated pointer or an unallocated allocatable entity.\n\n### **Description**\n\n **null** returns a disassociated pointer.\n\n If **mold** is present, a disassociated pointer of the same type is\n returned, otherwise the type is determined by context.\n\n In _Fortran 95_, **mold** is optional. Please note that _Fortran 2003_\n includes cases where it is required.\n\n### **Options**\n\n- **mold**\n : a pointer of any association status and of any\n type.\n\n### **Result**\n\n A disassociated pointer or an unallocated allocatable entity.\n\n### **Examples**\n\nSample program:\n\n```fortran\n!program demo_null\nmodule showit\nimplicit none\nprivate\ncharacter(len=*),parameter :: g='(*(g0,1x))'\npublic gen\n! a generic interface that only differs in the\n! type of the pointer the second argument is\ninterface gen\n module procedure s1\n module procedure s2\nend interface\n\ncontains\n\nsubroutine s1 (j, pi)\n integer j\n integer, pointer :: pi\n if(associated(pi))then\n write(*,g)'Two integers in S1:,',j,'and',pi\n else\n write(*,g)'One integer in S1:,',j\n endif\nend subroutine s1\n\nsubroutine s2 (k, pr)\n integer k\n real, pointer :: pr\n if(associated(pr))then\n write(*,g)'integer and real in S2:,',k,'and',pr\n else\n write(*,g)'One integer in S2:,',k\n endif\nend subroutine s2\n\nend module showit\n\nprogram demo_null\nuse showit, only : gen\n\nreal,target :: x = 200.0\ninteger,target :: i = 100\n\nreal, pointer :: real_ptr\ninteger, pointer :: integer_ptr\n\n! so how do we call S1() or S2() with a disassociated pointer?\n\n! the answer is the null() function with a mold value\n\n! since s1() and s2() both have a first integer\n! argument the NULL() pointer must be associated\n! to a real or integer type via the mold option\n! so the following can distinguish whether s1(1)\n! or s2() is called, even though the pointers are\n! not associated or defined\n\ncall gen (1, null (real_ptr) ) ! invokes s2\ncall gen (2, null (integer_ptr) ) ! invokes s1\nreal_ptr => x\ninteger_ptr => i\ncall gen (3, real_ptr ) ! invokes s2\ncall gen (4, integer_ptr ) ! invokes s1\n\nend program demo_null\n```\nResults:\n```text\n One integer in S2:, 1\n One integer in S1:, 2\n integer and real in S2:, 3 and 200.000000\n Two integers in S1:, 4 and 100\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**associated**(3)](#associated)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "NUM_IMAGES": "## num_images\n\n### **Name**\n\n**num_images** - \\[COLLECTIVE\\] Number of images\n\n### **Synopsis**\n```fortran\n result = num_images([team|team_number])\n```\n```fortran\n integer function num_images (team)\n\n type(TEAM_TYPE),intent(in),optional :: team\n integer(kind=KIND),intent(in),optional :: team_number\n```\n### **Characteristics**\n\n - use of **team** and **team_number** is mutually exclusive\n - **team** is a scalar of type **TEAM_TYPE** from the intrinsic module ISO_FORTRAN_ENV.\n - **team_number** is an _integer_ scalar.\n - the result is a default _integer_ scalar.\n\n### **Description**\n\n**num_images** Returns the number of images.\n\n### **Options**\n\n- **team**\n : shall be a scalar of type TEAM_TYPE from the intrinsic module\n ISO_FORTRAN_ENV, with a value that identifies the current or an\n ancestor team.\n\n- **team_number**\n : identifies the initial team or a team whose parent is the same as\n that of the current team.\n\n### **Result**\n\n The number of images in the specified team, or in the current team if\n no team is specified.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_num_images\nimplicit none\ninteger :: value[*]\nreal :: p[*]\ninteger :: i\n\n value = this_image()\n sync all\n if (this_image() == 1) then\n do i = 1, num_images()\n write(*,'(2(a,i0))') 'value[', i, '] is ', value[i]\n end do\n endif\n\n ! The following code uses image 1 to read data and\n ! broadcast it to other images.\n if (this_image()==1) then\n p=1234.5678\n do i = 2, num_images()\n p[i] = p\n end do\n end if\n sync all\n\nend program demo_num_images\n```\n### **Standard**\n\nFortran 2008 . With DISTANCE or FAILED argument, TS 18508\n\n### **See Also**\n\n[**this_image**(3)](#this_image),\n[**image_index**(3)](#this_index)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "OUT_OF_RANGE": "## out_of_range\n\n### **Name**\n\n**out_of_range** - \\[TYPE:NUMERIC\\] Whether a numeric value can be\nconverted safely to another type\n\n### **Synopsis**\n```fortran\n result = out_of_range (x, mold [, round])\n```\n```fortran\n elemental logical function(x, mold, round)\n\n type(TYPE(kind=**)),intent(in) :: x\n type(TYPE(kind=**)),intent(in) :: mold\n logical,intent(in),optional :: round\n```\n### **Characteristics**\n\n - **x** is of type _integer_ or _real_.\n - **mold** is an _integer_ or _real_ scalar.\n - **round** is a _logical_ scalar.\n - the result is a default _logical_.\n\n### **Description**\n\n **out_of_range** determines whether a value **x** can be converted\n safely to a _real_ or _integer_ variable the same type and kind\n as **mold**.\n\n For example, if **int8** is the __kind__ name for an 8-bit binary integer type,\n then for\n```fortran\n logical :: L1, L2\n L1=out_of_range(-128.5, 0_int8)\n L2=out_of_range(-128.5, 0_int8,.true.)\n end\n```\n L1 likely will have the value __.false.__ because the value will\n be truncated to -128.0, which is a representable integer number on a two's\n complement machine.\n\n L2 will be __.true.__ because it will be rounded to -129.0, which is not\n likely to be a representable eight-bit integer.\n\n### **Options**\n - **x**\n : a scalar to be tested for whether it can be stored in a variable\n of the type and kind of **mold**\n\n - **mold**\n : the type and kind of the variable (but not the value) is used to\n identify the characteristics of the variable type to fit **x** into.\n\n - **round**\n : flag whether to round the value of **x** before validating it as\n a value like **mold**.\n\n **round** can only be present if **x** is of type\n _real_ and **mold** is of type _integer_.\n\n### **Result**\n\nFrom the standard:\n\n Case (i): If **mold** is of type integer, and **round** is absent or\n present with the value false, the result is true\n if and only if the value of X is an IEEE infinity or\n NaN, or if the integer with largest magnitude that lies\n between zero and X inclusive is not representable by\n objects with the type and kind of **mold**.\n\n Case (ii): If **mold** is of type integer, and **round** is present with\n the value true, the result is true if and only\n if the value of X is an IEEE infinity or NaN, or\n if the integer nearest X, or the integer of greater\n magnitude if two integers are equally near to X, is not\n representable by objects with the type and kind of **mold**.\n\n Case (iii): Otherwise, the result is true if and only if the value\n of X is an IEEE infinity or NaN that is not\n supported by objects of the type and kind of **mold**,\n or if X is a finite number and the result of rounding\n the value of X (according to the IEEE rounding mode if\n appropriate) to the extended model for the kind of **mold**\n has magnitude larger than that of the largest finite\n number with the same sign as X that is representable\n by objects with the type and kind of **mold**.\n\n NOTE\n\n **mold** is required to be a scalar because the only information\n taken from it is its type and kind. Allowing an array **mold** would\n require that it be conformable with **x**. **round** is scalar because\n allowing an array rounding mode would have severe performance\n difficulties on many processors.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_out_of_range\nuse, intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\ninteger :: i\ninteger(kind=int8) :: i8, j8\n\n ! compilers are not required to produce an error on out of range.\n ! here storing the default integers into 1-byte integers\n ! incorrectly can have unexpected results\n do i=127,130\n i8=i\n j8=-i\n ! OUT_OF_RANGE(3) can let you check if the value will fit\n write(*,*)i8,j8,' might have expected',i,-i, &\n & out_of_range( i,i8), &\n & out_of_range(-i,i8)\n enddo\n write(*,*) 'RANGE IS ',-1-huge(0_int8),'TO',huge(0_int8)\n ! the real -128.5 is truncated to -128 and is in range\n write(*,*) out_of_range ( -128.5, 0_int8) ! false\n\n ! the real -128.5 is rounded to -129 and is not in range\n write(*,*) out_of_range ( -128.5, 0_int8, .true.) ! true\n\nend program demo_out_of_range\n```\nResults:\n```text\n > 127 -127 might have expected 127 -127 F F\n > -128 -128 might have expected 128 -128 T F\n > -127 127 might have expected 129 -129 T T\n > -126 126 might have expected 130 -130 T T\n > RANGE IS -128 TO 127\n > F\n > T\n```\n### **Standard**\n\n FORTRAN 2018\n\n### **See also**\n\n- [**aimag**(3)](#aimag) - Imaginary part of complex number\n- [**cmplx**(3)](#cmplx) - Convert values to a complex type\n- [**dble**(3)](#dble) - Double conversion function\n- [**int**(3)](#int) - Truncate towards zero and convert to integer\n- [**nint**(3)](#nint) - Nearest whole number\n- [**real**(3)](#real) - Convert to real type\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "PACK": "## pack\n\n### **Name**\n\n**pack** - \\[ARRAY:CONSTRUCTION\\] Pack an array into an array of rank one\n\n### **Synopsis**\n```fortran\n result = pack( array, mask [,vector] )\n```\n```fortran\n TYPE(kind=KIND) function pack(array,mask,vector)\n\n TYPE(kind=KIND),option(in) :: array(..)\n logical :: mask(..)\n TYPE(kind=KIND),option(in),optional :: vector(*)\n```\n### **Characteristics**\n\n - **array** is an array of any type\n - **mask** a _logical_ scalar as well as an array conformable with **array**.\n - **vector** is of the same kind and type as **array** and of rank one\n - the returned value is of the same kind and type as **array**\n\n### **Description**\n\n **pack** stores the elements of **array** in an array of rank one.\n\n The beginning of the resulting array is made up of elements whose\n **mask** equals _.true._. Afterwards, remaining positions are filled with elements\n taken from **vector**\n\n### **Options**\n\n- **array**\n : The data from this array is used to fill the resulting vector\n\n- **mask**\n : the _logical_ mask must be the same size as **array** or,\n alternatively, it may be a _logical_ scalar.\n\n- **vector**\n : an array of the same type as **array** and of rank\n one. If present, the number of elements in **vector** shall be equal to\n or greater than the number of true elements in **mask**. If **mask** is\n scalar, the number of elements in **vector** shall be equal to or\n greater than the number of elements in **array**.\n\n**vector** shall have at least as many elements as there are in **array**.\n\n### **Result**\n\nThe result is an array of rank one and the same type as that of **array**.\nIf **vector** is present, the result size is that of **vector**, the number of\n_.true._ values in **mask** otherwise.\n\nIf **mask** is scalar with the value _.true._, in which case the result\nsize is the size of **array**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_pack\nimplicit none\ninteger, allocatable :: m(:)\ncharacter(len=10) :: c(4)\n\n ! gathering nonzero elements from an array:\n m = [ 1, 0, 0, 0, 5, 0 ]\n write(*, fmt=\"(*(i0, ' '))\") pack(m, m /= 0)\n\n ! Gathering nonzero elements from an array and appending elements\n ! from VECTOR till the size of the mask array (or array size if the\n ! mask is scalar):\n m = [ 1, 0, 0, 2 ]\n write(*, fmt=\"(*(i0, ' '))\") pack(m, m /= 0, [ 0, 0, 3, 4 ])\n write(*, fmt=\"(*(i0, ' '))\") pack(m, m /= 0 )\n\n ! select strings whose second character is \"a\"\n c = [ character(len=10) :: 'ape', 'bat', 'cat', 'dog']\n write(*, fmt=\"(*(g0, ' '))\") pack(c, c(:)(2:2) == 'a' )\n\nend program demo_pack\n```\nResults:\n```text\n > 1 5\n > 1 2 3 4\n > 1 2\n > bat cat\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**merge**(3)](#merge),\n[**spread**(3)](#spread),\n[**unpack**(3)](#unpack)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", + "PACK": "## pack\n\n### **Name**\n\n**pack** - \\[ARRAY:CONSTRUCTION\\] Pack an array into an array of rank one\n\n### **Synopsis**\n```fortran\n result = pack( array, mask [,vector] )\n```\n```fortran\n TYPE(kind=KIND) function pack(array,mask,vector)\n\n TYPE(kind=KIND),option(in) :: array(..)\n logical :: mask(..)\n TYPE(kind=KIND),option(in),optional :: vector(*)\n```\n### **Characteristics**\n\n - **array** is an array of any type\n - **mask** a _logical_ scalar as well as an array conformable with **array**.\n - **vector** is of the same kind and type as **array** and of rank one\n - the returned value is of the same kind and type as **array**\n\n### **Description**\n\n **pack** stores the elements of **array** in an array of rank one.\n\n The beginning of the resulting array is made up of elements whose\n **mask** equals _.true._. Afterwards, remaining positions are filled with elements\n taken from **vector**\n\n### **Options**\n\n- **array**\n : The data from this array is used to fill the resulting vector\n\n- **mask**\n : the _logical_ mask must be the same size as **array** or,\n alternatively, it may be a _logical_ scalar.\n\n- **vector**\n : an array of the same type as **array** and of rank\n one. If present, the number of elements in **vector** shall be equal to\n or greater than the number of true elements in **mask**. If **mask** is\n scalar, the number of elements in **vector** shall be equal to or\n greater than the number of elements in **array**.\n\n**vector** shall have at least as many elements as there are in **array**.\n\n### **Result**\n\nThe result is an array of rank one and the same type as that of **array**.\nIf **vector** is present, the result size is that of **vector**, the number of\n_.true._ values in **mask** otherwise.\n\nIf **mask** is scalar with the value _.true._, in which case the result\nsize is the size of **array**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_pack\nimplicit none\ninteger, allocatable :: m(:)\ncharacter(len=10) :: c(4)\n\n ! gathering nonzero elements from an array:\n m = [ 1, 0, 0, 0, 5, 0 ]\n write(*, fmt=\"(*(i0, ' '))\") pack(m, m /= 0)\n\n ! Gathering nonzero elements from an array and appending elements\n ! from VECTOR till the size of the mask array (or array size if the\n ! mask is scalar):\n m = [ 1, 0, 0, 2 ]\n write(*, fmt=\"(*(i0, ' '))\") pack(m, m /= 0, [ 0, 0, 3, 4 ])\n write(*, fmt=\"(*(i0, ' '))\") pack(m, m /= 0 )\n\n ! select strings whose second character is \"a\"\n c = [ character(len=10) :: 'ape', 'bat', 'cat', 'dog']\n write(*, fmt=\"(*(g0, ' '))\") pack(c, c(:)(2:2) == 'a' )\n\n ! creating a quicksort using PACK(3f)\n BLOCK\n INTRINSIC RANDOM_SEED, RANDOM_NUMBER\n REAL :: x(10)\n CALL RANDOM_SEED()\n CALL RANDOM_NUMBER(x)\n WRITE (*,\"(a10,*(1x,f0.3))\") \"initial\",x\n WRITE (*,\"(a10,*(1x,f0.3))\") \"sorted\",qsort(x)\n ENDBLOCK\nCONTAINS\n! concise quicksort from @arjen and @beliavsky shows recursion,\n! array sections, and vectorized comparisons. \nPURE RECURSIVE FUNCTION qsort(values) RESULT(sorted)\nINTRINSIC PACK, SIZE\nREAL, INTENT(IN) :: values(:)\nREAL :: sorted(SIZE(values))\n IF (SIZE(values) > 1) THEN\n sorted = [qsort(PACK(values(2:),values(2:)=values(1)))]\n ELSE\n sorted = values\n ENDIF\nEND FUNCTION qsort\nend program demo_pack\n```\nResult:\n```text\n > 1 5 \n > 1 2 3 4 \n > 1 2 \n > bat cat \n > initial .833 .367 .958 .454 .122 .602 .418 .942 .566 .400\n > sorted .122 .367 .400 .418 .454 .566 .602 .833 .942 .958\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**merge**(3)](#merge),\n[**spread**(3)](#spread),\n[**unpack**(3)](#unpack)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "PARITY": "## parity\n\n### **Name**\n\n**parity** - \\[ARRAY:REDUCTION\\] Array reduction by .NEQV. operation\n\n### **Synopsis**\n```fortran\n result = parity( mask [,dim] )\n```\n```fortran\n logical(kind=KIND) function parity(mask, dim)\n\n type(logical(kind=KIND)),intent(in) :: mask(..)\n type(integer(kind=**)),intent(in),optional :: dim\n```\n### **Characteristics**\n\n - **mask** is a _logical_ array\n - **dim** is an integer scalar\n - the result is of type _logical_ with the same kind type parameter as **mask**.\n It is a scalar if **dim** does not appear; otherwise it is the rank and shape\n of **mask** with the dimension specified by **dim** removed.\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**parity** calculates the parity array (i.e. the reduction using .neqv.) of\n**mask** along dimension **dim** if **dim** is present and not 1. Otherwise, it\nreturns the parity of the entire **mask** array as a scalar.\n\n### **Options**\n\n - **mask**\n : Shall be an array of type _logical_.\n\n - **dim**\n : (Optional) shall be a scalar of type _integer_ with a value in the\n range from _1 to n_, where _n_ equals the rank of **mask**.\n\n### **Result**\n\n The result is of the same type as **mask**.\n\n If **dim** is absent, a scalar with the parity of all elements in **mask**\n is returned: _.true._ if an odd number of elements are _.true._\n and _.false._ otherwise.\n\n If MASK has rank one, PARITY (MASK, DIM) is equal to PARITY (MASK). Otherwise, the\n result is an array of parity values with dimension **dim** dropped.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_parity\nimplicit none\nlogical, parameter :: T=.true., F=.false.\nlogical :: x(3,4)\n ! basics\n print *, parity([T,F])\n print *, parity([T,F,F])\n print *, parity([T,F,F,T])\n print *, parity([T,F,F,T,T])\n x(1,:)=[T,T,T,T]\n x(2,:)=[T,T,T,T]\n x(3,:)=[T,T,T,T]\n print *, parity(x)\n print *, parity(x,dim=1)\n print *, parity(x,dim=2)\nend program demo_parity\n```\nResults:\n```text\n > T\n > T\n > F\n > T\n > F\n > T T T T\n > F F F\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n - [**all**(3)](#all) - Determines if all the values are true\n - [**any**(3)](#any) - Determines if any of the values in the logical array are _.true._\n - [**count**(3)](#count) - Count true values in an array\n - [**sum**(3)](#sum) - Sum the elements of an array\n - [**maxval**(3)](#maxval) - Determines the maximum value in an array or row\n - [**minval**(3)](#minval) - Minimum value of an array\n - [**product**(3)](#product) - Product of array elements\n - [**reduce**(3)](#reduce) - General array reduction\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "POPCNT": "## popcnt\n\n### **Name**\n\n**popcnt** - \\[BIT:COUNT\\] Number of bits set\n\n### **Synopsis**\n```fortran\n result = popcnt(i)\n```\n```fortran\n elemental integer function popcnt(i)\n\n integer(kind=KIND), intent(in) :: i\n```\n### **Characteristics**\n\n- **i** may be an _integer_ of any kind.\n- The return value is an _integer_ of the default integer kind.\n\n### **Description**\n\n **popcnt** returns the number of bits set to one in the binary\n representation of an _integer_.\n\n### **Options**\n\n- **i**\n : value to count set bits in\n\n### **Result**\n\nThe number of bits set to one in **i**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_popcnt\nuse, intrinsic :: iso_fortran_env, only : integer_kinds, &\n & int8, int16, int32, int64\nimplicit none\ncharacter(len=*),parameter :: pretty='(b64,1x,i0)'\n ! basic usage\n print pretty, 127, popcnt(127)\n print pretty, int(b\"01010\"), popcnt(int(b\"01010\"))\n\n ! any kind of an integer can be used\n print pretty, huge(0_int8), popcnt(huge(0_int8))\n print pretty, huge(0_int16), popcnt(huge(0_int16))\n print pretty, huge(0_int32), popcnt(huge(0_int32))\n print pretty, huge(0_int64), popcnt(huge(0_int64))\nend program demo_popcnt\n```\nResults:\n\nNote that on most machines the first bit is the sign bit, and a zero is\nused for positive values; but that this is system-dependent. These are\ntypical values, where the huge(3) function has set all but the first\nbit to 1.\n```text\n > 1111111 7\n > 1010 2\n > 1111111 7\n > 111111111111111 15\n > 1111111111111111111111111111111 31\n > 111111111111111111111111111111111111111111111111111111111111111 63\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nThere are many procedures that operator or query values at the bit level:\n\n[**poppar**(3)](#poppar),\n[**leadz**(3)](#leadz),\n[**trailz**(3)](#trailz)\n[**atomic_and**(3)](#atomic_and),\n[**atomic_fetch_and**(3)](#atomic_fetch_and),\n[**atomic_fetch_or**(3)](#atomic_fetch_or),\n[**atomic_fetch_xor**(3)](#atomic_fetch_xor),\n[**atomic_or**(3)](#atomic_or),\n[**atomic_xor**(3)](#atomic_xor),\n[**bge**(3)](#bge),\n[**bgt**(3)](#bgt),\n[**bit_size**(3)](#bit_size),\n[**ble**(3)](#ble),\n[**blt**(3)](#blt),\n[**btest**(3)](#btest),\n[**dshiftl**(3)](#dshiftl),\n[**dshiftr**(3)](#dshiftr),\n[**iall**(3)](#iall),\n[**iand**(3)](#iand),\n[**iany**(3)](#iany),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**iparity**(3)](#iparity),\n[**ishftc**(3)](#ishftc),\n[**ishft**(3)](#ishft),\n[**maskl**(3)](#maskl),\n[**maskr**(3)](#maskr),\n[**merge_bits**(3)](#merge_bits),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not),\n[**shifta**(3)](#shifta),\n[**shiftl**(3)](#shiftl),\n[**shiftr**(3)](#shiftr),\n[**storage_size**(3)](#storage_size)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "POPPAR": "## poppar\n\n### **Name**\n\n**poppar** - \\[BIT:COUNT\\] Parity of the number of bits set\n\n### **Synopsis**\n```fortran\n result = poppar(i)\n```\n```fortran\n elemental integer function poppar(i)\n\n integer(kind=KIND), intent(in) :: i\n```\n### **Characteristics**\n\n- **i** is an _integer_ of any kind\n- the return value is a default kind _integer_\n\n### **Description**\n\n **poppar** returns the parity of an integer's binary representation\n (i.e., the parity of the number of bits set).\n\n The parity is expressed as\n\n + **0** (zero) if **i** has an even number of bits set to **1**.\n + **1** (one) if the number of bits set to one **1** is odd,\n\n### **Options**\n\n- **i**\n : The value to query for its bit parity\n\n### **Result**\n\n The return value is equal to **0** if **i** has an even number of bits\n set and **1** if an odd number of bits are set.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_poppar\nuse, intrinsic :: iso_fortran_env, only : integer_kinds, &\n & int8, int16, int32, int64\nimplicit none\ncharacter(len=*),parameter :: pretty='(b64,1x,i0)'\n ! basic usage\n print pretty, 127, poppar(127)\n print pretty, 128, poppar(128)\n print pretty, int(b\"01010\"), poppar(int(b\"01010\"))\n\n ! any kind of an integer can be used\n print pretty, huge(0_int8), poppar(huge(0_int8))\n print pretty, huge(0_int16), poppar(huge(0_int16))\n print pretty, huge(0_int32), poppar(huge(0_int32))\n print pretty, huge(0_int64), poppar(huge(0_int64))\nend program demo_poppar\n```\nResults:\n```text\n > 1111111 1\n > 10000000 1\n > 1010 0\n > 1111111111111111111111111111111 1\n > 1111111 1\n > 111111111111111 1\n > 1111111111111111111111111111111 1\n > 111111111111111111111111111111111111111111111111111111111111111 1\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nThere are many procedures that operator or query values at the bit level:\n\n[**popcnt**(3)](#popcnt),\n[**leadz**(3)](#leadz),\n[**trailz**(3)](#trailz)\n[**atomic_and**(3)](#atomic_and),\n[**atomic_fetch_and**(3)](#atomic_fetch_and),\n[**atomic_fetch_or**(3)](#atomic_fetch_or),\n[**atomic_fetch_xor**(3)](#atomic_fetch_xor),\n[**atomic_or**(3)](#atomic_or),\n[**atomic_xor**(3)](#atomic_xor),\n[**bge**(3)](#bge),\n[**bgt**(3)](#bgt),\n[**bit_size**(3)](#bit_size),\n[**ble**(3)](#ble),\n[**blt**(3)](#blt),\n[**btest**(3)](#btest),\n[**dshiftl**(3)](#dshiftl),\n[**dshiftr**(3)](#dshiftr),\n[**iall**(3)](#iall),\n[**iand**(3)](#iand),\n[**iany**(3)](#iany),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**iparity**(3)](#iparity),\n[**ishftc**(3)](#ishftc),\n[**ishft**(3)](#ishft),\n[**maskl**(3)](#maskl),\n[**maskr**(3)](#maskr),\n[**merge_bits**(3)](#merge_bits),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not),\n[**shifta**(3)](#shifta),\n[**shiftl**(3)](#shiftl),\n[**shiftr**(3)](#shiftr),\n[**storage_size**(3)](#storage_size)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", @@ -166,7 +166,7 @@ "PRESENT": "## present\n\n### **Name**\n\n**present** - [STATE:INQUIRY\\] Determine whether an optional dummy argument\nis specified\n\n### **Synopsis**\n```fortran\n result = present(a)\n```\n```fortran\n logical function present (a)\n\n type(TYPE(kind=KIND)) :: a(..)\n```\n### **Characteristics**\n\n- **a** May be of any type and may be a pointer, scalar or array value,\n or a dummy procedure.\n\n### **Description**\n\n **present** can be used in a procedure to determine if an optional\n dummy argument was present on the current call to the procedure.\n\n **a** shall be the name of an optional dummy argument that is accessible\n in the subprogram in which the **present** function reference\n appears. There are no other requirements on **a**.\n\n Note when an argument is not present when the current procedure is\n invoked, you may only pass it as an optional argument to another\n procedure or pass it as an argument to **present**.\n\n### **Options**\n\n- **a**\n : the name of an optional dummy argument accessible within the current\n subroutine or function.\n\n### **Result**\n\n Returns _.true._ if the optional argument **a** is present (was passed\n on the call to the procedure) , or _.false._ otherwise.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_present\nimplicit none\ninteger :: answer\n ! argument to func() is not present\n answer=func()\n write(*,*) answer\n ! argument to func() is present\n answer=func(1492)\n write(*,*) answer\ncontains\n!\ninteger function func(x)\n! the optional characteristic on this definition allows this variable\n! to not be specified on a call; and also allows it to subsequently\n! be passed to PRESENT(3):\ninteger, intent(in), optional :: x\ninteger :: x_local\n !\n ! basic\n if(present(x))then\n ! if present, you can use x like any other variable.\n x_local=x\n else\n ! if not, you cannot define or reference x except to\n ! pass it as an optional parameter to another procedure\n ! or in a call to present(3)\n x_local=0\n endif\n !\n func=x_local**2\n !\n ! passing the argument on to other procedures\n ! so something like this is a bad idea because x is used\n ! as the first argument to merge(3) when it might not be\n ! present\n ! xlocal=merge(x,0,present(x)) ! NO!!\n !\n ! We can pass it to another procedure if another\n ! procedure declares the argument as optional as well,\n ! or we have tested that X is present\n call tattle('optional argument x',x)\n if(present(x))call not_optional(x)\nend function\n!\nsubroutine tattle(label,arg)\ncharacter(len=*),intent(in) :: label\ninteger,intent(in),optional :: arg\n if(present(arg))then\n write(*,*)label,' is present'\n else\n write(*,*)label,' is not present'\n endif\nend subroutine tattle\n!\nsubroutine not_optional(arg)\ninteger,intent(in) :: arg\n write(*,*)'already tested X is defined',arg\nend subroutine not_optional\n!\nend program demo_present\n```\nResults:\n```text\n optional argument x is not present\n 0\n optional argument x is present\n already tested X is defined 1492\n 2226064\n```\n### **Standard**\n\nFortran 95\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "PRODUCT": "## product\n\n### **Name**\n\n**product** - \\[ARRAY:REDUCTION\\] Product of array elements\n\n### **Synopsis**\n```fortran\n result = product(array [,dim] [,mask])\n```\n```fortran\n NUMERIC function product(array, dim, mask)\n\n NUMERIC,intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **NUMERIC** is any numeric type and kind.\n\n### **Description**\n\n**product** multiplies together all the selected elements of **array**,\nor along dimension **dim** if the corresponding element in **mask**\nis _.true._.\n\nIf **dim** is absent, a scalar with the product of all elements in **array** is\nreturned. (Note a zero-sized **array** returns **1**).\n\nWhen **dim** is present, If the masked array has a dimension of one\n(ie. is a vector) the result is a scalar. Otherwise, an array of rank\n**n-1**, where **n** equals the rank of **array**, and a shape similar\nto that of **array** with dimension **dim** dropped is returned.\n\n### **Options**\n\n- **array**\n : Shall be an array of type _integer_, _real_ or _complex_.\n\n- **dim**\n : shall be a scalar of type _integer_ with a value in the\n range from **1 to n**, where **n** equals the rank of **array**.\n\n- **mask**\n : shall be of type _logical_ and either be a scalar or an\n array of the same shape as **array**.\n\n### **Result**\n\nThe result is of the same type as **array**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_product\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))' ! a handy format\ncharacter(len=1),parameter :: nl=new_line('a')\n\nNO_DIM: block\n! If DIM is not specified, the result is the product of all the\n! selected array elements.\ninteger :: i,n, p1, p2\ninteger,allocatable :: array(:)\n ! all elements are selected by default\n do n=1,10\n print all, 'factorial of ',n,' is ', product([(real(i),i=1,n)])\n enddo\n\n ! using a mask\n array=[10,12,13,15,20,25,30]\n p1=product(array, mask=mod(array, 2)==1) ! only odd elements\n p2=product(array, mask=mod(array, 2)/=1) ! only even elements\n print all, nl,'product of all elements',product(array) ! all elements\n print all, ' odd * even =',nl,p1,'*',p2,'=',p1*p2\n\n ! NOTE: If ARRAY is a zero-sized array, the result is equal to one\n print all\n print all, 'zero-sized array=>',product([integer :: ])\n ! NOTE: If nothing in the mask is true, this also results in a null\n ! array\n print all, 'all elements have a false mask=>', &\n & product(array,mask=.false.)\n\nendblock NO_DIM\n\nWITH_DIM: block\ninteger :: rect(2,3)\ninteger :: box(2,3,4)\n\n! lets fill a few arrays\n rect = reshape([ &\n 1, 2, 3, &\n 4, 5, 6 &\n ],shape(rect),order=[2,1])\n call print_matrix_int('rect',rect)\n\n! Find the product of each column in RECT.\n print all, 'product of columns=',product(rect, dim = 1)\n\n! Find the product of each row in RECT.\n print all, 'product of rows=',product(rect, dim = 2)\n\n! now lets try a box\n box(:,:,1)=rect\n box(:,:,2)=rect*(+10)\n box(:,:,3)=rect*(-10)\n box(:,:,4)=rect*2\n ! lets look at the values\n call print_matrix_int('box 1',box(:,:,1))\n call print_matrix_int('box 2',box(:,:,2))\n call print_matrix_int('box 3',box(:,:,3))\n call print_matrix_int('box 4',box(:,:,4))\n\n ! remember without dim= even a box produces a scalar\n print all, 'no dim gives a scalar',product(real(box))\n\n ! only one plane has negative values, so note all the \"1\" values\n ! for vectors with no elements\n call print_matrix_int('negative values', &\n & product(box,mask=box < 0,dim=1))\n\n! If DIM is specified and ARRAY has rank greater than one, the\n! result is a new array in which dimension DIM has been eliminated.\n\n ! pick a dimension to multiply though\n call print_matrix_int('dim=1',product(box,dim=1))\n\n call print_matrix_int('dim=2',product(box,dim=2))\n\n call print_matrix_int('dim=3',product(box,dim=3))\n\nendblock WITH_DIM\n\ncontains\n\nsubroutine print_matrix_int(title,arr)\nimplicit none\n\n!@(#) print small 2d integer arrays in row-column format\n\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n print all\n print all, trim(title),':(',shape(arr),')' ! print title\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\nend subroutine print_matrix_int\n\nend program demo_product\n```\n\nResults:\n\n```text\nfactorial of 1 is 1.000000\nfactorial of 2 is 2.000000\nfactorial of 3 is 6.000000\nfactorial of 4 is 24.00000\nfactorial of 5 is 120.0000\nfactorial of 6 is 720.0000\nfactorial of 7 is 5040.000\nfactorial of 8 is 40320.00\nfactorial of 9 is 362880.0\nfactorial of 10 is 3628800.\n\n product of all elements 351000000\n odd * even =\n 4875 * 72000 = 351000000\n\nzero-sized array=> 1\nall elements have a false mask=> 1\n\nrect :( 2 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\nproduct of columns= 4 10 18\nproduct of rows= 6 120\n\nbox 1 :( 2 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n\nbox 2 :( 2 3 )\n > [ 10, 20, 30 ]\n > [ 40, 50, 60 ]\n\nbox 3 :( 2 3 )\n > [ -10, -20, -30 ]\n > [ -40, -50, -60 ]\n\nbox 4 :( 2 3 )\n > [ 2, 4, 6 ]\n > [ 8, 10, 12 ]\nno dim gives a scalar .1719927E+26\n\nnegative values :( 3 4 )\n > [ 1, 1, 400, 1 ]\n > [ 1, 1, 1000, 1 ]\n > [ 1, 1, 1800, 1 ]\n\ndim=1 :( 3 4 )\n > [ 4, 400, 400, 16 ]\n > [ 10, 1000, 1000, 40 ]\n > [ 18, 1800, 1800, 72 ]\n\ndim=2 :( 2 4 )\n > [ 6, 6000, -6000, 48 ]\n > [ 120, 120000, -120000, 960 ]\n\ndim=3 :( 2 3 )\n > [ -200, -3200, -16200 ]\n > [ -51200, -125000, -259200 ]\n```\n\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**sum**(3)](#sum), note that an element by element multiplication is done\ndirectly using the star character.\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "RADIX": "## radix\n\n### **Name**\n\n**radix** - \\[NUMERIC MODEL\\] Base of a numeric model\n\n### **Synopsis**\n```fortran\n result = radix(x)\n```\n```fortran\n integer function radix(x)\n\n TYPE(kind=**),intent(in) :: x(..)\n```\n### **Characteristics**\n\n - **x** may be scalar or an array of any _real_ or _integer_ type.\n - the result is a default integer scalar.\n\n### **Description**\n\n **radix** returns the base of the internal model representing the\n numeric entity **x**.\n\n In a positional numeral system, the radix or base is the number of\n unique digits, including the digit zero, used to represent numbers.\n\n This function helps to represent the internal computing model\n generically, but will be 2 (representing a binary machine) for any\n common platform for all the numeric types.\n\n### **Options**\n\n- **x**\n : used to identify the type of number to query.\n\n### **Result**\n\n The returned value indicates what base is internally used to represent\n the type of numeric value **x** represents.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_radix\nimplicit none\n print *, \"The radix for the default integer kind is\", radix(0)\n print *, \"The radix for the default real kind is\", radix(0.0)\n print *, \"The radix for the doubleprecision real kind is\", radix(0.0d0)\nend program demo_radix\n```\nResults:\n```text\n > The radix for the default integer kind is 2\n > The radix for the default real kind is 2\n > The radix for the doubleprecision real kind is 2\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", - "RANDOM_INIT": "## random_init\n\n### **Name**\n\n**random_init** - \\[MATHEMATICS:RANDOM\\] Initializes the state of\nthe pseudorandom number generator\n\n### **Synopsis**\n```fortran\n call random_init(repeatable, image_distinct)\n\n logical,intent(in) :: repeatable\n logical,intent(in) :: image_distinct\n```\n### **Characteristics**\n\n- **harvest** and **image_distinct** are logical scalars\n\n### Description\n\nInitializes the state of the pseudorandom number generator used by\n**random_number**.\n\n### **Options**\n\n**repeatable**\n: If it is **.true.**, the seed is set to a processor-dependent\nvalue that is the same each time **random_init** is called from the\nsame image. The term \"same image\" means a single instance of program\nexecution. The sequence of random numbers is different for repeated\nexecution of the program.\n\nIf it is **.false.**, the seed is set to a processor-dependent value.\n\n**image_distinct**\n: If is `.true.`, the seed is set to a processor-dependent value that\nis distinct from the seed set by a call to **random_init**in another\nimage. If it is **.false.**, the seed is set value that does depend\nwhich image called **random_init**.\n\n\n### **Examples**\n\nSample program:\n\n```fortran\n program demo_random_init\n implicit none\n real x(3), y(3)\n call random_init(.true., .true.)\n call random_number(x)\n call random_init(.true., .true.)\n call random_number(y)\n ! x and y should be the same sequence\n if ( any(x /= y) ) stop \"x(:) and y(:) are not all equal\"\n end program demo_random_init\n```\n### **Standard**\n\nFortran 2018\n\n### **See also**\n\n[random_number](#random_number),\n[random_seed](random_seed)\n\n _Fortran intrinsic descriptions\n", + "RANDOM_INIT": "## random_init\n\n### **Name**\n\n**random_init** - \\[MATHEMATICS:RANDOM\\] Initializes the state of\nthe pseudorandom number generator\n\n### **Synopsis**\n```fortran\n call random_init(repeatable, image_distinct)\n\n logical,intent(in) :: repeatable\n logical,intent(in) :: image_distinct\n```\n### **Characteristics**\n\n- **harvest** and **image_distinct** are logical scalars\n\n### Description\n\nInitializes the state of the pseudorandom number generator used by\n**random_number**.\n\n### **Options**\n\n**repeatable**\n: If it is **.true.**, the seed is set to a processor-dependent\nvalue that is the same each time **random_init** is called from the\nsame image. The term \"same image\" means a single instance of program\nexecution. The sequence of random numbers is different for repeated\nexecution of the program.\n\nIf it is **.false.**, the seed is set to a processor-dependent value.\n\n**image_distinct**\n: If it is `.true.`, the seed is set to a processor-dependent value that\nis distinct from the seed set by a call to **random_init**in another\nimage. If it is **.false.**, the seed is set to a value that does depend\non which image called **random_init**.\n\n### **Examples**\n\nSample program:\n\n```fortran\n program demo_random_init\n implicit none\n real x(3), y(3)\n call random_init(.true., .true.)\n call random_number(x)\n call random_init(.true., .true.)\n call random_number(y)\n ! x and y should be the same sequence\n if ( any(x /= y) ) stop \"x(:) and y(:) are not all equal\"\n end program demo_random_init\n```\n### **Standard**\n\nFortran 2018\n\n### **See also**\n\n[random_number](#random_number),\n[random_seed](#random_seed)\n\n _Fortran intrinsic descriptions\n", "RANDOM_NUMBER": "## random_number\n\n### **Name**\n\n**random_number** - \\[MATHEMATICS:RANDOM\\] Pseudo-random number\n\n### **Synopsis**\n```fortran\n call random_number(harvest)\n```\n```fortran\n subroutine random_number(harvest)\n\n real,intent(out) :: harvest(..)\n```\n### **Characteristics**\n\n- **harvest** and the result are default _real_ variables\n\n### **Description**\n\n**random_number** returns a single pseudorandom number or an array of\npseudorandom numbers from the uniform distribution over the range\n0 \\<= x \\< 1.\n\n### **Options**\n\n- **harvest**\n : Shall be a scalar or an array of type _real_.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_random_number\nuse, intrinsic :: iso_fortran_env, only : dp=>real64\nimplicit none\ninteger, allocatable :: seed(:)\ninteger :: n\ninteger :: first,last\ninteger :: i\ninteger :: rand_int\ninteger,allocatable :: count(:)\nreal(kind=dp) :: rand_val\n call random_seed(size = n)\n allocate(seed(n))\n call random_seed(get=seed)\n first=1\n last=10\n allocate(count(last-first+1))\n ! To have a discrete uniform distribution on the integers\n ! [first, first+1, ..., last-1, last] carve the continuous\n ! distribution up into last+1-first equal sized chunks,\n ! mapping each chunk to an integer.\n !\n ! One way is:\n ! call random_number(rand_val)\n ! choose one from last-first+1 integers\n ! rand_int = first + FLOOR((last+1-first)*rand_val)\n count=0\n ! generate a lot of random integers from 1 to 10 and count them.\n ! with a large number of values you should get about the same\n ! number of each value\n do i=1,100000000\n call random_number(rand_val)\n rand_int=first+floor((last+1-first)*rand_val)\n if(rand_int.ge.first.and.rand_int.le.last)then\n count(rand_int)=count(rand_int)+1\n else\n write(*,*)rand_int,' is out of range'\n endif\n enddo\n write(*,'(i0,1x,i0)')(i,count(i),i=1,size(count))\nend program demo_random_number\n```\nResults:\n```\n 1 10003588\n 2 10000104\n 3 10000169\n 4 9997996\n 5 9995349\n 6 10001304\n 7 10001909\n 8 9999133\n 9 10000252\n 10 10000196\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**random_seed**(3)](#random_seed)\n\n _Fortran intrinsic descriptions_\n", "RANDOM_SEED": "## random_seed\n\n### **Name**\n\n**random_seed** - \\[MATHEMATICS:RANDOM\\] Initialize a pseudo-random number sequence\n\n### **Synopsis**\n```fortran\n call random_seed( [size] [,put] [,get] )\n```\n```fortran\n subroutine random_seed( size, put, get )\n\n integer,intent(out),optional :: size\n integer,intent(in),optional :: put(*)\n integer,intent(out),optional :: get(*)\n```\n### **Characteristics**\n - **size** a scalar default _integer_\n - **put** a rank-one default _integer_ array\n - **get** a rank-one default _integer_ array\n - the result\n\n### **Description**\n\n**random_seed** restarts or queries the state of the pseudorandom\nnumber generator used by random_number.\n\nIf random_seed is called without arguments, it is seeded with random\ndata retrieved from the operating system.\n\n### **Options**\n\n- **size**\n : specifies the minimum size of the arrays used with the **put**\n and **get** arguments.\n\n- **put**\n : the size of the array must be larger than or equal to the number\n returned by the **size** argument.\n\n- **get**\n : It is **intent(out)** and the size of the array must be larger than\n or equal to the number returned by the **size** argument.\n\n### **Examples**\n\nSample program:\n\n```fortran\n program demo_random_seed\n implicit none\n integer, allocatable :: seed(:)\n integer :: n\n\n call random_seed(size = n)\n allocate(seed(n))\n call random_seed(get=seed)\n write (*, *) seed\n\n end program demo_random_seed\n```\nResults:\n```text\n -674862499 -1750483360 -183136071 -317862567 682500039\n 349459 344020729 -1725483289\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**random_number**(3)](#random_number)\n\n _Fortran intrinsic descriptions_\n", "RANGE": "## range\n\n### **Name**\n\n**range** - \\[NUMERIC MODEL\\] Decimal exponent range of a numeric kind\n\n### **Synopsis**\n```fortran\n result = range(x)\n```\n```fortran\n integer function range (x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be of type _integer_, _real_, or _complex_. It may be a scalar or an array.\n - **KIND** is any kind supported by the type of **x**\n - the result is a default _integer_ scalar\n\n### **Description**\n\n **range** returns the decimal exponent range in the model of the\n type of **x**.\n\n Since **x** is only used to determine the type and kind being\n interrogated, the value need not be defined.\n\n### **Options**\n\n- **x**\n : the value whose type and kind are used for the query\n\n### **Result**\n\n Case (i)\n : For an integer argument, the result has the value\n```fortran\n int (log10 (huge(x)))\n```\n Case (ii)\n : For a real argument, the result has the value\n```fortran\n int(min (log10 (huge(x)), -log10(tiny(x) )))\n ```\n Case (iii)\n : For a complex argument, the result has the value\n```fortran\n range(real(x))\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_range\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=sp) :: x(2)\ncomplex(kind=dp) :: y\n print *, precision(x), range(x)\n print *, precision(y), range(y)\nend program demo_range\n```\nResults:\n```text\n > 6 37\n > 15 307\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n",