pax_global_header00006660000000000000000000000064147723126600014522gustar00rootroot0000000000000052 comment=02bd593384ae19133e963a29aff382ba253f9df8 fortran-language-server-3.2.2+dfsg/000077500000000000000000000000001477231266000172055ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/.coveragerc000066400000000000000000000005061477231266000213270ustar00rootroot00000000000000[run] omit = fortls/__init__.py fortls/debug.py fortls/version.py fortls/schema.py concurrency = multiprocessing parallel = true sigterm = true [report] exclude_lines = if debug: log.debug except: if not PY3K: def update_m_intrinsics update_m_intrinsics() [html] show_contexts = True fortran-language-server-3.2.2+dfsg/.github/000077500000000000000000000000001477231266000205455ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/.github/CODEOWNERS000066400000000000000000000000171477231266000221360ustar00rootroot00000000000000* @gnikit fortran-language-server-3.2.2+dfsg/.github/FUNDING.yml000066400000000000000000000013451477231266000223650ustar00rootroot00000000000000# These are supported funding model platforms github: # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] patreon: # Replace with a single Patreon username open_collective: # Replace with a single Open Collective username ko_fi: # Replace with a single Ko-fi username tidelift: # pypi/fortls community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry liberapay: # Replace with a single Liberapay username issuehunt: # Replace with a single IssueHunt username otechie: # Replace with a single Otechie username lfx_crowdfunding: # Replace with a single LFX Crowdfunding project-name e.g., cloud-foundry custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] fortran-language-server-3.2.2+dfsg/.github/ISSUE_TEMPLATE/000077500000000000000000000000001477231266000227305ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/.github/ISSUE_TEMPLATE/bug_report.md000066400000000000000000000032071477231266000254240ustar00rootroot00000000000000--- name: Bug report about: Create a report to help us improve title: '' labels: bug assignees: '' --- **Describe the bug** A clear and concise description of what the bug is. **To Reproduce** Try and reproduce the `fortls` error through the debug interface, for more see `fortls --debug_help`. Usually debug requests start like `fortls --debug_filepath your_file.f90 --debug_rootpath . ...`. Start with posting: 1. a **Minimal Working Example** to demonstrate the bug 2. the `fortls` command to reproduce the issue, or your `fortls` 3. the output of the `fortls` command 4. Any additional JSONRPC requests like the ones produced with `--debug_log` Alternatively, you can try and describe the steps that you followed to encounter the bug: 1. Go to '...' 2. Click on '....' 3. Scroll down to '....' 4. See error **Expected behavior** A clear and concise description of what you expected to happen. **Screenshots & Animations** If applicable, add screenshots or GIF/MP4 animations to help explain your problem. **Setup information (please complete the following information):** - OS: [e.g. Linux, Mac] - Python Version [e.g. 3.10] - fortls Version [e.g. 2.3] - Code editor used [e.g. VS Code, Vim] - the Fortran extension for the code editor and its version [e.g. Modern Fortran v3.0.0] (if applicable) **Configuration information (please complete the following information):** - Your `.fortlsrc` or `.fortls.json` or `.fortls` configuration file OR any other JSON config being used (if any) - Any settings specified through your extension [e.g. for VS Code settings from `settings.json`] **Additional context** Add any other context about the problem here. fortran-language-server-3.2.2+dfsg/.github/ISSUE_TEMPLATE/feature_request.md000066400000000000000000000013651477231266000264620ustar00rootroot00000000000000--- name: Feature request about: Suggest an idea for this project title: '' labels: enhancement assignees: '' --- **Is your feature request related to a problem? Please describe.** A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] **Describe the solution you'd like** A clear and concise description of what you want to happen. **Describe alternatives you've considered** A clear and concise description of any alternative solutions or features you've considered. **Additional context** Add any other context or screenshots about the feature request here. fortran-language-server-3.2.2+dfsg/.github/dependabot.yml000066400000000000000000000004041477231266000233730ustar00rootroot00000000000000version: 2 updates: - package-ecosystem: "github-actions" directory: "/" schedule: interval: "daily" # Check for updates Python updates via pip in case we pin a dependency - package-ecosystem: "pip" directory: "/" schedule: interval: "weekly" fortran-language-server-3.2.2+dfsg/.github/workflows/000077500000000000000000000000001477231266000226025ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/.github/workflows/codeql-analysis.yml000066400000000000000000000044531477231266000264230ustar00rootroot00000000000000# For most projects, this workflow file will not need changing; you simply need # to commit it to your repository. # # You may wish to alter this file to override the set of languages analyzed, # or to provide custom queries or build logic. # # ******** NOTE ******** # We have attempted to detect the languages in your repository. Please check # the `language` matrix defined below to confirm you have the correct set of # supported CodeQL languages. # name: "CodeQL" on: push: branches: [ master, dev ] pull_request: # The branches below must be a subset of the branches above branches: [ master, dev ] schedule: - cron: '24 7 * * 2' jobs: analyze: name: Analyze runs-on: ubuntu-latest permissions: actions: read contents: read security-events: write strategy: fail-fast: false matrix: language: [ 'python' ] # CodeQL supports [ 'cpp', 'csharp', 'go', 'java', 'javascript', 'python', 'ruby' ] # Learn more about CodeQL language support at https://git.io/codeql-language-support steps: - name: Checkout repository uses: actions/checkout@v4 # Initializes the CodeQL tools for scanning. - name: Initialize CodeQL uses: github/codeql-action/init@v3 with: languages: ${{ matrix.language }} # If you wish to specify custom queries, you can do so here or in a config file. # By default, queries listed here will override any specified in a config file. # Prefix the list here with "+" to use these queries and those in the config file. # queries: ./path/to/local/query, your-org/your-repo/queries@main # Autobuild attempts to build any compiled languages (C/C++, C#, or Java). # If this step fails, then you should remove it and run the build manually (see below) - name: Autobuild uses: github/codeql-action/autobuild@v3 # ℹī¸ Command-line programs to run using the OS shell. # 📚 https://git.io/JvXDl # ✏ī¸ If the Autobuild fails above, remove it and uncomment the following three lines # and modify them (or add more) to build your code if your project # uses a compiled language #- run: | # make bootstrap # make release - name: Perform CodeQL Analysis uses: github/codeql-action/analyze@v3 fortran-language-server-3.2.2+dfsg/.github/workflows/docs.yml000066400000000000000000000010241477231266000242520ustar00rootroot00000000000000name: "Docs" on: [push, pull_request] jobs: docs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - uses: actions/setup-python@v5 with: python-version: "3.11" - name: Build docs run: | pip install -e .[dev,docs] make -C docs html - name: Deploy uses: peaceiris/actions-gh-pages@v4 if: github.ref == 'refs/heads/master' with: github_token: ${{ secrets.GITHUB_TOKEN }} publish_dir: docs/_build/html fortran-language-server-3.2.2+dfsg/.github/workflows/docs_preview.yml000066400000000000000000000014211477231266000260140ustar00rootroot00000000000000name: Docs Preview permissions: pull-requests: write on: pull_request: types: - opened - synchronize - reopened - edited - closed paths: - "docs/**" - "fortls/interface.py" workflow_dispatch: concurrency: preview-${{github.ref}} jobs: deploy-preview: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - uses: actions/setup-python@v5 with: python-version: "3.11" - name: Build docs run: | pip install -e .[dev,docs] make -C docs html - name: Deploy Preview uses: rossjrw/pr-preview-action@v1.6.0 with: source-dir: docs/_build/html preview-branch: gh-pages custom-url: fortls.fortran-lang.org fortran-language-server-3.2.2+dfsg/.github/workflows/main.yml000066400000000000000000000020771477231266000242570ustar00rootroot00000000000000name: Tests on: [push, pull_request] # Allows you to run this workflow manually from the Actions tab # workflow_dispatch: jobs: build: strategy: matrix: os: [ubuntu-latest, windows-latest] python-version: ["3.8", "3.9", "3.10", "3.11", "3.12", "3.13"] fail-fast: false runs-on: ${{ matrix.os }} steps: - uses: actions/checkout@v4 - uses: actions/setup-python@v5 with: python-version: ${{ matrix.python-version }} architecture: x64 - name: Setup run: pip install .[dev] - name: Lint run: black --diff --check --verbose . - name: Check schema is up to date run: | python3 -m fortls.schema git diff --exit-code ./fortls/fortls.schema.json - name: Unittests run: pytest --doctest-modules -n auto - name: Upload coverage to Codecov uses: codecov/codecov-action@v5.4.0 with: fail_ci_if_error: true verbose: true env: CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }} fortran-language-server-3.2.2+dfsg/.github/workflows/python-publish.yml000066400000000000000000000030151477231266000263110ustar00rootroot00000000000000# This workflow will upload a Python Package using Twine when a release is created # For more information see: https://help.github.com/en/actions/language-and-framework-guides/using-python-with-github-actions#publishing-to-package-registries # This workflow uses actions that are not certified by GitHub. # They are provided by a third-party and are governed by # separate terms of service, privacy policy, and support # documentation. name: PyPi Release on: release: types: [published] jobs: deploy: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - name: Set up Python uses: actions/setup-python@v5 with: python-version: "3.x" - uses: softprops/action-gh-release@master if: startsWith(github.ref, 'refs/tags/v') with: files: ./fortls/fortls.schema.json - name: Install dependencies run: | python -m pip install --upgrade pip pip install build - name: Build package run: python -m build - name: Publish to Test PyPi if: startsWith(github.ref, 'refs/tags') uses: pypa/gh-action-pypi-publish@release/v1 with: user: __token__ password: ${{ secrets.TEST_PYPI_API_TOKEN }} repository-url: https://test.pypi.org/legacy/ - name: Publish to PyPi if: startsWith(github.ref, 'refs/tags') uses: pypa/gh-action-pypi-publish@release/v1 with: user: __token__ password: ${{ secrets.PYPI_API_TOKEN }} fortran-language-server-3.2.2+dfsg/.github/workflows/update-intrinsics.yml000066400000000000000000000017611477231266000267770ustar00rootroot00000000000000on: # fire at 00:00 every 7th day of the month schedule: - cron: "0 0 */7 * *" workflow_dispatch: name: Check M_intrinsics for updates jobs: update-intrinsics: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - name: Setup run: | python3 -m pip install --upgrade pip pip install .[dev] - name: Download M_intrinsics run: | git clone https://github.com/urbanjost/M_intrinsics - name: Update Markdown intrinsics run: | python3 scripts/update_m_intrinsics.py - name: Create Pull Request uses: peter-evans/create-pull-request@v7 with: token: ${{ secrets.GITHUB_TOKEN }} commit-message: "docs: update M_intrinsics" title: Update M_intrinsics body: | Auto-generated Pull Request to update M_intrinsics JSON definitions. branch: docs/update-intrinsics delete-branch: true reviewers: gnikit fortran-language-server-3.2.2+dfsg/.gitignore000066400000000000000000000003301477231266000211710ustar00rootroot00000000000000*.pyc .vscode *.egg-info venv/ dist/ build/ docs/_build/ docs/fortls_changes.md fortls/_version.py .idea *.o *.mod *.smod *.log .coverage coverage.xml # Ignore M_intrinsics repo M_intrinsics benchmarks/ scripts/ fortran-language-server-3.2.2+dfsg/.pre-commit-config.yaml000066400000000000000000000013321477231266000234650ustar00rootroot00000000000000# See https://pre-commit.com for more information # See https://pre-commit.com/hooks.html for more hooks repos: - repo: https://github.com/pre-commit/pre-commit-hooks rev: v4.6.0 hooks: - id: trailing-whitespace - id: end-of-file-fixer - id: check-yaml - id: check-added-large-files args: ['--maxkb=2000'] - repo: https://github.com/PyCQA/flake8 rev: 7.0.0 hooks: - id: flake8 - repo: https://github.com/asottile/pyupgrade rev: v3.15.2 hooks: - id: pyupgrade - repo: https://github.com/pycqa/isort rev: 5.13.2 hooks: - id: isort name: isort (python) - repo: https://github.com/psf/black rev: 24.4.2 hooks: - id: black fortran-language-server-3.2.2+dfsg/CHANGELOG.md000066400000000000000000001244321477231266000210240ustar00rootroot00000000000000# CHANGELOG ## Unreleased ## 3.2.2 ### Fixed - Fixed bug where comments in `USE` statements disabled reference finding ([#450](https://github.com/fortran-lang/fortls/issues/450)) ## 3.2.1 ### Fixed - Fixed bug where no matching declarations were found for interface subchildren depending on their letter casing ([#471](https://github.com/fortran-lang/fortls/issues/471)) ## 3.2.0 ### Added - Added more verbose reporting for recursion errors arising from nested projects ([#445](https://github.com/fortran-lang/fortls/issues/445)) ### Fixed - Fixed bug with Fixed Format references being incorrectly detected in comments ([#447](https://github.com/fortran-lang/fortls/issues/447)) - Fixed bug with where form feed characters broke LSP features ([#443](https://github.com/fortran-lang/fortls/issues/443)) ## 3.1.2 ### Fixed - Fixed incorrect document symbol for `SUBMODULE` statements ([#413](https://github.com/fortran-lang/fortls/issues/413)) ## 3.1.1 ### Fixed - Fixed bug with nested preprocessor blocks erroneously evaluating as active ([#404](https://github.com/fortran-lang/fortls/issues/404)) ## 3.1.0 ### Fixed - Fixed bug where parser would crash when trying to retrieve an invalid line no. ([#398](https://github.com/fortran-lang/fortls/issues/398)) - Fixed bug with string quotes not being escaped when looking for parenthesis ([#250](https://github.com/fortran-lang/fortls/issues/250)) - Fixed bug with line continuations in lexical tokens ([#235](https://github.com/fortran-lang/fortls/issues/235)) ## 3.0.0 ### Added - Added support for changing the default Python recursion depth ([#312](https://github.com/fortran-lang/fortls/issues/312)) - Added support for preprocessor macro expansions ([#368](https://github.com/fortran-lang/fortls/pull/368)) - Added support for leading white spaces in preprocessor directives ([#297](https://github.com/fortran-lang/fortls/issues/297)) - Added hover messages for Types and Modules ([#208](https://github.com/fortran-lang/fortls/issues/208)) - Added support for Markdown intrinsics from the M_intrinsics repository ([#215](https://github.com/fortran-lang/fortls/issues/215)) - Added and create a schema for fortls configuration files ([#204](https://github.com/fortran-lang/fortls/issues/204)) - Added dependabot alers for PyPi ([#222](https://github.com/fortran-lang/fortls/issues/222)) - Added `CITATION.cff` file to project roots ### Changed - Changed `--incl_suffixes` option to faithfully match the suffixes that are provided in the option, without performing any type of modification. ([#300](https://github.com/fortran-lang/fortls/issues/300)) - Changed the completion signature to include the full Markdown documentation for the completion item. ([#219](https://github.com/fortran-lang/fortls/issues/219)) - Changed hover messages and signature help to use Markdown ([#45](https://github.com/fortran-lang/fortls/issues/45)) - Changed automatic detection of fixed/free-form of files to ignore preprocessor lines. ([#302](https://github.com/fortran-lang/fortls/pull/302)) - Moved project setup from `setup.cfg` to `pyproject.toml` ([#384](https://github.com/fortran-lang/fortls/pull/384)) - Bumped `setuptools` version to `>=61.0.0` ([#384](https://github.com/fortran-lang/fortls/pull/384)) ### Fixed - Fixed end of scope errors raised by trailing semicolon in native parser ([#265](https://github.com/fortran-lang/fortls/issues/265)) - Fixed bug where parent scope for includes in AST could be `None` ([#329](https://github.com/fortran-lang/fortls/issues/329)) - Fixed preprocessor bug with `if` and `elif` conditionals ([#322](https://github.com/fortran-lang/fortls/issues/322)) - Fixed bug where type fields or methods were not detected if spaces were used around `%` ([#286](https://github.com/fortran-lang/fortls/issues/286)) - Fixed bug where Go To Implementation would not work for submodules ([#74](https://github.com/fortran-lang/fortls/issues/74)) - Fixed bug where `associate` blocks for variables pointing to function results where not properly resolved ([#269](https://github.com/fortran-lang/fortls/issues/269)) - Fixed bug where the `langid` was not propagated correctly from the user settings to the LSP creation stage for all types of requests. ([#257](https://github.com/fortran-lang/fortls/issues/257)) - Fixed end of scope for `CRITICAL` keyword blocks ([#255](https://github.com/fortran-lang/fortls/issues/255)) - Fixed bug where completion of interfaces in USE ONLY would produce the snippet ([#150](https://github.com/fortran-lang/fortls/issues/150)) - Fixed bug where diagnostic messages were raised for non-existent variables ([#173](https://github.com/fortran-lang/fortls/issues/173)) ([#175](https://github.com/fortran-lang/fortls/issues/175)) - Fixed submodule crashing bug and document/Symbol request failure ([#233](https://github.com/fortran-lang/fortls/issues/233)) - Fixed debug interface parser not loading all configuration files ([#221](https://github.com/fortran-lang/fortls/issues/221)) - Fixed name mangling of type-bound procedure pointers while hovering ([#214](https://github.com/fortran-lang/fortls/issues/214)) - Fixed parsing start of multilines into AST ([#217](https://github.com/fortran-lang/fortls/issues/217)) ### Removed - Removed `setuptools_scm_git_archive` due to package deprecation ([#326](https://github.com/fortran-lang/fortls/issues/326)) ## 2.13.0 ### Added - Added additional default configuration file names `.fortlsrc`, `.fortls.json` ([#184](https://github.com/fortran-lang/fortls/issues/184)) - Added coverage testing for multiple Python versions ([#168](https://github.com/fortran-lang/fortls/pull/178)) - Added pre-commit.ci to `fortls` ([#168](https://github.com/fortran-lang/fortls/issues/168)) ### Fixed - Fixed `intent(in out)` not being parsed correctly ([#160](https://github.com/fortran-lang/fortls/issues/160)) ## 2.12.0 ### Fixed - Fixed issue where `pip` would install without `--user` and fail ([#163](https://github.com/fortran-lang/fortls/issues/163)) ## 2.11.0 ### Fixed - Fixed bug thorowing diagnostic errors if arguments were named `pure`, `elemental`, etc. ([#157](https://github.com/fortran-lang/fortls/issues/157)) ## 2.10.0 ### Fixed - Fixed `workspace/didChangeConfiguration` requests that caused errors in VS Code logs ([#114](https://github.com/fortran-lang/fortls/issues/114)) ## 2.9.0 ### Fixed - Fixed glob pattern resolution for command line arguments ([#142](https://github.com/fortran-lang/fortls/issues/142)) ### Changed - Changed the default value of the following options when a mix the command line interface and the `json` interface are used. Instead of having the `json` interface default the values to an empty set it now defaults to the values of the command line: `excl_paths`, `source_dirs`, `incl_suffixes`, `excl_suffixes`, `include_dirs` ([#143](https://github.com/fortran-lang/fortls/issues/143)) ## 2.8.0 ### Added - Added support for comments in the `json` configuration files ([#137](https://github.com/fortran-lang/fortls/issues/137)) - Added `sitemap.xml` to documentation webpage ([#134](https://github.com/fortran-lang/fortls/pull/134)) ### Fixed - Fixed bug where error messages did not post correctly ([#135](https://github.com/fortran-lang/fortls/issues/135)) ## 2.7.0 ### Added - Added doctests in the pytest test suite ([#131](https://github.com/fortran-lang/fortls/issues/131)) ### Changed - Renamed variables to simplify parser ([#133](https://github.com/fortran-lang/fortls/pull/133)) - Redesigned parsing functions for short-hand declarations of array dimensions, character length and parsing of kind ([#130](https://github.com/fortran-lang/fortls/pull/130)) ## 2.6.0 ### Changed - Redesigned the `fortls` website to be more aesthetically pleasing and user-friendly ([#112](https://github.com/fortran-lang/fortls/issues/112)) ### Fixed - Fixed bug where submodule procedure scopes would terminate early if keyword modifiers were used ([#119](https://github.com/fortran-lang/fortls/issues/119)) ## 2.5.0 ### Added - Added `textDocument/documentHighlight` request for Vim and EMACS ([#43](https://github.com/fortran-lang/fortls/issues/43)) - Added `pre-commit` hook with `flake`, `black`, `isort` and `pyupgrade` ([#106](https://github.com/fortran-lang/fortls/issues/106)) - Added test support for diagnostic messages ### Changed - Changed code structure, reformatted files and changed name conventions ([#109](https://github.com/fortran-lang/fortls/issues/109)) - Updated CONTRIBUTING instructions ## 2.4.0 ### Added - Added multiple unittests for diagnostic messages - Added `pre-commit` hook to the project ([#106](https://github.com/fortran-lang/fortls/issues/106)) - Added Code of Conduct - Added basic support for hovering over `ASSOCIATE` blocks ([#62](https://github.com/fortran-lang/fortls/issues/62)) ### Changed - Changed the naming convention for Fortran Objects ([#109](https://github.com/fortran-lang/fortls/issues/109)) - Formatted all files with `pre-commit` ## 2.3.1 ### Fixed - Fixed remote coverage report line diff ([#101](https://github.com/fortran-lang/fortls/issues/101)) ## 2.3.0 ### Added - Added keywords to the PyPi manifest ([#99](https://github.com/fortran-lang/fortls/issues/99)) ### Changed - Updated `README` to include logo and animations - Updated `README` to include conda-forge installation instructions ## 2.2.14 ### Added - Added unittests for intrinsics and improved overall coverage ### Changed - Restructured unittests to individual files for more granular reporting ## 2.2.13 ### Added - Automated the update for GitHub Actions ## 2.2.12 ### Added - Added coverage reporting for Unix + Windows ## 2.2.11 ### Added - Improved autocompletion for Fortran statements F2018 compliant ([#63](https://github.com/fortran-lang/fortls/issues/63)) ## 2.2.10 ### Fixed - Fixes GoTo Implementation error for intrinsics ([#80](https://github.com/fortran-lang/fortls/issues/80)) ## 2.2.9 ### Changed - Changed how renaming of implicitly named type-bound procedures and their implementations is handled. Unittest was added. - Rewrote the Fortran parser to be clearer and more modular ## 2.2.8 ### Changed - Disable PyPi autoupdating for pre-releases and dev versions ## 2.2.7 ### Changed - Changed the auto-update feature to skip `anaconda` environments since they handle their dependencies through `conda` and not `pip` ### Fixed - Fixed missing dependency from `setup.cfg` ([#78](https://github.com/fortran-lang/fortls/issues/78)) - Updated configuration file variables in documentation ## 2.2.6 ### Added - Added the capability for `fortls` to auto-update use `--disable_autoupdate` to disable ([#76](https://github.com/fortran-lang/fortls/issues/76)) ## Deprecated - Deprecated `--variable_hover` option and now is always enabled ([#46](https://github.com/fortran-lang/fortls/issues/46)) ## 2.2.5 ### Changed - Updated `setup.cfg` in preparation of submitting package to `conda-forge` - Added `Editor Integration` section in documentation ### Fixed - Fixed parsing of `defined` without by parenthesis surrounding the definition ([#67](https://github.com/fortran-lang/fortls/pull/67)) ## 2.2.4 ### Fixed - Fixed hovering value of literal and constant strings not displaying ([#54](https://github.com/fortran-lang/fortls/issues/54)) - Fixed hovering string length size is now matching the string ([#55](https://github.com/fortran-lang/fortls/issues/55)) - Fixed space separated keywords not being displayed upon hover ([#60](https://github.com/fortran-lang/fortls/issues/60)) ## 2.2.3 ### Changed - Changed reading in `json` files to be encoded as UTF-8 ([#51](https://github.com/fortran-lang/fortls/pull/51)) ## 2.2.2 ### Changed - Changed the way function hover messages are displayed, now signatures are standardised ([#47](https://github.com/fortran-lang/fortls/issues/47)) ### Fixed - Fixed hovering over functions displaying as theire result types ([#22](https://github.com/fortran-lang/fortls/issues/22)) - Fixed function modifiers not displaying upon hover ([#48](https://github.com/fortran-lang/fortls/issues/48)) - Fixed function hover when returning arrays ([#50](https://github.com/fortran-lang/fortls/issues/50)) ## 2.2.1 ### Changed - Changed default branch to master and updated Actions workflows ## 2.2.0 ### Added - Added semantic versioning with `setuptools_scm` ([#34](https://github.com/fortran-lang/fortls/issues/34)) ### Changed - Changes from `setup.py` to `setup.toml` and `pyproject.toml` ([#33](https://github.com/fortran-lang/fortls/issues/33)) - Changed documentation CI to up to date action - Formatted Python imports with `isort` ## 2.1.2 ### Fixed - Fixed code autocompletion bug with f-strings ([#39](https://github.com/hansec/fortran-language-server/issues/39)) ## 2.1.1 ### Added - Added additional shields to REAMDE, including coverage and Python versions ## 2.1.0 ### Added - Added coverage metric for Codecov - Added coverage for `WHERE`, `ENUM`, max line/comment diagnostics and multilines - Adds Windows CI ### Fixed - Fixed global `sort_keywords` option not propagating during parsing on Windows ([#36](https://github.com/fortran-lang/fortls/issues/36)) - Fixed unittests not propagating debugger state ([#35](https://github.com/fortran-lang/fortls/issues/35)) ## 2.0.1 ### Added - Add support for absolute include, source and exclude paths ### Changed - Changed `USE_info` named tuple to storing use modules as `sets` instead of `lists` - Changed `include_dirs` from a `list` to a `set` - Automates the versioning with GitHub releases ### Fixed - Fixed some mutable default argument warnings in methods and classes - Fixed private variables showing in autocomplete ([#191](https://github.com/hansec/fortran-language-server/issues/191)) ([#3](https://github.com/fortran-lang/fortls/issues/3)) ## 2.0.0 ### Added - Adds support for including preprocessor definitions from files same as `pp_defs` - Adds hover support for preprocessor variables - Adds Go To Definition for `include` statements - Adds intrinsic support for `OpenACC` version 3.1 - Adds sphinx autogenerated documentation - Adds `incl_suffixes` as a configuration option - Adds `EXTERNAL` as an attribute upon hover ### Changed - Update constant parameters for `omp_lib` and `omp_lib_kinds` Interface v5.0 - Format json files with `prettier` - Initialises the log channel and adds `$/setTrace` to override client's (i.e. VS Code) loglevel - Unified the interfaces from the command line and the configuration options file ([#17](https://github.com/fortran-lang/fortls/issues/17)) - Updated the documentation and simplified the README.md ### Deprecated - Option `--preserve_keyword_order` has been substituted with its opposite `--sort_keywords` ### Fixed - Fixes the hover of preprocessor functions. It now displays the function name witout the argument list and the function body. The argument list cannot be multiline but the function body can. - Fixes objects marked `EXTERNAL` across multiple lines ([#169](https://github.com/hansec/fortran-language-server/issues/169)) - Fixes include with external files ([#13](https://github.com/fortran-lang/fortls/issues/13)) - `POINTER` attribute now displays upon hover ([#16](https://github.com/fortran-lang/fortls/issues/16)) - Fixes `END FORALL` end of scope error ([#18](https://github.com/fortran-lang/fortls/issues/18)) - Fixes Fortran line continuation definitions intermingled with preprocessor directives ([#203](https://github.com/hansec/fortran-language-server/issues/203)) ([#4](https://github.com/fortran-lang/fortls/issues/4)) - Fixes `USE` directive ordering issues ([#184](https://github.com/hansec/fortran-language-server/issues/184)) ([#7](https://github.com/fortran-lang/fortls/issues/7)) ## 1.16.0 ### Added - Adds value for `PARAMETER` variables on hover ([#116](https://github.com/hansec/fortran-language-server/issues/116)) ([#1](https://github.com/fortran-lang/fortls/issues/1)) ## 1.15.2 ### Fixed - Further improves the literal variable hover added in v1.14.0 ## 1.15.1 ### Fixed - Fixes premature end of scope with variables named `end` ([#9](https://github.com/fortran-lang/fortls/issues/9)) ## 1.15.0 ### Added - Adds `--config` option which allows arbitrary named configuration files ## 1.14.4 ### Fixed - Fixes import host association includes (autocomplete work not complete) ([#187](https://github.com/hansec/fortran-language-server/issues/187)) ## 1.14.3 ### Fixed - Fixes parsing of `non_intrinsic` modules ([#206](https://github.com/hansec/fortran-language-server/issues/206)) ## 1.14.2 ### Fixed - Fixes error while parsing submodule parent name with spaces ([#207](https://github.com/hansec/fortran-language-server/issues/207)) ## 1.14.1 ### Fixed - Fixes language server features not triggering for variables in column 0 ## 1.14.0 ### Fixed - Fixes (partially) Fortran literal variable hover ([#188](https://github.com/hansec/fortran-language-server/issues/188)) ## 1.13.0 ### Added - Adds Python glob support for `excl_paths`, `source_dirs`, `include_dirs` ## 1.12.1 ### Fixed - Fixes diagnostic error with interfaces as function arguments ([#200](https://github.com/hansec/fortran-language-server/issues/200)) ## 1.12.0 ### Changed - Add support for disabling diagnostics globally or on a per-project basis, ref [PR 163](https://github.com/hansec/fortran-language-server/pull/163) ### Fixed - Fix bug with enum declarations, fixes [#167](https://github.com/hansec/fortran-language-server/issues/167) - Fix typo in "ISHIFT" and "ISHIFTC" intrinsic functions, ref [PR 165](https://github.com/hansec/fortran-language-server/pull/165) ## 1.11.1 ### Fixed - Fix bug with hover requests introduced in v1.11.0, fixes [#159](https://github.com/hansec/fortran-language-server/issues/159) ## 1.11.0 ### Changed - Add support for specifying the language name returned for hover requests, ref [Fortran IntelliSense #17](https://github.com/hansec/vscode-fortran-ls/issues/17) - Add support for submodule implementations using the "PROCEDURE" keyword, fixes [#152](https://github.com/hansec/fortran-language-server/issues/152) ### Fixed - Fix bug with keywords in old style function declarations, fixes [#154](https://github.com/hansec/fortran-language-server/issues/154) - Fix bug when searching an empty scope, fixes [#151](https://github.com/hansec/fortran-language-server/issues/151) - Remove erroneous double definition/masking checks for interfaces, fixes [#18](https://github.com/hansec/fortran-language-server/issues/18) and [#138](https://github.com/hansec/fortran-language-server/issues/138) - README: Add fix for possible installation error ## 1.10.3 ### Fixed - Fix parsing bug with spaces in "old-style" kind specifications, fixes [#142](https://github.com/hansec/fortran-language-server/issues/142) - Fix issue with erroneous sub-word matching in preprocessor macro substitutions, fixes [#141](https://github.com/hansec/fortran-language-server/issues/141) ## 1.10.2 ### Changed - Add support for "old-style" character length specification, fixes [#130](https://github.com/hansec/fortran-language-server/issues/130) and [#134](https://github.com/hansec/fortran-language-server/issues/134) ### Fixed - Fix "can't set attribute" error in USE traversal, fixes [#132](https://github.com/hansec/fortran-language-server/issues/132) - Fix bugs related to optional leading ampersands on continuation lines, fixes [#131](https://github.com/hansec/fortran-language-server/issues/131) - Fix bug in block parsing with string literals, fixes [#128](https://github.com/hansec/fortran-language-server/issues/128) ## 1.10.1 ### Fixed - Fix bug in semicolon parsing, fixes [#127](https://github.com/hansec/fortran-language-server/issues/127) ## 1.10.0 ### Changed - Initial implementation of preprocessor include file handling, ref [#115](https://github.com/hansec/fortran-language-server/issues/115) - Add support for specifying file suffixes for preprocessing, ref [#115](https://github.com/hansec/fortran-language-server/issues/115) - Add support for completion in visibility statements, fixes [#120](https://github.com/hansec/fortran-language-server/issues/120) - Support "onOpen" requests before a file is written to disk, fixes [#123](https://github.com/hansec/fortran-language-server/issues/123) - Add support for IMPURE keyword (contributed by @mcocdawc) - Improve readability by replacing various result arrays with namedtuples ### Fixed - Fix bug in open string literal detection, fixes [#124](https://github.com/hansec/fortran-language-server/issues/124) - Fix bug with multiline docstrings that start with a trailing comment, fixes [#118](https://github.com/hansec/fortran-language-server/issues/118) - Fix symbols types for subroutines and methods in "documentSymbol" and "completion" requests, fixes [#117](https://github.com/hansec/fortran-language-server/issues/117) - Fix bug where ONLY renaming was not fully tracked in some circumstances - Fix bug with inline dimension specifications for variables - Fix accidental message swap in "object not found" and "object not imported" diagnostics - Fix bug where errors were reported with "module subroutine" and "module function" definitions (no import required) ## 1.9.1 ### Fixed - Fix bug in USE ONLY accounting used for graph pruning, fixes [#122](https://github.com/hansec/fortran-language-server/issues/122) ## 1.9.0 ### Changed - Add support for USE statement renaming requests, ref [#109](https://github.com/hansec/fortran-language-server/issues/109) - Add support for argument information in variable hover requests, fixes [#107](https://github.com/hansec/fortran-language-server/issues/107) - Add support for disabling snippets in autocomplete results, fixes [#112](https://github.com/hansec/fortran-language-server/issues/112) - Prevent file AST updates on Open/Close requests when contents have not changed, ref [#105](https://github.com/hansec/fortran-language-server/issues/105) - Reduce unnecessary parsing with single line file changes - Debugging: Add support for printing full result object ### Fixed - Remove required space between "DOUBLE PRECISION" and "DOUBLE COMPLEX" definitions, fixes [#110](https://github.com/hansec/fortran-language-server/issues/110) - Fix requests when a user-defined type variable has the same name as a defined type used in that scope ## 1.8.2 ### Fixed - Fix parsing single line WHERE statements with trailing parentheses, fixes [#106](https://github.com/hansec/fortran-language-server/issues/106) - Fix erroneous object duplication diagnostics for DO, INTERFACE, etc. blocks - Remove erroneous "unimplemented procedure" diagnostics from abstract type definitions - Fix parsing bugs with semicolons in trailing comments ## 1.8.1 ### Fixed - Fix bug with requests in lines with tab characters, fixes [#93](https://github.com/hansec/fortran-language-server/issues/93) - Fix bug with requests following "WRITE(\*,\*)" statements ## 1.8.0 ### Changed - Add full support for ASSOCIATE statements, fixes [#101](https://github.com/hansec/fortran-language-server/issues/101) - Filter completion suggestions after "MODULE PROCEDURE" statements, fixes [#103](https://github.com/hansec/fortran-language-server/issues/103) - Filter completion suggestions in type-bound procedure links - Add support for including external source file directories - Diagnostics: Line length exceeds maximum length errors - Speedup language server initialization - Speedup "textDocument/references" requests ## 1.7.3 ### Fixed - Fix case preservation in hover requests, fixes [#102](https://github.com/hansec/fortran-language-server/issues/102) - Fix rename requests for type-bound procedures without an explicit link statement (ie. "=>"), fixes [#104](https://github.com/hansec/fortran-language-server/issues/104) - Fix incorrect "CONTAINS" diagnostic errors with procedure pointers and external interfaces - Fix bug in diagnostic construction/reporting (introduced in v1.7) - Fix bugs caused by accidental modification of child object lists ## 1.7.2 ### Fixed - Fix bug with definition/hover requests involving intrinsic functions/modules/variables (introduced in v1.7) ## 1.7.1 ### Fixed - Fix bug with completion and signatureHelp requests on continuation lines (introduced in v1.7) - Fix out-of-range error with various requests on zero-length lines (introduced in v1.7) ## 1.7.0 ### Changed - Add initial support for "textDocument/codeAction" requests, generate unimplemented deferred procedures - Show subroutine/function keywords ("PURE", "ELEMENTAL", etc.) - Add position of object in line to "textDocument/definition" and "textDocument/implementation" results - Diagnostics: CONTAINS statement placement errors - Diagnostics: Visibility statement placement errors - Command line options: Notify when workspace initialization is complete - Command line options: Set number of threads used during initialization - Significant refactoring of core code ### Fixed - Fix "RecursionError" exception with circular user-defined type references, fixes [#100](https://github.com/hansec/fortran-language-server/issues/100) - Fix bug detecting TYPE definitions with an immediately following colon, ref [#100](https://github.com/hansec/fortran-language-server/issues/100) - Fix incorrect diagnostics for interface statements with USE instead of IMPORT statements ## 1.6.0 ### Changed - Add support for EXTERNAL subroutines - Diagnostics: Missing subroutine/function arguments and argument declarations - Diagnostics: Unimplemented deferred type-bound procedures - Diagnostics: Unknown TYPE/KIND objects (only if candidate is visible in workspace) - Diagnostics: IMPORT statements (missing objects and placement) - Diagnostics: Basic handling for IMPLICIT statements ## 1.5.1 ### Changed - Add support for semicolon separators and multiline preprocessor macros, fixes [#98](https://github.com/hansec/fortran-language-server/issues/98) - Add various "parsing errors" to debug_parser output ### Fixed - Use consistent file access method across debug_parser run and language server requests ## 1.5.0 ### Changed - Add support for "textDocument/rename" requests - Add initial support for Doxygen and FORD style comment blocks, ref [#44](https://github.com/hansec/fortran-language-server/issues/44) ### Fixed - Fix language server crash with unknown user-defined type fields ### Other changes - Deprecate "mod_dirs" option in favor of more accurate "source_dirs". Support for "mod_dirs" will be removed in a future release. ## 1.4.0 ### Changed - Add support for "textDocument/implementation" requests, ref [#94](https://github.com/hansec/fortran-language-server/issues/94) - Add option to preserve keyword ordering, ref [#97](https://github.com/hansec/fortran-language-server/issues/97) ### Fixed - Fix parsing bug with single line WHERE statements, fixes [#92](https://github.com/hansec/fortran-language-server/issues/92) - Fix bug with keyword parsing with nested parenthesis, fixes [#97](https://github.com/hansec/fortran-language-server/issues/97) - Differentiate between type-bound procedures and implementations in "textDocument/references" requests, fixes [#94](https://github.com/hansec/fortran-language-server/issues/94) - Fix typos in MAX and MIN intrinsic functions, ref [#96](https://github.com/hansec/fortran-language-server/pull/96) ## 1.3.0 ### Changed - Add support for user-defined type members in "textDocument/references" requests, fixes [#88](https://github.com/hansec/fortran-language-server/issues/88) - Link type-bound procedures with no explicit link to matching named scope in module, fixes [#89](https://github.com/hansec/fortran-language-server/issues/89) - Report diagnostics related to misplaced "CONTAINS" statements - Restructure README for improved clarity on capabilities/limitations ### Fixed - Fix bug with blank/empty lines in free-format continuations, fixes [#91](https://github.com/hansec/fortran-language-server/issues/91) - Fix exception in "textDocument/references" requests when no object is found, fixes [#86](https://github.com/hansec/fortran-language-server/issues/86) - Fix bug when relative path is used for --debug_rootpath, fixes [#87](https://github.com/hansec/fortran-language-server/issues/87) ## 1.2.1 ### Fixed - Fix bug in nested user-defined type inheritance, fixes [#85](https://github.com/hansec/fortran-language-server/issues/85) - Fix bug in completion requests with empty parenthesis in request line ## 1.2.0 ### Changed - Add support for local variables/objects in "textDocument/references" requests, ref [#84](https://github.com/hansec/fortran-language-server/issues/78) - Improve preprocessing to handle more types of conditional statements and macro substitution, ref [#78](https://github.com/hansec/fortran-language-server/issues/78) - Report diagnostics for excess "END" statements instead of causing parser failure, ref [#78](https://github.com/hansec/fortran-language-server/issues/78) ### Fixed - Fix missing "textDocument/references" results when line starts with target object, fixes [#84](https://github.com/hansec/fortran-language-server/issues/84) ## 1.1.1 ### Fixed - Fix bug with backslash URI separators on Windows, fixes [#83](https://github.com/hansec/fortran-language-server/issues/83) ## 1.1.0 ### Changed - Add initial implementation of simple preprocessor, ref [#78](https://github.com/hansec/fortran-language-server/issues/78) ### Fixed - Updated Fixed/Free detection logic using ampersands to check for comment line, fixes [#81](https://github.com/hansec/fortran-language-server/issues/81) - Support use of "END" as a variable, fixes [#82](https://github.com/hansec/fortran-language-server/issues/82) ## 1.0.5 ### Fixed - Add support for named "SELECT" statements, fixes [#80](https://github.com/hansec/fortran-language-server/issues/80) - Track scopes for "ASSIGNMENT" and "OPERATOR" interface statements, fixes [#79](https://github.com/hansec/fortran-language-server/issues/79) - Fix bug in parsing "SELECT" statements with no space, fixes [#77](https://github.com/hansec/fortran-language-server/issues/77) - Further improve discrimination between end statements and other items, ref [#73](https://github.com/hansec/fortran-language-server/issues/73) ## 1.0.4 ### Fixed - Normalize file paths when storing/accessing file index, fixes [#75](https://github.com/hansec/fortran-language-server/issues/75) - Fix intrinsic statement "COUNT" ([#76](https://github.com/hansec/fortran-language-server/pull/76)) ## 1.0.3 ### Fixed - Further improve discrimination between end statements and variables/block labels, ref [#73](https://github.com/hansec/fortran-language-server/issues/73) - Fix autocomplete errors when ASSOCIATE and ENUM statements are present - Fix severity reporting with "debug_diagnostics" command line option ## 1.0.2 ### Fixed - Fix discrimination between end statements and variables with underscores, fixes [#73](https://github.com/hansec/fortran-language-server/issues/73) - Detect enum definitions, fixes [#74](https://github.com/hansec/fortran-language-server/issues/74) ## 1.0.1 ### Fixed - Detect and support associate statements, fixes [#72](https://github.com/hansec/fortran-language-server/issues/72) ## 1.0.0 ### Changed - Add parsing of DO/IF/WHERE blocks and report scope end errors - Detect and report errors with invalid parent for scope definitions - Improve highlighting for hover requests in VSCode - Downgrade missing use warnings to information level - Add intrinsic declaration statement "double complex" ([#70](https://github.com/hansec/fortran-language-server/pull/70)) ### Fixed - Fix bug with leading whitespace on visibility statements, fixes [#69](https://github.com/hansec/fortran-language-server/issues/69) - Fix parsing errors when "&" and "!" characters are present inside string literals - Fix parsing bug with multiple leading function/subroutine modifiers (PURE, ELEMENTAL, etc.) ## 0.9.3 ### Fixed - Fix detection of function definitions with leading module and variable statements, fixes [#66](https://github.com/hansec/fortran-language-server/issues/66) - Properly close remaining open scopes at end of file - Initialize scope "eline" property, [PR #67](https://github.com/hansec/fortran-language-server/pull/67) ## 0.9.2 ### Changed - Improve handling of different file encodings, [PR #57](https://github.com/hansec/fortran-language-server/pull/57) ### Fixed - Fix autocomplete results for inherited members of user-defined types when the member type definition is only available in parent type's scope ## 0.9.1 ### Changed - Add support for generic interfaces in type-bound procedures, [#64](https://github.com/hansec/fortran-language-server/issues/64) - Add parent scope information to masked variable errors, [#48](https://github.com/hansec/fortran-language-server/issues/48) ### Fixed - Fix parsing deferred length character definitions, [#61](https://github.com/hansec/fortran-language-server/issues/61) - Fix parsing function definitions with modifiers before type, [#63](https://github.com/hansec/fortran-language-server/issues/63) - Fix parsing with array construction in subroutine/function calls, [#60](https://github.com/hansec/fortran-language-server/issues/60) ## 0.9.0 ### Changed - Add basic support for workspace/symbol requests - Add support for excluding source files based on a common suffix ### Fixed - Prevent detection of variables starting with "use" as USE statements, [#59](https://github.com/hansec/fortran-language-server/issues/59) - Improve parsing of USE ONLY statements, [#53](https://github.com/hansec/fortran-language-server/issues/53) - Make sure explicitly specified module directories exist, fixes [#52](https://github.com/hansec/fortran-language-server/issues/52) - Fix visibility statements with trailing comments, [#49](https://github.com/hansec/fortran-language-server/issues/49) ## 0.8.4 ### Fixed - Check for existence of file during "textDocument/didClose" requests, [#46](https://github.com/hansec/fortran-language-server/issues/46) - Encode text as UTF-8 in change requests, fixes [#41](https://github.com/hansec/fortran-language-server/issues/41) ## 0.8.3 ### Changed - Add support for generating debug logs - Add Fortran statements to autocomplete suggestions - Add support for explicit dimension specifications, fixes [#37](https://github.com/hansec/fortran-language-server/issues/37) ## 0.8.2 ### Changed - Add support for F03 style bracket array initialization, fixes [#35](https://github.com/hansec/fortran-language-server/issues/35) ## 0.8.1 ### Fixed - Fix crash in completion requests with intrinsic modules ## 0.8.0 ### Changed - Reformat completion information and snippets to match common language server conventions - Provide hover information for overloaded interfaces - Add support for autocompletion in select type statements - Add support for type bound procedures with explicit pass statements - Add support for arguments defined as interfaces in hover and signatureHelp requests - Unbetafy signatureHelp support ### Fixed - Fix linking type bound procedures with same name as subroutine/function definition ## 0.7.3 ### Fixed - Improve detection of block statements, fixes [#32](https://github.com/hansec/fortran-language-server/issues/32) - Fix autocompletion with mixed case object definitions ## 0.7.2 ### Fixed - Fix variable definition detection without spaces, fixes [#30](https://github.com/hansec/fortran-language-server/issues/30) ## 0.7.1 ### Changed - Add option for displaying hover information for variables - Add subroutine/function keywords to hover information - Add more keywords to variable information - Support spaces between subroutine name and parentheses in signatureHelp ### Fixed - Fix bug with file paths that include spaces, fixes [#29](https://github.com/hansec/fortran-language-server/issues/29) - Fix bug where arguments were erroneously dropped for procedure variables - Fix bug where arguments of procedure type did not have definition information in subroutine/function hover results - Correct spelling of incremental_sync argument, fixes [#28](https://github.com/hansec/fortran-language-server/issues/28) ## 0.7.0 ### Changed - Add support for signatureHelp requests with non-overloaded subroutines/functions - Provide autocomplete and hover information for procedures with explicit interface definitions - Add support for Fortran 2008 block constructs, fixes [#23](https://github.com/hansec/fortran-language-server/issues/23) - Add support for "DOUBLE COMPLEX" datatype ### Fixed - Fix bug where external interfaces were erroneously public in default private modules - Fix bug producing repeated objects with include statements ## 0.6.2 ### Changed - Catch and report more types of errors related to file processing, fixes [#21](https://github.com/hansec/fortran-language-server/issues/21) ## 0.6.1 ### Fixed - Fix bug with incremental sync using VSCode on windows, fixes [#20](https://github.com/hansec/fortran-language-server/issues/20) ## 0.6.0 ### Changed - Add keywords to autocomplete results in variable definition statements - Filter autocompletion results in extend, import, and procedure statements - Ignore completion requests on scope definition and ending lines to reduce autocomplete noise - Filter autocompletion results in variable definition statements to reduce autocomplete noise (variables only) - Ignore autocomplete and definition requests on preprocessor lines - Add option to test completion and definition requests in debug mode ### Fixed - Improve export of abstract and external interfaces for completion and definition requests - Fix scope name detection to prevent confusing variables that start with Fortran statement names - Fix handling of external and abstract interface specifications - Fix bug preventing unrestricted USE statements from overriding USE only statements - Fix bug where file parsing ended prematurely in some cases with line continuations ## 0.5.0 ### Changed - Add intrinsic functions and modules to autocomplete suggestions - Add support for include statements ### Fixed - Remove erroneously included global objects from autocomplete results in USE ONLY statements - Fix displayed type for derived type objects in autocomplete requests ## 0.4.0 ### Changed - Add support for find_references, global and top-level module objects only - Filter autocomplete suggestions for callable objects in call statements - Speedup initialization and updates on large projects by accelerating construction of USE tree ### Fixed - Fix parser error with definitions requiring enclosing scopes in #include files and unnamed programs, fixes [#17](https://github.com/hansec/fortran-language-server/issues/17) - Fix parser failure with visibility statements in included fortran files, fixes [#16](https://github.com/hansec/fortran-language-server/issues/16) - Fix detection of lines with trailing comments ## 0.3.7 ### Changed - Automatically trigger autocomplete on `%` character - Show named interfaces and prototypes in document outline - Add support for autocomplete without prefix filtering ### Fixed - Fix occasional language server error in autocompletion with class methods ## 0.3.6 ### Changed - Add support for fortran submodules, fixes [#14](https://github.com/hansec/fortran-language-server/issues/14) and [#15](https://github.com/hansec/fortran-language-server/issues/15) - Improve line tokenization and parsing ### Fixed - Fix parsing errors with incomplete function definitions - Fix bugs in symbol and parser debugging ## 0.3.5 ### Fixed - Improve unicode file handling with Python 3.x - Add support for unnamed programs, fixes [#13](https://github.com/hansec/fortran-language-server/issues/13) ## 0.3.4 ### Fixed - Fix parser error with uppercase characters in scope names, fixes [#11](https://github.com/hansec/fortran-language-server/issues/11) - Add support for object names with a leading underscore, fixes [#9](https://github.com/hansec/fortran-language-server/issues/9) - Do not report diagnostics inside preprocessor if statements, fixes [#7](https://github.com/hansec/fortran-language-server/issues/7) ## 0.3.3 ### Changed - Improved Windows support and added AppVeyor CI testing - Add support for snippets in autocompletion - Ignore requests in comment sections ### Fixed - Fix bug with string/byte handling in Python 3 - Fix bug with multiprocess support on Windows - Fix bug with URI formatting and paths on Windows, fixes [#8](https://github.com/hansec/fortran-language-server/issues/8) ## 0.3.2 ### Fixed - Fix parsing variable definitions containing separators inside strings, fixes [#4](https://github.com/hansec/fortran-language-server/issues/4) - Fix incorrect variable masking error in functions, fixes [#5](https://github.com/hansec/fortran-language-server/issues/5) - Do not report intrinsic modules as unknown, fixes [#2](https://github.com/hansec/fortran-language-server/issues/2) and [#3](https://github.com/hansec/fortran-language-server/issues/3) ## 0.3.1 ### Changed - Do not show warnings for variable masking in interface definitions - Respect visibility statements when searching for object in scope ### Fixed - Fix bug in incremental document sync with ending newline ## 0.3.0 ### Changed - Add basic file diagnostics (double declaration, variable masking, unknown USE) - Indicate optional arguments in autocomplete suggestions - Detect source code format from file contents instead of extension - Add support for incremental document synchronization ### Fixed - Fix parsing error when variable definition line is incomplete - Fix incorrect line handling with open parentheses - Fix bug when file parsing/hashing fails in workspace initialization ## 0.2.0 ### Changed - Add support for recursive directory inclusion from "root_path" - Provide option to skip type members in documentSymbol requests - Apply visibility statements to objects for autocomplete suggestions - Filter interface suggestions to only show unique signatures - Link imported procedures in interface definitions ### Fixed - Fix line continuation handling for free form files with trailing and leading ampersands - Improve parentheses matching in line parsing ## 0.1.4 ### Changed - Handle line continuations in language server requests - Add server version number to help output ### Fixed - Fix bug when parsing files with unicode characters ## 0.1.3 ### Changed - Include interfaces in autocomplete suggestions - Restrict autocomplete suggestions by object visibility - Improve USE statement traversal - Add notifications for parser failures ### Fixed - Fix bug where parsing errors during workspace initialization could crash the language server ## 0.1.2 - Synchronize version numbers ## 0.1.1 - fix download link in setup.py ## 0.1.0 - First Release - Initial release fortran-language-server-3.2.2+dfsg/CITATION.cff000066400000000000000000000007101477231266000210750ustar00rootroot00000000000000# This CITATION.cff file was generated with cffinit. # Visit https://bit.ly/cffinit to generate yours today! cff-version: 1.2.0 title: fortls - Fortran Language Server message: >- If you use this software, please cite it using the metadata from this file. type: software authors: - family-names: Nikiteas name-suffix: Ioannis email: gnikit@duck.com affiliation: Imperial College London orcid: 'https://orcid.org/0000-0001-9811-9250' fortran-language-server-3.2.2+dfsg/CODE_OF_CONDUCT.md000066400000000000000000000121541477231266000220070ustar00rootroot00000000000000# Contributor Covenant Code of Conduct ## Our Pledge We as members, contributors, and leaders pledge to make participation in our community a harassment-free experience for everyone, regardless of age, body size, visible or invisible disability, ethnicity, sex characteristics, gender identity and expression, level of experience, education, socio-economic status, nationality, personal appearance, race, religion, or sexual identity and orientation. We pledge to act and interact in ways that contribute to an open, welcoming, diverse, inclusive, and healthy community. ## Our Standards Examples of behavior that contributes to a positive environment for our community include: * Demonstrating empathy and kindness toward other people * Being respectful of differing opinions, viewpoints, and experiences * Giving and gracefully accepting constructive feedback * Accepting responsibility and apologizing to those affected by our mistakes, and learning from the experience * Focusing on what is best not just for us as individuals, but for the overall community Examples of unacceptable behavior include: * The use of sexualized language or imagery, and sexual attention or advances of any kind * Trolling, insulting or derogatory comments, and personal or political attacks * Public or private harassment * Publishing others' private information, such as a physical or email address, without their explicit permission * Other conduct which could reasonably be considered inappropriate in a professional setting ## Enforcement Responsibilities Community leaders are responsible for clarifying and enforcing our standards of acceptable behavior and will take appropriate and fair corrective action in response to any behavior that they deem inappropriate, threatening, offensive, or harmful. Community leaders have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, and will communicate reasons for moderation decisions when appropriate. ## Scope This Code of Conduct applies within all community spaces, and also applies when an individual is officially representing the community in public spaces. Examples of representing our community include using an official e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. ## Enforcement Instances of abusive, harassing, or otherwise unacceptable behavior may be reported to the community leaders responsible for enforcement at giannis.nikiteas@gmail.com. All complaints will be reviewed and investigated promptly and fairly. All community leaders are obligated to respect the privacy and security of the reporter of any incident. ## Enforcement Guidelines Community leaders will follow these Community Impact Guidelines in determining the consequences for any action they deem in violation of this Code of Conduct: ### 1. Correction **Community Impact**: Use of inappropriate language or other behavior deemed unprofessional or unwelcome in the community. **Consequence**: A private, written warning from community leaders, providing clarity around the nature of the violation and an explanation of why the behavior was inappropriate. A public apology may be requested. ### 2. Warning **Community Impact**: A violation through a single incident or series of actions. **Consequence**: A warning with consequences for continued behavior. No interaction with the people involved, including unsolicited interaction with those enforcing the Code of Conduct, for a specified period of time. This includes avoiding interactions in community spaces as well as external channels like social media. Violating these terms may lead to a temporary or permanent ban. ### 3. Temporary Ban **Community Impact**: A serious violation of community standards, including sustained inappropriate behavior. **Consequence**: A temporary ban from any sort of interaction or public communication with the community for a specified period of time. No public or private interaction with the people involved, including unsolicited interaction with those enforcing the Code of Conduct, is allowed during this period. Violating these terms may lead to a permanent ban. ### 4. Permanent Ban **Community Impact**: Demonstrating a pattern of violation of community standards, including sustained inappropriate behavior, harassment of an individual, or aggression toward or disparagement of classes of individuals. **Consequence**: A permanent ban from any sort of public interaction within the community. ## Attribution This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 2.0, available at https://www.contributor-covenant.org/version/2/0/code_of_conduct.html. Community Impact Guidelines were inspired by [Mozilla's code of conduct enforcement ladder](https://github.com/mozilla/diversity). [homepage]: https://www.contributor-covenant.org For answers to common questions about this code of conduct, see the FAQ at https://www.contributor-covenant.org/faq. Translations are available at https://www.contributor-covenant.org/translations. fortran-language-server-3.2.2+dfsg/CONTRIBUTING.md000066400000000000000000000053251477231266000214430ustar00rootroot00000000000000# Contributing 👍🎉 Thank you for taking the time to contribute! 🎉👍 In this file you will find all the steps necessary to guide you through your first contribution to the project. Please note our [Code of Conduct](https://github.com/fortran-lang/fortls/blob/master/CODE_OF_CONDUCT.md) and adhere to it in all your interactions with this project. ## 📚 Getting Started A good place to start is the [Issues tab](https://github.com/fortran-lang/fortls/issues) on GitHub. Look for any issues with the `help wanted` tag. ### Downloading âŦ‡ī¸ Firstly, fork the repository from . Then clone the forked repository into your local machine. ```sh git@github.com:/fortls.git ``` Where `` should be your GitHub username. ### Dependencies To build this project you will need [Python](https://www.python.org/) `>= 3.7` and [pip](https://www.python.org/) `>= 21.0`. To install all Python dependencies open a terminal go into the `fortls` cloned folder and run: ```sh pip install -e ".[dev,docs]" ``` ### Testing đŸ§Ē To verify that your cloning of the GitHub repository worked as expected open a terminal and run: ```sh pytest -v ``` This will run the entire unit test suite. You can also run this to verify that you haven't broken anything in the code. 👉 **Tip!** You can run individual tests by selecting the path to the Python file and the method ```sh pytest test/test_interface.py::test_version_update_pypi ``` ### Developing & Debugging 🐞ī¸ ❗ī¸ Before you start developing, open a terminal inside `fortls` and run: ```sh pre-commit install ``` This will ensure that all you commits meet the formatting standards of the project. --- You can now start writing code! Your local `fortls` version will be updated with every code change you make, so you can use your normal code editor to checkout the `fortls` features that you have implemented. It is however considerably easier to create compact unittests to check if your changes have worked. A `fortls` test normally involves writing a Python function which sends a JSONRPC request to the server and then test checks for the correct server response. Often times small bits of Fortran source code also have to be submited to be used by the test. You can find varisous test examples in the `tests` directory. 👉 **Tip!** You can attach a debugger to the main `fortls` source code during unittesting which should allow you to pause, break, step into, etc. while testing, thus making it easier to find mistakes. ### Merging To merge your changes to the main `fortls` repository push your branch on GitHub and open a [Pull Request](https://github.com/fortran-lang/fortls/pulls). Ping `@gnikit` to review your PR. fortran-language-server-3.2.2+dfsg/LICENSE000066400000000000000000000021361477231266000202140ustar00rootroot00000000000000The MIT License (MIT) Copyright 2017-2019 Chris Hansen Copyright 2021-2022 Giannis Nikiteas Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. fortran-language-server-3.2.2+dfsg/README.md000066400000000000000000000240361477231266000204710ustar00rootroot00000000000000![alt](https://raw.githubusercontent.com/fortran-lang/fortls/master/assets/logo.png) # fortls - Fortran Language Server [![Powered by NumFOCUS](https://img.shields.io/badge/powered%20by-NumFOCUS-orange.svg?style=flat-square&colorA=E1523D&colorB=007D8A)](https://numfocus.org) ![PyPI](https://img.shields.io/pypi/v/fortls?style=flat-square) ![PyPI - Python Version](https://img.shields.io/pypi/pyversions/fortls?style=flat-square) [![PyPI - Downloads](https://img.shields.io/pypi/dm/fortls?style=flat-square&label=PyPi)](https://pepy.tech/project/fortls) ![Conda](https://img.shields.io/conda/dn/conda-forge/fortls?label=Anaconda&style=flat-square) ![GitHub License](https://img.shields.io/github/license/fortran-lang/fortls?style=flat-square) ![GitHub Workflow Status](https://img.shields.io/github/actions/workflow/status/fortran-lang/fortls/main.yml?branch=master&label=CI&style=flat-square) ![GitHub Workflow Status](https://img.shields.io/github/actions/workflow/status/fortran-lang/fortls/docs.yml?branch=master&label=Docs&style=flat-square) ![Codecov](https://img.shields.io/codecov/c/github/fortran-lang/fortls?style=flat-square) [![Code style: black](https://img.shields.io/badge/code%20style-black-000000.svg?style=flat-square)](https://github.com/psf/black) ![GitHub Repo stars](https://img.shields.io/github/stars/fortran-lang/fortls?color=yellow&style=flat-square) [![DOI](https://zenodo.org/badge/412392321.svg?style=flat-square)](https://zenodo.org/badge/latestdoi/412392321) ![alt](https://raw.githubusercontent.com/fortran-lang/fortls/master/assets/animations/intro-demo.gif) `fortls` is an implementation of the [Language Server Protocol](https://github.com/Microsoft/language-server-protocol) (LSP) for Fortran using Python (3.7+). All code editors that support LSP can integrate with `fortls` see the section [Editor Integration](https://fortls.fortran-lang.org/editor_integration.html#editor-integration) in the documentation. Some supported code editors include: [Visual Studio Code](https://fortls.fortran-lang.org/editor_integration.html#visual-studio-code), [Atom](https://fortls.fortran-lang.org/editor_integration.html#atom), [Sublime Text](https://fortls.fortran-lang.org/editor_integration.html#sublime-text), [(Neo)Vim](https://fortls.fortran-lang.org/editor_integration.html#vim-neovim-gvim), and [Emacs](https://fortls.fortran-lang.org/editor_integration.html#emacs). ## Features - Project-wide and Document symbol detection and Renaming - Hover support, Signature help and Auto-completion - GoTo/Peek implementation and Find/Peek references - Preprocessor support - Documentation parsing ([Doxygen](http://www.doxygen.org/) and [FORD](https://github.com/Fortran-FOSS-Programmers/ford) styles) - Access to multiple intrinsic modules and functions - `ISO_FORTRAN_ENV` GCC 11.2.0 - `ISO_C_BINDING` GCC 11.2.0 - `IEEE_EXCEPTIONS`, `IEEE_ARITHMETIC`, `IEEE_FEATURES` GCC 11.2.0 - OpenMP `OMP_LIB`, `OMP_LIB_KINDS` v5.0 - OpenACC `OPENACC`, `OPENACC_KINDS` v3.1 - Diagnostics - Multiple definitions with the same variable name - Variable definition masks definition from parent scope - Missing subroutine/function arguments - Unknown user-defined type used in `TYPE`/`CLASS` definition (only if visible in project) - Unclosed blocks/scopes - Invalid scope nesting - Unknown modules in `USE` statement - Unimplemented deferred type-bound procedures - Use of non-imported variables/objects in interface blocks - Statement placement errors (`CONTAINS`, `IMPLICIT`, `IMPORT`) - Code actions - Generate type-bound procedures and implementation templates for deferred procedures ### Notes/Limitations - Signature help and hover does not handle elegantly overloaded functions i.e. interfaces ## Documentation The full documentation for `fortls` can be found at [fortls.fortran-lang.org](https://fortls.fortran-lang.org/). ## Installation ### PyPi ```sh pip install fortls ``` ### Anaconda ```sh conda install -c conda-forge fortls ``` for more information about the Anaconda installation [see](https://github.com/conda-forge/fortls-feedstock#about-fortls) ### Common installation problems It is **NOT** recommended having `fortls` and `fortran-language-server` simultaneously installed, since they use the same executable name. If you are having trouble getting `fortls` to work try uninstalling `fortran-language-server` and reinstalling `fortls`. With `pip` ```sh pip uninstall fortran-language-server pip install fortls --upgrade ``` or with Anaconda ```sh conda uninstall fortran-language-server conda install -c conda-forge fortls ``` ## Settings `fortls` can be configured through both the command line e.g. `fortls --hover_signature` or through a Configuration json file. The two interfaces are identical and a full list of the available options can be found in the [Documentation](https://fortls.fortran-lang.org/options.html) or through `fortls -h` An example for a Configuration file is given below ```json { "incremental_sync": true, "lowercase_intrinsics": true, "hover_signature": true, "use_signature_help": true, "excl_paths": ["tests/**", "tools/**"], "excl_suffixes": ["_skip.f90"], "include_dirs": ["include/**"], "pp_suffixes": [".F90", ".h"], "pp_defs": { "HAVE_HDF5": "", "MPI_Comm": "integer" } } ``` ## Implemented server requests | Request | Description | | -------------------------------- | ------------------------------------------------------ | | `workspace/symbol` | Get workspace-wide symbols | | `textDocument/documentSymbol` | Get document symbols e.g. functions, subroutines, etc. | | `textDocument/completion` | Suggested tab-completion when typing | | `textDocument/signatureHelp` | Get signature information at a given cursor position | | `textDocument/definition` | GoTo definition/Peek definition | | `textDocument/references` | Find all/Peek references | | `textDocument/documentHighlight` | Same as `textDocument/references` | | `textDocument/hover` | Show messages and signatures upon hover | | `textDocument/implementation` | GoTo implementation/Peek implementation | | `textDocument/rename` | Rename a symbol across the workspace | | `textDocument/didOpen` | Document synchronisation upon opening | | `textDocument/didSave` | Document synchronisation upon saving | | `textDocument/didClose` | Document synchronisation upon closing | | `textDocument/didChange` | Document synchronisation upon changes to the document | | `textDocument/codeAction` | **Experimental** Generate code | ## Future plans `fortls` has reached a point where it is feature complete and stable enough to be used in many modern Fortran projects without any issues. It does however still have fundamental limitations, namely its ability to understand all Fortran syntax and semantics that has been used throughout the 65+ years of the language. **The good news is that we have a plan to address this issue!** We are excited to announce that we are working on creating a new Fortran Language Server based on the actively developed [LFortran](https://lfortran.org/) compiler 🎉. The new Language Server will be able to understand all Fortran syntax, be faster, and give more accurate autocompletion, hover and diagnostic information. That means we plan on investing any future funding on creating our new language server and ultimately creating a better user experience for everyone. ### What about `fortls`? Not to worry, `fortls` will continue to be here. We will keep `fortls` in active maintenance mode with bug fixes and new features from volunteer contributors, but otherwise we will be focusing our efforts into making the new language server using LFortran's parser a reality. ## `fortls` vs `fortran-language-server` This project was originally based on `fortran-language-server` LSP implementation, but the two projects have since diverged. `fortls` (this project) is now developed independently of the upstream `hansec/fortran-language-server` project and contains numerous new features and bug fixes the original `fortran-language-server` does not. For a complete and detailed list of the differences between the two Language Servers see the Documentation section: [Unique fortls features (not in fortran-language-server)](https://fortls.fortran-lang.org/fortls_changes.html) The name of executable for this project has been chosen to remain `fortls` to allow for integration with pre-existing plugins and workflows, but it could change in the future. ## Acknowledgements This project would not have been possible without the original work of [@hansec](https://github.com/hansec/) in [`fortran-language-server`](https://github.com/hansec/fortran-language-server) ## Support You can support Fortran-lang as a whole by donating at [Fortran-lang - NumFOCUS](https://numfocus.org/donate-for-fortran-lang). ## Bug reports When [filing bugs](https://github.com/fortran-lang/fortls/issues/new) please provide example code to reproduce the observed issue. ## Security Policy To report a security vulnerability please follow the instructions in our [Security page](https://github.com/fortran-lang/fortls/security/policy). ## License This project is made available under the [MIT License](https://github.com/fortran-lang/fortls/blob/master/LICENSE). fortran-language-server-3.2.2+dfsg/SECURITY.md000066400000000000000000000011121477231266000207710ustar00rootroot00000000000000# Security Policy ## Supported Versions `fortls` supports **ONLY** the latest Release. An autoupdate function is enabled by default to fetch the newest updates from `PyPi`. For Anaconda environments the autoupdate functionality is disabled and it is up to the user to update to the latest version. ## Reporting a Vulnerability The codebase is regularly scanned and patched for any potential security vulnerabilities. If you manage to find a vulnerability in the Language Server please open an [Bug Report](https://github.com/fortran-lang/fortls/issues) with prefix: **SECURITY:**. fortran-language-server-3.2.2+dfsg/docs/000077500000000000000000000000001477231266000201355ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/docs/Makefile000066400000000000000000000013731477231266000216010ustar00rootroot00000000000000# Minimal makefile for Sphinx documentation # # You can set these variables from the command line, and also # from the environment for the first two. SPHINXOPTS ?= SPHINXBUILD ?= sphinx-build SPHINXAPIDOC ?= sphinx-apidoc PANDOC ?= pandoc SOURCEDIR = . BUILDDIR = _build # Put it first so that "make" without argument is like "make help". help: @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) .PHONY: help Makefile # Catch-all target: route all unknown targets to Sphinx using the new # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). %: Makefile @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) modules: @$(SPHINXAPIDOC) -f -H "Developers' documentations" ../fortls -o . fortran-language-server-3.2.2+dfsg/docs/conf.py000066400000000000000000000101641477231266000214360ustar00rootroot00000000000000# Configuration file for the Sphinx documentation builder. # # This file only contains a selection of the most common options. For a full # list see the documentation: # https://www.sphinx-doc.org/en/master/usage/configuration.html # -- Path setup -------------------------------------------------------------- # If extensions (or modules to document with autodoc) are in another directory, # add these directories to sys.path here. If the directory is relative to the # documentation root, use os.path.abspath to make it absolute, like shown here. # import os import sys sys.path.insert(0, os.path.abspath("..")) from fortls import __version__ # noqa: E402 # Generate the agglomerated changes (from the CHANGELOG) between fortls # and the fortran-language-server project with open("../CHANGELOG.md") as f: lns = f.readlines() lns = lns[0 : lns.index("## 1.12.0\n")] changes = { "Added": [], "Changed": [], "Deprecated": [], "Removed": [], "Fixed": [], "Security": [], } field = "" for i in lns: if i.startswith("## "): continue if i.startswith("### "): field = i[4:-1] continue if i.startswith("- ") or i.startswith(" "): changes[field].append(i) new_file = ["# Unique fortls features (not in fortran-language-server)\n"] for key, val in changes.items(): if val: new_file.append(f"\n## {key}\n\n") new_file.extend(val) with open("fortls_changes.md", "w") as f: f.writelines(new_file) # -- Project information ----------------------------------------------------- project = "fortls" copyright = "2021-2022, Giannis Nikiteas" author = "Giannis Nikiteas" # The full version, including alpha/beta/rc tags release = __version__ # -- General configuration --------------------------------------------------- # Add any Sphinx extension module names here, as strings. They can be # extensions coming with Sphinx (named 'sphinx.ext.*') or your custom # ones. extensions = [ "sphinxarg.ext", "sphinx.ext.autodoc", "sphinx.ext.autosectionlabel", "sphinx.ext.autosummary", "sphinx.ext.napoleon", "sphinx.ext.intersphinx", "sphinx.ext.inheritance_diagram", "sphinx_autodoc_typehints", "sphinx.ext.autosectionlabel", "sphinx_design", "sphinx_copybutton", "myst_parser", "sphinx_sitemap", ] # For sphinx_design in Markdown myst_enable_extensions = ["colon_fence"] # Add any paths that contain templates here, relative to this directory. templates_path = ["_templates"] source_suffix = [".rst", ".md"] # List of patterns, relative to source directory, that match files and # directories to ignore when looking for source files. # This pattern also affects html_static_path and html_extra_path. exclude_patterns = ["_build", "Thumbs.db", ".DS_Store"] # -- Options for HTML output ------------------------------------------------- # The theme to use for HTML and HTML Help pages. See the documentation for # a list of builtin themes. # html_theme = "alabaster" html_theme = "sphinx_rtd_theme" html_theme = "furo" html_title = "fortls" html_logo = "../assets/logo.svg" html_favicon = "../assets/icon.svg" html_baseurl = "https://fortls.fortran-lang.org/" # Add any paths that contain custom static files (such as style sheets) here, # relative to this directory. They are copied after the builtin static files, # so a file named "default.css" will overwrite the builtin "default.css". html_static_path = ["_static"] # Add any extra paths that contain custom files (such as robots.txt or # .htaccess) here, relative to this directory. These files are copied # directly to the root of the documentation. html_extra_path = ["html_extra"] # Default is {version}{lang}{link} sitemap_url_scheme = "{link}" display_toc = True # autodoc_default_flags = ["members"] autosummary_generate = True intersphinx_mapping = { "python": ("https://docs.python.org/3.10", None), } inheritance_graph_attrs = { "size": '"6.0, 8.0"', "fontsize": 32, "bgcolor": "transparent", } inheritance_node_attrs = { "color": "black", "fillcolor": "white", "style": '"filled,solid"', } inheritance_edge_attrs = { "penwidth": 1.2, "arrowsize": 0.8, } fortran-language-server-3.2.2+dfsg/docs/contact.rst000066400000000000000000000015071477231266000223250ustar00rootroot00000000000000Contact Us =============== Are you a company that uses ``fortls``? Do you need technical support? Is there a feature missing that you would like to see or have you spotted a bug? **Reach out and let us know!** You can reach out in a number of ways: - Start a `GitHub Discussion `__. - Ask a question on `Fortran Language Discourse `__ and tag `@gnikit `__ in your post. - For Feature Requests open an issue on `GitHub `__. - For Bug Reports, open a bug report on `GitHub `__. Make sure to check the open GitHub issues! - For any other inquiry contact ``gnikit [@] duck [.] com`` fortran-language-server-3.2.2+dfsg/docs/contributing.rst000066400000000000000000000022421477231266000233760ustar00rootroot00000000000000 Contributing to fortls ====================== There are a few ways you can support the ``fortls`` project. Financial Support ------------------ You can fiscally support Fortran-lang by donating to the project, see `Fortran-lang - NumFOCUS`_. .. _Fortran-lang - NumFOCUS: https://numfocus.org/donate-for-fortran-lang .. .. grid:: 2 .. :gutter: 0 .. :class-container: sd-text-center sd-pt-4 .. :class-row: sd-align-minor-center .. .. grid-item:: .. .. button-link:: https://github.com/sponsors/gnikit .. :ref-type: ref .. :outline: .. :color: danger .. :class: sd-px-2 sd-fs-4 .. Become a **Sponsor** .. :octicon:`mark-github;2em;sd-text-black` .. :octicon:`heart-fill;2em;sd-text-danger` .. .. grid-item:: .. .. button-link:: https://www.paypal.com/paypalme/inikit .. :ref-type: ref .. :color: primary .. :class: sd-px-2 sd-fs-5 .. Make a **Donation** .. :fa:`fa-paypal` Contributing Code ----------------- .. include:: ./../CONTRIBUTING.md :parser: myst_parser.sphinx_ :start-line: 2 fortran-language-server-3.2.2+dfsg/docs/editor_integration.rst000066400000000000000000000171301477231266000245620ustar00rootroot00000000000000Editor Integration =================== `Visual Studio Code `__ ------------------------------------------------------- The Language Server is natively supported through the `Modern Fortran`_ extension. Install ``fortls`` then install the extension and all the server's features should be instantly available. .. _Modern Fortran: https://marketplace.visualstudio.com/items?itemName=fortran-lang.linter-gfortran .. important:: Make sure that ``fortls`` is reachable in your ``$PATH``. If not you can specify the option ``"fortran.fortls.path": "/custom/path/to/fortls"`` `Atom `__ --------------------------- Firstly ``fortls`` then install the `language-fortran`_ plugin by `@dparkins`_ to get Fortran syntax highlighting. Finally, install either `fortran-lsp`_ by `@gnikit`_ or `ide-fortran`_ by `@hansec`_ .. warning:: `fortran-lsp`_ has been created solely for the ``fortls`` Language Server, hence it natively interfaces with ``fortls``. `ide-fortran`_ was created for an older, now deprecated, Fortran Language Server hence the options available through the extension are not representative of ``fortls``'s interface. .. _language-fortran: https://atom.io/packages/language-fortran .. _@dparkins: https://github.com/dparkins .. _fortran-lsp: https://atom.io/packages/fortran-lsp .. _@gnikit: https://github.com/gnikit .. _ide-fortran: https://atom.io/packages/ide-fortran .. _@hansec: https://github.com/hansec `Sublime Text `__ ----------------------------------------------- Firstly, install ``fortls`` then install the `LSP`_ package from package control. Finally, install the `Fortran`_ package and add the following in your configuration .. code-block:: json { "clients": { "fortls": { "enabled": true, "command": ["fortls", "--notify_init"], "selector": "source.modern-fortran | source.fixedform-fortran" } } } For more details see the LSP `documentation`_. .. _LSP: https://github.com/sublimelsp/LSP .. _Fortran: https://packagecontrol.io/packages/Fortran .. _documentation: https://lsp.sublimetext.io/language_servers/#fortran `neovim `__ ------------------------------- .. warning:: For neovim versions < 0.5.0 follow the instructions in the :ref:`vim` section. Neovim version >= 0.5.0 `natively supports LSP `_. To enable the native LSP functionality install the `lspconfig`_ plugin with your favourite plugin manager. Then in your configuration file (i.e. ``init.lua``) add the following: .. code-block:: lua require'lspconfig'.fortls.setup{} If additional ``fortls`` options need to be passed to you can do that through the ``cmd`` option in ``setup{}`` .. code-block:: lua require'lspconfig'.fortls.setup{ cmd = { 'fortls', '--lowercase_intrinsics', '--hover_signature', '--hover_language=fortran', '--use_signature_help' } } .. important:: If you are just starting with ``neovim`` it is strongly recommended using the `Suggested configuration`_ from `lspconfig`_ for keybingings and server attaching. **Remember to attach the server during setup{}** .. _lspconfig: https://github.com/neovim/nvim-lspconfig .. _Suggested configuration: https://github.com/neovim/nvim-lspconfig#suggested-configuration .. _vim: `Vim `__ ------------------------------ Vim does not support LSP natively, so a 3rd party extensions need to be installed. A few options are available: `YouCompleteMe `__ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ `YouCompleteMe `__ is a popular Vim plugin and code-completion engine that also provides an LSP interface. You can therefore use it to register Language Servers like ``fortls``. For more information about configuring an arbitrary Language Server in YouCompleteMe, `see here `__. .. code-block:: vim " YouCompleteMe configuration options let g:ycm_language_server = \[ \ { \ 'name': 'fortls', \ 'cmdline': ['fortls', '--hover_language', 'fortran', '--notify_init', '--hover_signature', '--use_signature_help'], \ 'filetypes': ['fortran'], \ 'project_root_files': ['.fortls'], \ }, \] nmap yfw (YCMFindSymbolInWorkspace) nmap yfd (YCMFindSymbolInDocument) `LanguageClient-neovim `__ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Firstly install the plugin `LanguageClient-neovim`_. Then edit your ``~/.vimrc`` settings file to set ``fortls`` for Fortran files .. code-block:: vim " Required for operations modifying multiple buffers like rename. set hidden let g:LanguageClient_serverCommands = { " Add any default arguments you want fortls to have inside [] \ 'fortran': ['fortls', '--hover_signature', '--hover_language', 'fortran', '--use_signature_help'], \ } " note that if you are using Plug mapping you should not use `noremap` mappings. nmap (lcn-menu) " Or map each action separately nmap K (lcn-hover) nmap gd (lcn-definition) nmap (lcn-rename) .. _LanguageClient-neovim: https://github.com/autozimu/LanguageClient-neovim `EMACS `__ ----------------------------------------------- `LSP Mode `__ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Install the `lsp-mode`_ plugin. This should then allow for the variables `lsp-clients-fortls-args`_ and `lsp-clients-fortls-executable`_ to be defined in the ``~/.emacs`` configuration file. .. _lsp-mode: https://emacs-lsp.github.io/lsp-mode/page/installation .. _lsp-clients-fortls-args: https://emacs-lsp.github.io/lsp-mode/page/lsp-fortran/#lsp-clients-fortls-args .. _lsp-clients-fortls-executable: https://emacs-lsp.github.io/lsp-mode/page/lsp-fortran/#lsp-clients-fortls-executable `Eglot `__ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Install the `eglot`_ package which supports fortls out of the box. This can be done in emacs version > 26.1 via ``M-x package-install RET eglot RET``. Arguments to ``fortls`` can be provided in the form .. code-block:: elisp (add-to-list 'eglot-server-programs '(f90-mode . ("fortls" "--notify_init" "--nthreads=4"))) .. _eglot: https://github.com/joaotavora/eglot Visual Studio 2017 ------------------ Installing this `VS17 extension`_ should enable ``fortls`` features in Visual Studio .. _VS17 extension: https://github.com/michaelkonecny/vs-fortran-ls-client `Kakoune `__ ---------------------------------- Install `kak-lsp `_. Edit the ``kak-lsp.toml`` config file to include: .. code-block:: sh [language.fortran] filetypes = ["fortran"] roots = [".git", ".fortls"] command = "fortls" args = ["--symbol_skip_mem", "--incremental_sync", "--autocomplete_no_prefix", "--lowercase_intrisics"] Edit your ``kakrc`` config to enable ``kak-lsp``, adding ``fortran`` as a filetype: .. code-block:: sh eval %sh{kak-lsp --kakoune -s $kak_session} # lsp-enable hook global WinSetOption filetype=(fortran) %{ lsp-enable-window } fortran-language-server-3.2.2+dfsg/docs/features.rst000066400000000000000000000070531477231266000225120ustar00rootroot00000000000000Features =============== - Project-wide and Document symbol detection and Renaming - Hover support, Signature help and Auto-completion - GoTo/Peek implementation and Find/Peek references - Preprocessor support - Documentation parsing `Doxygen `__ and `FORD `__ styles - Diagnostics - Code actions - Intrinsics modules Completion ---------- .. image:: ../assets/lsp/completion-ani.gif .. image:: ../assets/lsp/completion.png Hover ------- .. image:: ../assets/lsp/hover.png .. image:: ../assets/lsp/hover2.png Symbols ------------ Project-wide and single Document symbol search .. image:: ../assets/lsp/symbols-workspace.png .. image:: ../assets/lsp/symbols-doc.png Signature Help ---------------- .. image:: ../assets/lsp/sig-help.gif Find References ------------------ .. figure:: ../assets/lsp/definition-goto.gif :align: left *Go To Definition of a function* .. figure:: ../assets/lsp/definition-peek.png :align: left *Peek into the Definition of a function* .. figure:: ../assets/lsp/references-peek.png :align: left *Peek into all the References of a function* Renaming ------------ .. figure:: ../assets/lsp/rename.gif :align: left *Rename a variable* Diagnostics ------------- - Multiple definitions with the same variable name - Variable definition masks definition from parent scope - Missing subroutine/function arguments - Unknown user-defined type used in ``TYPE``/ ``CLASS`` definition (only if visible in project) - Unclosed blocks/scopes - Invalid scope nesting - Unknown modules in ``USE`` statement - Unimplemented deferred type-bound procedures - Use of non-imported variables/objects in interface blocks - Statement placement errors (``CONTAINS``, ``IMPLICIT``, ``IMPORT``) Code Actions --------------- - Generate type-bound procedures and implementation templates for deferred procedures Intrinsics Modules ------------------ - ``ISO_FORTRAN_ENV``, ``ISO_C_BINDING`` GCC 11.2.0 - ``IEEE_EXCEPTIONS``, ``IEEE_ARITHMETIC``, ``IEEE_FEATURES`` GCC 11.2.0 - OpenMP ``OMP_LIB``, ``OMP_LIB_KINDS`` v5.0 - OpenACC ``OPENACC``, ``OPENACC_KINDS`` v3.1 All LSP Requests -------------------- .. list-table:: tmp :header-rows: 1 * - Request - Description * - ``workspace/symbol`` - Get workspace-wide symbols * - ``textDocument/documentSymbol`` - Get document symbols e.g. functions, subroutines, etc. * - ``textDocument/completion`` - Suggested tab-completion when typing * - ``textDocument/signatureHelp`` - Get signature information at a given cursor position * - ``textDocument/definition`` - GoTo definition/Peek definition * - ``textDocument/references`` - Find all/Peek references * - ``textDocument/documentHighlight`` - Same as ``textDocument/references`` * - ``textDocument/hover`` - Show messages and signatures upon hover * - ``textDocument/implementation`` - GoTo implementation/Peek implementation * - ``textDocument/rename`` - Rename a symbol across the workspace * - ``textDocument/didOpen`` - Document synchronisation upon opening * - ``textDocument/didSave`` - Document synchronisation upon saving * - ``textDocument/didClose`` - Document synchronisation upon closing * - ``textDocument/didChange`` - Document synchronisation upon changes to the document * - ``textDocument/codeAction`` - **Experimental** Generate code fortran-language-server-3.2.2+dfsg/docs/fortls.parsers.internal.rst000066400000000000000000000114641477231266000254770ustar00rootroot00000000000000fortls.parsers.internal package =============================== Submodules ---------- fortls.parsers.internal.associate module ---------------------------------------- .. automodule:: fortls.parsers.internal.associate :members: :undoc-members: :show-inheritance: fortls.parsers.internal.ast module ---------------------------------- .. automodule:: fortls.parsers.internal.ast :members: :undoc-members: :show-inheritance: fortls.parsers.internal.base module ----------------------------------- .. automodule:: fortls.parsers.internal.base :members: :undoc-members: :show-inheritance: fortls.parsers.internal.block module ------------------------------------ .. automodule:: fortls.parsers.internal.block :members: :undoc-members: :show-inheritance: fortls.parsers.internal.diagnostics module ------------------------------------------ .. automodule:: fortls.parsers.internal.diagnostics :members: :undoc-members: :show-inheritance: fortls.parsers.internal.do module --------------------------------- .. automodule:: fortls.parsers.internal.do :members: :undoc-members: :show-inheritance: fortls.parsers.internal.enum module ----------------------------------- .. automodule:: fortls.parsers.internal.enum :members: :undoc-members: :show-inheritance: fortls.parsers.internal.function module --------------------------------------- .. automodule:: fortls.parsers.internal.function :members: :undoc-members: :show-inheritance: fortls.parsers.internal.if\_block module ---------------------------------------- .. automodule:: fortls.parsers.internal.if_block :members: :undoc-members: :show-inheritance: fortls.parsers.internal.imports module -------------------------------------- .. automodule:: fortls.parsers.internal.imports :members: :undoc-members: :show-inheritance: fortls.parsers.internal.include module -------------------------------------- .. automodule:: fortls.parsers.internal.include :members: :undoc-members: :show-inheritance: fortls.parsers.internal.interface module ---------------------------------------- .. automodule:: fortls.parsers.internal.interface :members: :undoc-members: :show-inheritance: fortls.parsers.internal.intrinsics module ----------------------------------------- .. automodule:: fortls.parsers.internal.intrinsics :members: :undoc-members: :show-inheritance: fortls.parsers.internal.method module ------------------------------------- .. automodule:: fortls.parsers.internal.method :members: :undoc-members: :show-inheritance: fortls.parsers.internal.module module ------------------------------------- .. automodule:: fortls.parsers.internal.module :members: :undoc-members: :show-inheritance: fortls.parsers.internal.parser module ------------------------------------- .. automodule:: fortls.parsers.internal.parser :members: :undoc-members: :show-inheritance: fortls.parsers.internal.program module -------------------------------------- .. automodule:: fortls.parsers.internal.program :members: :undoc-members: :show-inheritance: fortls.parsers.internal.scope module ------------------------------------ .. automodule:: fortls.parsers.internal.scope :members: :undoc-members: :show-inheritance: fortls.parsers.internal.select module ------------------------------------- .. automodule:: fortls.parsers.internal.select :members: :undoc-members: :show-inheritance: fortls.parsers.internal.submodule module ---------------------------------------- .. automodule:: fortls.parsers.internal.submodule :members: :undoc-members: :show-inheritance: fortls.parsers.internal.subroutine module ----------------------------------------- .. automodule:: fortls.parsers.internal.subroutine :members: :undoc-members: :show-inheritance: fortls.parsers.internal.type module ----------------------------------- .. automodule:: fortls.parsers.internal.type :members: :undoc-members: :show-inheritance: fortls.parsers.internal.use module ---------------------------------- .. automodule:: fortls.parsers.internal.use :members: :undoc-members: :show-inheritance: fortls.parsers.internal.utilities module ---------------------------------------- .. automodule:: fortls.parsers.internal.utilities :members: :undoc-members: :show-inheritance: fortls.parsers.internal.variable module --------------------------------------- .. automodule:: fortls.parsers.internal.variable :members: :undoc-members: :show-inheritance: fortls.parsers.internal.where module ------------------------------------ .. automodule:: fortls.parsers.internal.where :members: :undoc-members: :show-inheritance: Module contents --------------- .. automodule:: fortls.parsers.internal :members: :undoc-members: :show-inheritance: fortran-language-server-3.2.2+dfsg/docs/fortls.parsers.rst000066400000000000000000000003701477231266000236560ustar00rootroot00000000000000fortls.parsers package ====================== Subpackages ----------- .. toctree:: :maxdepth: 4 fortls.parsers.internal Module contents --------------- .. automodule:: fortls.parsers :members: :undoc-members: :show-inheritance: fortran-language-server-3.2.2+dfsg/docs/fortls.rst000066400000000000000000000033431477231266000222030ustar00rootroot00000000000000fortls package ============== Subpackages ----------- .. toctree:: :maxdepth: 4 fortls.parsers Submodules ---------- fortls.constants module ----------------------- .. automodule:: fortls.constants :members: :undoc-members: :show-inheritance: fortls.debug module ------------------- .. automodule:: fortls.debug :members: :undoc-members: :show-inheritance: fortls.ftypes module -------------------- .. automodule:: fortls.ftypes :members: :undoc-members: :show-inheritance: fortls.helper\_functions module ------------------------------- .. automodule:: fortls.helper_functions :members: :undoc-members: :show-inheritance: fortls.interface module ----------------------- .. automodule:: fortls.interface :members: :undoc-members: :show-inheritance: fortls.json\_templates module ----------------------------- .. automodule:: fortls.json_templates :members: :undoc-members: :show-inheritance: fortls.jsonrpc module --------------------- .. automodule:: fortls.jsonrpc :members: :undoc-members: :show-inheritance: fortls.langserver module ------------------------ .. automodule:: fortls.langserver :members: :undoc-members: :show-inheritance: fortls.regex\_patterns module ----------------------------- .. automodule:: fortls.regex_patterns :members: :undoc-members: :show-inheritance: fortls.schema module -------------------- .. automodule:: fortls.schema :members: :undoc-members: :show-inheritance: fortls.version module --------------------- .. automodule:: fortls.version :members: :undoc-members: :show-inheritance: Module contents --------------- .. automodule:: fortls :members: :undoc-members: :show-inheritance: fortran-language-server-3.2.2+dfsg/docs/html_extra/000077500000000000000000000000001477231266000223045ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/docs/html_extra/CNAME000066400000000000000000000000301477231266000230430ustar00rootroot00000000000000fortls.fortran-lang.org fortran-language-server-3.2.2+dfsg/docs/html_extra/google3e426562ce42e98f.html000066400000000000000000000000661477231266000265430ustar00rootroot00000000000000google-site-verification: google3e426562ce42e98f.html fortran-language-server-3.2.2+dfsg/docs/html_extra/robots.txt000066400000000000000000000001151477231266000243520ustar00rootroot00000000000000User-agent: * Disallow: Sitemap: https://fortls.fortran-lang.org/sitemap.xml fortran-language-server-3.2.2+dfsg/docs/index.rst000066400000000000000000000110421477231266000217740ustar00rootroot00000000000000:sd_hide_title: ============== fortls ============== .. div:: landing-title :style: padding: 0.1rem 0.5rem 0.6rem 0; background-image: linear-gradient(315deg, #2753e3 0%, #734f96 74%); clip-path: polygon(0px 0px, 100% 0%, 100% 100%, 0% calc(100% - 1.5rem)); -webkit-clip-path: polygon(0px 0px, 100% 0%, 100% 100%, 0% calc(100% - 1.5rem)); .. grid:: :reverse: :gutter: 2 3 3 3 :margin: 4 4 1 2 .. grid-item:: :columns: 12 6 6 6 .. image:: ../assets/logo2-animated.svg :alt: fortls :width: 100% .. grid-item:: :columns: 12 6 6 6 :child-align: justify :class: sd-text-white sd-fs-3 A Language Server for Fortran providing code completion, diagnostics, hovering and more. .. button-ref:: quickstart :ref-type: doc :outline: :color: white :class: sd-px-4 sd-fs-5 Get Started .. .. grid:: 2 .. :gutter: 0 .. :class-container: sd-text-center sd-pt-4 .. :class-row: sd-align-minor-center .. .. grid-item:: .. .. button-link:: https://github.com/sponsors/gnikit .. :ref-type: ref .. :outline: .. :color: danger .. :class: sd-px-2 sd-fs-4 .. Become a **Sponsor** .. :octicon:`mark-github;2em;sd-text-black` .. :octicon:`heart-fill;2em;sd-text-danger` .. .. grid-item:: .. .. button-link:: https://www.paypal.com/paypalme/inikit .. :ref-type: ref .. :color: primary .. :class: sd-px-2 sd-fs-5 .. Make a **Donation** .. :fa:`fa-paypal` .. div:: sd-text-center *A tool to supercharge Fortran development!* .. tab-set:: :class: sd-align-major-center .. tab-item:: Completion :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 .. image:: ../assets/lsp/completion-ani.gif .. tab-item:: Hover :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 .. image:: ../assets/lsp/hover2.png .. tab-item:: Rename :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 .. image:: ../assets/lsp/rename2.gif .. tab-item:: Symbols :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 .. image:: ../assets/lsp/symbols-crop.png .. tab-item:: References :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 .. image:: ../assets/lsp/definition-peek.png .. tab-item:: Diagnostics :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 .. image:: ../assets/lsp/diagnostics1.png .. TODO: here go the sponsors .. toctree:: :hidden: quickstart.rst .. toctree:: :maxdepth: 2 :caption: Components :hidden: features.rst editor_integration.rst options.rst fortls_changes.md .. toctree:: :maxdepth: 2 :caption: Get Involved :hidden: contributing.rst .. toctree:: :maxdepth: 2 :caption: Contact Us :hidden: contact.rst .. toctree:: :hidden: :caption: Development modules.rst .. grid:: 1 2 3 3 :margin: 4 4 0 0 :gutter: 1 .. grid-item-card:: :octicon:`desktop-download;5em;sd-text-primary` :link-type: any :link: Download :class-body: sd-text-center Download .. grid-item-card:: :material-sharp:`import_contacts;5em;sd-text-primary` :class-body: sd-text-center :link: features :link-type: doc Features .. grid-item-card:: :material-outlined:`settings;5em;sd-text-primary` :link-type: doc :link: options :class-body: sd-text-center Configuration Options .. grid-item-card:: :octicon:`browser;5em;sd-text-primary` :link-type: doc :link: editor_integration :class-body: sd-text-center Editor Integration .. grid-item-card:: :material-round:`mail;5em;sd-text-primary` :link-type: doc :link: contact :class-body: sd-text-center Contact Us .. grid-item-card:: :octicon:`git-pull-request;5em;sd-text-primary` :link-type: doc :link: contributing :class-body: sd-text-center Contribute .. Include native markdown into native rst .. include:: README.md :parser: myst_parser.sphinx_ fortran-language-server-3.2.2+dfsg/docs/make.bat000066400000000000000000000013751477231266000215500ustar00rootroot00000000000000@ECHO OFF pushd %~dp0 REM Command file for Sphinx documentation if "%SPHINXBUILD%" == "" ( set SPHINXBUILD=sphinx-build ) set SOURCEDIR=. set BUILDDIR=_build if "%1" == "" goto help %SPHINXBUILD% >NUL 2>NUL if errorlevel 9009 ( echo. echo.The 'sphinx-build' command was not found. Make sure you have Sphinx echo.installed, then set the SPHINXBUILD environment variable to point echo.to the full path of the 'sphinx-build' executable. Alternatively you echo.may add the Sphinx directory to PATH. echo. echo.If you don't have Sphinx installed, grab it from echo.https://www.sphinx-doc.org/ exit /b 1 ) %SPHINXBUILD% -M %1 %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% goto end :help %SPHINXBUILD% -M help %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% :end popd fortran-language-server-3.2.2+dfsg/docs/modules.rst000066400000000000000000000002631477231266000223400ustar00rootroot00000000000000Documentation ========================== .. toctree:: :maxdepth: 4 fortls Indices and tables ================== * :ref:`genindex` * :ref:`modindex` .. * :ref:`search` fortran-language-server-3.2.2+dfsg/docs/options.rst000066400000000000000000000165071477231266000223730ustar00rootroot00000000000000Configuration options ===================== ``fortls`` can be configured through the command line interface and/or through a configuration file (by default named ``.fortls``). The options available from the command line and through the configuration file are identical and interchangeable. .. important:: Options defined in the configuration file have precedence over command line arguments. The following sections discuss the available settings in detail. .. _cmd_interface: Configuration using the command line ------------------------------------ .. argparse:: :module: fortls :func: cli :prog: fortls :nodefault: Configuration using a file -------------------------- A configuration file is a JSONC (JSON with comments) file that contains project specific settings for ``fortls``. By default, the Language Server will recognise 3 default names ``.fortlsrc``, ``.fortls.json`` and ``.fortls`` (in that order) under the ``root_path`` of the project, e.g. ``root_path/.fortlsrc``. A different configuration file name can be passed with the command line interface options ``--config`` e.g. ``fortls --config my_project.json``. The settings that can be specified in the configuration file are identical to the ones available through the command line interface having removed the leading ``--`` characters. For the command line interface see :ref:`cmd_interface`. Available options ################# All the ``fortls`` settings with their default arguments can be found below .. code-block:: json { "nthreads": 4, "notify_init": false, "incremental_sync": false, "recursion_limit": 1000, "sort_keywords": false, "disable_autoupdate": false, "debug_log": false, "source_dirs": ["./**"], "incl_suffixes": [], "excl_suffixes": [], "excl_paths": [], "autocomplete_no_prefix": false, "autocomplete_no_snippets": false, "autocomplete_name_only": false, "lowercase_intrinsics": false, "use_signature_help": false, "hover_signature": false, "hover_language": "fortran90", "max_line_length": -1, "max_comment_line_length": -1, "disable_diagnostics": false, "pp_suffixes": [], "include_dirs": [], "pp_defs": {}, "symbol_skip_mem": false, "enable_code_actions": false } Sources file parsing #################### source_dirs *********** .. code-block:: json { "source_dirs": ["./**", "/external/fortran/src"] } By default all directories under the current project will be recursively parsed for Fortran sources. Alternatively, one can define a series of directories for ``fortls`` to look for source files .. note:: glob fnmatch style patterns are allowed incl_suffixes ************* .. code-block:: json { "incl_suffixes": [".h", ".FYP", "inc"] } ``fortls`` will parse only files with ``incl_suffixes`` extensions found in ``source_dirs``. Using the above example, ``fortls`` will match files by the ``file.h`` and ``file.FYP``, but not ``file.fyp`` or ``filefyp``. It will also match ``file.inc`` and ``fileinc`` but not ``file.inc2``. By default, ``incl_suffixes`` are defined as .F .f .F03 .f03 .F05 .f05 .F08 .f08 .F18 .f18 .F77 .f77 .F90 .f90 .F95 .f95 .FOR .for .FPP .fpp. Additional source file extensions can be defined in ``incl_suffixes``. .. note:: The default file extensions cannot be overwritten. ``incl_suffixes`` will only append to the default extensions. excl_suffixes ************* .. code-block:: json { "excl_suffixes": ["_tmp.f90", "_hdf5.F90"] } If certain files or suffixes do not need to be parsed these can be excluded by deffining ``excl_suffixes`` excl_paths ********** Entire directories can be excluded from parsing by including them in ``excl_paths``. .. note:: glob fnmatch style patterns are allowed ``excl_paths`` uses glob patterns so if you want to exclude a directory and all its subdirectories from being parsed you should define it like so .. code-block:: json { "excl_paths": ["exclude_dir/**"] } Preprocessor ############ pp_suffixes *********** .. code-block:: json { "pp_suffixes" : [".h", ".F90", ".fpp"] } By default preprocessor definitions are parsed for all Fortran source files with uppercase extensions e.g. ``.F90``, ``.F``, ``.F08``, etc.. However, the default behaviour can be overriden by defining ``pp_defs``. include_dirs ************ .. code-block:: json { "include_dirs": ["include", "preprocessor", "/usr/include"] } By default ``fortls`` will scan the project's directories for files with extensions ``PP_SUFFIXES`` to parse for **preprocessor definitions**. However, if the preprocessor files are external to the project, their locations can be specific via ``include_dirs``. .. note:: glob fnmatch style patterns are allowed .. warning:: Source files detected in ``include_dirs`` will not be parsed for Fortran objects unless they are also included in ``source_dirs``. pp_defs ******* .. code-block:: json { "pp_defs": { "HAVE_PETSC": "" "Mat": "type(tMat)" } } Additional **preprocessor definitions** from what are specified in files found in ``include_dirs`` can be defined in ``pp_defs``. .. note:: Definitions in ``pp_defs`` will override definitions from ``include_dirs`` Limitations *********** - Recursive substitution is not available e.g. .. code-block:: cpp #define VAR1 10 #define VAR2 VAR1 Debug Options (command line only) --------------------------------- Options for debugging language server - ``--debug_filepath DEBUG_FILEPATH`` File path for language server tests - ``--debug_rootpath DEBUG_ROOTPATH`` Root path for language server tests - ``--debug_parser`` Test source code parser on specified file - ``--debug_preproc`` Test preprocessor on specified file - ``--debug_hover`` Test `textDocument/hover` request for specified file and position - ``--debug_rename RENAME_STRING`` Test `textDocument/rename` request for specified file and position - ``--debug_actions`` Test `textDocument/codeAction` request for specified file and position - ``--debug_symbols`` Test `textDocument/documentSymbol` request for specified file - ``--debug_completion`` Test `textDocument/completion` request for specified file and position - ``--debug_signature`` Test `textDocument/signatureHelp` request for specified file and position - ``--debug_definition`` Test `textDocument/definition` request for specified file and position - ``--debug_references`` Test `textDocument/references` request for specified file and position - ``--debug_diagnostics`` Test diagnostic notifications for specified file - ``--debug_implementation`` Test `textDocument/implementation` request for specified file and position - ``--debug_workspace_symbols QUERY_STRING`` Test `workspace/symbol` request - ``--debug_line INTEGER`` Line position for language server tests (1-indexed) - ``--debug_char INTEGER`` Character position for language server tests (1-indexed) - ``--debug_full_result`` Print full result object instead of condensed version fortran-language-server-3.2.2+dfsg/docs/quickstart.rst000066400000000000000000000054671477231266000230750ustar00rootroot00000000000000Get Started ########### .. article-info:: :avatar: ../assets/f.svg :avatar-link: https://github.com/gnikit :author: `gnikit `__ :date: |today| :read-time: 1 min read :class-avatar: sd-animate-grow50-rot20 ``fortls`` is a tool known as a language server that interfaces with your code editor (VS Code, Vim, etc.) to provide features like code completion, code navigation, hover messages, and many more. Download ******** The project is available for download through the **PyPi** and **Anaconda** package managers .. tab-set:: .. tab-item:: PyPi .. code-block:: sh pip install fortls For more information see `pypi/fortls`_ .. _pypi/fortls: https://pypi.python.org/pypi/fortls .. tab-item:: Anaconda .. code-block:: sh conda install -c conda-forge fortls For more installation instructions, see `conda-forge/fortls`_. .. _conda-forge/fortls: https://github.com/conda-forge/fortls-feedstock#about-fortls .. tab-item:: Brew .. code-block:: sh brew install fortls For more installation instructions, see `brew/fortls`_. .. _brew/fortls: https://formulae.brew.sh/formula/fortls .. tab-item:: Source Alternatively, one can install the development version from **GitHub** via .. code-block:: sh pip install --user --upgrade git+git://github.com/fortran-lang/fortls .. warning:: It is **NOT** possible having ``fortls`` and ``fortran-language-server`` simultaneously installed, since they use the same executable name. If you are having trouble getting ``fortls`` to work try uninstalling ``fortran-language-server`` and reinstalling ``fortls``. Usage ***** To make full use of ``fortls`` in your workflow you need to - integrate it into your code editor, see: :doc:`editor_integration` - (Optional) configure any additional settings to ``fortls``, see: :doc:`options` Integration =========== Depending on the code editor used, different steps will have to be followed to integrate ``fortls``. Luckily, we support numerous code editors and have detailed instructions in the :doc:`editor_integration` section. .. card:: Example: VS Code Setting up ``fortls`` with `VS Code`_ is as simple as installing the `Modern Fortran`_ extension. .. _VS Code: https://code.visualstudio.com .. _Modern Fortran: https://marketplace.visualstudio.com/items?itemName=fortran-lang.linter-gfortran Configuration ============= The Language Server by default is configured with reasonable settings however, depending on the project additional settings might need to be configured, such as source file paths, or additional preprocessor definitions. Instructions on how to do this and much more can be found in the :doc:`options` section. fortran-language-server-3.2.2+dfsg/fortls/000077500000000000000000000000001477231266000205165ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/fortls/__init__.py000066400000000000000000000017201477231266000226270ustar00rootroot00000000000000from __future__ import annotations import sys from multiprocessing import freeze_support from .debug import ( DebugError, debug_lsp, debug_parser, debug_preprocessor, is_debug_mode, ) from .interface import cli from .jsonrpc import JSONRPC2Connection, ReadWriter from .langserver import LangServer from .version import __version__ __all__ = ["__version__"] def main(): freeze_support() args = cli(__name__).parse_args() try: if args.debug_parser: debug_parser(args) elif args.debug_preproc: debug_preprocessor(args) elif is_debug_mode(args): debug_lsp(args, vars(args)) else: stdin, stdout = sys.stdin.buffer, sys.stdout.buffer LangServer( conn=JSONRPC2Connection(ReadWriter(stdin, stdout)), settings=vars(args), ).run() except DebugError as e: print(f"ERROR: {e}") sys.exit(-1) fortran-language-server-3.2.2+dfsg/fortls/__main__.py000066400000000000000000000000721477231266000226070ustar00rootroot00000000000000from . import main if __name__ == "__main__": main() fortran-language-server-3.2.2+dfsg/fortls/constants.py000066400000000000000000000027401477231266000231070ustar00rootroot00000000000000from __future__ import annotations import logging from fortls.regex_patterns import FortranRegularExpressions log = logging.getLogger(__name__) # Global variables sort_keywords = True # Keyword identifiers KEYWORD_LIST = [ "pointer", "allocatable", "optional", "public", "private", "nopass", "target", "save", "parameter", "contiguous", "deferred", "dimension", "intent", "pass", "pure", "impure", "elemental", "recursive", "abstract", "external", ] KEYWORD_ID_DICT = {keyword: ind for (ind, keyword) in enumerate(KEYWORD_LIST)} # Type identifiers BASE_TYPE_ID = -1 MODULE_TYPE_ID = 1 SUBROUTINE_TYPE_ID = 2 FUNCTION_TYPE_ID = 3 CLASS_TYPE_ID = 4 INTERFACE_TYPE_ID = 5 VAR_TYPE_ID = 6 METH_TYPE_ID = 7 SUBMODULE_TYPE_ID = 8 BLOCK_TYPE_ID = 9 SELECT_TYPE_ID = 10 DO_TYPE_ID = 11 WHERE_TYPE_ID = 12 IF_TYPE_ID = 13 ASSOC_TYPE_ID = 14 ENUM_TYPE_ID = 15 class Severity: error = 1 warn = 2 info = 3 #: A string used to mark literals e.g. 10, 3.14, "words", etc. #: The description name chosen is non-ambiguous and cannot naturally #: occur in Fortran (with/out C preproc) code #: It is invalid syntax to define a type starting with numerics #: it cannot also be a comment that requires !, c, d #: and ^= (xor_eq) operator is invalid in Fortran C++ preproc FORTRAN_LITERAL = "0^=__LITERAL_INTERNAL_DUMMY_VAR_" # Fortran Regular Expressions dataclass variable, immutable FRegex = FortranRegularExpressions() fortran-language-server-3.2.2+dfsg/fortls/debug.py000066400000000000000000000457421477231266000221720ustar00rootroot00000000000000from __future__ import annotations import logging import os import pprint import sys import json5 from .helper_functions import only_dirs, resolve_globs from .jsonrpc import JSONRPC2Connection, ReadWriter, path_from_uri from .langserver import LangServer from .parsers.internal.parser import FortranFile, preprocess_file class DebugError(Exception): """Base class for debug CLI.""" class ParameterError(DebugError): """Exception raised for errors in the parameters.""" def is_debug_mode(args): debug_flags = [ "debug_diagnostics", "debug_symbols", "debug_completion", "debug_signature", "debug_definition", "debug_hover", "debug_implementation", "debug_references", "debug_rename", "debug_actions", "debug_rootpath", "debug_workspace_symbols", ] return any(getattr(args, flag, False) for flag in debug_flags) def debug_lsp(args, settings): debug_functions = { "debug_rootpath": debug_rootpath, "debug_diagnostics": debug_diagnostics, "debug_symbols": debug_symbols, "debug_workspace_symbols": debug_workspace_symbols, "debug_completion": debug_completion, "debug_hover": debug_hover, "debug_signature": debug_signature, "debug_definition": debug_definition, "debug_references": debug_references, "debug_implementation": debug_implementation, "debug_rename": debug_rename, "debug_actions": debug_actions, } r, w = os.pipe() with os.fdopen(r, "rb") as buffer_in, os.fdopen(w, "wb") as buffer_out: server = LangServer( conn=JSONRPC2Connection(ReadWriter(buffer_in, buffer_out)), settings=settings, ) for flag, function in debug_functions.items(): if getattr(args, flag, False): function(args, server) separator() def debug_rootpath(args, server): if not os.path.isdir(args.debug_rootpath): raise DebugError("'debug_rootpath' not specified for debug request") print('\nTesting "initialize" request:') print(f' Root = "{args.debug_rootpath}"') server.serve_initialize({"params": {"rootPath": args.debug_rootpath}}) separator() if len(server.post_messages) == 0: print(" Successful!") else: print(" Successful with errors:") for message in server.post_messages: print(f" {message[1]}") print("\n Source directories:") for source_dir in server.source_dirs: print(f" {source_dir}") def debug_diagnostics(args, server): def lsp_request(): server.serve_onSave({"params": {"textDocument": {"uri": args.debug_filepath}}}) results, _ = server.get_diagnostics(args.debug_filepath) return results def format_results(results, _): sev_map = ["ERROR", "WARNING", "INFO"] if len(results) == 0: print("No errors or warnings") else: print("Reported Diagnostics:") for diag in results: sline = diag["range"]["start"]["line"] message = diag["message"] sev = sev_map[diag["severity"] - 1] print(f' {sline:5d}:{sev} "{message}"') debug_generic( args, "textDocument/publishDiagnostics", lsp_request, format_results, loc_needed=False, ) def debug_symbols(args, server): def lsp_request(): server.serve_onSave({"params": {"textDocument": {"uri": args.debug_filepath}}}) return server.serve_document_symbols( {"params": {"textDocument": {"uri": args.debug_filepath}}} ) def format_results(results, _): for symbol in results: sline = symbol["location"]["range"]["start"]["line"] parent = "null" if "containerName" in symbol: parent = symbol["containerName"] print( f" line {sline:5d} symbol -> " f"{symbol['kind']:3d}:{symbol['name']:30} parent = {parent}" ) debug_generic( args, "textDocument/documentSymbol", lsp_request, format_results, loc_needed=False, ) def debug_workspace_symbols(args, server): def lsp_request(): if args.debug_rootpath is None: raise DebugError("'debug_rootpath' not specified for debug request") return server.serve_workspace_symbol( {"params": {"query": args.debug_workspace_symbols}} ) def format_results(results, args): for symbol in results: path = path_from_uri(symbol["location"]["uri"]) sline = symbol["location"]["range"]["start"]["line"] parent = "null" if "containerName" in symbol: parent = symbol["containerName"] print( f" {parent}::{sline} symbol -> {symbol['name']:30} parent = " f"{os.path.relpath(path, args.debug_rootpath)}" ) debug_generic( args, "workspace/symbol", lsp_request, format_results, loc_needed=False, ) def debug_completion(args, server): def lsp_request(): server.serve_onSave({"params": {"textDocument": {"uri": args.debug_filepath}}}) return server.serve_autocomplete( { "params": { "textDocument": {"uri": args.debug_filepath}, "position": { "line": args.debug_line - 1, "character": args.debug_char - 1, }, } } ) def format_results(results, _): for obj in results: print(f" {obj['kind']}: {obj['label']} -> {obj['detail']}") debug_generic(args, "textDocument/completion", lsp_request, format_results) def debug_hover(args, server): def lsp_request(): server.serve_onSave({"params": {"textDocument": {"uri": args.debug_filepath}}}) return server.serve_hover( { "params": { "textDocument": {"uri": args.debug_filepath}, "position": { "line": args.debug_line - 1, "character": args.debug_char - 1, }, } } ) def format_results(results, _): contents = results["contents"] if isinstance(contents, dict): print(contents["value"]) else: print(contents) debug_generic(args, "textDocument/hover", lsp_request, format_results) def debug_signature(args, server): def lsp_request(): server.serve_onSave({"params": {"textDocument": {"uri": args.debug_filepath}}}) return server.serve_signature( { "params": { "textDocument": {"uri": args.debug_filepath}, "position": { "line": args.debug_line - 1, "character": args.debug_char - 1, }, } } ) def format_results(results, _): active_param = results.get("activeParameter", 0) print(f" Active param = {active_param}") active_signature = results.get("activeSignature", 0) print(f" Active sig = {active_signature}") for i, signature in enumerate(results["signatures"]): print(f" {signature['label']}") for j, obj in enumerate(signature["parameters"]): active_mark = " " if (i == active_signature) and (j == active_param): active_mark = "*" arg_desc = obj.get("documentation") if arg_desc is not None: print(f"{active_mark} {arg_desc} :: {obj['label']}") else: print(f"{active_mark} {obj['label']}") debug_generic(args, "textDocument/signatureHelp", lsp_request, format_results) def debug_definition(args, server): def lsp_request(): server.serve_onSave({"params": {"textDocument": {"uri": args.debug_filepath}}}) return server.serve_definition( { "params": { "textDocument": {"uri": args.debug_filepath}, "position": { "line": args.debug_line - 1, "character": args.debug_char - 1, }, } } ) def format_results(results, _): print(f' URI = "{results["uri"]}"') print(f' Line = {results["range"]["start"]["line"] + 1}') print(f' Char = {results["range"]["start"]["character"] + 1}') debug_generic(args, "textDocument/definition", lsp_request, format_results) def debug_references(args, server): def lsp_request(): server.serve_onSave({"params": {"textDocument": {"uri": args.debug_filepath}}}) return server.serve_references( { "params": { "textDocument": {"uri": args.debug_filepath}, "position": { "line": args.debug_line - 1, "character": args.debug_char - 1, }, } } ) def format_results(results, _): for result in results: print( f" {result['uri']} ({result['range']['start']['line'] + 1}" f", {result['range']['start']['character'] + 1})" ) debug_generic(args, "textDocument/references", lsp_request, format_results) def debug_implementation(args, server): def lsp_request(): server.serve_onSave({"params": {"textDocument": {"uri": args.debug_filepath}}}) return server.serve_implementation( { "params": { "textDocument": {"uri": args.debug_filepath}, "position": { "line": args.debug_line - 1, "character": args.debug_char - 1, }, } } ) def format_results(results, _): print(f' URI = "{results["uri"]}"') print(f' Line = {results["range"]["start"]["line"] + 1}') print(f' Char = {results["range"]["start"]["character"] + 1}') debug_generic(args, "textDocument/implementation", lsp_request, format_results) def debug_rename(args, server): def lsp_request(): server.serve_onSave({"params": {"textDocument": {"uri": args.debug_filepath}}}) return server.serve_rename( { "params": { "textDocument": {"uri": args.debug_filepath}, "position": { "line": args.debug_line - 1, "character": args.debug_char - 1, }, "newName": args.debug_rename, } } ) def format_results(results, _): for uri, changes in results["changes"].items(): path = path_from_uri(uri) file_obj = server.workspace.get(path) if file_obj is not None: file_contents = file_obj.contents_split process_file_changes(path, changes, file_contents) else: print(f'Unknown file: "{path}"') debug_generic(args, "textDocument/rename", lsp_request, format_results) def debug_actions(args, server): def lsp_request(): server.serve_onSave({"params": {"textDocument": {"uri": args.debug_filepath}}}) return server.serve_codeActions( { "params": { "textDocument": {"uri": args.debug_filepath}, "range": { "start": { "line": args.debug_line - 1, "character": args.debug_char - 1, }, "end": { "line": args.debug_line - 1, "character": args.debug_char - 1, }, }, } } ) def process_results(results, _): pp = pprint.PrettyPrinter(indent=2, width=120) for result in results: print(f"Kind = '{result['kind']}', Title = '{result['title']}'") for edit_uri, edit_change in result["edit"]["changes"].items(): print(f"\nChange: URI = '{edit_uri}'") pp.pprint(edit_change) print() debug_generic(args, "textDocument/getActions", lsp_request, process_results) def process_file_changes(file_path, changes, file_contents): print(f'File: "{file_path}"') for change in changes: start_line = change["range"]["start"]["line"] end_line = change["range"]["end"]["line"] start_col = change["range"]["start"]["character"] end_col = change["range"]["end"]["character"] print(f" {start_line + 1}, {end_line + 1}") new_contents = [] for i in range(start_line, end_line + 1): line = file_contents[i] print(f" - {line}") line_content = line if i == start_line: line_content = line[:start_col] + change["newText"] if i == end_line: line_content += line[end_col:] new_contents.append(line_content) for line in new_contents: print(f" + {line}") print() def debug_parser(args): """Debug the parser of the Language Server Triggered by `--debug_parser` option. Parameters ---------- args : Namespace The arguments parsed from the `ArgumentParser` """ print("\nTesting parser") separator() ensure_file_accessible(args.debug_filepath) pp_suffixes, pp_defs, include_dirs = read_config(args.debug_rootpath, args.config) print(f' File = "{args.debug_filepath}"') file_obj = FortranFile(args.debug_filepath, pp_suffixes) err_str, _ = file_obj.load_from_disk() if err_str: raise DebugError(f"Reading file failed: {err_str}") print(f" Detected format: {'fixed' if file_obj.fixed else 'free'}") print("\n" + "=" * 80 + "\nParser Output\n" + "=" * 80 + "\n") file_ast = file_obj.parse(debug=True, pp_defs=pp_defs, include_dirs=include_dirs) print("\n" + "=" * 80 + "\nObject Tree\n" + "=" * 80 + "\n") for obj in file_ast.get_scopes(): print(f"{obj.get_type()}: {obj.FQSN}") print_children(obj) print("\n" + "=" * 80 + "\nExportable Objects\n" + "=" * 80 + "\n") for _, obj in file_ast.global_dict.items(): print(f"{obj.get_type()}: {obj.FQSN}") separator() def debug_preprocessor(args): """Debug the preprocessor of the Language Server Triggered by `--debug_preprocessor` option. Parameters ---------- args : Namespace The arguments parsed from the `ArgumentParser` """ def sep_lvl2(heading: str): print("\n" + "=" * 75 + f"\n{heading}\n" + "=" * 75) print("\nTesting preprocessor") separator() logging.basicConfig(level=logging.DEBUG, stream=sys.stdout, format="%(message)s") file = args.debug_filepath ensure_file_accessible(file) with open(file, encoding="utf-8") as f: lines = f.readlines() root = args.debug_rootpath if args.debug_rootpath else os.path.dirname(file) _, pp_defs, include_dirs = read_config(root, args.config) sep_lvl2("Preprocessor Pass:") output, skips, defines, defs = preprocess_file( lines, file, pp_defs, include_dirs, debug=True ) sep_lvl2("Preprocessor Skipped Lines:") for line in skips: print(f" {line}") sep_lvl2("Preprocessor Macros:") for key, value in defs.items(): print(f" {key} = {value}") sep_lvl2("Preprocessor Defines (#define):") for line in defines: print(f" {line}") sep_lvl2("Preprocessor Final Output:") for line in output: print(rf" {line.rstrip()}") separator() def ensure_file_accessible(filepath: str): """Ensure the file exists and is accessible, raising an error if not.""" if not os.path.isfile(filepath): raise DebugError(f"File '{filepath}' does not exist or is not accessible") print(f' File = "{filepath}"') def check_request_params(args, loc_needed=True): ensure_file_accessible(args.debug_filepath) if loc_needed: if args.debug_line is None: raise ParameterError("'debug_line' not specified for debug request") print(f" Line = {args.debug_line}") if args.debug_char is None: raise ParameterError("'debug_char' not specified for debug request") print(f" Char = {args.debug_char}\n") def locate_config(root: str, input_config: str) -> str | None: default_conf_files = [input_config, ".fortlsrc", ".fortls.json5", ".fortls"] present_conf_files = [ os.path.isfile(os.path.join(root, f)) for f in default_conf_files ] if not any(present_conf_files): return None # Load the first config file found for f, present in zip(default_conf_files, present_conf_files): if not present: continue config_path = os.path.join(root, f) return config_path def read_config(root: str | None, input_config: str): pp_suffixes = None pp_defs = {} include_dirs = set() if root is None: return pp_suffixes, pp_defs, include_dirs # Check for config files config_path = locate_config(root, input_config) print(f" Config file = {config_path}") if config_path is None or not os.path.isfile(config_path): return pp_suffixes, pp_defs, include_dirs try: with open(config_path, encoding="utf-8") as fhandle: config_dict = json5.load(fhandle) pp_suffixes = config_dict.get("pp_suffixes", None) pp_defs = config_dict.get("pp_defs", {}) for path in config_dict.get("include_dirs", set()): include_dirs.update(only_dirs(resolve_globs(path, root))) if isinstance(pp_defs, list): pp_defs = {key: "" for key in pp_defs} except ValueError as e: print(f"Error {e} while parsing '{config_path}' settings file") return pp_suffixes, pp_defs, include_dirs def debug_generic(args, test_label, lsp_request, format_results, loc_needed=True): print(f'\nTesting "{test_label}" request:') check_request_params(args, loc_needed) results = lsp_request() separator() print_results(results, format_results, args) def print_results(results, format_results, args): """Helper function to print results based on detail level requested.""" if results is None: print(" No result found!") return if args.debug_full_result: print(json5.dumps(results, indent=2)) return format_results(results, args) def print_children(obj, indent=""): for child in obj.get_children(): print(f" {indent}{child.get_type()}: {child.FQSN}") print_children(child, indent + " ") def separator(): print("=" * 80) fortran-language-server-3.2.2+dfsg/fortls/fortls.schema.json000066400000000000000000000144541477231266000241710ustar00rootroot00000000000000{ "description": "Schema for the fortls Fortran Language Server", "properties": { "config": { "default": ".fortlsrc", "description": "Configuration options file (default file name: .fortlsrc, other default supported names: .fortls.json, .fortls)", "title": "Config", "type": "string" }, "nthreads": { "default": 4, "description": "Number of threads to use during workspace initialization (default: 4)", "title": "Nthreads", "type": "integer" }, "notify_init": { "default": false, "description": "Send notification message when workspace initialization is complete", "title": "Notify Init", "type": "boolean" }, "incremental_sync": { "default": false, "description": "Use incremental document synchronization (beta)", "title": "Incremental Sync", "type": "boolean" }, "recursion_limit": { "default": 1000, "description": "Set the maximum recursion depth for the parser (default: 1000)", "title": "Recursion Limit", "type": "integer" }, "sort_keywords": { "default": false, "description": "Display variable keywords information, function/subroutine definitions, etc. in a consistent (sorted) manner default: no sorting, display code as is)", "title": "Sort Keywords", "type": "boolean" }, "disable_autoupdate": { "default": false, "description": "fortls automatically checks PyPi for newer version and installs them.Use this option to disable the autoupdate feature.", "title": "Disable Autoupdate", "type": "boolean" }, "preserve_keyword_order": { "default": false, "description": "DEPRECATED, this is now the default. To sort use sort_keywords", "title": "Preserve Keyword Order", "type": "boolean" }, "debug_log": { "default": false, "description": "Generate debug log in project root folder", "title": "Debug Log", "type": "boolean" }, "source_dirs": { "default": [], "description": "Folders containing source files (default: set())", "items": {}, "title": "Source Dirs", "type": "array", "uniqueItems": true }, "incl_suffixes": { "default": [], "description": "Consider additional file extensions to the default (default: .F, .F77, .F90, .F95, .F03, .F08, .FOR, .FPP (lower & upper casing))", "items": {}, "title": "Incl Suffixes", "type": "array", "uniqueItems": true }, "excl_suffixes": { "default": [], "description": "Source file extensions to be excluded (default: set())", "items": {}, "title": "Excl Suffixes", "type": "array", "uniqueItems": true }, "excl_paths": { "default": [], "description": "Folders to exclude from parsing", "items": {}, "title": "Excl Paths", "type": "array", "uniqueItems": true }, "autocomplete_no_prefix": { "default": false, "description": "Do not filter autocomplete results by variable prefix", "title": "Autocomplete No Prefix", "type": "boolean" }, "autocomplete_no_snippets": { "default": false, "description": "Do not use snippets with place holders in autocomplete results", "title": "Autocomplete No Snippets", "type": "boolean" }, "autocomplete_name_only": { "default": false, "description": "Complete only the name of procedures and not the parameters", "title": "Autocomplete Name Only", "type": "boolean" }, "lowercase_intrinsics": { "default": false, "description": "Use lowercase for intrinsics and keywords in autocomplete requests", "title": "Lowercase Intrinsics", "type": "boolean" }, "use_signature_help": { "default": false, "description": "Use signature help instead of subroutine/function snippets. This effectively sets --autocomplete_no_snippets", "title": "Use Signature Help", "type": "boolean" }, "variable_hover": { "default": false, "description": "DEPRECATED: This option is always on. Show hover information for variables", "title": "Variable Hover", "type": "boolean" }, "hover_signature": { "default": false, "description": "Show signature information in hover for arguments ", "title": "Hover Signature", "type": "boolean" }, "hover_language": { "default": "fortran90", "description": "Language used for responses to hover requests a VSCode language id (default: fortran90)", "title": "Hover Language", "type": "string" }, "max_line_length": { "default": -1, "description": "Maximum line length (default: -1)", "title": "Max Line Length", "type": "integer" }, "max_comment_line_length": { "default": -1, "description": "Maximum comment line length (default: -1)", "title": "Max Comment Line Length", "type": "integer" }, "disable_diagnostics": { "default": false, "description": "Disable diagnostics", "title": "Disable Diagnostics", "type": "boolean" }, "pp_suffixes": { "default": [], "description": "File extensions to be parsed ONLY for preprocessor commands (default: all uppercase source file suffixes)", "items": {}, "title": "Pp Suffixes", "type": "array", "uniqueItems": true }, "include_dirs": { "default": [], "description": "Folders containing preprocessor files with extensions PP_SUFFIXES.", "items": {}, "title": "Include Dirs", "type": "array", "uniqueItems": true }, "pp_defs": { "default": {}, "description": "A dictionary with additional preprocessor definitions. Preprocessor definitions are normally included via INCLUDE_DIRS", "title": "Pp Defs", "type": "object" }, "symbol_skip_mem": { "default": false, "description": "Do not include type members in document symbol results", "title": "Symbol Skip Mem", "type": "boolean" }, "enable_code_actions": { "default": false, "description": "Enable experimental code actions (default: false)", "title": "Enable Code Actions", "type": "boolean" } }, "title": "fortls schema", "type": "object" } fortran-language-server-3.2.2+dfsg/fortls/ftypes.py000066400000000000000000000072411477231266000224060ustar00rootroot00000000000000from __future__ import annotations from dataclasses import dataclass, field from typing import NamedTuple #: A single line range tuple Range = NamedTuple("Range", [("start", int), ("end", int)]) @dataclass class VarInfo: """Holds information about a Fortran VARIABLE""" var_type: str #: Type of variable e.g. ``INTEGER``, ``REAL``, etc. #: keywords associated with this variable e.g. SAVE, DIMENSION, etc. keywords: list[str] #: Keywords associated with variable var_names: list[str] #: Variable names #: Kind of variable e.g. ``INTEGER*4`` etc. var_kind: str | None = field(default=None) @dataclass class SelectInfo: """Holds information about a SELECT construct""" type: int #: Type of SELECT e.g. normal, select type, select kind, select rank binding: str #: Variable/Object being selected upon desc: str #: Description of select e.g. "TYPE", "CLASS", None @dataclass class ClassInfo: """Holds information about a Fortran CLASS""" name: str #: Class name parent: str #: Parent object of class e.g. ``TYPE, EXTENDS(scaled_vector) :: a`` keywords: list[str] #: Keywords associated with the class @dataclass class UseInfo: """Holds information about a Fortran USE statement""" mod_name: str #: Module name #: List of procedures, variables, interfaces, etc. imported via only only_list: set[str] #: A dictionary holding the new names after a rename operation rename_map: dict[str, str] @dataclass class GenProcDefInfo: """Holds information about a GENERIC PROCEDURE DEFINITION""" bound_name: str #: Procedure name pro_links: list[str] #: Procedure links vis_flag: int #: Visibility flag, public or private @dataclass class SmodInfo: """Holds information about Fortran SUBMODULES""" name: str #: Submodule name parent: str #: Submodule i.e. module, parent @dataclass class InterInfo: """Holds information about a Fortran INTERFACE""" name: str #: Interface name abstract: bool #: Whether or not the interface is abstract @dataclass class VisInfo: """Holds information about the VISIBILITY of a module's contents""" type: int #: Visibility type 0: PUBLIC 1: PRIVATE TODO: convert to boolean obj_names: list[str] #: Module variables, procedures, etc. with that visibility @dataclass class IncludeInfo: """Holds information about a Fortran INCLUDE statement""" line_number: int #: Line number of include path: str #: File path to include file: None # fortran_file #: fortran_file object scope_objs: list[str] #: A list of available scopes @dataclass class SubInfo: """Holds information about a Fortran SUBROUTINE""" name: str #: Procedure name args: str #: Argument list #: Keywords associated with procedure keywords: list[str] = field(default_factory=list) #: Whether or not this is a ``MODULE PROCEDURE`` mod_flag: bool = field(default=False) @dataclass class ResultSig: """Holds information about the RESULT section of a Fortran FUNCTION""" name: str | None = field(default=None) #: Variable name of result type: str | None = field(default=None) #: Variable type of result kind: str | None = field(default=None) #: Variable kind of result #: Keywords associated with the result variable, can append without init keywords: list[str] = field(default_factory=list) @dataclass class FunSig(SubInfo): """Holds information about a Fortran FUNCTION""" #: Function's result with default ``result.name = name`` result: ResultSig = field(default_factory=ResultSig) def __post_init__(self): if not self.result.name: self.result.name = self.name fortran-language-server-3.2.2+dfsg/fortls/helper_functions.py000066400000000000000000000436561477231266000244550ustar00rootroot00000000000000from __future__ import annotations import os from pathlib import Path from fortls.constants import KEYWORD_ID_DICT, KEYWORD_LIST, FRegex, sort_keywords from fortls.ftypes import Range def expand_name(line: str, char_pos: int) -> str: """Get full word containing given cursor position Parameters ---------- line : str Text line char_pos : int Column position along the line Returns ------- str Word regex match for the input column """ # The order here is important. # WORD will capture substrings in logical and strings regexs = [ FRegex.LOGICAL, FRegex.SQ_STRING, FRegex.DQ_STRING, FRegex.WORD, FRegex.NUMBER, ] for r in regexs: for num_match in r.finditer(line): if num_match.start(0) <= char_pos <= num_match.end(0): return num_match.group(0) return "" def detect_fixed_format(file_lines: list[str]) -> bool: """Detect fixed/free format by looking for characters in label columns and variable declarations before column 6. Treat intersection format files as free format. Parameters ---------- file_lines : list[str] List of consecutive file lines Returns ------- bool True if file_lines are of Fixed Fortran style Examples -------- >>> detect_fixed_format([' free format']) False >>> detect_fixed_format([' INTEGER, PARAMETER :: N = 10']) False >>> detect_fixed_format(['C Fixed format']) True Lines wih ampersands are not fixed format >>> detect_fixed_format(['trailing line & ! comment']) False But preprocessor lines will be ignored >>> detect_fixed_format( ... ['#if defined(A) && !defined(B)', 'C Fixed format', '#endif']) True >>> detect_fixed_format( ... ['#if defined(A) && !defined(B)', ' free format', '#endif']) False And preprocessor line-continuation is taken into account >>> detect_fixed_format( ... ['#if defined(A) \\\\ ', ' && !defined(B)', 'C Fixed format', '#endif']) True >>> detect_fixed_format( ... ['#if defined(A) \\\\', '&& \\\\', '!defined(B)', ' free format', '#endif']) False """ pp_continue = False for line in file_lines: # Ignore preprocessor lines if line.startswith("#") or pp_continue: pp_continue = line.rstrip().endswith("\\") continue if FRegex.FREE_FORMAT_TEST.match(line): return False tmp_match = FRegex.VAR.match(line) if tmp_match and tmp_match.start(1) < 6: return False # Trailing ampersand indicates free or intersection format if not FRegex.FIXED_COMMENT.match(line): line_end = line.split("!")[0].strip() if len(line_end) > 0 and line_end.endswith("&"): return False return True def strip_line_label(line: str) -> tuple[str, str | None]: """Strip leading numeric line label Parameters ---------- line : str Text line Returns ------- tuple[str, str | None] Output string, Line label returns None if no line label present """ match = FRegex.LINE_LABEL.match(line) if match is None: return line, None line_label = match.group(1) out_str = line[: match.start(1)] + " " * len(line_label) + line[match.end(1) :] return out_str, line_label def strip_strings(in_line: str, maintain_len: bool = False) -> str: """Strips string literals from code line Parameters ---------- in_line : str Text string maintain_len : bool, optional Maintain the len(in_line) in the output string, by default False Returns ------- str Stripped string """ def repl_sq(m): return "'{}'".format(" " * (len(m.group()) - 2)) def repl_dq(m): return '"{}"'.format(" " * (len(m.group()) - 2)) if maintain_len: out_line = FRegex.SQ_STRING.sub(repl_sq, in_line) out_line = FRegex.DQ_STRING.sub(repl_dq, out_line) else: out_line = FRegex.SQ_STRING.sub("", in_line) out_line = FRegex.DQ_STRING.sub("", out_line) return out_line def separate_def_list(test_str: str) -> list[str] | None: """Separate definition lists, skipping parenthesis and bracket groups Parameters ---------- test_str : str Text string Returns ------- list[str] | None [description] Examples -------- >>> separate_def_list('var1, var2, var3') ['var1', 'var2', 'var3'] >>> separate_def_list('var, init_var(3) = [1,2,3], array(3,3)') ['var', 'init_var(3) = [1,2,3]', 'array(3,3)'] """ stripped_str = strip_strings(test_str) paren_count = 0 def_list: list[str] = [] curr_str = "" for char in stripped_str: if char in ("(", "["): paren_count += 1 elif char in (")", "]"): paren_count -= 1 elif (char == ",") and (paren_count == 0): curr_str = curr_str.strip() if curr_str != "": def_list.append(curr_str) curr_str = "" elif not def_list: return None continue curr_str += char curr_str = curr_str.strip() if curr_str != "": def_list.append(curr_str) return def_list def find_word_in_line(line: str, word: str) -> Range: """Find Fortran word in line Parameters ---------- line : str Text line word : str word to find in line Returns ------- Range start and end positions (indices) of the word if not found it returns -1, len(word) -1 """ i = next( ( poss_name.start() for poss_name in FRegex.WORD.finditer(line) if poss_name.group() == word ), -1, ) # TODO: if i == -1: return None makes more sense return Range(i, i + len(word)) def find_paren_match(string: str) -> int: """Find matching closing parenthesis from an already open parenthesis scope by forward search of the string, returns -1 if no match is found Parameters ---------- string : str Input string Returns ------- int The index of the matching ``)`` character in the string Examples -------- >>> find_paren_match('a, b)') 4 Multiple parenthesis that are closed >>> find_paren_match('a, (b, c), d)') 12 If the outermost parenthesis is not closed function returns -1 >>> find_paren_match('a, (b, (c, d)') -1 >>> find_paren_match('nt(sin(0.5))+8+len("ab((c")-3) :: y') 29 >>> find_paren_match("nt(sin(0.5))+8+len('ab))c')-3) :: y") 29 """ paren_count = 1 quote_state = {"'": False, '"': False} for i, char in enumerate(string): if char in quote_state: quote_state[char] = not quote_state[char] if any(quote_state.values()): continue if char == "(": paren_count += 1 elif char == ")": paren_count -= 1 if paren_count == 0: return i return -1 def get_line_prefix( pre_lines: list[str], curr_line: str, col: int, qs: bool = True ) -> str: """Get code line prefix from current line and preceding continuation lines Parameters ---------- pre_lines : list for multiline cases get all the previous, relevant lines curr_line : str the current line col : int column index of the current line qs : bool, optional strip quotes i.e. string literals from ``curr_line`` and ``pre_lines``. Need this disable when hovering over string literals, by default True Returns ------- str part of the line including any relevant line continuations before ``col`` Examples -------- >>> get_line_prefix([''], '#pragma once', 0) is None True """ if (curr_line is None) or (col > len(curr_line)) or (curr_line.startswith("#")): return None prepend_string = "".join(pre_lines) curr_line = prepend_string + curr_line col += len(prepend_string) line_prefix = curr_line[:col].lower() # Ignore string literals if qs and ((line_prefix.find("'") > -1) or (line_prefix.find('"') > -1)): sq_count = 0 dq_count = 0 for char in line_prefix: if (char == "'") and (dq_count % 2 == 0): sq_count += 1 elif (char == '"') and (sq_count % 2 == 0): dq_count += 1 if (dq_count % 2 == 1) or (sq_count % 2 == 1): return None return line_prefix def resolve_globs(glob_path: str, root_path: str = None) -> list[str]: """Resolve paths (absolute and relative) and glob patterns while nonexistent paths are ignored Parameters ---------- glob_path : str Path containing the glob pattern follows ``fnmatch`` glob pattern, can include relative paths, etc. see fnmatch: https://docs.python.org/3/library/fnmatch.html#module-fnmatch root_path : str, optional root path to start glob search. If left empty the root_path will be extracted from the glob_path, by default None Returns ------- list[str] Expanded glob patterns with absolute paths. Absolute paths are used to resolve any potential ambiguity Examples -------- Relative to a root path >>> import os, pathlib >>> resolve_globs('test', os.getcwd()) == [str(pathlib.Path(os.getcwd()) / 'test')] True Absolute path resolution >>> resolve_globs('test') == [str(pathlib.Path(os.getcwd()) / 'test')] True """ if not os.path.isabs(glob_path) and root_path: return [str(p.resolve()) for p in Path(root_path).resolve().glob(glob_path)] p = Path(glob_path).resolve() root = p.anchor # drive letter + root path rel = str(p.relative_to(root)) # contains glob pattern return [str(p.resolve()) for p in Path(root).glob(rel)] def only_dirs(paths: list[str]) -> list[str]: """From a list of strings returns only paths that are directories Parameters ---------- paths : list[str] A list containing the files and directories Returns ------- list[str] A list containing only valid directories Raises ------ FileNotFoundError A list containing all the non existing directories Examples -------- >>> only_dirs(['./test/', './test/test_source/', './test/test_source/test.f90']) ['./test/', './test/test_source/'] >>> only_dirs(['/fake/dir/a', '/fake/dir/b', '/fake/dir/c']) Traceback (most recent call last): FileNotFoundError: /fake/dir/a /fake/dir/b /fake/dir/c """ dirs: list[str] = [] errs: list[str] = [] for p in paths: if os.path.isdir(p): dirs.append(p) elif os.path.isfile(p): continue else: errs.append(p) if errs: raise FileNotFoundError("\n".join(errs)) return dirs def set_keyword_ordering(sorted): global sort_keywords sort_keywords = sorted def map_keywords(keywords: list[str]): mapped_keywords = [] keyword_info = {} for keyword in keywords: keyword_prefix = keyword.split("(")[0].lower().strip() keyword_ind = KEYWORD_ID_DICT.get(keyword_prefix) # keyword_ind can be 0 which if 0: evaluates to False if keyword_ind is not None: mapped_keywords.append(keyword_ind) if keyword_prefix in ("intent", "dimension", "pass"): keyword_substring = get_paren_substring(keyword) if keyword_substring is not None: keyword_info[keyword_prefix] = keyword_substring if sort_keywords: mapped_keywords.sort() return mapped_keywords, keyword_info def get_keywords(keywords: list, keyword_info: dict = None): if keyword_info is None: keyword_info = {} keyword_strings = [] for keyword_id in keywords: string_rep = KEYWORD_LIST[keyword_id] addl_info = keyword_info.get(string_rep) string_rep = string_rep.upper() if addl_info is not None: string_rep += f"({addl_info})" keyword_strings.append(string_rep) return keyword_strings def parenthetic_contents(string: str): """Generate parenthesized contents in string as pairs (contents, start-position, level). Examples -------- >>> list(parenthetic_contents('character*(10*size(val(1), 2)) :: name')) [('1', 22, 2), ('val(1), 2', 18, 1), ('10*size(val(1), 2)', 10, 0)] """ stack = [] for i, c in enumerate(string): if c == "(": stack.append(i) elif c == ")" and stack: start = stack.pop() yield (string[start + 1 : i], start, len(stack)) def get_paren_substring(string: str) -> str | None: """Get the contents enclosed by the first pair of parenthesis Parameters ---------- string : str A string Returns ------- str | None The part of the string enclosed in parenthesis e.g. or None Examples -------- >>> get_paren_substring('some line(a, b, (c, d))') 'a, b, (c, d)' If the line has incomplete parenthesis however, ``None`` is returned >>> get_paren_substring('some line(a, b') is None True """ i1 = string.find("(") i2 = string.rfind(")") return string[i1 + 1 : i2] if -1 < i1 < i2 else None def get_paren_level(line: str) -> tuple[str, list[Range]]: """Get sub-string corresponding to a single parenthesis level, via backward search up through the line. Parameters ---------- line : str Document line Returns ------- tuple[str, list[Range]] Arguments as a string and a list of Ranges for the arguments against ``line`` Examples -------- >>> get_paren_level('CALL sub1(arg1,arg2') ('arg1,arg2', [Range(start=10, end=19)]) If the range is interrupted by parenthesis, another Range variable is used to mark the ``start`` and ``end`` of the argument >>> get_paren_level('CALL sub1(arg1(i),arg2') ('arg1,arg2', [Range(start=10, end=14), Range(start=17, end=22)]) >>> get_paren_level('') ('', [Range(start=0, end=0)]) """ if not line: return "", [Range(0, 0)] level = 0 in_string = False string_char = "" i1 = len(line) sections: list[Range] = [] for i in range(len(line) - 1, -1, -1): char = line[i] if in_string: if char == string_char: in_string = False continue if char in ("(", "["): level -= 1 if level == 0: i1 = i elif level < 0: sections.append(Range(i + 1, i1)) break elif char in (")", "]"): level += 1 if level == 1: sections.append(Range(i + 1, i1)) elif char in ("'", '"'): in_string = True string_char = char if level == 0: sections.append(Range(i, i1)) sections.reverse() out_string = "".join(line[section.start : section.end] for section in sections) return out_string, sections def get_var_stack(line: str) -> list[str]: """Get user-defined type field sequence terminating the given line Parameters ---------- line : str Document line Returns ------- list[str] list of objects split by ``%`` Examples -------- >>> get_var_stack('myvar%foo%bar') ['myvar', 'foo', 'bar'] >>> get_var_stack('myarray(i)%foo%bar') ['myarray', 'foo', 'bar'] >>> get_var_stack('myarray( i ) % foo % bar') ['myarray', 'foo', 'bar'] In this case it will operate at the end of the string i.e. ``'this%foo'`` >>> get_var_stack('CALL self%method(this%foo') ['this', 'foo'] >>> get_var_stack('') [''] """ if not line: return [""] final_var, sections = get_paren_level(line) if final_var == "": return [""] # Continuation of variable after paren requires '%' character iLast = 0 for i, section in enumerate(sections): if not line[section.start : section.end].strip().startswith("%"): iLast = i final_var = "".join( line[section.start : section.end] for section in sections[iLast:] ) if final_var is not None: final_var = "%".join([i.strip() for i in final_var.split("%")]) final_op_split: list[str] = FRegex.OBJBREAK.split(final_var) return final_op_split[-1].split("%") else: return None def get_placeholders(arg_list: list[str]) -> tuple[str, str]: """ Function used to generate placeholders for snippets Parameters ---------- arg_list : list[str] Method arguments list Returns ------- Tuple[str, str] Tuple of arguments as a string and snippet string Examples -------- >>> get_placeholders(['x', 'y']) ('(x, y)', '(${1:x}, ${2:y})') >>> get_placeholders(['x=1', 'y=2']) ('(x=1, y=2)', '(x=${1:1}, y=${2:2})') >>> get_placeholders(['x', 'y=2', 'z']) ('(x, y=2, z)', '(${1:x}, y=${2:2}, ${3:z})') """ place_holders = [] for i, arg in enumerate(arg_list): opt_split = arg.split("=") if len(opt_split) > 1: place_holders.append(f"{opt_split[0]}=${{{i+1}:{opt_split[1]}}}") else: place_holders.append(f"${{{i+1}:{arg}}}") arg_str = f"({', '.join(arg_list)})" arg_snip = f"({', '.join(place_holders)})" return arg_str, arg_snip def fortran_md(code: str, docs: str | None): """Convert Fortran code to markdown Parameters ---------- code : str Fortran code docs : str | None Documentation string Returns ------- str Markdown string """ msg = "" if code: msg = "```{langid}\n" # This gets inserted later msg += f"{code}\n```" # Add documentation if docs: # if docs is not None or "" msg += f"\n-----\n{docs}" return msg fortran-language-server-3.2.2+dfsg/fortls/interface.py000066400000000000000000000316451477231266000230410ustar00rootroot00000000000000from __future__ import annotations import argparse import json import sys from fortls.version import __version__ class SetAction(argparse.Action): def __call__(self, parser, namespace, values, option_string=None): setattr(namespace, self.dest, set(values)) def cli(name: str = "fortls") -> argparse.ArgumentParser: """Parses the command line arguments to the Language Server Returns ------- argparse.ArgumentParser command line arguments """ parser = argparse.ArgumentParser( description="fortls - Fortran Language Server", prog=name, usage="fortls [options] [debug options]", formatter_class=lambda prog: argparse.HelpFormatter(prog, max_help_position=60), epilog=( "All options starting with '--' can also be set in a configuration file, by" " default named '.fortlsrc', '.fortls.json' or '.fortls'" " (other names/paths can specified via -c or" " --config). For more details see our documentation:" " https://fortls.fortran-lang.org/options.html#available-options" ), ) # General options ---------------------------------------------------------- parser.add_argument( "-v", "--version", action="version", version=__version__, help="Print server version number and exit", ) parser.add_argument( "-c", "--config", type=str, default=".fortlsrc", help=( "Configuration options file (default file name: %(default)s, other" " default supported names: .fortls.json, .fortls)" ), ) parser.add_argument( "-n", "--nthreads", type=int, default=4, metavar="INTEGER", help=( "Number of threads to use during workspace initialization (default:" " %(default)s)" ), ) parser.add_argument( "--notify_init", action="store_true", help="Send notification message when workspace initialization is complete", ) parser.add_argument( "--incremental_sync", action="store_true", help="Use incremental document synchronization (beta)", ) parser.add_argument( "--recursion_limit", type=int, default=1000, metavar="INTEGER", help="Set the maximum recursion depth for the parser (default: %(default)s)", ) parser.add_argument( "--sort_keywords", action="store_true", help=( "Display variable keywords information, function/subroutine definitions," " etc. in a consistent (sorted) manner default: no sorting, display code" " as is)" ), ) parser.add_argument( "--disable_autoupdate", action="store_true", help=( "fortls automatically checks PyPi for newer version and installs them." "Use this option to disable the autoupdate feature." ), ) # XXX: Deprecated, argument not attached to anything. Remove parser.add_argument( "--preserve_keyword_order", action="store_true", help="DEPRECATED, this is now the default. To sort use sort_keywords", ) parser.add_argument( "--debug_log", action="store_true", help="Generate debug log in project root folder", ) parser.add_argument( "--debug_help", action="help", help="Display options for debugging fortls" ) # File parsing options ----------------------------------------------------- group = parser.add_argument_group("Sources file parsing options") group.add_argument( "--source_dirs", type=str, nargs="*", default=set(), action=SetAction, metavar="DIRS", help="Folders containing source files (default: %(default)s)", ) group.add_argument( "--incl_suffixes", type=str, nargs="*", default=set(), action=SetAction, metavar="SUFFIXES", help=( "Consider additional file extensions to the default (default: " ".F, .F77, .F90, .F95, .F03, .F08, .FOR, .FPP (lower & upper casing))" ), ) group.add_argument( "--excl_suffixes", type=str, nargs="*", default=set(), action=SetAction, metavar="SUFFIXES", help="Source file extensions to be excluded (default: %(default)s)", ) group.add_argument( "--excl_paths", type=str, nargs="*", default=set(), action=SetAction, metavar="DIRS", help="Folders to exclude from parsing", ) # Autocomplete options ----------------------------------------------------- group = parser.add_argument_group("Autocomplete options") group.add_argument( "--autocomplete_no_prefix", action="store_true", help="Do not filter autocomplete results by variable prefix", ) group.add_argument( "--autocomplete_no_snippets", action="store_true", help="Do not use snippets with place holders in autocomplete results", ) group.add_argument( "--autocomplete_name_only", action="store_true", help="Complete only the name of procedures and not the parameters", ) group.add_argument( "--lowercase_intrinsics", action="store_true", help="Use lowercase for intrinsics and keywords in autocomplete requests", ) group.add_argument( "--use_signature_help", action="store_true", help=( "Use signature help instead of subroutine/function snippets. This" " effectively sets --autocomplete_no_snippets" ), ) # Hover options ------------------------------------------------------------ group = parser.add_argument_group("Hover options") group.add_argument( "--variable_hover", action="store_true", help=( "DEPRECATED: This option is always on. Show hover information for variables" ), ) group.add_argument( "--hover_signature", action="store_true", help="Show signature information in hover for arguments ", ) group.add_argument( "--hover_language", type=str, default="fortran90", help=( "Language used for responses to hover requests a VSCode language id" " (default: %(default)s)" ), ) # Diagnostic options ------------------------------------------------------- group = parser.add_argument_group("Diagnostic options (error swigles)") group.add_argument( "--max_line_length", type=int, default=-1, metavar="INTEGER", help="Maximum line length (default: %(default)s)", ) group.add_argument( "--max_comment_line_length", type=int, default=-1, metavar="INTEGER", help="Maximum comment line length (default: %(default)s)", ) group.add_argument( "--disable_diagnostics", action="store_true", help="Disable diagnostics" ) # Preprocessor options ----------------------------------------------------- group = parser.add_argument_group("Preprocessor options") group.add_argument( "--pp_suffixes", type=str, default=set(), nargs="*", metavar="SUFFIXES", help=( "File extensions to be parsed ONLY for preprocessor commands " "(default: all uppercase source file suffixes)" ), ) group.add_argument( "--include_dirs", # "--pp_include_dirs", # TODO: make main type=str, nargs="*", default=set(), action=SetAction, metavar="DIRS", help="Folders containing preprocessor files with extensions PP_SUFFIXES.", ) group.add_argument( "--pp_defs", type=json.loads, default={}, metavar="JSON", help=( "A dictionary with additional preprocessor definitions. " "Preprocessor definitions are normally included via INCLUDE_DIRS" ), ) # Symbols options ---------------------------------------------------------- group = parser.add_argument_group("Symbols options") group.add_argument( "--symbol_skip_mem", action="store_true", help="Do not include type members in document symbol results", ) # Code Actions options ----------------------------------------------------- group = parser.add_argument_group("CodeActions options [limited]") group.add_argument( "--enable_code_actions", action="store_true", help="Enable experimental code actions (default: false)", ) # Debug # By default debug arguments are hidden _debug_commandline_args(parser) return parser # TODO: make this return a parser def _debug_commandline_args(parser: argparse.ArgumentParser) -> None: """Parse the debug arguments if any are present. if none are present the arguments are suppressed in the help menu Parameters ---------- parser : argparse.ArgumentParser an argument parser Returns ------- None Operates and updates the parser """ # Only show debug options if an argument starting with --debug_ was input. # if suppressed the option will be hidden from the help menu. HIDE_DEBUG = True if any("--debug_" in arg for arg in sys.argv): HIDE_DEBUG = False def hide_opt(help: str) -> str: if not HIDE_DEBUG: return help else: return argparse.SUPPRESS group = parser.add_argument_group( hide_opt("DEBUG"), hide_opt("Options for debugging language server") ) group.add_argument( "--debug_filepath", type=str, help=hide_opt("File path for language server tests"), ) group.add_argument( "--debug_rootpath", type=str, help=hide_opt("Root path for language server tests"), ) group.add_argument( "--debug_parser", action="store_true", help=hide_opt("Test source code parser on specified file"), ) group.add_argument( "--debug_preproc", action="store_true", help=hide_opt("Test source code preprocessor parser on specified file"), ) group.add_argument( "--debug_hover", action="store_true", help=hide_opt( "Test `textDocument/hover` request for specified file and position" ), ) group.add_argument( "--debug_rename", type=str, metavar="RENAME_STRING", help=hide_opt( "Test `textDocument/rename` request for specified file and position" ), ) group.add_argument( "--debug_actions", action="store_true", help=hide_opt( "Test `textDocument/codeAction` request for specified file and position" ), ) group.add_argument( "--debug_symbols", action="store_true", help=hide_opt("Test `textDocument/documentSymbol` request for specified file"), ) group.add_argument( "--debug_completion", action="store_true", help=hide_opt( "Test `textDocument/completion` request for specified file and position" ), ) group.add_argument( "--debug_signature", action="store_true", help=hide_opt( "Test `textDocument/signatureHelp` request for specified file and position" ), ) group.add_argument( "--debug_definition", action="store_true", help=hide_opt( "Test `textDocument/definition` request for specified file and position" ), ) group.add_argument( "--debug_references", action="store_true", help=hide_opt( "Test `textDocument/references` request for specified file and position" ), ) group.add_argument( "--debug_diagnostics", action="store_true", help=hide_opt("Test diagnostic notifications for specified file"), ) group.add_argument( "--debug_implementation", action="store_true", help=hide_opt( "Test `textDocument/implementation` request for specified file and position" ), ) group.add_argument( "--debug_workspace_symbols", type=str, metavar="QUERY_STRING", help=hide_opt("Test `workspace/symbol` request"), ) group.add_argument( "--debug_line", type=int, metavar="INTEGER", help=hide_opt("Line position for language server tests (1-indexed)"), ) group.add_argument( "--debug_char", type=int, metavar="INTEGER", help=hide_opt("Character position for language server tests (1-indexed)"), ) group.add_argument( "--debug_full_result", action="store_true", help=hide_opt("Print full result object instead of condensed version"), ) fortran-language-server-3.2.2+dfsg/fortls/json_templates.py000066400000000000000000000024771477231266000241310ustar00rootroot00000000000000from __future__ import annotations def range_json(sln: int, sch: int, eln: int = None, ech: int = None): return { "range": { "start": {"line": sln, "character": sch}, "end": {"line": eln if eln else sln, "character": ech if ech else sch}, } } def diagnostic_json(sln: int, sch: int, eln: int, ech: int, msg: str, sev: int): return {**range_json(sln, sch, eln, ech), "message": msg, "severity": sev} def uri_json(uri: str, sln: int, sch: int, eln: int = None, ech: int = None): return {"uri": uri, **range_json(sln, sch, eln, ech)} def location_json(uri: str, sln: int, sch: int, eln: int = None, ech: int = None): return {"location": uri_json(uri, sln, sch, eln, ech)} def symbol_json( name: str, kind: int, uri: str, sln: int, sch: int, eln: int = None, ech: int = None, container_name: str = None, ): if container_name: return { "name": name, "kind": kind, **location_json(uri, sln, sch, eln, ech), "containerName": container_name, } return {"name": name, "kind": kind, **location_json(uri, sln, sch, eln, ech)} def change_json(new_text: str, sln: int, sch: int, eln: int = None, ech: int = None): return {**range_json(sln, sch, eln, ech), "newText": new_text} fortran-language-server-3.2.2+dfsg/fortls/jsonrpc.py000066400000000000000000000162601477231266000225530ustar00rootroot00000000000000import json import os import queue import threading from collections import deque from pathlib import Path from urllib.parse import quote, unquote from fortls.constants import log def path_from_uri(uri: str) -> str: # Convert file uri to path (strip html like head part) if not uri.startswith("file://"): return os.path.abspath(uri) if os.name == "nt": _, path = uri.split("file:///", 1) else: _, path = uri.split("file://", 1) return str(Path(unquote(path)).resolve()) def path_to_uri(path: str) -> str: # Convert path to file uri (add html like head part) if os.name == "nt": return "file:///" + quote(path.replace("\\", "/")) else: return "file://" + quote(path) class JSONRPC2ProtocolError(Exception): pass class ReadWriter: def __init__(self, reader, writer): self.reader = reader self.writer = writer def readline(self, *args): data = self.reader.readline(*args) return data.decode("utf-8") def read(self, *args): data = self.reader.read(*args) return data.decode("utf-8") def write(self, out): self.writer.write(out.encode()) self.writer.flush() class TCPReadWriter(ReadWriter): def readline(self, *args): data = self.reader.readline(*args) return data.decode("utf-8") def read(self, *args): return self.reader.read(*args).decode("utf-8") def write(self, out): self.writer.write(out.encode()) self.writer.flush() class JSONRPC2Connection: def __init__(self, conn=None): self.conn = conn self._msg_buffer = deque() self._next_id = 1 def _read_header_content_length(self, line): if len(line) < 2 or line[-2:] != "\r\n": raise JSONRPC2ProtocolError("Line endings must be \\r\\n") if line.startswith("Content-Length: "): _, value = line.split("Content-Length: ") value = value.strip() try: return int(value) except ValueError: raise JSONRPC2ProtocolError(f"Invalid Content-Length header: {value}") def _receive(self): line = self.conn.readline() if line == "": raise EOFError() length = self._read_header_content_length(line) # Keep reading headers until we find the sentinel # line for the JSON request. while line != "\r\n": line = self.conn.readline() body = self.conn.read(length) log.debug( "RECV %s", json.dumps(json.loads(body), separators=(",", ":"), indent=2) ) return json.loads(body) def read_message(self, want=None): """Read a JSON RPC message sent over the current connection. If id is None, the next available message is returned.""" if want is None: if self._msg_buffer: return self._msg_buffer.popleft() return self._receive() # First check if our buffer contains something we want. msg = deque_find_and_pop(self._msg_buffer, want) if msg: return msg # We need to keep receiving until we find something we want. # Things we don't want are put into the buffer for future callers. while True: msg = self._receive() if want(msg): return msg self._msg_buffer.append(msg) def _send(self, body): bd = json.dumps(body, separators=(",", ":")) content_length = len(bd) response = ( f"Content-Length: {content_length}\r\n" "Content-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n" f"{bd}" ) self.conn.write(response) log.debug("SEND %s", json.dumps(body, separators=(",", ":"), indent=2)) def write_response(self, rid, result): body = { "jsonrpc": "2.0", "id": rid, "result": result, } self._send(body) def write_error(self, rid, code, message, data=None): e = { "code": code, "message": message, } if data is not None: e["data"] = data body = { "jsonrpc": "2.0", "id": rid, "error": e, } self._send(body) def send_request(self, method, params): rid = self._next_id self._next_id += 1 body = { "jsonrpc": "2.0", "id": rid, "method": method, "params": params, } self._send(body) return self.read_message(want=lambda msg: msg.get("id") == rid) def send_notification(self, method, params): body = { "jsonrpc": "2.0", "method": method, "params": params, } self._send(body) def send_request_batch(self, requests): """Pipelines requests and returns responses. The responses is a generator where the nth response corresponds with the nth request. Users must read the generator until the end, otherwise you will leak a thread.""" # We communicate the request ids using a thread safe queue. # It also allows us to bound the number of concurrent requests. q = queue.Queue(100) def send(): for method, params in requests: rid = self._next_id self._next_id += 1 q.put(rid) body = { "jsonrpc": "2.0", "id": rid, "method": method, "params": params, } self._send(body) # Sentinel value to indicate we are done q.put(None) threading.Thread(target=send).start() while True: rid = q.get() if rid is None: break yield self.read_message(want=lambda msg: msg.get("id") == rid) def deque_find_and_pop(d, f): idx = -1 for i, v in enumerate(d): if f(v): idx = i break if idx < 0: return None d.rotate(-idx) v = d.popleft() d.rotate(idx) return v def write_rpc_request(rid, method, params): body = { "jsonrpc": "2.0", "id": rid, "method": method, "params": params, } body = json.dumps(body, separators=(",", ":")) content_length = len(body) return ( f"Content-Length: {content_length}\r\n" "Content-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n" f"{body}" ) def write_rpc_notification(method, params): body = { "jsonrpc": "2.0", "method": method, "params": params, } body = json.dumps(body, separators=(",", ":")) content_length = len(body) return ( f"Content-Length: {content_length}\r\n" "Content-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n" f"{body}" ) def read_rpc_messages(content): conn = JSONRPC2Connection(content) result_list = [] while True: try: result = conn._receive() except EOFError: break else: result_list.append(result) return result_list fortran-language-server-3.2.2+dfsg/fortls/langserver.py000066400000000000000000002211111477231266000232360ustar00rootroot00000000000000from __future__ import annotations import json import logging import os import re import subprocess import sys import traceback import urllib.request from multiprocessing import Pool from pathlib import Path from typing import Pattern from urllib.error import URLError import json5 from packaging import version # Local modules from fortls.constants import ( CLASS_TYPE_ID, FORTRAN_LITERAL, FUNCTION_TYPE_ID, INTERFACE_TYPE_ID, METH_TYPE_ID, MODULE_TYPE_ID, SELECT_TYPE_ID, SUBROUTINE_TYPE_ID, VAR_TYPE_ID, FRegex, Severity, log, ) from fortls.helper_functions import ( expand_name, fortran_md, get_line_prefix, get_paren_level, get_var_stack, only_dirs, resolve_globs, set_keyword_ordering, ) from fortls.json_templates import change_json, symbol_json, uri_json from fortls.jsonrpc import JSONRPC2Connection, path_from_uri, path_to_uri from fortls.parsers.internal.ast import FortranAST from fortls.parsers.internal.imports import Import from fortls.parsers.internal.intrinsics import ( Intrinsic, get_intrinsic_keywords, load_intrinsics, set_lowercase_intrinsics, ) from fortls.parsers.internal.parser import FortranFile, get_line_context from fortls.parsers.internal.scope import Scope from fortls.parsers.internal.use import Use from fortls.parsers.internal.utilities import ( climb_type_tree, find_in_scope, find_in_workspace, get_use_tree, ) from fortls.parsers.internal.variable import Variable from fortls.regex_patterns import create_src_file_exts_str from fortls.version import __version__ # Global regexes # TODO: I think this can be replaced by fortls.regex_patterns type & class TYPE_DEF_REGEX = re.compile(r"[ ]*(TYPE|CLASS)[ ]*\([a-z0-9_ ]*$", re.I) class LangServer: def __init__(self, conn, settings: dict): self.conn: JSONRPC2Connection = conn self.running: bool = True self.root_path: str = None self.workspace: dict[str, FortranFile] = {} self.obj_tree: dict = {} self.link_version = 0 self._version = version.parse(__version__) # Parse a dictionary of the command line interface and make them into # class variable. This way the command line and the file interfaces # are always on sync, with the same default arguments for k, v in settings.items(): # Do not parse command line debug arguments if k.startswith("debug_") and k != "debug_log": continue setattr(self, k, v) self.sync_type: int = 2 if self.incremental_sync else 1 self.post_messages = [] self.FORTRAN_SRC_EXT_REGEX: Pattern[str] = create_src_file_exts_str( self.incl_suffixes ) # Intrinsic (re-loaded during initialize) ( self.statements, self.keywords, self.intrinsic_funs, self.intrinsic_mods, ) = load_intrinsics() # Set object settings set_keyword_ordering(self.sort_keywords) def post_message(self, msg: str, severity: int = Severity.error, exc_info=False): self.conn.send_notification( "window/showMessage", {"type": severity, "message": msg} ) if severity == 1: log.error(msg, exc_info=exc_info) elif severity == 2: log.warning(msg, exc_info=exc_info) elif severity == 3: log.info(msg, exc_info=exc_info) def run(self): # Run server while self.running: try: request = self.conn.read_message() self.handle(request) except EOFError: break except Exception as e: self.post_message(f"Unexpected error: {e}", exc_info=True) break else: for message in self.post_messages: self.post_message(message[1], message[0]) self.post_messages = [] def handle(self, request: dict): def noop(request: dict): return None # Request handler log.debug("REQUEST %s %s", request.get("id"), request.get("method")) handler = { "initialize": self.serve_initialize, "textDocument/documentSymbol": self.serve_document_symbols, "textDocument/completion": self.serve_autocomplete, "textDocument/signatureHelp": self.serve_signature, "textDocument/definition": self.serve_definition, "textDocument/references": self.serve_references, "textDocument/documentHighlight": self.serve_references, "textDocument/hover": self.serve_hover, "textDocument/implementation": self.serve_implementation, "textDocument/rename": self.serve_rename, "textDocument/didOpen": self.serve_onOpen, "textDocument/didSave": self.serve_onSave, "textDocument/didClose": self.serve_onClose, "textDocument/didChange": self.serve_onChange, "textDocument/codeAction": self.serve_codeActions, "initialized": noop, "workspace/didChangeWatchedFiles": noop, "workspace/didChangeConfiguration": noop, "workspace/symbol": self.serve_workspace_symbol, "$/cancelRequest": noop, "$/setTrace": noop, "shutdown": noop, "exit": self.serve_exit, }.get(request["method"], self.serve_default) # We handle notifications differently since we can't respond if "id" not in request: try: handler(request) except: log.exception("error handling request: %s", request, exc_info=True) return # try: resp = handler(request) except JSONRPC2Error as e: self.conn.write_error( request["id"], code=e.code, message=e.message, data=e.data ) log.warning("RPC error handling request %s", request, exc_info=True) except Exception as e: self.conn.write_error( request["id"], code=-32603, message=str(e), data={ "traceback": traceback.format_exc(), }, ) log.warning("error handling request %s", request, exc_info=True) else: self.conn.write_response(request["id"], resp) def serve_initialize(self, request: dict): # Setup language server params: dict = request["params"] self.root_path = path_from_uri( params.get("rootUri") or params.get("rootPath") or "" ) self.source_dirs.add(self.root_path) self._load_config_file() update_recursion_limit(self.recursion_limit) self._resolve_globs_in_paths() self._config_logger(request) self._load_intrinsics() self._add_source_dirs() if self._update_version_pypi(): self.post_message( "Please restart the server for the new version to activate", Severity.info, ) # Initialize workspace self.workspace_init() log.info("fortls - Fortran Language Server %s Initialized", __version__) # server_capabilities = { "completionProvider": { "resolveProvider": False, "triggerCharacters": ["%"], }, "definitionProvider": True, "documentSymbolProvider": True, "referencesProvider": True, "hoverProvider": True, "implementationProvider": True, "renameProvider": True, "workspaceSymbolProvider": True, "textDocumentSync": self.sync_type, } if self.use_signature_help: server_capabilities["signatureHelpProvider"] = { "triggerCharacters": ["(", ","] } if self.enable_code_actions: server_capabilities["codeActionProvider"] = True if self.notify_init: self.post_message("fortls initialization complete", Severity.info) return {"capabilities": server_capabilities} def serve_workspace_symbol(self, request): def map_types(type): if type == 1: return 2 elif type == 2: return 6 elif type == 3: return 12 elif type == 4: return 5 elif type == 5: return 11 elif type == 6: return 13 elif type == 7: return 6 else: return 1 matching_symbols = [] query = request["params"]["query"].lower() for candidate in find_in_workspace(self.obj_tree, query): tmp_out = { "name": candidate.name, "kind": map_types(candidate.get_type()), "location": { "uri": path_to_uri(candidate.file_ast.path), "range": { "start": {"line": candidate.sline - 1, "character": 0}, "end": {"line": candidate.eline - 1, "character": 0}, }, }, } # Set containing scope if candidate.FQSN.find("::") > 0: tmp_list = candidate.FQSN.split("::") tmp_out["containerName"] = tmp_list[0] matching_symbols.append(tmp_out) return sorted(matching_symbols, key=lambda k: k["name"]) def serve_document_symbols(self, request: dict): def map_types(type, in_class: bool = False): if type in (1, 8): return 2 elif type in (2, 3): if in_class: return 6 else: return 12 elif type == 4: return 5 elif type == 5: return 11 elif type == 6: return 13 elif type == 7: return 6 else: return 1 # Get parameters from request params: dict = request["params"] uri: str = params["textDocument"]["uri"] path: str = path_from_uri(uri) file_obj = self.workspace.get(path) if file_obj is None: return [] # Add scopes to outline view test_output = [] for scope in file_obj.ast.get_scopes(): if ( not scope.name # Skip empty strings or scope.name.startswith("#") # Skip comments or scope.get_type() == SELECT_TYPE_ID # Skip select types ): continue scope_tree = scope.FQSN.split("::") if len(scope_tree) > 2: if scope_tree[1].startswith("#gen_int"): scope_type = 11 else: continue else: scope_type = map_types(scope.get_type()) # Set containing scope if scope.FQSN.find("::") > 0: tmp_list = scope.FQSN.split("::") test_output.append( symbol_json( scope.name, scope_type, uri, scope.sline - 1, 0, scope.eline - 1, 0, tmp_list[0], ) ) else: test_output.append( symbol_json( scope.name, scope_type, uri, scope.sline - 1, 0, scope.eline - 1, 0, ) ) # If class add members if scope.get_type() == CLASS_TYPE_ID and not self.symbol_skip_mem: for child in scope.children: test_output.append( symbol_json( child.name, map_types(child.get_type(), True), uri, child.sline - 1, 0, container_name=scope.name, ) ) return test_output def serve_autocomplete(self, request: dict): # def map_types(type: int): if type == 1: return 9 elif type == 2: return 3 elif type == 4: return 7 elif type == 6: return 6 else: return type def set_type_mask(def_value): return [def_value if i < 8 else True for i in range(16)] def get_candidates( scope_list: list, var_prefix: str, inc_globals: bool = True, public_only: bool = False, abstract_only: bool = False, no_use: bool = False, ): # def child_candidates( scope: Scope, only_list: list = None, filter_public=True, req_abstract=False, ) -> list[str]: if only_list is None: only_list = [] tmp_list: list[str] = [] # Filter children nonly = len(only_list) for child in scope.get_children(filter_public): if req_abstract: if child.is_abstract(): tmp_list += child_candidates( child, only_list, filter_public ) else: if child.is_external_int(): tmp_list += child_candidates( child, only_list, filter_public ) else: if (nonly > 0) and (child.name.lower() not in only_list): continue tmp_list.append(child) return tmp_list var_list: list[str] = [] use_dict: dict[str, Use | Import] = {} for scope in scope_list: var_list += child_candidates( scope, filter_public=public_only, req_abstract=abstract_only ) # Traverse USE tree and add to list if not no_use: use_dict = get_use_tree(scope, use_dict, self.obj_tree) # Look in found use modules rename_list = [None for _ in var_list] import_var_list = [] for use_mod, use_info in use_dict.items(): if type(use_info) is Use: scope = self.obj_tree[use_mod][0] only_list = use_info.rename() tmp_list = child_candidates( scope, only_list, req_abstract=abstract_only ) # Setup renaming if use_info.rename_map: rename_reversed = { value: key for (key, value) in use_info.rename_map.items() } for tmp_obj in tmp_list: var_list.append(tmp_obj) rename_list.append( rename_reversed.get(tmp_obj.name.lower(), None) ) else: var_list += tmp_list rename_list += [None for _ in tmp_list] elif type(use_info) is Import: scope = use_info.scope # Add import candidates import_var_list += child_candidates( scope, only_list=use_info.only_list, req_abstract=abstract_only, ) # We do not have renames so ignore # Add globals if inc_globals: tmp_list = [obj[0] for (_, obj) in self.obj_tree.items()] var_list += tmp_list + self.intrinsic_funs rename_list += [None for _ in tmp_list + self.intrinsic_funs] if import_var_list: var_list = import_var_list rename_list = [None for _ in import_var_list] # Filter by prefix if necessary if var_prefix == "": return var_list, rename_list else: tmp_list: list[str] = [] tmp_rename: list[str] = [] for var, rename in zip(var_list, rename_list): var_name: str | None = rename if var_name is None: var_name = var.name if var_name.lower().startswith(var_prefix): tmp_list.append(var) tmp_rename.append(rename) return tmp_list, tmp_rename def build_comp( candidate, name_only: bool = self.autocomplete_name_only, name_replace: str = None, is_interface: bool = False, is_member: bool = False, ): comp_obj = {} call_sig = None if name_only: comp_obj["label"] = candidate.name else: comp_obj["label"] = candidate.name if name_replace is not None: comp_obj["label"] = name_replace call_sig, snippet = candidate.get_snippet(name_replace) if self.autocomplete_no_snippets: snippet = call_sig if snippet is not None: if self.use_signature_help and (not is_interface): arg_open = snippet.find("(") if arg_open > 0: snippet = snippet[:arg_open] comp_obj["insertText"] = snippet comp_obj["insertTextFormat"] = 2 comp_obj["kind"] = map_types(candidate.get_type()) if is_member and (comp_obj["kind"] == 3): comp_obj["kind"] = 2 # Detail label shown above documentation, also shown when # documentation is collapsed i.e. short form completions comp_obj["detail"] = candidate.get_desc() if call_sig is not None: comp_obj["detail"] += " " + call_sig # Use the full markdown documentation hover_msg: str = candidate.get_hover_md(long=True) if hover_msg: hover_msg: dict = { "kind": "markdown", "value": hover_msg.replace( "```{langid}", f"```{self.hover_language}", 1 ), } comp_obj["documentation"] = hover_msg return comp_obj # Get parameters from request params: dict = request["params"] uri: str = params["textDocument"]["uri"] path: str = path_from_uri(uri) file_obj: FortranFile = self.workspace.get(path) if file_obj is None: return None # Check line ac_line: int = params["position"]["line"] ac_char: int = params["position"]["character"] # Get full line (and possible continuations) from file pre_lines, curr_line, _ = file_obj.get_code_line( ac_line, forward=False, strip_comment=True ) line_prefix = get_line_prefix(pre_lines, curr_line, ac_char) if line_prefix is None: return None is_member = False try: var_stack = get_var_stack(line_prefix) is_member = len(var_stack) > 1 var_prefix = var_stack[-1].strip() except (TypeError, AttributeError): return None # print(var_stack) item_list = [] # Get context name_only = self.autocomplete_name_only public_only = False include_globals = True line_context, context_info = get_line_context(line_prefix) if (line_context == "skip") or (var_prefix == "" and (not is_member)): return None if self.autocomplete_no_prefix: var_prefix = "" # Suggestions for user-defined type members scope_list = [] if is_member: curr_scope = file_obj.ast.get_inner_scope(ac_line + 1) type_scope = climb_type_tree(var_stack, curr_scope, self.obj_tree) # Set enclosing type as scope if type_scope is None: return None else: include_globals = False scope_list = [type_scope] else: scope_list = file_obj.ast.get_scopes(ac_line + 1) # Setup based on context req_callable = False abstract_only = False no_use = False type_mask = set_type_mask(False) type_mask[MODULE_TYPE_ID] = True type_mask[CLASS_TYPE_ID] = True if line_context == "mod_only": # Module names only (USE statement) for key in self.obj_tree: candidate = self.obj_tree[key][0] if ( candidate.get_type() == MODULE_TYPE_ID ) and candidate.name.lower().startswith(var_prefix): item_list.append(build_comp(candidate, name_only=True)) return item_list elif line_context == "mod_mems": # Public module members only (USE ONLY statement) name_only = True mod_name = context_info.lower() if mod_name in self.obj_tree: scope_list = [self.obj_tree[mod_name][0]] public_only = True include_globals = False type_mask[CLASS_TYPE_ID] = False else: return None elif line_context == "pro_link": # Link to local subroutine/functions type_mask = set_type_mask(True) type_mask[SUBROUTINE_TYPE_ID] = False type_mask[FUNCTION_TYPE_ID] = False name_only = True include_globals = False no_use = True elif line_context == "call": # Callable objects only ("CALL" statements) req_callable = True elif line_context == "type_only": # User-defined types only (variable definitions, select clauses) type_mask = set_type_mask(True) type_mask[CLASS_TYPE_ID] = False elif line_context == "import": # Import statement (variables and user-defined types only) name_only = True type_mask = set_type_mask(True) type_mask[CLASS_TYPE_ID] = False type_mask[VAR_TYPE_ID] = False elif line_context == "vis": # Visibility statement (local objects only) include_globals = False name_only = True type_mask = set_type_mask(True) type_mask[CLASS_TYPE_ID] = False type_mask[VAR_TYPE_ID] = False type_mask[SUBROUTINE_TYPE_ID] = False type_mask[FUNCTION_TYPE_ID] = False curr_scope = [file_obj.ast.get_inner_scope(ac_line + 1)] elif line_context == "int_only": # Interfaces only (procedure definitions) abstract_only = True include_globals = False name_only = True type_mask = set_type_mask(True) type_mask[SUBROUTINE_TYPE_ID] = False type_mask[FUNCTION_TYPE_ID] = False elif line_context == "var_only": # Variables only (variable definitions) name_only = True type_mask[SUBROUTINE_TYPE_ID] = True type_mask[FUNCTION_TYPE_ID] = True elif line_context == "var_key": # Variable definition keywords only (variable definition) key_context = 0 enc_scope_type = scope_list[-1].get_type() if enc_scope_type == MODULE_TYPE_ID: key_context = 1 elif (enc_scope_type == SUBROUTINE_TYPE_ID) or ( enc_scope_type == FUNCTION_TYPE_ID ): key_context = 2 elif enc_scope_type == CLASS_TYPE_ID: key_context = 3 for candidate in get_intrinsic_keywords( self.statements, self.keywords, key_context ): if candidate.name.lower().startswith(var_prefix): item_list.append(build_comp(candidate)) return item_list elif line_context == "first": # First word -> default context plus Fortran statements for candidate in get_intrinsic_keywords(self.statements, self.keywords, 0): if candidate.name.lower().startswith(var_prefix): item_list.append(build_comp(candidate)) # Build completion list candidate_list, rename_list = get_candidates( scope_list, var_prefix, include_globals, public_only, abstract_only, no_use ) for candidate, rename in zip(candidate_list, rename_list): # Skip module names (only valid in USE) candidate_type = candidate.get_type() if type_mask[candidate_type]: continue if req_callable and (not candidate.is_callable()): continue # name_replace = rename if candidate_type == INTERFACE_TYPE_ID and not line_context == "mod_mems": tmp_list = [] if name_replace is None: name_replace = candidate.name for member in candidate.mems: tmp_text, _ = member.get_snippet(name_replace) if tmp_list.count(tmp_text) > 0: continue tmp_list.append(tmp_text) item_list.append( build_comp( member, name_replace=name_replace, is_interface=True, is_member=is_member, ) ) continue # item_list.append( build_comp(candidate, name_only=name_only, name_replace=name_replace) ) return item_list def get_definition( self, def_file: FortranFile, def_line: int, def_char: int, hover_req: bool = False, ): """Return the Fortran object for the definition that matches the Fortran file, line number, column number Parameters ---------- def_file : fortran_file File to query def_line : int Line position in the file def_char : int Column position in the file hover_req : bool, optional Flag to enable if calling from a hover request, by default False Returns ------- fortran_var | fortran_include | None Fortran object """ # Get full line (and possible continuations) from file pre_lines, curr_line, _ = def_file.get_code_line( def_line, forward=False, strip_comment=True ) # Returns none for string literals, when the query is in the middle line_prefix = get_line_prefix(pre_lines, curr_line, def_char, qs=False) if line_prefix is None: return None is_member = False try: var_stack = get_var_stack(line_prefix) is_member = len(var_stack) > 1 def_name = expand_name(curr_line, def_char) except (TypeError, AttributeError): return None if def_name == "": return None # Search in Preprocessor defined variables if def_name in def_file.pp_defs: def_value = def_file.pp_defs.get(def_name) def_arg_str = "" if isinstance(def_value, tuple): def_arg_str, def_value = def_value def_arg_str = ", ".join([x.strip() for x in def_arg_str.split(",")]) def_arg_str = f"({def_arg_str})" var = Variable( def_file.ast, def_line + 1, def_name, f"#define {def_name}{def_arg_str} {def_value}", [], ) return var curr_scope = def_file.ast.get_inner_scope(def_line + 1) # Traverse type tree if necessary if is_member: type_scope = climb_type_tree(var_stack, curr_scope, self.obj_tree) # Set enclosing type as scope if type_scope is None: return None else: curr_scope = type_scope # Find in available scopes var_obj = None if curr_scope is not None: if ( (curr_scope.get_type() == CLASS_TYPE_ID) and (not is_member) and ( ( line_prefix.lstrip().lower().startswith("procedure") and (line_prefix.count("=>") > 0) ) or TYPE_DEF_REGEX.match(line_prefix) ) ): curr_scope = curr_scope.parent var_obj = find_in_scope( curr_scope, def_name, self.obj_tree, var_line_number=def_line + 1 ) # Search in global scope if var_obj is None: if is_member: return None key = def_name.lower() if key in self.obj_tree: return self.obj_tree[key][0] for obj in self.intrinsic_funs: if obj.name.lower() == key: return obj # If we have a Fortran literal constant e.g. 100, .false., etc. # Return a dummy object with the correct type & position in the doc if hover_req and curr_scope: var_type = None if FRegex.NUMBER.match(def_name): if any(s in def_name for s in [".", "e", "d"]): var_type = f"{FORTRAN_LITERAL}REAL" else: var_type = f"{FORTRAN_LITERAL}INTEGER" elif FRegex.LOGICAL.match(def_name): var_type = f"{FORTRAN_LITERAL}LOGICAL" elif FRegex.SQ_STRING.match(def_name) or FRegex.DQ_STRING.match( def_name ): var_type = f"{FORTRAN_LITERAL}STRING" if var_type: return Variable( curr_scope.file_ast, def_line + 1, def_name, var_type, curr_scope.keywords, ) else: return var_obj return None def serve_signature(self, request: dict): def get_sub_name(line: str): _, sections = get_paren_level(line) if sections[0].start <= 1: return None, None, None arg_string = line[sections[0].start : sections[-1].end] sub_string, sections = get_paren_level(line[: sections[0].start - 1]) return sub_string.strip(), arg_string.split(","), sections[-1].start def check_optional(arg, params: dict): opt_split = arg.split("=") if len(opt_split) > 1: opt_arg = opt_split[0].strip().lower() for i, param in enumerate(params): param_split = param["label"].split("=")[0] if param_split.lower() == opt_arg: return i return None def replace_langid(params: list[dict]) -> list[dict]: new_params = params[:] for param in new_params: if "documentation" not in param: continue # Replace the first value of langid, when starting a code block param["documentation"]["value"] = param["documentation"][ "value" ].replace("```{langid}", f"```{self.hover_language}", 1) return params # Get parameters from request params: dict = request["params"] uri: str = params["textDocument"]["uri"] path: str = path_from_uri(uri) file_obj = self.workspace.get(path) if file_obj is None: return None # Check line sig_line: int = params["position"]["line"] sig_char: int = params["position"]["character"] # Get full line (and possible continuations) from file pre_lines, curr_line, _ = file_obj.get_code_line( sig_line, forward=False, strip_comment=True ) line_prefix = get_line_prefix(pre_lines, curr_line, sig_char) if line_prefix is None: return None # Test if scope declaration or end statement if FRegex.SCOPE_DEF.match(curr_line) or FRegex.END.match(curr_line): return None is_member = False try: sub_name, arg_strings, sub_end = get_sub_name(line_prefix) var_stack = get_var_stack(sub_name) is_member = len(var_stack) > 1 except (TypeError, AttributeError): return None # curr_scope = file_obj.ast.get_inner_scope(sig_line + 1) # Traverse type tree if necessary if is_member: type_scope = climb_type_tree(var_stack, curr_scope, self.obj_tree) # Set enclosing type as scope if type_scope is None: curr_scope = None else: curr_scope = type_scope sub_name = var_stack[-1] # Find in available scopes var_obj = None if curr_scope is not None: var_obj = find_in_scope(curr_scope, sub_name, self.obj_tree) # Search in global scope if var_obj is None: key = sub_name.lower() if key in self.obj_tree: var_obj = self.obj_tree[key][0] else: for obj in self.intrinsic_funs: if obj.name.lower() == key: var_obj = obj break # Check keywords if (var_obj is None) and ( FRegex.INT_STMNT.match(line_prefix[:sub_end]) is not None ): key = sub_name.lower() for candidate in get_intrinsic_keywords(self.statements, self.keywords, 0): if candidate.name.lower() == key: var_obj = candidate break if var_obj is None: return None # Build signature label, doc_str, params = var_obj.get_signature() if label is None: return None # Replace placeholder language id with Fortran ID params = replace_langid(params) # Find current parameter by index or by # looking at last arg with optional name param_num = len(arg_strings) - 1 opt_num = check_optional(arg_strings[-1], params) if opt_num is None: if len(arg_strings) > 1: opt_num = check_optional(arg_strings[-2], params) if opt_num is not None: param_num = opt_num + 1 else: param_num = opt_num signature = {"label": label, "parameters": params} if doc_str is not None: doc_str = doc_str.format(langid=self.hover_language) signature["documentation"] = {"kind": "markdown", "value": doc_str} req_dict = {"signatures": [signature], "activeParameter": param_num} return req_dict def get_all_references( self, def_obj, type_mem: bool, file_obj: FortranFile = None, ): # Search through all files def_name: str = def_obj.name.lower() def_fqsn: str = def_obj.FQSN NAME_REGEX = re.compile(rf"(?:\W|^)({def_name})(?:\W|$)", re.I) if file_obj is None: file_set = self.workspace.items() else: file_set = ((file_obj.path, file_obj),) # A container that includes all the FQSN signatures for objects that # are linked to the rename request and that should also be replaced override_cache: list[str] = [] refs = {} ref_objs = [] for filename, file_obj in file_set: file_refs = [] # Search through file line by line for i, line in enumerate(file_obj.contents_split): if len(line) == 0: continue # Skip comment lines line = file_obj.strip_comment(line) if (line == "") or (line[0] == "#"): continue for match in NAME_REGEX.finditer(line): var_def = self.get_definition(file_obj, i, match.start(1) + 1) if var_def is None: continue ref_match = False try: # NOTE: throws AttributeError if object is intrinsic since # it will not have a FQSN # BUG: intrinsic objects should be excluded, but get_definition # does not recognise the arguments if def_fqsn == var_def.FQSN or var_def.FQSN in override_cache: ref_match = True # NOTE: throws AttributeError if object is None elif var_def.parent.get_type() == CLASS_TYPE_ID: if type_mem: for inherit_def in var_def.parent.get_overridden( def_name ): if def_fqsn == inherit_def.FQSN: ref_match = True override_cache.append(var_def.FQSN) break # Standalone definition of a type-bound procedure, # no pointer replace all its instances in the current scope # NOTE: throws AttributeError if object has no link_obj if ( var_def.sline - 1 == i and var_def.file_ast.path == filename and line.count("=>") == 0 and var_def.link_obj is def_obj ): ref_objs.append(var_def) override_cache.append(var_def.FQSN) ref_match = True # Object is a Method and the linked object i.e. the # implementation # shares the same parent signature as the current variable # NOTE:: throws and AttributeError if the link_object or # parent are not present OR they are set to None # hence not having a FQSN elif ( def_obj.get_type(True) == METH_TYPE_ID and def_obj.link_obj.parent.FQSN == var_def.parent.FQSN ): ref_match = True override_cache.append(var_def.FQSN) except AttributeError: ref_match = False if ref_match: file_refs.append([i, match.start(1), match.end(1)]) if len(file_refs) > 0: refs[filename] = file_refs return refs, ref_objs def serve_references(self, request): # Get parameters from request params: dict = request["params"] uri: str = params["textDocument"]["uri"] def_line: int = params["position"]["line"] def_char: int = params["position"]["character"] path = path_from_uri(uri) # Find object file_obj = self.workspace.get(path) if file_obj is None: return None def_obj = self.get_definition(file_obj, def_line, def_char) if def_obj is None: return None # Determine global accessibility and type membership restrict_file = None type_mem = False if def_obj.FQSN.count(":") > 2: if def_obj.parent.get_type() == CLASS_TYPE_ID: type_mem = True else: restrict_file = def_obj.file_ast.file if restrict_file is None: return None all_refs, _ = self.get_all_references(def_obj, type_mem, file_obj=restrict_file) refs = [] for filename, file_refs in all_refs.items(): for ref in file_refs: refs.append( uri_json(path_to_uri(filename), ref[0], ref[1], ref[0], ref[2]) ) return refs def serve_definition(self, request: dict): # Get parameters from request params: dict = request["params"] uri: str = params["textDocument"]["uri"] def_line: int = params["position"]["line"] def_char: int = params["position"]["character"] path = path_from_uri(uri) # Find object file_obj = self.workspace.get(path) if file_obj is None: return None var_obj = self.get_definition(file_obj, def_line, def_char) if var_obj is None: return None # Construct link reference if var_obj.file_ast.file is not None: return self._create_ref_link(var_obj) return None def serve_hover(self, request: dict): def create_hover(string: str, docs: str | None): # This does not account for Fixed Form Fortran, but it should be # okay for 99% of cases return fortran_md(string, docs).format(langid=self.hover_language) # Get parameters from request params: dict = request["params"] uri: str = params["textDocument"]["uri"] def_line: int = params["position"]["line"] def_char: int = params["position"]["character"] path: str = path_from_uri(uri) file_obj = self.workspace.get(path) if file_obj is None: return None # Find object var_obj = self.get_definition(file_obj, def_line, def_char, hover_req=True) if var_obj is None: return None # Construct hover information var_type: int = var_obj.get_type() hover_array = [] if var_type in ( SUBROUTINE_TYPE_ID, FUNCTION_TYPE_ID, MODULE_TYPE_ID, CLASS_TYPE_ID, ): hover_array.append( var_obj.get_hover_md(long=True).replace( "```{langid}", f"```{self.hover_language}", 1 ) ) elif var_type == INTERFACE_TYPE_ID: for member in var_obj.mems: hover_str, docs = member.get_hover(long=True) if hover_str is not None: hover_array.append(create_hover(hover_str, docs)) elif var_type == VAR_TYPE_ID: # Unless we have a Fortran literal include the desc in the hover msg # See get_definition for an explanation about this default name if not var_obj.desc.startswith(FORTRAN_LITERAL): hover_array.append( var_obj.get_hover_md(long=True).replace( "```{langid}", f"```{self.hover_language}", 1 ) ) # Hover for Literal variables elif var_obj.desc.endswith("REAL"): hover_array.append(create_hover("REAL", None)) elif var_obj.desc.endswith("INTEGER"): hover_array.append(create_hover("INTEGER", None)) elif var_obj.desc.endswith("LOGICAL"): hover_array.append(create_hover("LOGICAL", None)) elif var_obj.desc.endswith("STRING"): hover_str = f"CHARACTER(LEN={len(var_obj.name)-2})" hover_array.append(create_hover(hover_str, None)) if len(hover_array) > 0: return {"contents": {"kind": "markdown", "value": "\n".join(hover_array)}} return None def serve_implementation(self, request: dict): # Get parameters from request params: dict = request["params"] uri: str = params["textDocument"]["uri"] def_line: int = params["position"]["line"] def_char: int = params["position"]["character"] path = path_from_uri(uri) file_obj = self.workspace.get(path) if file_obj is None: return None # Find object var_obj = self.get_definition(file_obj, def_line, def_char) if var_obj is None: return None # Intrinsics do not have implementations we can access if isinstance(var_obj, Intrinsic): return None # Construct implementation reference if var_obj.parent.get_type() == CLASS_TYPE_ID: impl_obj = var_obj.link_obj if (impl_obj is not None) and (impl_obj.file_ast.file is not None): return self._create_ref_link(impl_obj) elif var_obj.parent.get_type() == INTERFACE_TYPE_ID: # Find the first implementation of the interface if var_obj.link_obj is not None: return self._create_ref_link(var_obj.link_obj) return None def serve_rename(self, request: dict): # Get parameters from request params: dict = request["params"] uri: str = params["textDocument"]["uri"] def_line: int = params["position"]["line"] def_char: int = params["position"]["character"] path = path_from_uri(uri) # Find object file_obj = self.workspace.get(path) if file_obj is None: return None def_obj = self.get_definition(file_obj, def_line, def_char) if def_obj is None: return None if isinstance(def_obj, Intrinsic): self.post_message("Rename failed: Cannot rename intrinsics", Severity.warn) return None # Determine global accesibility and type membership restrict_file = None type_mem = False if def_obj.FQSN.count(":") > 2: if def_obj.parent.get_type() == CLASS_TYPE_ID: type_mem = True else: restrict_file = def_obj.file_ast.file if restrict_file is None: return None all_refs, ref_objs = self.get_all_references( def_obj, type_mem, file_obj=restrict_file ) if len(all_refs) == 0: self.post_message("Rename failed: No usages found to rename", Severity.warn) return None # Create rename changes new_name = params["newName"] changes: dict[str, list[dict]] = {} for filename, file_refs in all_refs.items(): file_uri = path_to_uri(filename) changes[file_uri] = [] for ref in file_refs: changes[file_uri].append( change_json(new_name, ref[0], ref[1], ref[0], ref[2]) ) return {"changes": changes} def serve_codeActions(self, request: dict): params: dict = request["params"] uri: str = params["textDocument"]["uri"] sline: int = params["range"]["start"]["line"] eline: int = params["range"]["end"]["line"] path = path_from_uri(uri) file_obj = self.workspace.get(path) # Find object if file_obj is None: return None curr_scope = file_obj.ast.get_inner_scope(sline) if curr_scope is None: return None action_list = curr_scope.get_actions(sline, eline) if action_list is None: return None # Convert diagnostics for action in action_list: diagnostics = action.get("diagnostics") if diagnostics is not None: new_diags = [] for diagnostic in diagnostics: new_diags.append(diagnostic.build(file_obj)) action["diagnostics"] = new_diags return action_list def send_diagnostics(self, uri: str): diag_results, diag_exp = self.get_diagnostics(uri) if diag_results is not None: self.conn.send_notification( "textDocument/publishDiagnostics", {"uri": uri, "diagnostics": diag_results}, ) elif diag_exp is not None: self.conn.write_error( -1, code=-32603, message=str(diag_exp), data={ "traceback": traceback.format_exc(), }, ) def get_diagnostics(self, uri: str): filepath = path_from_uri(uri) file_obj = self.workspace.get(filepath) if file_obj is not None: try: diags = file_obj.check_file( self.obj_tree, max_line_length=self.max_line_length, max_comment_line_length=self.max_comment_line_length, ) except Exception as e: return None, e else: return diags, None return None, None def serve_onChange(self, request: dict): # Update workspace from file sent by editor params: dict = request["params"] uri: str = params["textDocument"]["uri"] path = path_from_uri(uri) file_obj = self.workspace.get(path) if file_obj is None: self.post_message(f"Change request failed for unknown file '{path}'") return else: # Update file contents with changes reparse_req = True if self.sync_type == 1: file_obj.apply_change(params["contentChanges"][0]) else: try: reparse_req = False for change in params["contentChanges"]: reparse_flag = file_obj.apply_change(change) reparse_req = reparse_req or reparse_flag except: self.post_message( f"Change request failed for file '{path}': Could not apply" " change", Severity.error, exc_info=True, ) return # Parse newly updated file if reparse_req: _, err_str = self.update_workspace_file(path, update_links=True) if err_str is not None: self.post_message(f"Change request failed for file '{path}': {err_str}") return # Update include statements linking to this file for _, tmp_file in self.workspace.items(): tmp_file.ast.resolve_includes(self.workspace, path=path) file_obj.ast.resolve_includes(self.workspace) # Update inheritance (currently file only) # tmp_file.ast.resolve_links(self.obj_tree, self.link_version) elif file_obj.preproc: file_obj.preprocess(pp_defs=self.pp_defs) self.pp_defs = {**self.pp_defs, **file_obj.pp_defs} def serve_onOpen(self, request: dict): self.serve_onSave(request, did_open=True) def serve_onClose(self, request: dict): self.serve_onSave(request, did_close=True) def serve_onSave( self, request: dict, did_open: bool = False, did_close: bool = False ): # Update workspace from file on disk params: dict = request["params"] uri: str = params["textDocument"]["uri"] filepath = path_from_uri(uri) # Skip update and remove objects if file is deleted if did_close and (not os.path.isfile(filepath)): # Remove old objects from tree file_obj = self.workspace.get(filepath) if file_obj is not None: ast_old = file_obj.ast if ast_old is not None: for key in ast_old.global_dict: self.obj_tree.pop(key, None) return did_change, err_str = self.update_workspace_file( filepath, read_file=True, allow_empty=did_open ) if err_str is not None: self.post_message(f"Save request failed for file '{filepath}': {err_str}") return if did_change: # Update include statements linking to this file for _, file_obj in self.workspace.items(): file_obj.ast.resolve_includes(self.workspace, path=filepath) file_obj = self.workspace.get(filepath) file_obj.ast.resolve_includes(self.workspace) # Update inheritance/links self.link_version = (self.link_version + 1) % 1000 for _, file_obj in self.workspace.items(): file_obj.ast.resolve_links(self.obj_tree, self.link_version) if not self.disable_diagnostics: self.send_diagnostics(uri) def update_workspace_file( self, filepath: str, read_file: bool = False, allow_empty: bool = False, update_links: bool = False, ): # Update workspace from file contents and path try: file_obj = self.workspace.get(filepath) if read_file: if file_obj is None: file_obj = FortranFile(filepath, self.pp_suffixes) # Create empty file if not yet saved to disk if not os.path.isfile(filepath): if allow_empty: file_obj.ast = FortranAST(file_obj) self.workspace[filepath] = file_obj return False, None else: return False, "File does not exist" # Error during load err_string, file_changed = file_obj.load_from_disk() if err_string: log.error("%s : %s", err_string, filepath) return False, err_string # Error during file read if not file_changed: return False, None ast_new = file_obj.parse( pp_defs=self.pp_defs, include_dirs=self.include_dirs ) # Add the included read in pp_defs from to the ones specified in the # configuration file self.pp_defs = {**self.pp_defs, **file_obj.pp_defs} except: log.error("Error while parsing file %s", filepath, exc_info=True) return False, "Error during parsing" # Error during parsing # Remove old objects from tree ast_old = file_obj.ast if ast_old is not None: for key in ast_old.global_dict: self.obj_tree.pop(key, None) # Add new file to workspace file_obj.ast = ast_new if filepath not in self.workspace: self.workspace[filepath] = file_obj # Add top-level objects to object tree for key, obj in ast_new.global_dict.items(): self.obj_tree[key] = [obj, filepath] # Update local links/inheritance if necessary if update_links: self.link_version = (self.link_version + 1) % 1000 ast_new.resolve_links(self.obj_tree, self.link_version) return True, None @staticmethod def file_init( filepath: str, pp_defs: dict, pp_suffixes: list[str], include_dirs: set[str], sort: bool, ): """Initialise a Fortran file Parameters ---------- filepath : str Path to file pp_defs : dict Preprocessor definitions pp_suffixes : list[str] Preprocessor file extension, additional to default include_dirs : set[str] Preprocessor only include directories, not used by normal parser sort : bool Whether or not keywords should be sorted Returns ------- fortran_file | str A Fortran file object or a string containing the error message """ file_obj = FortranFile(filepath, pp_suffixes) err_str, _ = file_obj.load_from_disk() if err_str: return err_str try: # On Windows multiprocess does not propagate global variables in a shell. # Windows uses 'spawn' while Unix uses 'fork' which propagates globals. # This is a bypass. # For more see on SO: shorturl.at/hwAG1 set_keyword_ordering(sort) file_ast = file_obj.parse(pp_defs=pp_defs, include_dirs=include_dirs) except: log.error("Error while parsing file %s", filepath, exc_info=True) return "Error during parsing" file_obj.ast = file_ast return file_obj def workspace_init(self): """Initialise the workspace root across multiple threads""" file_list = self._get_source_files() # Process files pool = Pool(processes=self.nthreads) results = {} for filepath in file_list: results[filepath] = pool.apply_async( self.file_init, args=( filepath, self.pp_defs, self.pp_suffixes, self.include_dirs, self.sort_keywords, ), ) pool.close() pool.join() for path, result in results.items(): try: result_obj = result.get() except Exception as e: result_obj = ( "An exception has occured while initialising the workspace.\n" f"Exception({(type(e))}): {e}\n" + f"Traceback: {traceback.format_exc()}" ) if isinstance(result_obj, str): self.post_message( f"Initialization failed for file {path}: {result_obj}" ) continue self.workspace[path] = result_obj # Add top-level objects to object tree ast_new = self.workspace[path].ast for key in ast_new.global_dict: self.obj_tree[key] = [ast_new.global_dict[key], path] # Update include statements for _, file_obj in self.workspace.items(): file_obj.ast.resolve_includes(self.workspace) # Update inheritance/links self.link_version = (self.link_version + 1) % 1000 for _, file_obj in self.workspace.items(): file_obj.ast.resolve_links(self.obj_tree, self.link_version) def serve_exit(self, request: dict) -> None: # Exit server self.workspace = {} self.obj_tree = {} self.running = False def serve_default(self, request: dict): """Raise an error in the Language Server Parameters ---------- request : dict client dictionary with requests Raises ------ JSONRPC2Error error with code -32601 """ # Default handler (errors!) raise JSONRPC2Error( code=-32601, message=f"method {request['method']} not found" ) def _load_config_file(self) -> None: """Loads the configuration file for the Language Server""" # Check for config files default_conf_files = [self.config, ".fortlsrc", ".fortls.json", ".fortls"] present_conf_files = [ os.path.isfile(os.path.join(self.root_path, f)) for f in default_conf_files ] if not any(present_conf_files): return None # Load the first config file found for f, present in zip(default_conf_files, present_conf_files): if not present: continue config_path = os.path.join(self.root_path, f) break try: with open(config_path) as jsonfile: config_dict = json5.load(jsonfile) # Include and Exclude directories self._load_config_file_dirs(config_dict) # General options self._load_config_file_general(config_dict) # Preprocessor options self._load_config_file_preproc(config_dict) # Debug options debugging: bool = config_dict.get("debug_log", self.debug_log) # If conf option is different than the debug option passed as a # command line argument return True so that debug log is setup if debugging != self.debug_log and not self.debug_log: self.debug_log = True except FileNotFoundError: self.post_message(f"Configuration file '{self.config}' not found") # Erroneous json file syntax except ValueError as e: msg = f'Error: "{e}" while reading "{self.config}" Configuration file' self.post_message(msg) def _load_config_file_dirs(self, config_dict: dict) -> None: self.excl_paths = set(config_dict.get("excl_paths", self.excl_paths)) self.source_dirs = set(config_dict.get("source_dirs", self.source_dirs)) self.incl_suffixes = set(config_dict.get("incl_suffixes", self.incl_suffixes)) # Update the source file REGEX self.FORTRAN_SRC_EXT_REGEX = create_src_file_exts_str(self.incl_suffixes) self.excl_suffixes = set(config_dict.get("excl_suffixes", self.excl_suffixes)) def _load_config_file_general(self, config_dict: dict) -> None: # General options ------------------------------------------------------ self.nthreads = config_dict.get("nthreads", self.nthreads) self.notify_init = config_dict.get("notify_init", self.notify_init) self.incremental_sync = config_dict.get( "incremental_sync", self.incremental_sync ) self.sync_type: int = 2 if self.incremental_sync else 1 self.recursion_limit = config_dict.get("recursion_limit", self.recursion_limit) self.sort_keywords = config_dict.get("sort_keywords", self.sort_keywords) self.disable_autoupdate = config_dict.get( "disable_autoupdate", self.disable_autoupdate ) # Autocomplete options ------------------------------------------------- self.autocomplete_no_prefix = config_dict.get( "autocomplete_no_prefix", self.autocomplete_no_prefix ) self.autocomplete_no_snippets = config_dict.get( "autocomplete_no_snippets", self.autocomplete_no_snippets ) self.autocomplete_name_only = config_dict.get( "autocomplete_name_only", self.autocomplete_name_only ) self.lowercase_intrinsics = config_dict.get( "lowercase_intrinsics", self.lowercase_intrinsics ) self.use_signature_help = config_dict.get( "use_signature_help", self.use_signature_help ) # Hover options -------------------------------------------------------- self.hover_signature = config_dict.get("hover_signature", self.hover_signature) self.hover_language = config_dict.get("hover_language", self.hover_language) # Diagnostic options --------------------------------------------------- self.max_line_length = config_dict.get("max_line_length", self.max_line_length) self.max_comment_line_length = config_dict.get( "max_comment_line_length", self.max_comment_line_length ) self.disable_diagnostics = config_dict.get( "disable_diagnostics", self.disable_diagnostics ) # Symbols options ------------------------------------------------------ self.symbol_skip_mem = config_dict.get("symbol_skip_mem", self.symbol_skip_mem) # Code Actions options ------------------------------------------------- self.enable_code_actions = config_dict.get( "enable_code_actions", self.enable_code_actions ) def _load_config_file_preproc(self, config_dict: dict) -> None: self.pp_suffixes = config_dict.get("pp_suffixes", None) self.pp_defs = config_dict.get("pp_defs", {}) if isinstance(self.pp_defs, list): self.pp_defs = {key: "" for key in self.pp_defs} self.include_dirs = set(config_dict.get("include_dirs", self.include_dirs)) def _resolve_globs_in_paths(self) -> None: """Resolves glob patterns in `excl_paths`, `source_dirs` and `include_dirs`. Also performs the exclusion of `excl_paths` from `source_dirs`. """ # Exclude paths (directories & files) with glob resolution excl_paths = set() for path in self.excl_paths: excl_paths.update(set(resolve_globs(path, self.root_path))) self.excl_paths = excl_paths.copy() # Source directory paths (directories) with glob resolution source_dirs = set() for path in self.source_dirs: # resolve_globs filters any nonexisting directories so FileNotFoundError # found inside only_dirs can never be raised source_dirs.update(set(only_dirs(resolve_globs(path, self.root_path)))) self.source_dirs = source_dirs.copy() # Keep all directories present in source_dirs but not excl_paths self.source_dirs = {i for i in self.source_dirs if i not in self.excl_paths} # Preprocessor includes include_dirs = set() for path in self.include_dirs: # resolve_globs filters any nonexisting directories so FileNotFoundError # found inside only_dirs can never be raised include_dirs.update(set(only_dirs(resolve_globs(path, self.root_path)))) self.include_dirs = include_dirs.copy() def _add_source_dirs(self) -> None: """Will recursively add all subdirectories that contain Fortran source files only if the option `source_dirs` has not been specified in the configuration file or no configuration file is present """ # Recursively add sub-directories that only match Fortran extensions if len(self.source_dirs) != 1: return None if self.root_path not in self.source_dirs: return None self.source_dirs = set() for root, dirs, files in os.walk(self.root_path): # Match not found if not list(filter(self.FORTRAN_SRC_EXT_REGEX.search, files)): continue if root not in self.source_dirs and root not in self.excl_paths: self.source_dirs.add(str(Path(root).resolve())) def _get_source_files(self) -> list[str]: """Get all the source files present in `self.source_dirs`, exclude any files found in `self.excl_paths`^ and ignore any files ending with `self.excl_suffixes`. ^: the only case where this has not allready happened is when `source_dirs` is not specified or a configuration file is not present Returns ------- list[str] List of source Fortran source files """ # Get filenames file_list = [] for src_dir in self.source_dirs: for f in os.listdir(src_dir): p = os.path.join(src_dir, f) # Process only files if not os.path.isfile(p): continue # File extension must match supported extensions if not self.FORTRAN_SRC_EXT_REGEX.search(f): continue # File cannot be in excluded paths/files if p in self.excl_paths: continue # File cannot have an excluded extension if any(f.endswith(ext) for ext in self.excl_suffixes): continue file_list.append(p) return file_list def _config_logger(self, request) -> None: """Configures the logger to save Language Server requests/responses to a file the logger will by default output to the main (stderr, stdout) channels. """ file_log = True if self.debug_log and self.root_path else False fmt = "[%(levelname)-.4s - %(asctime)s] %(message)s" if file_log: fname = "fortls_debug.log" fname = os.path.join(self.root_path, fname) logging.basicConfig(filename=fname, level=logging.DEBUG, filemode="w") # Also forward logs to the console consoleHandler = logging.StreamHandler() log.addHandler(consoleHandler) log.debug("REQUEST %s %s", request.get("id"), request.get("method")) self.post_messages.append([Severity.info, "fortls debugging enabled"]) else: logging.basicConfig(format=fmt, datefmt="%H:%M:%S", level=logging.INFO) def _load_intrinsics(self) -> None: # Load intrinsics set_keyword_ordering(True) # Always sort intrinsics if self.lowercase_intrinsics: set_lowercase_intrinsics() ( self.statements, self.keywords, self.intrinsic_funs, self.intrinsic_mods, ) = load_intrinsics() for module in self.intrinsic_mods: self.obj_tree[module.FQSN] = [module, None] # Set object settings set_keyword_ordering(self.sort_keywords) def _create_ref_link(self, obj) -> dict: """Create a link reference to an object""" obj_file: FortranFile = obj.file_ast.file sline, (schar, echar) = obj_file.find_word_in_code_line(obj.sline - 1, obj.name) if schar < 0: schar = echar = 0 return uri_json(path_to_uri(obj_file.path), sline, schar, sline, echar) def _update_version_pypi(self, test: bool = False): """Fetch updates from PyPi for fortls Parameters ---------- test : bool, optional flag used to override exit checks, only for unittesting, by default False """ if self.disable_autoupdate: return False # Do not run for prerelease and dev release if self._version.is_prerelease and not test: return False try: # For security reasons register as Request before opening request = urllib.request.Request("https://pypi.org/pypi/fortls/json") with urllib.request.urlopen(request) as resp: info = json.loads(resp.read().decode("utf-8")) remote_v = version.parse(info["info"]["version"]) # Do not update from remote if it is a prerelease if remote_v.is_prerelease: return False # This is the only reliable way to compare version semantics if remote_v > self._version or test: self.post_message( "A newer version of fortls is available for download", Severity.info, ) # Anaconda environments should handle their updates through conda if os.path.exists(os.path.join(sys.prefix, "conda-meta")): return False self.post_message( f"Downloading from PyPi fortls {info['info']['version']}", Severity.info, ) # Run pip result = subprocess.run( [ sys.executable, "-m", "pip", "install", "fortls", "--upgrade", "--user", ], capture_output=True, ) if result.stdout: log.info(result.stdout.decode("utf-8")) if result.stderr: log.error(result.stderr.decode("utf-8")) return True # No internet connection exceptions except (URLError, KeyError): self.post_message("Failed to update the fortls", Severity.warn) return False def update_recursion_limit(limit: int) -> None: """Update the recursion limit of the Python interpreter Parameters ---------- limit : int New recursion limit Examples -------- >>> update_recursion_limit(10000) """ if limit != sys.getrecursionlimit(): sys.setrecursionlimit(limit) class JSONRPC2Error(Exception): def __init__(self, code, message, data=None): self.code = code self.message = message self.data = data fortran-language-server-3.2.2+dfsg/fortls/parsers/000077500000000000000000000000001477231266000221755ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/fortls/parsers/__init__.py000066400000000000000000000000001477231266000242740ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/000077500000000000000000000000001477231266000240115ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/__init__.py000066400000000000000000000000001477231266000261100ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/associate.py000066400000000000000000000057661477231266000263540ustar00rootroot00000000000000from __future__ import annotations import re from dataclasses import dataclass from typing import TYPE_CHECKING from fortls.constants import ASSOC_TYPE_ID from fortls.helper_functions import get_var_stack from .block import Block from .utilities import climb_type_tree, find_in_scope from .variable import Variable if TYPE_CHECKING: from .ast import FortranAST @dataclass class AssociateMap: var: Variable bind_name: str link_name: str class Associate(Block): def __init__(self, file_ast: FortranAST, line_number: int, name: str): super().__init__(file_ast, line_number, name) self.links: list[AssociateMap] = [] # holds the info to associate variables def get_type(self, no_link=False): return ASSOC_TYPE_ID def get_desc(self): return "ASSOCIATE" def create_binding_variable( self, file_ast: FortranAST, line_number: int, bind_name: str, link_name: str ) -> Variable: """Create a new variable to be linked upon resolution to the real variable that contains the information of the mapping from the parent scope to the ASSOCIATE block scope. Parameters ---------- file_ast : fortran_ast AST file line_number : int Line number bind_name : str Name of the ASSOCIATE block variable link_name : str Name of the parent scope variable Returns ------- fortran_var Variable object holding the ASSOCIATE block variable, pending resolution """ new_var = Variable(file_ast, line_number, bind_name, "UNKNOWN", []) self.links.append(AssociateMap(new_var, bind_name, link_name)) return new_var def resolve_link(self, obj_tree): # Loop through the list of the associated variables map and resolve the links # find the AST node that that corresponds to the variable with link_name for assoc in self.links: # TODO: extract the dimensions component from the link_name # re.sub(r'\(.*\)', '', link_name) removes the dimensions component # keywords = re.match(r'(.*)\((.*)\)', link_name).groups() # now pass the keywords through the dimension_parser and set the keywords # in the associate object. Hover should now pick the local keywords # over the linked_object keywords assoc.link_name = re.sub(r"\(.*\)", "", assoc.link_name) var_stack = get_var_stack(assoc.link_name) is_member = len(var_stack) > 1 if is_member: type_scope = climb_type_tree(var_stack, self, obj_tree) if type_scope is None: continue var_obj = find_in_scope(type_scope, var_stack[-1], obj_tree) else: var_obj = find_in_scope(self, assoc.link_name, obj_tree) if var_obj is not None: assoc.var.link_obj = var_obj def require_link(self): return True fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/ast.py000066400000000000000000000300501477231266000251500ustar00rootroot00000000000000from __future__ import annotations import os import re from re import Pattern from fortls.ftypes import IncludeInfo from fortls.json_templates import diagnostic_json from .diagnostics import Diagnostic from .imports import Import, ImportTypes from .interface import Interface from .program import Program from .scope import Scope from .use import Use from .variable import Variable class FortranAST: def __init__(self, file_obj=None): self.file = file_obj self.path: str | None = file_obj.path if file_obj is not None else None self.global_dict: dict = {} self.scope_list: list = [] self.variable_list: list = [] self.public_list: list = [] self.private_list: list = [] self.scope_stack: list = [] self.end_stack: list = [] self.pp_if: list = [] self.include_statements: list = [] self.end_errors: list = [] self.parse_errors: list = [] self.inherit_objs: list = [] self.linkable_objs: list = [] self.external_objs: list = [] self.none_scope = None self.inc_scope = None self.current_scope = None self.end_scope_regex: Pattern | None = None self.enc_scope_name: str | None = None self.last_obj = None self.pending_doc: str | None = None def create_none_scope(self): """Create empty scope to hold non-module contained items""" if self.none_scope is not None: raise ValueError self.none_scope = Program(self, 1, "main") self.add_scope( self.none_scope, re.compile(r"[ ]*END[ ]*PROGRAM", re.I), exportable=False ) def get_enc_scope_name(self): """Get current enclosing scope name""" return None if self.current_scope is None else self.current_scope.FQSN def add_scope( self, new_scope: Scope, end_scope_regex: Pattern[str], exportable: bool = True, req_container: bool = False, ): self.scope_list.append(new_scope) if new_scope.require_inherit(): self.inherit_objs.append(new_scope) if new_scope.require_link(): self.linkable_objs.append(new_scope) if self.current_scope is None: if req_container: self.create_none_scope() new_scope.FQSN = f"{self.none_scope.FQSN}::{new_scope.name.lower()}" self.current_scope.add_child(new_scope) self.scope_stack.append(self.current_scope) elif exportable: self.global_dict[new_scope.FQSN] = new_scope else: self.current_scope.add_child(new_scope) self.scope_stack.append(self.current_scope) if self.end_scope_regex is not None: self.end_stack.append(self.end_scope_regex) self.current_scope = new_scope self.end_scope_regex = end_scope_regex self.enc_scope_name = self.get_enc_scope_name() self.last_obj = new_scope if self.pending_doc is not None: self.last_obj.add_doc(self.pending_doc) self.pending_doc = None def end_scope(self, line_number: int, check: bool = True): if ( (self.current_scope is None) or (self.current_scope is self.none_scope) ) and check: self.end_errors.append([-1, line_number]) return self.current_scope.end(line_number) if len(self.scope_stack) > 0: self.current_scope = self.scope_stack.pop() else: self.current_scope = None if len(self.end_stack) > 0: self.end_scope_regex = self.end_stack.pop() else: self.end_scope_regex = None self.enc_scope_name = self.get_enc_scope_name() def add_variable(self, new_var: Variable): if self.current_scope is None: self.create_none_scope() new_var.FQSN = f"{self.none_scope.FQSN}::{new_var.name.lower()}" self.current_scope.add_child(new_var) self.variable_list.append(new_var) if new_var.is_external: self.external_objs.append(new_var) if new_var.require_link(): self.linkable_objs.append(new_var) self.last_obj = new_var if self.pending_doc is not None: self.last_obj.add_doc(self.pending_doc) self.pending_doc = None def add_int_member(self, key): self.current_scope.add_member(key) def add_private(self, name: str): self.private_list.append(f"{self.enc_scope_name}::{name}") def add_public(self, name: str): self.public_list.append(f"{self.enc_scope_name}::{name}") def add_use(self, use_mod: Use | Import): if self.current_scope is None: self.create_none_scope() self.current_scope.add_use(use_mod) def add_include(self, path: str, line_number: int): self.include_statements.append(IncludeInfo(line_number, path, None, [])) def add_doc(self, doc_string: str, forward: bool = False): if not doc_string: return if forward: self.pending_doc = doc_string elif self.last_obj is not None: self.last_obj.add_doc(doc_string) def add_error(self, msg: str, sev: int, ln: int, sch: int, ech: int = None): """Add a Diagnostic error, encountered during parsing, for a range in the document. Parameters ---------- msg : str Error message sev : int Severity, Error, Warning, Notification ln : int Line number sch : int Start character ech : int End character """ # Convert from Editor line numbers 1-base index to LSP index which is 0-based self.parse_errors.append(diagnostic_json(ln - 1, sch, ln - 1, ech, msg, sev)) def start_ppif(self, line_number: int): self.pp_if.append([line_number - 1, -1]) def end_ppif(self, line_number: int): if len(self.pp_if) > 0: self.pp_if[-1][1] = line_number - 1 def get_scopes(self, line_number: int | None = None): """Get a list of all the scopes present in the line number provided. Parameters ---------- line_number : int, optional Document line number, if None return all document scopes, by default None Returns ------- Variable,Type,Function,Subroutine,Module,Program,Interface,BlockData A list of scopes """ if line_number is None: return self.scope_list scope_list = [] for scope in self.scope_list: if not scope.sline <= line_number <= scope.eline: continue if type(scope.parent) is Interface: for use_stmnt in scope.use: if type(use_stmnt) is not Import: continue # Exclude the parent and all other scopes if use_stmnt.import_type == ImportTypes.NONE: return [scope] scope_list.append(scope) scope_list.extend(iter(scope.get_ancestors())) if scope_list or self.none_scope is None: return scope_list return [self.none_scope] def get_inner_scope(self, line_number: int): scope_sline = -1 curr_scope = None for scope in self.scope_list: if scope.sline > scope_sline and scope.sline <= line_number <= scope.eline: curr_scope = scope scope_sline = scope.sline if (curr_scope is None) and (self.none_scope is not None): return self.none_scope return curr_scope def get_object(self, FQSN: str): def find_child_by_name(parent, name): for child in parent.children: if child.name == name: return child if child.name.startswith("#GEN_INT"): found = next( ( int_child for int_child in child.get_children() if int_child.name == name ), None, ) if found: return found return None parts = FQSN.split("::") current = self.global_dict.get(parts[0]) # Look for non-exportable scopes if current is None: current = next( (scope for scope in self.scope_list if scope.FQSN == parts[0]), None ) if current is None: return None for part in parts[1:]: current = find_child_by_name(current, part) if current is None: return None return current def resolve_includes(self, workspace, path: str | None = None): file_dir = os.path.dirname(self.path) for inc in self.include_statements: file_path = os.path.normpath(os.path.join(file_dir, inc.path)) if path and path != file_path: continue parent_scope = self.get_inner_scope(inc.line_number) added_entities = inc.scope_objs if file_path in workspace: include_file = workspace[file_path] include_ast = include_file.ast inc.file = include_file if include_ast.none_scope: if include_ast.inc_scope is None: include_ast.inc_scope = include_ast.none_scope # Remove old objects for obj in added_entities: parent_scope.children.remove(obj) added_entities = [] for child in include_ast.inc_scope.children: added_entities.append(child) if parent_scope is not None: parent_scope.add_child(child) child.update_fqsn(parent_scope.FQSN) include_ast.none_scope = parent_scope inc.scope_objs = added_entities def resolve_links(self, obj_tree, link_version): for inherit_obj in self.inherit_objs: inherit_obj.resolve_inherit(obj_tree, inherit_version=link_version) for linkable_obj in self.linkable_objs: linkable_obj.resolve_link(obj_tree) def close_file(self, line_number: int): # Close open scopes while self.current_scope is not None: self.end_scope(line_number, check=False) # Close and delist none_scope if self.none_scope is not None: self.none_scope.end(line_number) self.scope_list.remove(self.none_scope) # Tasks to be done when file parsing is finished for private_name in self.private_list: obj = self.get_object(private_name) if obj is not None: obj.set_visibility(-1) for public_name in self.public_list: obj = self.get_object(public_name) if obj is not None: obj.set_visibility(1) def check_file(self, obj_tree): errors = [] tmp_list = self.scope_list[:] # shallow copy if self.none_scope is not None: tmp_list += [self.none_scope] for error in self.end_errors: if error[0] >= 0: message = f"Unexpected end of scope at line {error[0]}" else: message = "Unexpected end statement: No open scopes" errors.append(Diagnostic(error[1] - 1, message=message, severity=1)) for scope in tmp_list: if not scope.check_valid_parent(): errors.append( Diagnostic( scope.sline - 1, message=f'Invalid parent for "{scope.get_desc()}" declaration', severity=1, ) ) errors += scope.check_use(obj_tree) errors += scope.check_definitions(obj_tree) errors += scope.get_diagnostics() return errors, self.parse_errors fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/base.py000066400000000000000000000054521477231266000253030ustar00rootroot00000000000000from __future__ import annotations from fortls.constants import BASE_TYPE_ID from fortls.helper_functions import fortran_md # Fortran object classes class FortranObj: def __init__(self): self.vis: int = 0 self.def_vis: int = 0 self.doc_str: str = None self.parent = None self.eline: int = -1 self.implicit_vars = None def set_default_vis(self, new_vis: int): self.def_vis = new_vis def set_visibility(self, new_vis: int): self.vis = new_vis def set_parent(self, parent_obj): self.parent = parent_obj def add_doc(self, doc_str: str): self.doc_str = doc_str def update_fqsn(self, enc_scope=None): return None def end(self, line_number: int): self.eline = line_number def resolve_inherit(self, obj_tree, inherit_version): return None def require_inherit(self): return False def resolve_link(self, obj_tree): return None def require_link(self): return False def get_type(self, no_link=False): return BASE_TYPE_ID def get_type_obj(self, obj_tree): return None def get_desc(self): return "unknown" def get_snippet(self, name_replace=None, drop_arg=-1): return None, None def get_documentation(self): return self.doc_str def get_hover(self, long=False, drop_arg=-1) -> tuple[str | None, str | None]: return None, None def get_hover_md(self, long=False, drop_arg=-1) -> str: msg, docs = self.get_hover(long, drop_arg) return fortran_md(msg, docs) def get_signature(self, drop_arg=-1): return None, None, None def get_interface(self, name_replace=None, drop_arg=-1, change_strings=None): return None def get_children(self, public_only=False): return [] def get_ancestors(self): return [] def get_diagnostics(self): return [] def get_implicit(self): if self.parent is None: return self.implicit_vars parent_implicit = self.parent.get_implicit() if (self.implicit_vars is not None) or (parent_implicit is None): return self.implicit_vars return parent_implicit def get_actions(self, sline, eline): return None def is_optional(self): return False def is_mod_scope(self): return False def is_callable(self): return False def is_external_int(self): return False def is_abstract(self): return False def req_named_end(self): return False def check_valid_parent(self): return True def check_definition(self, obj_tree, known_types: dict = None, interface=False): if known_types is None: known_types = {} return None, known_types fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/block.py000066400000000000000000000011401477231266000254510ustar00rootroot00000000000000from __future__ import annotations import copy from typing import TYPE_CHECKING from fortls.constants import BLOCK_TYPE_ID from .scope import Scope if TYPE_CHECKING: from .ast import FortranAST class Block(Scope): def __init__(self, file_ast: FortranAST, line_number: int, name: str): super().__init__(file_ast, line_number, name) def get_type(self, no_link=False): return BLOCK_TYPE_ID def get_desc(self): return "BLOCK" def get_children(self, public_only=False): return copy.copy(self.children) def req_named_end(self): return True fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/diagnostics.py000066400000000000000000000030101477231266000266640ustar00rootroot00000000000000from __future__ import annotations from fortls.json_templates import diagnostic_json, location_json from fortls.jsonrpc import path_to_uri class Diagnostic: def __init__( self, sline: int, message: str, severity: int = 1, find_word: str = None ): self.sline: int = sline self.message: str = message self.severity: int = severity self.find_word: str = find_word self.has_related: bool = False self.related_path = None self.related_line = None self.related_message = None def add_related(self, path: str, line: int, message: str): self.has_related = True self.related_path = path self.related_line = line self.related_message = message def build(self, file_obj): schar = echar = 0 if self.find_word is not None: self.sline, obj_range = file_obj.find_word_in_code_line( self.sline, self.find_word ) if obj_range.start >= 0: schar = obj_range.start echar = obj_range.end diag = diagnostic_json( self.sline, schar, self.sline, echar, self.message, self.severity ) if self.has_related: diag["relatedInformation"] = [ { **location_json( path_to_uri(self.related_path), self.related_line, 0 ), "message": self.related_message, } ] return diag fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/do.py000066400000000000000000000006761477231266000247760ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from fortls.constants import DO_TYPE_ID from .block import Block if TYPE_CHECKING: from .ast import FortranAST class Do(Block): def __init__(self, file_ast: FortranAST, line_number: int, name: str): super().__init__(file_ast, line_number, name) def get_type(self, no_link=False): return DO_TYPE_ID def get_desc(self): return "DO" fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/enum.py000066400000000000000000000007061477231266000253320ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from fortls.constants import ENUM_TYPE_ID from .block import Block if TYPE_CHECKING: from .ast import FortranAST class Enum(Block): def __init__(self, file_ast: FortranAST, line_number: int, name: str): super().__init__(file_ast, line_number, name) def get_type(self, no_link=False): return ENUM_TYPE_ID def get_desc(self): return "ENUM" fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/function.py000066400000000000000000000127341477231266000262170ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from fortls.constants import FUNCTION_TYPE_ID from fortls.helper_functions import get_keywords from .subroutine import Subroutine if TYPE_CHECKING: from .ast import FortranAST from .variable import Variable class Function(Subroutine): def __init__( self, file_ast: FortranAST, line_number: int, name: str, args: str = "", mod_flag: bool = False, keywords: list = None, keyword_info: dict = None, result_type: str = None, result_name: str = None, ): super().__init__(file_ast, line_number, name, args, mod_flag, keywords) self.args: str = args.replace(" ", "").lower() self.args_snip: str = self.args self.arg_objs: list = [] self.in_children: list = [] self.missing_args: list = [] self.mod_scope: bool = mod_flag self.result_name: str = result_name self.result_type: str = result_type self.result_obj: Variable = None self.keyword_info: dict = keyword_info # Set the implicit result() name to be the function name if self.result_name is None: self.result_name = self.name # Used in Associated blocks if self.keyword_info is None: self.keyword_info = {} def copy_interface(self, copy_source: Function): # Call the parent class method child_names = super().copy_interface(copy_source) # Return specific options self.result_name = copy_source.result_name self.result_type = copy_source.result_type self.result_obj = copy_source.result_obj if ( copy_source.result_obj is not None and copy_source.result_obj.name.lower() not in child_names ): self.in_children.append(copy_source.result_obj) def resolve_link(self, obj_tree): self.resolve_arg_link(obj_tree) result_var_lower = self.result_name.lower() for child in self.children: if child.name.lower() == result_var_lower: self.result_obj = child # Update result value and type self.result_name = child.name self.result_type = child.get_desc() def get_type(self, no_link=False): return FUNCTION_TYPE_ID def get_desc(self): token = "FUNCTION" return f"{self.result_type} {token}" if self.result_type else token def is_callable(self): return False def get_hover(self, long: bool = False, drop_arg: int = -1) -> tuple[str, str]: """Construct the hover message for a FUNCTION. Two forms are produced here the `long` i.e. the normal for hover requests [MODIFIERS] FUNCTION NAME([ARGS]) RESULT(RESULT_VAR) TYPE, [ARG_MODIFIERS] :: [ARGS] TYPE, [RESULT_MODIFIERS] :: RESULT_VAR note: intrinsic functions will display slightly different, `RESULT_VAR` and its `TYPE` might not always be present short form, used when functions are arguments in functions and subroutines: FUNCTION NAME([ARGS]) :: ARG_LIST_NAME Parameters ---------- long : bool, optional toggle between long and short hover results, by default False drop_arg : int, optional Ignore argument at position `drop_arg` in the argument list, by default -1 Returns ------- tuple[str, bool] String representative of the hover message and the `long` flag used """ fun_sig, _ = self.get_snippet(drop_arg=drop_arg) # short hover messages do not include the result() fun_sig += f" RESULT({self.result_name})" if long else "" keyword_list = get_keywords(self.keywords) keyword_list.append("FUNCTION") hover_array = [f"{' '.join(keyword_list)} {fun_sig}"] hover_array, docs = self.get_docs_full(hover_array, long, drop_arg) # Only append the return value if using long form if self.result_obj and long: # Parse the documentation from the result variable arg_doc, doc_str = self.result_obj.get_hover() if doc_str is not None: docs.append(f"\n**Return:** \n`{self.result_obj.name}`{doc_str}") hover_array.append(arg_doc) # intrinsic functions, where the return type is missing but can be inferred elif self.result_type and long: # prepend type to function signature hover_array[0] = f"{self.result_type} {hover_array[0]}" return "\n ".join(hover_array), " \n".join(docs) # TODO: fix this def get_interface(self, name_replace=None, drop_arg=-1, change_strings=None): fun_sig, _ = self.get_snippet(name_replace=name_replace) fun_sig += f" RESULT({self.result_name})" # XXX: keyword_list = [] if self.result_type: keyword_list.append(self.result_type) keyword_list += get_keywords(self.keywords) keyword_list.append("FUNCTION ") interface_array = self.get_interface_array( keyword_list, fun_sig, drop_arg, change_strings ) if self.result_obj is not None: arg_doc, docs = self.result_obj.get_hover() interface_array.append(f"{arg_doc} :: {self.result_obj.name}") name = name_replace if name_replace is not None else self.name interface_array.append(f"END FUNCTION {name}") return "\n".join(interface_array) fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/if_block.py000066400000000000000000000006761477231266000261440ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from fortls.constants import IF_TYPE_ID from .block import Block if TYPE_CHECKING: from .ast import FortranAST class If(Block): def __init__(self, file_ast: FortranAST, line_number: int, name: str): super().__init__(file_ast, line_number, name) def get_type(self, no_link=False): return IF_TYPE_ID def get_desc(self): return "IF" fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/imports.py000066400000000000000000000020031477231266000260530ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from .use import Use if TYPE_CHECKING: from .module import Module from .scope import Scope class ImportTypes: DEFAULT = -1 NONE = 0 ALL = 1 ONLY = 2 class Import(Use): """AST node for IMPORT statement""" def __init__( self, name: str, import_type: ImportTypes = ImportTypes.DEFAULT, only_list: set[str] = None, rename_map: dict[str, str] = None, line_number: int = 0, ): if only_list is None: only_list = set() if rename_map is None: rename_map = {} super().__init__(name, only_list, rename_map, line_number) self.import_type = import_type self._scope: Scope | Module | None = None @property def scope(self): """Parent scope of IMPORT statement i.e. parent of the interface""" return self._scope @scope.setter def scope(self, scope: Scope): self._scope = scope fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/include.py000066400000000000000000000002061477231266000260040ustar00rootroot00000000000000from __future__ import annotations from .scope import Scope class Include(Scope): def get_desc(self): return "INCLUDE" fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/interface.py000066400000000000000000000023021477231266000263200ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from fortls.constants import INTERFACE_TYPE_ID from .scope import Scope from .utilities import find_in_scope if TYPE_CHECKING: from .ast import FortranAST class Interface(Scope): def __init__( self, file_ast: FortranAST, line_number: int, name: str, abstract: bool = False, ): super().__init__(file_ast, line_number, name) self.mems = [] self.abstract = abstract self.external = name.startswith("#GEN_INT") and (not abstract) def get_type(self, no_link=False): return INTERFACE_TYPE_ID def get_desc(self): return "INTERFACE" def is_callable(self): return True def is_external_int(self): return self.external def is_abstract(self): return self.abstract def resolve_link(self, obj_tree): if self.parent is None: return self.mems = [] for member in self.members: mem_obj = find_in_scope(self.parent, member, obj_tree) if mem_obj is not None: self.mems.append(mem_obj) def require_link(self): return True fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/intrinsic.modules.json000066400000000000000000002162721477231266000303670ustar00rootroot00000000000000{ "omp_lib": { "type": 0, "name": "omp_lib", "children": [ { "name": "openmp_version", "type": 3, "desc": "INTEGER" }, { "name": "omp_alloctrait", "type": 4 }, { "name": "omp_sched_static", "type": 3, "desc": "INTEGER(KIND=omp_sched_kind)" }, { "name": "omp_sched_dynamic", "type": 3, "desc": "INTEGER(KIND=omp_sched_kind)" }, { "name": "omp_sched_guided", "type": 3, "desc": "INTEGER(KIND=omp_sched_kind)" }, { "name": "omp_sched_auto", "type": 3, "desc": "INTEGER(KIND=omp_sched_kind)" }, { "name": "omp_proc_bind_false", "type": 3, "desc": "INTEGER(KIND=omp_proc_bind_kind)" }, { "name": "omp_proc_bind_true", "type": 3, "desc": "INTEGER(KIND=omp_proc_bind_kind)" }, { "name": "omp_proc_bind_master", "type": 3, "desc": "INTEGER(KIND=omp_proc_bind_kind)" }, { "name": "omp_proc_bind_close", "type": 3, "desc": "INTEGER(KIND=omp_proc_bind_kind)" }, { "name": "omp_proc_bind_spread", "type": 3, "desc": "INTEGER(KIND=omp_proc_bind_kind)" }, { "name": "omp_lock_hint_none", "type": 3, "desc": "INTEGER(KIND=omp_lock_hint_kind)" }, { "name": "omp_lock_hint_uncontended", "type": 3, "desc": "INTEGER(KIND=omp_lock_hint_kind)" }, { "name": "omp_lock_hint_contended", "type": 3, "desc": "INTEGER(KIND=omp_lock_hint_kind)" }, { "name": "omp_lock_hint_nonspeculative", "type": 3, "desc": "INTEGER(KIND=omp_lock_hint_kind)" }, { "name": "omp_lock_hint_speculative", "type": 3, "desc": "INTEGER(KIND=omp_lock_hint_kind)" }, { "name": "omp_sync_hint_none", "type": 3, "desc": "INTEGER(KIND=omp_lock_hint_kind)" }, { "name": "omp_sync_hint_uncontended", "type": 3, "desc": "INTEGER(KIND=omp_lock_hint_kind)" }, { "name": "omp_sync_hint_contended", "type": 3, "desc": "INTEGER(KIND=omp_lock_hint_kind)" }, { "name": "omp_sync_hint_nonspeculative", "type": 3, "desc": "INTEGER(KIND=omp_lock_hint_kind)" }, { "name": "omp_sync_hint_speculative", "type": 3, "desc": "INTEGER(KIND=omp_lock_hint_kind)" }, { "name": "omp_pause_soft", "type": 3, "desc": "INTEGER(KIND=omp_pause_resource_kind)" }, { "name": "omp_pause_hard", "type": 3, "desc": "INTEGER(KIND=omp_pause_resource_kind)" }, { "name": "omp_atk_sync_hint", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_key_kind)" }, { "name": "omp_atk_alignment", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_key_kind)" }, { "name": "omp_atk_access", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_key_kind)" }, { "name": "omp_atk_pool_size", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_key_kind)" }, { "name": "omp_atk_fallback", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_key_kind)" }, { "name": "omp_atk_fb_data", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_key_kind)" }, { "name": "omp_atk_pinned", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_key_kind)" }, { "name": "omp_atk_partition", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_key_kind)" }, { "name": "omp_atv_default", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_false", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_true", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_contended", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_uncontended", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_serialized", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_sequential", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_private", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_all", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_thread", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_pteam", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_cgroup", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_default_mem_fb", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_null_fb", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_abort_fb", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_allocator_fb", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_environment", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_nearest", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_atv_blocked", "type": 3, "desc": "INTEGER(KIND=omp_alloctrait_val_kind)" }, { "name": "omp_null_allocator", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)" }, { "name": "omp_default_mem_alloc", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)" }, { "name": "omp_large_cap_mem_alloc", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)" }, { "name": "omp_const_mem_alloc", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)" }, { "name": "omp_high_bw_mem_alloc", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)" }, { "name": "omp_low_lat_mem_alloc", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)" }, { "name": "omp_cgroup_mem_alloc", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)" }, { "name": "omp_pteam_mem_alloc", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)" }, { "name": "omp_thread_mem_alloc", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)" }, { "name": "omp_default_mem_space", "type": 3, "desc": "INTEGER(KIND=omp_memspace_handle_kind)" }, { "name": "omp_large_cap_mem_space", "type": 3, "desc": "INTEGER(KIND=omp_memspace_handle_kind)" }, { "name": "omp_const_mem_space", "type": 3, "desc": "INTEGER(KIND=omp_memspace_handle_kind)" }, { "name": "omp_high_bw_mem_space", "type": 3, "desc": "INTEGER(KIND=omp_memspace_handle_kind)" }, { "name": "omp_low_lat_mem_space", "type": 3, "desc": "INTEGER(KIND=omp_memspace_handle_kind)" }, { "name": "omp_get_supported_active_levels", "type": 2, "return": "INTEGER" }, { "name": "omp_get_num_threads", "type": 2, "return": "INTEGER" }, { "name": "omp_get_max_threads", "type": 2, "return": "INTEGER" }, { "name": "omp_get_thread_num", "type": 2, "return": "INTEGER" }, { "name": "omp_get_num_procs", "type": 2, "return": "INTEGER" }, { "name": "omp_get_thread_limit", "type": 2, "return": "INTEGER" }, { "name": "omp_get_max_active_levels", "type": 2, "return": "INTEGER" }, { "name": "omp_get_level", "type": 2, "return": "INTEGER" }, { "name": "omp_get_ancestor_thread_num", "type": 2, "return": "INTEGER", "args": "level", "children": [ { "name": "level", "type": 3, "desc": "INTEGER" } ] }, { "name": "omp_get_team_size", "type": 2, "return": "INTEGER", "args": "level", "children": [ { "name": "level", "type": 3, "desc": "INTEGER" } ] }, { "name": "omp_get_active_level", "type": 2, "return": "INTEGER" }, { "name": "omp_get_proc_bind", "type": 2, "return": "INTEGER(KIND=omp_proc_bind_kind)" }, { "name": "omp_get_num_places", "type": 2, "return": "INTEGER(KIND=omp_proc_bind_kind)" }, { "name": "omp_get_place_num_procs", "type": 2, "return": "INTEGER", "args": "place_num", "children": [ { "name": "place_num", "type": 3, "desc": "INTEGER" } ] }, { "name": "omp_get_place_proc_ids", "type": 1, "args": "place_num,ids", "children": [ { "name": "place_num", "type": 3, "desc": "INTEGER" }, { "name": "ids", "type": 3, "desc": "INTEGER", "mods": ["DIMENSION(*)"] } ] }, { "name": "omp_get_partition_place_nums", "type": 1, "args": "place_nums", "children": [ { "name": "place_nums", "type": 3, "desc": "INTEGER", "mods": ["DIMENSION(*)"] } ] }, { "name": "omp_set_affinity_format", "type": 1, "args": "format", "children": [ { "name": "format", "type": 3, "desc": "CHARACTER(LEN=*)", "mods": ["INTENT(in)"] } ] }, { "name": "omp_get_affinity_format", "type": 2, "return": "INTEGER", "args": "buffer", "children": [ { "name": "buffer", "type": 3, "desc": "CHARACTER(LEN=*)", "mods": ["INTENT(out)"] } ] }, { "name": "omp_display_affinity", "type": 1, "args": "format", "children": [ { "name": "format", "type": 3, "desc": "CHARACTER(LEN=*)", "mods": ["INTENT(in)"] } ] }, { "name": "omp_capture_affinity", "type": 1, "args": "buffer,format", "children": [ { "name": "buffer", "type": 3, "desc": "CHARACTER(LEN=*)", "mods": ["INTENT(out)"] }, { "name": "format", "type": 3, "desc": "CHARACTER(LEN=*)", "mods": ["INTENT(in)"] } ] }, { "name": "omp_get_default_device", "type": 2, "return": "INTEGER" }, { "name": "omp_get_num_devices", "type": 2, "return": "INTEGER" }, { "name": "omp_get_device_num", "type": 2, "return": "INTEGER" }, { "name": "omp_get_num_teams", "type": 2, "return": "INTEGER" }, { "name": "omp_get_team_num", "type": 2, "return": "INTEGER" }, { "name": "omp_in_parallel", "type": 2, "return": "LOGICAL" }, { "name": "omp_get_dynamic", "type": 2, "return": "LOGICAL" }, { "name": "omp_get_cancellation", "type": 2, "return": "LOGICAL" }, { "name": "omp_get_nested", "type": 2, "return": "LOGICAL" }, { "name": "omp_in_final", "type": 2, "return": "LOGICAL" }, { "name": "omp_is_initial_device", "type": 2, "return": "LOGICAL" }, { "name": "omp_get_initial_device", "type": 2, "return": "INTEGER" }, { "name": "omp_get_max_task_priority", "type": 2, "return": "INTEGER" }, { "name": "omp_pause_resource", "type": 2, "return": "INTEGER", "args": "kind,device_num", "children": [ { "name": "kind", "type": 3, "desc": "INTEGER(KIND=omp_pause_resource_kind)" }, { "name": "device_num", "type": 3, "desc": "INTEGER" } ] }, { "name": "omp_pause_resource_all", "type": 2, "return": "INTEGER", "args": "kind", "children": [ { "name": "kind", "type": 3, "desc": "INTEGER(KIND=omp_pause_resource_kind)" } ] }, { "name": "omp_get_wtime", "type": 2, "return": "DOUBLE PRECISION" }, { "name": "omp_get_wtick", "type": 2, "return": "DOUBLE PRECISION" }, { "name": "omp_fulfill_event", "type": 1, "args": "event", "children": [ { "name": "event", "type": 3, "desc": "INTEGER(KIND=omp_event_handle_kind)" } ] }, { "name": "omp_init_allocator", "type": 2, "return": "INTEGER(KIND=omp_allocator_handle_kind)", "args": "memspace,ntraits,traits", "children": [ { "name": "memspace", "type": 3, "desc": "INTEGER(KIND=omp_memspace_handle_kind)", "mods": ["INTENT(in)"] }, { "name": "ntraits", "type": 3, "desc": "INTEGER", "mods": ["INTENT(in)"] }, { "name": "traits", "type": 3, "desc": "TYPE(omp_alloctrait)", "mods": ["DIMENSION(*)", "INTENT(in)"] } ] }, { "name": "omp_destroy_allocator", "type": 1, "args": "allocator", "children": [ { "name": "allocator", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)", "mods": ["INTENT(in)"] } ] }, { "name": "omp_set_default_allocator", "type": 1, "args": "allocator", "children": [ { "name": "allocator", "type": 3, "desc": "INTEGER(KIND=omp_allocator_handle_kind)", "mods": ["INTENT(in)"] } ] }, { "name": "omp_get_default_allocator", "type": 2, "return": "INTEGER(KIND=omp_allocator_handle_kind)" }, { "name": "omp_control_tool", "type": 2, "return": "INTEGER", "args": "command,modifier", "children": [ { "name": "command", "type": 3, "desc": "INTEGER(KIND=omp_control_tool_kind)" }, { "name": "modifier", "type": 3, "desc": "INTEGER" } ] }, { "name": "omp_test_lock", "type": 2, "return": "LOGICAL", "args": "svar", "children": [ { "name": "svar", "type": 3, "desc": "INTEGER(KIND=omp_lock_kind)" } ] }, { "name": "omp_test_nest_lock", "type": 2, "return": "LOGICAL", "args": "nvar", "children": [ { "name": "nvar", "type": 3, "desc": "INTEGER(KIND=omp_nest_lock_kind)" } ] }, { "name": "omp_set_num_threads", "type": 1, "args": "num_threads", "children": [ { "name": "num_threads", "type": 3, "desc": "INTEGER" } ] }, { "name": "omp_set_dynamic", "type": 1, "args": "dynamic_threads", "children": [ { "name": "dynamic_threads", "type": 3, "desc": "LOGICAL" } ] }, { "name": "omp_set_nested", "type": 1, "args": "nested", "children": [ { "name": "nested", "type": 3, "desc": "LOGICAL" } ] }, { "name": "omp_set_schedule", "type": 1, "args": "kind,chunk_size", "children": [ { "name": "kind", "type": 3, "desc": "INTEGER(KIND=omp_sched_kind)" }, { "name": "chunk_size", "type": 3, "desc": "INTEGER" } ] }, { "name": "omp_get_schedule", "type": 1, "args": "kind,chunk_size", "children": [ { "name": "kind", "type": 3, "desc": "INTEGER(KIND=omp_sched_kind)" }, { "name": "chunk_size", "type": 3, "desc": "INTEGER" } ] }, { "name": "omp_set_max_active_levels", "type": 1, "args": "max_levels", "children": [ { "name": "max_levels", "type": 3, "desc": "INTEGER" } ] }, { "name": "omp_set_default_device", "type": 1, "args": "device_num", "children": [ { "name": "device_num", "type": 3, "desc": "INTEGER" } ] }, { "name": "omp_init_lock", "type": 1, "args": "svar", "children": [ { "name": "svar", "type": 3, "desc": "INTEGER(KIND=omp_lock_kind)" } ] }, { "name": "omp_init_nest_lock", "type": 1, "args": "nvar", "children": [ { "name": "nvar", "type": 3, "desc": "INTEGER(KIND=omp_nest_lock_kind)" } ] }, { "name": "omp_init_lock_with_hint", "type": 1, "args": "svar,hint", "children": [ { "name": "svar", "type": 3, "desc": "INTEGER(KIND=omp_lock_kind)" }, { "name": "hint", "type": 3, "desc": "INTEGER(KIND=omp_sync_hint_kind)" } ] }, { "name": "omp_init_nest_lock_with_hint", "type": 1, "args": "nvar,hint", "children": [ { "name": "nvar", "type": 3, "desc": "INTEGER(KIND=omp_nest_lock_kind)" }, { "name": "hint", "type": 3, "desc": "INTEGER(KIND=omp_sync_hint_kind)" } ] }, { "name": "omp_destroy_lock", "type": 1, "args": "svar", "children": [ { "name": "svar", "type": 3, "desc": "INTEGER(KIND=omp_lock_kind)" } ] }, { "name": "omp_destroy_nest_lock", "type": 1, "args": "nvar", "children": [ { "name": "nvar", "type": 3, "desc": "INTEGER(KIND=omp_nest_lock_kind)" } ] }, { "name": "omp_set_lock", "type": 1, "args": "svar", "children": [ { "name": "svar", "type": 3, "desc": "INTEGER(KIND=omp_lock_kind)" } ] }, { "name": "omp_set_nest_lock", "type": 1, "args": "nvar", "children": [ { "name": "nvar", "type": 3, "desc": "INTEGER(KIND=omp_nest_lock_kind)" } ] }, { "name": "omp_unset_lock", "type": 1, "args": "svar", "children": [ { "name": "svar", "type": 3, "desc": "INTEGER(KIND=omp_lock_kind)" } ] }, { "name": "omp_unset_nest_lock", "type": 1, "args": "nvar", "children": [ { "name": "nvar", "type": 3, "desc": "INTEGER(KIND=omp_nest_lock_kind)" } ] } ] }, "omp_lib_kinds": { "type": 0, "name": "omp_lib_kinds", "children": [ { "name": "omp_allocator_handle_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_alloctrait_key_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_alloctrait_val_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_depend_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_lock_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_lock_hint_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_nest_lock_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_pause_resource_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_memspace_handle_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_proc_bind_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_sched_kind", "type": 3, "desc": "INTEGER" }, { "name": "omp_sync_hint_kind", "type": 3, "desc": "INTEGER" } ] }, "openacc": { "type": 0, "name": "openacc", "children": [ { "name": "openacc_version", "type": 3, "desc": "INTEGER" }, { "name": "acc_device_property_kind", "type": 3, "desc": "INTEGER" }, { "name": "acc_get_num_devices", "type": 2, "return": "INTEGER", "args": "dev_type", "children": [ { "name": "dev_type", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" } ] }, { "name": "acc_set_device_type", "type": 1, "args": "dev_type", "children": [ { "name": "dev_type", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" } ] }, { "name": "acc_get_device_type", "type": 2, "return": "INTEGER(KIND=acc_device_kind)" }, { "name": "acc_set_device_num", "type": 1, "args": "dev_num,dev_type", "children": [ { "name": "dev_num", "type": 3, "desc": "INTEGER" }, { "name": "dev_type", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" } ] }, { "name": "acc_get_device_num", "type": 2, "return": "INTEGER", "args": "dev_type", "children": [ { "name": "dev_type", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" } ] }, { "name": "acc_get_property", "type": 2, "return": "INTEGER(KIND=c_size_t)", "args": "dev_num,dev_type,property", "children": [ { "name": "dev_num", "type": 3, "desc": "INTEGER", "mods": ["VALUE"] }, { "name": "dev_type", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)", "mods": ["VALUE"] }, { "name": "property", "type": 3, "desc": "INTEGER(KIND=acc_device_property_kind)", "mods": ["VALUE"] } ] }, { "name": "acc_get_property_string", "type": 1, "args": "dev_num,dev_type,property,string", "children": [ { "name": "dev_num", "type": 3, "desc": "INTEGER", "mods": ["VALUE"] }, { "name": "dev_type", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)", "mods": ["VALUE"] }, { "name": "property", "type": 3, "desc": "INTEGER(KIND=acc_device_property_kind)", "mods": ["VALUE"] }, { "name": "string", "type": 3, "desc": "CHARACTER(LEN=*)" } ] }, { "name": "acc_init", "type": 1, "args": "dev_type", "children": [ { "name": "dev_type", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)", "mods": ["VALUE"] } ] }, { "name": "acc_shutdown", "type": 1, "args": "dev_type", "children": [ { "name": "dev_type", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" } ] }, { "name": "acc_async_test", "type": 2, "return": "LOGICAL", "args": "wait_arg", "children": [ { "name": "wait_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_async_test_device", "type": 2, "return": "LOGICAL", "args": "wait_arg,dev_num", "children": [ { "name": "wait_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" }, { "name": "dev_num", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_async_test_all", "type": 2, "return": "LOGICAL" }, { "name": "acc_async_test_all_device", "type": 2, "return": "LOGICAL", "args": "dev_num", "children": [ { "name": "dev_num", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_wait", "type": 1, "args": "wait_arg", "children": [ { "name": "wait_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_wait", "type": 1, "args": "wait_arg,dev_num", "children": [ { "name": "wait_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" }, { "name": "dev_num", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_wait_async", "type": 1, "args": "wait_arg,async_arg", "children": [ { "name": "wait_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_wait_device_async", "type": 1, "args": "wait_arg,async_arg,dev_num", "children": [ { "name": "wait_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" }, { "name": "dev_num", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_wait_all", "type": 1 }, { "name": "acc_wait_all_device", "type": 1, "args": "dev_num", "children": [ { "name": "dev_num", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_wait_all_async", "type": 1, "args": "async_arg", "children": [ { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_wait_all_device_async", "type": 1, "args": "async_arg,dev_num", "children": [ { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" }, { "name": "dev_num", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_get_default_async", "type": 2, "return": "INTEGER(KIND=acc_device_kind)" }, { "name": "acc_set_default_async", "type": 1, "args": "async_arg", "children": [ { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" } ] }, { "name": "acc_on_device", "type": 2, "return": "LOGICAL", "args": "dev_type", "children": [ { "name": "dev_type", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" } ] }, { "name": "acc_copyin", "type": 1, "args": "data_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] } ] }, { "name": "acc_copyin", "type": 1, "args": "data_arg,bytes", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_copyin_async", "type": 1, "args": "data_arg,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_copyin_async", "type": 1, "args": "data_arg,bytes,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_create", "type": 1, "args": "data_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] } ] }, { "name": "acc_create", "type": 1, "args": "data_arg,bytes", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_create_async", "type": 1, "args": "data_arg,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_create_async", "type": 1, "args": "data_arg,bytes,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_copyout", "type": 1, "args": "data_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] } ] }, { "name": "acc_copyout", "type": 1, "args": "data_arg,bytes", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_copyout_async", "type": 1, "args": "data_arg,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_copyout_async", "type": 1, "args": "data_arg,bytes,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_copyout_finalize", "type": 1, "args": "data_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] } ] }, { "name": "acc_copyout_finalize", "type": 1, "args": "data_arg,bytes", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_copyout_finalize_async", "type": 1, "args": "data_arg,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_copyout_finalize_async", "type": 1, "args": "data_arg,bytes,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_delete", "type": 1, "args": "data_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] } ] }, { "name": "acc_delete", "type": 1, "args": "data_arg,bytes", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_delete_async", "type": 1, "args": "data_arg,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_delete_async", "type": 1, "args": "data_arg,bytes,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_delete_finalize", "type": 1, "args": "data_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] } ] }, { "name": "acc_delete_finalize", "type": 1, "args": "data_arg,bytes", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_delete_finalize_async", "type": 1, "args": "data_arg,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_delete_finalize_async", "type": 1, "args": "data_arg,bytes,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_update_device", "type": 1, "args": "data_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] } ] }, { "name": "acc_update_device", "type": 1, "args": "data_arg,bytes", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_update_device_async", "type": 1, "args": "data_arg,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_update_device_async", "type": 1, "args": "data_arg,bytes,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_update_self", "type": 1, "args": "data_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] } ] }, { "name": "acc_update_self", "type": 1, "args": "data_arg,bytes", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_update_self_async", "type": 1, "args": "data_arg,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_update_self_async", "type": 1, "args": "data_arg,bytes,async_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" }, { "name": "async_arg", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, { "name": "acc_is_present", "type": 2, "return": "LOGICAL", "args": "data_arg", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] } ] }, { "name": "acc_is_present", "type": 2, "return": "LOGICAL", "args": "data_arg,bytes", "children": [ { "name": "data_arg", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" } ] }, { "name": "acc_memcpy_d2d", "type": 1, "args": "data_arg_dest,data_arg_src,bytes,dev_num_dest,dev_num_src", "children": [ { "name": "data_arg_dest", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "data_arg_src", "type": 3, "desc": "TYPE(*)", "mods": ["DIMENSION(*)"] }, { "name": "bytes", "type": 3, "desc": "INTEGER" }, { "name": "dev_num_dest", "type": 3, "desc": "INTEGER" }, { "name": "dev_num_src", "type": 3, "desc": "INTEGER" } ] } ] }, "openacc_kinds": { "type": 0, "name": "openacc_kinds", "children": [ { "name": "acc_device_kind", "type": 3, "desc": "INTEGER" }, { "name": "acc_device_none", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" }, { "name": "acc_device_default", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" }, { "name": "acc_device_host", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" }, { "name": "acc_device_not_host", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" }, { "name": "acc_device_nvidia", "type": 3, "desc": "INTEGER(KIND=acc_device_kind)" }, { "name": "acc_handle_kind", "type": 3, "desc": "INTEGER" }, { "name": "acc_async_noval", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" }, { "name": "acc_async_sync", "type": 3, "desc": "INTEGER(KIND=acc_handle_kind)" } ] }, "iso_fortran_env": { "type": 0, "name": "iso_fortran_env", "children": [ { "name": "atomic_int_kind", "type": 3, "desc": "INTEGER" }, { "name": "atomic_logical_kind", "type": 3, "desc": "INTEGER" }, { "name": "character_kinds", "type": 3, "desc": "INTEGER", "mods": ["DIMENSION(:)"] }, { "name": "character_storage_size", "type": 3, "desc": "INTEGER" }, { "name": "error_unit", "type": 3, "desc": "INTEGER" }, { "name": "file_storage_size", "type": 3, "desc": "INTEGER" }, { "name": "input_unit", "type": 3, "desc": "INTEGER" }, { "name": "int8", "type": 3, "desc": "INTEGER" }, { "name": "int16", "type": 3, "desc": "INTEGER" }, { "name": "int32", "type": 3, "desc": "INTEGER" }, { "name": "int64", "type": 3, "desc": "INTEGER" }, { "name": "integer_kinds", "type": 3, "desc": "INTEGER", "mods": ["DIMENSION(:)"] }, { "name": "iostat_end", "type": 3, "desc": "INTEGER" }, { "name": "iostat_eor", "type": 3, "desc": "INTEGER" }, { "name": "iostat_inquire_internal_unit", "type": 3, "desc": "INTEGER" }, { "name": "numeric_storage_size", "type": 3, "desc": "INTEGER" }, { "name": "logical_kinds", "type": 3, "desc": "INTEGER", "mods": ["DIMENSION(:)"] }, { "name": "output_unit", "type": 3, "desc": "INTEGER" }, { "name": "real32", "type": 3, "desc": "INTEGER" }, { "name": "real64", "type": 3, "desc": "INTEGER" }, { "name": "real128", "type": 3, "desc": "INTEGER" }, { "name": "real_kinds", "type": 3, "desc": "INTEGER", "mods": ["DIMENSION(:)"] }, { "name": "stat_locked", "type": 3, "desc": "INTEGER" }, { "name": "stat_locked_other_image", "type": 3, "desc": "INTEGER" }, { "name": "stat_stopped_image", "type": 3, "desc": "INTEGER" }, { "name": "stat_failed_image", "type": 3, "desc": "INTEGER" }, { "name": "stat_unlocked", "type": 3, "desc": "INTEGER" }, { "name": "lock_type", "type": 4 }, { "name": "compiler_options", "type": 2, "return": "CHARACTER(LEN=*)" }, { "name": "compiler_version", "type": 2, "return": "CHARACTER(LEN=*)" } ] }, "iso_c_binding": { "type": 0, "name": "iso_c_binding", "children": [ { "name": "c_int", "type": 3, "desc": "INTEGER" }, { "name": "c_short", "type": 3, "desc": "INTEGER" }, { "name": "c_long", "type": 3, "desc": "INTEGER" }, { "name": "c_long_long", "type": 3, "desc": "INTEGER" }, { "name": "c_signed_char", "type": 3, "desc": "INTEGER" }, { "name": "c_size_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int8_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int16_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int32_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int64_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int128_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int_least8_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int_least16_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int_least32_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int_least64_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int_least128_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int_fast8_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int_fast16_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int_fast32_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int_fast64_t", "type": 3, "desc": "INTEGER" }, { "name": "c_int_fast128_t", "type": 3, "desc": "INTEGER" }, { "name": "c_intmax_t", "type": 3, "desc": "INTEGER" }, { "name": "c_intptr_t", "type": 3, "desc": "INTEGER" }, { "name": "c_ptrdiff_t", "type": 3, "desc": "INTEGER" }, { "name": "c_float", "type": 3, "desc": "INTEGER" }, { "name": "c_double", "type": 3, "desc": "INTEGER" }, { "name": "c_long_double", "type": 3, "desc": "INTEGER" }, { "name": "c_float128", "type": 3, "desc": "INTEGER" }, { "name": "c_float_complex", "type": 3, "desc": "INTEGER" }, { "name": "c_double_complex", "type": 3, "desc": "INTEGER" }, { "name": "c_long_double_complex", "type": 3, "desc": "INTEGER" }, { "name": "c_float128_complex", "type": 3, "desc": "INTEGER" }, { "name": "c_bool", "type": 3, "desc": "INTEGER" }, { "name": "c_char", "type": 3, "desc": "INTEGER" }, { "name": "c_null_char", "type": 3, "desc": "CHARACTER(KIND=c_char)" }, { "name": "c_alert", "type": 3, "desc": "CHARACTER(KIND=c_char)" }, { "name": "c_backspace", "type": 3, "desc": "CHARACTER(KIND=c_char)" }, { "name": "c_form_feed", "type": 3, "desc": "CHARACTER(KIND=c_char)" }, { "name": "c_new_line", "type": 3, "desc": "CHARACTER(KIND=c_char)" }, { "name": "c_carriage_return", "type": 3, "desc": "CHARACTER(KIND=c_char)" }, { "name": "c_horizontal_tab", "type": 3, "desc": "CHARACTER(KIND=c_char)" }, { "name": "c_vertical_tab", "type": 3, "desc": "CHARACTER(KIND=c_char)" }, { "name": "c_null_ptr", "type": 3, "desc": "TYPE(c_ptr)" }, { "name": "c_null_funptr", "type": 3, "desc": "TYPE(c_funptr)" }, { "name": "c_ptr", "type": 4 }, { "name": "c_funptr", "type": 4 }, { "name": "c_associated", "type": 2, "return": "LOGICAL", "args": "c_ptr_1,c_ptr_2", "children": [ { "name": "c_ptr_1", "type": 3, "desc": "TYPE(c_ptr)", "mods": ["INTENT(in)"] }, { "name": "c_ptr_2", "type": 3, "desc": "TYPE(c_ptr)", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "c_f_pointer", "type": 1, "args": "cptr,fptr,shape", "children": [ { "name": "cptr", "type": 3, "desc": "INTENT(in)", "mods": ["INTENT(in)"] }, { "name": "fptr", "type": 3, "desc": "ANY", "mods": ["POINTER", "INTENT(out)"] }, { "name": "shape", "type": 3, "desc": "INTEGER", "mods": ["DIMENSION(:)", "INTENT(in)"] } ] }, { "name": "c_f_procpointer", "type": 1, "args": "cptr,fptr", "children": [ { "name": "cptr", "type": 3, "desc": "TYPE(c_funptr)", "mods": ["INTENT(in)"] }, { "name": "fptr", "type": 3, "desc": "PROCEDURE", "mods": ["POINTER", "INTENT(out)"] } ] }, { "name": "c_funloc", "type": 2, "return": "TYPE(c_funptr)", "args": "x", "children": [ { "name": "x", "type": 3, "desc": "PROCEDURE", "mods": ["INTENT(in)"] } ] }, { "name": "c_loc", "type": 2, "return": "TYPE(c_ptr)", "args": "x", "children": [ { "name": "x", "type": 3, "desc": "ANY", "mods": ["POINTER", "INTENT(in)"] } ] }, { "name": "c_sizeof", "type": 2, "return": "INTEGER(KIND=c_size_t)", "args": "x", "children": [ { "name": "x", "type": 3, "desc": "ANY", "mods": ["INTENT(in)"] } ] } ] }, "ieee_exceptions": { "type": 0, "name": "ieee_exceptions", "children": [ { "name": "ieee_flag_type", "type": 4 }, { "name": "ieee_overflow", "type": 3, "desc": "TYPE(ieee_flag_type)" }, { "name": "ieee_divide_by_zero", "type": 3, "desc": "TYPE(ieee_flag_type)" }, { "name": "ieee_invalid", "type": 3, "desc": "TYPE(ieee_flag_type)" }, { "name": "ieee_underflow", "type": 3, "desc": "TYPE(ieee_flag_type)" }, { "name": "ieee_inexact", "type": 3, "desc": "TYPE(ieee_flag_type)" }, { "name": "ieee_usual", "type": 3, "desc": "TYPE(ieee_flag_type)", "mods": ["DIMENSION(3)"] }, { "name": "ieee_all", "type": 3, "desc": "TYPE(ieee_flag_type)", "mods": ["DIMENSION(5)"] } ] }, "ieee_arithmetic": { "type": 0, "name": "ieee_arithmetic", "use": "ieee_exceptions", "children": [ { "name": "ieee_status_type", "type": 4 }, { "name": "ieee_class_type", "type": 4 }, { "name": "ieee_round_type", "type": 4 }, { "name": "ieee_signaling_nan", "type": 3, "desc": "TYPE(ieee_class_type)" }, { "name": "ieee_quiet_nan", "type": 3, "desc": "TYPE(ieee_class_type)" }, { "name": "ieee_negative_inf", "type": 3, "desc": "TYPE(ieee_class_type)" }, { "name": "ieee_negative_normal", "type": 3, "desc": "TYPE(ieee_class_type)" }, { "name": "ieee_negative_denormal", "type": 3, "desc": "TYPE(ieee_class_type)" }, { "name": "ieee_negative_zero", "type": 3, "desc": "TYPE(ieee_class_type)" }, { "name": "ieee_positive_zero", "type": 3, "desc": "TYPE(ieee_class_type)" }, { "name": "ieee_positive_denormal", "type": 3, "desc": "TYPE(ieee_class_type)" }, { "name": "ieee_positive_normal", "type": 3, "desc": "TYPE(ieee_class_type)" }, { "name": "ieee_positive_inf", "type": 3, "desc": "TYPE(ieee_class_type)" }, { "name": "ieee_nearest", "type": 3, "desc": "TYPE(ieee_round_type)" }, { "name": "ieee_to_zero", "type": 3, "desc": "TYPE(ieee_round_type)" }, { "name": "ieee_up", "type": 3, "desc": "TYPE(ieee_round_type)" }, { "name": "ieee_down", "type": 3, "desc": "TYPE(ieee_round_type)" }, { "name": "ieee_other", "type": 3, "desc": "TYPE(ieee_round_type)" }, { "name": "ieee_class", "type": 2, "return": "TYPE(ieee_class_type)", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_copy_sign", "type": 1, "args": "X,Y", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(inout)"] }, { "name": "Y", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_get_flag", "type": 1, "args": "FLAG,FLAG_VALUE", "children": [ { "name": "FLAG", "type": 3, "desc": "TYPE(ieee_flag_type)", "mods": ["INTENT(in)"] }, { "name": "FLAG_VALUE", "type": 3, "desc": "LOGICAL", "mods": ["INTENT(out)"] } ] }, { "name": "ieee_set_flag", "type": 1, "args": "FLAG,FLAG_VALUE", "children": [ { "name": "FLAG", "type": 3, "desc": "TYPE(ieee_flag_type)", "mods": ["INTENT(in)"] }, { "name": "FLAG_VALUE", "type": 3, "desc": "LOGICAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_get_halting_mode", "type": 1, "args": "FLAG,HALTING", "children": [ { "name": "FLAG", "type": 3, "desc": "TYPE(ieee_flag_type)", "mods": ["INTENT(in)"] }, { "name": "HALTING", "type": 3, "desc": "LOGICAL", "mods": ["INTENT(out)"] } ] }, { "name": "ieee_set_halting_mode", "type": 1, "args": "FLAG,HALTING", "children": [ { "name": "FLAG", "type": 3, "desc": "TYPE(ieee_flag_type)", "mods": ["INTENT(in)"] }, { "name": "HALTING", "type": 3, "desc": "LOGICAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_get_rounding_mode", "type": 1, "args": "ROUND_VALUE", "children": [ { "name": "ROUND_VALUE", "type": 3, "desc": "TYPE(ieee_round_type)", "mods": ["INTENT(out)"] } ] }, { "name": "ieee_set_rounding_mode", "type": 1, "args": "ROUND_VALUE", "children": [ { "name": "ROUND_VALUE", "type": 3, "desc": "TYPE(ieee_round_type)", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_get_status", "type": 1, "args": "STATUS_VALUE", "children": [ { "name": "STATUS_VALUE", "type": 3, "desc": "TYPE(ieee_status_type)", "mods": ["INTENT(out)"] } ] }, { "name": "ieee_set_status", "type": 1, "args": "STATUS_VALUE", "children": [ { "name": "STATUS_VALUE", "type": 3, "desc": "TYPE(ieee_status_type)", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_is_finite", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_is_nan", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_is_negative", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_is_normal", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_logb", "type": 2, "return": "REAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_next_after", "type": 2, "return": "REAL", "args": "X,Y", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] }, { "name": "Y", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_rem", "type": 2, "return": "REAL", "args": "X,Y", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] }, { "name": "Y", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_rint", "type": 2, "return": "REAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_scalb", "type": 2, "return": "REAL", "args": "X,I", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] }, { "name": "I", "type": 3, "desc": "INTEGER", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_selected_real_kind", "type": 2, "return": "INTEGER", "args": "P,R", "children": [ { "name": "P", "type": 3, "desc": "INTEGER", "mods": ["OPTIONAL", "INTENT(in)"] }, { "name": "R", "type": 3, "desc": "INTEGER", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_support_datatype", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_support_denormal", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_support_divide", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_support_flag", "type": 2, "return": "LOGICAL", "args": "FLAG,X", "children": [ { "name": "FLAG", "type": 3, "desc": "TYPE(ieee_flag_type)", "mods": ["INTENT(in)"] }, { "name": "X", "type": 3, "desc": "REAL", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_support_halting", "type": 2, "return": "LOGICAL", "args": "FLAG", "children": [ { "name": "FLAG", "type": 3, "desc": "TYPE(ieee_flag_type)", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_support_inf", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_support_io", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_support_nan", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_support_rounding", "type": 2, "return": "LOGICAL", "args": "ROUND_VALUE,X", "children": [ { "name": "FLAG", "type": 3, "desc": "TYPE(ieee_round_type)", "mods": ["INTENT(in)"] }, { "name": "X", "type": 3, "desc": "REAL", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_support_sqrt", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_support_standard", "type": 2, "return": "LOGICAL", "args": "X", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["OPTIONAL", "INTENT(in)"] } ] }, { "name": "ieee_unordered", "type": 2, "return": "LOGICAL", "args": "X,Y", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] }, { "name": "Y", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] } ] }, { "name": "ieee_value", "type": 2, "return": "REAL", "args": "X,CLASS", "children": [ { "name": "X", "type": 3, "desc": "REAL", "mods": ["INTENT(in)"] }, { "name": "CLASS", "type": 3, "desc": "TYPE(ieee_class_type)", "mods": ["INTENT(in)"] } ] } ] }, "ieee_features": { "type": 0, "name": "ieee_features", "children": [ { "name": "ieee_features_type", "type": 4 }, { "name": "ieee_denormal", "type": 3, "desc": "TYPE(ieee_features_type)" }, { "name": "ieee_divide", "type": 3, "desc": "TYPE(ieee_features_type)" }, { "name": "ieee_halting", "type": 3, "desc": "TYPE(ieee_features_type)" }, { "name": "ieee_inexact_flag", "type": 3, "desc": "TYPE(ieee_features_type)" }, { "name": "ieee_inf", "type": 3, "desc": "TYPE(ieee_features_type)" }, { "name": "ieee_invalid_flag", "type": 3, "desc": "TYPE(ieee_features_type)" }, { "name": "ieee_nan", "type": 3, "desc": "TYPE(ieee_features_type)" }, { "name": "ieee_rounding", "type": 3, "desc": "TYPE(ieee_features_type)" }, { "name": "ieee_sqrt", "type": 3, "desc": "TYPE(ieee_features_type)" }, { "name": "ieee_underflow_flag", "type": 3, "desc": "TYPE(ieee_features_type)" } ] } } fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/intrinsic.procedures.json000066400000000000000000001261741477231266000310730ustar00rootroot00000000000000{ "ABORT": { "doc": "ABORT causes immediate termination of the program.", "type": 2 }, "ABS": { "args": "A", "doc": "ABS(A) computes the absolute value of A.", "type": 3 }, "ACCESS": { "args": "NAME,MODE", "doc": "ACCESS(NAME,MODE) checks whether the file NAME exists, is readable, writable or executable.", "type": 3 }, "ACHAR": { "args": "I,KIND=kind", "doc": "ACHAR(I,KIND=kind) returns the character located at position I in the ASCII collating sequence.", "type": 3 }, "ACOS": { "args": "X", "doc": "ACOS(X) computes the arccosine of X (inverse of COS(X)).", "type": 3 }, "ACOSD": { "args": "X", "doc": "ACOSD(X) computes the arccosine of X in degrees (inverse of COSD(X).", "type": 3 }, "ACOSH": { "args": "X", "doc": "ACOSH(X) computes the inverse hyperbolic cosine of X.", "type": 3 }, "ADJUSTL": { "args": "STRING", "doc": "ADJUSTL(STRING) will left adjust a string by removing leading spaces.", "type": 3 }, "ADJUSTR": { "args": "STRING", "doc": "ADJUSTR(STRING) will right adjust a string by removing trailing spaces.", "type": 3 }, "AIMAG": { "args": "Z", "doc": "AIMAG(Z) yields the imaginary part of complex argument Z.", "type": 3 }, "AINT": { "args": "A,KIND=kind", "doc": "AINT(A,KIND=kind) truncates its argument to a whole number.", "type": 3 }, "ALARM": { "args": "SECONDS,HANDLER,STATUS=status", "doc": "ALARM(SECONDS,HANDLER,STATUS=status) causes external subroutine HANDLER to be executed after a delay of SECONDS by using alarm(2) to set up a signal and signal(2) to catch it. If STATUS is supplied, it will be returned with the number of seconds remaining until any previously scheduled alarm was due to be delivered, or zero if there was no previously scheduled alarm.", "type": 2 }, "ALL": { "args": "MASK,DIM=dim", "doc": "ALL(MASK,DIM=dim) determines if all the values are true in MASK in the array along dimension DIM.", "type": 3 }, "ALLOCATED": { "args": "A", "doc": "ALLOCATED(A) check the allocation status of A.", "type": 3 }, "ANINT": { "args": "A,KIND=kind", "doc": "ANINT(A,KIND=kind) rounds its argument to the nearest whole number.", "type": 3 }, "ANY": { "args": "MASK,DIM=dim", "doc": "ANY(MASK,DIM=dim) determines if any of the values are true in MASK in the array along dimension DIM.", "type": 3 }, "ASIN": { "args": "X", "doc": "ASIN(X) computes the arcsine of X (inverse of SIN(X)).", "type": 3 }, "ASIND": { "args": "X", "doc": "ASIND(X) computes the arcsine of its X in degrees (inverse of SIND(X)).", "type": 3 }, "ASINH": { "args": "X", "doc": "ASINH(X) computes the inverse hyperbolic sine of X.", "type": 3 }, "ASSOCIATED": { "args": "POINTER,TARGET=target", "doc": "ASSOCIATED(POINTER,TARGET=target) determines the status of the pointer POINTER or if POINTER is associated with the target TARGET.", "type": 3 }, "ATAN": { "args": "X", "doc": "ATAN(X) computes the arctangent of X (inverse of TAN(X)).", "type": 3 }, "ATAND": { "args": "X", "doc": "ATAND(X) computes the arctangent of X in degrees (inverse of TAND).", "type": 3 }, "ATAN2": { "args": "Y,X", "doc": "ATAN2(Y,X) computes the principal value of the argument function of the complex number X + i Y.", "type": 3 }, "ATAN2D": { "args": "Y,X", "doc": "ATAN2D(Y,X) computes the principal value of the argument function of the complex number X + i Y in degrees.", "type": 3 }, "ATANH": { "args": "X", "doc": "ATANH(X) computes the inverse hyperbolic tangent of X.", "type": 3 }, "ATOMIC_ADD": { "args": "ATOM,VALUE", "doc": "ATOMIC_ADD(ATOM,VALUE) atomically adds the value of VALUE to the variable ATOM.", "type": 2 }, "ATOMIC_AND": { "args": "ATOM,VALUE", "doc": "ATOMIC_AND(ATOM,VALUE) atomically defines ATOM with the bitwise AND between the values of ATOM and VALUE.", "type": 2 }, "ATOMIC_CAS": { "args": "ATOM,OLD,COMPARE,NEW,STAT=stat", "doc": "ATOMIC_CAS compares the variable ATOM with the value of COMPARE; if the value is the same, ATOM is set to the value of NEW. Additionally, OLD is set to the value of ATOM that was used for the comparison.", "type": 2 }, "ATOMIC_DEFINE": { "args": "ATOM,VALUE,STAT=stat", "doc": "ATOMIC_DEFINE(ATOM,VALUE) defines the variable ATOM with the value VALUE atomically.", "type": 2 }, "ATOMIC_FETCH_ADD": { "args": "ATOM,VALUE,OLD,STAT=stat", "doc": "ATOMIC_FETCH_ADD(ATOM,VALUE,OLD) atomically stores the value of ATOM in OLD and adds the value of VALUE to the variable ATOM.", "type": 2 }, "ATOMIC_FETCH_AND": { "args": "ATOM,VALUE,OLD,STAT=stat", "doc": "ATOMIC_AND(ATOM,VALUE) atomically stores the value of ATOM in OLD and defines ATOM with the bitwise AND between the values of ATOM and VALUE.", "type": 2 }, "ATOMIC_FETCH_OR": { "args": "ATOM,VALUE,OLD,STAT=stat", "doc": "ATOMIC_OR(ATOM,VALUE) atomically stores the value of ATOM in OLD and defines ATOM with the bitwise OR between the values of ATOM and VALUE.", "type": 2 }, "ATOMIC_FETCH_XOR": { "args": "ATOM,VALUE,OLD,STAT=stat", "doc": "ATOMIC_XOR(ATOM,VALUE) atomically stores the value of ATOM in OLD and defines ATOM with the bitwise XOR between the values of ATOM and VALUE.", "type": 2 }, "ATOMIC_OR": { "args": "ATOM,VALUE,STAT=stat", "doc": "ATOMIC_OR(ATOM,VALUE) atomically defines ATOM with the bitwise AND between the values of ATOM and VALUE.", "type": 2 }, "ATOMIC_REF": { "args": "ATOM,VALUE,STAT=stat", "doc": "ATOMIC_DEFINE(ATOM,VALUE) atomically assigns the value of the variable ATOM to VALUE.", "type": 2 }, "ATOMIC_XOR": { "args": "ATOM,VALUE,STAT=stat", "doc": "ATOMIC_AND(ATOM,VALUE) atomically defines ATOM with the bitwise XOR between the values of ATOM and VALUE.", "type": 2 }, "BACKTRACE": { "args": "", "doc": "BACKTRACE shows a backtrace at an arbitrary place in user code. Program execution continues normally afterwards. The backtrace information is printed to the unit corresponding to ERROR_UNIT in ISO_FORTRAN_ENV.", "type": 2 }, "BESSEL_J0": { "args": "X", "doc": "BESSEL_J0(X) computes the Bessel function of the first kind of order 0 of X.", "type": 3 }, "BESSEL_J1": { "args": "X", "doc": "BESSEL_J1(X) computes the Bessel function of the first kind of order 1 of X.", "type": 3 }, "BESSEL_JN": { "args": "N,X", "doc": "BESSEL_JN(N,X) computes the Bessel function of the first kind of order N of X.", "type": 3 }, "BESSEL_Y0": { "args": "X", "doc": "BESSEL_Y0(X) computes the Bessel function of the second kind of order 0 of X.", "type": 3 }, "BESSEL_Y1": { "args": "X", "doc": "BESSEL_Y1(X) computes the Bessel function of the second kind of order 1 of X.", "type": 3 }, "BESSEL_YN": { "args": "N,X", "doc": "BESSEL_YN(N,X) computes the Bessel function of the second kind of order N of X.", "type": 3 }, "BGE": { "args": "I,J", "doc": "BGE(I,J) determines whether an integral is a bitwise greater than or equal to another.", "type": 3 }, "BGT": { "args": "I,J", "doc": "BGT(I,J) determines whether an integral is a bitwise greater than another.", "type": 3 }, "BIT_SIZE": { "args": "I", "doc": "BIT_SIZE(I) returns the number of bits represented by the type of I", "type": 3 }, "BLE": { "args": "I,J", "doc": "BLE(I,J) determines whether an integral is a bitwise less than or equal to another.", "type": 3 }, "BLT": { "args": "I,J", "doc": "BLT(I,J) determines whether an integral is a bitwise less than another.", "type": 3 }, "BTEST": { "args": "I,J", "doc": "BTEST(I,POS) returns logical .TRUE. if the bit at POS in I is set.", "type": 3 }, "CEILING": { "args": "A,KIND=kind", "doc": "CEILING(A,KIND=kind) returns the least integer greater than or equal to A.", "type": 3 }, "CHAR": { "args": "I,KIND=kind", "doc": "CHAR(I,KIND=kind) returns the character represented by the integer I.", "type": 3 }, "CHDIR": { "args": "NAME,STATUS=status", "doc": "CHDIR(NAME,STATUS=status) change current working directory to a specified path.", "type": 2 }, "CHMOD": { "args": "NAME,MODE,STATUS=status", "doc": "CHMOD(NAME,MODE,STATUS=status) changes the permissions of a file.", "type": 2 }, "CMPLX": { "args": "X,Y=y,KIND=kind", "doc": "CMPLX(X,Y=y,KIND=kind) returns a complex number where X is converted to the real component.", "type": 3 }, "CO_BROADCAST": { "args": "A,SOURCE_IMAGE,STAT=stat,ERRMSG=errmsg", "doc": "CO_BROADCAST(A,SOURCE_IMAGE,STAT=stat,ERRMSG=errmsg) copies the value of argument A on the image with image index SOURCE_IMAGE to all images in the current team.", "type": 2 }, "CO_MAX": { "args": "A,RESULT_IMAGE=result_image,STAT=stat,ERRMSG=errmsg", "doc": "CO_MAX(A,RESULT_IMAGE=result_image,STAT=stat,ERRMSG=errmsg) determines element-wise the maximal value of A on all images of the current team.", "type": 2 }, "CO_MIN": { "args": "A,RESULT_IMAGE=result_image,STAT=stat,ERRMSG=errmsg", "doc": "CO_MIN(A,RESULT_IMAGE=result_image,STAT=stat,ERRMSG=errmsg) determines element-wise the minimal value of A on all images of the current team.", "type": 2 }, "CO_REDUCE": { "args": "A,OPERATION,RESULT_IMAGE=result_image,STAT=stat,ERRMSG=errmsg", "doc": "CO_REDUCE(A,OPERATION,RESULT_IMAGE=result_image,STAT=stat,ERRMSG=errmsg) determines element-wise the reduction of the value of A on all images of the current team.", "type": 2 }, "CO_SUM": { "args": "A,RESULT_IMAGE=result_image,STAT=stat,ERRMSG=errmsg", "doc": "CO_SUM(A,RESULT_IMAGE=result_image,STAT=stat,ERRMSG=errmsg) sums up the values of each element of A on all images of the current team.", "type": 2 }, "COMMAND_ARGUMENT_COUNT": { "args": "X", "doc": "COMMAND_ARGUMENT_COUNT() returns the number of arguments passed on the command line when the containing program was invoked.", "type": 3 }, "COMPLEX": { "args": "X,Y", "doc": "COMPLEX(X,Y) returns a complex number where X is converted to the real component and Y is converted to the imaginary component.", "type": 3 }, "CONJG": { "args": "Z", "doc": "CONJG(Z) returns the conjugate of Z.", "type": 3 }, "COS": { "args": "X", "doc": "COS(X) computes the cosine of X.", "type": 3 }, "COSD": { "args": "X", "doc": "COSD(X) computes the cosine of X in degrees.", "type": 3 }, "COSH": { "args": "X", "doc": "COSH(X) computes the hyperbolic cosine of X.", "type": 3 }, "COTAN": { "args": "X", "doc": "COTAN(X) computes the cotangent of X.", "type": 3 }, "COTAND": { "args": "X", "doc": "COTAND(X) computes the cotangent of X in degrees.", "type": 3 }, "COUNT": { "args": "MASK,DIM=dim,KIND=kind", "doc": "COUNT(MASK,DIM=dim,KIND=kind) Count the number of true elements of MASK along dimension DIM.", "type": 3 }, "CPU_TIME": { "args": "TIME", "doc": "CPU_TIME(TIME) returns a REAL value representing the elapsed CPU time in seconds.", "type": 2 }, "CSHIFT": { "args": "ARRAY,SHIFT,DIM=dim", "doc": "CSHIFT(ARRAY,SHIFT,DIM=dim) performs a circular shift on elements of ARRAY along the dimension of DIM.", "type": 3 }, "CTIME": { "args": "TIME", "doc": "CTIME(TIME) converts a system time value, such as returned by TIME8, to a string. The output will be of the form ‘Sat Aug 19 18:13:14 1995’.", "type": 3 }, "DATE_AND_TIME": { "args": "DATE,TIME,ZONE,VALUES", "doc": "DATE_AND_TIME(DATE,TIME,ZONE,VALUES) gets the corresponding date and time information from the real-time system clock.", "type": 2 }, "DBLE": { "args": "A", "doc": "DBLE(A) converts A to double precision real type.", "type": 3 }, "DIGITS": { "args": "X", "doc": "DIGITS(X) returns the number of significant binary digits of the internal model representation of X.", "type": 3 }, "DIM": { "args": "X,Y", "doc": "DIM(X,Y) returns the difference X-Y if the result is positive; otherwise returns zero.", "type": 3 }, "DOT_PRODUCT": { "args": "A,B", "doc": "DOT_PRODUCT(A,B) computes the dot product multiplication of two vectors A and B.", "type": 3 }, "DPROD": { "args": "X,Y", "doc": "DPROD(X,Y) returns the product X*Y.", "type": 3 }, "DSHIFTL": { "args": "I,J,SHIFT", "doc": "DSHIFTL(I,J,SHIFT) combines bits of I and J.", "type": 3 }, "DSHIFTR": { "args": "I,J,SHIFT", "doc": "DSHIFTR(I,J,SHIFT) combines bits of I and J.", "type": 3 }, "EOSHIFT": { "args": "ARRAY,SHIFT,DIM=dim", "doc": "EOSHIFT(ARRAY,SHIFT,BOUNDARY=boundary,DIM=dim) performs a end-off shift on elements of ARRAY along the dimension of DIM.", "type": 3 }, "EPSILON": { "args": "X", "doc": "EPSILON(X) returns the smallest number E of the same kind as X such that 1 + E > 1.", "type": 3 }, "ERF": { "args": "X", "doc": "ERF(X) computes the error function of X.", "type": 3 }, "ERFC": { "args": "X", "doc": "ERFC(X) computes the complementary error function of X.", "type": 3 }, "ERFC_SCALED": { "args": "X", "doc": "ERFC_SCALED(X) computes the exponentially-scaled complementary error function of X.", "type": 3 }, "ETIME": { "args": "VALUES(2),TIME,", "doc": "ETIME(VALUES(2),TIME) returns the number of seconds of runtime since the start of the process’s execution in TIME.", "type": 3 }, "EVENT_QUERY": { "args": "EVENT,COUNT,STAT=stat", "doc": "EVENT_QUERY(EVENT,COUNT,STAT=stat) assigns the number of events to COUNT which have been posted to the EVENT variable and not yet been removed by calling EVENT WAIT.", "type": 2 }, "EXECUTE_COMMAND_LINE": { "args": "COMMAND,WAIT=wait,EXITSTAT=exitstat,CMDSTAT=cmdstat,CMDMSG=cmdmsg", "doc": "EXECUTE_COMMAND_LINE(COMMAND,WAIT=wait,EXITSTAT=exitstat,CMDSTAT=cmdstat,CMDMSG=cmdmsg) runs a shell command, synchronously or asynchronously.", "type": 2 }, "EXIT": { "args": "STATUS=status", "doc": "EXIT(STATUS=status) causes immediate termination of the program with status.", "type": 2 }, "EXP": { "args": "X", "doc": "EXP(X) computes the base e exponential of X.", "type": 3 }, "EXPONENT": { "args": "X", "doc": "EXPONENT(X) returns the value of the exponent part of X.", "type": 3 }, "EXTENDS_TYPE_OF": { "args": "A,MOLD", "doc": "EXTENDS_TYPE_OF(A,MOLD) queries dynamic type for extension.", "type": 3 }, "FDATE": { "args": "DATE", "doc": "FDATE(DATE) returns the current date (using the same format as CTIME) in DATE. It is equivalent to CALL CTIME(DATE, TIME()).", "type": 2 }, "FGET": { "args": "C,STATUS=status", "doc": "FDATE(C,STATUS=status) Read a single character in stream mode from stdin by bypassing normal formatted output.", "type": 2 }, "FGETC": { "args": "UNIT,C,STATUS=status", "doc": "FDATE(UNIT,C,STATUS=status) Read a single character in stream mode by bypassing normal formatted output.", "type": 2 }, "FINDLOC": { "args": "ARRAY,VALUE,DIM=dim,MASK=mask,KIND=kind,BACK=back", "doc": "FINDLOC(ARRAY,VALUE,DIM=dim,MASK=mask,KIND=kind,BACK=back) determines the location of the element in the array with the value given in the VALUE argument.", "type": 3 }, "FLOOR": { "args": "A,KIND=kind", "doc": "FLOOR(A,KIND=kind) returns the greatest integer less than or equal to A.", "type": 3 }, "FLUSH": { "args": "UNIT=unit", "doc": "FLUSH(UNIT=unit) Flushes Fortran unit(s) currently open for output.", "type": 2 }, "FNUM": { "args": "UNIT", "doc": "FNUM(UNIT) returns the POSIX file descriptor number corresponding to the open Fortran I/O unit UNIT.", "type": 3 }, "FPUT": { "args": "C,STATUS=status", "doc": "FPUT(C,STATUS=status) Write a single character in stream mode to stdout by bypassing normal formatted output.", "type": 3 }, "FPUTC": { "args": "C,UNIT=unit,STATUS=status", "doc": "FPUTC(C,UNIT=unit,STATUS=status) Write a single character in stream mode to stdout by bypassing normal formatted output.", "type": 3 }, "FRACTION": { "args": "X", "doc": "FRACTION(X) returns the fractional part of the model representation of X.", "type": 3 }, "FREE": { "args": "PTR", "doc": "FREE(PTR) Frees memory previously allocated by MALLOC.", "type": 2 }, "FSEEK": { "args": "UNIT,OFFSET,WHENCE,STATUS=status", "doc": "FSEEK(UNIT,OFFSET,WHENCE,STATUS=status) Moves UNIT to the specified OFFSET.", "type": 2 }, "FSTAT": { "args": "UNIT,VALUES", "doc": "FSTAT(UNIT,VALUES) FSTAT is identical to STAT, except that information about an already opened file is obtained.", "type": 3 }, "FTELL": { "args": "UNIT", "doc": "FSTAT(UNIT) Retrieves the current position within an open file.", "type": 3 }, "GAMMA": { "args": "X", "doc": "GAMMA(X) computes the gamma function of X.", "type": 3 }, "GERROR": { "args": "RESULT", "doc": "GERROR(RESULT) Returns the system error message corresponding to the last system error.", "type": 2 }, "GETARG": { "args": "POS,VALUE", "doc": "GETARG(POS,VALUE) Retrieve the POS-th argument that was passed on the command line when the containing program was invoked.", "type": 2 }, "GET_COMMAND": { "args": "COMMAND=command,LENGTH=length,STATUS=status", "doc": "GET_COMMAND(COMMAND=command,LENGTH=length,STATUS=status) retrieve the entire command line that was used to invoke the program.", "type": 2 }, "GET_COMMAND_ARGUMENT": { "args": "NUMBER=number,VALUE=value,LENGTH=length,STATUS=status", "doc": "GET_COMMAND_ARGUMENT(NUMBER=number,VALUE=value,LENGTH=length,STATUS=status) retrieve the NUMBER-th argument that was passed on the command line when the containing program was invoked.", "type": 2 }, "GETCWD": { "args": "C,STATUS=status", "doc": "GETCWD(C,STATUS=status) Get current working directory.", "type": 3 }, "GETENV": { "args": "NAME,VALUE", "doc": "GETENV(NAME,VALUE) Get the VALUE of the environmental variable NAME.", "type": 2 }, "GET_ENVIRONMENT_VARIABLE": { "args": "NAME=name,VALUE=value,LENGTH=length,STATUS=status,TRIM_NAME=trim_name", "doc": "GET_ENVIRONMENT_VARIABLE(NAME=name,VALUE=value,LENGTH=length,STATUS=status,TRIM_NAME=trim_name) gets the VALUE of the environmental variable NAME.", "type": 2 }, "GETGID": { "args": "", "doc": "GETGID() Returns the numerical group ID of the current process.", "type": 3 }, "GETLOG": { "args": "C", "doc": "GETLOG(C)Gets the username under which the program is running.", "type": 2 }, "GETPID": { "args": "", "doc": "GETPID() Returns the numerical process identifier of the current process.", "type": 3 }, "GETUID": { "args": "", "doc": "GETUID() Returns the numerical user ID of the current process.", "type": 3 }, "GMTIME": { "args": "TIME,VALUES", "doc": "GMTIME(TIME,VALUES) Given a system time value TIME (as provided by the TIME intrinsic), fills VALUES with values extracted from it appropriate to the UTC time zone, using gmtime(3).", "type": 2 }, "HOSTNM": { "args": "C,STATUS=status", "doc": "HOSTNM(C,STATUS=status) Retrieves the host name of the system on which the program is running.", "type": 3 }, "HUGE": { "args": "X", "doc": "HUGE(X) returns the largest number that is not an infinity in the model of the type of X.", "type": 3 }, "HYPOT": { "args": "X,Y", "doc": "HYPOT(X,Y) is the Euclidean distance function without undue underflow or overflow.", "type": 3 }, "IACHAR": { "args": "I,KIND=kind", "doc": "IACHAR(C,KIND=kind) returns the code for the ASCII character in the first character position of C.", "type": 3 }, "IALL": { "args": "MASK,DIM=dim", "doc": "IALL(MASK,DIM=dim) reduces with bitwise AND the elements of ARRAY along dimension DIM.", "type": 3 }, "IAND": { "args": "I,J", "doc": "IAND(I,J) Bitwise logical AND.", "type": 3 }, "IANY": { "args": "MASK,DIM=dim", "doc": "IANY(MASK,DIM=dim) reduces with bitwise OR the elements of ARRAY along dimension DIM.", "type": 3 }, "IARGC": { "args": "", "doc": "IARGC() returns the number of arguments passed on the command line when the containing program was invoked.", "type": 3 }, "IBCLR": { "args": "I,POS", "doc": "IBCLR(I,POS) returns the value of I with the bit at position POS set to zero.", "type": 3 }, "IBITS": { "args": "I,POS,LEN", "doc": "IBITS(I,POS,LEN) extracts a field of length LEN from I, starting from bit position POS and extending left for LEN bits.", "type": 3 }, "IBSET": { "args": "I,POS", "doc": "IBSET(I,POS) returns the value of I with the bit at position POS set to one.", "type": 3 }, "ICHAR": { "args": "I,KIND=kind", "doc": "ICHAR(C,KIND=kind) returns the code for the character in the first character position of C in the system's native character set.", "type": 3 }, "IDATE": { "args": "VALUES", "doc": "IDATE(VALUES) Fills VALUES with the numerical values at the current local time.", "type": 2 }, "IEOR": { "args": "I,J", "doc": "IEOR(I,J) Bitwise logical exclusive OR.", "type": 3 }, "IEORNO": { "args": "", "doc": "IEORNO() Returns the last system error number, as given by the C errno variable.", "type": 3 }, "IMAGE_INDEX": { "args": "COARRAY,SUB", "doc": "IMAGE_INDEX(COARRAY,SUB) returns the image index belonging to a cosubscript.", "type": 3 }, "INDEX": { "args": "STRING,SUBSTRING,BACK=back,KIND=kind", "doc": "INDEX(STRING,SUBSTRING,BACK=back,KIND=kind) returns the position of the start of the first occurrence of string SUBSTRING as a substring in STRING, counting from one.", "type": 3 }, "INT": { "args": "A,KIND=kind", "doc": "INT(A,KIND=kind) Convert to integer type.", "type": 3 }, "INT2": { "args": "A", "doc": "INT2(A) Convert to a KIND=2 integer type.", "type": 3 }, "INT8": { "args": "A", "doc": "INT8(A) Convert to a KIND=8 integer type.", "type": 3 }, "IOR": { "args": "I,J", "doc": "IOR(I,J) Bitwise logical inclusive OR.", "type": 3 }, "IPARITY": { "args": "ARRAY,DIM=dim,MASK=mask", "doc": "IPARITY(ARRAY,DIM=dim,MASK=mask) reduces with bitwise XOR (exclusive or) the elements of ARRAY along dimension DIM if the corresponding element in MASK is TRUE.", "type": 3 }, "IRAND": { "args": "FLAG", "doc": "IRAND(FLAG) returns a pseudo-random number from a uniform distribution between 0 and a system-dependent limit (which is in most cases 2147483647).", "type": 3 }, "IS_CONTIGUOUS": { "args": "ARRAY", "doc": "IS_CONTIGUOUS(ARRAY) tests whether an array is contiguous.", "type": 3 }, "IS_IOSTAT_END": { "args": "I", "doc": "IS_IOSTAT_END(I) tests whether the variable I has the value of the I/O status 'end of file'", "type": 3 }, "IS_IOSTAT_EOR": { "args": "I", "doc": "IS_IOSTAT_EOR(I) tests whether the variable I has the value of the I/O status 'end of record'", "type": 3 }, "ISATTY": { "args": "UNIT", "doc": "ISATTY(UNIT) Determine whether a unit is connected to a terminal device.", "type": 3 }, "ISHFT": { "args": "I,SHIFT", "doc": "ISHFT(I,SHIFT) returns a value corresponding to I with all of the bits shifted SHIFT places.", "type": 3 }, "ISHFTC": { "args": "I,SHIFT,SIZE=size", "doc": "ISHFTC(I,SHIFT,SIZE=size) returns a value corresponding to I with the rightmost SIZE bits shifted circularly SHIFT places; that is, bits shifted out one end are shifted into the opposite end.", "type": 3 }, "ISNAN": { "args": "X", "doc": "ISNAN(X) tests whether a floating-point value is an IEEE Not-a-Number (NaN).", "type": 3 }, "ITIME": { "args": "VALUES", "doc": "ITIME(VALUES) Fills VALUES with the numerical values at the current local time.", "type": 2 }, "KILL": { "args": "PID,STATUS=status", "doc": "KILL(PID,STATUS=status) Sends the signal specified by SIG to the process PID. See kill(2).", "type": 3 }, "KIND": { "args": "X", "doc": "KIND(X) returns the kind value of the entity X.", "type": 3 }, "LBOUND": { "args": "ARRAY,DIM=dim,KIND=kind", "doc": "LBOUND(ARRAY,DIM=dim,KIND=kind) returns the lower bounds of an array, or a single lower bound along the DIM dimension.", "type": 3 }, "LCOBOUND": { "args": "COARRAY,DIM=dim,KIND=kind", "doc": "LCOBOUND(COARRAY,DIM=dim,KIND=kind) Returns the lower bounds of a coarray, or a single lower cobound along the DIM codimension.", "type": 3 }, "LEADZ": { "args": "I", "doc": "LEADZ(I) returns the number of leading zero bits of an integer.", "type": 3 }, "LEN": { "args": "STRING,KIND=kind", "doc": "LEN(STRING,KIND=kind) returns the length of a character string.", "type": 3 }, "LEN_TRIM": { "args": "STRING,KIND=kind", "doc": "LEN_TRIM(STRING,KIND=kind) returns the length of a character string, ignoring any trailing blanks.", "type": 3 }, "LGE": { "args": "STRING_A,STRING_B", "doc": "LGE(STRING_A,STRING_B) determines whether one string is lexically greater than or equal to another string.", "type": 3 }, "LGT": { "args": "STRING_A,STRING_B", "doc": "LGT(STRING_A,STRING_B) determines whether one string is lexically greater than another string.", "type": 3 }, "LINK": { "args": "PATH1,PATH2", "doc": "LINK(PATH1,PATH2) Makes a (hard) link from file PATH1 to PATH2.", "type": 3 }, "LLE": { "args": "STRING_A,STRING_B", "doc": "LLE(STRING_A,STRING_B) determines whether one string is lexically less than or equal to another string.", "type": 3 }, "LLT": { "args": "STRING_A,STRING_B", "doc": "LLT(STRING_A,STRING_B) determines whether one string is lexically less than another string.", "type": 3 }, "LNBLNK": { "args": "STRING", "doc": "LNBLNK(STRING) Returns the length of a character string, ignoring any trailing blanks.", "type": 3 }, "LOC": { "args": "X", "doc": "LOC(X) returns the address of X as an integer.", "type": 3 }, "LOG": { "args": "X", "doc": "LOG(X) computes the natural logarithm of X, i.e. the logarithm to the base e.", "type": 3 }, "LOG10": { "args": "X", "doc": "LOG10(X) computes the base 10 logarithm of X.", "type": 3 }, "LOG_GAMMA": { "args": "X", "doc": "LOG_GAMMA(X) computes the natural logarithm of the absolute value of the Gamma function.", "type": 3 }, "LOGICAL": { "args": "L,KIND=kind", "doc": "LOGICAL(L,KIND=kind) Converts one kind of LOGICAL variable to another.", "type": 3 }, "LSHIFT": { "args": "I,SHIFT", "doc": "LSHIFT(I,SHIFT) returns a value corresponding to I with all of the bits shifted left by SHIFT places.", "type": 3 }, "LSTAT": { "args": "NAME,VALUES,STATUS=status", "doc": "LSTAT(NAME,VALUES,STATUS=status) is identical to STAT, except that if path is a symbolic link, then the link itself is statted, not the file that it refers to.", "type": 3 }, "LTIME": { "args": "TIME,VALUES", "doc": "LTIME(TIME,VALUES) Given a system time value TIME (as provided by the TIME intrinsic), fills VALUES with values extracted from it appropriate to the local time zone using localtime(3).", "type": 2 }, "MALLOC": { "args": "SIZE", "doc": "MALLOC(SIZE) allocates SIZE bytes of dynamic memory and returns the address of the allocated memory.", "type": 3 }, "MASKL": { "args": "I,KIND=kind", "doc": "MASKL(I,KIND=kind) has its leftmost I bits set to 1, and the remaining bits set to 0.", "type": 3 }, "MASKR": { "args": "I,KIND=kind", "doc": "MASKR(I,KIND=kind) has its rightmost I bits set to 1, and the remaining bits set to 0.", "type": 3 }, "MATMUL": { "args": "MATRIX_A,MATRIX_B", "doc": "MATMUL(MATRIX_A,MATRIX_B) performs a matrix multiplication on numeric or logical arguments.", "type": 3 }, "MAX": { "args": "A1,A2", "doc": "MAX(A1,A2,...) returns the argument with the largest (most positive) value.", "type": 3 }, "MAXEXPONENT": { "args": "X", "doc": "MAXEXPONENT(X) returns the maximum exponent in the model of the type of X.", "type": 3 }, "MAXLOC": { "args": "ARRAY,DIM=dim,MASK=mask,KIND=kind,BACK=back", "doc": "MAXLOC(ARRAY,DIM=dim,MASK=mask,KIND=kind,BACK=back) determines the location of the element in the array with the maximum value.", "type": 3 }, "MAXVAL": { "args": "ARRAY,DIM=dim,MASK=mask,KIND=kind,BACK=back", "doc": "MAXVAL(ARRAY,DIM=dim,MASK=mask) determines the maximum value of the elements in an array.", "type": 3 }, "MCLOCK": { "args": "", "doc": "MCLOCK() Returns the number of clock ticks since the start of the process, based on the function clock(3) in the C standard library.", "type": 3 }, "MCLOCK8": { "args": "", "doc": "MCLOCK8() Returns the number of clock ticks since the start of the process, based on the function clock(3) in the C standard library.", "type": 3 }, "MERGE": { "args": "TSOURCE,FSOURCE,MASK", "doc": "MERGE(TSOURCE,FSOURCE,MASK) select values from two arrays according to a logical mask.", "type": 3 }, "MERGE_BITS": { "args": "I,J,MASK", "doc": "MERGE_BITS(I,J,MASK) merges the bits of I and J as determined by the mask.", "type": 3 }, "MIN": { "args": "A1,A2", "doc": "MIN(A1,A2,...) returns the argument with the smallest (most negative) value.", "type": 3 }, "MINEXPONENT": { "args": "X", "doc": "MINEXPONENT(X) returns the minimum exponent in the model of the type of X.", "type": 3 }, "MINLOC": { "args": "ARRAY,DIM=dim,MASK=mask,KIND=kind,BACK=back", "doc": "MINLOC(ARRAY,DIM=dim,MASK=mask,KIND=kind,BACK=back) determines the location of the element in the array with the minimum value.", "type": 3 }, "MINVAL": { "args": "ARRAY,DIM=dim,MASK=mask,KIND=kind,BACK=back", "doc": "MINVAL(ARRAY,DIM=dim,MASK=mask) determines the minimum value of the elements in an array.", "type": 3 }, "MOD": { "args": "A,P", "doc": "MOD(A,P) computes the remainder of the division of A by P.", "type": 3 }, "MODULO": { "args": "A,P", "doc": "MODULO(A,P) computes the A modulo P.", "type": 3 }, "MOVE_ALLOC": { "args": "FROM,TO", "doc": "MOVE_ALLOC(FROM,TO) moves the allocation from FROM to TO.", "type": 3 }, "MVBITS": { "args": "FROM,TO", "doc": "MVBITS(FROM,FROMPOS,LEN,TO,TOPOS) moves LEN bits from positions FROMPOS through FROMPOS+LEN-1 of FROM to positions TOPOS through TOPOS+LEN-1 of TO.", "type": 3 }, "NEAREST": { "args": "X,S", "doc": "NEAREST(X,S) returns the processor-representable number nearest to X in the direction indicated by the sign of S.", "type": 3 }, "NEW_LINE": { "args": "C", "doc": "NEW_LINE(C) returns the new-line character.", "type": 3 }, "NINT": { "args": "A,KIND=kind", "doc": "NINT(A,KIND=kind) rounds its argument to the nearest whole number.", "type": 3 }, "NORM2": { "args": "ARRAY,DIM=dim", "doc": "NORM2(ARRAY,DIM=dim) Calculates the Euclidean vector norm (L_2 norm) of ARRAY along dimension DIM.", "type": 3 }, "NOT": { "args": "I", "doc": "NOT(I) returns the bitwise Boolean inverse of I.", "type": 3 }, "NULL": { "doc": "NULL() returns a disassociated pointer.", "type": 3 }, "PACK": { "args": "ARRAY,MASK=mask,VECTOR=vector", "doc": "PACK(ARRAY,MASK=mask,VECTOR=vector) stores the elements of ARRAY in an array of rank one.", "type": 3 }, "PARITY": { "args": "MASK,DIM=dim", "doc": "PARITY(MASK,DIM=dim) Calculates the parity, i.e. the reduction using .XOR., of MASK along dimension DIM.", "type": 3 }, "PERROR": { "args": "STRING", "doc": "PERROR(STRING) Prints (on the C stderr stream) a newline-terminated error message corresponding to the last system error. This is prefixed by STRING, a colon and a space.", "type": 2 }, "POPCNT": { "args": "I", "doc": "POPCNT(I) returns the number of bits set (’1’ bits) in the binary representation of I.", "type": 3 }, "POPPAR": { "args": "I", "doc": "POPPAR(I) returns parity of the integer I, i.e. the parity of the number of bits set ('1' bits) in the binary representation of I. It is equal to 0 if I has an even number of bits set, and 1 for an odd number of '1' bits.", "type": 3 }, "PRECISION": { "args": "X", "doc": "PRECISION(X) returns the decimal precision in the model of the type of X.", "type": 3 }, "PRESENT": { "args": "A", "doc": "PRESENT(A) determines whether an optional dummy argument is present.", "type": 3 }, "PRODUCT": { "args": "ARRAY,DIM=dim,MASK=mask", "doc": "PRODUCT(ARRAY,DIM=dim,MASK=mask) multiplies the elements of ARRAY along dimension DIM if the corresponding element in MASK is TRUE.", "type": 3 }, "RADIX": { "args": "X", "doc": "RADIX(X) returns the base of the model representing the entity X.", "type": 3 }, "RAN": { "args": "I", "doc": "RAN(I) For compatibility with HP FORTRAN 77/iX, the RAN intrinsic is provided as an alias for RAND.", "type": 3 }, "RAND": { "args": "I", "doc": "RAND(I) returns a pseudo-random number from a uniform distribution between 0 and 1.", "type": 3 }, "RANDOM_INIT": { "args": "REPEATABLE,IMAGE_DISTINCT", "doc": "RANDOM_INIT(REPEATABLE,IMAGE_DISTINCT) Initializes the state of the pseudorandom number generator used by RANDOM_NUMBER.", "type": 2 }, "RANDOM_NUMBER": { "args": "HARVEST", "doc": "RANDOM_NUMBER(HARVEST) returns a single pseudorandom number or an array of pseudorandom numbers.", "type": 2 }, "RANDOM_SEED": { "args": "SIZE=size,PUT=put,GET=get", "doc": "RANDOM_SEED(SIZE=size,PUT=put,GET=get) restarts or queries the state of the pseudorandom number generator used by RANDOM_NUMBER.", "type": 2 }, "RANGE": { "args": "X", "doc": "RANGE(X) returns the decimal exponent range in the model of the type of X.", "type": 3 }, "RANK": { "args": "A", "doc": "RANK(A) returns the rank of a scalar or array data object.", "type": 3 }, "REAL": { "args": "A,KIND=kind", "doc": "REAL(A,KIND=kind) converts its argument A to a real type.", "type": 3 }, "RENAME": { "args": "PATH1,PATH2", "doc": "RENAME(PATH1,PATH2) Renames a file from file PATH1 to PATH2.", "type": 3 }, "REPEAT": { "args": "STRING,NCOPIES", "doc": "REPEAT(STRING,NCOPIES) concatenates NCOPIES copies of a string.", "type": 3 }, "RESHAPE": { "args": "SOURCE,SHAPE,PAD=pad,ORDER=order", "doc": "RESHAPE(SOURCE,SHAPE,PAD=pad,ORDER=order) reshapes SOURCE to correspond to SHAPE.", "type": 3 }, "RRSPACING": { "args": "X", "doc": "RRSPACING(X) returns the reciprocal of the relative spacing of model numbers near X.", "type": 3 }, "RSHIFT": { "args": "I,SHIFT", "doc": "RSHIFT(I,SHIFT) eturns a value corresponding to I with all of the bits shifted right by SHIFT places.", "type": 3 }, "SAME_TYPE_AS": { "args": "A,B", "doc": "SAME_TYPE_AS(A,B) query dynamic types for equality.", "type": 3 }, "SCALE": { "args": "X,I", "doc": "SCALE(X,I) returns X * RADIX(X)**I.", "type": 3 }, "SCAN": { "args": "STRING,SET,BACK=back,KIND=kind", "doc": "SCAN(STRING,SET,BACK=back,KIND=kind) scans a STRING for any of the characters in a SET of characters.", "type": 3 }, "SECNDS": { "args": "X", "doc": "SECNDS(X) gets the time in seconds from the real-time system clock.", "type": 3 }, "SECOND": { "args": "TIME", "doc": "SECOND(TIME) Returns a REAL(4) value representing the elapsed CPU time in seconds.", "type": 3 }, "SELECTED_CHAR_KIND": { "args": "NAME", "doc": "SELECTED_CHAR_KIND(NAME) returns the kind value for the character set named NAME, if a character set with such a name is supported, or -1 otherwise.", "type": 3 }, "SELECTED_INT_KIND": { "args": "R", "doc": "SELECTED_INT_KIND(R) return the kind value of the smallest integer type that can represent all values ranging from -10^R (exclusive) to 10^R (exclusive).", "type": 3 }, "SELECTED_REAL_KIND": { "args": "P,R", "doc": "SELECTED_REAL_KIND(P,R) returns the kind value of a real data type with decimal precision of at least P digits, exponent range of at least R, and with a radix of RADIX.", "type": 3 }, "SET_EXPONENT": { "args": "X,I", "doc": "SET_EXPONENT(X,I) returns the real number whose fractional part is that that of X and whose exponent part is I.", "type": 3 }, "SHAPE": { "args": "SOURCE,KIND=kind", "doc": "SHAPE(SOURCE,KIND=kind) determines the shape of an array.", "type": 3 }, "SHIFTA": { "args": "I,SHIFT", "doc": "SHIFTA(I,SHIFT) returns a value corresponding to I with all of the bits shifted right by SHIFT places.", "type": 3 }, "SHIFTL": { "args": "I,SHIFT", "doc": "SHIFTL(I,SHIFT) returns a value corresponding to I with all of the bits shifted left by SHIFT places.", "type": 3 }, "SHIFTR": { "args": "I,SHIFT", "doc": "SHIFTR(I,SHIFT) returns a value corresponding to I with all of the bits shifted right by SHIFT places.", "type": 3 }, "SIGN": { "args": "A,B", "doc": "SIGN(A,B) returns the value of A with the sign of B.", "type": 3 }, "SIGNAL": { "args": "NUMBER,HANDLER", "doc": "SIGNAL(NUMBER,HANDLER) causes external subroutine HANDLER to be executed with a single integer argument when signal NUMBER occurs.", "type": 3 }, "SIN": { "args": "X", "doc": "SIN(X) computes the sine of X.", "type": 3 }, "SIND": { "args": "X", "doc": "SIND(X) computes the sine of X in degrees.", "type": 3 }, "SINH": { "args": "X", "doc": "SINH(X) computes the hyperbolic sine of X.", "type": 3 }, "SIZE": { "args": "ARRAY,DIM=dim,KIND=kind", "doc": "SIZE(ARRAY,DIM=dim,KIND=kind) determines the extent of ARRAY along a specified dimension DIM, or the total number of elements in ARRAY if DIM is absent.", "type": 3 }, "SIZEOF": { "args": "X", "doc": "SIZEOF(X) calculates the number of bytes of storage the expression X occupies.", "type": 3 }, "SLEEP": { "args": "SECONDS", "doc": "SLEEP(SECONDS) Calling this subroutine causes the process to pause for SECONDS seconds.", "type": 2 }, "SPACING": { "args": "X", "doc": "SPACING(X) determines the distance between the argument X and the nearest adjacent number of the same type.", "type": 3 }, "SPREAD": { "args": "SOURCE,DIM,NCOPIES", "doc": "SPREAD(SOURCE,DIM,NCOPIES) replicates a SOURCE array NCOPIES times along a specified dimension DIM.", "type": 3 }, "SQRT": { "args": "X", "doc": "SQRT(X) computes the square root of X.", "type": 3 }, "SRAND": { "args": "SEED", "doc": "SRAND(SEED) reinitializes the pseudo-random number generator called by RAND and IRAND.", "type": 2 }, "STAT": { "args": "NAME,VALUES", "doc": "STAT(NAME,VALUES) This function returns information about a file.", "type": 3 }, "STORAGE_SIZE": { "args": "A,KIND=kind", "doc": "STORAGE_SIZE(A,KIND=kind) Returns the storage size of argument A in bits.", "type": 3 }, "SUM": { "args": "ARRAY,DIM=dim,MASK=mask", "doc": "SUM(ARRAY,DIM=dim,MASK=mask) adds the elements of ARRAY along dimension DIM if the corresponding element in MASK is TRUE.", "type": 3 }, "SYMLNK": { "args": "PATH1,PATH2", "doc": "SYMLNK(PATH1,PATH2) Makes a symbolic link from file PATH1 to PATH2.", "type": 3 }, "SYSTEM": { "args": "COMMAND,STATUS=status", "doc": "SYSTEM(COMMAND,STATUS=status) Passes the command COMMAND to a shell (see system(3)).", "type": 3 }, "SYSTEM_CLOCK": { "args": "COUNT=count,COUNT_RATE=count_rate,COUNT_MAX=count_max", "doc": "SYSTEM_CLOCK(COUNT=count,COUNT_RATE=count_rate,COUNT_MAX=count_max) determines the COUNT of a processor clock since an unspecified time in the past modulo COUNT_MAX, COUNT_RATE determines the number of clock ticks per second.", "type": 3 }, "TAN": { "args": "X", "doc": "TAN(X) computes the tangent of X.", "type": 3 }, "TAND": { "args": "X", "doc": "TAND(X) computes the tangent of X in degrees.", "type": 3 }, "TANH": { "args": "X", "doc": "TANH(X) computes the hyperbolic tangent of X.", "type": 3 }, "THIS_IMAGE": { "args": "DISTANCE=distance|COARRAY,DIM=dim", "doc": "THIS_IMAGE(DISTANCE=distance|COARRAY,DIM=dim) Returns the cosubscript for this image.", "type": 3 }, "TIME": { "args": "", "doc": "TIME() Returns the current time encoded as an integer.", "type": 3 }, "TIME8": { "args": "", "doc": "TIME8() Returns the current time encoded as an integer. This value is suitable for passing to CTIME, GMTIME, and LTIME.", "type": 3 }, "TINY": { "args": "X", "doc": "TINY(X) returns the smallest positive (non zero) number in the model of the type of X.", "type": 3 }, "TRAILZ": { "args": "I", "doc": "TRAILZ(I) returns the number of trailing zero bits of an integer.", "type": 3 }, "TRANSFER": { "args": "SOURCE,MOLD,SIZE=size", "doc": "TRANSFER(SOURCE,MOLD,SIZE=size) interprets the bitwise representation of SOURCE in memory as if it is the representation of a variable or array of the same type and type parameters as MOLD.", "type": 3 }, "TRANSPOSE": { "args": "MATRIX", "doc": "TRANSPOSE(MATRIX) transpose an array of rank two.", "type": 3 }, "TRIM": { "args": "STRING", "doc": "TRIM(STRING) removes trailing blank characters of a string.", "type": 3 }, "TTYNAM": { "args": "UNIT", "doc": "TTYNAM(UNIT) Get the name of a terminal device.", "type": 3 }, "UBOUND": { "args": "ARRAY,DIM=dim,KIND=kind", "doc": "UBOUND(ARRAY,DIM=dim,KIND=kind) returns the upper bounds of an array, or a single upper bound along the DIM dimension.", "type": 3 }, "UCOBOUND": { "args": "ARRAY,DIM=dim,KIND=kind", "doc": "UCOBOUND(ARRAY,DIM=dim,KIND=kind) Returns the upper cobounds of a coarray, or a single upper cobound along the DIM codimension.", "type": 3 }, "UMASK": { "args": "MASK", "doc": "UMASK(MASK) Sets the file creation mask to MASK.", "type": 3 }, "UNLINK": { "args": "PATH", "doc": "UNLINK(PATH) Unlinks the file PATH.", "type": 3 }, "UNPACK": { "args": "VECTOR,MASK,FIELD", "doc": "UNPACK(VECTOR,MASK,FIELD) Store the elements of VECTOR in an array of higher rank.", "type": 3 }, "VERIFY": { "args": "STRING,SET,BACK=back,KIND=kind", "doc": "VERIFY(STRING,SET,BACK=back,KIND=kind) verifies that all the characters in STRING belong to the set of characters in SET.", "type": 3 }, "XOR": { "args": "I,J", "doc": "XOR(I,J) Bitwise logical exclusive or.", "type": 3 } } fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/intrinsic.procedures.markdown.json000066400000000000000000025720441477231266000327170ustar00rootroot00000000000000{ "ABS": "## abs\n\n### **Name**\n\n**abs** - \\[NUMERIC\\] Absolute value\n\n### **Synopsis**\n```fortran\n result = abs(a)\n```\n```fortran\n elemental TYPE(kind=KIND) function abs(a)\n\n TYPE(kind=KIND),intent(in) :: a\n```\n### **Characteristics**\n\n- **a** may be any _real_, _integer_, or _complex_ value.\n\n- If **a** is _complex_ the returned value will be a _real_ with the\n same kind as **a**.\n\n Otherwise the returned type and kind is the same as for **a**.\n\n### **Description**\n\n **abs** computes the absolute value of numeric argument **a**.\n\n In mathematics, the absolute value or modulus of a real number **x**,\n denoted **|x|**, is the magnitude of **x** without regard to its sign.\n\n The absolute value of a number may be thought of as its distance from\n zero. So for a complex value the absolute value is a real number\n with magnitude **sqrt(x%re\\*\\*2,x%im\\*\\*2)**, as if the real component\n is the x value and the imaginary value is the y value for the point\n \\.\n\n### **Options**\n\n- **a**\n : The value to compute the absolute value of.\n\n### **Result**\n\n If **a** is of type _integer_ or _real_, the value of the result\n is the absolute value **|a|** and of the same type and kind as the\n input argument.\n\n If **a** is _complex_ with value **(x, y)**, the result is a _real_\n equal to a processor-dependent approximation to\n```fortran\n sqrt(x**2 + y**2)\n```\n computed without undue overflow or underflow (that means the\n computation of the result can overflow the allowed magnitude of the\n real value returned, and that very small values can produce underflows\n if they are squared while calculating the returned value, for example).\n\n That is, if you think of non-complex values as being complex values\n on the x-axis and complex values as being x-y points \n the result of **abs** is the (positive) magnitude of the distance\n of the value from the origin.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_abs\n implicit none\n integer,parameter :: dp=kind(0.0d0)\n\n! some values to use with ABS(3)\n integer :: i = -1\n real :: x = -1.0\n complex :: z = (-3.0,-4.0)\n doubleprecision :: rr = -45.78_dp\n\n! some formats for pretty-printing some information\n character(len=*),parameter :: &\n frmt = '(1x,a15,1x,\" In: \",g0, T51,\" Out: \",g0)', &\n frmtc = '(1x,a15,1x,\" In: (\",g0,\",\",g0,\")\",T51,\" Out: \",g0)', &\n gen = '(*(g0,1x))'\n\n ! the basics\n print gen, 'basic usage:'\n ! any integer, real, or complex type\n write(*, frmt) 'integer ', i, abs(i)\n write(*, frmt) 'real ', x, abs(x)\n write(*, frmt) 'doubleprecision ', rr, abs(rr)\n write(*, frmtc) 'complex ', z, abs(z)\n\n ! elemental\n print gen, 'abs is elemental:', abs([20, 0, -1, -3, 100])\n\n ! the returned value for complex input can be thought of as the\n ! distance from the origin <0,0>\n print gen, 'distance of (', z, ') from zero is', abs( z )\n\n call DUSTY_CORNERS_1(\"beware of abs(-huge(0)-1)\")\n call DUSTY_CORNERS_2(\"beware of losing precision using CMPLX(3)\")\n call DUSTY_CORNERS_3(\"beware of overflow of complex values\")\n call DUSTY_CORNERS_4(\"custom meaning for absolute value of COMPLEX\")\n\ncontains\n\n subroutine DUSTY_CORNERS_1(message)\n character(len=*),intent(in) :: message\n\n ! A dusty corner is that abs(-huge(0)-1) of an integer would be\n ! a representable negative value on most machines but result in a\n ! positive value out of range.\n\n print gen, message\n ! By definition:\n ! You can take the absolute value of any value whose POSITIVE value\n ! is representable with the same type and kind.\n\n print gen, 'abs range test : ', abs(huge(0)), abs(-huge(0))\n print gen, 'abs range test : ', abs(huge(0.0)), abs(-huge(0.0))\n print gen, 'abs range test : ', abs(tiny(0.0)), abs(-tiny(0.0))\n\n end subroutine DUSTY_CORNERS_1\n\n subroutine DUSTY_CORNERS_2(message)\n character(len=*),intent(in) :: message\n\n ! dusty corner: \"kind=dp\" is required or the value returned by\n ! CMPLX() is a default real instead of double precision.\n\n ! Working with complex values you often encounter the CMPLX(3)\n ! function. CMPLX(3) defaults to returning a default REAL regardless\n ! of input type. Not really a direct problem with ABS(2f) per-se,\n ! but a common error when working with doubleprecision complex values\n\n print gen, message\n print gen, 'real result versus doubleprecision result', &\n & abs(cmplx(30.0_dp,40.0_dp)), &\n & abs(cmplx(30.0_dp,40.0_dp,kind=dp))\n\n end subroutine DUSTY_CORNERS_2\n\n subroutine DUSTY_CORNERS_3(message)\n character(len=*),intent(in) :: message\n print gen, message\n\n ! this will probably cause an overflow error, or\n !print gen, abs(cmplx( huge(0.0), huge(0.0) ))\n\n print gen, 'because the biggest default real is',huge(0.0)\n print gen, 'because returning magnitude of sqrt(x%re**2,x%im**2)'\n\n end subroutine DUSTY_CORNERS_3\n\n subroutine DUSTY_CORNERS_4(message)\n character(len=*),intent(in) :: message\n print gen, message\n\n ! if you do not want the distance for a complex value you\n ! might want something like returning a complex value with\n ! both the imaginary and real parts. One way to do that is\n\n print gen, cmplx(abs(z%re),abs(z%im),kind=kind(z))\n\n end subroutine DUSTY_CORNERS_4\n\nend program demo_abs\n```\nResults:\n```text\n > integer In: -1 Out: 1\n > real In: -1.00000000 Out: 1.00000000\n > doubleprecision In: -45.780000000000001 Out: 45.780000000000001\n > complex In: (-3.00000000,-4.00000000) Out: 5.00000000\n > abs is elemental: 20 0 1 3 100\n > distance of ( -3.00000000 -4.00000000 ) from zero is 5.00000000\n > beware of abs(-huge(0)-1)\n > abs range test : 2147483647 2147483647\n > abs range test : 0.340282347E+39 0.340282347E+39\n > abs range test : 0.117549435E-37 0.117549435E-37\n > beware of losing precision using CMPLX(3)\n > real result versus doubleprecision result 50.0000000 50.000000000000000\n > beware of overflow of complex values\n > because the biggest default real is 0.340282347E+39\n > because returning magnitude of sqrt(x%re**2,x%im**2)\n > making your own meaning for ABS(COMPLEX_VALUE)\n > 3.00000000 4.00000000\n```\n### **Standard**\n\n FORTRAN 77\n\n### **See Also**\n\n[**sign**(3)](#sign)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ACHAR": "## achar\n\n### **Name**\n\n**achar** - \\[CHARACTER:CONVERSION\\] Returns a character in a specified\nposition in the ASCII collating sequence\n\n### **Synopsis**\n```fortran\n result = achar(i [,kind])\n```\n```fortran\n elemental character(len=1,kind=KIND) function achar(i,KIND)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- a kind designated as ** may be any supported kind for the type\n\n- The _character_ kind returned is the value of **kind** if present.\n otherwise, a single default _character_ is returned.\n\n### **Description**\n\n **achar** returns the character located at position **i** (commonly\n called the _ADE_ or ASCII Decimal Equivalent) in the ASCII collating\n sequence.\n\n The **achar** function is often used for generating in-band escape\n sequences to control terminal attributes, as it makes it easy to print\n unprintable characters such as escape and tab. For example:\n```fortran\n write(*,'(*(a))')achar(27),'[2J'\n```\n will clear the screen on an ANSI-compatible terminal display,\n\n### **Note**\n\nThe ADEs (ASCII Decimal Equivalents) for ASCII are\n```text\n*-------*-------*-------*-------*-------*-------*-------*-------*\n| 00 nul| 01 soh| 02 stx| 03 etx| 04 eot| 05 enq| 06 ack| 07 bel|\n| 08 bs | 09 ht | 10 nl | 11 vt | 12 np | 13 cr | 14 so | 15 si |\n| 16 dle| 17 dc1| 18 dc2| 19 dc3| 20 dc4| 21 nak| 22 syn| 23 etb|\n| 24 can| 25 em | 26 sub| 27 esc| 28 fs | 29 gs | 30 rs | 31 us |\n| 32 sp | 33 ! | 34 \" | 35 # | 36 $ | 37 % | 38 & | 39 ' |\n| 40 ( | 41 ) | 42 * | 43 + | 44 , | 45 - | 46 . | 47 / |\n| 48 0 | 49 1 | 50 2 | 51 3 | 52 4 | 53 5 | 54 6 | 55 7 |\n| 56 8 | 57 9 | 58 : | 59 ; | 60 < | 61 = | 62 > | 63 ? |\n| 64 @ | 65 A | 66 B | 67 C | 68 D | 69 E | 70 F | 71 G |\n| 72 H | 73 I | 74 J | 75 K | 76 L | 77 M | 78 N | 79 O |\n| 80 P | 81 Q | 82 R | 83 S | 84 T | 85 U | 86 V | 87 W |\n| 88 X | 89 Y | 90 Z | 91 [ | 92 \\ | 93 ] | 94 ^ | 95 _ |\n| 96 ` | 97 a | 98 b | 99 c |100 d |101 e |102 f |103 g |\n|104 h |105 i |106 j |107 k |108 l |109 m |110 n |111 o |\n|112 p |113 q |114 r |115 s |116 t |117 u |118 v |119 w |\n|120 x |121 y |122 z |123 { |124 | |125 } |126 ~ |127 del|\n*-------*-------*-------*-------*-------*-------*-------*-------*\n```\n### **Options**\n\n- **i**\n : the _integer_ value to convert to an ASCII character, in the range\n 0 to 127.\n : **achar** shall have the value C for any character\n C capable of representation as a default character.\n\n- **kind**\n : a _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n Assuming **i** has a value in the range 0 <= I <= 127, the result is the\n character in position **i** of the ASCII collating sequence, provided\n the processor is capable of representing that character in the character\n kind of the result; otherwise, the result is processor dependent.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_achar\nuse,intrinsic::iso_fortran_env,only:int8,int16,int32,int64\nimplicit none\ninteger :: i\n i=65\n write(*,'(\"decimal =\",i0)')i\n write(*,'(\"character =\",a1)')achar(i)\n write(*,'(\"binary =\",b0)')achar(i)\n write(*,'(\"octal =\",o0)')achar(i)\n write(*,'(\"hexadecimal =\",z0)')achar(i)\n\n write(*,'(8(i3,1x,a,1x))')(i,achar(i), i=32,126)\n\n write(*,'(a)')upper('Mixed Case')\ncontains\n! a classic use of achar(3) is to convert the case of a string\n\npure elemental function upper(str) result (string)\n!\n!$@(#) upper(3): function to return a trimmed uppercase-only string\n!\n! input string to convert to all uppercase\ncharacter(*), intent(in) :: str\n! output string that contains no miniscule letters\ncharacter(len(str)) :: string\ninteger :: i, iend\ninteger,parameter :: toupper = iachar('A')-iachar('a')\n iend=len_trim(str)\n ! initialize output string to trimmed input string\n string = str(:iend)\n ! process each letter in the string\n do concurrent (i = 1:iend)\n select case (str(i:i))\n ! located miniscule letter\n case ('a':'z')\n ! change miniscule to majuscule letter\n string(i:i) = achar(iachar(str(i:i))+toupper)\n end select\n enddo\nend function upper\nend program demo_achar\n```\nResults:\n```text\n > decimal =65\n > character =A\n > binary =1000001\n > octal =101\n > hexadecimal =41\n > 32 33 ! 34 \" 35 # 36 $ 37 % 38 & 39 '\n > 40 ( 41 ) 42 * 43 + 44 , 45 - 46 . 47 /\n > 48 0 49 1 50 2 51 3 52 4 53 5 54 6 55 7\n > 56 8 57 9 58 : 59 ; 60 < 61 = 62 > 63 ?\n > 64 @ 65 A 66 B 67 C 68 D 69 E 70 F 71 G\n > 72 H 73 I 74 J 75 K 76 L 77 M 78 N 79 O\n > 80 P 81 Q 82 R 83 S 84 T 85 U 86 V 87 W\n > 88 X 89 Y 90 Z 91 [ 92 \\ 93 ] 94 ^ 95 _\n > 96 ` 97 a 98 b 99 c 100 d 101 e 102 f 103 g\n > 104 h 105 i 106 j 107 k 108 l 109 m 110 n 111 o\n > 112 p 113 q 114 r 115 s 116 t 117 u 118 v 119 w\n > 120 x 121 y 122 z 123 { 124 | 125 } 126 ~\n > MIXED CASE\n```\n### **Standard**\n\nFORTRAN 77. KIND argument added Fortran 2003\n\n### **See Also**\n\n[**char**(3)](#char),\n[**iachar**(3)](#iachar),\n[**ichar**(3)](#ichar)\n\n### **Resources**\n\n- [ANSI escape sequences](https://en.wikipedia.org/wiki/ANSI_escape_code)\n- [M_attr module](https://github.com/urbanjost/M_attr) for controlling ANSI-compatible terminals\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ACOS": "## acos\n\n### **Name**\n\n**acos** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arccosine (inverse cosine) function\n\n### **Synopsis**\n```fortran\n result = acos(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function acos(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_\n - **KIND** may be any kind supported by the associated type.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**acos** computes the arccosine of **x** (inverse of **cos(x)**).\n\n### **Options**\n\n- **x**\n : The value to compute the arctangent of.\n If the type is _real_, the value must satisfy |**x**| <= 1.\n\n### **Result**\n\nThe return value is of the same type and kind as **x**. The _real_ part of\nthe result is in radians and lies in the range **0 \\<= acos(x%re) \\<= PI** .\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_acos\nuse, intrinsic :: iso_fortran_env, only : real32,real64,real128\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))'\nreal(kind=real64) :: x , d2r\n\n ! basics\n x = 0.866_real64\n print all,'acos(',x,') is ', acos(x)\n\n ! acos(-1) should be PI\n print all,'for reference', new_line('a'), &\n &'PI ~= 3.14159265358979323846264338327950288419716939937510'\n write(*,*) acos(-1.0_real64)\n d2r=acos(-1.0_real64)/180.0_real64\n print all,'90 degrees is ', d2r*90.0_real64, ' radians'\n ! elemental\n print all,'elemental',acos([-1.0,-0.5,0.0,0.50,1.0])\n ! complex\n print *,'complex',acos( (-1.0, 0.0) )\n print *,'complex',acos( (-1.0, -1.0) )\n print *,'complex',acos( ( 0.0, -0.0) )\n print *,'complex',acos( ( 1.0, 0.0) )\n\nend program demo_acos\n```\nResults:\n```text\n > acos( 0.86599999999999999 ) is 0.52364958093182890\n > for reference \n > PI ~= 3.14159265358979323846264338327950288419716939937510\n > 3.1415926535897931 \n > 90 degrees is 1.5707963267948966 radians\n > elemental 3.14159274 2.09439516 1.57079637 1.04719758 0.00000000\n > complex (3.14159274,-0.00000000)\n > complex (2.23703575,1.06127501)\n > complex (1.57079637,0.00000000)\n > complex (0.00000000,-0.00000000)\n```\n### **Standard**\n\nFORTRAN 77 ; for a _complex_ argument - Fortran 2008\n\n### **See Also**\nInverse function: [**cos**(3)](cos)\n\n### **Resources**\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ACOSD": "## acosd\n\n### **Name**\n\n**acosd** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arccosine (inverse cosine) function in degrees\n\n### **Synopsis**\n```fortran\n result = acosd(x)\n```\n```fortran\n elemental real(kind=KIND) function acosd(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **KIND** may be any kind supported by the _real_ type.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n **acosd** computes the arccosine of **x** in degrees (inverse\n of **cosd(x)**). For example, **ACOSD(-1.0)** has the value 180.0\n (approximately).\n\n### **Options**\n\n- **x**\n : The value to compute the arctangent of.\n If the type is _real_, the value must satisfy |**x**| <= 1.\n\n### **Result**\n\nThe return value is of the same type and kind as **x**.\nThe result has a value equal to a processor-dependent approximation to\nthe arc cosine of X. It is expressed in degrees and lies in the range\n\n 0 <= ACOSD (X) <= 180\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_acosd\nuse, intrinsic :: iso_fortran_env, only : real32,real64,real128\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))'\nreal(kind=real64) :: x , d2r\n\n ! basics\n print *,'acosd(-1.0) -->',acosd( -1.0 )\n print *,'acosd( 0.0) -->',acosd( -1.0 )\n print *,'acosd( 1.0) -->',acosd( 0.0 )\n x = 0.866_real64\n print all,'acosd(',x,') is ', acosd(x)\n ! any real kind\n write(*,*) acosd(-1.0_real64)\n ! elemental\n print all,'elemental',acosd([-1.0,-0.5,0.0,0.50,1.0])\n !\nend program demo_acosd\n```\nResults:\n```text\n > acosd(-1.0) --> 180.000000\n > acosd( 0.0) --> 180.000000\n > acosd( 1.0) --> 90.0000000\n > acosd( 0.86599999999999999 ) is 30.002910931188026\n > 180.00000000000000\n > elemental 180.000000 120.000000 90.0000000 60.0000000 0.00000000\n```\n### **Standard**\n\nFORTRAN 2023\n\n### **See Also**\nInverse function: [**cosd**(3)](cosd)\n\n### **Resources**\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ACOSH": "## acosh\n\n### **Name**\n\n**acosh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Inverse hyperbolic cosine function\n\n### **Synopsis**\n```fortran\n result = acosh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function acosh(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_\n - **KIND** may be any kind supported by the associated type.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**acosh** computes the inverse hyperbolic cosine of **x** in radians.\n\n### **Options**\n\n- **x**\n : The value to compute the hyperbolic cosine of. A real value should\n be \\>= 1 or the result with be a Nan.\n\n### **Result**\n\nThe result has a value equal to a processor-dependent approximation to\nthe inverse hyperbolic cosine function of X.\n\nIf **x** is _complex_, the imaginary part of the result is in radians\nand lies between\n```fortran\n 0 <= aimag(acosh(x)) <= PI\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_acosh\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=dp), dimension(3) :: x = [ 1.0_dp, 2.0_dp, 3.0_dp ]\n if( any(x.lt.1) )then\n write (*,*) ' warning: values < 1 are present'\n endif\n write (*,*) acosh(x)\nend program demo_acosh\n```\nResults:\n```text\n > 0.0000000000000000 1.3169578969248166 1.7627471740390861\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\nInverse function: [**cosh**(3)](#cosh)\n\n### **Resources**\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ACOSPI": "## acospi\n\n### **Name**\n\n**acospi** - \\[MATHEMATICS:TRIGONOMETRIC\\] Circular Arccosine (inverse\ncircular cosine) function\n\n### **Synopsis**\n```fortran\n result = acospi(x)\n```\n```fortran\n elemental real(kind=KIND) function acospi(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **KIND** may be any _real_ kind\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**acospi** computes the circular arccosine of **x** (inverse of\n**cospi(x)**). The result is expressed in half-revolutions (ie. PI's)\nand lies in the range\n```fortran\n 0 <= ACOSPI (X) <= 1.\n```\n\n### **Options**\n\n- **x**\n : The value to compute the circular arctangent of.\n The value must satisfy |**x**| <= 1.\n\n### **Result**\n\nThe result has a value equal to a processor-dependent approximation to\nthe arc cosine of X.\n\nThe return value is of the same type and kind as **x**.\n\nIt is expressed in half-revolutions and lies in the range 0 <= ACOSPI (X) <= 1.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_acospi\nuse, intrinsic :: iso_fortran_env, only : real32,real64,real128\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))'\nreal(kind=real64) :: x , d2r\nreal(kind=real64),parameter :: &\n& PI = 3.14159265358979323846264338327950288419716939937510_real64\n\n ! basics\n x = PI/4.0_real64\n print all,'acospi(',x,') is ', acospi(x)\n\n ! acospi(-1) should be PI\n write(*,*) acospi(-1.0_real64)\n d2r=acospi(-1.0_real64)/180.0_real64\n print all,'90 degrees is ', d2r*90.0_real64, ' radians'\n ! elemental\n print all,'elemental',acospi([-1.0,-0.5,0.0,0.50,1.0])\n !\n print *,'-1.0',acospi( -1.0 )\n print *,' 0.0',acospi( 0.0 )\n print *,' 1.0',acospi( 1.0 )\n\nend program demo_acospi\n```\nResults:\n```text\n > acospi( 0.78539816339744828 ) is 0.21245823046654463\n > 1.0000000000000000 \n > 90 degrees is 0.50000000000000000 radians\n > elemental 1.00000000 0.666666687 0.500000000 0.333333343 0.00000000\n > -1.0 1.00000000 \n > 0.0 0.500000000 \n > 1.0 0.00000000 \n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n - arc cosine in radians: [**acos**(3)](cos)\n - arc cosine in degrees: [**acosd**(3)](cos)\n - Inverse function: [**cos**(3)](cos)\n\n### **Resources**\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ADJUSTL": "## adjustl\n\n### **Name**\n\n**adjustl** - \\[CHARACTER:WHITESPACE\\] Left-justified a string\n\n### **Synopsis**\n```fortran\n result = adjustl(string)\n```\n```fortran\n elemental character(len=len(string),kind=KIND) function adjustl(string)\n\n character(len=*,kind=KIND),intent(in) :: string\n```\n### **Characteristics**\n - **string** is a _character_ variable of any supported kind\n - The return value is a _character_ variable of the same kind\n and length as **string**\n\n### **Description**\n\n **adjustl** will left-justify a string by removing leading\n spaces. Spaces are inserted at the end of the string as needed.\n\n### **Options**\n\n- **string**\n : the string to left-justify\n\n### **Result**\n\n A copy of **string** where leading spaces are removed and the same\n number of spaces are inserted on the end of **string**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_adjustl\nimplicit none\ncharacter(len=20) :: str = ' sample string'\ncharacter(len=:),allocatable :: astr\ninteger :: length\n\n ! basic use\n write(*,'(a,\"[\",a,\"]\")') 'original: ',str\n str=adjustl(str)\n write(*,'(a,\"[\",a,\"]\")') 'adjusted: ',str\n\n ! a fixed-length string can be printed\n ! trimmed using trim(3) or len_trim(3)\n write(*,'(a,\"[\",a,\"]\")') 'trimmed: ',trim(str)\n length=len_trim(str)\n write(*,'(a,\"[\",a,\"]\")') 'substring:',str(:length)\n\n ! note an allocatable string stays the same length too\n ! and is not trimmed by just an adjustl(3) call.\n astr=' allocatable string '\n write(*,'(a,\"[\",a,\"]\")') 'original:',astr\n astr = adjustl(astr)\n write(*,'(a,\"[\",a,\"]\")') 'adjusted:',astr\n ! trim(3) can be used to change the length\n astr = trim(astr)\n write(*,'(a,\"[\",a,\"]\")') 'trimmed: ',astr\n\nend program demo_adjustl\n```\nResults:\n```text\n > original: [ sample string ]\n > adjusted: [sample string ]\n > trimmed: [sample string]\n > substring:[sample string]\n > original:[ allocatable string ]\n > adjusted:[allocatable string ]\n > trimmed: [allocatable string]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**adjustr**(3)](#adjustr),\n[**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ADJUSTR": "## adjustr\n\n### **Name**\n\n**adjustr** - \\[CHARACTER:WHITESPACE\\] Right-justify a string\n\n### **Synopsis**\n```fortran\n result = adjustr(string)\n```\n```fortran\n elemental character(len=len(string),kind=KIND) function adjustr(string)\n\n character(len=*,kind=KIND),intent(in) :: string\n```\n### **Characteristics**\n\n- **string** is a _character_ variable\n- The return value is a _character_ variable of the same kind and\n length as **string**\n\n### **Description**\n\n**adjustr** right-justifies a string by removing trailing spaces. Spaces\nare inserted at the start of the string as needed to retain the original\nlength.\n\n### **Options**\n\n- **string**\n : the string to right-justify\n\n### **Result**\n\nTrailing spaces are removed and the same number of spaces are inserted\nat the start of **string**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_adjustr\nimplicit none\ncharacter(len=20) :: str\n ! print a short number line\n write(*,'(a)')repeat('1234567890',2)\n\n ! basic usage\n str = ' sample string '\n write(*,'(a)') str\n str = adjustr(str)\n write(*,'(a)') str\n\n !\n ! elemental\n !\n write(*,'(a)')repeat('1234567890',5)\n write(*,'(a)')adjustr([character(len=50) :: &\n ' first ', &\n ' second ', &\n ' third ' ])\n write(*,'(a)')repeat('1234567890',5)\n\nend program demo_adjustr\n```\nResults:\n```text\n > 12345678901234567890\n > sample string\n > sample string\n > 12345678901234567890123456789012345678901234567890\n > first\n > second\n > third\n > 12345678901234567890123456789012345678901234567890\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**adjustl**(3)](#adjustl),\n[**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "AIMAG": "## aimag\n\n### **Name**\n\n**aimag** - \\[TYPE:CONVERSION\\] Imaginary part of complex number\n\n### **Synopsis**\n```fortran\n result = aimag(z)\n```\n```fortran\n elemental function aimag(z)\n\n complex(kind=KIND) aimag\n complex(kind=KIND),intent(in) :: z\n```\n### **Characteristics**\n\n- The type of the argument **z** is _complex_. It may be of any\n supported _complex_ kind\n\n- The return value is of type _real_ with the kind type parameter of\n the argument **z**.\n\n### **Description**\n\n **aimag** yields the imaginary part of the complex argument **z**.\n\n This is similar to the modern complex-part-designator **%IM** which also\n designates the imaginary part of a value, accept a designator is treated\n as a variable. This means it may appear\n on the left-hand side of an assignment as well, as in **val%im=10.0** or\n as an argument in a procedure call that will act as a typical variable\n passed by reference.\n\n### **Options**\n\n- **z**\n : The _complex_ value to extract the imaginary component of.\n\n### **Result**\n\n The return value is a _real_ value with the magnitude and sign of the\n imaginary component of the argument **z**.\n\n That is, If **z** has the value **(x,y)**, the result has the value\n **y**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_aimag\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\ncharacter(len=*),parameter :: it='(*(1x,g0))'\ninteger :: i\ncomplex :: z4\ncomplex :: arr(3)\ncomplex(kind=real64) :: z8\n\n print it, 'basics:'\n\n z4 = cmplx(1.e0, 2.e0)\n print *, 'value=',z4\n print it, 'imaginary part=',aimag(z4),'or', z4%im\n\n print it, 'kinds other than the default may be supported'\n\n z8 = cmplx(3.e0_real64, 4.e0_real64,kind=real64)\n print *, 'value=',z8\n print it, 'imaginary part=',aimag(z8),'or', z8%im\n\n print it, 'an elemental function can be passed an array'\n print it, 'given a complex array:'\n\n arr=[z4,z4/2.0,z4+z4]\n print *, (arr(i),new_line('a'),i=1,size(arr))\n print it, 'the imaginary component is:'\n print it, aimag( arr )\n\nend program demo_aimag\n```\nResults:\n```text\n > basics:\n > value= (1.00000000,2.00000000)\n > imaginary part= 2.00000000 or 2.00000000\n > kinds other than the default may be supported\n > value= (3.0000000000000000,4.0000000000000000)\n > imaginary part= 4.0000000000000000 or 4.0000000000000000\n > an elemental function can be passed an array\n > given a complex array:\n > (1.00000000,2.00000000) \n > (0.500000000,1.00000000) \n > (2.00000000,4.00000000) \n > \n > the imaginary component is:\n > 2.00000000 1.00000000 4.00000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n- [**cmplx**(3)](#cmplx) - Complex conversion function\n- [**conjg**(3)](#conjg) - Complex conjugate function\n- [**real**(3)](#real) - Convert to real type\n\nFortran has strong support for _complex_ values, including many intrinsics\nthat take or produce _complex_ values in addition to algebraic and\nlogical expressions:\n\n[**abs**(3)](#abs),\n[**acosh**(3)](#acosh),\n[**acos**(3)](#acos),\n[**asinh**(3)](#asinh),\n[**asin**(3)](#asin),\n[**atan2**(3)](#atan2),\n[**atanh**(3)](#atanh),\n[**atan**(3)](#atan),\n[**cosh**(3)](#cosh),\n[**cos**(3)](#cos),\n[**co_sum**(3)](#co_sum),\n[**dble**(3)](#dble),\n[**dot_product**(3)](#dot_product),\n[**exp**(3)](#exp),\n[**int**(3)](#int),\n[**is_contiguous**(3)](#is_contiguous),\n[**kind**(3)](#kind),\n[**log**(3)](#log),\n[**matmul**(3)](#matmul),\n[**precision**(3)](#precision),\n[**product**(3)](#product),\n[**range**(3)](#range),\n[**rank**(3)](#rank),\n[**sinh**(3)](#sinh),\n[**sin**(3)](#sin),\n[**sqrt**(3)](#sqrt),\n[**storage_size**(3)](#storage_size),\n[**sum**(3)](#sum),\n[**tanh**(3)](#tanh),\n[**tan**(3)](#tan),\n[**unpack**(3)](#unpack),\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "AINT": "## aint\n\n### **Name**\n\n**aint** - \\[NUMERIC\\] Truncate toward zero to a whole number\n\n### **Synopsis**\n```fortran\n result = aint(x [,kind])\n```\n```fortran\n elemental real(kind=KIND) function iaint(x,KIND)\n\n real(kind=**),intent(in) :: x\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- a kind designated as ** may be any supported kind for the type\n- the result is a real of the default kind unless **kind** is specified.\n- **kind** is an _integer_ initialization expression indicating the\n kind parameter of the result.\n\n### **Description**\n\n **aint** truncates its argument toward zero to a whole number.\n\n### **Options**\n\n- **x**\n : the _real_ value to truncate.\n\n- **kind**\n : indicates the kind parameter of the result.\n\n### **Result**\n\n The sign is the same as the sign of **x** unless the magnitude of **x**\n is less than one, in which case zero is returned.\n\n Otherwise **aint** returns the largest whole number that does not\n exceed the magnitude of **x** with the same sign as the input.\n\n That is, it truncates the value towards zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_aint\nuse, intrinsic :: iso_fortran_env, only : sp=>real32, dp=>real64\nimplicit none\nreal(kind=dp) :: x8\n print *,'basics:'\n print *,' just chops off the fractional part'\n print *, aint(-2.999), aint(-2.1111)\n print *,' if |x| < 1 a positive zero is returned'\n print *, aint(-0.999), aint( 0.9999)\n print *,' input may be of any real kind'\n x8 = 4.3210_dp\n print *, aint(-x8), aint(x8)\n print *,'elemental:'\n print *,aint([ &\n & -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, &\n & 0.0, &\n & +0.5, +1.0, +1.5, +2.0, +2.2, +2.5, +2.7 ])\nend program demo_aint\n```\nResults:\n```text\n > basics:\n > just chops off the fractional part\n > -2.000000 -2.000000\n > if |x| < 1 a positive zero is returned\n > 0.0000000E+00 0.0000000E+00\n > input may be of any real kind\n > -4.00000000000000 4.00000000000000\n > elemental:\n > -2.000000 -2.000000 -2.000000 -2.000000 -1.000000\n > -1.000000 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.000000\n > 1.000000 2.000000 2.000000 2.000000 2.000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**nint**(3)](#nint),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ALL": "## all\n\n### **Name**\n\n**all** - \\[ARRAY:REDUCTION\\] Determines if all the values are true\n\n### **Synopsis**\n```fortran\n result = all(mask [,dim])\n```\n```fortran\n function all(mask ,dim)\n\n logical(kind=KIND),intent(in) :: mask(..)\n integer,intent(in),optional :: dim\n logical(kind=KIND) :: all(..)\n```\n### **Characteristics**\n\n - **mask** is a _logical_ array\n - **dim** is an _integer_\n - the result is a logical array if **dim** is supplied,\n otherwise it is a logical scalar. It has the same characteristics\n as **mask**\n\n### **Description**\n\n **all** determines if all the values are true in **mask** in the\n array along dimension **dim** if **dim** is specified; otherwise all\n elements are tested together.\n\n This testing type is called a logical conjunction of elements of\n **mask** along dimension **dim**.\n\n The mask is generally a _logical_ expression, allowing for comparing\n arrays and many other common operations.\n\n### **Options**\n\n- **mask**\n : the logical array to be tested for all elements being _.true_.\n\n- **dim**\n : **dim** indicates the direction through the elements of **mask**\n to group elements for testing.\n : **dim** has a value that lies between one and the rank of **mask**.\n The corresponding actual argument shall not be an optional dummy\n argument.\n : If **dim** is not present all elements are tested and a single\n scalar value is returned.\n\n### **Result**\n\n1. If **dim** is not present **all(mask)** is _.true._ if all elements\n of **mask** are _.true._. It also is _.true._ if **mask** has zero size;\n otherwise, it is _.false._ .\n\n2. If the rank of **mask** is one, then **all(mask, dim)** is equivalent\n to **all(mask)**.\n\n3. If the rank of **mask** is greater than one and **dim** is present then\n **all(mask,dim)** returns an array with the rank (number of\n dimensions) of **mask** minus 1. The shape is determined from the\n shape of **mask** where the **dim** dimension is elided. A value is\n returned for each set of elements along the **dim** dimension.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_all\nimplicit none\nlogical,parameter :: T=.true., F=.false.\nlogical bool\n\n ! basic usage\n ! is everything true?\n bool = all([ T,T,T ])\n print *, 'are all values true?', bool\n bool = all([ T,F,T ])\n print *, 'are all values true now?', bool\n\n ! compare matrices, even by a dimension\n ARRAYS: block\n integer :: a(2,3), b(2,3)\n ! set everything to one except one value in b\n a = 1\n b = 1\n b(2,2) = 2\n ! now compare those two arrays\n print *,'entire array :', all(a == b )\n print *,'compare columns:', all(a == b, dim=1)\n print *,'compare rows:', all(a == b, dim=2)\n end block ARRAYS\n\nend program demo_all\n```\nResults:\n```text\n > T\n > F\n > entire array : F\n > compare columns: T F T\n > compare rows: T F\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**any**(3)](#any)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ALLOCATED": "## allocated\n\n### **Name**\n\n**allocated** - \\[ARRAY:INQUIRY\\] Allocation status of an allocatable entity\n\n### **Synopsis**\n```fortran\n result = allocated(array|scalar)\n```\n```fortran\n logical function allocated(array,scalar)\n\n type(TYPE(kind=**)),allocatable,optional :: array(..)\n type(TYPE(kind=**)),allocatable,optional :: scalar\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **array** may be any allocatable array object of any type.\n - **scalar** may be any allocatable scalar of any type.\n - the result is a default logical scalar\n\n### **Description**\n\n **allocated** checks the allocation status of both arrays\n and scalars.\n\n At least one and only one of **array** or **scalar** must be specified.\n\n### **Options**\n\n- **entity**\n : the _allocatable_ object to test.\n\n### **Result**\n\n If the argument is allocated then the result is _.true._; otherwise,\n it returns _.false._.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_allocated\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=sp), allocatable :: x(:)\ncharacter(len=256) :: message\ninteger :: istat\n ! basics\n if( allocated(x)) then\n write(*,*)'do things if allocated'\n else\n write(*,*)'do things if not allocated'\n endif\n\n ! if already allocated, deallocate\n if ( allocated(x) ) deallocate(x,STAT=istat, ERRMSG=message )\n if(istat.ne.0)then\n write(*,*)trim(message)\n stop\n endif\n\n ! only if not allocated, allocate\n if ( .not. allocated(x) ) allocate(x(20))\n\n ! allocation and intent(out)\n call intentout(x)\n write(*,*)'note it is deallocated!',allocated(x)\n\n contains\n\n subroutine intentout(arr)\n ! note that if arr has intent(out) and is allocatable,\n ! arr is deallocated on entry\n real(kind=sp),intent(out),allocatable :: arr(:)\n write(*,*)'note it was allocated in calling program',allocated(arr)\n end subroutine intentout\n\nend program demo_allocated\n```\nResults:\n```text\n > do things if not allocated\n > note it was allocated in calling program F\n > note it is deallocated! F\n```\n### **Standard**\n\n Fortran 95. allocatable scalar entities were added in Fortran 2003.\n\n### **See Also**\n\n[**move_alloc**(3)](#move_alloc)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ANINT": "## anint\n\n### **Name**\n\n**anint** - \\[NUMERIC\\] Real nearest whole number\n\n### **Synopsis**\n```fortran\n result = anint(a [,kind])\n```\n```fortran\n elemental real(kind=KIND) function anint(x,KIND)\n\n real(kind=**),intent(in) :: x\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- **a** is type _real_ of any kind\n- **KIND** is a scalar integer constant expression.\n- the result is type _real_. The kind of the result is the same as **x**\n unless specified by **kind**.\n\n### **Description**\n\n **anint** rounds its argument to the nearest whole number.\n\n Unlike **nint**(3) which returns an _integer_ the full range or real\n values can be returned (_integer_ types typically have a smaller range\n of values than _real_ types).\n\n### **Options**\n\n- **a**\n : the value to round\n\n- **kind**\n : specifies the kind of the result. The default is the kind of **a**.\n\n### **Result**\n\nThe return value is the real whole number nearest **a**.\n\nIf **a** is greater than zero, **anint(a)**(3) returns **aint(a + 0.5)**.\n\nIf **a** is less than or equal to zero then it returns **aint(a - 0.5)**,\nexcept **aint** specifies that for |**a**| < 1 the result is zero (0).\n\nIt is processor-dependent whether anint(a) returns negative zero when\n-0.5 < a <= -0.0. Compiler switches are often available which enable\nor disable support of negative zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_anint\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal,allocatable :: arr(:)\n\n ! basics\n print *, 'ANINT (2.783) has the value 3.0 =>', anint(2.783)\n print *, 'ANINT (-2.783) has the value -3.0 =>', anint(-2.783)\n\n print *, 'by default the kind of the output is the kind of the input'\n print *, anint(1234567890.1234567890e0)\n print *, anint(1234567890.1234567890d0)\n\n print *, 'sometimes specifying the result kind is useful when passing'\n print *, 'results as an argument, for example.'\n print *, 'do you know why the results are different?'\n print *, anint(1234567890.1234567890,kind=real64)\n print *, anint(1234567890.1234567890d0,kind=real64)\n\n ! elemental\n print *, 'numbers on a cusp are always the most troublesome'\n print *, anint([ -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, 0.0 ])\n\n print *, 'negative zero is processor dependent'\n arr=[ 0.0, 0.1, 0.5, 1.0, 1.5, 2.0, 2.2, 2.5, 2.7 ]\n print *, anint(arr)\n arr=[ -0.0, -0.1, -0.5, -1.0, -1.5, -2.0, -2.2, -2.5, -2.7 ]\n print *, anint(arr)\n\nend program demo_anint\n```\nResults:\n```text\n > ANINT (2.783) has the value 3.0 => 3.000000\n > ANINT (-2.783) has the value -3.0 => -3.000000\n > by default the kind of the output is the kind of the input\n > 1.2345679E+09\n > 1234567890.00000\n > sometimes specifying the result kind is useful when passing\n > results as an argument, for example.\n > do you know why the results are different?\n > 1234567936.00000\n > 1234567890.00000\n > numbers on a cusp are always the most troublesome\n > -3.000000 -3.000000 -2.000000 -2.000000 -2.000000\n > -1.000000 -1.000000 0.0000000E+00\n > negative zero is processor dependent\n > 0.0000000E+00 0.0000000E+00 1.000000 1.000000 2.000000\n > 2.000000 2.000000 3.000000 3.000000\n > 0.0000000E+00 0.0000000E+00 -1.000000 -1.000000 -2.000000\n > -2.000000 -2.000000 -3.000000 -3.000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**int**(3)](#int),\n[**nint**(3)](#nint),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "ANY": "## any\n\n### **Name**\n\n**any** - \\[ARRAY:REDUCTION\\] Determines if any of the values in the logical array are _.true._\n\n### **Synopsis**\n```fortran\n result = any(mask [,dim])\n```\n```fortran\n function any(mask, dim)\n\n logical(kind=KIND),intent(in) :: mask(..)\n integer,intent(in),optional :: dim\n logical(kind=KIND) :: any(..)\n```\n### **Characteristics**\n\n- **mask** is a _logical_ array\n- **dim** is a scalar integer\n- the result is a logical array if **dim** is supplied,\n otherwise it is a logical scalar.\n\n### **Description**\n\n **any** determines if any of the values in the logical\n array **mask** along dimension **dim** are _.true._.\n\n### **Options**\n\n- **mask**\n : an array of _logical_ expressions or values to be tested in groups\n or in total for a _.true._ value.\n\n- **dim**\n : a whole number value that lies between one and **rank(mask)** that\n indicates to return an array of values along the indicated dimension\n instead of a scalar answer.\n\n### **Result**\n\n**any(mask)** returns a scalar value of type _logical_ where the kind type\nparameter is the same as the kind type parameter of **mask**. If **dim**\nis present, then **any(mask, dim)** returns an array with the rank of\n**mask** minus 1. The shape is determined from the shape of **mask**\nwhere the **dim** dimension is elided.\n\n1. **any(mask)** is _.true._ if any element of **mask** is _.true._;\n otherwise, it is _.false._. It also is _.false._ if **mask** has\n zero size.\n\n2. If the rank of **mask** is one, then **any(mask, dim)** is\n equivalent to **any(mask)**. If the rank is greater than one, then\n **any(mask, dim)** is determined by applying **any(mask)** to the\n array sections.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_any\nimplicit none\nlogical,parameter :: T=.true., F=.false.\ninteger :: a(2,3), b(2,3)\nlogical :: bool\n ! basic usage\n bool = any([F,F,T,F])\n print *,bool\n bool = any([F,F,F,F])\n print *,bool\n ! fill two integer arrays with values for testing\n a = 1\n b = 1\n b(:,2) = 2\n b(:,3) = 3\n ! using any(3) with logical expressions you can compare two arrays\n ! in a myriad of ways\n ! first, print where elements of b are bigger than in a\n call printl( 'first print b > a ', b > a )\n ! now use any() to test\n call printl( 'any true values? any(b > a) ', any(b > a ) )\n call printl( 'again by columns? any(b > a,1)', any(b > a, 1) )\n call printl( 'again by rows? any(b > a,2)', any(b > a, 2) )\ncontains\n! CONVENIENCE ROUTINE. this is not specific to ANY()\nsubroutine printl(title,a)\nuse, intrinsic :: iso_fortran_env, only : &\n & stderr=>ERROR_UNIT,&\n & stdin=>INPUT_UNIT,&\n & stdout=>OUTPUT_UNIT\nimplicit none\n\n!@(#) print small 2d logical scalar, vector, or matrix\n\ncharacter(len=*),parameter :: all='(*(g0,1x))'\ncharacter(len=*),parameter :: row='(\" > [ \",*(l1:,\",\"))'\ncharacter(len=*),intent(in) :: title\nlogical,intent(in) :: a(..)\ninteger :: i\n write(*,*)\n write(*,all,advance='no')trim(title),&\n & ' : shape=',shape(a),',rank=',rank(a),',size=',size(a)\n ! get size and shape of input\n select rank(a)\n rank (0); write(*,'(a)')'(a scalar)'\n write(*,fmt=row,advance='no')a\n write(*,'(\" ]\")')\n rank (1); write(*,'(a)')'(a vector)'\n do i=1,size(a)\n write(*,fmt=row,advance='no')a(i)\n write(*,'(\" ]\")')\n enddo\n rank (2); write(*,'(a)')'(a matrix) '\n do i=1,size(a,dim=1)\n write(*,fmt=row,advance='no')a(i,:)\n write(*,'(\" ]\")')\n enddo\n rank default\n write(stderr,*)'*printl* did not expect rank=', rank(a), &\n & 'shape=', shape(a),'size=',size(a)\n stop '*printl* unexpected rank'\n end select\n\nend subroutine printl\n\nend program demo_any\n```\nResults:\n```text\n > T\n > F\n >\n > first print b > a : shape=23,rank=2,size=6(a matrix)\n > > [ F,T,T ]\n > > [ F,T,T ]\n >\n > any true values? any(b > a) : shape=,rank=0,size=1(a scalar)\n > > [ T ]\n >\n > again by columns? any(b > a,1) : shape=3,rank=1,size=3(a vector)\n > > [ F ]\n > > [ T ]\n > > [ T ]\n >\n > again by rows? any(b > a,2) : shape=2,rank=1,size=2(a vector)\n > > [ T ]\n > > [ T ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**all**(3)](#all)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ASIN": "## asin\n\n### **Name**\n\n**asin** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arcsine function\n\n### **Synopsis**\n```fortran\n result = asin(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function asin(x)\n\n TYPE(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_\n - **KIND** may be any kind supported by the associated type.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**asin** computes the arcsine of its argument **x**.\n\nThe arcsine is the inverse function of the sine function. It is commonly\nused in trigonometry when trying to find the angle when the lengths of\nthe hypotenuse and the opposite side of a right triangle are known.\n\n### **Options**\n\n- **x**\n : The value to compute the arcsine of\n The type shall be either _real_ and a magnitude that is less than or\n equal to one; or be _complex_.\n\n### **Result**\n\n The result has a value equal to a processor-dependent approximation\n to arcsin(x).\n\n If **x** is real the result is _real_ and it is expressed in radians\n and lies in the range\n```fortran\n PI/2 <= ASIN (X) <= PI/2.\n```\n If the argument (and therefore the result) is imaginary the real part\n of the result is in radians and lies in the range\n```fortran\n -PI/2 <= real(asin(x)) <= PI/2\n```\n### **Examples**\n\nThe arcsine will allow you to find the measure of a right angle when you\nknow the ratio of the side opposite the angle to the hypotenuse.\n\nSo if you knew that a train track rose 1.25 vertical miles on a track\nthat was 50 miles long, you could determine the average angle of incline\nof the track using the arcsine. Given\n\n sin(theta) = 1.25 miles/50 miles (opposite/hypotenuse)\n\nSample program:\n```fortran\nprogram demo_asin\nuse, intrinsic :: iso_fortran_env, only : dp=>real64\nimplicit none\n! value to convert degrees to radians\nreal(kind=dp),parameter :: D2R=acos(-1.0_dp)/180.0_dp\nreal(kind=dp) :: angle, rise, run\ncharacter(len=*),parameter :: all='(*(g0,1x))'\n ! given sine(theta) = 1.25 miles/50 miles (opposite/hypotenuse)\n ! then taking the arcsine of both sides of the equality yields\n ! theta = arcsine(1.25 miles/50 miles) ie. arcsine(opposite/hypotenuse)\n rise=1.250_dp\n run=50.00_dp\n angle = asin(rise/run)\n print all, 'angle of incline(radians) = ', angle\n angle = angle/D2R\n print all, 'angle of incline(degrees) = ', angle\n\n print all, 'percent grade=',rise/run*100.0_dp\nend program demo_asin\n```\nResults:\n```\n > angle of incline(radians) = 2.5002604899361139E-002\n > angle of incline(degrees) = 1.4325437375665075\n > percent grade= 2.5000000000000000\n```\nThe percentage grade is the slope, written as a percent. To calculate\nthe slope you divide the rise by the run. In the example the rise is\n1.25 mile over a run of 50 miles so the slope is 1.25/50 = 0.025.\nWritten as a percent this is 2.5 %.\n\nFor the US, two and 1/2 percent is generally thought of as the upper\nlimit. This means a rise of 2.5 feet when going 100 feet forward. In\nthe US this was the maximum grade on the first major US railroad, the\nBaltimore and Ohio. Note curves increase the frictional drag on a\ntrain reducing the allowable grade.\n\n### **Standard**\n\nFORTRAN 77 , for a _complex_ argument Fortran 2008\n\n### **See Also**\n\nInverse function: [**sin**(3)](#sin)\n\n### **Resources**\n\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ASIND": "## asind\n\n### **Name**\n\n**asind** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arcsine function in degrees\n\n### **Synopsis**\n```fortran\n result = asind(x)\n```\n```fortran\n elemental real(kind=KIND) function asind(x)\n\n real(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **KIND** may be any kind supported by the _real_ type.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**asind** computes the arc sine of its argument **x** in degrees\n\nThe arcsine is the inverse function of the sine function. It is commonly\nused in trigonometry when trying to find the angle when the lengths of\nthe hypotenuse and the opposite side of a right triangle are known.\n\nExample: **asind(1.0)** has the value 90.0 (approximately).\n\n### **Options**\n\n- **x**\n : The value to compute the arc sine of\n The type shall be _real_ and a magnitude that is less than or\n equal to one |X| <= 1.\n It is expressed in degrees and lies in the range 90 <= asind(x) <= 90.\n\n### **Result**\n\n The result has a value equal to a processor-dependent approximation\n to arcsin(x).\n\n If **x** is real the result is _real_ and it is expressed in radians\n and lies in the range\n```fortran\n PI/2 <= asind (X) <= PI/2.\n```\n If the argument (and therefore the result) is imaginary the real part\n of the result is in radians and lies in the range\n```fortran\n -PI/2 <= real(asind(x)) <= PI/2\n```\n### **Examples**\n\nThe arcsine will allow you to find the measure of a right angle when you\nknow the ratio of the side opposite the angle to the hypotenuse.\n\nSo if you knew that a train track rose 1.25 vertical miles on a track\nthat was 50 miles long, you could determine the average angle of incline\nof the track using the arcsine. Given\n\n sin(theta) = 1.25 miles/50 miles (opposite/hypotenuse)\n\nSample program:\n```fortran\nprogram demo_asind\nuse, intrinsic :: iso_fortran_env, only : dp=>real64\nimplicit none\n! value to convert degrees to radians\nreal(kind=dp),parameter :: R2D=180.0_dp/acos(-1.0_dp)\nreal(kind=dp) :: angle, rise, run\ncharacter(len=*),parameter :: all='(*(g0,1x))'\n ! given sine(theta) = 1.25 miles/50 miles (opposite/hypotenuse)\n ! then taking the arcsine of both sides of the equality yields\n ! theta = arcsine(1.25 miles/50 miles) ie. arcsine(opposite/hypotenuse)\n rise=1.250_dp\n run=50.00_dp\n angle = asind(rise/run)\n print all, 'angle of incline(degrees) = ', angle\n angle = angle/R2D\n print all, 'angle of incline(radians) = ', angle\n\n print all, 'percent grade=',rise/run*100.0_dp\ncontains\nsubroutine sub1()\n! notice the (incidently empty) type is defined below\n! the implicit statement\nimplicit type(nil) (a)\ntype nil\nend type nil\ntype(nil) :: anull\nend subroutine sub1\nend program demo_asind\n```\nResults:\n```text\n > angle of incline(degrees) = 1.4325437375665075\n > angle of incline(radians) = 0.25002604899361135E-1\n > percent grade= 2.5000000000000000\n```\nThe percentage grade is the slope, written as a percent. To calculate\nthe slope you divide the rise by the run. In the example the rise is\n1.25 mile over a run of 50 miles so the slope is 1.25/50 = 0.025.\nWritten as a percent this is 2.5 %.\n\nFor the US, two and 1/2 percent is generally thought of as the upper\nlimit. This means a rise of 2.5 feet when going 100 feet forward. In\nthe US this was the maximum grade on the first major US railroad, the\nBaltimore and Ohio. Note curves increase the frictional drag on a\ntrain reducing the allowable grade.\n\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\nInverse function: [**sin**(3)](#sin)\n\n### **Resources**\n\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ASINH": "## asinh\n\n### **Name**\n\n**asinh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Inverse hyperbolic sine function\n\n### **Synopsis**\n```fortran\n result = asinh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function asinh(x)\n\n TYPE(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_ or _complex_ type\n - **KIND** may be any kind supported by the associated type\n - The returned value will be of the same type and kind as the argument **x**\n\n### **Description**\n\n**asinh** computes the inverse hyperbolic sine of **x**.\n\n### **Options**\n\n- **x**\n : The value to compute the inverse hyperbolic sine of\n\n### **Result**\n\n The result has a value equal to a processor-dependent approximation\n to the inverse hyperbolic sine function of **x**.\n\n If **x** is _complex_, the imaginary part of the result is in radians and lies\n between\n```fortran\n -PI/2 <= aimag(asinh(x)) <= PI/2\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_asinh\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=dp), dimension(3) :: x = [ -1.0d0, 0.0d0, 1.0d0 ]\n\n ! elemental\n write (*,*) asinh(x)\n\nend program demo_asinh\n```\nResults:\n```text\n > -0.88137358701954305 0.0000000000000000 0.88137358701954305\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nInverse function: [**sinh**(3)](#sinh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ASINPI": "## asinpi\n\n### **Name**\n\n**asinpi** - \\[MATHEMATICS:TRIGONOMETRIC\\] Circular arc sine function\n\n### **Synopsis**\n```fortran\n result = asinpi(x)\n```\n```fortran\n elemental real(kind=KIND) function asinpi(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **KIND** may be any _real_ kind\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**asinpi** computes the arcsine of its argument **x**.\n\nThe arcsine is the inverse function of the sine function. It is commonly\nused in trigonometry when trying to find the angle when the lengths of\nthe hypotenuse and the opposite side of a right triangle are known.\n\nThe returned value is in half-revolutions (ie. in multiples\nof PI).\n\nExample: ASINPI(1:0) has the value 0:5 (approximately).\n\n### **Options**\n\n- **x**\n : The value to compute the arcsine of; where |X| <= 1.\n The type shall be _real_\n\n### **Result**\n\n The result has a value equal to a processor-dependent approximation\n to the arc sine of X.\n The result is _real_ and it is expressed in half-revolutions\n and lies in the range\n```fortran\n -1 <= asinpi (X) <= 1\n```\n and is the same kind as the input.\n\n### **Examples**\n\nThe arcsine will allow you to find the measure of a right angle when you\nknow the ratio of the side opposite the angle to the hypotenuse.\n\nSo if you knew that a train track rose 1.25 vertical miles on a track\nthat was 50 miles long, you could determine the average angle of incline\nof the track using the arcsine. Given\n\n sin(theta) = 1.25 miles/50 miles (opposite/hypotenuse)\n\nSample program:\n```fortran\nprogram demo_asinpi\nuse, intrinsic :: iso_fortran_env, only : dp=>real64\nimplicit none\n! value to convert degrees to half-revolutions\nreal(kind=dp),parameter :: D2HR=1/180.0_dp\nreal(kind=dp) :: angle, rise, run\ncharacter(len=*),parameter :: all='(*(g0,1x))'\n ! basics\n ! elemental\n print all, asinpi( [0.0d0, 0.5d0, -0.5d0, 1.0d0, -1.0d0 ])\n !\n ! sample application\n ! given sine(theta) = 1.25 miles/50 miles (opposite/hypotenuse)\n ! then taking the arcsine of both sides of the equality yields\n ! theta = arcsine(1.25 miles/50 miles) ie. arcsine(opposite/hypotenuse)\n rise=1.250_dp\n run=50.00_dp\n angle = asinpi(rise/run)\n print all, 'angle of incline(half-revolutions) = ', angle\n angle = angle/D2HR\n print all, 'angle of incline(degrees) = ', angle\n print all, 'percent grade=',rise/run*100.0_dp\ncontains\nelemental function asinpi(x)\nreal(kind=dp),parameter :: PI=acos(-1.0_dp)\nreal(kind=dp),intent(in) :: x\nreal(kind=dp) :: asinpi\n asinpi=asin(x)/PI\nend function asinpi\nend program demo_asinpi\n```\nResults:\n```text\n > 0.00, 0.166667, -0.166667, 0.50, -0.50\n > angle of incline(half-revolutions) = 0.79585763198139307E-2\n > angle of incline(degrees) = 1.4325437375665075\n > percent grade= 2.5000000000000000\n```\nThe percentage grade is the slope, written as a percent. To calculate\nthe slope you divide the rise by the run. In the example the rise is\n1.25 mile over a run of 50 miles so the slope is 1.25/50 = 0.025.\nWritten as a percent this is 2.5 %.\n\nFor the US, two and 1/2 percent is generally thought of as the upper\nlimit. This means a rise of 2.5 feet when going 100 feet forward. In\nthe US this was the maximum grade on the first major US railroad, the\nBaltimore and Ohio. Note curves increase the frictional drag on a\ntrain reducing the allowable grade.\n\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n- Inverse function in half-revolutions: [**sinpi**(3)](#sinpi)\n- function in radians: [**asin**(3)](#asin)\n- function in degrees : [**asind**(3)](#asind)\n- radians: [**sin**(3)](#sin)\n- degrees: [**sind**(3)](#sind)\n\n### **Resources**\n\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "ASSOCIATED": "## associated\n\n### **Name**\n\n**associated** - \\[STATE:INQUIRY\\] Association status of a pointer or pointer/target pair\n\n### **Synopsis**\n```fortran\n result = associated(pointer [,target])\n```\n```fortran\n logical function associated(pointer,target)\n\n type(TYPE(kind=KIND)),pointer :: pointer\n type(TYPE(kind=KIND)),pointer,optional :: target\n```\n### **Characteristics**\n\n - **pointer** shall have the _pointer_ attribute and it can be any type\n or may be a procedure pointer\n - **target** shall be a pointer or a target. It must have the\n same type, kind type parameter, and array rank as **pointer**.\n - The association status of neither **pointer** nor **target** shall\n be undefined.\n - the result is a default _logical_ value\n\n### **Description**\n\n **associated** determines the status of the pointer **pointer**\n or if **pointer** is associated with the target **target**.\n\n### **Options**\n\n- **pointer**\n : A pointer to test for association.\n Its pointer association status shall not be undefined.\n\n- **target**\n : A target that is to be tested for occupying the same storage\n units as the pointer **pointer**. That is, it is tested as to whether it\n is pointed to by **pointer**.\n\n### **Result**\n\n**associated** returns a scalar value of type _logical_.\nThere are several cases:\n\n1. When the optional **target** is not present then **associated(pointer)**\n is _.true._ if **pointer** is associated with a target; otherwise, it\n returns _.false._.\n\n2. If **target** is present and a scalar target, the result is _.true._ if\n **target** is not a zero-sized storage sequence and the target\n associated with **pointer** occupies the same storage units. If **pointer**\n is disassociated, the result is _.false._.\n\n3. If **target** is present and an array target, the result is _.true._ if\n **target** and **pointer** have the same shape, are not zero-sized arrays,\n are arrays whose elements are not zero-sized storage sequences, and\n **target** and **pointer** occupy the same storage units in array element\n order.\n\n As in case 2, the result is _.false._, if **pointer** is disassociated.\n\n4. If **target** is present and an scalar pointer, the result is _.true._ if\n **target** is associated with **pointer**, the target associated with **target**\n are not zero-sized storage sequences and occupy the same storage\n units.\n\n The result is _.false._, if either **target** or **pointer** is disassociated.\n\n5. If **target** is present and an array pointer, the result is _.true._ if\n target associated with **pointer** and the target associated with **target**\n have the same shape, are not zero-sized arrays, are arrays whose\n elements are not zero-sized storage sequences, and **target** and\n **pointer** occupy the same storage units in array element order.\n\n6. If **target** is present and is a procedure, the result is true if and\n only if **pointer** is associated with **target** and, if **target** is an\n internal procedure, they have the same host instance.\n\n7. If **target** is present and is a procedure pointer, the result is true\n if and only if **pointer** and **target** are associated with the same\n procedure and, if the procedure is an internal procedure, they have\n the same host instance.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_associated\nimplicit none\nreal, target :: tgt(2) = [1., 2.]\nreal, pointer :: ptr(:)\n ptr => tgt\n if (associated(ptr) .eqv. .false.) &\n & stop 'POINTER NOT ASSOCIATED'\n if (associated(ptr,tgt) .eqv. .false.) &\n & stop 'POINTER NOT ASSOCIATED TO TARGET'\n if (associated(ptr) ) &\n & print *, 'POINTER ASSOCIATED'\n if (associated(ptr,tgt) ) &\n & print *, 'POINTER ASSOCIATED TO TARGET'\nend program demo_associated\n```\nResults:\n```text\n > POINTER ASSOCIATED\n > POINTER ASSOCIATED TO TARGET\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**null**(3)](#null)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ATAN": "## atan\n\n### **Name**\n\n**atan** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arctangent AKA inverse tangent function\n\n### **Synopsis**\n```fortran\n result = atan([x) | atan(y, x)\n```\n```fortran\n elemental TYPE(kind=KIND) function atan(y,x)\n\n TYPE(kind=KIND),intent(in) :: x\n TYPE(kind=**),intent(in),optional :: y\n```\n### **Characteristics**\n\n - If **y** is present **x** and **y** must both be _real_.\n Otherwise, **x** may be _complex_.\n - **KIND** can be any kind supported by the associated type.\n - The returned value is of the same type and kind as **x**.\n\n### **Description**\n\n**atan** computes the arctangent of **x**.\n\n### **Options**\n\n- **x**\n : The value to compute the arctangent of.\n if **y** is present, **x** shall be _real_.\n\n- **y**\n : is of the same type and kind as **x**. If **x** is zero, **y**\n must not be zero.\n\n### **Result**\n\nThe returned value is of the same type and kind as **x**. If **y** is\npresent, the result is identical to **atan2(y,x)**. Otherwise, it is the\narc tangent of **x**, where the real part of the result is in radians\nand lies in the range\n**-PI/2 \\<= atan(x) \\<= PI/2**\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atan\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))'\nreal(kind=real64),parameter :: &\n Deg_Per_Rad = 57.2957795130823208767981548_real64\nreal(kind=real64) :: x\n x=2.866_real64\n print all, atan(x)\n\n print all, atan( 2.0d0, 2.0d0),atan( 2.0d0, 2.0d0)*Deg_Per_Rad\n print all, atan( 2.0d0,-2.0d0),atan( 2.0d0,-2.0d0)*Deg_Per_Rad\n print all, atan(-2.0d0, 2.0d0),atan(-2.0d0, 2.0d0)*Deg_Per_Rad\n print all, atan(-2.0d0,-2.0d0),atan(-2.0d0,-2.0d0)*Deg_Per_Rad\n\nend program demo_atan\n```\nResults:\n```text\n > 1.235085437457879\n > .7853981633974483 45.00000000000000\n > 2.356194490192345 135.0000000000000\n > -.7853981633974483 -45.00000000000000\n > -2.356194490192345 -135.0000000000000\n```\n### **Standard**\n\nFORTRAN 77 for a complex argument; and for two\narguments Fortran 2008\n\n### **See Also**\n\n[**atan2**(3)](#atan2), [**tan**(3)](#tan)\n\n### **Resources**\n\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ATAN2": "## atan2\n\n### **Name**\n\n**atan2** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arctangent (inverse tangent)\nfunction\n\n### **Synopsis**\n```fortran\n result = atan2(y, x)\n```\n```fortran\n elemental real(kind=KIND) function atan2(y, x)\n\n real,kind=KIND) :: atan2 \n real,kind=KIND),intent(in) :: y, x \n```\n### **Characteristics**\n\n - **x** and **y** must be reals of the same kind.\n - The return value has the same type and kind as **y** and **x**.\n\n### **Description**\n\n **atan2** computes in radians a processor-dependent approximation of\n the arctangent of the complex number ( **x**, **y** ) or equivalently\n the principal value of the arctangent of the value **y/x** (which\n determines a unique angle).\n\n If **y** has the value zero, **x** shall not have the value zero.\n\n The resulting phase lies in the range \n\n -PI <= ATAN2 (Y,X) <= PI \n \n and is equal to a processor-dependent approximation to a value of\n arctan(Y/X).\n\n### **Options**\n\n- **y**\n : The imaginary component of the complex value **(x,y)** or the **y**\n component of the point **\\**.\n\n- **x**\n : The real component of the complex value **(x,y)** or the **x**\n component of the point **\\**.\n\n### **Result**\n\nThe value returned is by definition the principal value of the complex\nnumber **(x, y)**, or in other terms, the phase of the phasor x+i\\*y.\n\nThe principal value is simply what we get when we adjust a radian value\nto lie between **-PI** and **PI** inclusive,\n\nThe classic definition of the arctangent is the angle that is formed\nin Cartesian coordinates of the line from the origin point **\\<0,0\\>**\nto the point **\\** .\n\nPictured as a vector it is easy to see that if **x** and **y** are both\nzero the angle is indeterminate because it sits directly over the origin,\nso **atan(0.0,0.0)** will produce an error.\n\nRange of returned values by quadrant:\n```text\n> +PI/2\n> |\n> |\n> PI/2 < z < PI | 0 > z < PI/2\n> |\n> +-PI -------------+---------------- +-0\n> |\n> PI/2 < -z < PI | 0 < -z < PI/2\n> |\n> |\n> -PI/2\n>\n NOTES:\n\n If the processor distinguishes -0 and +0 then the sign of the\n returned value is that of Y when Y is zero, else when Y is zero\n the returned value is always positive.\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_atan2\nreal :: z \ncomplex :: c \n !\n ! basic usage\n ! ATAN2 (1.5574077, 1.0) has the value 1.0 (approximately).\n z=atan2(1.5574077, 1.0)\n write(*,*) 'radians=',z,'degrees=',r2d(z)\n !\n ! elemental : arrays\n write(*,*)'elemental',atan2( [10.0, 20.0], [30.0,40.0] )\n !\n ! elemental : arrays and scalars\n write(*,*)'elemental',atan2( [10.0, 20.0], 50.0 )\n !\n ! break complex values into real and imaginary components\n ! (note TAN2() can take a complex type value )\n c=(0.0,1.0)\n write(*,*)'complex',c,atan2( x=c%re, y=c%im )\n !\n ! extended sample converting cartesian coordinates to polar\n COMPLEX_VALS: block\n real :: ang, radius\n complex,allocatable :: vals(:)\n integer :: i\n !\n vals=[ &\n ! 0 45 90 135\n ( 1.0, 0.0 ), ( 1.0, 1.0 ), ( 0.0, 1.0 ), (-1.0, 1.0 ), & \n ! 180 225 270\n (-1.0, 0.0 ), (-1.0,-1.0 ), ( 0.0,-1.0 ) ] \n do i=1,size(vals)\n call cartesian_to_polar(vals(i), radius,ang)\n write(*,101)vals(i),ang,r2d(ang),radius\n enddo\n 101 format( 'X= ',f5.2,' Y= ',f5.2,' ANGLE= ',g0, &\n & T38,'DEGREES= ',g0.4, T54,'DISTANCE=',g0)\n endblock COMPLEX_VALS\n!\ncontains\n!\nelemental real function r2d(radians)\n! input radians to convert to degrees\ndoubleprecision,parameter :: DEGREE=0.017453292519943d0 ! radians\nreal,intent(in) :: radians\n r2d=radians / DEGREE ! do the conversion\nend function r2d\n!\nsubroutine cartesian_to_polar(xy,radius,inclination)\n! return angle in radians in range 0 to 2*PI\nimplicit none\ncomplex,intent(in) :: xy\nreal,intent(out) :: radius,inclination\n radius=abs( xy )\n ! arbitrarily set angle to zero when radius is zero\n inclination=merge(0.0,atan2(x=xy%re, y=xy%im),radius==0.0)\n ! bring into range 0 <= inclination < 2*PI\n if(inclination < 0.0)inclination=inclination+2*atan2(0.0d0,-1.0d0)\nend subroutine cartesian_to_polar\n!\nend program demo_atan2\n\nResults:\n\n > radians= 1.00000000 degrees= 57.2957802 \n > elemental 0.321750551 0.463647604 \n > elemental 0.197395563 0.380506366 \n > complex (0.00000000,1.00000000) 1.57079637 \n > X= 1.00 Y= 0.00 ANGLE= 0.00000000 DEGREES= 0.000 DISTANCE=1.00000000\n > X= 1.00 Y= 1.00 ANGLE= 0.785398185 DEGREES= 45.00 DISTANCE=1.41421354\n > X= 0.00 Y= 1.00 ANGLE= 1.57079637 DEGREES= 90.00 DISTANCE=1.00000000\n > X= -1.00 Y= 1.00 ANGLE= 2.35619450 DEGREES= 135.0 DISTANCE=1.41421354\n > X= -1.00 Y= 0.00 ANGLE= 3.14159274 DEGREES= 180.0 DISTANCE=1.00000000\n > X= -1.00 Y= -1.00 ANGLE= 3.92699075 DEGREES= 225.0 DISTANCE=1.41421354\n > X= 0.00 Y= -1.00 ANGLE= 4.71238899 DEGREES= 270.0 DISTANCE=1.00000000\n\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n- [**atan**(3)](#atan)\n- [**tan**(3)](#tan)\n- [**tan2**(3)](#tan2)\n\n### **Resources**\n\n- [arctan:wikipedia](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ATAN2D": "## atan2d\n\n### **Name**\n\n**atan2d** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arc tangent function in\ndegrees (inverse tangent)\n\n### **Synopsis**\n```fortran\n result = atan2d(y, x)\n```\n```fortran\n elemental real(kind=KIND) function atan2d(y, x)\n\n real,kind=KIND) :: atan2d\n real,kind=KIND),intent(in) :: y, x\n```\n### **Characteristics**\n\n - **x** and **y** must be reals of the same kind.\n - The return value has the same type and kind as **y** and **x**.\n\n### **Description**\n\n **atan2d** computes in degrees a processor-dependent approximation\n of the arctangent of the principal value of the arctangent of the\n value **y/x** (which determines a unique angle).\n\n If **y** has the value zero, **x** shall not have the value zero.\n\n The resulting phase lies in the range -180 <= atan2d (Y,X) <= 180 and is\n equal to a processor-dependent approximation to a value of arctan(Y/X)\n expressed in degrees.\n\n It is equivalent to **ATAN2(Y, X)\\*180/PI** but limited to real values.\n\n### **Options**\n\n- **y**\n : The imaginary component of the complex value **(x,y)** or the **y**\n component of the point **\\**.\n\n- **x**\n : The real component of the complex value **(x,y)** or the **x**\n component of the point **\\**.\n\n### **Result**\nThe result is in degrees, not radians.\n\nThe radian value is by definition the principal value of the complex\nnumber **(x, y)**, or in other terms, the phase of the phasor x+i\\*y.\n\nThe principal value is simply what we get when we adjust the value\nto lie between **-180** and **180** degrees inclusive,\n\nThe classic definition of the arctangent is the angle that is formed\nin Cartesian coordinates of the line from the origin point **\\<0,0\\>**\nto the point **\\** .\n\nPictured as a vector it is easy to see that if **x** and **y** are both\nzero the angle is indeterminate because it sits directly over the origin,\nso **atan2d(0.0,0.0)** will produce an error.\n\nRange of returned values by quadrant:\n```text\n> +90\n> |\n> |\n> 90 < z < 180 | 0 > z < 90\n> |\n> +-180 ------------+---------------- +-0\n> |\n> 90 < -z < 180 | 0 < -z < 90\n> |\n> |\n> -90\n>\n NOTES:\n\n If the processor distinguishes -0 and +0 then the sign of the\n returned value is that of Y when Y is zero, else when Y is zero\n the returned value is always positive.\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_atan2d\nimplicit none\ninteger,parameter :: wp=kind(0.0)\nreal(wp),parameter :: d2r=acos(-1.0_wp)/180.0_wp\nreal :: z\ncomplex :: c\n !\n ! basic usage\n ! atan2d (1.5574077, 1.0) has the value 1.0 radian (approximately).\n z=atan2d(1.5574077, 1.0)\n write(*,*) 'degrees=',z,'radians=',d2r*z\n !\n ! elemental arrays\n write(*,*)'elemental',atan2d( [10.0, 20.0], [30.0,40.0] )\n !\n ! elemental arrays and scalars\n write(*,*)'elemental',atan2d( [10.0, 20.0], 50.0 )\n !\n ! multi-dimensional returns multi-dimensional\n write(*,*) atan2(reshape([1.0,1.0,1.0,1.0],[2,2]),&\n & reshape([1.0,1.0,1.0,1.0],[2,2]) )\n !\n ! break complex values into real and imaginary components\n c=(0.0,1.0)\n write(*,*)'complex value treated as components', &\n & c,atan2d( x=c%re, y=c%im )\n !\n ! extended sample\n COMPLEX_VALS: block\n real :: ang\n complex,allocatable :: vals(:)\n integer :: i\n !\n vals=[ &\n ( 1.0, 0.0 ), & ! 0\n ( 1.0, 1.0 ), & ! 45\n ( 0.0, 1.0 ), & ! 90\n (-1.0, 1.0 ), & ! 135\n (-1.0, 0.0 ), & ! 180\n (-1.0,-1.0 ), & ! 225\n ( 0.0,-1.0 )] ! 270\n do i=1,size(vals)\n ang=atan2d(vals(i)%im, vals(i)%re)\n write(*,101)vals(i),ang,d2r*ang\n enddo\n 101 format( &\n & 'X= ',f5.2, &\n & ' Y= ',f5.2, &\n & ' ANGLE= ',g0, &\n & T38,'RADIANS= ',g0.4)\n endblock COMPLEX_VALS\n!\nend program demo_atan2d\n```\nResults:\n```text\n > degrees= 57.2957802 radians= 1.00000000\n > elemental 18.4349480 26.5650520\n > elemental 11.3099327 21.8014107\n > 0.785398185 0.785398185 0.785398185 0.785398185\n > complex value treated as components (0.0000,1.0000) 90.000\n > X= 1.00 Y= 0.00 ANGLE= 0.00000000 RADIANS= 0.000\n > X= 1.00 Y= 1.00 ANGLE= 45.0000000 RADIANS= 0.7854\n > X= 0.00 Y= 1.00 ANGLE= 90.0000000 RADIANS= 1.571\n > X= -1.00 Y= 1.00 ANGLE= 135.000000 RADIANS= 2.356\n > X= -1.00 Y= 0.00 ANGLE= 180.000000 RADIANS= 3.142\n > X= -1.00 Y= -1.00 ANGLE= -135.000000 RADIANS= -2.356\n > X= 0.00 Y= -1.00 ANGLE= -90.0000000 RADIANS= -1.571\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n- [**atan**(3)](#atan)\n- [**atanpi**(3)](#atanpi)\n\n### **Resources**\n\n- [arctan:wikipedia](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ATAN2PI": "## atan2pi\n\n### **Name**\n\n**atan2pi** - \\[MATHEMATICS:TRIGONOMETRIC\\] Circular Arc tangent (inverse tangent)\nfunction\n\n### **Synopsis**\n```fortran\n result = atan2pi(y, x)\n```\n```fortran\n elemental real(kind=KIND) function atan2pi(y, x)\n\n real,kind=KIND) :: atan2pi\n real,kind=KIND),intent(in) :: y, x\n```\n### **Characteristics**\n\n - **x** and **y** must be reals of the same kind.\n - The return value has the same type and kind as **y** and **x**.\n\n### **Description**\n\n **atan2pi** computes in half-revolutions a processor-dependent\n approximation of the arctangent of the components of the complex number\n ( **x**, **y** ) or equivalently the principal value of the arctangent\n of the value **y/x** (which determines a unique angle).\n\n If **y** has the value zero, **x** shall not have the value zero.\n\n The resulting phase lies in the range -1 <= atan2pi (Y,X) <= 1 and is equal to a\n processor-dependent approximation to a value of arctan(Y/X).\n\n### **Options**\n\n- **y**\n : The imaginary component of the complex value **(x,y)** or the **y**\n component of the point **\\**.\n\n- **x**\n : The real component of the complex value **(x,y)** or the **x**\n component of the point **\\**.\n\n### **Result**\n\nThe value returned is by definition the principal value of the complex\nnumber **(x, y)**, or in other terms, the phase of the phasor x+i\\*y.\n\nThe principal value is simply what we get when we adjust an angular\nhalf-revolution value to lie between **-1** and **1** inclusive,\n\nThe classic definition of the arctangent is the angle that is formed\nin Cartesian coordinates of the line from the origin point **\\<0,0\\>**\nto the point **\\** .\n\nPictured as a vector it is easy to see that if **x** and **y** are both\nzero the angle is indeterminate because it sits directly over the origin,\nso **atan(0.0,0.0)** will produce an error.\n\nRange of returned values by quadrant:\n```text\n> +1/2\n> |\n> |\n> 1/2 < z < 1 | 0 > z < 1/2\n> |\n> +-1 -------------+---------------- +-0\n> |\n> 1/2 < -z < 1 | 0 < -z < 1/2\n> |\n> |\n> -1/2\n>\n NOTES:\n\n If the processor distinguishes -0 and +0 then the sign of the\n returned value is that of Y when Y is zero, else when Y is zero\n the returned value is always positive.\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_atan2pi\nreal :: z\ncomplex :: c\nreal, parameter :: h2d = 180.0\n !\n ! basic usage\n ! atan2pi (1.5574077, 1.0) has the value 1.0 (approximately).\n z=atan2pi(1.5574077, 1.0)\n write(*,*) 'half-revolutions=',z,'degrees=',h2d*z\n !\n ! elemental arrays\n write(*,*)'elemental',atan2pi( [10.0, 20.0], [30.0,40.0] )\n !\n ! elemental arrays and scalars\n write(*,*)'elemental',atan2pi( [10.0, 20.0], 50.0 )\n !\n ! break complex values into real and imaginary components\n ! (note TAN2() can take a complex type value )\n c=(0.0,1.0)\n write(*,*)'complex',c,atan2pi( x=c%re, y=c%im )\n !\n ! extended sample converting cartesian coordinates to polar\n COMPLEX_VALS: block\n real :: ang\n complex,allocatable :: vals(:)\n integer :: i\n !\n vals=[ &\n ( 1.0, 0.0 ), & ! 0\n ( 1.0, 1.0 ), & ! 45\n ( 0.0, 1.0 ), & ! 90\n (-1.0, 1.0 ), & ! 135\n (-1.0, 0.0 ), & ! 180\n (-1.0,-1.0 ), & ! 225\n ( 0.0,-1.0 )] ! 270\n write(*,'(a)')repeat('1234567890',8)\n do i=1,size(vals)\n ang=atan2pi(vals(i)%im,vals(i)%re)\n write(*,101)vals(i),ang,h2d*ang\n enddo\n 101 format( &\n & 'X= ',f5.2, &\n & ' Y= ',f5.2, &\n & ' HALF-REVOLUTIONS= ',f7.3, &\n & T50,' DEGREES= ',g0.4)\n endblock COMPLEX_VALS\n!\nend program demo_atan2pi\n```\nResults:\n```text\n > half-revolutions= 0.318309873 degrees= 57.2957764\n > elemental 0.102416381 0.147583619\n > elemental 6.28329590E-02 0.121118948\n > complex (0.00000000,1.00000000) 0.500000000\n > X= 1.00 Y= 0.00 HALF-REVOLUTIONS= 0.000 DEGREES= 0.000\n > X= 1.00 Y= 1.00 HALF-REVOLUTIONS= 0.250 DEGREES= 45.00\n > X= 0.00 Y= 1.00 HALF-REVOLUTIONS= 0.500 DEGREES= 90.00\n > X= -1.00 Y= 1.00 HALF-REVOLUTIONS= 0.750 DEGREES= 135.0\n > X= -1.00 Y= 0.00 HALF-REVOLUTIONS= 1.000 DEGREES= 180.0\n > X= -1.00 Y= -1.00 HALF-REVOLUTIONS= -0.750 DEGREES= -135.0\n > X= 0.00 Y= -1.00 HALF-REVOLUTIONS= -0.500 DEGREES= -90.00\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n- [**atan**(3)](#atan)\n\n### **Resources**\n\n- [arctan:wikipedia](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ATAND": "## atand\n\n### **Name**\n\n**atand** - \\[MATHEMATICS:TRIGONOMETRIC\\] Arc tangent AKA inverse\ntangent function in degrees\n\n### **Synopsis**\n```fortran\n result = atand(x) | atand(y, x)\n```\n```fortran\n elemental real(kind=KIND) function atand(y,x)\n\n real(kind=KIND),intent(in) :: x\n real(kind=**),intent(in),optional :: y\n```\n### **Characteristics**\n\n - If **y** is present **x** and **y** must both be of the same\n kind.\n - **KIND** can be any kind supported by the associated type.\n - The returned value is real of the same kind as **x**.\n\n### **Description**\n\n**atand** calculates the Arc Tangent function in degrees.\n\n### **Options**\n\n- **x**\n : The _real_ value to compute the arctangent of.\n\n- **y**\n : is real of the same kind as **x**. If **x** is zero, **y**\n must not be zero.\n\n### **Result**\n\nThe returned value is a _real_ type of the same kind as **x** that\napproximates the arc tangent of **x** expressed in degrees. If **y**\nis present, the result is identical to **atan2d(y,x)**. The result lies\nin the range **-90 \\<= atand(x) \\<= 90** .\n\n### **Examples**\n\natand(1.0) has the value 45.0 (approximately).\n\nSample program:\n\n```fortran\nprogram demo_atand\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))'\nreal(kind=real64),parameter :: &\n Deg_Per_Rad = 57.2957795130823208767981548_real64\nreal(kind=real64) :: x\n x=2.866_real64\n print all, atand(x)\n\n print all, atand( 2.0d0, 2.0d0),atand( 2.0d0, 2.0d0)/Deg_Per_Rad\n print all, atand( 2.0d0,-2.0d0),atand( 2.0d0,-2.0d0)/Deg_Per_Rad\n print all, atand(-2.0d0, 2.0d0),atand(-2.0d0, 2.0d0)/Deg_Per_Rad\n print all, atand(-2.0d0,-2.0d0),atand(-2.0d0,-2.0d0)/Deg_Per_Rad\n\nend program demo_atand\n```\nResults:\n```text\n > 70.765182904405478\n > 45.000000000000000 0.78539816339744828\n > 135.00000000000000 2.3561944901923448\n > -45.000000000000000 -0.78539816339744828\n > -135.00000000000000 -2.3561944901923448\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n[**atan2d**(3)](#atand2), [**tand**(3)](#tand),\n[**atan2**(3)](#atan2), [**tan**(3)](#tan),\n[**atan2pi**(3)](#atan2pi), [**tanpi**(3)](#tanpi)\n\n### **Resources**\n\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ATANH": "## atanh\n\n### **Name**\n\n**atanh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Inverse hyperbolic tangent function\n\n### **Synopsis**\n```fortran\n result = atanh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function atanh(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be _real_ or _complex_ of any associated type\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n **atanh** computes the inverse hyperbolic tangent of **x**.\n\n### **Options**\n\n- **x**\n : The type shall be _real_ or _complex_.\n\n### **Result**\n\n The return value has same type and kind as **x**. If **x** is _complex_, the\n imaginary part of the result is in radians and lies between\n```fortran\n -PI/2 <= aimag(atanh(x)) <= PI/2\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_atanh\nimplicit none\nreal, dimension(3) :: x = [ -1.0, 0.0, 1.0 ]\n\n write (*,*) atanh(x)\n\nend program demo_atanh\n```\nResults:\n```text\n > -Infinity 0.0000000E+00 Infinity\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nInverse function: [**tanh**(3)](#tanh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ATANPI": "## atanpi\n\n### **Name**\n\n**atanpi** - \\[MATHEMATICS:TRIGONOMETRIC\\] Circular Arctangent AKA inverse tangent function\n\n### **Synopsis**\n```fortran\n result = atanpi([x) | atanpi(y, x)\n```\n```fortran\n elemental real(kind=KIND) function atanpi(y,x)\n\n real(kind=KIND),intent(in) :: x\n real(kind=KIND),intent(in),optional :: y\n```\n### **Characteristics**\n\n - **y** and **x** must both be _real_ and of the same KIND\n - **KIND** can be any kind supported by the real type.\n - The returned value is of the same type and kind as **x**.\n\n### **Description**\n\n **atan**(3) computes the circular arctangent of **x** in\n half-revolutions.\n\n If **y** appears, the result is the same as the result of\n **atan2pi(y,x)**. If **y** does not appear, the result has a value\n equal to a processor-dependent approximation to the arc tangent of\n **x**; it is expressed in half-revolutions and lies in the range \n **-0.5 <= atanpi(x) <= 0.5**.\n\n Example. **atanpi(1.0)** has the value 0.25 (approximately).\n\n### **Options**\n\n- **x**\n : The _real_ value to compute the arctangent of.\n\n- **y**\n : is of the same type and kind as **x**. If **x** is zero, **y**\n must not be zero.\n\n### **Result**\n\n The returned value is of the same type and kind as **x**. If **y**\n is present, the result is identical to **atan2pi(y,x)**. Otherwise,\n it is the arc tangent of **x**, where the result is in half-revolutions\n and lies in the range **-1 \\<= atan(x) \\<= 1**\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atanpi\nuse, intrinsic :: iso_fortran_env, only : real32, real64\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))'\nreal(kind=real64) :: x, y\n x=2.866_real64\n print all, atanpi(x)\n\n print all, atanpi( 2.0d0, 2.0d0),atanpi( 2.0d0, 2.0d0)*180\n print all, atanpi( 2.0d0,-2.0d0),atanpi( 2.0d0,-2.0d0)*180\n print all, atanpi(-2.0d0, 2.0d0),atanpi(-2.0d0, 2.0d0)*180\n print all, atanpi(-2.0d0,-2.0d0),atanpi(-2.0d0,-2.0d0)*180\n\nend program demo_atanpi\n```\nResults:\n```text\n > 0.39313990502447488\n > 0.25000000000000000 45.000000000000000\n > 0.75000000000000000 135.00000000000000\n > -0.25000000000000000 -45.000000000000000\n > -0.75000000000000000 -135.00000000000000\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n[**atan2d**(3)](#tan2d),\n[**tan2d**(3)](#tan2d),\n[**atan2pi**(3)](#tan2pi),\n[**tan2pi**(3)](#tan2pi)\n\n### **Resources**\n\n- [wikipedia: inverse trigonometric functions](https://en.wikipedia.org/wiki/Inverse_trigonometric_functions)\n\n", "ATOMIC_ADD": "## atomic_add\n\n### **Name**\n\n**atomic_add** - \\[ATOMIC\\] Atomic ADD operation\n\n### **Synopsis**\n```fortran\n call atomic_add (atom, value [,stat] )\n```\n```fortran\n subroutine atomic_add(atom,value,stat)\n\n integer(atomic_int_kind) :: atom[*]\n integer(atomic_int_kind),intent(in) :: value\n integer,intent(out),intent(out) :: stat\n```\n### **Characteristics**\n\n- **atom** is a scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value** is a scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat** is a Scalar default-kind integer variable.\n\n### **Description**\n\n**atomic_add** atomically adds the value of VAR to the\nvariable **atom**. When **stat** is present and the invocation was successful,\nit is assigned the value 0. If it is present and the invocation has\nfailed, it is assigned a positive value; in particular, for a coindexed\nATOM, if the remote image has stopped, it is assigned the value of\niso_fortran_env's STAT_STOPPED_IMAGE and if the remote image has\nfailed, the value STAT_FAILED_IMAGE.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_atomic_add\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*]\n call atomic_add (atom[1], this_image())\nend program demo_atomic_add\n```\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_define**(3)](#atomic_define),\n[**atomic_fetch_add**(3)](#atomic_fetch),\n[**atomic_and**(3)](#atomic_and),\n[**atomic_or**(3)](#atomic_or),\n[**atomic_xor**(3)](#atomic_xor)\n**iso_fortran_env**(3),\n\n _Fortran intrinsic descriptions_\n", "ATOMIC_AND": "## atomic_and\n\n### **Name**\n\n**atomic_and** - \\[ATOMIC:BIT MANIPULATION\\] Atomic bitwise AND operation\n\n### **Synopsis**\n```fortran\n call atomic_and(atom, value [,stat])\n```\n```fortran\n subroutine atomic_and(atom,value,stat)\n\n integer(atomic_int_kind) :: atom[*]\n integer(atomic_int_kind),intent(in) :: value\n integer,intent(out),intent(out) :: stat\n```\n### **Characteristics**\n\n- **atom** is a scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value** is a scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat** is a Scalar default-kind integer variable.\n\n### **Description**\n\n**atomic_and** atomically defines **atom** with the bitwise\n**and** between the values of **atom** and **value**. When **stat** is present and the\ninvocation was successful, it is assigned the value 0. If it is present\nand the invocation has failed, it is assigned a positive value; in\nparticular, for a coindexed **atom**, if the remote image has stopped, it is\nassigned the value of iso_fortran_env's stat_stopped_image and if\nthe remote image has failed, the value stat_failed_image.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_and\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*]\n call atomic_and(atom[1], int(b'10100011101'))\nend program demo_atomic_and\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_fetch_and**(3)](#atomic_fetch_and),\n[**atomic_define**(3)](#atomic_define),\n[**atomic_ref**(3)](#atomic_ref),\n[**atomic_cas**(3)](#atomic_cas),\n**iso_fortran_env**(3),\n[**atomic_add**(3)](#atomic_add),\n[**atomic_or**(3)](#atomic_or),\n[**atomic_xor**(3)](#atomic_xor)\n\n _Fortran intrinsic descriptions_\n", "ATOMIC_CAS": "## atomic_cas\n\n### **Name**\n\n**atomic_cas** - \\[ATOMIC\\] Atomic compare and swap\n\n### **Synopsis**\n```fortran\n call atomic_cas (atom, old, compare, new [,stat] )\n```\n```fortran\n subroutine atomic_cas (atom, old, compare, new, stat)\n```\n### **Characteristics**\n\n### **Description**\n\n**atomic_cas** compares the variable **atom** with the value of\n**compare**; if the value is the same, **atom** is set to the value of\n**new**. Additionally, **old** is set to the value of **atom** that was\nused for the comparison. When **stat** is present and the invocation\nwas successful, it is assigned the value 0. If it is present and the\ninvocation has failed, it is assigned a positive value; in particular,\nfor a coindexed **atom**, if the remote image has stopped, it is assigned\nthe value of iso_fortran_env's stat_stopped_image and if the remote\nimage has failed, the value stat_failed_image.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of either integer type with\n atomic_int_kind kind or logical type with atomic_logical_kind\n kind.\n\n- **old**\n : Scalar of the same type and kind as **atom**.\n\n- **compare**\n : Scalar variable of the same type and kind as **atom**.\n\n- **new**\n : Scalar variable of the same type as **atom**. If kind is different, the\n value is converted to the kind of **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_cas\nuse iso_fortran_env\nimplicit none\nlogical(atomic_logical_kind) :: atom[*], prev\n call atomic_cas(atom[1], prev, .false., .true.)\nend program demo_atomic_cas\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_define**(3)](#atomic_define),\n[**atomic_ref**(3)](#atomic_ref),\n[**iso_fortran_env**(3)](#)\n\n _Fortran intrinsic descriptions_\n", "ATOMIC_DEFINE": "## atomic_define\n\n### **Name**\n\n**atomic_define** - \\[ATOMIC\\] Setting a variable atomically\n\n### **Synopsis**\n```fortran\n call atomic_define (atom, value [,stat] )\n```\n```fortran\n subroutine atomic_define(atom, value, stat)\n\n TYPE(kind=atomic_KIND_kind) :: atom[*]\n TYPE(kind=KIND) :: value\n integer,intent(out),optional :: stat\n```\n### **Characteristics**\n\n- **atom**\n : Scalar coarray or coindexed variable of either integer type with\n atomic_int_kind kind or logical type with atomic_logical_kind\n kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Description**\n\n**atomic_define** defines the variable **atom** with the value\n**value** atomically.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable to atomically assign the\n value **value** to.\n kind.\n\n- **value**\n : value to assign to **atom**\n\n- **stat**\n : When **stat** is present and the invocation was\n successful, it is assigned the value **0**. If it is present and the\n invocation has failed, it is assigned a positive value; in particular,\n for a coindexed **atom**, if the remote image has stopped, it is assigned\n the value of iso_fortran_env's stat_stopped_image and if the remote\n image has failed, the value stat_failed_image.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_define\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*]\n call atomic_define(atom[1], this_image())\nend program demo_atomic_define\n```\n\n### **Standard**\n\nFortran 2008 ; with **stat**, TS 18508\n\n### **See Also**\n\n[**atomic_ref**(3)](#atomic_ref),\n[**atomic_cas**(3)](#atomic_cas),\n**iso_fortran_env**(3),\n[**atomic_add**(3)](#atomic_add),\n[**atomic_and**(3)](#atomic_and),\n[**atomic_or**(3)](#atomic_or),\n[**atomic_xor**(3)](#atomic_xor)\n\n _Fortran intrinsic descriptions_\n", "ATOMIC_FETCH_ADD": "## atomic_fetch_add\n\n### **Name**\n\n**atomic_fetch_add** - \\[ATOMIC\\] Atomic ADD operation with prior fetch\n\n### **Synopsis**\n```fortran\n call atomic_fetch_add(atom, value, old [,stat] )\n```\n```fortran\n subroutine atomic_fetch_add(atom, value, old, stat)\n```\n### **Characteristics**\n\n### **Description**\n\n**atomic_fetch_add** atomically stores the value of **atom** in **old**\nand adds the value of **var** to the variable **atom**. When **stat** is\npresent and the invocation was successful, it is assigned the value **0**.\nIf it is present and the invocation has failed, it is assigned a positive\nvalue; in particular, for a coindexed **atom**, if the remote image has\nstopped, it is assigned the value of iso_fortran_env's stat_stopped_image\nand if the remote image has failed, the value stat_failed_image.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind. atomic_logical_kind kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **old**\n : Scalar of the same type and kind as **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_fetch_add\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*], old\n call atomic_add(atom[1], this_image(), old)\nend program demo_atomic_fetch_add\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_define**(3)](#atomic_define),\n[**atomic_add**(3)](#atomic_add),\n**iso_fortran_env**(3),\n\n[**atomic_fetch_and**(3)](#atomic_fetch_and),\n[**atomic_fetch_or**(3)](#atomic_fetch_or),\n\n[**atomic_fetch_xor**(3)](#atomic_fetch_xor)\n\n _Fortran intrinsic descriptions_\n", "ATOMIC_FETCH_AND": "## atomic_fetch_and\n\n### **Name**\n\n**atomic_fetch_and** - \\[ATOMIC:BIT MANIPULATION\\] Atomic bitwise AND operation with prior fetch\n\n### **Synopsis**\n```fortran\n call atomic_fetch_and(atom, value, old [,stat] )\n```\n```fortran\n subroutine atomic_fetch_and(atom, value, old, stat)\n```\n### **Characteristics**\n\n### **Description**\n\n**atomic_fetch_and** atomically stores the value of\n**atom** in **old** and defines **atom** with the bitwise AND between the values of\n**atom** and **value**. When **stat** is present and the invocation was successful,\nit is assigned the value **0**. If it is present and the invocation has\nfailed, it is assigned a positive value; in particular, for a coindexed\n**atom**, if the remote image has stopped, it is assigned the value of\niso_fortran_env's stat_stopped_image and if the remote image has\nfailed, the value stat_failed_image.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **old**\n : Scalar of the same type and kind as **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_fetch_and\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*], old\n call atomic_fetch_and (atom[1], int(b'10100011101'), old)\nend program demo_atomic_fetch_and\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_define**(3)](#atomic_define),\n[**atomic_and**(3)](#atomic_and),\n[**iso_fortran_env**(3)](#),\n\n[**atomic_fetch_add**(3)](#atomic_fetch_add),\n[**atomic_fetch_or**(3)](#atomic_fetch_or),\n\n[**atomic_fetch_xor**(3)](#atomic_fetch_xor)\n\n _Fortran intrinsic descriptions_\n", "ATOMIC_FETCH_OR": "## atomic_fetch_or\n\n### **Name**\n\n**atomic_fetch_or** - \\[ATOMIC:BIT MANIPULATION\\] Atomic bitwise OR operation with prior fetch\n\n### **Synopsis**\n```fortran\n call atomic_fetch_or(atom, value, old [,stat] )\n```\n```fortran\n subroutine atomic_fetch_or(atom, value, old, stat)\n```\n### **Characteristics**\n\n### **Description**\n\n**atomic_fetch_or** atomically stores the value of\n**atom** in **old** and defines **atom** with the bitwise OR between the values of\n**atom** and **value**. When **stat** is present and the invocation was successful,\nit is assigned the value **0**. If it is present and the invocation has\nfailed, it is assigned a positive value; in particular, for a coindexed\n**atom**, if the remote image has stopped, it is assigned the value of\niso_fortran_env's stat_stopped_image and if the remote image has\nfailed, the value stat_failed_image.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **old**\n : Scalar of the same type and kind as **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_fetch_or\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*], old\n call atomic_fetch_or(atom[1], int(b'10100011101'), old)\nend program demo_atomic_fetch_or\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_define**(3)](#atomic_define),\n[**atomic_or**(3)](#atomic_or),\n[**iso_fortran_env**(3)](#),\n\n[**atomic_fetch_add**(3)](#atomic_fetch_add),\n[**atomic_fetch_and**(3)](#atomic_fetch_and),\n\n[**atomic_fetch_xor**(3)](#atomic_fetch_xor)\n\n _Fortran intrinsic descriptions_\n", "ATOMIC_FETCH_XOR": "## atomic_fetch_xor\n\n### **Name**\n\n**atomic_fetch_xor** - \\[ATOMIC:BIT MANIPULATION\\] Atomic bitwise XOR operation with prior fetch\n\n### **Synopsis**\n```fortran\n call atomic_fetch_xor (atom, value, old [,stat] )\n```\n```fortran\n subroutine atomic_fetch_xor (atom, value, old, stat)\n```\n### **Characteristics**\n\n### **Description**\n\n**atomic_fetch_xor** atomically stores the value of\n**atom** in **old** and defines **atom** with the bitwise **xor** between the values of\n**atom** and **value**. When **stat** is present and the invocation was successful,\nit is assigned the value **0**. If it is present and the invocation has\nfailed, it is assigned a positive value; in particular, for a coindexed\n**atom**, if the remote image has stopped, it is assigned the value of\niso_fortran_env's stat_stopped_image and if the remote image has\nfailed, the value stat_failed_image.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **old**\n : Scalar of the same type and kind as **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_fetch_xor\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*], old\n call atomic_fetch_xor (atom[1], int(b'10100011101'), old)\nend program demo_atomic_fetch_xor\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_define**(3)](#atomic_define),\n[**atomic_xor**(3)](#atomic_xor),\n[**iso_fortran_env**(3)](#),\n\n[**atomic_fetch_add**(3)](#atomic_fetch_add),\n[**atomic_fetch_and**(3)](#atomic_fetch_and),\n\n[**atomic_fetch_or**(3)](#atomic_fetch_or)\n\n _Fortran intrinsic descriptions_\n", "ATOMIC_OR": "## atomic_or\n\n### **Name**\n\n**atomic_or** - \\[ATOMIC:BIT MANIPULATION\\] Atomic bitwise OR operation\n\n### **Synopsis**\n```fortran\n call atomic_or(atom, value [,stat] )\n```\n```fortran\n subroutine atomic_or(atom,value,stat)\n\n integer(atomic_int_kind) :: atom[*]\n integer(atomic_int_kind),intent(in) :: value\n integer,intent(out),intent(out) :: stat\n```\n### **Characteristics**\n\n- **atom** is a scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value** is a scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat** is a Scalar default-kind integer variable.\n\n### **Description**\n\n**atomic_or** atomically defines **atom** with the bitwise **or**\nbetween the values of **atom** and **value**. When **stat** is present and the\ninvocation was successful, it is assigned the value **0**. If it is present\nand the invocation has failed, it is assigned a positive value; in\nparticular, for a coindexed **atom**, if the remote image has stopped, it is\nassigned the value of iso_fortran_env's stat_stopped_image and if\nthe remote image has failed, the value stat_failed_image.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_or\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*]\n call atomic_or(atom[1], int(b'10100011101'))\nend program demo_atomic_or\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_define**(3)](#atomic_define),\n[**atomic_fetch_or**(3)](#atomic_fetch),\n\n[**iso_fortran_env**(3)](#),\n[**atomic_add**(3)](#atomic_add),\n[**atomic_or**](#atomic_or),\n\n[**atomic_xor**(3)](#atomic_xor)\n\n _Fortran intrinsic descriptions_\n", "ATOMIC_REF": "## atomic_ref\n\n### **Name**\n\n**atomic_ref** - \\[ATOMIC\\] Obtaining the value of a variable atomically\n\n### **Synopsis**\n```fortran\n call atomic_ref(value, atom [,stat] )\n```\n```fortran\n subroutine atomic_ref(value,atom,stat)\n\n integer(atomic_int_kind),intent(in) :: value\n integer(atomic_int_kind) :: atom[*]\n integer,intent(out),intent(out) :: stat\n```\n### **Characteristics**\n\n- **atom** is a scalar coarray or coindexed variable of either integer\n type with atomic_int_kind kind or logical type with atomic_logical_kind\n kind.\n\n- **value** is a scalar of the same type as **atom**. If the kind is\n different, the value is converted to the kind of **atom**.\n\n- **stat** is a Scalar default-kind integer variable.\n\n### **Description**\n\n**atomic_ref** atomically assigns the value of the\nvariable **atom** to **value**. When **stat** is present and the invocation was\nsuccessful, it is assigned the value **0**. If it is present and the\ninvocation has failed, it is assigned a positive value; in particular,\nfor a coindexed **atom**, if the remote image has stopped, it is assigned\nthe value of iso_fortran_env's **stat_stopped_image** and if the remote\nimage has failed, the value **stat_failed_image**.\n\n### **Options**\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **atom**\n : Scalar coarray or coindexed variable of either integer type with\n atomic_int_kind kind or logical type with atomic_logical_kind\n kind.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_ref\nuse iso_fortran_env\nimplicit none\nlogical(atomic_logical_kind) :: atom[*]\nlogical :: val\n call atomic_ref( val, atom[1] )\n if (val) then\n print *, \"Obtained\"\n endif\nend program demo_atomic_ref\n```\n\n### **Standard**\n\nFortran 2008 ; with STAT, TS 18508\n\n### **See Also**\n\n[**atomic_define**(3)](#atomic_define),\n[**atomic_cas**(3)](#atomic_cas),\n[**iso_fortran_env**(3)](#),\n\n[**atomic_fetch_add**(3)](#atomic_add),\n[**atomic_fetch_and**(3)](#atomic_and),\n\n[**atomic_fetch_or**(3)](#atomic_or),\n[**atomic_fetch_xor**(3)](#atomic_xor)\n\n _Fortran intrinsic descriptions_\n", "ATOMIC_XOR": "## atomic_xor\n\n### **Name**\n\n**atomic_xor** - \\[ATOMIC:BIT MANIPULATION\\] Atomic bitwise OR operation\n\n### **Synopsis**\n```fortran\n call atomic_xor(atom, value [,stat] )\n```\n```fortran\n subroutine atomic_xor(atom,value,stat)\n\n integer(atomic_int_kind) :: atom[*]\n integer(atomic_int_kind),intent(in) :: value\n integer,intent(out),intent(out) :: stat\n```\n### **Characteristics**\n\n- **atom** is a scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value** is a scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat** is a Scalar default-kind integer variable.\n\n### **Characteristics**\n\n### **Description**\n\n**atomic_xor** atomically defines **atom** with the bitwise\n**xor** between the values of **atom** and **value**. When **stat** is present and the\ninvocation was successful, it is assigned the value **0**. If it is present\nand the invocation has failed, it is assigned a positive value; in\nparticular, for a coindexed **atom**, if the remote image has stopped, it is\nassigned the value of iso_fortran_env's stat_stopped_image and if\nthe remote image has failed, the value stat_failed_image.\n\n### **Options**\n\n- **atom**\n : Scalar coarray or coindexed variable of integer type with\n atomic_int_kind kind.\n\n- **value**\n : Scalar of the same type as **atom**. If the kind is different, the value\n is converted to the kind of **atom**.\n\n- **stat**\n : (optional) Scalar default-kind integer variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_atomic_xor\nuse iso_fortran_env\nimplicit none\ninteger(atomic_int_kind) :: atom[*]\n call atomic_xor(atom[1], int(b'10100011101'))\nend program demo_atomic_xor\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**atomic_define**(3)](#atomic_define),\n[**atomic_fetch_xor**(3)](#atomic_fetch),\n[**iso_fortran_env**(3)](#),\n[**atomic_add**(3)](#atomic_add),\n[**atomic_or**(3)](#atomic_or),\n[**atomic_xor**](#atomic_xor)\n\n _Fortran intrinsic descriptions_\n", "BESSEL_J0": "## bessel_j0\n\n### **Name**\n\n**bessel_j0** - \\[MATHEMATICS\\] Bessel function of the first kind of order 0\n\n### **Synopsis**\n```fortran\n result = bessel_j0(x)\n```\n```fortran\n elemental real(kind=KIND) function bessel_j0(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - KIND may be any KIND supported by the _real_ type.\n - The result is the same type and kind as **x**.\n\n### **Description**\n\n**bessel_j0** computes the Bessel function of the first kind\nof order **0** of **x**.\n\n### **Options**\n\n- **x**\n : The value to operate on.\n\n### **Result**\n\nthe Bessel function of the first kind of order **0** of **x**.\nThe result lies in the range **-0.4027 \\<= bessel(0,x) \\<= 1**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_bessel_j0\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\n implicit none\n real(kind=real64) :: x\n x = 0.0_real64\n x = bessel_j0(x)\n write(*,*)x\nend program demo_bessel_j0\n```\nResults:\n\n```text\n > 1.0000000000000000\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bessel_j1**(3)](#bessel_j1),\n[**bessel_jn**(3)](#bessel_jn),\n[**bessel_y0**(3)](#bessel_y0),\n[**bessel_y1**(3)](#bessel_y1),\n[**bessel_yn**(3)](#bessel_yn)\n\n _Fortran intrinsic descriptions_\n", "BESSEL_J1": "## bessel_j1\n\n### **Name**\n\n**bessel_j1** - \\[MATHEMATICS\\] Bessel function of the first kind of order 1\n\n### **Synopsis**\n```fortran\n result = bessel_j1(x)\n```\n```fortran\n elemental real(kind=KIND) function bessel_j1(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - KIND may be any supported _real_ KIND.\n - the result is of the same type and kind as **x**\n\n### **Description**\n\n**bessel_j1** computes the Bessel function of the first kind\nof order **1** of **x**.\n\n### **Options**\n\n- **x**\n : The type shall be _real_.\n\n### **Result**\n\nThe return value is of type _real_ and lies in the range\n**-0.5818 \\<= bessel(0,x) \\<= 0.5818** . It has the same kind as **x**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_bessel_j1\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 1.0_real64\n x = bessel_j1(x)\n write(*,*)x\nend program demo_bessel_j1\n```\nResults:\n```text\n > 0.44005058574493350\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bessel_j0**(3)](#bessel_j0),\n[**bessel_jn**(3)](#bessel_jn),\n[**bessel_y0**(3)](#bessel_y0),\n[**bessel_y1**(3)](#bessel_y1),\n[**bessel_yn**(3)](#bessel_yn)\n\n _Fortran intrinsic descriptions_\n", "BESSEL_JN": "## bessel_jn\n\n### **Name**\n\n**bessel_jn** - \\[MATHEMATICS\\] Bessel function of the first kind\n\n### **Synopsis**\n```fortran\n result = bessel_jn(n, x)\n```\n```fortran\n elemental real(kind=KIND) function bessel_jn(n,x)\n\n integer(kind=**),intent(in) :: n\n real(kind=KIND),intent(in) :: x\n```\n - KIND may be any valid value for type _real_\n - **x** is _real_\n - The return value has the same type and kind as **x**.\n\n```fortran\n result = bessel_jn(n1, n2, x)\n```\n```fortran\n real(kind=KIND) function bessel_jn(n1, n2, ,x)\n\n integer(kind=**),intent(in) :: n1\n integer(kind=**),intent(in) :: n2\n real(kind=KIND),intent(in) :: x\n```\n - **n1** is _integer_\n - **n2** is _integer_\n - **x** is _real_\n - The return value has the same type and kind as **x**.\n\n### **Description**\n\n **bessel_jn( n, x )** computes the Bessel function of the first kind of\n order **n** of **x**.\n\n **bessel_jn(n1, n2, x)** returns an array with the Bessel\n function\\|Bessel functions of the first kind of the orders **n1**\n to **n2**.\n\n### **Options**\n\n- **n**\n : a non-negative scalar integer..\n\n- **n1**\n : a non-negative scalar _integer_.\n\n- **n2**\n : a non-negative scalar _integer_.\n\n- **x**\n : Shall be a scalar for **bessel\\_jn(n,x)** or an array\n For **bessel_jn(n1, n2, x)**.\n\n### **Result**\n\n The result value of BESSEL_JN (N, X) is a processor-dependent\n approximation to the Bessel function of the first kind and order N\n of X.\n\n The result of BESSEL_JN (N1, N2, X) is a rank-one array with extent\n MAX (N2-N1+1, 0). Element i of the result value of BESSEL_JN (N1,\n N2, X) is a processor-dependent approximation to the Bessel function\n of the first kind and order N1+i-1 of X.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_bessel_jn\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 1.0_real64\n x = bessel_jn(5,x)\n write(*,*)x\nend program demo_bessel_jn\n```\nResults:\n\n```text\n > 2.4975773021123450E-004\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bessel_j0**(3)](#bessel_j0),\n[**bessel_j1**(3)](#bessel_j1),\n[**bessel_y0**(3)](#bessel_y0),\n[**bessel_y1**(3)](#bessel_y1),\n[**bessel_yn**(3)](#bessel_yn)\n\n _Fortran intrinsic descriptions_\n", "BESSEL_Y0": "## bessel_y0\n\n### **Name**\n\n**bessel_y0** - \\[MATHEMATICS\\] Bessel function of the second kind of order 0\n\n### **Synopsis**\n```fortran\n result = bessel_y0(x)\n```\n```fortran\n elemental real(kind=KIND) function bessel_y0(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - KIND may be any supported _real_ KIND.\n - the result characteristics (type, kind) are the same as **x**\n\n### **Description**\n\n**bessel_y0** computes the Bessel function of the second\nkind of order 0 of **x**.\n\n### **Options**\n\n- **x**\n : The type shall be _real_.\n Its value shall be greater than zero.\n\n### **Result**\n\nThe return value is of type _real_. It has the same kind as **x**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_bessel_y0\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\n real(kind=real64) :: x = 0.0_real64\n x = bessel_y0(x)\n write(*,*)x\nend program demo_bessel_y0\n```\nResults:\n```text\n > -Infinity\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bessel_j0**(3)](#bessel_j0),\n[**bessel_j1**(3)](#bessel_j1),\n[**bessel_jn**(3)](#bessel_jn),\n[**bessel_y1**(3)](#bessel_y1),\n[**bessel_yn**(3)](#bessel_yn)\n\n _Fortran intrinsic descriptions_\n", "BESSEL_Y1": "## bessel_y1\n\n### **Name**\n\n**bessel_y1** - \\[MATHEMATICS\\] Bessel function of the second kind of order 1\n\n### **Synopsis**\n```fortran\n result = bessel_y1(x)\n```\n```fortran\n elemental real(kind=KIND) function bessel_y1(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - KIND may be any supported _real_ KIND.\n - the characteristics (type, kind) of the result are the same as **x**\n\n### **Description**\n\n**bessel_y1** computes the Bessel function of the second\nkind of order 1 of **x**.\n\n### **Options**\n\n- **x**\n : The type shall be _real_.\n Its value shall be greater than zero.\n\n### **Result**\n\nThe return value is _real_. It has the same kind as **x**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_bessel_y1\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\n real(kind=real64) :: x = 1.0_real64\n write(*,*)x, bessel_y1(x)\nend program demo_bessel_y1\n```\nResults:\n```text\n > 1.00000000000000 -0.781212821300289\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bessel_j0**(3)](#bessel_j0),\n[**bessel_j1**(3)](#bessel_j1),\n[**bessel_jn**(3)](#bessel_jn),\n[**bessel_y0**(3)](#bessel_y0),\n[**bessel_yn**(3)](#bessel_yn)\n\n _Fortran intrinsic descriptions_\n", "BESSEL_YN": "## bessel_yn\n\n### **Name**\n\n**bessel_yn** - \\[MATHEMATICS\\] Bessel function of the second kind\n\n### **Synopsis**\n```fortran\n result = bessel_yn(n, x)\n```\n```fortran\n elemental real(kind=KIND) function bessel_yn(n,x)\n\n integer(kind=**),intent(in) :: n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n - **n** is _integer_\n - **x** is _real_\n - The return value has the same type and kind as **x**.\n\n```fortran\n result = bessel_yn(n1, n2, x)\n```\n```fortran\n real(kind=KIND) function bessel_yn(n1, n2, ,x)\n\n integer(kind=**),intent(in) :: n1\n integer(kind=**),intent(in) :: n2\n real(kind=KIND),intent(in) :: x\n```\n - **n1** is _integer_\n - **n2** is _integer_\n - **x** is _real_\n - The return value has the same type and kind as **x**.\n\n### **Description**\n\n **bessel_yn(n, x)** computes the Bessel function of the second kind\n of order **n** of **x**.\n\n **bessel_yn(n1, n2, x)** returns an array with the Bessel\n function\\|Bessel functions of the first kind of the orders **n1**\n to **n2**.\n\n### **Options**\n\n- **n**\n : Shall be a scalar or an array of type _integer_ and non-negative.\n\n- **n1**\n : Shall be a non-negative scalar of type _integer_ and non-negative.\n\n- **n2**\n : Shall be a non-negative scalar of type _integer_ and non-negative.\n\n- **x**\n : A _real_ non-negative value. Note **bessel_yn(n1, n2, x)** is not\n elemental, in which case it must be a scalar.\n\n### **Result**\n\n The result value of BESSEL_YN (N, X) is a processor-dependent\n approximation to the Bessel function of the second kind and order N\n of X.\n\n The result of **BESSEL_YN (N1, N2, X)** is a rank-one array with extent\n **MAX (N2-N1+1, 0)**. Element i of the result value of BESSEL_YN\n (N1, N2, X) is a processor-dependent approximation to the Bessel\n function of the second kind and order N1+i-1 of X.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_bessel_yn\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 1.0_real64\n write(*,*) x,bessel_yn(5,x)\nend program demo_bessel_yn\n```\nResults:\n\n```text\n > 1.0000000000000000 -260.40586662581222\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bessel_j0**(3)](#bessel_j0),\n[**bessel_j1**(3)](#bessel_j1),\n[**bessel_jn**(3)](#bessel_jn),\n[**bessel_y0**(3)](#bessel_y0),\n[**bessel_y1**(3)](#bessel_y1)\n\n _Fortran intrinsic descriptions_\n", "BGE": "## bge\n\n### **Name**\n\n**bge** - \\[BIT:COMPARE\\] Bitwise greater than or equal to\n\n### **Synopsis**\n```fortran\n result = bge(i,j)\n```\n```fortran\n elemental logical function bge(i, j)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: j\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n\n - the _integer_ _kind_ of **i** and **j** may not necessarily be\n the same. In addition, values may be a BOZ constant with a value\n valid for the _integer_ kind available with the most bits on the\n current platform.\n\n - The return value is of type default _logical_.\n\n### **Description**\n\n **bge** Determines whether one _integer_ is bitwise greater than\n or equal to another.\n\n The bit-level representation of a value is platform dependent. The\n endian-ness of a system and whether the system uses a \"two's complement\"\n representation of signs can affect the results, for example.\n\n A BOZ constant (Binary, Octal, Hexadecimal) does not have a _kind_\n or _type_ of its own, so be aware it is subject to truncation when\n transferred to an _integer_ type. The most bits the constant may\n contain is limited by the most bits representable by any _integer_\n kind supported by the compilation.\n\n#### Bit Sequence Comparison\n\n When bit sequences of unequal length are compared, the shorter sequence\n is padded with zero bits on the left to the same length as the longer\n sequence (up to the largest number of bits any available _integer_ kind\n supports).\n\n Bit sequences are compared from left to right, one bit at a time,\n until unequal bits are found or until all bits have been compared and\n found to be equal.\n\n The bits are always evaluated in this order, not necessarily from MSB\n to LSB (most significant bit to least significant bit).\n\n If unequal bits are found the sequence with zero in the unequal\n position is considered to be less than the sequence with one in the\n unequal position.\n\n### **Options**\n\n- **i**\n : The value to test if >= **j** based on the bit representation\n of the values.\n\n- **j**\n : The value to test **i** against.\n\n### **Result**\n\n Returns _.true._ if **i** is bit-wise greater than **j** and _.false._\n otherwise.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_bge\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i\ninteger(kind=int8) :: byte\ninteger(kind=int8),allocatable :: arr1(:), arr2(:)\n\n ! BASIC USAGE\n write(*,*)'bge(-127,127)=',bge( -127, 127 )\n ! on (very common) \"two's complement\" machines that are\n ! little-endian -127 will be greater than 127\n\n ! BOZ constants\n ! BOZ constants are subject to truncation, so make sure\n ! your values are valid for the integer kind being compared to\n write(*,*)'bge(b\"0001\",2)=',bge( b\"1\", 2)\n\n ! ELEMENTAL\n ! an array and scalar\n write(*, *)'compare array of values [-128, -0, +0, 127] to 127'\n write(*, *)bge(int([-128, -0, +0, 127], kind=int8), 127_int8)\n\n ! two arrays\n write(*, *)'compare two arrays'\n arr1=int( [ -127, -0, +0, 127], kind=int8 )\n arr2=int( [ 127, 0, 0, -127], kind=int8 )\n write(*,*)'arr1=',arr1\n write(*,*)'arr2=',arr2\n write(*, *)'bge(arr1,arr2)=',bge( arr1, arr2 )\n\n ! SHOW TESTS AND BITS\n ! actually looking at the bit patterns should clarify what affect\n ! signs have ...\n write(*,*)'Compare some one-byte values to 64.'\n write(*,*)'Notice that the values are tested as bits not as integers'\n write(*,*)'so the results are as if values are unsigned integers.'\n do i=-128,127,32\n byte=i\n write(*,'(sp,i0.4,*(1x,1l,1x,b0.8))')i,bge(byte,64_int8),byte\n enddo\n\n ! SIGNED ZERO\n ! are +0 and -0 the same on your platform? When comparing at the\n ! bit level this is important\n write(*,'(\"plus zero=\",b0)') +0\n write(*,'(\"minus zero=\",b0)') -0\n\nend program demo_bge\n```\nResults:\n\n How an integer value is represented at the bit level can vary. These\n are just the values expected on Today's most common platforms ...\n\n```text\n > bge(-127,127)= T\n > bge(b\"0001\",2)= F\n > compare array of values [-128, -0, +0, 127] to 127\n > T F F T\n > compare two arrays\n > arr1= -127 0 0 127\n > arr2= 127 0 0 -127\n > bge(arr1,arr2)= T T T F\n > Compare some one-byte values to 64.\n > Notice that the values are tested as bits not as integers\n > so the results are as if values are unsigned integers.\n > -0128 T 10000000\n > -0096 T 10100000\n > -0064 T 11000000\n > -0032 T 11100000\n > +0000 F 00000000\n > +0032 F 00100000\n > +0064 T 01000000\n > +0096 T 01100000\n > plus zero=0\n > minus zero=0\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bgt**(3)](#bgt),\n[**ble**(3)](#ble),\n[**blt**(3)](#blt)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "BGT": "## bgt\n\n### **Name**\n\n**bgt** - \\[BIT:COMPARE\\] Bitwise greater than\n\n### **Synopsis**\n```fortran\n result = bgt(i, j)\n```\n```fortran\n elemental logical function bgt(i, j)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: j\n```\n### **Characteristics**\n\n - **i** is an _integer_ or a boz-literal-constant.\n - **j** is an _integer_ or a boz-literal-constant.\n - a kind designated as ** may be any supported kind for the type\n The _integer_ _kind_ of **i** and **j** may not necessarily be the same.\n kind. In addition, values may be a BOZ constant with a value valid\n for the _integer_ kind available with the most bits on the current\n platform.\n - The return value is of type _logical_ and of the default kind.\n\n### **Description**\n\n **bgt** determines whether an integer is bitwise greater than another.\n Bit-level representations of values are platform-dependent.\n\n### **Options**\n\n- **i**\n : reference value to compare against\n\n- **j**\n : value to compare to **i**\n\n### **Result**\n\n The return value is of type _logical_ and of the default kind. The\n result is true if the sequence of bits represented by _i_ is greater\n than the sequence of bits represented by _j_, otherwise the result\n is false.\n\n Bits are compared from right to left.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_bgt\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i\ninteger(kind=int8) :: byte\n ! Compare some one-byte values to 64.\n ! Notice that the values are tested as bits not as integers\n ! so sign bits in the integer are treated just like any other\n write(*,'(a)') 'we will compare other values to 64'\n i=64\n byte=i\n write(*,'(sp,i0.4,*(1x,1l,1x,b0.8))')i,bgt(byte,64_int8),byte\n\n write(*,'(a)') \"comparing at the bit level, not as whole numbers.\"\n write(*,'(a)') \"so pay particular attention to the negative\"\n write(*,'(a)') \"values on this two's complement platform ...\"\n do i=-128,127,32\n byte=i\n write(*,'(sp,i0.4,*(1x,1l,1x,b0.8))')i,bgt(byte,64_int8),byte\n enddo\n\n ! see the BGE() description for an extended description\n ! of related information\n\nend program demo_bgt\n```\nResults:\n```text\n > we will compare other values to 64\n > +0064 F 01000000\n > comparing at the bit level, not as whole numbers.\n > so pay particular attention to the negative\n > values on this two's complement platform ...\n > -0128 T 10000000\n > -0096 T 10100000\n > -0064 T 11000000\n > -0032 T 11100000\n > +0000 F 00000000\n > +0032 F 00100000\n > +0064 F 01000000\n > +0096 T 01100000\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bge**(3)](#bge),\n[**ble**(3)](#ble),\n[**blt**(3)](#blt)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "BIT_SIZE": "## bit_size\n\n### **Name**\n\n**bit_size** - \\[BIT:INQUIRY\\] Bit size inquiry function\n\n### **Synopsis**\n```fortran\n result = bit_size(i)\n```\n```fortran\n integer(kind=KIND) function bit_size(i)\n\n integer(kind=KIND),intent(in) :: i(..)\n```\n### **Characteristics**\n\n - **i** shall be of type integer. It may be a scalar or an array.\n - the value of **KIND** is any valid value for an _integer_ kind\n parameter on the processor.\n - the return value is a scalar of the same kind as the input value.\n\n### **Description**\n\n **bit_size** returns the number of bits (integer precision plus\n sign bit) represented by the type of the _integer_ **i**.\n\n### **Options**\n\n- **i**\n : An _integer_ value of any kind whose size in bits is to be determined.\n Because only the type of the argument is examined, the argument need not\n be defined; **i** can be a scalar or an array, but a scalar representing\n just a single element is always returned.\n\n### **Result**\n\nThe number of bits used to represent a value of the type and kind\nof _i_. The result is a _integer_ scalar of the same kind as _i_.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_bit_size\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nuse,intrinsic :: iso_fortran_env, only : integer_kinds\nimplicit none\ncharacter(len=*),parameter :: fmt=&\n& '(a,\": bit size is \",i3,\" which is kind=\",i3,\" on this platform\")'\n\n ! default integer bit size on this platform\n write(*,fmt) \"default\", bit_size(0), kind(0)\n\n write(*,fmt) \"int8 \", bit_size(0_int8), kind(0_int8)\n write(*,fmt) \"int16 \", bit_size(0_int16), kind(0_int16)\n write(*,fmt) \"int32 \", bit_size(0_int32), kind(0_int32)\n write(*,fmt) \"int64 \", bit_size(0_int64), kind(0_int64)\n\n write(*,'(a,*(i0:,\", \"))') \"The available kinds are \",integer_kinds\n\nend program demo_bit_size\n```\nTypical Results:\n```text\n > default: bit size is 32 which is kind= 4 on this platform\n > int8 : bit size is 8 which is kind= 1 on this platform\n > int16 : bit size is 16 which is kind= 2 on this platform\n > int32 : bit size is 32 which is kind= 4 on this platform\n > int64 : bit size is 64 which is kind= 8 on this platform\n > The available kinds are 1, 2, 4, 8, 16\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n+ [**btest**(3)](#btest) - Tests a bit of an _integer_ value.\n+ [**storage_size**(3)](#storage) - Storage size in bits\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "BLE": "## ble\n\n### **Name**\n\n**ble** - \\[BIT:COMPARE\\] Bitwise less than or equal to\n\n### **Synopsis**\n```fortran\n result = ble(i,j)\n```\n```fortran\n elemental logical function ble(i, j)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: j\n```\n### **Characteristics**\n\n - **i** and **j** may be of any supported _integer_ kind, not\n necessarily the same. An exception is that values may be a\n BOZ constant with a value valid for the _integer_ kind available with\n the most bits on the current platform.\n - the returned value is a logical scalar of default kind\n\n### **Description**\n\n **ble** determines whether an integer is bitwise less than or\n equal to another, assuming any shorter value is padded on the left\n with zeros to the length of the longer value.\n\n### **Options**\n\n- **i**\n : the value to compare **j** to\n\n- **j**\n : the value to be tested for being less than or equal to **i**\n\n### **Result**\n\nThe return value is _.true._ if any bit in **j** is less than any bit\nin **i** starting with the rightmost bit and continuing tests leftward.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ble\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i\ninteger(kind=int8) :: byte\n ! Compare some one-byte values to 64.\n ! Notice that the values are tested as bits not as integers\n ! so sign bits in the integer are treated just like any other\n do i=-128,127,32\n byte=i\n write(*,'(sp,i0.4,*(1x,1l,1x,b0.8))')i,ble(byte,64_int8),byte\n write(*,'(sp,i0.4,*(4x,b0.8))')64_int8,64_int8\n enddo\n\n ! see the BGE() description for an extended description\n ! of related information\n\nend program demo_ble\n```\nResults:\n```text\n > -0128 F 10000000\n > +0064 01000000\n > -0096 F 10100000\n > +0064 01000000\n > -0064 F 11000000\n > +0064 01000000\n > -0032 F 11100000\n > +0064 01000000\n > +0000 T 00000000\n > +0064 01000000\n > +0032 T 00100000\n > +0064 01000000\n > +0064 T 01000000\n > +0064 01000000\n > +0096 F 01100000\n > +0064 01000000\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bge**(3)](#bge),\n[**bgt**(3)](#bgt),\n[**blt**(3)](#blt)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "BLT": "## blt\n\n### **Name**\n\n**blt** - \\[BIT:COMPARE\\] Bitwise less than\n\n### **Synopsis**\n```fortran\n result = blt(i,j)\n```\n```fortran\n elemental logical function blt(i, j)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: j\n```\n### **Characteristics**\n\n - **i** is an _integer_ of any kind or a BOZ-literal-constant\n - **j** is an _integer_ of any kind or a BOZ-literal-constant, not\n necessarily the same as **i**.\n - the result is of default logical kind\n\n BOZ constants must have a value valid for the _integer_ kind available\n with the most bits on the current platform.\n\n### **Description**\n\n **blt** determines whether an _integer_ is bitwise less than another.\n\n\n### **Options**\n\n- **i**\n : Shall be of _integer_ type or a BOZ literal constant.\n\n- **j**\n : Shall be of _integer_ type or a BOZ constant.\n\n### **Result**\n\nThe return value is of type _logical_ and of the default kind.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_blt\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i\ninteger(kind=int8) :: byte\n ! Compare some one-byte values to 64.\n ! Notice that the values are tested as bits not as integers\n ! so sign bits in the integer are treated just like any other\n do i=-128,127,32\n byte=i\n write(*,'(sp,i0.4,*(1x,1l,1x,b0.8))')i,blt(byte,64_int8),byte\n enddo\n ! BOZ literals\n write(*,*)blt(z'1000', z'101011010')\n ! see the BGE() description for an extended description\n ! of related information\n\nend program demo_blt\n```\nResults:\n```text\n > -0128 F 10000000\n > -0096 F 10100000\n > -0064 F 11000000\n > -0032 F 11100000\n > +0000 T 00000000\n > +0032 T 00100000\n > +0064 F 01000000\n > +0096 F 01100000\n > T\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bge**(3)](#bge),\n[**bgt**(3)](#bgt),\n[**ble**(3)](#ble)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "BTEST": "## btest\n\n### **Name**\n\n**btest** - \\[BIT:INQUIRY\\] Tests a bit of an _integer_ value.\n\n### **Synopsis**\n```fortran\n result = btest(i,pos)\n```\n```fortran\n elemental logical function btest(i,pos)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n```\n### **Characteristics**\n\n - **i** is an _integer_ of any kind\n - **pos** is a _integer_ of any kind\n - the result is a default logical\n\n### **Description**\n\n **btest** returns logical _.true._ if the bit at **pos** in **i** is\n set to 1. Position zero is the right-most bit. Bit position increases\n from right to left up to **bitsize(i)-1**.\n\n### **Options**\n\n- **i**\n : The _integer_ containing the bit to be tested\n\n- **pos**\n : The position of the bit to query. it must be a valid position for the\n value **i**; ie. **0 <= pos <= bit_size(i)**.\n\n### **Result**\n\n The result is a _logical_ that has the value _.true._ if bit position\n **pos** of **i** has the value **1** and the value _.false._ if bit\n **pos** of **i** has the value **0**.\n\n Positions of bits in the sequence are numbered from right to left,\n with the position of the rightmost bit being zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_btest\nimplicit none\ninteger :: i, j, pos, a(2,2)\nlogical :: bool\ncharacter(len=*),parameter :: g='(*(g0))'\n\n i = 32768 + 1024 + 64\n write(*,'(a,i0,\"=>\",b32.32,/)')'Looking at the integer: ',i\n\n ! looking one bit at a time from LOW BIT TO HIGH BIT\n write(*,g)'from bit 0 to bit ',bit_size(i),'==>'\n do pos=0,bit_size(i)-1\n bool = btest(i, pos)\n write(*,'(l1)',advance='no')bool\n enddo\n write(*,*)\n\n ! a binary format the hard way.\n ! Note going from bit_size(i) to zero.\n write(*,*)\n write(*,g)'so for ',i,' with a bit size of ',bit_size(i)\n write(*,'(b32.32)')i\n write(*,g)merge('^','_',[(btest(i,j),j=bit_size(i)-1,0,-1)])\n write(*,*)\n write(*,g)'and for ',-i,' with a bit size of ',bit_size(i)\n write(*,'(b32.32)')-i\n write(*,g)merge('^','_',[(btest(-i,j),j=bit_size(i)-1,0,-1)])\n\n ! elemental:\n !\n a(1,:)=[ 1, 2 ]\n a(2,:)=[ 3, 4 ]\n write(*,*)\n write(*,'(a,/,*(i2,1x,i2,/))')'given the array a ...',a\n ! the second bit of all the values in a\n write(*,'(a,/,*(l2,1x,l2,/))')'the value of btest (a, 2)',btest(a,2)\n ! bits 1,2,3,4 of the value 2\n write(*,'(a,/,*(l2,1x,l2,/))')'the value of btest (2, a)',btest(2,a)\nend program demo_btest\n```\nResults:\n```text\n > Looking at the integer: 33856=>11111111111111110111101111000000\n >\n > 00000000000000001000010001000000\n > 11111111111111110111101111000000\n > 1000010001000000\n > 11111111111111110111101111000000\n > from bit 0 to bit 32==>\n > FFFFFFTFFFTFFFFTFFFFFFFFFFFFFFFF\n >\n > so for 33856 with a bit size of 32\n > 00000000000000001000010001000000\n > ________________^____^___^______\n >\n > and for -33856 with a bit size of 32\n > 11111111111111110111101111000000\n > ^^^^^^^^^^^^^^^^_^^^^_^^^^______\n >\n > given the array a ...\n > 1 3\n > 2 4\n >\n > the value of btest (a, 2)\n > F F\n > F T\n >\n > the value of btest (2, a)\n > T F\n > F F\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**iand**(3)](#iand),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "CEILING": "## ceiling\n\n### **Name**\n\n**ceiling** - \\[NUMERIC\\] returns the least integer greater than or\nequal to **a**.\n\n### **Synopsis**\n```fortran\n result = ceiling(a [,kind])\n```\n```fortran\n elemental integer(KIND) function ceiling(a,KIND)\n\n real(kind=**),intent(in) :: a\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - **a** is of type _real_\n - if present **KIND** is a scalar integer constant expression that\n specifies the kind of the result.\n - the result is _integer_. It is default kind if **KIND** is not\n specified\n\n### **Description**\n\n **ceiling** returns the least integer greater than or equal to **a**.\n\n On the number line -n <-- 0 -> +n the value returned is always at or\n to the right of the input value.\n\n For example, ceil(0.5) is 1.0, and ceil(-0.5) is 0.0.\n\n The input value may be too large to store the result in an `integer`\n type. To avoid an overflow (which produces an undefined result), an\n application should perform a range check on the input value before\n using ceiling(3).\n\n\n### **Options**\n\n- **a**\n : A _real_ value to produce a ceiling for.\n\n- **kind**\n : indicates the kind parameter of the result.\n\n### **Result**\n\n The result will be the _integer_ value equal to **a** or the least\n integer greater than **a** if the input value is not equal to a\n whole number.\n\n If **a** is equal to a whole number, the returned value is **int(a)**.\n\n The result is undefined if it cannot be represented in the specified\n _integer_ type.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_ceiling\nimplicit none\n! just a convenient format for a list of integers\ncharacter(len=*),parameter :: gen='(1x,*(g0:,1x))'\nreal :: x\nreal :: y\ninteger :: ierr\nreal,parameter :: arr(*)=[ &\n & -2.7, -2.5, -2.2, -2.0, -1.5, &\n & -1.0, -0.5, 0.0, +0.5, +1.0, &\n & +1.5, +2.0, +2.2, +2.5, +2.7 ]\ncharacter(len=80) :: message\n print *, 'Basic Usage'\n x = 63.29\n y = -63.59\n print gen, ceiling(x), ceiling(y)\n ! note the result was the next integer larger to the right\n\n print *, 'Whole Numbers' ! real values equal to whole numbers\n x = 63.0\n y = -63.0\n print gen, ceiling(x), ceiling(y)\n\n print *, 'Elemental' ! (so an array argument is allowed)\n print gen , ceiling(arr)\n\n print *, 'Advanced Usage' ! Dealing with large magnitude values\n print '(a)',[character(len=80):: &\n 'Limits ',&\n 'You only care about Limits if you are using values near or above ',&\n 'the limits of the integer type you are using (see huge(3)). ',&\n '',&\n 'Surprised by some of the following results? ',&\n 'What do real values clearly out of the range of integers return? ',&\n 'What do values near the end of the range of integers return? ',&\n 'The standard only specifies what happens for representable values',&\n 'in the range of integer values. ',&\n '',&\n 'It is common but not required that if the input is out of range ',&\n 'and positive the result is -huge(0) and -huge(0)-1 if negative. ',&\n 'Note you are out of range before you get to real(huge(0)). ',&\n '' ]\n print gen , 'For reference: huge(0)=',huge(0),'-huge(0)-1=',-huge(0)-1\n\n x=huge(0)\n call displayx()\n\n x=2*x\n call displayx()\n\n x=-huge(0)-1\n call displayx()\n\n x=2*x\n call displayx()\n\n print gen , repeat('=',80)\n\ncontains\n\nsubroutine displayx()\nuse,intrinsic :: iso_fortran_env, only: int8,int16,int32,int64\n print gen , repeat('=',80)\n print gen , 'x=',x,' spacing=',spacing(x)\n print gen , ' ceiling(x):',ceiling(x)\n print gen , ' ceiling(x,kind=int64):',ceiling(x,kind=int64)\n print gen , ' ceiling_robust(x):',ceiling_robust(x,ierr,message)\n if(ierr.ne.0)then\n print gen, ierr,'=>',trim(message)\n endif\nend subroutine displayx\n\nelemental impure function ceiling_robust(x,ierr,message)\n! return the least integer >= x\nuse,intrinsic :: iso_fortran_env, only: int8,int16,int32,int64\nuse,intrinsic :: iso_fortran_env, only: real32,real64,real128\nreal,intent(in) :: x\ninteger,intent(out),optional :: ierr\ncharacter(len=*),intent(out),optional :: message\ncharacter(len=80) :: message_local\ninteger :: ceiling_robust\ninteger :: ierr_local\n ierr_local=0\n message_local=''\n ! allow -huge(0)-1 or not?\n if(spacing(x) > 128)then ! bounds checking\n if(x.ge.0)then\n write(message_local,*)'X=',x,' >=',anint(real(huge(0)))\n ierr_local=1\n ceiling_robust=huge(0)\n else\n ierr_local=2\n ceiling_robust=-huge(0)-1\n write(message_local,*)'X=',x,' <=',anint(real(-huge(0)-1))\n endif\n else\n ! used to use a computed goto to do this!\n ceiling_robust = int(x)\n if (x > 0.0) then\n if (real(ceiling_robust) < x)then\n ceiling_robust = ceiling_robust + 1\n endif\n endif\n endif\n if(present(ierr))then\n ierr=ierr_local\n elseif(ierr_local.ne.0)then\n stop message_local\n endif\n if(present(message))then\n message=message_local\n endif\nend function ceiling_robust\n\nend program demo_ceiling\n```\nResults:\n```text\n > Basic Usage\n > 64 -63\n > Whole Numbers\n > 63 -63\n > Elemental\n > -2 -2 -2 -2 -1 -1 0 0 1 1 2 2 3 3 3\n > Limits\n >\n > Surprised by some of the following results?\n > What do real values clearly out of the range of integers return?\n > What do values near the end of the range of integers return?\n > The standard only specifies what happens for representable values\n > in the range of integer values.\n >\n > It is common but not required that if the input is out of range\n > and positive the result is -huge(0) and -huge(0)-1 if negative.\n > Note you are out of range before you get to real(huge(0)).\n >\n > For reference: huge(0)= 2147483647 -huge(0)-1= -2147483648\n > ======================================================================\n > x= 0.214748365E+10 spacing= 256.000000\n > ceiling(x): -2147483647\n > ceiling(x,kind=int64): 2147483648\n > ceiling_robust(x): 2147483647\n > 1 => X= 2.14748365E+09 >= 2.14748365E+09\n > ======================================================================\n > x= 0.429496730E+10 spacing= 512.000000\n > ceiling(x): -2147483647\n > ceiling(x,kind=int64): 4294967296\n > ceiling_robust(x): 2147483647\n > 1 => X= 4.29496730E+09 >= 2.14748365E+09\n > ======================================================================\n > x= -0.214748365E+10 spacing= 256.000000\n > ceiling(x): -2147483648\n > ceiling(x,kind=int64): -2147483648\n > ceiling_robust(x): -2147483648\n > 2 => X= -2.14748365E+09 <= -2.14748365E+09\n > ======================================================================\n > x= -0.429496730E+10 spacing= 512.000000\n > ceiling(x): -2147483648\n > ceiling(x,kind=int64): -4294967296\n > ceiling_robust(x): -2147483648\n > 2 => X= -4.29496730E+09 <= -2.14748365E+09\n > ======================================================================\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**floor**(3)](#floor),\n[**nint**(3)](#nint)\n\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**selected_int_kind**(3)](#selected_int_kind)\n\n[**nearest**(3)](#nearest),\n[**spacing**(3)](#spacing),\n[**epsilon**(3)](#epsilon)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "CHAR": "## char\n\n### **Name**\n\n**char** - \\[CHARACTER:CONVERSION\\] Generate a character from a\ncode value\n\n### **Synopsis**\n```fortran\n result = char(i [,kind])\n```\n```fortran\n elemental character(kind=KIND) function char(i,KIND)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n - a kind designated as ** may be any supported kind for the type\n - **i** is an _integer_ of any kind\n - **KIND** is an _integer_ initialization expression indicating the kind\n parameter of the result.\n - The returned value is a character with the kind specified by **kind**\n or if **kind** is not present, the default _character_ kind.\n\n### **Description**\n Generates a _character_ value given a numeric code representing the\n position **i** in the collating sequence associated with the specified\n kind **kind**.\n\n Note that **achar**(3) is a similar function specifically for ASCII\n characters that is preferred when only ASCII is being processed,\n which is equivalent to **char(i,kind=selected_char_kind(\"ascii\") )**\n\n The **ichar**(3) function is the reverse of **char**, converting\n characters to their collating sequence value.\n\n\n\n### **Options**\n- **i**\n : a value in the range **0 <= I <= n-1**, where **n** is the number of characters\n in the collating sequence associated with the specified kind type parameter.\n : For ASCII, **n** is 127. The default character set may or may not allow higher\n values.\n\n- **kind**\n : A constant _integer_ initialization expression indicating the kind\n parameter of the result. If not present, the default kind is assumed.\n\n### **Result**\nThe return value is a single _character_ of the specified kind, determined by the\nposition of **i** in the collating sequence associated with the specified **kind**.\n\n### **Examples**\n Sample program:\n```fortran\nprogram demo_char\nimplicit none\ninteger, parameter :: ascii = selected_char_kind (\"ascii\")\ncharacter(len=1, kind=ascii ) :: c, esc\ninteger :: i\n ! basic\n i=74\n c=char(i)\n write(*,*)'ASCII character ',i,'is ',c\n write(*,'(*(g0))')'Uppercase ASCII: ',(char(i),i=65,90)\n write(*,'(*(g0))')'lowercase ASCII: ',(char(i),i=97,122)\n esc=char(27)\n write(*,'(*(g0))')'Elemental: ',char([65,97,90,122])\n !\n print *, 'a selection of ASCII characters (shows hex if not printable)'\n do i=0,127,10\n c = char(i,kind=ascii)\n select case(i)\n case(32:126)\n write(*,'(i3,1x,a)')i,c\n case(0:31,127)\n ! print hexadecimal value for unprintable characters\n write(*,'(i3,1x,z2.2)')i,c\n case default\n write(*,'(i3,1x,a,1x,a)')i,c,'non-standard ASCII'\n end select\n enddo\n\nend program demo_char\n```\nResults:\n```text\n > ASCII character 74 is J\n > Uppercase ASCII: ABCDEFGHIJKLMNOPQRSTUVWXYZ\n > lowercase ASCII: abcdefghijklmnopqrstuvwxyz\n > Elemental: AaZz\n > a selection of ASCII characters (shows hex if not printable)\n > 0 00\n > 10 0A\n > 20 14\n > 30 1E\n > 40 (\n > 50 2\n > 60 <\n > 70 F\n > 80 P\n > 90 Z\n > 100 d\n > 110 n\n > 120 x\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**achar**(3)](#achar),\n[**iachar**(3)](#iachar),\n[**ichar**(3)](#ichar)\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl), [**adjustr**(3)](#adjustr), [**index**(3)](#index),\n [**scan**(3)](#scan), [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat), [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "CMPLX": "## cmplx\n\n### **Name**\n\n**cmplx** - \\[TYPE:CONVERSION\\] Conversion to a complex type\n\n### **Synopsis**\n```fortran\n result = cmplx(x [,kind]) | cmplx(x [,y] [,kind])\n```\n```fortran\n elemental complex(kind=KIND) function cmplx( x, y, kind )\n\n type(TYPE(kind=**)),intent(in) :: x\n type(TYPE(kind=**)),intent(in),optional :: y\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- **x** may be _integer_, _real_, or _complex_.\n- **y** may be _integer_ or _real_.\n **y** is allowed only if **x** is not _complex_.\n- **KIND** is a constant _integer_ initialization expression indicating the kind\n parameter of the result.\n\nThe type of the arguments does not affect the kind of the result except\nfor a _complex_ **x** value.\n\n- if **kind** is not present and **x** is _complex_ the result is of the kind\n of **x**.\n\n- if **kind** is not present and **x** is not _complex_ the result if of default\n _complex_ kind.\n\nNOTE: a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\nThe **cmplx** function converts numeric values to a _complex_ value.\n\nEven though constants can be used to define a complex variable using syntax like\n```fortran\n z = (1.23456789, 9.87654321)\n```\nthis will not work for variables. So you cannot enter\n```fortran\n z = (a, b) ! NO ! (unless a and b are constants, not variables)\n```\nso to construct a _complex_ value using non-complex values you must use\nthe **cmplx** function:\n```fortran\n z = cmplx(a, b)\n```\nor assign values separately to the imaginary and real components using\nthe **%IM** and **%RE** designators:\n```fortran\n z%re = a\n z%im = b\n```\nIf **x** is complex **y** is not allowed and **cmplx** essentially\nreturns the input value except for an optional change of kind, which can be\nuseful when passing a value to a procedure that requires the arguments\nto have a different kind (and does not return an altered value):\n```fortran\n call something(cmplx(z,kind=real64))\n```\nwould pass a copy of a value with kind=real64 even if z had a different kind\n\nbut otherwise is equivalent to a simple assign. So if z1 and z2 were _complex_:\n```fortran\n z2 = z1 ! equivalent statements\n z2 = cmplx(z1)\n```\nIf **x** is not _complex_ **x** is only used to define the real component\nof the result but **y** is still optional -- the imaginary part of the\nresult will just be assigned a value of zero.\n\nIf **y** is present it is converted to the imaginary component.\n\n#### **cmplx(3) and double precision**\n\nPrimarily in order to maintain upward compatibility you need to be careful\nwhen working with complex values of higher precision that the default.\n\nIt was necessary for Fortran to continue to specify that **cmplx**\nalways return a result of the default kind if the **kind** option\nis absent, since that is the behavior mandated by FORTRAN 77.\n\nIt might have been preferable to use the highest precision of the\narguments for determining the return kind, but that is not the case. So\nwith arguments with greater precision than default values you are\nrequired to use the **kind** argument or the greater precision values\nwill be reduced to default precision.\n\nThis means **cmplx(d1,d2)**, where **d1** and **d2** are\n_doubleprecision_, is treated as:\n```fortran\n cmplx(sngl(d1), sngl(d2))\n```\nwhich looses precision.\n\nSo Fortran 90 extends the **cmplx** intrinsic by adding an extra\nargument used to specify the desired kind of the complex result.\n\n```fortran\n integer,parameter :: dp=kind(0.0d0)\n complex(kind=dp) :: z8\n ! wrong ways to specify constant values\n ! note this was stored with default real precision !\n z8 = cmplx(1.2345678901234567d0, 1.2345678901234567d0)\n print *, 'NO, Z8=',z8,real(z8),aimag(z8)\n\n z8 = cmplx(1.2345678901234567e0_dp, 1.2345678901234567e0_dp)\n ! again, note output components are just real\n print *, 'NO, Z8=',z8,real(z8),aimag(z8)\n !\n ! YES\n !\n ! kind= makes it work\n z8 = cmplx(1.2345678901234567d0, 1.2345678901234567d0,kind=dp)\n print *, 'YES, Z8=',z8,real(z8),aimag(z8)\n```\nA more recent alternative to using **cmplx** is \"F2018 component\nsyntax\" where real and imaginary parts of a complex entity can be\naccessed independently:\n\n```fortran\nvalue%RE ! %RE specifies the real part\nor\nvalue%IM ! %IM specifies the imaginary part\n\n```\nWhere the designator value is of course of complex type.\n\nThe type of a complex-part-designator is _real_, and its kind and shape\nare those of the designator. That is, you retain the precision of the\ncomplex value by default, unlike with **cmplx**.\n\nThe following are examples of complex part designators:\n\n```fortran\n impedance%re !-- Same value as real(impedance)\n fft%im !-- Same value as AIMAG(fft)\n x%im = 0.0 !-- Sets the imaginary part of x to zero\n x(1:2)%re=[10,20] !-- even if x is an array\n```\n\n#### NOTE for I/O\n Note that if format statements are specified a complex value is\n treated as two real values.\n\n For list-directed I/O (ie. using an asterisk for a format) and NAMELIST\n output the values are expected to be delimited by \"(\" and \")\" and of\n the form \"(real_part,imaginary_part)\". For NAMELIST input parenthesized\n values or lists of multiple _real_ values are acceptable.\n\n### **Options**\n\n- **x**\n : The value assigned to the _real_ component of the result when **x** is\n not complex.\n\n If **x** is complex, the result is the same as if the real part of the\n input was passed as **x** and the imaginary part as **y**.\n```fortran\n result = CMPLX (REAL (X), AIMAG (X), KIND).\n```\n That is, a complex **x** value is copied to the result value with a\n possible change of kind.\n\n- **y**\n : **y** is only allowed if **x** is not _complex_. Its value\n is assigned to the imaginary component of the result and defaults\n to a value of zero if absent.\n\n- **kind**\n : An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\nThe return value is of _complex_ type, with magnitudes determined by the\nvalues **x** and **y**.\n\nThe common case when **x** is not complex is that the real\ncomponent of the result is assigned the value of **x** and the imaginary\npart is zero or the value of **y** if **y** is present.\n\nWhen **x** is complex **y** is not allowed and the result is the same\nvalue as **x** with a possible change of kind. That is, the real part\nis **real(x, kind)** and the imaginary part is **real(y, kind)**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_aimag\nimplicit none\ninteger,parameter :: dp=kind(0.0d0)\nreal(kind=dp) :: precise\ncomplex(kind=dp) :: z8\ncomplex :: z4, zthree(3)\n precise=1.2345678901234567d0\n\n ! basic\n z4 = cmplx(-3)\n print *, 'Z4=',z4\n z4 = cmplx(1.23456789, 1.23456789)\n print *, 'Z4=',z4\n ! with a format treat a complex as two real values\n print '(1x,g0,1x,g0,1x,g0)','Z4=',z4\n\n ! working with higher precision values\n ! using kind=dp makes it keep DOUBLEPRECISION precision\n ! otherwise the result would be of default kind\n z8 = cmplx(precise, -precise )\n print *, 'lost precision Z8=',z8\n z8 = cmplx(precise, -precise ,kind=dp)\n print *, 'kept precision Z8=',z8\n\n ! assignment of constant values does not require cmplx(3)00\n ! The following is intuitive and works without calling cmplx(3)\n ! but does not work for variables just constants\n z8 = (1.1111111111111111d0, 2.2222222222222222d0 )\n print *, 'Z8 defined with constants=',z8\n\n ! what happens when you assign a complex to a real?\n precise=z8\n print *, 'LHS=',precise,'RHS=',z8\n\n ! elemental\n zthree=cmplx([10,20,30],-1)\n print *, 'zthree=',zthree\n\n ! descriptors are an alternative\n zthree(1:2)%re=[100,200]\n print *, 'zthree=',zthree\n\nend program demo_aimag\n```\nResults:\n```text\n > Z4= (-3.000000,0.0000000E+00)\n > Z4= (1.234568,1.234568)\n > Z4= 1.234568 1.234568\n > lost precision Z8= (1.23456788063049,-1.23456788063049)\n > kept precision Z8= (1.23456789012346,-1.23456789012346)\n > Z8 defined with constants= (1.11111111111111,2.22222222222222)\n > LHS= 1.11111111111111 RHS= (1.11111111111111,2.22222222222222)\n > zthree= (10.00000,-1.000000) (20.00000,-1.000000) (30.00000,-1.000000)\n > zthree= (100.0000,-1.000000) (200.0000,-1.000000) (30.00000,-1.000000)\n```\n### **Standard**\n\nFORTRAN 77, KIND added in Fortran 90.\n\n### **See Also**\n\n- [**aimag**(3)](#aimag) - Imaginary part of complex number\n- [**conjg**(3)](#conjg) - Complex conjugate function\n- [**real**(3)](#real) - Convert to real type\n\nFortran has strong support for _complex_ values, including many intrinsics\nthat take or produce _complex_ values in addition to algebraic and\nlogical expressions:\n\n[**abs**(3)](#abs),\n[**acosh**(3)](#acosh),\n[**acos**(3)](#acos),\n[**asinh**(3)](#asinh),\n[**asin**(3)](#asin),\n[**atan2**(3)](#atan2),\n[**atanh**(3)](#atanh),\n[**atan**(3)](#atan),\n[**cosh**(3)](#cosh),\n[**cos**(3)](#cos),\n[**co_sum**(3)](#co_sum),\n[**dble**(3)](#dble),\n[**dot_product**(3)](#dot_product),\n[**exp**(3)](#exp),\n[**int**(3)](#int),\n[**is_contiguous**(3)](#is_contiguous),\n[**kind**(3)](#kind),\n[**log**(3)](#log),\n[**matmul**(3)](#matmul),\n[**precision**(3)](#precision),\n[**product**(3)](#product),\n[**range**(3)](#range),\n[**rank**(3)](#rank),\n[**sinh**(3)](#sinh),\n[**sin**(3)](#sin),\n[**sqrt**(3)](#sqrt),\n[**storage_size**(3)](#storage_size),\n[**sum**(3)](#sum),\n[**tanh**(3)](#tanh),\n[**tan**(3)](#tan),\n[**unpack**(3)](#unpack),\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "COMMAND_ARGUMENT_COUNT": "## command_argument_count\n\n### **Name**\n\n**command_argument_count** - \\[SYSTEM:COMMAND LINE\\] Get number of command line arguments\n\n### **Synopsis**\n```fortran\n result = command_argument_count()\n```\n```fortran\n integer function command_argument_count()\n```\n### **Characteristics**\n\n - the result is of default integer scalar.\n\n### **Description**\n\n**command_argument_count** returns the number of arguments passed\non the command line when the containing program was invoked.\n\n### **Options**\n\nNone\n\n### **Result**\n\n The return value is of type default _integer_. It is the number of\n arguments passed on the command line when the program was invoked.\n\n If there are no command arguments available or if the processor does\n not support command arguments, then the result has the value zero.\n\n If the processor has a concept of a command name, the command name\n does not count as one of the command arguments.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_command_argument_count\nimplicit none\ninteger :: count\n count = command_argument_count()\n print *, count\nend program demo_command_argument_count\n```\nSample output:\n\n```bash\n # the command verb does not count\n ./test_command_argument_count\n 0\n # quoted strings may count as one argument\n ./test_command_argument_count count arguments\n 2\n ./test_command_argument_count 'count arguments'\n 1\n```\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**get_command**(3)](#get_command),\n[**get_command_argument**(3)](#get_command_argument)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "COMPILER_OPTIONS": "## compiler_options\n\n### **Name**\n\n**compiler_options** - \\[COMPILER:INQUIRY\\] Options passed to the compiler\n\n### **Synopsis**\n```fortran\n result = compiler_options()\n```\n```fortran\n character(len=:) function compiler_options()\n```\n### **Characteristics**\n\n - the return value is a default-kind _character_ variable with\n system-dependent length.\n\n### **Description**\n\n **compiler_options** returns a string with the options used for\n compiling.\n\n### **Options**\n\n None.\n\n### **Result**\n\n The result contains the compiler flags used to compile the file\n containing the **compiler_options** call.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_compiler_version\nuse, intrinsic :: iso_fortran_env, only : compiler_version\nuse, intrinsic :: iso_fortran_env, only : compiler_options\nimplicit none\n print '(4a)', &\n 'This file was compiled by ', &\n compiler_version(), &\n ' using the options ', &\n compiler_options()\nend program demo_compiler_version\n```\nResults:\n```text\n > This file was compiled by GCC version 10.3.0 using\n > the options -I build/gfortran_2A42023B310FA28D\n > -mtune=generic -march=x86-64 -auxbase-strip\n > build/gfortran_2A42023B310FA28D/compiler_options/app_main.f90.o\n > -g -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1\n > -fcheck=bounds -fcheck=array-temps -fbacktrace\n > -fcoarray=single -J build/gfortran_2A42023B310FA28D\n > -fpre-include=/usr/include/finclude/math-vector-fortran.h\n \n > This file was compiled by nvfortran 21.5-0 LLVM\n > using the options app/main.f90 -c -Minform=inform\n > -Mbackslash -Mbounds -Mchkptr -Mchkstk -traceback -module\n > build/nvfortran_78229DCE997517A4 -Ibuild/nvfortran_78229DCE997517A4 -o\n > build/nvfortran_78229DCE997517A4/compiler_options/app_main.f90.o\n \n > This file was compiled by Intel(R) Fortran Intel(R) 64 Compiler Classic\n > for applications running on Intel(R) 64, Version 2021.3.0 Build\n > 20210609_000000 using the options -Ibuild/ifort_5C58216731706F11\n > -c -warn all -check all -error-limit 1 -O0 -g -assume\n > byterecl -traceback -module build/ifort_5C58216731706F11 -o\n > build/ifort_5C58216731706F11/compiler_options/app_main.f90.o\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**compiler_version**(3)](#compiler_version),\n**iso_fortran_env**(7)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "COMPILER_VERSION": "## compiler_version\n\n### **Name**\n\n**compiler_version** - \\[COMPILER:INQUIRY\\] Compiler version string\n\n### **Synopsis**\n```fortran\n result = compiler_version()\n```\n```fortran\n character(len=:) function compiler_version()\n```\n### **Characteristics**\n\n- The return value is a default-kind scalar _character_ with\n system-dependent length.\n\n### **Description**\n\n **compiler_version** returns a string containing the name and\n version of the compiler.\n\n### **Options**\n\n None.\n\n### **Result**\n\n The return value contains the name of the compiler and its version\n number used to compile the file containing the **compiler_version**\n call.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_compiler_version\nuse, intrinsic :: iso_fortran_env, only : compiler_version\nuse, intrinsic :: iso_fortran_env, only : compiler_options\nimplicit none\n print '(4a)', &\n 'This file was compiled by ', &\n compiler_version(), &\n ' using the options ', &\n compiler_options()\nend program demo_compiler_version\n```\nResults:\n```text\n > This file was compiled by GCC version 10.3.0\n\n > This file was compiled by Intel(R) Fortran Intel(R) 64 Compiler\n > Classic for applications running on Intel(R) 64, Version 2021.3.0 Build\n > 20210609_000000\n\n > This file was compiled by nvfortran 21.5-0 LLVM\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**compiler_options**(3)](#compiler_options),\n**iso_fortran_env**(7)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "CONJG": "## conjg\n\n### **Name**\n\n**conjg** - \\[NUMERIC\\] Complex conjugate of a complex value\n\n### **Synopsis**\n```fortran\n result = conjg(z)\n```\n```fortran\n elemental complex(kind=KIND) function conjg(z)\n\n complex(kind=**),intent(in) :: z\n```\n### **Characteristics**\n\n- **z** is a _complex_ value of any valid kind.\n- The returned value has the same _complex_ type as the input.\n\n### **Description**\n\n**conjg** returns the complex conjugate of the _complex_ value **z**.\n\nThat is, If **z** is the _complex_ value **(x, y)** then the result is\n**(x, -y)**.\n\nIn mathematics, the complex conjugate of a complex number is a value\nwhose real and imaginary part are equal parts are equal in magnitude to\neach other but the **y** value has opposite sign.\n\nFor matrices of complex numbers, **conjg(array)** represents the\nelement-by-element conjugation of **array**; not the conjugate transpose\nof the **array** .\n\n### **Options**\n\n- **z**\n : The value to create the conjugate of.\n\n### **Result**\n\nReturns a value equal to the input value except the sign of\nthe imaginary component is the opposite of the input value.\n\nThat is, if **z** has the value **(x,y)**, the result has the value\n**(x, -y)**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_conjg\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\ncomplex :: z = (2.0, 3.0)\ncomplex(kind=real64) :: dz = ( &\n & 1.2345678901234567_real64, -1.2345678901234567_real64)\ncomplex :: arr(3,3)\ninteger :: i\n ! basics\n ! notice the sine of the imaginary component changes\n print *, z, conjg(z)\n\n ! any complex kind is supported. z is of default kind but\n ! dz is kind=real64.\n print *, dz\n dz = conjg(dz)\n print *, dz\n print *\n\n ! the function is elemental so it can take arrays\n arr(1,:)=[(-1.0, 2.0),( 3.0, 4.0),( 5.0,-6.0)]\n arr(2,:)=[( 7.0,-8.0),( 8.0, 9.0),( 9.0, 9.0)]\n arr(3,:)=[( 1.0, 9.0),( 2.0, 0.0),(-3.0,-7.0)]\n\n write(*,*)'original'\n write(*,'(3(\"(\",g8.2,\",\",g8.2,\")\",1x))')(arr(i,:),i=1,3)\n arr = conjg(arr)\n write(*,*)'conjugate'\n write(*,'(3(\"(\",g8.2,\",\",g8.2,\")\",1x))')(arr(i,:),i=1,3)\n\nend program demo_conjg\n```\nResults:\n```fortran\n > (2.000000,3.000000) (2.000000,-3.000000)\n >\n > (1.23456789012346,-1.23456789012346)\n > (1.23456789012346,1.23456789012346)\n >\n > original\n > (-1.0 , 2.0 ) ( 3.0 , 4.0 ) ( 5.0 ,-6.0 )\n > ( 7.0 ,-8.0 ) ( 8.0 , 9.0 ) ( 9.0 , 9.0 )\n > ( 1.0 , 9.0 ) ( 2.0 , 0.0 ) (-3.0 ,-7.0 )\n >\n > conjugate\n > (-1.0 ,-2.0 ) ( 3.0 ,-4.0 ) ( 5.0 , 6.0 )\n > ( 7.0 , 8.0 ) ( 8.0 ,-9.0 ) ( 9.0 ,-9.0 )\n > ( 1.0 ,-9.0 ) ( 2.0 , 0.0 ) (-3.0 , 7.0 )\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n- [**aimag**(3)](#aimag) - Imaginary part of complex number\n- [**cmplx**(3)](#cmplx) - Complex conversion function\n- [**real**(3)](#real) - Convert to real type\n\nFortran has strong support for _complex_ values, including many intrinsics\nthat take or produce _complex_ values in addition to algebraic and\nlogical expressions:\n\n[**abs**(3)](#abs),\n[**acosh**(3)](#acosh),\n[**acos**(3)](#acos),\n[**asinh**(3)](#asinh),\n[**asin**(3)](#asin),\n[**atan2**(3)](#atan2),\n[**atanh**(3)](#atanh),\n[**atan**(3)](#atan),\n[**cosh**(3)](#cosh),\n[**cos**(3)](#cos),\n[**co_sum**(3)](#co_sum),\n[**dble**(3)](#dble),\n[**dot_product**(3)](#dot_product),\n[**exp**(3)](#exp),\n[**int**(3)](#int),\n[**is_contiguous**(3)](#is_contiguous),\n[**kind**(3)](#kind),\n[**log**(3)](#log),\n[**matmul**(3)](#matmul),\n[**precision**(3)](#precision),\n[**product**(3)](#product),\n[**range**(3)](#range),\n[**rank**(3)](#rank),\n[**sinh**(3)](#sinh),\n[**sin**(3)](#sin),\n[**sqrt**(3)](#sqrt),\n[**storage_size**(3)](#storage_size),\n[**sum**(3)](#sum),\n[**tanh**(3)](#tanh),\n[**tan**(3)](#tan),\n[**unpack**(3)](#unpack),\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "COS": "## cos\n\n### **Name**\n\n**cos** - \\[MATHEMATICS:TRIGONOMETRIC\\] Cosine function\n\n### **Synopsis**\n```fortran\n result = cos(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function cos(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is of type _real_ or _complex_ of any valid kind.\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n **cos** computes the cosine of an angle **x** given the size of\n the angle in radians.\n\n The cosine of a _real_ value is the ratio of the adjacent side to the\n hypotenuse of a right-angled triangle.\n\n### **Options**\n\n- **x**\n : The angle in radians when **x** is of type _real_.\n If **x** is of type _complex_, its real part is regarded as a value\n in radians, often called the phase.\n\n### **Result**\n\n The return value is the cosine of **x**.\n\n If **x** is type _real_, the return value lies in\n the range **-1 \\<= cos(x) \\<= 1** .\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_cos\nimplicit none\ncharacter(len=*),parameter :: g2='(a,t20,g0)'\ndoubleprecision,parameter :: PI=atan(1.0d0)*4.0d0\n write(*,g2)'COS(0.0)= ', cos(0.0)\n write(*,g2)'COS(PI)= ', cos(PI)\n write(*,g2)'COS(PI/2.0d0)=', cos(PI/2.0d0),'EPSILON=',epsilon(PI)\n write(*,g2)'COS(2*PI)= ', cos(2*PI)\n write(*,g2)'COS(-2*PI)= ', cos(-2*PI)\n write(*,g2)'COS(-2000*PI)=', cos(-2000*PI)\n write(*,g2)'COS(3000*PI)= ', cos(3000*PI)\nend program demo_cos\n```\nResults:\n```text\n > COS(0.0)= 1.000000\n > COS(PI)= -1.000000000000000\n > COS(PI/2.0d0)= .6123233995736766E-16\n > EPSILON= .2220446049250313E-15\n > COS(2*PI)= 1.000000000000000\n > COS(-2*PI)= 1.000000000000000\n > COS(-2000*PI)= 1.000000000000000\n > COS(3000*PI)= 1.000000000000000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**acos**(3)](#acos),\n[**sin**(3)](#sin),\n[**tan**(3)](#tan)\n\n### **Resources**\n\n- [Wikipedia:sine and cosine](https://en.wikipedia.org/wiki/Sine_and_cosine)\n\n _Fortran intrinsic descriptions_\n", "COSD": "## cosd\n\n### **Name**\n\n**cosd** - \\[MATHEMATICS:TRIGONOMETRIC\\] Degree cosine function\n\n### **Synopsis**\n```fortran\n result = cosd(x)\n```\n```fortran\n elemental real(kind=KIND) function cosd(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is of type _real_ of any valid kind.\n - **KIND** may be any real kind.\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n **cosd** computes the cosine of an angle **x** given the size of\n the angle in degrees.\n\n The cosine is the ratio of the adjacent side to the hypotenuse of a\n right-angled triangle.\n\n### **Options**\n\n- **x**\n : The angle in degrees to compute the cosine of.\n\n### **Result**\n\n The return value is an approximation of the cosine of **x**.\n\n The return value lies in the range\n```code\n -1 \\<= cosd(x) \\<= 1\n```\n### **Examples**\n\ncosd(180.0) has the value -1.0 (approximately).\n\nSample program:\n```fortran\nprogram demo_cosd\nimplicit none\ncharacter(len=*),parameter :: g2='(a,t20,g0)'\n write(*,g2)'cosd(0.0)=',cosd(0.0)\n write(*,g2)'cosd(180.0)=',cosd(180.0)\n write(*,g2)'cosd(90.0d0)=',cosd(90.0d0)\n write(*,g2)'cosd(360.0)=',cosd(360.0)\n write(*,g2)'cosd(-360.0)=',cosd(-360.0)\n write(*,g2)'cosd(-2000*180.0)=',cosd(-2000*180.0)\n write(*,g2)'cosd(3000*180.0)=',cosd(3000*180.0)\nend program demo_cosd\n```\nResults:\n```text\n > cosd(0.0)= 1.00000000\n > cosd(180.0)= -1.00000000\n > cosd(90.0d0)= 0.0000000000000000\n > cosd(360.0)= 1.00000000\n > cosd(-360.0)= 1.00000000\n > cosd(-2000*180.0)= 1.00000000\n > cosd(3000*180.0)= 1.00000000\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n[**acosd**(3)](#acosd),\n[**acos**(3)](#acos),\n[**sind**(3)](#sind),\n[**tand**(3)](#tand)\n\n### **Resources**\n\n- [Wikipedia:sine and cosine](https://en.wikipedia.org/wiki/Sine_and_cosine)\n\n _Fortran intrinsic descriptions_\n", "COSH": "## cosh\n\n### **Name**\n\n**cosh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Hyperbolic cosine function\n\n### **Synopsis**\n```fortran\n result = cosh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function cosh(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_ of any kind.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**cosh** computes the hyperbolic cosine of **x**.\n\nIf **x** is of type complex its imaginary part is regarded as a value\nin radians.\n\n### **Options**\n\n- **x**\n : the value to compute the hyperbolic cosine of\n\n### **Result**\n\n If **x** is _complex_, the imaginary part of the result is in radians.\n\n If **x** is _real_, the return value has a lower bound of one,\n **cosh(x) \\>= 1**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_cosh\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 1.0_real64\n write(*,*)'X=',x,'COSH(X=)',cosh(x)\nend program demo_cosh\n```\nResults:\n```text\n > X= 1.00000000000000 COSH(X=) 1.54308063481524\n```\n### **Standard**\n\nFORTRAN 77 , for a complex argument - Fortran 2008\n\n### **See Also**\n\nInverse function: [**acosh**(3)](#acosh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _Fortran intrinsic descriptions_\n", "COSPI": "## cospi\n\n### **Name**\n\n**cospi** - \\[MATHEMATICS:TRIGONOMETRIC\\] Circular Cosine function\n\n### **Synopsis**\n```fortran\n result = cospi(x)\n```\n```fortran\n elemental real(kind=KIND) function cospi(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is of type _real_.\n - **KIND** may be any kind supported by the associated type of **x**.\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n **cospi** computes the circular cosine of an angle **x** given the\n size of the angle in half-revolutions.\n\n The cosine of a _real_ value is the ratio of the adjacent side to the\n hypotenuse of a right-angled triangle.\n\n **cospi(x)** is approximately equal to **cos(x\\*PI)**.\n\n### **Options**\n\n- **x**\n : The angle in half-revolutions to compute the cosine of.\n\n### **Result**\n\n The return value is the approximate value of the cosine of **x**.\n\n The return value lies in the range\n **-1 \\<= cospi(x) \\<= 1** .\n\n\n### **Examples**\n\n Example: **cospi(1.0)** has the value -1.0 (approximately).\n\nSample program:\n```fortran\nprogram demo_cos\nimplicit none\ncharacter(len=*),parameter :: g2='(a,t21,*(g0,1x))'\n write(*,g2) 'Basics:'\n write(*,g2) 'COSpi(0)=', cospi(0.0d0)\n write(*,g2) 'COSpi(1)=', cospi(1.0d0)\n write(*,g2) 'COSpi(1/2)=', cospi(1.0d0/2.0d0)\n write(*,g2) 'COSpi(2)=', cospi(2.0d0)\n write(*,g2) 'COSpi(-2)=', cospi(-2.0d0)\n write(*,g2) 'COSpi(-2000)=', cospi(-2000.0d0)\n write(*,g2) 'COSpi(3000)=', cospi(3000.0d0)\n write(*,g2) 'Elemental:'\n write(*,g2) 'COSpi([0,1/4,-1/4])=',COSpi([0.0,0.25,-0.25])\nend program demo_cos\n```\nResults:\n```text\n > Basics:\n > COSpi(0)= 1.0000000000000000\n > COSpi(1)= -1.0000000000000000\n > COSpi(1/2)= 0.61232339957367660E-16\n > COSpi(2)= 1.0000000000000000\n > COSpi(-2)= 1.0000000000000000\n > COSpi(-2000)= 1.0000000000000000\n > COSpi(3000)= 1.0000000000000000\n > Elemental:\n > COSpi([0,1/4,-1/4])=1.00000000 0.707106769 0.707106769\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n[**acos**(3)](#acos),\n[**sin**(3)](#sin),\n[**tan**(3)](#tan)\n\n### **Resources**\n\n- [Wikipedia:sine and cosine](https://en.wikipedia.org/wiki/Sine_and_cosine)\n\n _Fortran intrinsic descriptions_\n", "COUNT": "## count\n\n### **Name**\n\n**count** - \\[ARRAY:REDUCTION\\] Count true values in an array\n\n### **Synopsis**\n```fortran\n result = count(mask [,dim] [,kind] )\n```\n```fortran\n integer(kind=KIND) function count(mask, dim, KIND )\n\n logical(kind=**),intent(in) :: mask(..)\n integer(kind=**),intent(in),optional :: dim\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **mask** is a _logical_ array of any shape and kind.\n - If **dim** is present, the result is an array with the specified rank\n removed.\n - **KIND** is a scalar integer constant expression valid as an\n _integer_ kind\n - The return value is of default _integer_ type unless **kind**\n is specified to declare the kind of the result.\n\n### **Description**\n\n **count** counts the number of _.true._ elements in a logical\n **mask**, or, if the **dim** argument is supplied, counts the number\n of elements along each row of the array in the **dim** direction. If\n the array has zero size or all of the elements of **mask** are false,\n then the result is **0**.\n\n### **Options**\n\n- **mask**\n : an array to count the number of _.true._ values in\n\n- **dim**\n : specifies to remove this dimension from the result and produce an\n array of counts of _.true._ values along the removed dimension.\n If not present, the result is a scalar count of the true elements\n in **mask** the value must be in the range 1 <= dim <= n, where n\n is the rank(number of dimensions) of **mask**.\n\n The corresponding actual argument shall not be an optional dummy\n argument, a disassociated pointer, or an unallocated allocatable.\n\n- **kind**\n : An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\n The return value is the number of _.true_. values in **mask** if **dim**\n is not present.\n\n If **dim** is present, the result is an array with a rank one less\n than the rank of the input array **mask**, and a size corresponding to\n the shape of **array** with the **dim** dimension removed, with the\n remaining elements containing the number of _.true._ elements along\n the removed dimension.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_count\nimplicit none\ncharacter(len=*),parameter :: ints='(*(i2,1x))'\n! two arrays and a mask all with the same shape\ninteger, dimension(2,3) :: a, b\nlogical, dimension(2,3) :: mymask\ninteger :: i\ninteger :: c(2,3,4)\n\nprint *,'the numeric arrays we will compare'\na = reshape( [ 1, 2, 3, 4, 5, 6 ], [ 2, 3 ])\nb = reshape( [ 0, 7, 3, 4, 5, 8 ], [ 2, 3 ])\nc = reshape( [( i,i=1,24)], [ 2, 3 ,4])\nprint '(3i3)', a(1,:)\nprint '(3i3)', a(2,:)\nprint *\nprint '(3i3)', b(1,:)\nprint '(3i3)', b(2,:)\n!\n! basic calls\nprint *, 'count a few basic things creating a mask from an expression'\nprint *, 'count a>b',count(a>b)\nprint *, 'count b the numeric arrays we will compare\n > 1 3 5\n > 2 4 6\n >\n > 0 3 5\n > 7 4 8\n > count a few basic things creating a mask from an expression\n > count a>b 1\n > count b count b==a 3\n > check sum = T\n > make a mask identifying unequal elements ...\n > the mask generated from a.ne.b\n > T F F\n > T F T\n > count total and along rows and columns ...\n > number of elements not equal\n > (ie. total true elements in the mask)\n > 3\n > count of elements not equal in each column\n > (ie. total true elements in each column)\n > 2 0 1\n > count of elements not equal in each row\n > (ie. total true elements in each row)\n > 1 2\n > lets try this with c(2,3,4)\n > taking the result of the modulo\n > z=1 z=2 z=3 z=4\n > 1 3 0 || 2 4 1 || 3 0 2 || 4 1 3 |\n > 2 4 1 || 3 0 2 || 4 1 3 || 0 2 4 |\n >\n > would result in the mask ..\n > F F T || F F F || F T F || F F F |\n > F F F || F T F || F F F || T F F |\n >\n > the total number of .true.values is\n > 4\n >\n > counting up along a row and removing rows :( 3 4 )\n > > [ 0, 0, 0, 1 ]\n > > [ 0, 1, 1, 0 ]\n > > [ 1, 0, 0, 0 ]\n >\n > counting up along a column and removing columns :( 2 4 )\n > > [ 1, 0, 1, 0 ]\n > > [ 0, 1, 0, 1 ]\n >\n > counting up along a depth and removing depths :( 2 3 )\n > > [ 0, 1, 1 ]\n > > [ 1, 1, 0 ]\n```\n### **Standard**\n\nFortran 95 , with KIND argument - Fortran 2003\n\n### **See Also**\n\n - [**any**(3)](#any)\n - [**all**(3)](#all)\n - [**sum**(3)](#sum)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "CO_BROADCAST": "## co_broadcast\n\n### **Name**\n\n**co_broadcast** - \\[COLLECTIVE\\] Copy a value to all images the current set of images\n\n### **Synopsis**\n```fortran\n call co_broadcast(a, source_image [,stat] [,errmsg] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**co_broadcast** copies the value of argument **a** on the image with image\nindex source_image to all images in the current team. **a** becomes defined\nas if by intrinsic assignment. If the execution was successful and **stat**\nis present, it is assigned the value zero. If the execution failed, **stat**\ngets assigned a nonzero value and, if present, **errmsg** gets assigned a\nvalue describing the occurred error.\n\n### **Options**\n\n- **a**\n : **intent(inout)** argument; shall have the same dynamic type and\n type parameters on all images of the current team. If it is an\n array, it shall have the same shape on all images.\n\n- **source_image**\n : a scalar integer expression. It shall have the same the same value\n on all images and refer to an image of the current team.\n\n- **stat**\n : (optional) a scalar integer variable\n\n- **errmsg**\n : (optional) a scalar character variable\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_co_broadcast\nimplicit none\ninteger :: val(3)\n if (this_image() == 1) then\n val = [1, 5, 3]\n endif\n call co_broadcast (val, source_image=1)\n print *, this_image(), \":\", val\nend program demo_co_broadcast\n```\n### **Standard**\n\nFortran xx\n\n### **See Also**\n\n[**co_max**(3)](#co_max),\n[**co_min**(3)](#co_min),\n[**co_sum**(3)](#co_sum),\n[**co_reduce**(3)](#co_reduce)\n\n _Fortran intrinsic descriptions_\n", "CO_MAX": "## co_max\n\n### **Name**\n\n**co_max** - \\[COLLECTIVE\\] Maximal value on the current set of images\n\n### **Synopsis**\n```fortran\n call co_max(a, result_image [,stat] [,errmsg] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**co_max** determines element-wise the maximal value of **a** on all\nimages of the current team. If result_image is present, the maximum values\nare returned in **a** on the specified image only and the value of **a**\non the other images become undefined. If result_image is not present,\nthe value is returned on all images. If the execution was successful\nand **stat** is present, it is assigned the value zero. If the execution\nfailed, **stat** gets assigned a nonzero value and, if present, **errmsg**\ngets assigned a value describing the occurred error.\n\n### **Options**\n\n- **a**\n : shall be an integer, real or character variable, which has the same\n type and type parameters on all images of the team.\n\n- **result_image**\n : (optional) a scalar integer expression; if present, it shall have\n the same the same value on all images and refer to an image of the\n current team.\n\n- **stat**\n : (optional) a scalar integer variable\n\n- **errmsg**\n : (optional) a scalar character variable\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_co_max\nimplicit none\ninteger :: val\n val = this_image()\n call co_max(val, result_image=1)\n if (this_image() == 1) then\n write(*,*) \"Maximal value\", val ! prints num_images()\n endif\nend program demo_co_max\n```\nResults:\n\n```text\n > Maximal value 2\n```\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**co_min**(3)](#co_min),\n[**co_sum**(3)](#co_sum),\n[**co_reduce**(3)](#co_reduce),\n[**co_broadcast**(3)](#co_broadcast)\n\n _Fortran intrinsic descriptions_\n", "CO_MIN": "## co_min\n\n### **Name**\n\n**co_min** - \\[COLLECTIVE\\] Minimal value on the current set of images\n\n### **Synopsis**\n```fortran\n call co_min(a, result_image [,stat] [,errmsg] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**co_min** determines element-wise the minimal value of **a** on all\nimages of the current team. If result_image is present, the minimal values\nare returned in **a** on the specified image only and the value of **a**\non the other images become undefined. If result_image is not present,\nthe value is returned on all images. If the execution was successful\nand **stat** is present, it is assigned the value zero. If the execution\nfailed, **stat** gets assigned a nonzero value and, if present, **errmsg**\ngets assigned a value describing the occurred error.\n\n### **Options**\n\n- **a**\n : shall be an integer, real or character variable, which has the same\n type and type parameters on all images of the team.\n\n- **result_image**\n : (optional) a scalar integer expression; if present, it shall have\n the same the same value on all images and refer to an image of the\n current team.\n\n- **stat**\n : (optional) a scalar integer variable\n\n- **errmsg**\n : (optional) a scalar character variable\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_co_min\nimplicit none\ninteger :: val\n val = this_image()\n call co_min(val, result_image=1)\n if (this_image() == 1) then\n write(*,*) \"Minimal value\", val ! prints 1\n endif\nend program demo_co_min\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**co_max**(3)](#co_max),\n[**co_sum**(3)](#co_sum),\n[**co_reduce**(3)](#co_reduce),\n[**co_broadcast**(3)](#co_broadcast)\n\n _Fortran intrinsic descriptions_\n", "CO_REDUCE": "## co_reduce\n\n### **Name**\n\n**co_reduce** - \\[COLLECTIVE\\] Reduction of values on the current set of images\n\n### **Synopsis**\n```fortran\n call co_reduce(a, operation, result_image [,stat] [,errmsg] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**co_reduce** determines element-wise the reduction of the value of **a** on\nall images of the current team. The pure function passed as **operation** is\nused to pairwise reduce the values of **a** by passing either the value of **a**\nof different images or the result values of such a reduction as\nargument. If **a** is an array, the reduction is done element wise. If\nresult_image is present, the result values are returned in **a** on the\nspecified image only and the value of **a** on the other images become\nundefined. If result_image is not present, the value is returned on all\nimages. If the execution was successful and **stat** is present, it is\nassigned the value zero. If the execution failed, **stat** gets assigned a\nnonzero value and, if present, **errmsg** gets assigned a value describing\nthe occurred error.\n\n### **Options**\n\n- **a**\n : is an **intent(inout)** argument and shall be nonpolymorphic. If it\n is allocatable, it shall be allocated; if it is a pointer, it shall\n be associated. **a** shall have the same type and type parameters on all\n images of the team; if it is an array, it shall have the same shape\n on all images.\n\n- **operation**\n : pure function with two scalar nonallocatable arguments, which shall\n be nonpolymorphic and have the same type and type parameters as **a**.\n The function shall return a nonallocatable scalar of the same type\n and type parameters as **a**. The function shall be the same on all\n images and with regards to the arguments mathematically commutative\n and associative. Note that OPERATION may not be an elemental unless\n it is an intrinsic function.\n\n- **result_image**\n\n : (optional) a scalar integer expression; if present, it shall\n have the same the same value on all images and refer to an image\n of the current team.\n\n- **stat**\n : (optional) a scalar integer variable\n\n- **errmsg**\n : (optional) a scalar character variable\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_co_reduce\nimplicit none\ninteger :: val\n\n val = this_image()\n call co_reduce(val, myprod, 1)\n if (this_image() == 1) then\n write(*,*) \"Product value\", val ! prints num_images() factorial\n endif\n\ncontains\n\npure function myprod(a, b)\n integer, value :: a, b\n integer :: myprod\n myprod = a * b\nend function myprod\n\nend program demo_co_reduce\n```\nResults:\n```text\n > Product value 1\n```\n### **Note**\n\nWhile the rules permit in principle an intrinsic function, none of the\nintrinsics in the standard fulfill the criteria of having a specific\nfunction, which takes two arguments of the same type and returning that\ntype as a result.\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**co_min**(3)](#co_min),\n[**co_max**(3)](#co_max),\n[**co_sum**(3)](#co_sum),\n[**co_broadcast**(3)](#co_broadcast)\n\n _Fortran intrinsic descriptions_\n", "CO_SUM": "## co_sum\n\n### **Name**\n\n**co_sum** - \\[COLLECTIVE\\] Sum of values on the current set of images\n\n### **Synopsis**\n```fortran\n call co_sum(a, result_image [,stat] [,errmsg] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**co_sum** sums up the values of each element of **a** on all images\nof the current team.\n\nIf result_image is present, the summed-up values are returned in **a**\non the specified image only and the value of **a** on the other images\nbecome undefined.\n\nIf result_image is not present, the value is returned on all images. If\nthe execution was successful and **stat** is present, it is assigned the\nvalue zero. If the execution failed, **stat** gets assigned a nonzero\nvalue and, if present, **errmsg** gets assigned a value describing the\noccurred error.\n\n### **Options**\n\n- **a**\n : shall be an integer, real or complex variable, which has the same\n type and type parameters on all images of the team.\n\n- **result_image**\n : (optional) a scalar integer expression; if present, it shall have\n the same the same value on all images and refer to an image of the\n current team.\n\n- **stat**\n : (optional) a scalar integer variable\n\n- **errmsg**\n : (optional) a scalar character variable\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_co_sum\nimplicit none\ninteger :: val\n val = this_image()\n call co_sum(val, result_image=1)\n if (this_image() == 1) then\n ! prints (n**2 + n)/2, with n = num_images()\n write(*,*) \"The sum is \", val\n endif\nend program demo_co_sum\n```\n\nResults:\n\n```text\n > The sum is 1\n```\n\n### **Standard**\n\nTS 18508\n\n### **See Also**\n\n[**co_max**(3)](#co_max),\n[**co_min**(3)](#co_min),\n[**co_reduce**(3)](#co_reduce),\n[**co_broadcast**(3)](#co_broadcast)\n\n _Fortran intrinsic descriptions_\n", "CPU_TIME": "## cpu_time\n\n### **Name**\n\n**cpu_time** - \\[SYSTEM:TIME\\] Return CPU processor time used in seconds\n\n### **Synopsis**\n```fortran\n call cpu_time(time)\n```\n```fortran\n subroutine cpu_time(time)\n\n real,intent(out) :: time\n```\n### **Characteristics**\n\n - **time** is a _real_ of any kind\n\n### **Description**\n\n **cpu_time** returns a _real_ value representing the elapsed CPU time\n in seconds. This is useful for testing segments of code to determine\n execution time.\n\n If no time source is available, **time** is set to a negative value.\n\n The exact definition of time is left imprecise because of the variability\n in what different processors are able to provide.\n\n Note that **time** may contain a system dependent, arbitrary offset and may\n not start with 0.0. For **cpu_time** the absolute value is meaningless.\n Only differences between subsequent calls, as shown in the example below,\n should be used.\n\n PARALLEL PROCESSING\n\n Whether the value assigned is an approximation to the amount of time used\n by the invoking image, or the amount of time used by the whole program,\n is processor dependent.\n\n A processor for which a single result is inadequate (for example, a\n parallel processor) might choose to provide an additional version for\n which **time** is an array.\n\n### **Result**\n\n- **time**\n : is assigned a processor-dependent approximation to the processor\n time in seconds. If the processor cannot return a meaningful time,\n a processor-dependent negative value is returned.\n\n : The start time is left imprecise because the purpose is to time\n sections of code, as in the example. This might or might not\n include system overhead time.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_cpu_time\nuse, intrinsic :: iso_fortran_env, only : real32,real64,real128\nimplicit none\nreal :: start, finish\nreal(kind=real64) :: startd, finishd\n !\n call cpu_time(start)\n call cpu_time(startd)\n ! put code to time here\n call cpu_time(finish)\n call cpu_time(finishd)\n !\n ! writes processor time taken by the piece of code.\n\n ! the accuracy of the clock and whether it includes system time\n ! as well as user time is processor dependent. Accuracy up to\n ! milliseconds is common but not guaranteed, and may be much\n ! higher or lower\n print '(\"Processor Time = \",f6.3,\" seconds.\")',finish-start\n\n ! see your specific compiler documentation for how to measure\n ! parallel jobs and for the precision of the time returned\n print '(\"Processor Time = \",g0,\" seconds.\")',finish-start\n print '(\"Processor Time = \",g0,\" seconds.\")',finishd-startd\nend program demo_cpu_time\n```\nResults:\n\n The precision of the result, some aspects of what is returned,\n and what if any options there are for parallel applications\n may very from system to system. See compiler-specific for details.\n```text\n > Processor Time = 0.000 seconds.\n > Processor Time = .4000030E-05 seconds.\n > Processor Time = .2000000000000265E-05 seconds.\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**system_clock**(3)](#system_clock),\n[**date_and_time**(3)](#date_and_time)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "CSHIFT": "## cshift\n\n### **Name**\n\n**cshift** - \\[ARRAY:TRANSFORMATIONAL\\] Circular shift elements of an array\n\n### **Synopsis**\n```fortran\n result = cshift(array, shift [,dim])\n```\n```fortran\n type(TYPE(kind=KIND)) function cshift(array, shift, dim )\n\n type(TYPE(kind=KIND)),intent(in) :: array(..)\n integer(kind=**),intent(in) :: shift\n integer(kind=**),intent(in) :: dim\n```\n### **Characteristics**\n\n - **array** may be any type and rank\n - **shift** an _integer_ scalar if **array** has rank one.\n Otherwise, it shall be scalar or of rank n-1 and of shape [d1, d2,\n ..., dDIM-1, dDIM+1, ..., dn] where [d1, d2, ..., dn] is the shape\n of **array**.\n - **dim** is an _integer_ scalar with a value in the range 1 <= **dim**\n <= n, where n is the rank of **array**.\n If **dim** is absent, it is as if it were present with the value 1.\n - the result will automatically be of the same type, kind and shape as **array**.\n\n NOTE:\n :a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **cshift** performs a circular shift on elements\n of **array** along the dimension of **dim**. If **dim** is omitted it is\n taken to be **1**. **dim** is a scalar of type _integer_ in the range of\n **1 \\<= dim \\<= n**, where \"n\" is the rank of **array**.\n\n If the rank of\n **array** is one, then all elements of **array** are shifted by **shift**\n places. If rank is greater than one, then all complete rank one sections\n of **array** along the given dimension are shifted. Elements shifted\n out one end of each rank one section are shifted back in the other end.\n\n### **Options**\n\n- **array**\n : An array of any type which is to be shifted\n\n- **shift**\n : the number of positions to circularly shift. A negative value produces\n a right shift, a positive value produces a left shift.\n\n- **dim**\n : the dimension along which to shift a multi-rank **array**. Defaults\n to 1.\n\n### **Result**\n\nReturns an array of same type and rank as the **array** argument.\n\nThe rows of an array of rank two may all be shifted by the same amount\nor by different amounts.\n\n## cshift\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_cshift\nimplicit none\ninteger, dimension(5) :: i1\ninteger, dimension(3,4) :: a, b\n !basics\n i1=[10,20,30,40,50]\n print *,'start with:'\n print '(1x,5i3)', i1\n print *,'shift -2'\n print '(1x,5i3)', cshift(i1,-2)\n print *,'shift +2'\n print '(1x,5i3)', cshift(i1,+2)\n\n print *,'start with a matrix'\n a = reshape( [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 ], [ 3, 4 ])\n print '(4i3)', a(1,:)\n print '(4i3)', a(2,:)\n print '(4i3)', a(3,:)\n print *,'matrix shifted along rows, each by its own amount [-1,0,1]'\n b = cshift(a, SHIFT=[1, 0, -1], DIM=2)\n print *\n print '(4i3)', b(1,:)\n print '(4i3)', b(2,:)\n print '(4i3)', b(3,:)\nend program demo_cshift\n```\nResults:\n```text\n > start with:\n > 10 20 30 40 50\n > shift -2\n > 40 50 10 20 30\n > shift +2\n > 30 40 50 10 20\n > start with a matrix\n > 1 4 7 10\n > 2 5 8 11\n > 3 6 9 12\n > matrix shifted along rows, each by its own amount\n >\n > 4 7 10 1\n > 2 5 8 11\n > 12 3 6 9\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n - [**eoshift**(3)](#eoshift) - End-off shift elements of an array\n \n - [**sum**(3)](#sum) - sum the elements of an array\n - [**product**(3)](#product) - Product of array elements\n - [**findloc**(3)](#findloc) - Location of first element of ARRAY identified by MASK along dimension DIM having a value\n - [**maxloc**(3)](#maxloc) - Location of the maximum value within an array\n\n _Fortran intrinsic descriptions_\n", "C_ASSOCIATED": "## c_associated\n\n### **Name**\n\n**c_associated** - \\[ISO_C_BINDING\\] Status of a C pointer\n\n### **Synopsis**\n```fortran\n result = c_associated(c_prt_1, [c_ptr_2] )\n```\n```fortran\n logical function c_associated(c_prt_1, cptr_2)\n\n TYPE,intent(in) ::c_ptr_1\n TYPE,intent(in),optional ::c_ptr_2\n```\n### **Characteristics**\n\n- **c_ptr_1** is a scalar of the type c_ptr or c_funptr.\n- **c_ptr_2** is a scalar of the same type as c_ptr_1.\n- The return value is of type _logical_\n\n### **Description**\n\n**c_associated** determines the status of the\nC pointer c_ptr_1 or if c_ptr_1 is associated with the target\nc_ptr_2.\n\n### **Options**\n\n- **c_ptr_1**\n : C pointer to test for being a C NULL pointer, or to test if\n pointing to the same association as **c_ptr_2** when present.\n\n- **c_ptr_2**\n : C pointer to test for shared association with **c_ptr_1**\n\n### **Result**\n\nThe return value is of type _logical_; it is _.false_. if either c_ptr_1\nis a C NULL pointer or if c_ptr1 and c_ptr_2 point to different\naddresses.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_c_associated\n\ncontains\n\nsubroutine association_test(a,b)\nuse iso_c_binding, only: c_associated, c_loc, c_ptr\nimplicit none\nreal, pointer :: a\ntype(c_ptr) :: b\n if(c_associated(b, c_loc(a))) &\n stop 'b and a do not point to same target'\nend subroutine association_test\n\nend program demo_c_associated\n```\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**c_loc**(3)](#c_loc),\n[**c_funloc**(3)](#c_funloc),\n**iso_c_binding**(3)\n\n _Fortran intrinsic descriptions_\n", "C_FUNLOC": "## c_funloc\n\n### **Name**\n\n**c_funloc** - \\[ISO_C_BINDING\\] Obtain the C address of a procedure\n\n### **Synopsis**\n```fortran\n result = c_funloc(x)\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**c_funloc** determines the C address of the argument.\n\n### **Options**\n\n- **x**\n : Interoperable function or pointer to such function.\n\n### **Result**\n\nThe return value is of type c_funptr and contains the C address of the\nargument.\n\n### **Examples**\n\nSample program:\n\n```fortran\n! program demo_c_funloc and module\nmodule x\nuse iso_c_binding\nimplicit none\ncontains\nsubroutine sub(a) bind(c)\nreal(c_float) :: a\n a = sqrt(a)+5.0\nend subroutine sub\nend module x\n!\nprogram demo_c_funloc\nuse iso_c_binding\nuse x\nimplicit none\ninterface\n subroutine my_routine(p) bind(c,name='myC_func')\n import :: c_funptr\n type(c_funptr), intent(in) :: p\n end subroutine\nend interface\n call my_routine(c_funloc(sub))\n!\nend program demo_c_funloc\n```\n\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**c_associated**(3)](#c_associated),\n[**c_loc**(3)](#c_loc),\n[**c_f_pointer**(3)](#c_f_pointer),\n\n[**c_f_procpointer**(3)](#c_f_procpointer),\n**iso_c_binding**(3)\n\n _Fortran intrinsic descriptions_\n", "C_F_POINTER": "## c_f_pointer\n\n### **Name**\n\n**c_f_pointer** - \\[ISO_C_BINDING\\] Convert C into Fortran pointer\n\n### **Synopsis**\n```fortran\n call c_f_pointer(cptr, fptr [,shape] )\n```\n```fortran\n subroutine c_f_pointer(cptr, fptr ,shape )\n\n type(c_ptr),intent(in) :: cprt\n type(TYPE),pointer,intent(out) :: fprt\n integer,intent(in),optional :: shape(:)\n```\n### **Characteristics**\n\nThe Fortran pointer **fprt** must be interoperable with **cptr**\n\n**shape** is only specified if **fptr** is an array.\n\n### **Description**\n\n**c_f_pointer** assigns the target (the C pointer **cptr**) to the\nFortran pointer **fptr** and specifies its shape if **fptr** points to\nan array.\n\n### **Options**\n\n- **cptr**\n : scalar of the type c_ptr. It is **intent(in)**.\n\n- **fptr**\n : pointer interoperable with **cptr**. it is **intent(out)**.\n\n- **shape**\n : (Optional) Rank-one array of type _integer_ with **intent(in)** .\n It shall be present if and only if **fptr** is an array. The size\n must be equal to the rank of **fptr**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_c_f_pointer\nuse iso_c_binding\nimplicit none\ninterface\n subroutine my_routine(p) bind(c,name='myC_func')\n import :: c_ptr\n type(c_ptr), intent(out) :: p\n end subroutine\nend interface\ntype(c_ptr) :: cptr\nreal,pointer :: a(:)\n call my_routine(cptr)\n call c_f_pointer(cptr, a, [12])\nend program demo_c_f_pointer\n```\n\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**c_loc**(3)](#c_loc),\n[**c_f_procpointer**(3)](#c_f_procpointer),\n**iso_c_binding**(3)\n\n _Fortran intrinsic descriptions_\n", "C_F_PROCPOINTER": "## c_f_procpointer\n\n### **Name**\n\n**c_f_procpointer** - \\[ISO_C_BINDING\\] Convert C into Fortran procedure pointer\n\n### **Synopsis**\n```fortran\n call c_f_procpointer(cptr, fptr)\n```\n```fortran\n subroutine c_f_procpointer(cptr, fptr )\n\n type(c_funptr),intent(in) :: cprt\n type(TYPE),pointer,intent(out) :: fprt\n```\n### **Characteristics**\n\n### **Description**\n\n**c_f_procpointer** assigns the target of the C function\npointer **cptr** to the Fortran procedure pointer **fptr**.\n\n### **Options**\n\n- **cptr**\n : scalar of the type c_funptr. It is **intent(in)**.\n\n- **fptr**\n : procedure pointer interoperable with **cptr**. It is **intent(out)**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_c_f_procpointer\nuse iso_c_binding\nimplicit none\nabstract interface\n function func(a)\n import :: c_float\n real(c_float), intent(in) :: a\n real(c_float) :: func\n end function\nend interface\ninterface\n function getIterFunc() bind(c,name=\"getIterFunc\")\n import :: c_funptr\n type(c_funptr) :: getIterFunc\n end function\nend interface\ntype(c_funptr) :: cfunptr\nprocedure(func), pointer :: myFunc\n cfunptr = getIterFunc()\n call c_f_procpointer(cfunptr, myFunc)\nend program demo_c_f_procpointer\n```\n\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**c_loc**(3)](#c_loc),\n[**c_f_pointer**(3)](#c_f_pointer),\n**iso_c_binding**(3)\n\n _Fortran intrinsic descriptions_\n", "C_LOC": "## c_loc\n\n### **Name**\n\n**c_loc** - \\[ISO_C_BINDING\\] Obtain the C address of an object\n\n### **Synopsis**\n```fortran\n result = c_loc(x)\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n **c_loc** determines the C address of the argument.\n\n### **Options**\n\n- **x**\n : Shall have either the _pointer_ or _target_ attribute. It shall not be a\n coindexed object. It shall either be a variable with interoperable\n type and kind type parameters, or be a scalar, nonpolymorphic\n variable with no length type parameters.\n\n### **Result**\n\nThe return value is of type c_ptr and contains the C address of the\nargument.\n\n### **Examples**\n\nSample program:\n\n```fortran\n subroutine association_test(a,b)\n use iso_c_binding, only: c_associated, c_loc, c_ptr\n implicit none\n real, pointer :: a\n type(c_ptr) :: b\n if(c_associated(b, c_loc(a))) &\n stop 'b and a do not point to same target'\n end subroutine association_test\n```\n\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**c_associated**(3)](#c_associated),\n[**c_funloc**(3)](#c_funloc),\n[**c_f_pointer**(3)](#c_f_pointer),\n\n[**c_f_procpointer**(3)](#c_f_procpointer),\n**iso_c_binding**(3)\n\n _Fortran intrinsic descriptions_\n", "C_SIZEOF": "## c_sizeof\n\n### **Name**\n\n**c_sizeof** - \\[ISO_C_BINDING\\] Size in bytes of an expression\n\n### **Synopsis**\n```fortran\n result = c_sizeof(x)\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**c_sizeof** calculates the number of bytes of storage the\nexpression **x** occupies.\n\n### **Options**\n\n- **x**\n : The argument shall be an interoperable data entity.\n\n### **Result**\n\nThe return value is of type integer and of the system-dependent kind\nc*size_t (from the iso\\_c\\_binding* module). Its value is the\nnumber of bytes occupied by the argument. If the argument has the\n_pointer_ attribute, the number of bytes of the storage area pointed to is\nreturned. If the argument is of a derived type with _pointer_ or\n_allocatable_ components, the return value does not account for the sizes\nof the data pointed to by these components.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_c_sizeof\nuse iso_c_binding\nimplicit none\nreal(c_float) :: r, s(5)\n print *, (c_sizeof(s)/c_sizeof(r) == 5)\nend program demo_c_sizeof\n```\n\nResults:\n\n```text\n > T\n```\n\nThe example will print _.true._ unless you are using a platform where\ndefault _real_ variables are unusually padded.\n\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**storage_size**(3)](#storage_size)\n\n _Fortran intrinsic descriptions_\n", "DATE_AND_TIME": "## date_and_time\n\n### **Name**\n\n**date_and_time** - \\[SYSTEM:TIME\\] Gets current date and time\n\n### **Synopsis**\n```fortran\n subroutine date_and_time(date, time, zone, values)\n\n character(len=8),intent(out),optional :: date\n character(len=10),intent(out),optional :: time\n character(len=5),intent(out),optional :: zone\n integer,intent(out),optional :: values(8)\n```\n### **Characteristics**\n\n - **date**, **time**, and **zone** are default _character_ scalar types\n - **values** is a rank-one array of type integer with a decimal\n exponent range of at least four.\n\n### **Description**\n\n **date_and_time** gets the corresponding date and time information\n from the real-time system clock.\n\n Unavailable time and date _character_ parameters return blanks.\n\n Unavailable numeric parameters return **-huge(value)**.\n\n### **Options**\n\n- **date**\n : A character string of default kind of the form **CCYYMMDD**, of length\n 8 or larger, where\n\n + **CCYY** is the year in the Gregorian calendar\n + **MM** is the month within the year\n + **DD** is the day within the month.\n\n The characters of this value are all decimal digits.\n\n If there is no date available, **date** is assigned all blanks.\n\n- **time**\n : A character string of default kind of the form **HHMMSS.SSS**,\n of length 10 or larger, where\n\n + **HH** is the hour of the day,\n + **MM** is the minutes of the hour,\n + and **SS.SSS** is the seconds and milliseconds of the minute.\n\n Except for the decimal point, the characters of this value shall\n all be decimal digits.\n\n If there is no clock available, **time** is assigned all blanks.\n\n- **zone**\n : A string of the form (+-)**HHMM**, of length 5 or larger, representing\n the difference with respect to Coordinated Universal Time (UTC), where\n\n + **HH** and **MM** are the time difference with respect to\n Coordinated Universal Time (UTC) in hours and minutes,\n respectively.\n\n The characters of this value following the sign character are all\n decimal digits.\n\n If this information is not available, **zone** is assigned all blanks.\n\n- **values**\n : An array of at least eight elements. If there is no data\n available for a value it is set to **-huge(values)**. Otherwise,\n it contains:\n\n - **values**(1) : The year, including the century.\n - **values**(2) : The month of the year\n - **values**(3) : The day of the month\n - **values**(4) : Time difference in minutes between the reported time\n and UTC time.\n - **values**(5) : The hour of the day, in the range 0 to 23.\n - **values**(6) : The minutes of the hour, in the range 0 to 59\n - **values**(7) : The seconds of the minute, in the range 0 to 60\n - **values**(8) : The milliseconds of the second, in the range 0 to 999.\n\n The date, clock, and time zone information might be available on some\n images and not others. If the date, clock, or time zone information is\n available on more than one image, it is processor dependent whether or\n not those images share the same information.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_date_and_time\n implicit none\n character(len=8) :: date\n character(len=10) :: time\n character(len=5) :: zone\n integer, dimension(8) :: values\n\n call date_and_time(date, time, zone, values)\n\n ! using keyword arguments\n call date_and_time(DATE=date, TIME=time, ZONE=zone)\n print '(*(g0))','DATE=\"',date,'\" TIME=\"',time,'\" ZONE=\"',zone,'\"'\n\n call date_and_time(VALUES=values)\n write (*, '(i5,a)') &\n & values(1), ' - The year', &\n & values(2), ' - The month', &\n & values(3), ' - The day of the month', &\n & values(4), ' - Time difference with UTC in minutes', &\n & values(5), ' - The hour of the day', &\n & values(6), ' - The minutes of the hour', &\n & values(7), ' - The seconds of the minute', &\n & values(8), ' - The milliseconds of the second'\n\n write (*, '(a)') iso_8601()\ncontains\n function iso_8601()\n ! return date using ISO-8601 format at a resolution of seconds\n character(len=8) :: dt\n character(len=10) :: tm\n character(len=5) :: zone\n character(len=25) :: iso_8601\n call date_and_time(dt, tm, zone)\n ISO_8601 = dt(1:4)//'-'//dt(5:6)//'-'//dt(7:8) &\n & //'T'// &\n & tm(1:2)//':'//tm(3:4)//':'//tm(5:6) &\n & //zone(1:3)//':'//zone(4:5)\n end function iso_8601\nend program demo_date_and_time\n```\nResults:\n```text\n > DATE=\"20240426\" TIME=\"111545.335\" ZONE=\"-0400\"\n > 2024 - The year\n > 4 - The month\n > 26 - The day of the month\n > -240 - Time difference with UTC in minutes\n > 11 - The hour of the day\n > 15 - The minutes of the hour\n > 45 - The seconds of the minute\n > 335 - The milliseconds of the second\n > 2024-04-26T11:15:45-04:00\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n These forms are compatible with the representations defined in ISO\n 8601:2004.\n\n UTC is established by the International Bureau of Weights\n and Measures (BIPM, i.e. Bureau International des Poids et Mesures)\n and the International Earth Rotation Service (IERS).\n\n [**cpu_time**(3)](#cpu_time),\n [**system_clock**(3)](#system_clock)\n\n### **Resources**\n\ndate and time conversion, formatting and computation\n\n- [M_time](https://github.com/urbanjost/M_time) - https://github.com/urbanjost/M_time\n- [fortran-datetime](https://github.com/dongli/fortran-datetime) - https://github.com/dongli/fortran-datetime\n- [datetime-fortran](https://github.com/wavebitscientific/datetime-fortran) - https://github.com/wavebitscientific/datetime-fortran\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "DBLE": "## dble\n\n### **Name**\n\n**dble** - \\[TYPE:CONVERSION\\] Converstion to double precision real\n\n### **Synopsis**\n```fortran\n result = dble(a)\n```\n```fortran\n elemental doubleprecision function dble(a)\n\n doubleprecision :: dble\n TYPE(kind=KIND),intent(in) :: a\n```\n### **Characteristics**\n\n - **a** my be _integer_, _real_, _complex_, or a BOZ-literal-constant\n - the result is a doubleprecision _real_.\n\n### **Description**\n\n**dble** Converts **a** to double precision _real_ type.\n\n### **Options**\n\n- **a**\n : a value to convert to a doubleprecision _real_.\n\n### **Result**\n\nThe return value is of type _doubleprecision_. For _complex_ input,\nthe returned value has the magnitude and sign of the real component\nof the input value.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_dble\nimplicit none\nreal:: x = 2.18\ninteger :: i = 5\ncomplex :: z = (2.3,1.14)\n print *, dble(x), dble(i), dble(z)\nend program demo_dble\n```\nResults:\n\n```text\n > 2.1800000667572021 5.0000000000000000 2.2999999523162842\n```\n### **Standard**\n\nFORTRAN 77\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- [**int**(3)](#int) - Truncate towards zero and convert to integer\n- [**nint**(3)](#nint) - Nearest whole number\n- [**out\\_of\\_range**(3)](#out_of_range) - Whether a value cannot be converted safely.\n- [**real**(3)](#real) - Convert to real type\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "DIGITS": "## digits\n\n### **Name**\n\n**digits** - \\[MODEL:NUMERIC\\] Significant digits in the numeric model\n\n### **Synopsis**\n```fortran\n result = digits(x)\n```\n```fortran\n integer function digits(x)\n\n TYPE(kind=KIND),intent(in) :: x(..)\n```\n### **Characteristics**\n\n - **x** an _integer_ or _real_ scalar or array\n\n - The return value is an _integer_ of default kind.\n\n### **Description**\n\n **digits** returns the number of significant digits of the internal\n model representation of **x**. For example, on a system using a 32-bit\n floating point representation, a default real number would likely\n return 24.\n\n### **Options**\n\n- **x**\n : a value of the type and kind to query\n\n### **Result**\n\n The number of significant digits in a variable of the type and kind\n of **x**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_digits\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0:,1x))'\ninteger :: i = 12345\nreal :: x = 3.143\ndoubleprecision :: y = 2.33d0\n print all, 'default integer: ', digits(i)\n print all, 'default real: ', digits(x)\n print all, 'default doubleprecision:', digits(y)\nend program demo_digits\n```\nResults:\n```text\n > default integer: 31\n > default real: 24\n > default doubleprecision: 53\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "DIM": "## dim\n\n### **Name**\n\n**dim** - \\[NUMERIC\\] Positive difference of X - Y\n\n### **Synopsis**\n```fortran\n result = dim(x, y)\n```\n```fortran\n elemental TYPE(kind=KIND) function dim(x, y )\n\n TYPE(kind=KIND),intent(in) :: x, y\n```\n### **Characteristics**\n\n- **x** and **y** may be any _real_ or _integer_ but of the same type\n and kind\n- the result is of the same type and kind as the arguments\n\n### **Description**\n\n **dim** returns the maximum of **x - y** and zero.\n That is, it returns the difference **x - y** if the result is positive;\n otherwise it returns zero. It is equivalent to\n```fortran\n max(0,x-y)\n```\n### **Options**\n\n- **x**\n : the subtrahend, ie. the number being subtracted from.\n\n- **y**\n : the minuend; ie. the number being subtracted\n\n### **Result**\n\nReturns the difference **x - y** or zero, whichever is larger.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_dim\nuse, intrinsic :: iso_fortran_env, only : real64\nimplicit none\ninteger :: i\nreal(kind=real64) :: x\n\n ! basic usage\n i = dim(4, 15)\n x = dim(4.321_real64, 1.111_real64)\n print *, i\n print *, x\n\n ! elemental\n print *, dim([1,2,3],2)\n print *, dim([1,2,3],[3,2,1])\n print *, dim(-10,[0,-10,-20])\n\nend program demo_dim\n```\nResults:\n```text\n > 0\n > 3.21000000000000\n > 0 0 1\n > 0 0 2\n > 0 0 10\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n - [**abs**(3)](#abs) - Absolute value\n - [**aint**(3)](#aint) - Truncate toward zero to a whole number\n - [**anint**(3)](#anint) - Real nearest whole number\n - [**ceiling**(3)](#ceiling) - Integer ceiling function\n - [**conjg**(3)](#conjg) - Complex conjugate of a complex value\n - [**dim**](#dim) - Positive difference of X - Y\n - [**dprod**(3)](#dprod) - Double precision real product\n - [**floor**(3)](#floor) - Function to return largest integral value\n - [**max**(3)](#max) - Maximum value of an argument list\n - [**min**(3)](#min) - Minimum value of an argument list\n - [**mod**(3)](#mode) - Remainder function\n - [**sign**(3)](#sign) - Sign copying function\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "DOT_PRODUCT": "## dot_product\n\n### **Name**\n\n**dot_product** - \\[ARRAY:TRANSFORMATIONAL\\] Dot product of two vectors\n\n### **Synopsis**\n```fortran\n result = dot_product(vector_a, vector_b)\n```\n```fortran\n TYPE(kind=KIND) function dot_product(vector_a, vector_b)\n\n TYPE(kind=KIND),intent(in) :: vector_a(:)\n TYPE(kind=KIND),intent(in) :: vector_b(:)\n```\n### **Characteristics**\n\n - **vector_a**, **vector_b** may be any numeric or logical type array\n of rank one of the same size\n - the two vectors need not be of the same kind, but both must be logical\n or numeric for any given call.\n - the result is the same type and kind of the vector that is the higher\n type that the other vector is optionally promoted to if they differ.\n\nThe two vectors may be either numeric or logical and must be arrays\nof rank one and of equal size.\n\n### **Description**\n\n**dot_product** computes the dot product\nmultiplication of two vectors **vector_a** and **vector_b**.\n\n### **Options**\n\n- **vector_a**\n : A rank 1 vector of values\n\n- **vector_b**\n : The type shall be numeric if **vector_a** is of numeric type\n or _logical_ if vector_a is of type _logical_. vector_b shall be a\n rank-one array of the same size as **vector_a**.\n\n### **Result**\n\nIf the arguments are numeric, the return value is a scalar of numeric\ntype. If the arguments are _logical_, the\nreturn value is _.true._ or _.false._.\n\nIf the vectors are _integer_ or _real_, the result is\n```fortran\n sum(vector_a*vector_b)\n```\nIf the vectors are _complex_, the result is\n```fortran\n sum(conjg(vector_a)*vector_b)\n```\nIf the vectors have size zero, the result has the value zero.\n\nIf the vectors are _logical_, the result is\n```fortran\n any(vector_a .and. vector_b)\n```\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_dot_prod\nimplicit none\n integer, dimension(3) :: a, b\n a = [ 1, 2, 3 ]\n b = [ 4, 5, 6 ]\n print '(3i3)', a\n print *\n print '(3i3)', b\n print *\n print *, dot_product(a,b)\nend program demo_dot_prod\n```\nResults:\n```text\n > 1 2 3\n >\n > 4 5 6\n >\n > 32\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**sum**(3)](#sum),\n[**conjg**(3)](#conjg),\n[**any**(3)](#any)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "DPROD": "## dprod\n\n### **Name**\n\n**dprod** - \\[NUMERIC\\] Double precision real product\n\n### **Synopsis**\n```fortran\n result = dprod(x,y)\n```\n```fortran\n elemental function dprod(x,y)\n\n real,intent(in) :: x\n real,intent(in) :: y\n doubleprecision :: dprod\n```\n### **Characteristics**\n\n - **x** is a default real.\n - **y** is a default real.\n - the result is a _doubleprecision_ real.\n\n The setting of compiler options specifying the size of a default _real_\n can affect this function.\n\n### **Description**\n\n **dprod** produces a _doubleprecision_ product of default _real_\n values **x** and **y**.\n\n That is, it is expected to convert the arguments to double precision\n before multiplying, which a simple expression **x\\*y** would not be\n required to do. This can be significant in specialized computations\n requiring high precision.\n\n The result has a value equal to a processor-dependent approximation\n to the product of **x** and **y**. Note it is recommended in the\n standard that the processor compute the product in double precision,\n rather than in single precision then converted to double precision;\n but is only a recommendation.\n\n### **Options**\n\n- **x**\n : the multiplier\n\n- **y**\n : the multiplicand\n\n### **Result**\n\nThe returned value of the product should have the same value as\n**dble(x)\\*dble(y)**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_dprod\nimplicit none\ninteger,parameter :: dp=kind(0.0d0)\nreal :: x = 5.2\nreal :: y = 2.3\ndoubleprecision :: xx\nreal(kind=dp) :: dd\n\n print *,'algebraically 5.2 x 2.3 is exactly 11.96'\n print *,'as floating point values results may differ slightly:'\n ! basic usage\n dd = dprod(x,y)\n print *, 'compare dprod(xy)=',dd, &\n & 'to x*y=',x*y, &\n & 'to dble(x)*dble(y)=',dble(x)*dble(y)\n\n print *,'test if an expected result is produced'\n xx=-6.0d0\n write(*,*)DPROD(-3.0, 2.0),xx\n write(*,*)merge('PASSED','FAILED',DPROD(-3.0, 2.0) == xx)\n\n print *,'elemental'\n print *, dprod( [2.3,3.4,4.5], 10.0 )\n print *, dprod( [2.3,3.4,4.5], [9.8,7.6,5.4] )\n\nend program demo_dprod\n```\nResults:\n(this can vary between programming environments):\n```text\n > algebraically 5.2 x 2.3 is exactly 11.96\n > as floating point values results may differ slightly:\n > compare dprod(xy)= 11.9599993133545 to x*y= 11.96000\n > to dble(x)*dble(y)= 11.9599993133545\n > test if an expected result is produced\n > -6.00000000000000 -6.00000000000000\n > PASSED\n > elemental\n > 22.9999995231628 34.0000009536743 45.0000000000000\n > 22.5399999713898 25.8400004005432 24.3000004291534\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**dble**(3)](#dble)\n[**real**(3)](#real)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "DSHIFTL": "## dshiftl\n\n### **Name**\n\n**dshiftl** - \\[BIT:COPY\\] Combined left shift of the bits of two integers\n\n### **Synopsis**\n```fortran\n result = dshiftl(i, j, shift)\n```\n```fortran\n elemental integer(kind=KIND) function dshiftl(i, j, shift)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=KIND),intent(in) :: j\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - the kind of **i**, **j**, and the return value are the same. An\n exception is that one of **i** and **j** may be a BOZ literal constant\n (A BOZ literal constant is a binary, octal or hex constant).\n\n - If either I or J is a BOZ-literal-constant (but not both), it is\n first converted as if by the intrinsic function **int**(3) to type\n _integer_ with the kind type parameter of the other.\n\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **dshiftl** combines bits of **i** and **j**. The rightmost **shift**\n bits of the result are the leftmost **shift** bits of **j**, and the\n remaining bits are the rightmost **bitsize(i)-shift** of **i**.\n\n Hence **dshiftl** is designated as a \"combined left shift\", because\n it is like we appended **i** and **j** together, shifted it **shift**\n bits to the left, and then kept the same number of bits as **i** or\n **j** had.\n\n For example, for two 16-bit values if **shift=6**\n```text\n SHIFT=6\n I = 1111111111111111\n J = 0000000000000000\n COMBINED 11111111111111110000000000000000\n DROP LEFT BITS 11111111110000000000000000\n KEEP LEFT 16 1111111111000000\n```\n#### NOTE\n This is equivalent to\n```fortran\n ior( shiftl(i, shift), shiftr(j, bit_size(j) - shift) )\n```\n Also note that using this last representation of the operation is can\n be derived that when both **i** and **j** have the same value as in\n```fortran\n dshiftl(i, i, shift)\n```\n the result has the same value as a circular shift:\n```fortran\n ishftc(i, shift)\n```\n### **Options**\n\n- **i**\n : used to define the left pattern of bits in the combined pattern\n\n- **j**\n : used for the right pattern of bits in the combined pattern\n\n- **shift**\n : shall be nonnegative and less than or equal to the number of bits\n in an _integer_ input value (ie. the bit size of either one that is\n not a BOZ literal constant).\n\n### **Result**\n\n The leftmost **shift** bits of **j** are copied to the rightmost bits\n of the result, and the remaining bits are the rightmost bits of **i**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_dshiftl\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int32) :: i, j\ninteger :: shift\n\n ! basic usage\n write(*,*) dshiftl (1, 2**30, 2) ! int32 values on little-endian => 5\n\n ! print some simple calls as binary to better visual the results\n i=-1\n j=0\n shift=5\n call printit()\n\n ! the leftmost SHIFT bits of J are copied to the rightmost result bits\n j=int(b\"11111000000000000000000000000000\")\n ! and the other bits are the rightmost bits of I\n i=int(b\"00000000000000000000000000000000\")\n call printit()\n\n j=int(b\"11111000000000000000000000000000\")\n i=int(b\"00000111111111111111111111111111\")\n ! result should be all 1s\n call printit()\n\ncontains\nsubroutine printit()\n ! print i,j,shift and then i,j, and the result as binary values\n write(*,'(*(g0))')'I=',i,' J=',j,' SHIFT=',shift\n write(*,'(b32.32)') i,j, dshiftl (i, j, shift)\nend subroutine printit\n\nend program demo_dshiftl\n```\nResults:\n```text\n > 5\n > I=-1 J=0 SHIFT=5\n > 11111111111111111111111111111111\n > 00000000000000000000000000000000\n > 11111111111111111111111111100000\n > I=0 J=-134217728 SHIFT=5\n > 00000000000000000000000000000000\n > 11111000000000000000000000000000\n > 00000000000000000000000000011111\n > I=134217727 J=-134217728 SHIFT=5\n > 00000111111111111111111111111111\n > 11111000000000000000000000000000\n > 11111111111111111111111111111111\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**dshiftr**(3)](#dshiftr)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "DSHIFTR": "## dshiftr\n\n### **Name**\n\n**dshiftr** - \\[BIT:COPY\\] Combined right shift of the bits of two integers\n\n### **Synopsis**\n```fortran\n result = dshiftr(i, j, shift)\n```\n```fortran\n elemental integer(kind=KIND) function dshiftr(i, j, shift)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=KIND),intent(in) :: j\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - a kind designated as ** may be any kind value for the _integer_ type\n\n - the kind of **i**, **j**, and the return value are the same. An\n exception is that one of **i** and **j** may be a BOZ literal constant\n (A BOZ literal constant is a binary, octal or hex constant).\n\n - If either I or J is a BOZ-literal-constant, it is first converted\n as if by the intrinsic function **int**(3) to type _integer_ with the\n kind type parameter of the other.\n\n### **Description**\n\n **dshiftr** combines bits of **i** and **j**. The leftmost **shift**\n bits of the result are the rightmost **shift** bits of **i**, and the\n remaining bits are the leftmost bits of **j**.\n\n It may be thought of as appending the bits of **i** and **j**, dropping\n off the **shift** rightmost bits, and then retaining the same number\n of rightmost bits as an input value, hence the name \"combined right\n shift\"...\n\nGiven two 16-bit values labeled alphabetically ...\n```text\n i=ABCDEFGHIJKLMNOP\n j=abcdefghijklmnop\n```\nAppend them together\n```text\n ABCDEFGHIJKLMNOPabcdefghijklmnop\n```\nShift them N=6 bits to the right dropping off bits\n```text\n ABCDEFGHIJKLMNOPabcdefghij\n```\nKeep the 16 right-most bits\n```text\n KLMNOPabcdefghij\n```\n#### NOTE\n\n**dshifr(i,j,shift)** is equivalent to\n```fortran\n ior(shiftl (i, bit_size(i) - shift), shiftr(j, shift) )\n```\nit can also be seen that if **i** and **j** have the same\nvalue\n```fortran\n dshiftr( i, i, shift )\n```\nthis has the same result as a negative circular shift\n```fortran\n ishftc( i, -shift ).\n```\n### **Options**\n\n- **i**\n : left value of the pair of values to be combine-shifted right\n\n- **j**\n : right value of the pair of values to be combine-shifted right\n\n- **shift**\n : the shift value is non-negative and less than or equal to the number\n of bits in an input value as can be computed by **bit_size**(3).\n\n### **Result**\n\nThe result is a combined right shift of **i** and **j** that is the\nsame as the bit patterns of the inputs being combined left to right,\ndropping off **shift** bits on the right and then retaining the same\nnumber of bits as an input value from the rightmost bits.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_dshiftr\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int32) :: i, j\ninteger :: shift\n\n ! basic usage\n write(*,*) dshiftr (1, 2**30, 2)\n\n ! print some calls as binary to better visualize the results\n i=-1\n j=0\n shift=5\n\n ! print values\n write(*,'(*(g0))')'I=',i,' J=',j,' SHIFT=',shift\n write(*,'(b32.32)') i,j, dshiftr (i, j, shift)\n\n ! visualizing a \"combined right shift\" ...\n i=int(b\"00000000000000000000000000011111\")\n j=int(b\"11111111111111111111111111100000\")\n ! appended together ( i//j )\n ! 0000000000000000000000000001111111111111111111111111111111100000\n ! shifted right SHIFT values dropping off shifted values\n ! 00000000000000000000000000011111111111111111111111111111111\n ! keep enough rightmost bits to fill the kind\n ! 11111111111111111111111111111111\n ! so the result should be all 1s bits ...\n\n write(*,'(*(g0))')'I=',i,' J=',j,' SHIFT=',shift\n write(*,'(b32.32)') i,j, dshiftr (i, j, shift)\n\nend program demo_dshiftr\n```\nResults:\n```text\n > 1342177280\n > I=-1 J=0 SHIFT=5\n > 11111111111111111111111111111111\n > 00000000000000000000000000000000\n > 11111000000000000000000000000000\n > I=31 J=-32 SHIFT=5\n > 00000000000000000000000000011111\n > 11111111111111111111111111100000\n > 11111111111111111111111111111111\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**dshiftl**(3)](#dshiftl)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "EOSHIFT": "## eoshift\n\n### **Name**\n\n**eoshift** - \\[ARRAY:TRANSFORMATIONAL\\] End-off shift of elements of an array\n\n### **Synopsis**\n```fortran\n result = eoshift( array, shift [,boundary] [,dim] )\n```\n```fortran\n type(TYPE(kind=KIND)) function eoshift(array,shift,boundary,dim)\n\n type(TYPE(kind=KIND)),intent(in) :: array(..)\n integer(kind=**),intent(in) :: shift(..)\n type(TYPE(kind=KIND)),intent(in) :: boundary(..)\n integer(kind=**),intent(in) :: dim\n```\n### **Characteristics**\n\n - **array** an array of any type\n - **shift** is an integer of any kind. It may be a scalar.\n If the rank of **array** is greater than one, and **dim** is\n specified it is the same shape as **array** reduced by removing\n dimension **dim**.\n - **boundary** May be a scalar of the same type and kind as **array**.\n It must be a scalar when **array** has a rank of one. Otherwise, it\n may be an array of the same shape as **array** reduced by dimension\n **dim**. It may only be absent for certain types, as described below.\n - **dim** is an integer of any kind. It defaults to one.\n - the result has the same type, type parameters, and shape as **array**.\n - a kind designated as ** may be any supported kind for the type\n\n - The result is an array of same type, kind and rank as the **array**\n argument.\n\n### **Description**\n\n **eoshift** performs an end-off shift on elements of **array**\n along the dimension of **dim**.\n\n Elements shifted out one end of each rank one section are dropped.\n\n If **boundary** is present then the corresponding value from\n **boundary** is copied back in the other end, else default values\n are used.\n\n### **Options**\n\n- **array**\n : array of any type whose elements are to be shifted.\n If the rank of **array** is one, then all elements of **array** are\n shifted by **shift** places. If rank is greater than one, then all\n complete rank one sections of **array** along the given dimension\n are shifted.\n\n- **shift**\n : the number of elements to shift. A negative value shifts to the\n right, a positive value to the left of the vector(s) being shifted.\n\n- **boundary**\n : the value to use to fill in the elements vacated by the shift.\n If **boundary** is not present then the following are copied in\n depending on the type of **array**.\n```text\n Array Type | Boundary Value\n -----------------------------------------------------\n Numeric | 0, 0.0, or (0.0, 0.0) of the type and kind of \"array\"\n Logical | .false.\n Character(len)| LEN blanks\n```\n These are the only types for which **boundary** may not be present.\n For these types the kind is converted as neccessary to the kind of\n **array**.\n- **dim**\n : **dim** is in the range of\n```fortran\n 1 <= DIM <= n\n```\n where **\"n\"** is the rank of **array**. If **dim** is omitted it\n is taken to be **1**.\n\n### **Result**\n\n Returns an array of the same characteristics as the input with the\n specified number of elements dropped off along the specified direction\n indicated, backfilling the vacated elements with a value indicated by\n the **boundary** value.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_eoshift\nimplicit none\ninteger, dimension(3,3) :: a\ninteger :: i\n\n write(*,*)'original'\n a = reshape( [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ], [ 3, 3 ])\n call printi(a)\n\n write(*,*)'shift each row differently'\n a = eoshift(a, SHIFT=[1, 2, -2], BOUNDARY=-5, DIM=2)\n call printi(a)\n\n write(*,*)'shift each column differently'\n a = eoshift(a, SHIFT=[1, 2, -2], BOUNDARY=-5, DIM=1)\n call printi(a)\n\n write(*,*)'original'\n call printi(reshape([(i,i=1,12)],[3,4]))\n write(*,'(*(g0))')'shift=+2,dim=1'\n call printi(eoshift(reshape([(i,i=1,12)],[3,4]),+2,dim=1))\n write(*,'(*(g0))')'shift=+2,dim=2'\n call printi(eoshift(reshape([(i,i=1,12)],[3,4]),+2,dim=2))\n write(*,'(*(g0))')'shift=-2,dim=1'\n call printi(eoshift(reshape([(i,i=1,12)],[3,4]),-2,dim=1))\n write(*,'(*(g0))')'shift=-2,dim=2'\n call printi(eoshift(reshape([(i,i=1,12)],[3,4]),-2,dim=2))\ncontains\nsubroutine printi(arr)\n!@(#) print small 2d integer arrays in row-column format\ninteger,intent(in) :: arr(:,:) \ninteger :: i \ncharacter(len=40) :: biggest \n write(biggest,'(*(g0))')'(1x,*(i', &\n & ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2, &\n & ':,\",\"))'\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest)arr(i,:)\n enddo\nend subroutine printi\n\nend program demo_eoshift\n```\nResults:\n```text\n > original\n > 1, 4, 7\n > 2, 5, 8\n > 3, 6, 9\n > shift each row differently\n > 4, 7, -5\n > 8, -5, -5\n > -5, -5, 3\n > shift each column differently\n > 8, -5, -5\n > -5, -5, -5\n > -5, -5, -5\n > original\n > 1, 4, 7, 10\n > 2, 5, 8, 11\n > 3, 6, 9, 12\n > shift=+2,dim=1\n > 3, 6, 9, 12\n > 0, 0, 0, 0\n > 0, 0, 0, 0\n > shift=+2,dim=2\n > 7, 10, 0, 0\n > 8, 11, 0, 0\n > 9, 12, 0, 0\n > shift=-2,dim=1\n > 0, 0, 0, 0\n > 0, 0, 0, 0\n > 1, 4, 7, 10\n > shift=-2,dim=2\n > 0, 0, 1, 4\n > 0, 0, 2, 5\n > 0, 0, 3, 6\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**dshiftr**(3)](#dshiftr),\n[**dshiftl**(3)](#dshiftl)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "EPSILON": "## epsilon\n\n### **Name**\n\n**epsilon** - \\[MODEL:NUMERIC\\] Epsilon function\n\n### **Synopsis**\n```fortran\n result = epsilon(x)\n```\n```fortran\n real(kind=kind(x)) function epsilon(x)\n\n real(kind=kind(x),intent(in) :: x(..)\n```\n### **Characteristics**\n\n - **x** shall be of type _real_. It may be a scalar or an array.\n - the result is a scalar of the same type and kind type parameter as **x**.\n\n### **Description**\n\n**epsilon** returns the floating point relative accuracy.\nIt is the nearly negligible number relative to **1**\nsuch that **1+ little_number** is not equal to **1**; or more\nprecisely\n```fortran\n real( 1.0, kind(x)) + epsilon(x) /= real( 1.0, kind(x))\n```\nIt may be thought of as the distance from 1.0 to the next largest\nfloating point number.\n\nOne use of **epsilon** is to select a _delta_ value for algorithms that\nsearch until the calculation is within _delta_ of an estimate.\n\nIf _delta_ is too small the algorithm might never halt, as a computation\nsumming values smaller than the decimal resolution of the data type does\nnot change.\n\n### **Options**\n\n- **x**\n : The type shall be _real_.\n\n### **Result**\n\nThe return value is of the same type as the argument.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_epsilon\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=sp) :: x = 3.143\nreal(kind=dp) :: y = 2.33d0\n\n ! so if x is of type real32, epsilon(x) has the value 2**-23\n print *, epsilon(x)\n ! note just the type and kind of x matter, not the value\n print *, epsilon(huge(x))\n print *, epsilon(tiny(x))\n\n ! the value changes with the kind of the real value though\n print *, epsilon(y)\n\n ! adding and subtracting epsilon(x) changes x\n write(*,*)x == x + epsilon(x)\n write(*,*)x == x - epsilon(x)\n\n ! these next two comparisons will be .true. !\n write(*,*)x == x + epsilon(x) * 0.999999\n write(*,*)x == x - epsilon(x) * 0.999999\n\n ! you can calculate epsilon(1.0d0)\n write(*,*)my_dp_eps()\n\ncontains\n\n function my_dp_eps()\n ! calculate the epsilon value of a machine the hard way\n real(kind=dp) :: t\n real(kind=dp) :: my_dp_eps\n\n ! starting with a value of 1, keep dividing the value\n ! by 2 until no change is detected. Note that with\n ! infinite precision this would be an infinite loop,\n ! but floating point values in Fortran have a defined\n ! and limited precision.\n my_dp_eps = 1.0d0\n SET_ST: do\n my_dp_eps = my_dp_eps/2.0d0\n t = 1.0d0 + my_dp_eps\n if (t <= 1.0d0) exit\n enddo SET_ST\n my_dp_eps = 2.0d0*my_dp_eps\n\n end function my_dp_eps\nend program demo_epsilon\n```\nResults:\n```text\n > 1.19209290E-07\n > 1.19209290E-07\n > 1.19209290E-07\n > 2.2204460492503131E-016\n > F\n > F\n > T\n > T\n > 2.2204460492503131E-016\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ERF": "## erf\n\n### **Name**\n\n**erf** - \\[MATHEMATICS\\] Error function\n\n### **Synopsis**\n```fortran\n result = erf(x)\n```\n```fortran\n elemental real(kind=KIND) function erf(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is of type _real_\n - The result is of the same _type_ and _kind_ as **x**.\n\n### **Description**\n\n**erf** computes the error function of **x**, defined as\n\n$$\n\\text{erf}(x) = \\frac{2}{\\sqrt{\\pi}} \\int_0^x e^{__-t__^2} dt.\n$$\n\n### **Options**\n\n- **x**\n : The type shall be _real_.\n\n### **Result**\n\nThe return value is of type _real_, of the same kind as **x** and lies in the\nrange **-1** \\<= **erf**(x) \\<= 1 .\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_erf\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 0.17_real64\n write(*,*)x, erf(x)\nend program demo_erf\n```\nResults:\n```text\n > 0.17000000000000001 0.18999246120180879\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n[**erfc**(3)](#erfc),\n[**erf_scaled**(3)](#erfc_scaled)\n\n### **Resources**\n\n- [Wikipedia:error function](https://en.wikipedia.org/wiki/Error_function)\n\n _Fortran intrinsic descriptions_\n", "ERFC": "## erfc\n\n### **Name**\n\n**erfc** - \\[MATHEMATICS\\] Complementary error function\n\n### **Synopsis**\n```fortran\n result = erfc(x)\n```\n```fortran\n elemental real(kind=KIND) function erfc(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is of type _real_ and any valid kind\n - **KIND** is any value valid for type _real_\n - the result has the same characteristics as **x**\n\n### **Description**\n\n **erfc** computes the complementary error function of **x**. Simply\n put this is equivalent to **1 - erf(x)**, but **erfc** is provided\n because of the extreme loss of relative accuracy if **erf(x)** is\n called for large **x** and the result is subtracted from **1**.\n\n **erfc(x)** is defined as\n\n\n\n$$\n\\text{erfc}(x) = 1 - \\text{erf}(x) = 1 - \\frac{2}{\\sqrt{\\pi}} \\int_x^{\\infty} e^{-t^2} dt.\n$$\n\n### **Options**\n\n- **x**\n : The type shall be _real_.\n\n### **Result**\n\n The return value is of type _real_ and of the same kind as **x**. It lies in\n the range\n```fortran\n 0 <= erfc(x) <= 2.\n```\nand is a processor-dependent approximation to the complementary error\nfunction of **x** ( **1-erf(x)** ).\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_erfc\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 0.17_real64\n write(*,'(*(g0))')'X=',x, ' ERFC(X)=',erfc(x)\n write(*,'(*(g0))')'equivalently 1-ERF(X)=',1-erf(x)\nend program demo_erfc\n```\nResults:\n```text\n > X=.1700000000000000 ERFC(X)=.8100075387981912\n > equivalently 1-ERF(X)=.8100075387981912\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n[**erf**(3)](#erf)\n[**erf_scaled**(3)](#erf_scaled)\n\n### **Resources**\n\n- [Wikipedia:error function](https://en.wikipedia.org/wiki/Error_function)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ERFC_SCALED": "## erfc_scaled\n\n### **Name**\n\n**erfc_scaled** - \\[MATHEMATICS\\] Scaled complementary error function\n\n### **Synopsis**\n```fortran\n result = erfc_scaled(x)\n```\n```fortran\n elemental real(kind=KIND) function erfc_scaled(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is of type _real_ of any valid kind\n - **KIND** is any kind valid for a _real_ type\n - the result has the same characteristics as **x**\n\n### **Description**\n\n**erfc_scaled** computes the exponentially-scaled complementary\nerror function of **x**:\n\n$$\ne^{x^2} \\frac{2}{\\sqrt{\\pi}} \\int_{x}^{\\infty}\ne^{-t^2} dt.\n$$\n\nerfc_scaled(x)=exp(x*x)erfc(x)\n\n\n#### NOTE1\n\n The complementary error function is asymptotic to\n exp(-X2)/(X/PI). As such it underflows at approximately X >= 9 when\n using ISO/IEC/IEEE 60559:2011 single precision arithmetic. The\n exponentially-scaled complementary error function is asymptotic to\n 1/(X PI). As such it does not underflow until X > HUGE (X)/PI.\n\n### **Options**\n\n- **x**\n the value to apply the **erfc** function to\n\n### **Result**\n\nThe approximation to the exponentially-scaled complementary error function\nof **x**\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_erfc_scaled\nimplicit none\nreal(kind(0.0d0)) :: x = 0.17d0\n x = erfc_scaled(x)\n print *, x\nend program demo_erfc_scaled\n```\nResults:\n```text\n > 0.833758302149981\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n[**erf**(3)](#erf),\n[**exp**(3)](#exp),\n[**erfc**(3)](#erfc)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "EVENT_QUERY": "## event_query\n\n### **Name**\n\n**event_query** - \\[COLLECTIVE\\] Query whether a coarray event has occurred\n\n### **Synopsis**\n```fortran\n call event_query(event, count [,stat] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**event_query** assigns the number of events to **count** which have been\nposted to the **event** variable and not yet been removed by calling\n**event_wait**. When **stat** is present and the invocation was successful, it\nis assigned the value **0**. If it is present and the invocation has failed,\nit is assigned a positive value and **count** is assigned the value **-1**.\n\n### **Options**\n\n- **event**\n : (intent(in)) Scalar of type event_type, defined in\n iso_fortran_env; shall not be coindexed.\n\n- **count**\n : (intent(out))Scalar integer with at least the precision of default\n _integer_.\n\n- **stat**\n : (OPTIONAL) Scalar default-kind _integer_ variable.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_event_query\nuse iso_fortran_env\nimplicit none\ntype(event_type) :: event_value_has_been_set[*]\ninteger :: cnt\n if (this_image() == 1) then\n call event_query(event_value_has_been_set, cnt)\n if (cnt > 0) write(*,*) \"Value has been set\"\n elseif (this_image() == 2) then\n event post(event_value_has_been_set[1])\n endif\nend program demo_event_query\n```\n### **Standard**\n\nTS 18508\n\n### **See also**\n\n - [co_broadcast(3)](#co_broadcast) - Copy a value to all images the current set of images\n - [co_lbound(3)](#co_lbound) - Lower codimension bounds of an array\n - [co_max(3)](#co_max) - Maximal value on the current set of images\n - [co_min(3)](#co_min) - Minimal value on the current set of images\n - [co_reduce(3)](#co_reduce) - Reduction of values on the current set of images\n - [co_sum(3)](#co_sum) - Sum of values on the current set of images\n - [co_ubound(3)](#co_ubound) - Upper codimension bounds of an array\n - [event_query(3)](#event_query) - Query whether a coarray event has occurred\n - [image_index(3)](#image_index) - Cosubscript to image index conversion\n - [lcobound(3)](#lcobound) - Lower codimension bounds of an array\n - [num_images(3)](#num_images) - Number of images\n - [this_image(3)](#this_image) - Cosubscript index of this image\n - [ucobound(3)](#ucobound) - Upper codimension bounds of an array\n\n _Fortran intrinsic descriptions_\n", "EXECUTE_COMMAND_LINE": "## execute_command_line\n\n### **Name**\n\n**execute_command_line** - \\[SYSTEM:PROCESSES\\] Execute a shell command\n\n### **Synopsis**\n```fortran\n call execute_command_line( &\n & command [,wait] [,exitstat] [,cmdstat] [,cmdmsg] )\n```\n```fortran\n subroutine execute_command_line(command,wait,exitstat,cmdstat,cmdmsg)\n\n character(len=*),intent(in) :: command\n logical,intent(in),optional :: wait\n integer,intent(inout),optional :: exitstat\n integer,intent(inout),optional :: cmdstat\n character(len=*),intent(inout),optional :: cmdmsg\n```\n### **Characteristics**\n - **command** is a default _character_ scalar\n - **wait** is a default _logical_ scalar. \n - **exitstat** is an _integer_ of the default kind.\n It must be of a kind with at least a decimal exponent range of 9.\n - **cmdstat** is an _integer_ of default kind. The kind of the variable\n must support at least a decimal exponent range of four.\n - **cmdmsg** is a _character_ scalar of the default kind.\n\n### **Description**\n\n For **execute_command_line** the **command** argument is passed\n to the shell and executed. (The shell is generally **sh**(1) on Unix\n systems, and cmd.exe on Windows.) If **wait** is present and has the\n value _.false._, the execution of the command is asynchronous if the\n system supports it; otherwise, the command is executed synchronously.\n\n The three last arguments allow the user to get status information. After\n synchronous execution, **exitstat** contains the integer exit code of\n the command, as returned by **system**. **cmdstat** is set to zero if\n the command line was executed (whatever its exit status was). **cmdmsg**\n is assigned an error message if an error has occurred.\n\n Note that the system call need not be thread-safe. It is the\n responsibility of the user to ensure that the system is not called\n concurrently if required.\n\n When the command is executed synchronously, **execute_command_line**\n returns after the command line has completed execution. Otherwise,\n **execute_command_line** returns without waiting.\n\n Because this intrinsic is making a system call, it is very system\n dependent. Its behavior with respect to signaling is processor\n dependent. In particular, on POSIX-compliant systems, the SIGINT and\n SIGQUIT signals will be ignored, and the SIGCHLD will be blocked. As\n such, if the parent process is terminated, the child process might\n not be terminated alongside.\n\n One of the most common causes of errors is that the program requested\n is not in the search path. You should make sure that the program to be\n executed is installed on your system and that it is in the system's\n path when the program calls it. You can check if it is installed by\n running it from the command prompt. If it runs successfully from the\n command prompt, it means that it is installed, and so you should\n next check that it is in the search path when the program executes\n (usually this means checking the environment variable PATH).\n\n### **Options**\n\n- **command**\n : the command line to be executed. The interpretation is\n programming-environment dependent.\n\n- **wait**\n : If **wait** is present with the\n value _.false._, and the processor supports asynchronous execution of\n the command, the command is executed asynchronously; otherwise it is\n executed synchronously.\n\n When the command is executed synchronously, **execute_command_line**\n returns after the command line has completed execution. Otherwise,\n **execute_command_line** returns without waiting.\n\n- **exitstat**\n : If the command is executed synchronously, it is assigned the value\n of the processor-dependent exit status. Otherwise, the value of\n **exitstat** is unchanged.\n\n- **cmdstat**\n : If an error condition occurs and **cmdstat** is not present, error\n termination of execution of the image is initiated.\n\n It is assigned the value **-1** if the processor does not support\n command line execution, a processor-dependent positive value if an\n error condition occurs, or the value **-2** if no error condition\n occurs but **wait** is present with the value false and the processor\n does not support asynchronous execution. Otherwise it is assigned\n the value 0.\n\n- **cmdmsg**\n : If an error condition occurs, it is assigned a processor-dependent\n explanatory message. Otherwise, it is unchanged.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_execute_command_line\nimplicit none\ninteger :: exitstat, cmdstat\ncharacter(len=256) :: cmdmsg\n\n call execute_command_line( &\n & command = \"external_prog.exe\", & \n & exitstat = exitstat, &\n & cmdstat = cmdstat, &\n & cmdmsg = cmdmsg) \n print *, \"Exit status of external_prog.exe was \", exitstat\n if(cmdstat.ne.0)then\n print *, ''//trim(cmdmsg)\n endif\n\n ! if asynchronous exitstat and cmdstat may not be relied on\n call execute_command_line(\"reindex_files.exe\", wait=.false.)\n print *, \"Now hopefully reindexing files in the background\"\n\n if(cmd('dir'))then\n write(*,*)'OK'\n else\n stop 4\n endif\n\n ! might short-circuit or not if a command fails\n if(all(cmd([character(len=80) :: 'date','time myprg','date'])))then\n write(*,*)'good time'\n else\n write(*,*)'bad time'\n endif\n\n stop 'end of program'\ncontains\n\nelemental impure function cmd(command)\n! a functional interface for calling system commands\nuse, intrinsic :: iso_fortran_env, only : &\n& stderr=>ERROR_UNIT, stdout=>OUTPUT_UNIT\ncharacter(len=*),intent(in) :: command\nlogical :: cmd\nlogical :: wait\ninteger :: exitstat\ninteger :: cmdstat\ncharacter(len=256) :: cmdmsg\n wait=.false.\n exitstat=0\n cmdstat=0\n call execute_command_line(command=command,wait=wait, &\n & exitstat=exitstat,cmdstat=cmdstat,cmdmsg=cmdmsg)\n if(cmdstat.ne.0)then\n flush(stdout)\n write(stderr,'(a)')trim(cmdmsg)\n flush(stderr)\n endif\n if(exitstat.ne.0)then\n flush(stdout)\n write(stderr,'(*(g0))')'exitstat=',exitstat,':',trim(command)\n flush(stderr)\n endif\n cmd=merge(.true.,.false.,exitstat==0)\nend function cmd\n\nend program demo_execute_command_line\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n[**get_environment_variable**(3)](#get_environment_variable)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "EXP": "## exp\n\n### **Name**\n\n**exp** - \\[MATHEMATICS\\] Base-e exponential function\n\n### **Synopsis**\n```fortran\n result = exp(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function exp(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be _real_ or _complex_ of any kind.\n - The return value has the same type and kind as **x**.\n\n### **Description**\n\n**exp** returns the value of _e_ (the base of natural logarithms)\nraised to the power of **x**.\n\n\"_e_\" is also known as _Euler's constant_.\n\nIf **x** is of type _complex_, its imaginary part is regarded as a value\nin radians such that if (see _Euler's formula_):\n```fortran\n cx=(re,im)\n```\nthen\n```fortran\n exp(cx) = exp(re) * cmplx(cos(im),sin(im),kind=kind(cx))\n```\nSince **exp** is the inverse function of **log**(3) the maximum valid magnitude\nof the _real_ component of **x** is **log(huge(x))**.\n\n### **Options**\n\n- **x**\n : The type shall be _real_ or _complex_.\n\n### **Result**\n\nThe value of the result is **e\\*\\*x** where **e** is Euler's constant.\n\nIf **x** is of type complex, its imaginary part is\nregarded as a value in radians.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_exp\nimplicit none\nreal :: x, re, im\ncomplex :: cx\n\n x = 1.0\n write(*,*)\"Euler's constant is approximately\",exp(x)\n\n !! complex values\n ! given\n re=3.0\n im=4.0\n cx=cmplx(re,im)\n\n ! complex results from complex arguments are Related to Euler's formula\n write(*,*)'given the complex value ',cx\n write(*,*)'exp(x) is',exp(cx)\n write(*,*)'is the same as',exp(re)*cmplx(cos(im),sin(im),kind=kind(cx))\n\n ! exp(3) is the inverse function of log(3) so\n ! the real component of the input must be less than or equal to\n write(*,*)'maximum real component',log(huge(0.0))\n ! or for double precision\n write(*,*)'maximum doubleprecision component',log(huge(0.0d0))\n\n ! but since the imaginary component is passed to the cos(3) and sin(3)\n ! functions the imaginary component can be any real value\n\nend program demo_exp\n```\nResults:\n```text\n > Euler's constant is approximately 2.71828175 \n > given the complex value (3.00000000,4.00000000)\n > exp(x) is (-13.1287832,-15.2007847)\n > is the same as (-13.1287832,-15.2007847)\n > maximum real component 88.7228394 \n > maximum doubleprecision component 709.78271289338397 \n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n- [**log**(3)](#log)\n\n### **Resources**\n\n- Wikipedia:[Exponential function](https://en.wikipedia.org/wiki/Exponential_function)\n\n- Wikipedia:[Euler's formula](https://en.wikipedia.org/wiki/Euler%27s_formula)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "EXPONENT": "## exponent\n\n### **Name**\n\n**exponent** - \\[MODEL:COMPONENTS\\] Exponent of floating-point number\n\n### **Synopsis**\n```fortran\n result = exponent(x)\n```\n```fortran\n elemental integer function exponent(x)\n\n real(kind=**),intent(in) :: x\n```\n### **Characteristics**\n - **x** shall be of type _real_ of any valid kind\n - the result is a default _integer_ type\n\n### **Description**\n\n **exponent** returns the value of the exponent part of **x**, provided\n the exponent is within the range of default _integers_.\n\n### **Options**\n\n- **x**\n : the value to query the exponent of\n\n### **Result**\n\n **exponent** returns the value of the exponent part of **x**\n\n If **x** is zero the value returned is zero.\n\n If **x** is an IEEE infinity or NaN, the result has the value HUGE(0).\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_exponent\nimplicit none\nreal :: x = 1.0\ninteger :: i\n i = exponent(x)\n print *, i\n print *, exponent(0.0)\n print *, exponent([10.0,100.0,1000.0,-10000.0])\n ! beware of overflow, it may occur silently\n !print *, 2**[10.0,100.0,1000.0,-10000.0]\n print *, exponent(huge(0.0))\n print *, exponent(tiny(0.0))\nend program demo_exponent\n```\nResults:\n```text\n > 4 7 10 14\n > 128\n > -125\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions_\n", "EXTENDS_TYPE_OF": "## extends_type_of\n\n### **Name**\n\n**extends_type_of** - \\[STATE:INQUIRY\\] Determine if the dynamic type\nof **a** is an extension of the dynamic type of **mold**.\n\n### **Synopsis**\n```fortran\n result = extends_type_of(a, mold)\n```\n```fortran\n logical extends_type_of(a, mold)\n\n type(TYPE(kind=KIND)),intent(in) :: a\n type(TYPE(kind=KIND)),intent(in) :: mold\n```\n### **Characteristics**\n -**a** shall be an object or pointer to an extensible declared type,\n or unlimited polymorphic. If it is a polymorphic pointer, it\n shall not have an undefined association status.\n -**mole** shall be an object or pointer to an extensible declared type\n or unlimited polymorphic. If it is a polymorphic pointer,\n it shall not have an undefined association status.\n - the result is a scalar default logical type.\n\n### **Description**\n\n **extends_type_of** is .true. if and only if the dynamic type of\n **a** is or could be (for unlimited polymorphic) an extension of the\n dynamic type of **mold**.\n\n#### NOTE1\n\n The dynamic type of a disassociated pointer or unallocated allocatable\n variable is its declared type.\n\n#### NOTE2\n\n The test performed by **extends_type_of** is not the same as the\n test performed by the type guard **class is**. The test performed by\n **extends_type_of** does not consider kind type parameters.\n\n### **options**\n- **a**\n : be an object of extensible declared type or unlimited\n polymorphic. If it is a polymorphic pointer, it shall not have an\n undefined association status.\n\n- **mold**\n : be an object of extensible declared type or unlimited\n polymorphic. If it is a polymorphic pointer, it shall not have an\n undefined association status.\n\n### **Result**\n\n If **mold** is unlimited polymorphic and is either a disassociated\n pointer or unallocated allocatable variable, the result is true.\n\n Otherwise if **a** is unlimited polymorphic and is either a\n disassociated pointer or unallocated allocatable variable, the result\n is false.\n\n Otherwise the result is true if and only if the dynamic type of **a**\n\n if the dynamic type of A or MOLD is extensible, the result is true if\n and only if the dynamic type of A is an extension type of the dynamic\n type of MOLD; otherwise the result is processor dependent.\n\n\n### **Examples**\n\nSample program:\n```fortran\n ! program demo_extends_type_of\n module M_demo_extends_type_of\n implicit none\n private\n\n type nothing\n end type nothing\n\n type, extends(nothing) :: dot\n real :: x=0\n real :: y=0\n end type dot\n\n type, extends(dot) :: point\n real :: z=0\n end type point\n\n type something_else\n end type something_else\n\n public :: nothing\n public :: dot\n public :: point\n public :: something_else\n\n end module M_demo_extends_type_of\n\n program demo_extends_type_of\n use M_demo_extends_type_of, only : nothing, dot, point, something_else\n implicit none\n type(nothing) :: grandpa\n type(dot) :: dad\n type(point) :: me\n type(something_else) :: alien\n\n write(*,*)'these should all be true'\n write(*,*)extends_type_of(me,grandpa),'I am descended from Grandpa'\n write(*,*)extends_type_of(dad,grandpa),'Dad is descended from Grandpa'\n write(*,*)extends_type_of(me,dad),'Dad is my ancestor'\n\n write(*,*)'is an object an extension of itself?'\n write(*,*)extends_type_of(grandpa,grandpa) ,'self-propagating!'\n write(*,*)extends_type_of(dad,dad) ,'clone!'\n\n write(*,*)' you did not father your grandfather'\n write(*,*)extends_type_of(grandpa,dad),'no paradox here'\n\n write(*,*)extends_type_of(dad,me),'no paradox here'\n write(*,*)extends_type_of(grandpa,me),'no relation whatsoever'\n write(*,*)extends_type_of(grandpa,alien),'no relation'\n write(*,*)extends_type_of(me,alien),'not what everyone thinks'\n\n call pointers()\n contains\n\n subroutine pointers()\n ! Given the declarations and assignments\n type t1\n real c\n end type\n type, extends(t1) :: t2\n end type\n class(t1), pointer :: p, q\n allocate (p)\n allocate (t2 :: q)\n ! the result of EXTENDS_TYPE_OF (P, Q) will be false, and the result\n ! of EXTENDS_TYPE_OF (Q, P) will be true.\n write(*,*)'(P,Q)',extends_type_of(p,q),\"mind your P's and Q's\"\n write(*,*)'(Q,P)',extends_type_of(q,p)\n end subroutine pointers\n\n end program demo_extends_type_of\n```\nResults:\n```text\n > these should all be true\n > T I am descended from Grandpa\n > T Dad is descended from Grandpa\n > T Dad is my ancestor\n > is an object an extension of itself?\n > T self-propagating!\n > T clone!\n > you did not father your grandfather\n > F no paradox here\n > F no paradox here\n > F no relation whatsoever\n > F no relation\n > F not what everyone thinks\n > (P,Q) F mind your P's and Q's\n > (Q,P) T\n```\n### **Standard**\n\n Fortran 2003\n\n### **See Also**\n\n[**same_type_as**(3)](#same_type_as)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "FINDLOC": "## findloc\n\n### **Name**\n\n**findloc** - \\[ARRAY:LOCATION\\] Location of first element of ARRAY\nidentified by MASK along dimension DIM matching a target value\n\n### **Synopsis**\nSyntax:\n```fortran\n result = findloc (array, value, dim [,mask] [,kind] [,back])\n or\n result = findloc (array, value [,mask] [,kind] [,back])\n```\n```fortran\n function findloc (array, value, dim, mask, kind, back)\n\n type(TYPE(kind=KIND)),intent(in) :: array(..)\n type(TYPE(kind=KIND)),intent(in) :: value\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n integer(kind=**),intent(in),optional :: kind\n logical(kind=**),intent(in),optional :: back\n```\n### **Characteristics**\n\n- **array** is an array of any intrinsic type.\n- **value** shall be scalar but in type conformance with **array**,\n as specified for the operator == or the operator .EQV..\n- **dim** an _integer_ corresponding to a dimension of **array**.\n The corresponding actual argument shall not be an optional dummy\n argument.\n- **mask** is logical and shall be conformable with **array**.\n- **kind** a scalar integer initialization expression (ie. a constant)\n- **back** a logical scalar.\n- the result is _integer_ of default kind or kind **kind** if the\n **kind** argument is present. If **dim** does not appear, the result\n is an array of rank one and of size equal to the rank of **array**;\n otherwise, the result is an array of the same rank and shape as\n **array** reduced by the dimension **dim**.\n\n**NOTE**: a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**findloc** returns the location of the first element of **array**\nidentified by **mask** along dimension **dim** having a value equal\nto **value**.\n\nIf both **array** and **value** are of type logical, the comparison is\nperformed with the **.eqv.** operator; otherwise, the comparison is\nperformed with the == operator. If the value of the comparison is\n_.true._, that element of **array** matches **value**.\n\nIf only one element matches **value**, that element's subscripts are\nreturned. Otherwise, if more than one element matches **value** and\n**back** is absent or present with the value _.false._, the element whose\nsubscripts are returned is the first such element, taken in array\nelement order. If **back** is present with the value _.true._, the element\nwhose subscripts are returned is the last such element, taken in array\nelement order.\n\n### **Options**\n\n- **array**\n : shall be an array of intrinsic type.\n\n- **value**\n : shall be scalar and in type conformance with **array**.\n\n- **dim**\n : shall be an integer scalar with a value in the range 1 <= **DIM** <=\n n, where n is the rank of **array**. The corresponding actual argument\n shall not be an optional dummy argument.\n\n- **mask**\n : (optional) shall be of type logical and shall be conformable with\n **array**.\n\n- **kind**\n : (optional) shall be a scalar integer initialization expression.\n\n- **back**\n : (optional) shall be a logical scalar.\n\n### **Result**\n\n**kind** is present, the kind type\nparameter is that specified by the value of **kind**; otherwise the kind\ntype parameter is that of default integer type. If **dim** does not appear,\nthe result is an array of rank one and of size equal to the rank of\n**array**; otherwise, the result is of rank n - 1 and shape\n```\n [d1, d2, . . ., dDIM-1, dDIM+1, . . ., dn ]\n```\nwhere\n```\n [d1, d2, . . ., dn ]\n```\nis the shape of **array**.\n\n### **Result**\n\n- **Case (i):**\n The result of **findloc (array, value)** is a rank-one array whose\n element values are the values of the subscripts of an element of\n **array** whose value matches **value**. If there is such a value, the\n ith subscript returned lies in the range 1 to ei, where ei is the\n extent of the ith dimension of **array**. If no elements match **value**\n or **array** has size zero, all elements of the result are zero.\n\n- **Case (ii):**\n the result of **findloc (array, value, mask = mask)** is a\n rank-one array whose element values are the values of the subscripts\n of an element of **array**, corresponding to a true element of **mask**,\n whose value matches **value**. If there is such a value, the ith\n subscript returned lies in the range 1 to ei, where ei is the\n extent of the ith dimension of **array**. If no elements match\n **value**, **array** has size zero, or every element of **mask** has the\n value false, all elements of the result are zero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_findloc\nlogical,parameter :: T=.true., F=.false.\ninteger,allocatable :: ibox(:,:)\nlogical,allocatable :: mask(:,:)\n ! basics\n ! the first element matching the value is returned AS AN ARRAY\n call printi('== 6',findloc ([2, 6, 4, 6], value = 6))\n call printi('== 6',findloc ([2, 6, 4, 6], value = 6,back=.true.))\n ! the first element matching the value is returned AS A SCALAR\n call printi('== 6',findloc ([2, 6, 4, 6], value = 6,dim=1))\n call printi('== 6',findloc ([2, 6, 4, 6], value = 6,back=.true.,dim=1))\n\n ibox=reshape([ 0,-5, 7, 7, &\n 3, 4, -1, 2, &\n 1, 5, 6, 7] ,shape=[3,4],order=[2,1])\n\n mask=reshape([ T, T, F, T, &\n T, T, F, T, &\n T, T, F, T] ,shape=[3,4],order=[2,1])\n\n call printi('array is', ibox )\n call printl('mask is', mask )\n print *, 'so for == 7 and back=.false.'\n call printi('so for == 7 the address of the element is', &\n & findloc (ibox, 7, mask = mask) )\n print *, 'so for == 7 and back=.true.'\n call printi('so for == 7 the address of the element is', &\n & findloc (ibox, 7, mask = mask, back=.true.) )\n\n print *,'This is independent of declared lower bounds for the array'\n\n print *, ' using dim=N'\n ibox=reshape([ 1, 2, -9, &\n 2, 2, 6 ] ,shape=[2,3],order=[2,1])\n\n call printi('array is', ibox )\n ! has the value [2, 1, 0] and\n call printi('',findloc (ibox, value = 2, dim = 1) )\n ! has the value [2, 1].\n call printi('',findloc (ibox, value = 2, dim = 2) )\ncontains\n! GENERIC ROUTINES TO PRINT MATRICES\nsubroutine printl(title,a)\nimplicit none\n!@(#) print small 2d logical scalar, vector, matrix in row-column format\ncharacter(len=*),intent(in) :: title\nlogical,intent(in) :: a(..)\n\ncharacter(len=*),parameter :: row='(\" > [ \",*(l1:,\",\"))'\ncharacter(len=*),parameter :: all='(\" \",*(g0,1x))'\nlogical,allocatable :: b(:,:)\ninteger :: i\n write(*,all,advance='no')trim(title)\n ! copy everything to a matrix to keep code simple\n select rank(a)\n rank (0); write(*,'(a)')' (a scalar)'; b=reshape([a],[1,1])\n rank (1); write(*,'(a)')' (a vector)'; b=reshape(a,[size(a),1])\n rank (2); write(*,'(a)')' (a matrix)'; b=a\n rank default; stop '*printl* unexpected rank'\n end select\n do i=1,size(b,dim=1)\n write(*,fmt=row,advance='no')b(i,:)\n write(*,'(\" ]\")')\n enddo\n write(*,all) '>shape=',shape(a),',rank=',rank(a),',size=',size(a)\n write(*,*)\nend subroutine printl\n\nsubroutine printi(title,a)\nimplicit none\n!@(#) print small 2d integer scalar, vector, matrix in row-column format\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: a(..)\ncharacter(len=*),parameter :: all='(\" \",*(g0,1x))'\ncharacter(len=20) :: row\ninteger,allocatable :: b(:,:)\ninteger :: i\n write(*,all,advance='no')trim(title)\n ! copy everything to a matrix to keep code simple\n select rank(a)\n rank (0); write(*,'(a)')' (a scalar)'; b=reshape([a],[1,1])\n rank (1); write(*,'(a)')' (a vector)'; b=reshape(a,[size(a),1])\n rank (2); write(*,'(a)')' (a matrix)'; b=a\n rank default; stop '*printi* unexpected rank'\n end select\n ! find how many characters to use for integers\n write(row,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(b))))))+2\n ! use this format to write a row\n row='(\" > [\",*(i'//trim(row)//':,\",\"))'\n do i=1,size(b,dim=1)\n write(*,fmt=row,advance='no')b(i,:)\n write(*,'(\" ]\")')\n enddo\n write(*,all) '>shape=',shape(a),',rank=',rank(a),',size=',size(a)\n write(*,*)\nend subroutine printi\nend program demo_findloc\n```\nResults:\n```text\n > == 6 (a vector)\n > > [ 2 ]\n > >shape= 1 ,rank= 1 ,size= 1\n >\n > == 6 (a vector)\n > > [ 4 ]\n > >shape= 1 ,rank= 1 ,size= 1\n >\n > == 6 (a scalar)\n > > [ 2 ]\n > >shape= ,rank= 0 ,size= 1\n >\n > == 6 (a scalar)\n > > [ 4 ]\n > >shape= ,rank= 0 ,size= 1\n >\n > array is (a matrix)\n > > [ 0, -5, 7, 7 ]\n > > [ 3, 4, -1, 2 ]\n > > [ 1, 5, 6, 7 ]\n > >shape= 3 4 ,rank= 2 ,size= 12\n >\n > mask is (a matrix)\n > > [ T,T,F,T ]\n > > [ T,T,F,T ]\n > > [ T,T,F,T ]\n > >shape= 3 4 ,rank= 2 ,size= 12\n >\n > so for == 7 and back=.false.\n > so for == 7 the address of the element is (a vector)\n > > [ 1 ]\n > > [ 4 ]\n > >shape= 2 ,rank= 1 ,size= 2\n >\n > so for == 7 and back=.true.\n > so for == 7 the address of the element is (a vector)\n > > [ 3 ]\n > > [ 4 ]\n > >shape= 2 ,rank= 1 ,size= 2\n >\n > This is independent of declared lower bounds for the array\n > using dim=N\n > array is (a matrix)\n > > [ 1, 2, -9 ]\n > > [ 2, 2, 6 ]\n > >shape= 2 3 ,rank= 2 ,size= 6\n >\n > (a vector)\n > > [ 2 ]\n > > [ 1 ]\n > > [ 0 ]\n > >shape= 3 ,rank= 1 ,size= 3\n >\n > (a vector)\n > > [ 2 ]\n > > [ 1 ]\n > >shape= 2 ,rank= 1 ,size= 2\n >\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n - [**maxloc**(3)](#maxloc) - Location of the maximum value within an array\n - [**minloc**(3)](#minloc) - Location of the minimum value within an array\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "FLOOR": "## floor\n\n### **Name**\n\n**floor** - \\[NUMERIC\\] Function to return largest integral value\nnot greater than argument\n\n### **Synopsis**\n```fortran\n result = floor(a [,kind])\n```\n```fortran\n elemental integer(kind=KIND) function floor( a ,kind )\n\n real(kind=**),intent(in) :: a\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- a kind designated as ** may be any supported kind for the type\n- **a** is a _real_ of any kind\n- _KIND_ is any valid value for type _integer_.\n- the result is an _integer_ of the specified or default kind\n\n### **Description**\n\n**floor** returns the greatest integer less than or equal to **a**.\n\nIn other words, it picks the whole number at or to the left of the value on\nthe number line.\n\nThis means care has to be taken that the magnitude of the _real_ value **a**\ndoes not exceed the range of the output value, as the range of values supported\nby _real_ values is typically larger than the range for _integers_.\n\n### **Options**\n\n- **a**\n : The value to operate on. Valid values are restricted by the size of\n the returned _integer_ kind to the range **-huge(int(a,kind=KIND))-1**\n to **huge(int(a),kind=KIND)**.\n\n- **kind**\n : A scalar _integer_ constant initialization expression\n indicating the kind parameter of the result.\n\n### **Result**\n\nThe return value is of type _integer(kind)_ if **kind** is present and of\ndefault-kind _integer_ otherwise.\n\nThe result is undefined if it cannot be represented in the specified\ninteger type.\n\nIf in range for the kind of the result the result is the whole number\nat or to the left of the input value on the number line.\n\nIf **a** is positive the result is the value with the fractional part\nremoved.\n\nIf **a** is negative, it is the whole number at or to the left of the\ninput value.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_floor\nimplicit none\nreal :: x = 63.29\nreal :: y = -63.59\n print *, x, floor(x)\n print *, y, floor(y)\n ! elemental\n print *,floor([ &\n & -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, &\n & 0.0, &\n & +0.5, +1.0, +1.5, +2.0, +2.2, +2.5, +2.7 ])\n\n ! note even a small deviation from the whole number changes the result\n print *, [2.0,2.0-epsilon(0.0),2.0-2*epsilon(0.0)]\n print *,floor([2.0,2.0-epsilon(0.0),2.0-2*epsilon(0.0)])\n\n ! A=Nan, Infinity or huge(0_KIND)-1 < A > huge(0_KIND) is undefined\nend program demo_floor\n```\nResults:\n```text\n > 63.29000 63\n > -63.59000 -64\n > -3 -3 -3 -2 -2 -1\n > -1 0 0 1 1 2\n > 2 2 2\n > 2.000000 2.000000 2.000000\n > 2 1 1\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ceiling**(3)](#ceiling),\n[**nint**(3)](#nint),\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**selected_int_kind**(3)](#selected_int_kind)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "FRACTION": "## fraction\n\n### **Name**\n\n**fraction** - \\[MODEL:COMPONENTS\\] Fractional part of the model representation\n\n### **Synopsis**\n```fortran\n result = fraction(x)\n```\n```fortran\n elemental real(kind=KIND) function fraction(x)\n\n real(kind=KIND),intent(in) :: fraction\n```\n### **Characteristics**\n\n - **x** is of type _real_\n - The result has the same characteristics as the argument.\n\n### **Description**\n\n **fraction** returns the fractional part of the model representation\n of **x**.\n\n### **Options**\n\n- **x**\n : The value to interrogate\n\n### **Result**\n\nThe fractional part of the model representation of **x** is returned;\nit is\n```fortran\n x * real(radix(x))**(-exponent(x))\n```\nIf **x** has the value zero, the result is zero.\n\nIf **x** is an IEEE NaN, the result is that NaN.\n\nIf **x** is an IEEE infinity, the result is an IEEE NaN.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_fraction\nimplicit none\nreal :: x\n x = 178.1387e-4\n print *, fraction(x), x * real(radix(x))**(-exponent(x))\n x = 10.0\n print *, fraction(x)\n print *, fraction(x) * 2**4\nend program demo_fraction\n```\nResults:\n```text\n > 0.570043862 0.570043862 \n > 0.625000000 \n > 10.0000000 \n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions_\n", "GAMMA": "## gamma\n\n### **Name**\n\n**gamma** - \\[MATHEMATICS\\] Gamma function, which yields factorials for positive whole numbers\n\n### **Synopsis**\n```fortran\n result = gamma(x)\n```\n```fortran\n elemental real(kind=**) 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", "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\n >001 00000 00001 [a]\n >002 00000 00004 [test]\n >003 00000 00022 [of getting arguments ]\n >004 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", "GET_ENVIRONMENT_VARIABLE": "## get_environment_variable\n\n### **Name**\n\n**get_environment_variable** - \\[SYSTEM:ENVIRONMENT\\]\n Retrieve the 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** retrieves 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\nWhen 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\n support environment variables **value** will be filled with blanks.\n\n- **length**\n : This argument contains the length needed to store the environment\n variable name. It is zero if the environment variable is not set.\n- **status**\n : Returns\n + **-1** if value is present but too short to fit in the provided variable.\n + **1** if the environment variable does not exist\n + **2** if the processor does not support environment variables\n + and **0** in all other cases.\n- **trim_name**\n : If present and set to .false. the trailing blanks in name\n are significant; otherwise, they are not considered part of the\n environment variable name.\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\nuse, intrinsic :: iso_fortran_env, only : stderr=>ERROR_UNIT\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 write(stderr,*) &\n & name, \" is not defined in the environment. Strange...\"\n value=''\n case (2)\n write(stderr,*) &\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", "HUGE": "## huge\n\n### **Name**\n\n**huge** - \\[MODEL:NUMERIC\\] 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 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\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 special case of the Euclidean distance between\nthe point **** and the origin. It is equal to\n```fortran\nsqrt(x**2+y**2)\n```\nwithout undue underflow or overflow.\n\n### **Options**\n\n- **x**\n: the x value of the point of interest\n\n- **y**\n: the y value of the point of interest\n\n### **Result**\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 : 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```\nResults:\n```text\n >\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", "IAND": "## iand\n\n### **Name**\n\n**iand** - \\[BIT:LOGICAL\\] Bitwise logical AND\n\n### **Synopsis**\n```fortran\n result = iand(i, j)\n```\n```fortran\n elemental integer(kind=KIND) function iand(i,j)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=KIND),intent(in) :: j\n```\n### **Characteristics**\n\n- **i**, **j** and the result shall have the same _integer_ type and kind,\n with the exception that one of **i** or **j** may be a BOZ constant.\n\n### **Description**\n\n**iand** returns the bitwise logical **and** of two values.\n\n### **Options**\n\n- **i**\n : one of the pair of values to compare the bits of\n\n- **j**\n : one of the pair of values to compare the bits of\n\nIf either **i** or **j** is a BOZ-literal-constant, it is first converted\nas if by the intrinsic function **int**(3) to type _integer_ with the\nkind type parameter of the other.\n\n### **Result**\n\nThe result has the value obtained by combining **i** and **i**\nbit-by-bit according to the following table:\n```text\n I | J | IAND (I, J)\n ----------------------------\n 1 | 1 | 1\n 1 | 0 | 0\n 0 | 1 | 0\n 0 | 0 | 0\n```\nSo if both the bit in **i** and **j** are on the resulting bit is on\n(a one); else the resulting bit is off (a zero).\n\nThis is commonly called the \"bitwise logical AND\" of the two values.\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_iand\nimplicit none\ninteger :: a, b\n data a / z'f' /, b / z'3' /\n write (*,*) 'a=',a,' b=',b,'iand(a,b)=',iand(a, b)\n write (*,'(b32.32)') a,b,iand(a,b)\nend program demo_iand\n```\nResults:\n```text\n > a= 15 b= 3 iand(a,b)= 3\n > 00000000000000000000000000001111\n > 00000000000000000000000000000011\n > 00000000000000000000000000000011\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IANY": "## iany\n\n### **Name**\n\n**iany** - \\[BIT:LOGICAL\\] Bitwise OR of array elements\n\n### **Synopsis**\n```fortran\n result = iany(array [,mask]) | iany(array ,dim [,mask])\n```\n```fortran\n integer(kind=KIND) function iany(array,dim,mask)\n\n integer(kind=KIND),intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - **array** is an _integer_ array\n - **dim** may be of any _integer_ kind.\n - **mask** is a _logical_ array that conforms to **array**\n - The result will by of the same type and kind\n as **array**. It is scalar if **dim** does not appear or is 1.\n Otherwise, it is the shape and rank of array reduced by the\n dimension **dim**.\n\n note a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **iany** reduces with bitwise **OR** (inclusive **OR**) the\n elements of **array** along dimension **dim** if the corresponding\n element in **mask** is _.true._.\n\n### **Options**\n\n- **array**\n : an array of elements to selectively **OR** based on the mask.\n\n- **dim**\n : a value in the range from **1 to n**, where **n** equals the rank\n of **array**.\n\n- **mask**\n : a _logical_ scalar; or an array of the same shape as **array**.\n\n### **Result**\n\n The result is of the same type as **array**.\n\n If **dim** is absent, a scalar with the bitwise _or_ of all elements in\n **array** is returned. Otherwise, an array of rank **n-1**, where **n**\n equals the rank of **array**, and a shape similar to that of **array**\n with dimension **dim** dropped is returned.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_iany\nuse, intrinsic :: iso_fortran_env, only : integer_kinds, &\n & int8, int16, int32, int64\nimplicit none\nlogical,parameter :: T=.true., F=.false.\ninteger(kind=int8) :: a(3)\n a(1) = int(b'00100100',int8)\n a(2) = int(b'01101010',int8)\n a(3) = int(b'10101010',int8)\n write(*,*)'A='\n print '(1x,b8.8)', a\n print *\n write(*,*)'IANY(A)='\n print '(1x,b8.8)', iany(a)\n print *\n write(*,*)'IANY(A) with a mask'\n print '(1x,b8.8)', iany(a,mask=[T,F,T])\n print *\n write(*,*)'should match '\n print '(1x,b8.8)', iany([a(1),a(3)])\n print *\n write(*,*)'does it?'\n write(*,*)iany(a,[T,F,T]) == iany([a(1),a(3)])\nend program demo_iany\n```\nResults:\n```text\n > A=\n > 00100100\n > 01101010\n > 10101010\n >\n > IANY(A)=\n > 11101110\n >\n > IANY(A) with a mask\n > 10101110\n >\n > should match\n > 10101110\n >\n > does it?\n > T\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**iparity**(3)](#iparity),\n[**iall**(3)](#iall),\n[**ior**(3)](#ior)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IBCLR": "## ibclr\n\n### **Name**\n\n**ibclr** - \\[BIT:SET\\] Clear a bit\n\n### **Synopsis**\n```fortran\n result = ibclr(i, pos)\n```\n```fortran\n elemental integer(kind=KIND) function ibclr(i,pos)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n```\n### **Characteristics**\n\n - **i** shall be type _integer_.\n - **pos** shall be type _integer_.\n - The return value is of the same kind as **i**.\n\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **ibclr** returns the value of **i** with the bit at position **pos**\n set to zero.\n\n### **Options**\n\n - **i**\n : The initial value to be modified\n\n - **pos**\n : The position of the bit to change in the input value. A value\n of zero refers to the right-most bit. The value of **pos** must be\n nonnegative and less than **(bit_size(i)**).\n\n### **Result**\n\nThe returned value has the same bit sequence as **i** except the\ndesignated bit is unconditionally set to **0**\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ibclr\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i\n ! basic usage\n print *,ibclr (16, 1), ' ==> ibclr(16,1) has the value 15'\n\n ! it is easier to see using binary representation\n i=int(b'0000000000111111',kind=int16)\n write(*,'(b16.16,1x,i0)') ibclr(i,3), ibclr(i,3)\n\n ! elemental\n print *,'an array of initial values may be given as well'\n print *,ibclr(i=[7,4096,9], pos=2)\n print *\n print *,'a list of positions results in multiple returned values'\n print *,'not multiple bits set in one value, as the routine is '\n print *,'a scalar function; calling it elementally essentially '\n print *,'calls it multiple times. '\n write(*,'(b16.16)') ibclr(i=-1_int16, pos=[1,2,3,4])\n\n ! both may be arrays if of the same size\n\nend program demo_ibclr\n```\nResults:\n```text\n > 16 ==> ibclr(16,1) has the value 15\n > 0000000000110111 55\n > an array of initial values may be given as well\n > 3 4096 9\n >\n > a list of positions results in multiple returned values\n > not multiple bits set in one value, as the routine is\n > a scalar function; calling it elementally essentially\n > calls it multiple times.\n > 1111111111111101\n > 1111111111111011\n > 1111111111110111\n > 1111111111101111\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibclr),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IBITS": "## ibits\n\n### **Name**\n\n**ibits** - \\[BIT:COPY\\] Extraction of a subset of bits\n\n### **Synopsis**\n```fortran\n result = ibits(i, pos, len)\n```\n```fortran\n elemental integer(kind=KIND) function ibits(i,pos,len)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n integer(kind=**),intent(in) :: len\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported _integer_ kind\n - **i** may be any supported _integer_ kind as well\n - the return value will be the same kind as **i**\n\n### **Description**\n\n**ibits** extracts a field of bits from **i**, starting\nfrom bit position **pos** and extending left for a total of **len** bits.\n\nThe result is then right-justified and the remaining left-most bits in the\nresult are zeroed.\n\nThe position **pos** is calculated assuming the right-most bit is zero and\nthe positions increment to the left.\n\n### **Options**\n\n - **i**\n : The value to extract bits from\n\n - **pos**\n : The position of the bit to start copying at. **pos** is\n non-negative.\n\n - **len**\n : the number of bits to copy from **i**. It must be non-negative.\n\n**pos + len** shall be less than or equal to **bit_size(i)**.\n\n### **Result**\n\nThe return value is composed of the selected bits right-justified,\nleft-padded with zeros.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ibits\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i,j\n ! basic usage\n print *,ibits (14, 1, 3) ! should be seven\n print *,ibits(-1,10,3) ! and so is this\n ! it is easier to see using binary representation\n i=int(b'0101010101011101',kind=int16)\n write(*,'(b16.16,1x,i0)') ibits(i,3,3), ibits(i,3,3)\n\n ! we can illustrate this as\n ! #-- position 15\n ! | #-- position 0\n ! | <-- +len |\n ! V V\n ! 5432109876543210\n i =int(b'1111111111111111',kind=int16)\n ! ^^^^\n j=ibits(i,10,4) ! start at 10th from left and proceed\n ! left for a total of 4 characters\n write(*,'(a,b16.16)')'j=',j\n ! lets do something less ambiguous\n i =int(b'0010011000000000',kind=int16)\n j=ibits(i,9,5)\n write(*,'(a,b16.16)')'j=',j\nend program demo_ibits\n```\nResults:\n```text\n > 7\n > 7\n > 0000000000000011 3\n > j=0000000000001111\n > j=0000000000010011\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibclr**(3)](#ibclr),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IBSET": "## ibset\n\n### **Name**\n\n**ibset** - \\[BIT:SET\\] Set a bit to one in an integer value\n\n### **Synopsis**\n```fortran\n result = ibset(i, pos)\n```\n```fortran\n elemental integer(kind=KIND) function ibset(i,pos)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: pos\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - The return value is of the same kind as **i**. Otherwise,\n any _integer_ kinds are allowed.\n\n### **Description**\n\n**ibset** returns the value of **i** with the bit at position **pos** set to one.\n\n### **Options**\n\n - **i**\n : The initial value to be modified\n\n - **pos**\n : The position of the bit to change in the input value. A value\n of zero refers to the right-most bit. The value of **pos** must be\n nonnegative and less than **(bit_size(i)**).\n\n### **Result**\n\nThe returned value has the same bit sequence as **i** except the\ndesignated bit is unconditionally set to **1**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ibset\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i\n ! basic usage\n print *,ibset (12, 1), 'ibset(12,1) has the value 14'\n\n ! it is easier to see using binary representation\n i=int(b'0000000000000110',kind=int16)\n write(*,'(b16.16,1x,i0,1x,i0)') ibset(i,12), ibset(i,12), i\n\n ! elemental\n print *,'an array of initial values may be given as well'\n print *,ibset(i=[0,4096], pos=2)\n print *\n print *,'a list of positions results in multiple returned values'\n print *,'not multiple bits set in one value, as the routine is '\n print *,'a scalar function; calling it elementally essentially '\n print *,'calls it multiple times. '\n write(*,'(b16.16)') ibset(i=0, pos=[1,2,3,4])\n\n ! both may be arrays if of the same size\n\nend program demo_ibset\n```\nResults:\n```text\n > 14 ibset(12,1) has the value 14\n > 0001000000000110 4102 6\n > an array of initial values may be given as well\n > 4 4100\n >\n > a list of positions results in multiple returned values\n > not multiple bits set in one value, as the routine is\n > a scalar function; calling it elementally essentially\n > calls it multiple times.\n > 0000000000000010\n > 0000000000000100\n > 0000000000001000\n > 0000000000010000\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ibclr**(3)](#ibclr)\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibits**(3)](#ibits),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ICHAR": "## ichar\n\n### **Name**\n\n**ichar** - \\[CHARACTER:CONVERSION\\] Character-to-integer code conversion function\n\n### **Synopsis**\n```fortran\n result = ichar(c [,kind])\n```\n```fortran\n elemental integer(kind=KIND) function ichar(c,KIND)\n\n character(len=1,kind=**),intent(in) :: c\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- **c** is a scalar _character_\n- **kind** is a constant _integer_ initialization expression indicating\n the kind parameter of the result.\n- The return value is of type _integer_ and of kind **kind**. If **kind**\n is absent, the return value is of default _integer_ kind.\n\n### **Description**\n\n **ichar** returns the code for the character in the system's native\n character set. The correspondence between characters and their codes is\n not necessarily the same across different Fortran implementations. For\n example, a platform using EBCDIC would return different values than an\n ASCII platform.\n\n See **iachar**(3) for specifically working with the ASCII character set.\n\n### **Options**\n\n- **c**\n : The input character to determine the decimal code of.\n The range of values capable of representation is processor-dependent.\n\n- **kind**\n : indicates the kind parameter of the result. If **kind** is absent,\n the return value is of default _integer_ kind.\n\n### **Result**\n\n The code in the system default character set for the character being\n queried is returned.\n\n The result is the position of **c** in the processor collating sequence\n associated with the kind type parameter of **c**.\n\n it is nonnegative and less than n, where n is the number of characters\n in the collating sequence.\n\n The kind type parameter of the result shall specify an integer kind\n that is capable of representing n.\n\n For any characters C and D capable of representation in the processor,\n C <= D is true if and only if ICHAR (C) <= ICHAR (D) is true and C ==\n D is true if and only if ICHAR (C) == ICHAR (D) is true.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_ichar\nuse,intrinsic :: iso_fortran_env, only : b=>int8\nimplicit none\ninteger,parameter :: bytes=80\ncharacter :: string*(bytes),lets((bytes))*1\ninteger(kind=b) :: ilets(bytes)\nequivalence (string,lets)\nequivalence (string,ilets)\n write(*,*)ichar(['a','z','A','Z'])\n string='Do unto others'\n associate (a=>ichar(lets))\n ilets=merge(a-32,a,a>=97.and.a<=122) ! uppercase\n write(*,*)string\n ilets=merge(a+32,a,a>=65.and.a<=90) ! lowercase\n write(*,*)string\n end associate\nend program demo_ichar\n```\nResults:\n```text\n > 97 122 65 90\n > DO UNTO OTHERS \n > do unto others \n```\n### **Standard**\n\nFortran 95, with KIND argument -Fortran 2003\n\n### **See Also**\n\n[**achar**(3)](#achar),\n[**char**(3)](#char),\n[**iachar**(3)](#iachar)\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n\n[**scan**(3)](#scan),\n[**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat),\n [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IEOR": "## ieor\n\n### **Name**\n\n**ieor** - \\[BIT:LOGICAL\\] Bitwise exclusive OR\n\n### **Synopsis**\n```fortran\n result = ieor(i, j)\n```\n```fortran\n elemental integer(kind=**) function ieor(i,j)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in) :: j\n```\n### **Characteristics**\n\n - **i**, **j** and the result must be of the same _integer_ kind.\n - An exception is that one of **i** and **j** may be a BOZ literal\n constant\n\n### **Description**\n\n **ieor** returns a bitwise exclusive-**or** of **i** and **j**.\n\n An exclusive OR or \"exclusive disjunction\" is a logical operation that\n is true if and only if its arguments differ. In this case a one-bit\n and a zero-bit substitute for true and false.\n\n This is often represented with the notation \"XOR\", for \"eXclusive OR\".\n\n An alternate way to view the process is that the result has the value\n obtained by combining **i** and **j** bit-by-bit according to the\n following table:\n\n > I | J |IEOR (I, J)\n > --#---#-----------\n > 1 | 1 | 0\n > 1 | 0 | 1\n > 0 | 1 | 1\n > 0 | 0 | 0\n\n### **Options**\n\n - **i**\n : the first of the two values to XOR\n\n - **j**\n : the second of the two values to XOR\n\n If either I or J is a boz-literal-constant, it is first converted\n as if by the intrinsic function INT to type integer with the kind\n type parameter of the other.\n\n### **Result**\n\n If a bit is different at the same location in **i** and **j**\n the corresponding bit in the result is **1**, otherwise it is **0**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ieor\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int16) :: i,j\n ! basic usage\n print *,ieor (16, 1), ' ==> ieor(16,1) has the value 17'\n\n ! it is easier to see using binary representation\n i=int(b'0000000000111111',kind=int16)\n j=int(b'0000001111110000',kind=int16)\n write(*,'(a,b16.16,1x,i0)')'i= ',i, i\n write(*,'(a,b16.16,1x,i0)')'j= ',j, j\n write(*,'(a,b16.16,1x,i0)')'result=',ieor(i,j), ieor(i,j)\n\n ! elemental\n print *,'arguments may be arrays. If both are arrays they '\n print *,'must have the same shape. '\n print *,ieor(i=[7,4096,9], j=2)\n\n ! both may be arrays if of the same size\n\nend program demo_ieor\n```\nResults:\n```text\n > 17 ==> ieor(16,1) has the value 17\n > i= 0000000000111111 63\n > j= 0000001111110000 1008\n > result=0000001111001111 975\n > arguments may be arrays. If both are arrays they\n > must have the same shape.\n > 5 4098 11\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**](#ieor),\n[**ior**(3)](#ior),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IMAGE_INDEX": "## image_index\n\n### **Name**\n\n**image_index** - \\[COLLECTIVE\\] Cosubscript to image index conversion\n\n### **Synopsis**\n```fortran\n result = image_index(coarray, sub)\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**image_index** returns the image index belonging to a cosubscript.\n\n### **Options**\n\n- **coarray**\n : Coarray of any type.\n\n- **sub**\n : default integer rank-1 array of a size equal to the corank of\n **coarray**.\n\n### **Result**\n\nScalar default integer with the value of the image index which\ncorresponds to the cosubscripts. For invalid cosubscripts the result is\nzero.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo image_index\nimplicit none\ninteger :: array[2,-1:4,8,*]\n ! Writes 28 (or 0 if there are fewer than 28 images)\n write (*,*) image_index(array, [2,0,3,1])\nend demo image_index\n```\n\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**this_image**(3)](#this_image),\n[**num_images**(3)](#num_images)\n\n _Fortran intrinsic descriptions_\n", "INDEX": "## index\n\n### **Name**\n\n**index** - \\[CHARACTER:SEARCH\\] Position of a substring within a string\n\n### **Synopsis**\n```fortran\nresult = index( string, substring [,back] [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function index(string,substring,back,kind)\n\n character(len=*,kind=KIND),intent(in) :: string\n character(len=*,kind=KIND),intent(in) :: substring\n logical(kind=**),intent(in),optional :: back\n integer(kind=**),intent(in),optional :: kind\n```\n### **Characteristics**\n\n- **string** is a _character_ variable of any kind\n- **substring** is a _character_ variable of the same kind as **string**\n- **back** is a _logical_ variable of any supported kind\n- **KIND** is a scalar integer constant expression.\n\n### **Description**\n\n **index** returns the position of the start of the leftmost\n or rightmost occurrence of string **substring** in **string**,\n counting from one. If **substring** is not present in **string**,\n zero is returned.\n\n### **Options**\n\n- **string**\n : string to be searched for a match\n\n- **substring**\n : string to attempt to locate in **string**\n\n- **back**\n : If the **back** argument is present and true, the return value is the\n start of the rightmost occurrence rather than the leftmost.\n\n- **kind**\n : if **kind** is present, the kind type parameter is that specified by the value of\n **kind**; otherwise the kind type parameter is that of default integer type.\n\n\n### **Result**\n\n The result is the starting position of the first substring\n **substring** found in **string**.\n\n If the length of **substring** is longer than **string** the result\n is zero.\n\n If the substring is not found the result is zero.\n\n If **back** is _.true._ the greatest starting position is returned\n (that is, the position of the right-most match). Otherwise,\n the smallest position starting a match (ie. the left-most match)\n is returned.\n\n The position returned is measured from the left with the first\n character of **string** being position one.\n\n Otherwise, if no match is found zero is returned.\n\n### **Examples**\n\nExample program\n```fortran\nprogram demo_index\nimplicit none\ncharacter(len=*),parameter :: str=&\n 'Search this string for this expression'\n !1234567890123456789012345678901234567890\n write(*,*)&\n index(str,'this').eq.8, &\n ! return value is counted from the left end even if BACK=.TRUE.\n index(str,'this',back=.true.).eq.24, &\n ! INDEX is case-sensitive\n index(str,'This').eq.0\nend program demo_index\n```\nExpected Results:\n\n```text\n > T T T\n```\n### **Standard**\n\nFORTRAN 77 , with KIND argument Fortran 2003\n\n### **See Also**\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl), [**adjustr**(3)](#adjustr), [**index**](#index),\n [**scan**(3)](#scan), [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat), [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions_\n", "INT": "## int\n\n### **Name**\n\n**int** - \\[TYPE:CONVERSION\\] Truncate towards zero and convert to integer\n\n### **Synopsis**\n```fortran\n result = int(a [,kind])\n```\n```fortran\n elemental integer(kind=KIND) function int(a, KIND )\n\n TYPE(kind=**),intent(in) :: a\n integer,optional :: KIND\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **a** shall be of type integer, real, or complex, or a boz-literal-constant.\n - **KIND** shall be a scalar integer constant expression.\n\n### **Description**\n\n **int** truncates towards zero and return an _integer_.\n\n### **Options**\n\n - **a**\n : is the value to truncate towards zero\n\n - **kind**\n : indicates the kind parameter of the result.\n If not present the returned type is that of default integer type.\n\n### **Result**\n\nreturns an _integer_ variable applying the following rules:\n\n**Case**:\n\n1. If **a** is of type _integer_, **int**(a) = a\n\n2. If **a** is of type _real_ and **|a| \\< 1, int(a)** equals **0**. If **|a| \\>=\n 1**, then **int(a)** equals the integer whose magnitude does not exceed\n **a** and whose sign is the same as the sign of **a**.\n\n3. If **a** is of type _complex_, rule 2 is applied to the _real_ part of **a**.\n\n4. If _a_ is a boz-literal constant, it is treated as an _integer_\n with the _kind_ specified.\n\n The interpretation of a bit sequence whose most significant bit is\n **1** is processor dependent.\n\nThe result is undefined if it cannot be represented in the specified integer type.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_int\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i = 42\ncomplex :: z = (-3.7, 1.0)\nreal :: x=-10.5, y=10.5\n\n print *, int(x), int(y)\n\n print *, int(i)\n\n print *, int(z), int(z,8)\n ! elemental\n print *, int([-10.9,-10.5,-10.3,10.3,10.5,10.9])\n ! note int(3) truncates towards zero\n\n ! CAUTION:\n ! a number bigger than a default integer can represent\n ! produces an incorrect result and is not required to\n ! be detected by the program.\n x=real(huge(0))+1000.0\n print *, int(x),x\n ! using a larger kind\n print *, int(x,kind=int64),x\n\n print *, int(&\n & B\"111111111111111111111111111111111111111111111111111111111111111\",&\n & kind=int64)\n print *, int(O\"777777777777777777777\",kind=int64)\n print *, int(Z\"7FFFFFFFFFFFFFFF\",kind=int64)\n\n ! elemental\n print *\n print *,int([ &\n & -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, &\n & 0.0, &\n & +0.5, +1.0, +1.5, +2.0, +2.2, +2.5, +2.7 ])\n\nend program demo_int\n```\n\nResults:\n\n```text\n > -10 10\n > 42\n > -3 -3\n > -10 -10 -10 10 10 10\n > -2147483648 2.14748467E+09\n > 2147484672 2.14748467E+09\n > 9223372036854775807\n > 9223372036854775807\n > 9223372036854775807\n >\n > -2 -2 -2 -2 -1\n > -1 0 0 0 1\n > 1 2 2 2 2\n```\n\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**nint**(3)](#nint),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IOR": "## ior\n\n### **Name**\n\n**ior** - \\[BIT:LOGICAL\\] Bitwise logical inclusive OR\n\n### **Synopsis**\n```fortran\n result = ior(i, j)\n```\n```fortran\n elemental integer(kind=KIND) function ior(i,j)\n\n integer(kind=KIND ,intent(in) :: i\n integer(kind=KIND ,intent(in) :: j\n```\n### **Characteristics**\n\n- **i**, **j** and the result shall have the same _integer_ type and kind,\n with the exception that one of **i** or **j** may be a BOZ constant.\n\n### **Description**\n\n**ior** returns the bit-wise Boolean inclusive-or of **i** and **j**.\n\n### **Options**\n\n- **i**\n : one of the pair of values to compare the bits of\n\n- **j**\n : one of the pair of values to compare the bits of\n\nIf either **i** or **j** is a BOZ-literal-constant, it is first converted\nas if by the intrinsic function **int**(3) to type _integer_ with the\nkind type parameter of the other.\n\n### **Result**\n\n The result has the value obtained by combining I and J\n bit-by-bit according to the following table:\n```text\n I J IOR (I, J)\n 1 1 1\n 1 0 1\n 0 1 1\n 0 0 0\n```\n Where if the bit is set in either input value, it is set in the\n result. Otherwise the result bit is zero.\n\n This is commonly called the \"bitwise logical inclusive OR\" of the two values.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ior\nimplicit none\ninteger :: i, j, k\n i=53 ! i=00110101 binary (lowest order byte)\n j=45 ! j=00101101 binary (lowest order byte)\n k=ior(i,j) ! k=00111101 binary (lowest order byte), k=61 decimal\n write(*,'(i8,1x,b8.8)')i,i,j,j,k,k\nend program demo_ior\n```\nResults:\n```\n > 53 00110101\n > 45 00101101\n > 61 00111101\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**mvbits**(3)](#mvbits),\n[**not**(3)](#not)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IPARITY": "## iparity\n\n### **Name**\n\n**iparity** - \\[BIT:LOGICAL\\] Bitwise exclusive OR of array elements\n\n### **Synopsis**\n```fortran\n result = iparity( array [,mask] ) | iparity( array, dim [,mask] )\n```\n```fortran\n integer(kind=KIND) function iparity(array, dim, mask )\n\n integer(kind=KIND),intent(in) :: array(..)\n logical(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n - **array** - An _integer_ array.\n - **dim** - an _integer_ scalar from 1 to the rank of **array**\n - **mask** - _logical_ conformable with **array**.\n\n### **Description**\n\n**iparity** reduces with bitwise _xor_ (exclusive _or_) the elements\nof **array** along dimension **dim** if the corresponding element in\n**mask** is _.true._.\n\n### **Options**\n\n- **array**\n : an array of _integer_ values\n\n- **dim**\n : a value from 1 to the rank of **array**.\n\n- **mask**\n : a _logical_ mask either a scalar or an array of the same shape\n as **array**.\n\n### **Result**\n\nThe result is of the same type as **array**.\n\nIf **dim** is absent, a scalar with the bitwise _xor_ of all elements in **array**\nis returned. Otherwise, an array of rank **n-1**, where **n** equals the\nrank of **array**, and a shape similar to that of **array** with dimension **dim**\ndropped is returned.\n\n Case (i)\n : The result of IPARITY (ARRAY) has a value equal to the\n bitwise exclusive OR of all the elements of ARRAY. If\n ARRAY has size zero the result has the value zero.\n\n Case (ii)\n : The result of IPARITY (ARRAY, MASK=MASK) has a value\n equal to that of\n```fortran\n IPARITY (PACK (ARRAY, MASK)).\n```\n Case (iii)\n : The result of IPARITY (ARRAY, DIM=DIM [, MASK=MASK])\n has a value equal to that of IPARITY (ARRAY [, MASK=MASK])\n if ARRAY has rank one.\n\n Otherwise, an array of values reduced along the dimension\n DIM is returned.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_iparity\nimplicit none\ninteger, dimension(2) :: a\n a(1) = int(b'00100100')\n a(2) = int(b'01101010')\n print '(b8.8)', iparity(a)\nend program demo_iparity\n```\nResults:\n```\n > 01001110\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**iany**(3)](#iany),\n[**iall**(3)](#iall),\n[**ieor**(3)](#ieor),\n[**parity**(3)](#parity)\n\n _Fortran intrinsic descriptions_\n", "ISHFT": "## ishft\n\n### **Name**\n\n**ishft** - \\[BIT:SHIFT\\] Logical shift of bits in an integer\n\n### **Synopsis**\n```fortran\n result = ishftc( i, shift )\n```\n```fortran\n elemental integer(kind=KIND) function ishft(i, shift )\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **i** is an _integer_ of any kind. the kind for **i** dictates the kind of the returned value.\n - **shift** is an _integer_ of any kind.\n\n### **Description**\n\n **ishft** returns a value corresponding to **i** with all of the\n bits shifted **shift** places left or right as specified by the sign\n and magnitude of **shift**.\n\n Bits shifted out from the left end or right end are lost; zeros are\n shifted in from the opposite end.\n\n### **Options**\n\n- **i**\n : The value specifying the pattern of bits to shift\n\n- **shift**\n : A value of **shift** greater than zero corresponds to a left shift,\n a value of zero corresponds to no shift, and a value less than zero\n corresponds to a right shift.\n\n If the absolute value of **shift** is\n greater than **bit_size(i)**, the value is undefined.\n\n\n### **Result**\n\n The result has the value obtained by shifting the bits of **i** by **shift** positions.\n\n 1. If **shift** is positive, the shift is to the left\n 2. if **shift** is negative, the shift is to the right\n 3. if **shift** is zero, no shift is performed.\n\n Bits shifted out from the left or from the right, as appropriate,\n are lost. Zeros are shifted in from the opposite end.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ishft\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: shift\ncharacter(len=*),parameter :: g='(b32.32,1x,i0)'\n\n write(*,*) ishft(3, 1),' <== typically should have the value 6'\n\n shift=4\n write(*,g) ishft(huge(0),shift), shift\n shift=0\n write(*,g) ishft(huge(0),shift), shift\n shift=-4\n write(*,g) ishft(huge(0),shift), shift\nend program demo_ishft\n```\nResults:\n```text\n> 6 <== typically should have the value 6\n> 11111111111111111111111111110000 4\n> 01111111111111111111111111111111 0\n> 00000111111111111111111111111111 -4\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**ishftc**(3)](#ishftc)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "ISHFTC": "## ishftc\n\n### **Name**\n\n**ishftc** - \\[BIT:SHIFT\\] Shift rightmost bits circularly, AKA. a logical shift\n\n### **Synopsis**\n```fortran\n result = ishftc( i, shift [,size] )\n```\n```fortran\n elemental integer(kind=KIND) function ishftc(i, shift, size)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: shift\n integer(kind=**),intent(in),optional :: size\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **i** may be an _integer_ of any kind\n - **shift** and **size** may be _integers_ of any kind\n - the kind for **i** dictates the kind of the returned value.\n\n### **Description**\n\n **ishftc** circularly shifts just the specified rightmost bits of\n an integer.\n\n **ishftc** returns a value corresponding to **i** with the rightmost\n **size** bits shifted circularly **shift** places; that is, bits\n shifted out one end of the section are shifted into the opposite end\n of the section.\n\n A value of **shift** greater than zero corresponds to a left shift,\n a value of zero corresponds to no shift, and a value less than zero\n corresponds to a right shift.\n\n### **Options**\n\n- **i**\n : The value specifying the pattern of bits to shift\n\n- **shift**\n : If **shift** is positive, the shift is to the left; if **shift**\n is negative, the shift is to the right; and if **shift** is zero,\n no shift is performed.\n\n The absolute value of **shift** must be less than **size** (simply\n put, the number of positions to shift must be less than or equal to\n the number of bits specified to be shifted).\n\n- **size**\n : The value must be greater than zero and less than or equal to\n **bit_size**(i).\n\n The default if **bit_size(i)** is absent is to circularly shift the\n entire value **i**.\n\n### **Result**\n\n The result characteristics (kind, shape, size, rank, ...) are the\n same as **i**.\n\n The result has the value obtained by shifting the **size** rightmost\n bits of **i** circularly by **shift** positions.\n\n No bits are lost.\n\n The unshifted bits are unaltered.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_ishftc\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: i\ncharacter(len=*),parameter :: g='(b32.32,1x,i0)'\n ! basics\n write(*,*) ishftc(3, 1),' <== typically should have the value 6'\n\n print *, 'lets start with this:'\n write(*,'(b32.32)')huge(0)\n print *, 'shift the value by various amounts, negative and positive'\n do i= -bit_size(0), bit_size(0), 8\n write(*,g) ishftc(huge(0),i), i\n enddo\n print *,'elemental'\n i=huge(0)\n write(*,*)ishftc(i,[2,3,4,5])\n write(*,*)ishftc([2**1,2**3,-2**7],3)\n print *,'note the arrays have to conform when elemental'\n write(*,*)ishftc([2**1,2**3,-2**7],[5,20,0])\n\nend program demo_ishftc\n```\nResults:\n```text\n > 6 <== typically should have the value 6\n > lets start with this:\n > 01111111111111111111111111111111\n > shift the value by various amounts, negative and positive\n > 01111111111111111111111111111111 -32\n > 11111111111111111111111101111111 -24\n > 11111111111111110111111111111111 -16\n > 11111111011111111111111111111111 -8\n > 01111111111111111111111111111111 0\n > 11111111111111111111111101111111 8\n > 11111111111111110111111111111111 16\n > 11111111011111111111111111111111 24\n > 01111111111111111111111111111111 32\n > elemental\n > -3 -5 -9 -17\n > 16 64 -1017\n > note the arrays have to conform when elemental\n > 64 8388608 -128\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n- [**ishft**(3)](#ishft) - Logical shift of bits in an integer\n- [**shifta**(3)](#shifta) - Right shift with fill\n- [**shiftl**(3)](#shiftl) - Shift bits left\n- [**shiftr**(3)](#shiftr) - Combined right shift of the bits of two int...\n- [**dshiftl**(3)](#dshiftl) - Combined left shift of the bits of two inte...\n- [**dshiftr**(3)](#dshiftr) - Combined right shift of the bits of two int...\n- [**cshift**(3)](#cshift) - Circular shift elements of an array\n- [**eoshift**(3)](#eoshift) - End-off shift elements of an array\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IS_CONTIGUOUS": "## is_contiguous\n\n### **Name**\n\n**is_contiguous** - \\[ARRAY:INQUIRY\\] Test if object is contiguous\n\n### **Synopsis**\n```fortran\n result = is_contiguous(array)\n```\n```fortran\n logical function is_contiguous(array)\n\n type(TYPE(kind=**)),intent(in) :: array\n```\n### **Characteristics**\n\n- a kind designated as ** may be any supported kind for the type\n- **array** may be of any type. It shall be an array or assumed-rank. If\n it is a pointer it shall be associated.\n- the result is a default logical scalar\n\n### **Description**\n\n**is_contiguous** returns _.true._ if and only if an object is\ncontiguous.\n\nAn object is contiguous if it is\n\n- **(1)**\n an object with the CONTIGUOUS attribute,\n\n- **(2)**\n a nonpointer whole array that is not assumed-shape,\n\n- **(3)**\n an assumed-shape array that is argument associated with an array\n that is contiguous,\n\n- **(4)**\n an array allocated by an ALLOCATE statement,\n\n- **(5)**\n a pointer associated with a contiguous target, or\n\n- **(6)**\n a nonzero-sized array section provided that\n\n - **(a)**\n its base object is contiguous,\n\n - **(b)**\n it does not have a vector subscript,\n\n - **(c)**\n the elements of the section, in array element order, are a\n subset of the base object elements that are consecutive in\n array element order,\n\n - **(d)**\n if the array is of type character and a substring-range\n appears, the substring-range specifies all of the characters\n of the parent-string,\n\n - **(e)**\n only its final part-ref has nonzero rank, and\n\n - **(f)**\n it is not the real or imaginary part of an array of type\n complex.\n\nAn object is not contiguous if it is an array subobject, and\n\n- the object has two or more elements,\n\n- the elements of the object in array element order are not\n consecutive in the elements of the base object,\n\n- the object is not of type character with length zero, and\n\n- the object is not of a derived type that has no ultimate\n components other than zero-sized arrays and\n\n- characters with length zero.\n\nIt is processor-dependent whether any other object is contiguous.\n\n### **Options**\n\n- **array**\n : An array of any type to be tested for being contiguous. If it is a\n pointer it shall be associated.\n\n### **Result**\n\n The result has the value _.true._ if **array** is contiguous, and _.false._\n otherwise.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_is_contiguous\nimplicit none\nintrinsic is_contiguous\nreal, DIMENSION (1000, 1000), TARGET :: A\nreal, DIMENSION (:, :), POINTER :: IN, OUT\n IN => A ! Associate IN with target A\n OUT => A(1:1000:2,:) ! Associate OUT with subset of target A\n !\n write(*,*)'IN is ',IS_CONTIGUOUS(IN)\n write(*,*)'OUT is ',IS_CONTIGUOUS(OUT)\n !\nend program demo_is_contiguous\n```\nResults:\n\n```text\n > IN is T\n > OUT is F\n```\n### **Standard**\n\nFortran 2008\n\n### **See also**\n\n - [allocated(3)](#allocated) - Allocation status of an allocatable entity\n - [is_contiguous(3)](#is_contigious) - Test if object is contiguous\n - [lbound(3)](#lbound) - Lower dimension bounds of an array\n - [rank(3)](#rank) - Rank of a data object\n - [shape(3)](#shape) - Determine the shape of an array or scalar\n - [size(3)](#size) - Determine the size of an array or extent of one dimension\n - [ubound(3)](#ubound) - Upper dimension bounds of an array\n\n _Fortran intrinsic descriptions_\n", "IS_IOSTAT_END": "## is_iostat_end\n\n### **Name**\n\n**is_iostat_end** - \\[STATE:INQUIRY\\] Test for end-of-file value\n\n### **Synopsis**\n```fortran\n result = is_iostat_end(i)\n```\n```fortran\n elemental logical function is_iostat_end(i)\n\n integer,intent(in) :: i\n```\n### **Characteristics**\n\n - **i** is _integer_ of any kind\n - the return value is a default _logical_\n\n### **Description**\n\n**is_iostat_end** tests whether a variable (assumed returned as a status\nfrom an I/O statement) has the \"end of file\" I/O status value.\n\nThe function is equivalent to comparing the variable with the\n**iostat_end** parameter of the intrinsic module **iso_fortran_env**.\n\n### **Options**\n\n- **i**\n : An _integer_ status value to test if indicating end of file.\n\n### **Result**\n\nreturns _.true._ if and only if**i** has the value\nwhich indicates an end of file condition for **iostat=** specifiers, and is\n_.false._ otherwise.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_iostat\nimplicit none\ninteger,parameter :: wp=kind(0.0d0)\nreal(kind=wp) :: value\ninteger :: iostat\ninteger :: lun\ncharacter(len=256) :: message\n ! make a scratch input file for demonstration purposes\n call makefile(lun) \n write(*,*)'Begin entering numeric values, one per line'\n do\n read(lun,*,iostat=iostat,iomsg=message)value\n if(iostat.eq.0)then\n write(*,*)'VALUE=',value\n elseif( is_iostat_end(iostat) ) then\n stop 'end of file. Goodbye!'\n else\n write(*,*)'ERROR:',iostat,trim(message)\n exit\n endif\n !\n enddo\ncontains\nsubroutine makefile(lun)\n! make a scratch file just for demonstration purposes\ninteger :: lun\ninteger :: i\ncharacter(len=255),parameter :: fakefile(*)=[character(len=255) :: &\n\n'3.141592653589793238462643383279502884197169399375105820974944592307 &\n &/ pi', &\n\n'0.577215664901532860606512090082402431042 &\n &/ The Euler-Mascheroni constant (Gamma)', &\n\n'2.71828182845904523536028747135266249775724709369995 &\n &/ Napier''s constant \"e\"&\n & is the base of the natural logarithm system,&\n & named in honor of Euler ', &\n\n'1.6180339887498948482045868 &\n &/ Golden_Ratio', &\n\n'1 / unity', &\n''] \n!'/ end of data']\n\n open(newunit=lun,status='replace',file='data.txt',action='readwrite')\n write(lun,'(a)')(trim(fakefile(i)),i=1,size(fakefile))\n rewind(lun)\nend subroutine makefile\nend program demo_iostat\n```\nResults:\n```text\n > Begin entering numeric values, one per line\n > VALUE= 3.1415926535897931 \n > VALUE= 0.57721566490153287 \n > VALUE= 2.7182818284590451 \n > VALUE= 1.6180339887498949 \n > VALUE= 1.0000000000000000 \n > STOP end of file. Goodbye!\n```\n### **Standard**\n\nFortran 2003\n\n### **See also**\n\n - [associated(3)](#associated) - Association status of a pointer or pointer/target pair\n - [extends_type_of(3)](#extends_type_of) - Determine if the dynamic type of A is an extension of the dynamic type of MOLD.\n - [is_iostat_end(3)](#is_iostat_end) - Test for end-of-file value\n - [is_iostat_eor(3)](#is_iostat_eor) - Test for end-of-record value\n - [present(3)](#present) - Determine whether an optional dummy argument is specified\n - [same_type_as(3)](#same_type_as) - Query dynamic types for equality\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "IS_IOSTAT_EOR": "## is_iostat_eor\n\n### **Name**\n\n**is_iostat_eor** - \\[STATE:INQUIRY\\] Test for end-of-record value\n\n### **Synopsis**\n```fortran\n result = is_iostat_eor(i)\n```\n```fortran\n elemental integer function is_iostat_eor(i)\n\n integer(kind=KIND),intent(in) :: i\n```\n### **Characteristics**\n\n - **i** is _integer_ of any kind\n - the return value is a default _logical_\n\n### **Description**\n\n **is_iostat_eor** tests whether a variable has the value of the\n I/O status \"end of record\". The function is equivalent to comparing\n the variable with the **iostat_eor** parameter of the intrinsic module\n **iso_fortran_env**.\n\n### **Options**\n\n- **i**\n : The value to test as indicating \"end of record\".\n\n### **Result**\n\n Returns _.true._ if and only if **i** has the value which indicates\n an end-of-record condition for iostat= specifiers, and is _.false._\n otherwise.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_is_iostat_eor\nuse iso_fortran_env, only : iostat_eor\nimplicit none\ninteger :: inums(5), lun, ios\n\n ! create a test file to read from\n open(newunit=lun, form='formatted',status='scratch',action='readwrite')\n write(lun, '(a)') &\n '10 20 30', &\n '40 50 60 70', &\n '80 90', &\n '100', &\n '110 120 130', &\n '140'\n rewind(lun)\n\n do\n read(lun, *, iostat=ios) inums\n write(*,*)'iostat=',ios\n if(is_iostat_eor(ios)) then\n\t inums=-huge(0)\n print *, 'end of record'\n elseif(is_iostat_end(ios)) then\n print *,'end of file'\n\t inums=-huge(0)\n exit\n elseif(ios.ne.0)then\n print *,'I/O error',ios\n\t inums=-huge(0)\n exit\n else\n write(*,'(*(g0,1x))')'inums=',inums\n endif\n enddo\n\n close(lun,iostat=ios,status='delete')\n\nend program demo_is_iostat_eor\n```\nResults:\n```text\n > iostat= 0\n > inums= 10 20 30 40 50\n > iostat= 0\n > inums= 80 90 100 110 120\n > iostat= -1\n > end of file\n```\nNote:\nthe list-directed read starts on a new line with each read, and\nthat the read values should not portably be used if IOSTAT is not zero.\n\nFormat descriptors, Stream I/O and non-advancing I/O and reads into\nstrings that can then be parsed or read multiple times give full control\nof what is read. List-directed I/O is generally more appropriate for\ninteractive I/O.\n### **Standard**\n\nFortran 2003\n\n### **See also**\n\n - [associated(3)](#associated) - Association status of a pointer or pointer/target pair\n - [extends_type_of(3)](#extends_type_of) - Determine if the dynamic type of A is an extension of the dynamic type of MOLD.\n - [is_iostat_end(3)](#is_iostat_end) - Test for end-of-file value\n - [is_iostat_eor(3)](#is_iostat_eor) - Test for end-of-record value\n - [present(3)](#present) - Determine whether an optional dummy argument is specified\n - [same_type_as(3)](#same_type_as) - Query dynamic types for equality\n\n _Fortran intrinsic descriptions_\n", "KIND": "## kind\n\n### **Name**\n\n**kind** - \\[KIND:INQUIRY\\] Query kind of an entity\n\n### **Synopsis**\n```fortran\n result = kind(x)\n```\n```fortran\n integer function kind(x)\n\n type(TYPE(kind=**)),intent(in) :: x(..)\n```\n### **Characteristics**\n - **x** may be of any intrinsic type. It may be a scalar or an array.\n - the result is a default _integer_ scalar\n\n### **Description**\n\n **kind(x)**(3) returns the kind value of the entity **x**.\n\n### **Options**\n\n- **x**\n : Value to query the kind of.\n\n### **Result**\n\n The return value indicates the kind of the argument **x**.\n\n Note that kinds are processor-dependent.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_kind\nimplicit none\ninteger,parameter :: dc = kind(' ')\ninteger,parameter :: dl = kind(.true.)\n\n print *, \"The default character kind is \", dc\n print *, \"The default logical kind is \", dl\n\nend program demo_kind\n```\nResults:\n```text\n > The default character kind is 1\n > The default logical kind is 4\n```\n### **Standard**\n\nFortran 95\n\n### **See also**\n\n- [**allocated**(3)](#allocated) - Status of an allocatable entity\n- [**is_contiguous**(3)](#is_contiguous) - test if object is contiguous\n- [**lbound**(3)](#lbound) - Lower dimension bounds of an array\n- [**rank**(3)](#rank) - Rank of a data object\n- [**shape**(3)](#shape) - Determine the shape of an array\n- [**size**(3)](#size) - Determine the size of an array\n- [**ubound**(3)](#ubound) - Upper dimension bounds of an array\n- [**bit_size**(3)](#bit_size) - Bit size inquiry function\n- [**storage_size**(3)](#storage_size) - Storage size in bits\n- [**kind**](#kind) - Kind of an entity\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "LBOUND": "## lbound\n\n### **Name**\n\n**lbound** - \\[ARRAY:INQUIRY\\] Lower dimension bounds of an array\n\n### **Synopsis**\n```fortran\n result = lbound(array [,dim] [,kind] )\n```\n```fortran\n elemental TYPE(kind=KIND) function lbound(array,dim,kind)\n\n TYPE(kind=KIND),intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n integer(kind=**),intent(in),optional :: kind\n```\n### **Characteristics**\n\n- **array** shall be assumed-rank or an array, of any type.\n It cannot be an unallocated allocatable array or a pointer that is not associated.\n\n- **dim** shall be a scalar _integer_.\n The corresponding actual argument shall not be an optional dummy\n argument, a disassociated pointer, or an unallocated allocatable.\n\n- **kind** an _integer_ initialization expression indicating the kind\n parameter of the result.\n\n- The return value is of type _integer_ and of kind **kind**. If **kind**\n is absent, the return value is of default integer kind.\n The result is scalar if **dim** is present; otherwise, the result is\n an array of rank one and size n, where n is the rank of **array**.\n\n- a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **lbound** returns the lower bounds of an array, or a single lower\n bound along the **dim** dimension.\n\n### **Options**\n\n- **array**\n : Shall be an array, of any type.\n\n- **dim**\n : Shall be a scalar _integer_.\n If **dim** is absent, the result is an array of the upper bounds of\n **array**.\n\n- **kind**\n : An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\nIf **dim** is absent,\nthe result is an array of the lower bounds of **array**.\n\nIf **dim** is present,\nthe result is a scalar corresponding to the lower bound of the\narray along that dimension. If **array** is an expression rather than\na whole array or array structure component, or if it has a zero extent\nalong the relevant dimension, the lower bound is taken to be 1.\n\n NOTE1\n\n If **array** is assumed-rank and has rank zero, **dim** cannot be\n present since it cannot satisfy the requirement **1 <= dim <= 0**.\n\n### **Examples**\n\nNote that this function should not be used on assumed-size arrays or in\nany function without an explicit interface. Errors can occur if there\nis no interface defined.\n\nSample program\n```fortran\n! program demo_lbound\nmodule m_bounds\nimplicit none\n contains\n subroutine msub(arr)\n !!integer,intent(in) :: arr(*) ! cannot be assumed-size array\n integer,intent(in) :: arr(:)\n write(*,*)'MSUB: LOWER=',lbound(arr), &\n & 'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\n end subroutine msub\n end module m_bounds\n\n program demo_lbound\n use m_bounds, only : msub\n implicit none\n interface\n subroutine esub(arr)\n integer,intent(in) :: arr(:)\n end subroutine esub\n end interface\n integer :: arr(-10:10)\n write(*,*)'MAIN: LOWER=',lbound(arr), &\n & 'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\n call csub()\n call msub(arr)\n call esub(arr)\n contains\nsubroutine csub\n write(*,*)'CSUB: LOWER=',lbound(arr), &\n & 'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\nend subroutine csub\nend\n\n subroutine esub(arr)\n implicit none\n integer,intent(in) :: arr(:)\n ! WARNING: IF CALLED WITHOUT AN EXPLICIT INTERFACE\n ! THIS WILL GIVE UNDEFINED ANSWERS (like 0,0,0)\n write(*,*)'ESUB: LOWER=',lbound(arr), &\n & 'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\n end subroutine esub\n\n!end program demo_lbound\n```\nResults:\n```\n > MAIN: LOWER= -10 UPPER= 10 SIZE= 21\n > CSUB: LOWER= -10 UPPER= 10 SIZE= 21\n > MSUB: LOWER= 1 UPPER= 21 SIZE= 21\n > ESUB: LOWER= 1 UPPER= 21 SIZE= 21\n```\n### **Standard**\n\nFortran 95 , with KIND argument - Fortran 2003\n\n### **See Also**\n\n#### Array inquiry:\n\n- [**size**(3)](#size) - Determine the size of an array\n- [**rank**(3)](#rank) - Rank of a data object\n- [**shape**(3)](#shape) - Determine the shape of an array\n- [**ubound**(3)](#ubound) - Upper dimension bounds of an array\n\n[**co\\_ubound**(3)](#ucobound),\n[**co\\_lbound**(3)](lcobound)\n\n#### State Inquiry:\n\n- [**allocated**(3)](#allocated) - Status of an allocatable entity\n- [**is_contiguous**(3)](#is_contiguous) - Test if object is contiguous\n\n#### Kind Inquiry:\n\n- [**kind**(3)](#kind) - Kind of an entity\n\n#### Bit Inquiry:\n\n- [**storage_size**(3)](#storage_size) - Storage size in bits\n- [**bit_size**(3)](#bit_size) - Bit size inquiry function\n- [**btest**(3)](#btest) - Tests a bit of an _integer_ value.\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "LCOBOUND": "## lcobound\n\n### **Name**\n\n**lcobound** - \\[COLLECTIVE\\] Lower codimension bounds of an array\n\n### **Synopsis**\n```fortran\n result = lcobound( coarray [,dim] [,kind] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**lcobound** returns the lower bounds of a coarray, or a single\nlower cobound along the **dim** codimension.\n\n### **Options**\n\n- **array**\n : Shall be an coarray, of any type.\n\n- **dim**\n : (Optional) Shall be a scalar _integer_.\n\n- **kind**\n : (Optional) An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\nThe return value is of type _integer_ and of kind **kind**. If **kind** is absent,\nthe return value is of default integer kind. If **dim** is absent, the\nresult is an array of the lower cobounds of **coarray**. If **dim** is present,\nthe result is a scalar corresponding to the lower cobound of the array\nalong that codimension.\n\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**ucobound**(3)](#ucobound),\n[**lbound**(3)](#lbound)\n\n _Fortran intrinsic descriptions_\n", "LEADZ": "## leadz\n\n### **Name**\n\n**leadz** - \\[BIT:COUNT\\] Number of leading zero bits of an integer\n\n### **Synopsis**\n```fortran\n result = leadz(i)\n```\n```fortran\n elemental integer function leadz(i)\n\n integer(kind=**),intent(in) :: i\n```\n### **Characteristics**\n\n- **i** may be an _integer_ of any kind.\n- the return value is a default integer type.\n\n### **Description**\n\n **leadz** returns the number of leading zero bits of an integer.\n\n### **Options**\n\n- **i**\n : _integer_ to count the leading zero bits of.\n\n### **Result**\n\n The number of leading zero bits, taking into account the kind of the\n input value. If all the bits of **i** are zero, the result value is\n **bit_size(i)**.\n\n The result may also be thought of as **bit_size(i)-1-k** where **k**\n is the position of the leftmost 1 bit in the input **i**. Positions\n are from 0 to bit-size(), with 0 at the right-most bit.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_leadz\nimplicit none\ninteger :: value, i\ncharacter(len=80) :: f\n\n ! make a format statement for writing a value as a bit string\n write(f,'(\"(b\",i0,\".\",i0,\")\")')bit_size(value),bit_size(value)\n\n ! show output for various integer values\n value=0\n do i=-150, 150, 50\n value=i\n write (*,'(\"LEADING ZERO BITS=\",i3)',advance='no') leadz(value)\n write (*,'(\" OF VALUE \")',advance='no')\n write(*,f,advance='no') value\n write(*,'(*(1x,g0))') \"AKA\",value\n enddo\n ! Notes:\n ! for two's-complements programming environments a negative non-zero\n ! integer value will always start with a 1 and a positive value with 0\n ! as the first bit is the sign bit. Such platforms are very common.\nend program demo_leadz\n```\nResults:\n```text\n > LEADING ZERO BITS= 0 OF VALUE 11111111111111111111111101101010 AKA -150\n > LEADING ZERO BITS= 0 OF VALUE 11111111111111111111111110011100 AKA -100\n > LEADING ZERO BITS= 0 OF VALUE 11111111111111111111111111001110 AKA -50\n > LEADING ZERO BITS=32 OF VALUE 00000000000000000000000000000000 AKA 0\n > LEADING ZERO BITS=26 OF VALUE 00000000000000000000000000110010 AKA 50\n > LEADING ZERO BITS=25 OF VALUE 00000000000000000000000001100100 AKA 100\n > LEADING ZERO BITS=24 OF VALUE 00000000000000000000000010010110 AKA 150\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**bit_size**(3)](#bit_size),\n[**popcnt**(3)](#popcnt),\n[**poppar**(3)](#poppar),\n[**trailz**(3)](#trailz)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "LEN": "## len\n\n### **Name**\n\n**len** - \\[CHARACTER\\] Length of a character entity\n\n### **Synopsis**\n```fortran\n result = len(string [,kind])\n```\n```fortran\n integer(kind=KIND) function len(string,KIND)\n\n character(len=*),intent(in) :: string(..)\n integer,optional,intent(in) :: KIND\n```\n### **Characteristics**\n\n - **string** is a scalar or array _character_ variable\n - **KIND** is a scalar integer constant expression.\n - the returned value is the same integer kind as the **kind**\n argument, or of the default integer kind if **kind** is not specified.\n\n### **Description**\n\n **len** returns the length of a _character_ string.\n\n If **string** is an array, the length of a single element of **string**\n is returned, as all elements of an array are the same length.\n\n Note that **string** need not be defined when this intrinsic is invoked,\n as only the length (not the content) of **string** is needed.\n\n### **Options**\n\n- **string**\n : A scalar or array string to return the length of.\n If it is an unallocated allocatable variable or a pointer that is\n not associated, its length type parameter shall not be deferred.\n\n- **kind**\n : A constant indicating the _kind_ parameter of the result.\n\n### **Result**\n\n The result has a value equal to the number of characters in STRING\n if it is scalar or in an element of STRING if it is an array.\n\n### **Examples**\n\nSample program\n\n```fortran\nprogram demo_len\nimplicit none\n\n! fixed length\ncharacter(len=40) :: string\n! allocatable length\ncharacter(len=:),allocatable :: astring\ncharacter(len=:),allocatable :: many_strings(:)\ninteger :: ii\n ! BASIC USAGE\n ii=len(string)\n write(*,*)'length =',ii\n\n ! ALLOCATABLE VARIABLE LENGTH CAN CHANGE\n ! the allocatable string length will be the length of RHS expression\n astring=' How long is this allocatable string? '\n write(*,*)astring, ' LEN=', len(astring)\n ! print underline\n write(*,*) repeat('=',len(astring))\n ! assign new value to astring and length changes\n astring='New allocatable string'\n write(*,*)astring, ' LEN=', len(astring)\n ! print underline\n write(*,*) repeat('=',len(astring))\n\n ! THE STRING LENGTH WILL BE CONSTANT FOR A FIXED-LENGTH VARIABLE\n string=' How long is this fixed string? '\n write(*,*)string,' LEN=',len(string)\n string='New fixed string '\n write(*,*)string,' LEN=',len(string)\n\n ! ALL STRINGS IN AN ARRAY ARE THE SAME LENGTH\n ! a scalar is returned for an array, as all values in a Fortran\n ! character array must be of the same length.\n many_strings = [ character(len=7) :: 'Tom', 'Dick', 'Harry' ]\n write(*,*)'length of ALL elements of array=',len(many_strings)\n\n ! NAME%LEN IS ESSENTIALLY THE SAME AS LEN(NAME)\n ! you can also query the length (and other attributes) of a string\n ! using a \"type parameter inquiry\" (available since fortran 2018)\n write(*,*)'length from type parameter inquiry=',string%len\n ! %len is equivalent to a call to LEN() except the kind of the integer\n ! value returned is always of default kind.\n\n ! LOOK AT HOW A PASSED STRING CAN BE USED ...\n call passed(' how long? ')\n\ncontains\n\n subroutine passed(str)\n character(len=*),intent(in) :: str\n ! the length of str can be used in the definitions of variables\n ! you can query the length of the passed variable\n write(*,*)'length of passed value is ', LEN(str)\n end subroutine passed\n\nend program demo_len\n```\nResults:\n```text\n > length = 40\n > How long is this allocatable string? LEN= 38\n > ======================================\n > New allocatable string LEN= 22\n > ======================\n > How long is this fixed string? LEN= 40\n > New fixed string LEN= 40\n > length of ALL elements of array= 7\n > length from type parameter inquiry= 40\n > length of passed value is 11\n```\n### **Standard**\n\nFORTRAN 77 ; with **kind** argument - Fortran 2003\n\n### **See Also**\n\nlen_trim(3), adjustr(3), trim(3), and adjustl(3) are related routines that\nallow you to deal with leading and trailing blanks.\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n [**scan**(3)](#scan),\n [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**](#len),\n [**repeat**(3)](#repeat),\n [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "LEN_TRIM": "## len_trim\n\n### **Name**\n\n**len_trim** - \\[CHARACTER:WHITESPACE\\] Character length without trailing blank characters\n\n### **Synopsis**\n```fortran\n result = len_trim(string [,kind])\n```\n```fortran\n elemental integer(kind=KIND) function len_trim(string,KIND)\n\n character(len=*),intent(in) :: string\n integer(kind=KIND),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - **string** is of type _character_\n - **kind** is a scalar integer constant expression specifying the kind\n of the returned value.\n - The return value is of type _integer_ and of kind **KIND**. If **KIND**\n is absent, the return value is of default _integer_ kind.\n\n### **Description**\n\n **len_trim** returns the length of a character string, ignoring\n any trailing blanks.\n\n### **Options**\n\n- **string**\n : The input string whose length is to be measured.\n\n- **kind**\n : Indicates the kind parameter of the result.\n\n### **Result**\n\n The result equals the number of characters remaining\n after any trailing blanks in **string** are removed.\n\n If the input argument is of zero length or all blanks\n the result is zero.\n\n### **Examples**\n\nSample program\n```fortran\nprogram demo_len_trim\nimplicit none\ncharacter(len=:),allocatable :: string\ninteger :: i\n! basic usage\n string=\" how long is this string? \"\n write(*,*) string\n write(*,*)'UNTRIMMED LENGTH=',len(string)\n write(*,*)'TRIMMED LENGTH=',len_trim(string)\n\n ! print string, then print substring of string\n string='xxxxx '\n write(*,*)string,string,string\n i=len_trim(string)\n write(*,*)string(:i),string(:i),string(:i)\n !\n ! elemental example\n ELE:block\n ! an array of strings may be used\n character(len=:),allocatable :: tablet(:)\n tablet=[character(len=256) :: &\n & ' how long is this string? ',&\n & 'and this one?']\n write(*,*)'UNTRIMMED LENGTH= ',len(tablet)\n write(*,*)'TRIMMED LENGTH= ',len_trim(tablet)\n write(*,*)'SUM TRIMMED LENGTH=',sum(len_trim(tablet))\n endblock ELE\n !\nend program demo_len_trim\n```\nResults:\n```text\n > how long is this string?\n > UNTRIMMED LENGTH= 30\n > TRIMMED LENGTH= 25\n > xxxxx xxxxx xxxxx\n > xxxxxxxxxxxxxxx\n > UNTRIMMED LENGTH= 256\n > TRIMMED LENGTH= 25 13\n > SUM TRIMMED LENGTH= 38\n```\n### **Standard**\n\nFortran 95 . **kind** argument added with Fortran 2003.\n\n### **See Also**\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n [**scan**(3)](#scan),\n [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**repeat**(3)](#repeat),\n [**len**(3)](#len),\n [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "LGE": "## lge\n\n### **Name**\n\n**lge** - \\[CHARACTER:COMPARE\\] ASCII Lexical greater than or equal\n\n### **Synopsis**\n```fortran\n result = lge(string_a, stringb)\n```\n```fortran\n elemental logical function lge(string_a, string_b)\n\n character(len=*),intent(in) :: string_a\n character(len=*),intent(in) :: string_b\n```\n### **Characteristics**\n\n - **string_a** is default _character_ or an ASCII character string\n - **string_b** is the same type and kind as **string\\_a**\n - the result is a default logical\n\n### **Description**\n\n **lge** determines whether one string is lexically greater than\n or equal to another string, where the two strings are interpreted as\n containing ASCII character codes. If **string_a** and **string_b**\n are not the same length, the shorter is compared as if spaces were\n appended to it to form a value that has the same length as the longer.\n\n The lexical comparison intrinsics **lge**, **lgt**(3), **lle**(3),\n and **llt**(3) differ from the corresponding intrinsic operators\n _.ge., .gt., .le., and .lt._, in that the latter use the processor's\n character ordering (which is not ASCII on some targets), whereas the\n former always use the ASCII ordering.\n\n### **Options**\n\n- **string_a**\n : string to be tested\n\n- **string_b**\n : string to compare to **string_a**\n\n### **Result**\n\n Returns _.true._ if string_a \\>= string_b, and _.false._ otherwise,\n based on the ASCII collating sequence.\n\n If both input arguments are null strings, _.true._ is always returned.\n\n If either string contains a character not in the ASCII character set,\n the result is processor dependent.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_lge\nimplicit none\ninteger :: i\n print *,'the ASCII collating sequence for printable characters'\n write(*,'(1x,19a)')(char(i),i=32,126) ! ASCII order\n write(*,*) lge('abc','ABC') ! [T] lowercase is > uppercase\n write(*,*) lge('abc','abc ') ! [T] trailing spaces\n ! If both strings are of zero length the result is true\n write(*,*) lge('','') ! [T]\n write(*,*) lge('','a') ! [F] the null string is padded\n write(*,*) lge('a','') ! [T]\n ! elemental\n write(*,*) lge('abc',['abc','123']) ! [T T] scalar and array\n write(*,*) lge(['cba', '123'],'abc') ! [T F]\n write(*,*) lge(['abc','123'],['cba','123']) ! [F T] both arrays\nend program demo_lge\n```\nResults:\n```text\n > the ASCII collating sequence for printable characters\n > !\"#$%&'()*+,-./012\n > 3456789:;<=>?@ABCDE\n > FGHIJKLMNOPQRSTUVWX\n > YZ[\\]^_`abcdefghijk\n > lmnopqrstuvwxyz{|}~\n > T\n > T\n > T\n > F\n > T\n > T T\n > T F\n > F T\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n [**lgt**(3)](#lgt),\n [**lle**(3)](#lle),\n [**llt**(3)](#llt)\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n\n[**scan**(3)](#scan),\n[**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat),\n [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "LGT": "## lgt\n\n### **Name**\n\n**lgt** - \\[CHARACTER:COMPARE\\] ASCII Lexical greater than\n\n### **Synopsis**\n```fortran\n result = lgt(string_a, string_b)\n```\n```fortran\n elemental logical function lgt(string_a, string_b)\n\n character(len=*),intent(in) :: string_a\n character(len=*),intent(in) :: string_b\n```\n### **Characteristics**\n\n - **string_a** is default _character_ or an ASCII character string\n - **string_b** is the same type and kind as **string_a**\n - the result is a default logical\n\n### **Description**\n\n **lgt** determines whether one string is lexically greater than\n another string, where the two strings are interpreted as containing\n ASCII character codes. If the String **a** and String **b** are not\n the same length, the shorter is compared as if spaces were appended\n to it to form a value that has the same length as the longer.\n\n In general, the lexical comparison intrinsics **lge**, **lgt**, **lle**,\n and **llt** differ from the corresponding intrinsic operators _.ge.,\n .gt., .le., and .lt._, in that the latter use the processor's character\n ordering (which is not ASCII on some targets), whereas the former\n always use the ASCII ordering.\n\n### **Options**\n\n- **string_a**\n : string to be tested\n\n- **string_b**\n : string to compare to **string_a**\n\n### **Result**\n\n Returns _.true._ if string_a \\> string_b, and _.false._ otherwise,\n based on the ASCII ordering.\n\n If both input arguments are null strings, _.false._ is returned.\n\n If either string contains a character not in the ASCII character set,\n the result is processor dependent.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_lgt\nimplicit none\ninteger :: i\n print *,'the ASCII collating sequence for printable characters'\n write(*,'(1x,19a)')(char(i),i=32,126)\n\n write(*,*) lgt('abc','ABC') ! [T] lowercase is > uppercase\n write(*,*) lgt('abc','abc ') ! [F] trailing spaces\n\n ! If both strings are of zero length the result is false.\n write(*,*) lgt('','') ! [F]\n write(*,*) lgt('','a') ! [F] the null string is padded\n write(*,*) lgt('a','') ! [T]\n write(*,*) lgt('abc',['abc','123']) ! [F T] scalar and array\n write(*,*) lgt(['cba', '123'],'abc') ! [T F]\n write(*,*) lgt(['abc','123'],['cba','123']) ! [F F] both arrays\nend program demo_lgt\n```\nResults:\n```text\n > the ASCII collating sequence for printable characters\n > !\"#$%&'()*+,-./012\n > 3456789:;<=>?@ABCDE\n > FGHIJKLMNOPQRSTUVWX\n > YZ[\\]^_`abcdefghijk\n > lmnopqrstuvwxyz{|}~\n > T\n > F\n > F\n > F\n > T\n > F T\n > T F\n > F F\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n [**lge**(3)](#lge),\n [**lle**(3)](#lle),\n [**llt**(3)](#llt)\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),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n\n[**scan**(3)](#scan),\n[**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat),\n [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "LLE": "## lle\n\n### **Name**\n\n**lle** - \\[CHARACTER:COMPARE\\] ASCII Lexical less than or equal\n\n### **Synopsis**\n```fortran\n result = lle(string_a, stringb)\n```\n```fortran\n elemental logical function lle(string_a, string_b)\n\n character(len=*),intent(in) :: string_a\n character(len=*),intent(in) :: string_b\n```\n### **Characteristics**\n\n - **string_a** is default _character_ or an ASCII character string\n - **string_b** is the same type and kind as **string_a**\n - the result is a default logical\n\n### **Description**\n\n **lle** determines whether one string is lexically less than or equal\n to another string, where the two strings are interpreted as containing\n ASCII character codes.\n\n If **string_a** and **string_b** are not the\n same length, the shorter is compared as if spaces were appended to it\n to form a value that has the same length as the longer.\n\n Leading spaces are significant.\n\n In general, the lexical comparison intrinsics **lge**, **lgt**, **lle**,\n and **llt** differ from the corresponding intrinsic operators _.ge.,\n .gt., .le., and .lt._, in that the latter use the processor's character\n ordering (which is not ASCII on some targets), whereas **lle**\n always uses the ASCII ordering.\n\n### **Options**\n\n- **string_a**\n : string to be tested\n\n- **string_b**\n : string to compare to **string_a**\n\n### **Result**\n\n Returns _.true._ if **string_a \\<= string_b**, and _.false._ otherwise,\n based on the ASCII collating sequence.\n\n If both input arguments are null strings, _.true._ is always returned.\n\n If either string contains a character not in the ASCII character set,\n the result is processor dependent.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_lle\nimplicit none\ninteger :: i\n print *,'the ASCII collating sequence for printable characters'\n write(*,'(1x,19a)')(char(i),i=32,126)\n ! basics\n\n print *,'case matters'\n write(*,*) lle('abc','ABC') ! F lowercase is > uppercase\n\n print *,'a space is the lowest printable character'\n write(*,*) lle('abcd','abc') ! F d > space\n write(*,*) lle('abc','abcd') ! T space < d\n\n print *,'leading spaces matter, trailing spaces do not'\n write(*,*) lle('abc','abc ') ! T trailing spaces\n write(*,*) lle('abc',' abc') ! F leading spaces are significant\n\n print *,'even null strings are padded and compared'\n ! If both strings are of zero length the result is true.\n write(*,*) lle('','') ! T\n write(*,*) lle('','a') ! T the null string is padded\n write(*,*) lle('a','') ! F\n print *,'elemental'\n write(*,*) lle('abc',['abc','123']) ! [T,F] scalar and array\n write(*,*) lle(['cba', '123'],'abc') ! [F,T]\n ! per the rules for elemental procedures arrays must be the same size\n write(*,*) lle(['abc','123'],['cba','123']) ! [T,T] both arrays\nend program demo_lle\n```\nResults:\n```text\n > the ASCII collating sequence for printable characters\n > !\"#$%&'()*+,-./012\n > 3456789:;<=>?@ABCDE\n > FGHIJKLMNOPQRSTUVWX\n > YZ[\\]^_`abcdefghijk\n > lmnopqrstuvwxyz{|}~\n > case matters\n > F\n > a space is the lowest printable character\n > F\n > T\n > leading spaces matter, trailing spaces do not\n > T\n > F\n > even null strings are padded and compared\n > T\n > T\n > F\n > elemental\n > T F\n > F T\n > T T\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n [**lge**(3)](#lge),\n [**lgt**(3)](#lgt),\n [**llt**(3)](#llt)\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n\n[**scan**(3)](#scan),\n[**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat),\n [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "LLT": "## llt\n\n### **Name**\n\n**llt** - \\[CHARACTER:COMPARE\\] ASCII Lexical less than\n\n### **Synopsis**\n```fortran\n result = llt(string_a, stringb)\n```\n```fortran\n elemental logical function llt(string_a, string_b)\n\n character(len=*),intent(in) :: string_a\n character(len=*),intent(in) :: string_b\n```\n### **Characteristics**\n\n - **string_a** is default _character_ or an ASCII character string\n - **string_b** is the same type and kind as **string_a**\n - the result is a default logical\n\n### **Description**\n\n **llt** determines whether one string is lexically less than\n another string, where the two strings are interpreted as containing\n ASCII character codes. If the **string_a** and **string_b** are not\n the same length, the shorter is compared as if spaces were appended\n to it to form a value that has the same length as the longer.\n\n In general, the lexical comparison intrinsics **lge**, **lgt**, **lle**,\n and **llt** differ from the corresponding intrinsic operators _.ge.,\n .gt., .le., and .lt._, in that the latter use the processor's character\n ordering (which is not ASCII on some targets), whereas the former\n always use the ASCII ordering.\n\n### **Options**\n\n\n- **string_a**\n : string to be tested\n\n- **string_b**\n : string to compare to **string_a**\n\n### **Result**\n\n Returns _.true._ if string_a \\< string_b, and _.false._ otherwise,\n based on the ASCII collating sequence.\n\n If both input arguments are null strings, _.false._ is always returned.\n\n If either string contains a character not in the ASCII character set,\n the result is processor dependent.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_llt\nimplicit none\ninteger :: i\n\n print *,'the ASCII collating sequence for printable characters'\n write(*,'(1x,19a)')(char(i),i=32,126) ! ASCII order\n\n ! basics\n print *,'case matters'\n write(*,*) llt('abc','ABC') ! [F] lowercase is > uppercase\n write(*,*) llt('abc','abc ') ! [F] trailing spaces\n ! If both strings are of zero length the result is false.\n write(*,*) llt('','') ! [F]\n write(*,*) llt('','a') ! [T] the null string is padded\n write(*,*) llt('a','') ! [F]\n print *,'elemental'\n write(*,*) llt('abc',['abc','123']) ! [F F] scalar and array\n write(*,*) llt(['cba', '123'],'abc') ! [F T]\n write(*,*) llt(['abc','123'],['cba','123']) ! [T F] both arrays\nend program demo_llt\n```\nResults:\n```text\n > the ASCII collating sequence for printable characters\n > !\"#$%&'()*+,-./012\n > 3456789:;<=>?@ABCDE\n > FGHIJKLMNOPQRSTUVWX\n > YZ[\\]^_`abcdefghijk\n > lmnopqrstuvwxyz{|}~\n > case matters\n > F\n > F\n > F\n > T\n > F\n > elemental\n > F F\n > F T\n > T F\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n [**lge**(3)](#lge),\n [**lgt**(3)](#lgt),\n [**lle**(3)](#lle))\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl), [**adjustr**(3)](#adjustr), [**index**(3)](#index),\n [**scan**(3)](#scan), [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat), [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "LOG": "## log\n\n### **Name**\n\n**log** - \\[MATHEMATICS\\] Natural logarithm\n\n### **Synopsis**\n```fortran\n result = log(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function log(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_ or _complex_ kind.\n - the result is the same type and characteristics as **x**.\n\n### **Description**\n\n **log** computes the natural logarithm of **x**, i.e. the logarithm to\n the base \"e\".\n\n### **Options**\n\n- **x**\n : The value to compute the natural log of.\n If **x** is _real_, its value shall be greater than zero.\n If **x** is _complex_, its value shall not be zero.\n\n\n### **Result**\n\n The natural logarithm of **x**.\n If **x** is the _complex_ value **(r,i)** , the imaginary part \"i\" is in the range\n```fortran\n -PI < i <= PI\n```\n If the real part of **x** is less than zero and the imaginary part of\n **x** is zero, then the imaginary part of the result is approximately\n **PI** if the imaginary part of **PI** is positive real zero or the\n processor does not distinguish between positive and negative real zero,\n and approximately **-PI** if the imaginary part of **x** is negative\n real zero.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_log\nimplicit none\n real(kind(0.0d0)) :: x = 2.71828182845904518d0\n complex :: z = (1.0, 2.0)\n write(*,*)x, log(x) ! will yield (approximately) 1\n write(*,*)z, log(z)\nend program demo_log\n```\nResults:\n```text\n > 2.7182818284590451 1.0000000000000000\n > (1.00000000,2.00000000) (0.804718971,1.10714877)\n```\n### **Standard**\n\nFORTRAN 77\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", "LOG10": "## log10\n\n### **Name**\n\n**log10** - \\[MATHEMATICS\\] Base 10 or common logarithm\n\n### **Synopsis**\n```fortran\n result = log10(x)\n```\n```fortran\n elemental real(kind=KIND) function log10(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be any kind of _real_ value\n - the result is the same type and characteristics as **x**.\n\n### **Description**\n\n **log10** computes the base 10 logarithm of **x**. This is generally\n called the \"common logarithm\".\n\n### **Options**\n\n- **x**\n : A _real_ value > 0 to take the log of.\n\n### **Result**\n\n The logarithm to base 10 of **x**\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_log10\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 10.0_real64\n\n x = log10(x)\n write(*,'(*(g0))')'log10(',x,') is ',log10(x)\n\n ! elemental\n write(*, *)log10([1.0, 10.0, 100.0, 1000.0, 10000.0, &\n & 100000.0, 1000000.0, 10000000.0])\n\nend program demo_log10\n```\nResults:\n```text\n > log10(1.000000000000000) is .000000000000000\n > 0.0000000E+00 1.000000 2.000000 3.000000 4.000000\n > 5.000000 6.000000 7.000000\n```\n### **Standard**\n\nFORTRAN 77\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_\n", "LOGICAL": "## logical\n\n### **Name**\n\n**logical** - \\[TYPE:LOGICAL\\] Conversion between kinds of logical values\n\n### **Synopsis**\n```fortran\n result = logical(l [,kind])\n```\n```fortran\n elemental logical(kind=KIND) function logical(l,KIND)\n\n logical(kind=**),intent(in) :: l\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **l** is of type logical\n - **KIND** shall be a scalar integer constant expression.\n If **KIND** is present, the kind type parameter of the result is\n that specified by the value of **KIND**; otherwise, the kind type\n parameter is that of default logical.\n\n### **Description**\n\n **logical** converts one kind of _logical_ variable to another.\n\n### **Options**\n\n- **l**\n : The _logical_ value to produce a copy of with kind **kind**\n\n- **kind**\n : indicates the kind parameter of the result.\n If not present, the default kind is returned.\n\n### **Result**\n\nThe return value is a _logical_ value equal to **l**, with a kind\ncorresponding to **kind**, or of the default logical kind if **kind**\nis not given.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_logical\n! Access array containing the kind type parameter values supported by this\n! compiler for entities of logical type\nuse iso_fortran_env, only : logical_kinds\nimplicit none\ninteger :: i\n\n ! list kind values supported on this platform, which generally vary\n ! in storage size as alias declarations\n do i =1, size(logical_kinds)\n write(*,'(*(g0))')'integer,parameter :: boolean', &\n & logical_kinds(i),'=', logical_kinds(i)\n enddo\n\nend program demo_logical\n```\nResults:\n```text\n > integer,parameter :: boolean1=1\n > integer,parameter :: boolean2=2\n > integer,parameter :: boolean4=4\n > integer,parameter :: boolean8=8\n > integer,parameter :: boolean16=16\n```\n### **Standard**\n\nFortran 95 , related ISO_FORTRAN_ENV module - fortran 2009\n\n### **See Also**\n\n[**int**(3)](#int),\n[**real**(3)](#real),\n[**cmplx**(3)](#cmplx)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "LOG_GAMMA": "## log_gamma\n\n### **Name**\n\n**log_gamma** - \\[MATHEMATICS\\] Logarithm of the absolute value of\nthe Gamma function\n\n### **Synopsis**\n```fortran\n result = log_gamma(x)\n```\n```fortran\n elemental real(kind=KIND) function log_gamma(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_ type\n - the return value is of same type and kind as **x**.\n\n### **Description**\n\n **log_gamma** computes the natural logarithm of the absolute value\n of the Gamma function.\n\n### **Options**\n\n- **x**\n : neither negative nor zero value to render the result for.\n\n### **Result**\n\n The result has a value equal to a processor-dependent approximation\n to the natural logarithm of the absolute value of the gamma function\n of **x**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_log_gamma\nimplicit none\nreal :: x = 1.0\n write(*,*)x,log_gamma(x) ! returns 0.0\n write(*,*)x,log_gamma(3.0) ! returns 0.693 (approximately)\nend program demo_log_gamma\n```\nResults:\n```text\n > 1.000000 0.0000000E+00\n > 1.000000 0.6931472\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\nGamma function: [**gamma**(3)](#gamma)\n\n _Fortran intrinsic descriptions_\n", "MASKL": "## maskl\n\n### **Name**\n\n**maskl** - \\[BIT:SET\\] Generates a left justified mask\n\n### **Synopsis**\n```fortran\n result = maskl( i [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function maskl(i,KIND)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- a kind designated as ** may be any supported kind for the type\n- **i** is an integer\n- **kind** Shall be a scalar constant expression of type _integer_\n whose value is a supported _integer_ kind.\n- The result is an _integer_ of the same _kind_ as **i** unless **kind** is\n present, which is then used to specify the kind of the result.\n\n### **Description**\n\n **maskl** has its leftmost **i** bits set to **1**, and the remaining\n bits set to **0**.\n\n### **Options**\n\n- **i**\n : the number of left-most bits to set in the _integer_ result. It\n must be from 0 to the number of bits for the kind of the result.\n The default kind of the result is the same as **i** unless the result\n size is specified by **kind**. That is, these Fortran statements must\n be _.true._ :\n```fortran\n i >= 0 .and. i < bitsize(i) ! if KIND is not specified\n i >= 0 .and. i < bitsize(0_KIND) ! if KIND is specified\n```\n- **kind**\n : designates the kind of the _integer_ result.\n\n### **Result**\n\n The leftmost **i** bits of the output _integer_ are set to 1 and the\n other bits are set to 0.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_maskl\nimplicit none\ninteger :: i\n ! basics\n i=3\n write(*,'(i0,1x,b0)') i, maskl(i)\n\n ! elemental\n write(*,'(*(i11,1x,b0.32,1x,/))') maskl([(i,i,i=0,bit_size(0),4)])\nend program demo_maskl\n```\nResults:\n```text\n > 3 11100000000000000000000000000000\n > 0 00000000000000000000000000000000\n > -268435456 11110000000000000000000000000000\n > -16777216 11111111000000000000000000000000\n > -1048576 11111111111100000000000000000000\n > -65536 11111111111111110000000000000000\n > -4096 11111111111111111111000000000000\n > -256 11111111111111111111111100000000\n > -16 11111111111111111111111111110000\n > -1 11111111111111111111111111111111\n\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**maskr**(3)](#maskr)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MASKR": "## maskr\n\n### **Name**\n\n**maskr** - \\[BIT:SET\\] Generates a right-justified mask\n\n### **Synopsis**\n```fortran\n result = maskr( i [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function maskr(i,KIND)\n\n integer(kind=**),intent(in) :: i\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- a kind designated as ** may be any supported kind for the type\n- **i** is an integer\n- **kind** Shall be a scalar constant expression of type _integer_\n whose value is a supported _integer_ kind.\n- The result is an _integer_ of the same _kind_ as **i** unless **kind** is\n present, which is then used to specify the kind of the result.\n\n### **Description**\n\n **maskr** generates an _integer_ with its rightmost **i**\n bits set to 1, and the remaining bits set to 0.\n\n### **Options**\n\n- **i**\n : the number of right-most bits to set in the _integer_ result. It\n must be from 0 to the number of bits for the kind of the result.\n The default kind of the result is the same as **i** unless the result\n size is specified by **kind**. That is, these Fortran statements must\n be _.true._ :\n```fortran\n i >= 0 .and. i < bitsize(i) ! if KIND is not specified\n i >= 0 .and. i < bitsize(0_KIND) ! if KIND is specified\n```\n- **kind**\n : designates the kind of the _integer_ result.\n\n### **Result**\n\n The rightmost **i** bits of the output _integer_ are set to 1 and the\n other bits are set to 0.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_maskr\nimplicit none\ninteger :: i\n\n ! basics\n print *,'basics'\n write(*,'(i0,t5,b32.32)') 1, maskr(1)\n write(*,'(i0,t5,b32.32)') 5, maskr(5)\n write(*,'(i0,t5,b32.32)') 11, maskr(11)\n print *,\"should be equivalent on two's-complement processors\"\n write(*,'(i0,t5,b32.32)') 1, shiftr(-1,bit_size(0)-1)\n write(*,'(i0,t5,b32.32)') 5, shiftr(-1,bit_size(0)-5)\n write(*,'(i0,t5,b32.32)') 11, shiftr(-1,bit_size(0)-11)\n\n ! elemental\n print *,'elemental '\n print *,'(array argument accepted like called with each element)'\n write(*,'(*(i11,1x,b0.32,1x,/))') maskr([(i,i,i=0,bit_size(0),4)])\n\nend program demo_maskr\n```\nResults:\n```text\n > basics\n > 1 00000000000000000000000000000001\n > 5 00000000000000000000000000011111\n > 11 00000000000000000000011111111111\n > should be equivalent on two's-complement processors\n > 1 00000000000000000000000000000001\n > 5 00000000000000000000000000011111\n > 11 00000000000000000000011111111111\n > elemental\n > (array argument accepted like called with each element)\n > 0 00000000000000000000000000000000\n > 15 00000000000000000000000000001111\n > 255 00000000000000000000000011111111\n > 4095 00000000000000000000111111111111\n > 65535 00000000000000001111111111111111\n > 1048575 00000000000011111111111111111111\n > 16777215 00000000111111111111111111111111\n > 268435455 00001111111111111111111111111111\n > -1 11111111111111111111111111111111\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**maskl**(3)](#maskl)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MATMUL": "## matmul\n\n### **Name**\n\n**matmul** - \\[ARRAY:TRANSFORMATIONAL\\] Numeric or logical matrix\nmultiplication\n\n### **Synopsis**\n```fortran\n result = matmul(matrix_a,matrix_b)\n```\n```fortran\n function matmul(matrix_a, matrix_b)\n\n type(TYPE1(kind=**)) :: matrix_a(..)\n type(TYPE2(kind=**)) :: matrix_b(..)\n type(TYPE(kind=PROMOTED)) :: matmul(..)\n```\n### **Characteristics**\n\n - **matrix_a** is a numeric (_integer_, _real_, or _complex_ ) or\n _logical_ array of rank one two.\n - **matrix_b** is a numeric (_integer_, _real_, or _complex_ ) or\n _logical_ array of rank one two.\n - At least one argument must be rank two.\n - the size of the first dimension of **matrix_b** must equal the size\n of the last dimension of **matrix_a**.\n - the type of the result is the same as if an element of each argument\n had been multiplied as a RHS expression (that is, if the arguments\n are not of the same type the result follows the same rules of promotion\n as a simple scalar multiplication of the two types would produce)\n - If one argument is _logical_, both must be _logical_. For logicals\n the resulting type is as if the _.and._ operator has been used on\n elements from the arrays.\n - The shape of the result depends on the shapes of the arguments\n as described below.\n\n### **Description**\n\n **matmul** performs a matrix multiplication on numeric or logical\n arguments.\n\n### **Options**\n\n- **matrix_a**\n : A numeric or logical array with a rank of one or two.\n\n- **matrix_b**\n : A numeric or logical array with a rank of one or two. The last\n dimension of **matrix_a** and the first dimension of **matrix_b**\n must be equal.\n\n Note that **matrix_a** and **matrix_b** may be different numeric\n types.\n\n### **Result**\n\n#### **Numeric Arguments**\n\n If **matrix_a** and **matrix_b** are numeric the result is an\n array containing the conventional matrix product of **matrix_a**\n and **matrix_b**.\n\n First, for the numeric expression **C=matmul(A,B)**\n\n - Any vector **A(n)** is treated as a row vector **A(1,n)**.\n - Any vector **B(n)** is treated as a column vector **B(n,1)**.\n\n##### **Shape and Rank**\n\n The shape of the result can then be determined as the number of rows\n of the first matrix and the number of columns of the second; but if\n any argument is of rank one (a vector) the result is also rank one.\n Conversely when both arguments are of rank two, the result has a rank\n of two. That is ...\n\n + If **matrix_a** has shape [n,m] and **matrix_b** has shape [m,k],\n the result has shape [n,k].\n + If **matrix_a** has shape [m] and **matrix_b** has shape [m,k],\n the result has shape [k].\n + If **matrix_a** has shape [n,m] and **matrix_b** has shape [m],\n the result has shape [n].\n\n##### **Values**\n\n Then element **C(i,j)** of the product is obtained by multiplying\n term-by-term the entries of the ith row of **A** and the jth column\n of **B**, and summing these products. In other words, **C(i,j)**\n is the dot product of the ith row of **A** and the jth column of **B**.\n\n#### **Logical Arguments**\n\n##### **Values**\n\n If **matrix_a** and **matrix_b** are of type logical, the array elements\n of the result are instead:\n```fortran\n Value_of_Element (i,j) = &\n ANY( (row_i_of_MATRIX_A) .AND. (column_j_of_MATRIX_B) )\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_matmul\nimplicit none\ninteger :: a(2,3), b(3,2), c(2), d(3), e(2,2), f(3), g(2), v1(4),v2(4)\n a = reshape([1, 2, 3, 4, 5, 6], [2, 3])\n b = reshape([10, 20, 30, 40, 50, 60], [3, 2])\n c = [1, 2]\n d = [1, 2, 3]\n e = matmul(a, b)\n f = matmul(c,a)\n g = matmul(a,d)\n\n call print_matrix_int('A is ',a)\n call print_matrix_int('B is ',b)\n call print_vector_int('C is ',c)\n call print_vector_int('D is ',d)\n call print_matrix_int('E is matmul(A,B)',e)\n call print_vector_int('F is matmul(C,A)',f)\n call print_vector_int('G is matmul(A,D)',g)\n\n ! look at argument shapes when one is a vector\n write(*,'(\" > shape\")')\n ! at least one argument must be of rank two\n ! so for two vectors at least one must be reshaped\n v1=[11,22,33,44]\n v2=[10,20,30,40]\n\n ! these return a vector C(1:1)\n ! treat A(1:n) as A(1:1,1:n)\n call print_vector_int('Cd is a vector (not a scalar)',&\n & matmul(reshape(v1,[1,size(v1)]),v2))\n ! or treat B(1:m) as B(1:m,1:1)\n call print_vector_int('cD is a vector too',&\n & matmul(v1,reshape(v2,[size(v2),1])))\n\n ! or treat A(1:n) as A(1:1,1:n) and B(1:m) as B(1:m,1:1)\n ! but note this returns a matrix C(1:1,1:1) not a vector!\n call print_matrix_int('CD is a matrix',matmul(&\n & reshape(v1,[1,size(v1)]), &\n & reshape(v2,[size(v2),1])))\n\ncontains\n\n! CONVENIENCE ROUTINES TO PRINT IN ROW-COLUMN ORDER\nsubroutine print_vector_int(title,arr)\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:)\n call print_matrix_int(title,reshape(arr,[1,shape(arr)]))\nend subroutine print_vector_int\n\nsubroutine print_matrix_int(title,arr)\n!@(#) print small 2d integer arrays in row-column format\ncharacter(len=*),parameter :: all='(\" > \",*(g0,1x))' ! a handy format\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n print all\n print all, trim(title)\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\nend subroutine print_matrix_int\n\nend program demo_matmul\n```\nResults:\n```text\n >\n > A is\n > [ 1, 3, 5 ]\n > [ 2, 4, 6 ]\n >\n > B is\n > [ 10, 40 ]\n > [ 20, 50 ]\n > [ 30, 60 ]\n >\n > C is\n > [ 1, 2 ]\n >\n > D is\n > [ 1, 2, 3 ]\n >\n > E is matmul(A,B)\n > [ 220, 490 ]\n > [ 280, 640 ]\n >\n > F is matmul(C,A)\n > [ 5, 11, 17 ]\n >\n > G is matmul(A,D)\n > [ 22, 28 ]\n > shape\n >\n > Cd is a vector (not a scalar)\n > [ 3300 ]\n >\n > cD is a vector too\n > [ 3300 ]\n >\n > CD is a matrix\n > [ 3300 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**product**(3)](#product),\n[**transpose**(3)](#transpose)\n\n### **Resources**\n\n- [Matrix multiplication : Wikipedia](https://en.wikipedia.org/wiki/Matrix_multiplication)\n- The Winograd variant of Strassen's matrix-matrix multiply algorithm may\n be of interest for optimizing multiplication of very large matrices. See\n```text\n \"GEMMW: A portable level 3 BLAS Winograd variant of Strassen's\n matrix-matrix multiply algorithm\",\n\n Douglas, C. C., Heroux, M., Slishman, G., and Smith, R. M.,\n Journal of Computational Physics,\n Vol. 110, No. 1, January 1994, pages 1-10.\n\n The numerical instabilities of Strassen's method for matrix\n multiplication requires special processing.\n```\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "MAX": "## max\n\n### **Name**\n\n**max** - \\[NUMERIC\\] Maximum value of an argument list\n\n### **Synopsis**\n```fortran\n result = max(a1, a2, a3, ...)\n```\n```fortran\n elemental TYPE(kind=KIND) function max(a1, a2, a3, ... )\n\n TYPE(kind=KIND,intent(in),optional :: a1\n TYPE(kind=KIND,intent(in),optional :: a2\n TYPE(kind=KIND,intent(in),optional :: a3\n :\n :\n```\n### **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 The returned selected character argument is padded with blanks as\n needed on the right to the same 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\n The examples contain such cases as examples to clarify 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.\n\n- **a2,a3,...**\n : the remaining arguments of the set of values to search for a\n maximum in.\n\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 multiple arrays you could \n ! use something like \n ! MAXVAL([arr1, arr2]) \n ! or probably better (more likely to avoid creating a large temp array)\n ! max(maxval(arr1),maxval(arr2))\n ! 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 BOX 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** - \\[MODEL:NUMERIC\\] 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```\nResults:\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### **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. \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\n is **1**.\n\n- **j**\n : value to select bits from when the associated bit in the mask\n is **0**.\n\n- **mask**\n : a value whose bits are used as a mask to select bits from **i**\n 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\nThe arguments must the same type which shall be integer, real,\nor character and they also all have the same kind type parameter.\n\nThe type and kind type parameter of the result are the same as those\nof the arguments.\n\n NOTE:\n\nA common extension is that the argument kinds can vary. In that case\nthe returned value may be the kind of the first argument, or might be\nthe kind of the expression a1+a2+a3+a4... per the rules of promotion.\n\n### **Options**\n\n- **a1**\n : the first element of the set of values to examine.\n\n- **a2, a3, ...**\n : An expression of the same type and kind as **a1** completing the\n set of values to evaluate.\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\ninteger :: i\ninteger :: rectangle(3,4)=reshape([(-6+i,i=0,11)],[3,4])\n print *, 'basics'\n print *, min(10.0,11.0,30.0,-100.0)\n print *, min(-200.0,-1.0)\n print *, 'elemental'\n print *, min(1,[2,3,4])\n print *, min(5,[2,3,4])\n\n print *, 'box:'\n do i=1,size(rectangle,dim=1)\n write(*,'(*(i3,1x))')rectangle(i,:)\n enddo\n print *, 'make all values 0 or less:'\n do i=1,size(rectangle,dim=1)\n write(*,'(*(i3,1x))')min(rectangle(i,:),0)\n enddo\nend program demo_min\n```\nResults:\n```text\n > basics\n > -100.000000 \n > -200.000000 \n > elemental\n > 1 1 1\n > 2 3 4\n > box:\n > -6 -3 0 3\n > -5 -2 1 4\n > -4 -1 2 5\n > make all values 0 or less:\n > -6 -3 0 0\n > -5 -2 0 0\n > -4 -1 0 0\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**max**(3)](#max),\n[**maxloc**(3)](#maxloc),\n[**minloc**(3)](#minloc),\n[**minval**(3)](#minval),\n[**maxval**(3)](#minval)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n '\n", "MINEXPONENT": "## minexponent\n\n### **Name**\n\n**minexponent** - \\[MODEL:NUMERIC\\] 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 : 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 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```\nResult:\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 > if zero-size character array all dels if ASCII\n > \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", "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 Otherwise, 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", "MVBITS": "## mvbits\n\n### **Name**\n\n**mvbits** - \\[BIT:COPY\\] Reproduce bit patterns found in one integer in another\n\n### **Synopsis**\n```fortran\n call mvbits(from, frompos, len, to, topos)\n```\n```fortran\n elemental subroutine mvbits( from, frompos, len, to, topos )\n\n integer(kind=KIND),intent(in) :: from\n integer(kind=**),intent(in) :: frompos\n integer(kind=**),intent(in) :: len\n integer(kind=KIND),intent(inout) :: to\n integer(kind=**),intent(in) :: topos\n```\n### **Characteristics**\n\n - **from** is an _integer_\n - **frompos** is an integer\n - **len** is an integer\n - **to** is an integer of the same kind as **from**.\n - **topos** is an integer\n\n### **Description**\n\n**mvbits** copies a bit pattern found in a range of adjacent bits in\nthe _integer_ **from** to a specified position in another integer **to**\n(which is of the same kind as **from**). It otherwise leaves the bits\nin **to** as-is.\n\nThe bit positions copied must exist within the value of **from**.\nThat is, the values of **frompos+len-1** and **topos+len-1** must be\nnonnegative and less than **bit_size**(from).\n\nThe bits are numbered **0** to **bit_size(i)-1**, from right to left.\n\n### **Options**\n\n- **from**\n : An _integer_ to read bits from.\n\n- **frompos**\n : **frompos** is the position of the first bit to copy. It is a\n nonnegative _integer_ value < **bit_size(from)**.\n\n- **len**\n : A nonnegative _integer_ value that indicates how many bits to\n copy from **from**. It must not specify copying bits past the end\n of **from**. That is, **frompos + len** must be less than or equal\n to **bit_size(from)**.\n\n- **to**\n : The _integer_ variable to place the copied bits into. It must\n be of the same kind as **from** and may even be the same variable\n as **from**, or associated to it.\n\n **to** is set by copying the sequence of bits of length **len**,\n starting at position **frompos** of **from** to position **topos** of\n **to**. No other bits of **to** are altered. On return, the **len**\n bits of **to** starting at **topos** are equal to the value that\n the **len** bits of **from** starting at **frompos** had on entry.\n\n- **topos**\n : A nonnegative _integer_ value indicating the starting location in\n **to** to place the specified copy of bits from **from**.\n **topos + len** must be less than or equal to **bit_size(to)**.\n\n### **Examples**\n\nSample program that populates a new 32-bit integer with its bytes\nin reverse order from the input value (ie. changes the Endian of the integer).\n```fortran\nprogram demo_mvbits\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int32) :: intfrom, intto, abcd_int\ncharacter(len=*),parameter :: bits= '(g0,t30,b32.32)'\ncharacter(len=*),parameter :: fmt= '(g0,t30,a,t40,b32.32)'\n\n intfrom=huge(0) ! all bits are 1 accept the sign bit\n intto=0 ! all bits are 0\n\n !! CHANGE BIT 0\n ! show the value and bit pattern\n write(*,bits)intfrom,intfrom\n write(*,bits)intto,intto\n\n ! copy bit 0 from intfrom to intto to show the rightmost bit changes\n ! (from, frompos, len, to, topos)\n call mvbits(intfrom, 0, 1, intto, 0) ! change bit 0\n write(*,bits)intto,intto\n\n !! COPY PART OF A VALUE TO ITSELF\n ! can copy bit from a value to itself\n call mvbits(intfrom,0,1,intfrom,31)\n write(*,bits)intfrom,intfrom\n\n !! MOVING BYTES AT A TIME\n ! make native integer value with bit patterns\n ! that happen to be the same as the beginning of the alphabet\n ! to make it easy to see the bytes are reversed\n abcd_int=transfer('abcd',0)\n ! show the value and bit pattern\n write(*,*)'native'\n write(*,fmt)abcd_int,abcd_int,abcd_int\n\n ! change endian of the value\n abcd_int=int_swap32(abcd_int)\n ! show the values and their bit pattern\n write(*,*)'non-native'\n write(*,fmt)abcd_int,abcd_int,abcd_int\n\n contains\n\n pure elemental function int_swap32(intin) result(intout)\n ! Convert a 32 bit integer from big Endian to little Endian,\n ! or conversely from little Endian to big Endian.\n !\n integer(kind=int32), intent(in) :: intin\n integer(kind=int32) :: intout\n ! copy bytes from input value to new position in output value\n ! (from, frompos, len, to, topos)\n call mvbits(intin, 0, 8, intout, 24) ! byte1 to byte4\n call mvbits(intin, 8, 8, intout, 16) ! byte2 to byte3\n call mvbits(intin, 16, 8, intout, 8) ! byte3 to byte2\n call mvbits(intin, 24, 8, intout, 0) ! byte4 to byte1\n end function int_swap32\n\n end program demo_mvbits\n```\nResults:\n```text\n > 2147483647 01111111111111111111111111111111\n > 0 00000000000000000000000000000000\n > 1 00000000000000000000000000000001\n > -1 11111111111111111111111111111111\n > native\n > 1684234849 abcd 01100100011000110110001001100001\n > non-native\n > 1633837924 dcba 01100001011000100110001101100100\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**btest**(3)](#btest),\n[**iand**(3)](#iand),\n[**ibclr**(3)](#ibclr),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n[**ieor**(3)](#ieor),\n[**ior**(3)](#ior),\n[**not**(3)](#not)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "NEAREST": "## nearest\n\n### **Name**\n\n**nearest** - \\[MODEL:COMPONENTS\\] Nearest representable number\n\n### **Synopsis**\n```fortran\n result = nearest(x, s)\n```\n```fortran\n elemental real(kind=KIND) function nearest(x,s)\n\n real(kind=KIND),intent(in) :: x\n real(kind=**),intent(in) :: s\n```\n### **Characteristics**\n\n- **x** may be a _real_ value of any kind.\n- **s** may be a _real_ value of any kind.\n- The return value is of the same type and kind as **x**.\n- a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**nearest** returns the processor-representable number nearest to\n**x** in the direction indicated by the sign of **s**.\n\n### **Options**\n\n- **x**\n : the value to find the nearest representable value of\n\n- **s**\n : a non-zero value whose sign is used to determine the direction in\n which to search from **x** to the representable value.\n\n If **s** is positive, **nearest** returns the processor-representable\n number greater than **x** and nearest to it.\n\n If **s** is negative, **nearest** returns the processor-representable\n number smaller than **x** and nearest to it.\n\n### **Result**\n\nThe return value is of the same type as **x**. If **s** is positive, **nearest**\nreturns the processor-representable number greater than **x** and nearest to\nit. If **s** is negative, **nearest** returns the processor-representable number\nsmaller than **x** and nearest to it.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_nearest\nimplicit none\n\n real :: x, y\n x = nearest(42.0, 1.0)\n y = nearest(42.0, -1.0)\n write (*,\"(3(g20.15))\") x, y, x - y\n\n! write (*,\"(3(g20.15))\") &\n! nearest(tiny(0.0),1.0), &\n! nearest(tiny(0.0),-1.0), &\n! nearest(tiny(0.0),1.0) -nearest(tiny(0.0),-1.0)\n\n! write (*,\"(3(g20.15))\") &\n! nearest(huge(0.0),1.0), &\n! nearest(huge(0.0),-1.0), &\n! nearest(huge(0.0),1.0)- nearest(huge(0.0),-1.0)\n\nend program demo_nearest\n```\nResults:\n```text\n > 42.0000038146973 41.9999961853027 .762939453125000E-05\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions_\n", "NEW_LINE": "## new_line\n\n### **Name**\n\n**new_line** - \\[CHARACTER:INQUIRY\\] Newline character\n\n### **Synopsis**\n```fortran\n result = new_line(c)\n```\n```fortran\n character(len=1,kind=KIND) function new_line(c)\n\n character(len=1,kind=KIND),intent(in) :: c(..)\n```\n### **Characteristics**\n\n - **c** shall be of type _character_. It may be a scalar or an array.\n - the result is a _character_ scalar of length one with the same kind type parameter as **c**.\n\n### **Description**\n\n**new_line** returns the newline character.\n\nNormally, newlines are generated with regular formatted I/O statements like\nWRITE() and PRINT() when each statement completes:\n```fortran\n print *, 'x=11'\n print *\n print *, 'y=22'\n end\n```\nproduces:\n```text\n x=11\n\n y=22\n```\nAlternatively, a \"/\" descriptor in a format is used to generate a\nnewline on the output. For example:\n```fortran\n write(*,'(a,1x,i0,/,a)') 'x =',11,'is the answer'\n end\n```\nproduces:\n```text\n x = 11\n is the answer\n```\nAlso, for formatted sequential output if more data is listed on the\noutput statement than can be represented by the format statement a\nnewline is generated and then the format is reused until the output\nlist is exhausted.\n```fortran\n write(*,'(a,\"=\",i0)') 'x', 10, 'y', 20\n end\n```\nproduces\n```text\n x=10\n y=20\n```\nBut there are occasions, particularly when non-advancing I/O or stream\nI/O is being generated (which does not generate a newline at the end\nof each WRITE statement, as normally occurs) where it is preferable to\nplace a newline explicitly in the output at specified points.\n\nTo do so you must make sure you are generating the correct newline\ncharacter, which the techniques above do automatically.\n\nThe newline character varies between some platforms, and can even\ndepend on the encoding (ie. which character set is being used) of the\noutput file. In these cases selecting the correct character to output\ncan be determined by the **new_line** procedure.\n\n### **Options**\n\n- **c**\n : an arbitrary character whose kind is used to decide on the output\n character that represents a newline.\n\n### **Result**\n\nCase (i)\n : If **a** is default _character_ and the character in position **10**\n of the ASCII collating sequence is representable in the default\n character set, then the result is **achar(10)**.\n\n This is the typical case, and just requires using \"new_line('a')\".\n\nCase (ii)\n : If **a** is an ASCII character or an ISO 10646 character, then the\n result is **char(10, kind (a))**.\n\nCase (iii)\n : Otherwise, the result is a processor-dependent character that\n represents a newline in output to files connected for formatted\n stream output if there is such a character.\n\nCase (iv)\n : If not of the previous cases apply, the result is the blank character.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_new_line\nimplicit none\ncharacter,parameter :: nl=new_line('a')\ncharacter(len=:),allocatable :: string\nreal :: r\ninteger :: i, count\n\n ! basics\n ! print a string with a newline embedded in it\n string='This is record 1.'//nl//'This is record 2.'\n write(*,'(a)') string\n\n ! print a newline character string\n write(*,'(*(a))',advance='no') &\n nl,'This is record 1.',nl,'This is record 2.',nl\n\n ! output a number of words of random length as a paragraph\n ! by inserting a new_line before line exceeds 70 characters\n\n ! simplistic paragraph print using non-advancing I/O\n count=0\n do i=1,100\n\n ! make some fake word of random length\n call random_number(r)\n string=repeat('x',int(r*10)+1)\n\n count=count+len(string)+1\n if(count.gt.70)then\n write(*,'(a)',advance='no')nl\n count=len(string)+1\n endif\n write(*,'(1x,a)',advance='no')string\n enddo\n write(*,'(a)',advance='no')nl\n\nend program demo_new_line\n```\nResults:\n```text\n > This is record 1.\n > This is record 2.\n >\n > This is record 1.\n > This is record 2.\n > x x xxxx xxxxxxx xxxxxxxxxx xxxxxxxxx xxxx xxxxxxxxxx xxxxxxxx\n > xxxxxxxxx xxxx xxxxxxxxx x xxxxxxxxx xxxxxxxx xxxxxxxx xxxx x\n > xxxxxxxxxx x x x xxxxxx xxxxxxxxxx x xxxxxxxxxx x xxxxxxx xxxxxxxxx\n > xx xxxxxxxxxx xxxxxxxx x xx xxxxxxxxxx xxxxxxxx xxx xxxxxxx xxxxxx\n > xxxxx xxxxxxxxx x xxxxxxxxxx xxxxxx xxxxxxxx xxxxx xxxxxxxx xxxxxxxx\n > xxxxx xxx xxxxxxxx xxxxxxx xxxxxxxx xxx xxxx xxx xxxxxxxx xxxxxx\n > xxxxxxx xxxxxxx xxxxx xxxxx xx xxxxxx xx xxxxxxxxxx xxxxxx x xxxx\n > xxxxxx xxxxxxx x xxx xxxxx xxxxxxxxx xxx xxxxxxx x xxxxxx xxxxxxxxx\n > xxxx xxxxxxxxx xxxxxxxx xxxxxxxx xxx xxxxxxx xxxxxxx xxxxxxxxxx\n > xxxxxxxxxx xxxxxx xxxxx xxxx xxxxxxx xx xxxxxxxxxx xxxxxx xxxxxx\n > xxxxxx xxxx xxxxx\n```\n### **Standard**\n\nFortran 2003\n\n### **See also**\n\n[**achar**(3)](#achar),\n[**char**(3)](#char),\n[**iachar**(3)](#iachar),\n[**ichar**(3)](#ichar),\n[**selected_char_kind**(3)](#selected_char_kind)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "NINT": "## nint\n\n### **Name**\n\n**nint** - \\[TYPE:CONVERSION\\] Nearest whole number\n\n### **Synopsis**\n```fortran\n result = nint( a [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function nint(a, kind )\n\n real(kind=**),intent(in) :: a\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **a** is type real of any kind\n - **KIND** is a scalar integer constant expression\n - The result is default _integer_ kind or the value of **kind**\n if **kind** is present.\n\n### **Description**\n\n **nint** rounds its argument to the nearest whole number with its\n sign preserved.\n\n The user must ensure the value is a valid value for the range of the\n **kind** returned. If the processor cannot represent the result in the kind\n specified, the result is undefined.\n\n If **a** is greater than zero, **nint(a)** has the value **int(a+0.5)**.\n\n If **a** is less than or equal to zero, **nint(a)** has the value\n **int(a-0.5)**.\n\n### **Options**\n\n- **a**\n : The value to round to the nearest whole number\n\n- **kind**\n : can specify the kind of the output value. If not present, the\n output is the default type of _integer_.\n\n### **Result**\n\n The result is the integer nearest **a**, or if there are two integers\n equally near **a**, the result is whichever such _integer_ has the greater\n magnitude.\n\n The result is undefined if it cannot be represented in the specified\n integer type.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_nint\nimplicit none\ninteger,parameter :: dp=kind(0.0d0)\nreal,allocatable :: in(:)\ninteger,allocatable :: out(:)\ninteger :: i\nreal :: x4\nreal(kind=dp) :: x8\n\n ! basic use\n x4 = 1.234E0\n x8 = 4.721_dp\n print *, nint(x4), nint(-x4)\n print *, nint(x8), nint(-x8)\n\n ! elemental\n in = [ -2.7, -2.5, -2.2, -2.0, -1.5, -1.0, -0.5, -0.4, &\n & 0.0, &\n & +0.04, +0.5, +1.0, +1.5, +2.0, +2.2, +2.5, +2.7 ]\n out = nint(in)\n do i=1,size(in)\n write(*,*)in(i),out(i)\n enddo\n\n ! dusty corners\n ISSUES: block\n use,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\n integer :: icheck\n ! make sure input is in range for the type returned\n write(*,*)'Range limits for typical KINDS:'\n write(*,'(1x,g0,1x,g0)') &\n & int8,huge(0_int8), &\n & int16,huge(0_int16), &\n & int32,huge(0_int32), &\n & int64,huge(0_int64)\n\n ! the standard does not require this to be an error ...\n x8=12345.67e15 ! too big of a number\n icheck=selected_int_kind(ceiling(log10(x8)))\n write(*,*)'Any KIND big enough? ICHECK=',icheck\n print *, 'These are all wrong answers for ',x8\n print *, nint(x8,kind=int8)\n print *, nint(x8,kind=int16)\n print *, nint(x8,kind=int32)\n print *, nint(x8,kind=int64)\n endblock ISSUES\n\nend program demo_nint\n```\nResults:\n```text\n > 1 -1\n > 5 -5\n > -2.700000 -3\n > -2.500000 -3\n > -2.200000 -2\n > -2.000000 -2\n > -1.500000 -2\n > -1.000000 -1\n > -0.5000000 -1\n > -0.4000000 0\n > 0.0000000E+00 0\n > 3.9999999E-02 0\n > 0.5000000 1\n > 1.000000 1\n > 1.500000 2\n > 2.000000 2\n > 2.200000 2\n > 2.500000 3\n > 2.700000 3\n > Range limits for typical KINDS:\n > 1 127\n > 2 32767\n > 4 2147483647\n > 8 9223372036854775807\n > Any KIND big enough? ICHECK= -1\n > These are all wrong answers for 1.234566949990144E+019\n > 0\n > 0\n > -2147483648\n > -9223372036854775808\n```\n### **Standard**\n\nFORTRAN 77 , with KIND argument - Fortran 90\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**selected_int_kind**(3)](#selected_int_kind),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "NORM2": "## norm2\n\n### **Name**\n\n**norm2** - \\[MATHEMATICS\\] Euclidean vector norm\n\n### **Synopsis**\n```fortran\n result = norm2(array, [dim])\n```\n```fortran\n real(kind=KIND) function norm2(array, dim)\n\n real(kind=KIND),intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n```\n### **Characteristics**\n\n - **array** shall be an array of type _real_.\n - **dim** shall be a scalar of type _integer_\n - The result is of the same type as **array**.\n\n### **Description**\n\n **norm2** calculates the Euclidean vector norm (L_2 norm or\n generalized L norm) of **array** along dimension **dim**.\n\n### **Options**\n\n- **array**\n : the array of input values for the L_2 norm computations\n\n- **dim**\n : a value in the range from **1** to **rank(array)**.\n\n### **Result**\n\n If **dim** is absent, a scalar with the square root of the sum of squares\n of the elements of **array** is returned.\n\n Otherwise, an array of rank **n-1**, where **n** equals the rank of\n **array**, and a shape similar to that of **array** with dimension DIM\n dropped is returned.\n\n Case (i)\n : The result of NORM2 (X) has a value equal to a\n processor-dependent approximation to the generalized\n L norm of X, which is the square root of the sum of\n the squares of the elements of X. If X has size zero,\n the result has the value zero.\n\n Case (ii)\n : The result of NORM2 (X, DIM=DIM) has a value equal\n to that of NORM2 (X) if X has rank one. Otherwise,\n the resulting array is reduced in rank with dimension\n **dim** removed, and each remaining elment is the\n result of NORM2(X) for the values along dimension\n **dim**.\n\n It is recommended that the processor compute the result without undue\n overflow or underflow.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_norm2\nimplicit none\ninteger :: i\nreal :: x(2,3) = reshape([ &\n 1, 2, 3, &\n 4, 5, 6 &\n ],shape(x),order=[2,1])\n\n write(*,*) 'input in row-column order'\n write(*,*) 'x='\n write(*,'(4x,3f4.0)')transpose(x)\n write(*,*)\n write(*,*) 'norm2(x)=',norm2(x)\n write(*,*) 'which is equivalent to'\n write(*,*) 'sqrt(sum(x**2))=',sqrt(sum(x**2))\n write(*,*)\n write(*,*) 'for reference the array squared is'\n write(*,*) 'x**2='\n write(*,'(4x,3f4.0)')transpose(x**2)\n write(*,*)\n write(*,*) 'norm2(x,dim=1)=',norm2(x,dim=1)\n write(*,*) 'norm2(x,dim=2)=',norm2(x,dim=2)\n write(*,*) '(sqrt(sum(x(:,i)**2)),i=1,3)=',(sqrt(sum(x(:,i)**2)),i=1,3)\n write(*,*) '(sqrt(sum(x(i,:)**2)),i=1,2)=',(sqrt(sum(x(i,:)**2)),i=1,2)\n\nend program demo_norm2\n```\nResults:\n```text\n > input in row-column order\n > x=\n > 1. 2. 3.\n > 4. 5. 6.\n >\n > norm2(x)= 9.539392\n > which is equivalent to\n > sqrt(sum(x**2))= 9.539392\n >\n > for reference the array squared is\n > x**2=\n > 1. 4. 9.\n > 16. 25. 36.\n >\n > norm2(x,dim=1)= 4.123106 5.385165 6.708204\n > norm2(x,dim=2)= 3.741657 8.774964\n > (sqrt(sum(x(:,i)**2)),i=1,3)= 4.123106 5.385165 6.708204\n > (sqrt(sum(x(i,:)**2)),i=1,2)= 3.741657 8.774964\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**product**(3)](#product),\n[**sum**(3)](#sum),\n[**hypot**(3)](#hypot)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "NOT": "## not\n\n### **Name**\n\n**not** - \\[BIT:LOGICAL\\] Logical negation; flips all bits in an integer\n\n### **Synopsis**\n```fortran\n result = not(i)\n```\n```fortran\n elemental integer(kind=KIND) function not(i)\n\n integer(kind=KIND), intent(in) :: i\n```\n### **Characteristics**\n\n- **i** may be an _integer_ of any valid kind\n- The returned _integer_ is of the same kind as the argument **i**.\n\n### **Description**\n\n **not** returns the bitwise Boolean inverse of **i**. This is also\n known as the \"Bitwise complement\" or \"Logical negation\" of the value.\n\n If an input bit is a one, that position is a zero on output. Conversely\n any input bit that is zero is a one on output.\n\n### **Options**\n\n- **i**\n : The value to flip the bits of.\n\n### **Result**\n\n The result has the value obtained by complementing **i** bit-by-bit\n according to the following truth table:\n\n > I | NOT(I)\n > ----#----------\n > 1 | 0\n > 0 | 1\n\n That is, every input bit is flipped.\n\n### **Examples**\n\nSample program\n\n```fortran\nprogram demo_not\nimplicit none\ninteger :: i\n ! basics\n i=-13741\n print *,'the input value',i,'represented in bits is'\n write(*,'(1x,b32.32,1x,i0)') i, i\n i=not(i)\n print *,'on output it is',i\n write(*,'(1x,b32.32,1x,i0)') i, i\n print *, \" on a two's complement machine flip the bits and add 1\"\n print *, \" to get the value with the sign changed, for example.\"\n print *, 1234, not(1234)+1\n print *, -1234, not(-1234)+1\n print *, \" of course 'x=-x' works just fine and more generally.\"\nend program demo_not\n```\nResults:\n```text\n > the input value -13741 represented in bits is\n > 11111111111111111100101001010011 -13741\n > on output it is 13740\n > 00000000000000000011010110101100 13740\n > on a two's complement machine flip the bits and add 1\n > to get the value with the sign changed, for example.\n > 1234 -1234\n > -1234 1234\n > of course 'x=-x' works just fine and more generally.\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**iand**(3)](#iand),\n[**ior**(3)](#ior),\n[**ieor**(3)](#ieor),\n[**ibits**(3)](#ibits),\n[**ibset**(3)](#ibset),\n\n[**ibclr**(3)](#ibclr)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "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:CONVERSION\\] 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\n program demo_pack\n implicit none\n integer, allocatable :: m(:)\n character(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\n contains\n !\n ! concise quicksort from @arjen and @beliavsky shows recursion,\n ! array sections, and vectorized comparisons. \n !\n pure recursive function qsort(values) result(sorted)\n intrinsic pack, size\n real, intent(in) :: values(:)\n real :: sorted(size(values))\n if (size(values) > 1) then\n sorted = &\n\t & [qsort(pack(values(2:),values(2:)=values(1)))]\n else\n sorted = values\n endif\n end function qsort\n end 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", "PRECISION": "## precision\n\n### **Name**\n\n**precision** - \\[MODEL:NUMERIC\\] Decimal precision of a real kind\n\n### **Synopsis**\n```fortran\n result = precision(x)\n```\n```fortran\n integer function precision(x)\n\n TYPE(kind=**),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** shall be of type _real_ or _complex_. It may be a scalar or an array.\n - the result is a default _integer_ scalar.\n\n### **Description**\n\n **precision** returns the decimal precision in the model of the type\n of **x**.\n\n### **Options**\n\n- **x**\n : the type and kind of the argument are used to determine which number\n model to query. The value of the argument is not unused; it may even\n be undefined.\n\n### **Result**\n\n The precision of values of the type and kind of **x**\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_precision\nuse,intrinsic :: iso_fortran_env, only : dp=>real64,sp=>real32\nimplicit none\nreal(kind=sp) :: x(2)\ncomplex(kind=dp) :: y\n\n print *, precision(x), range(x)\n print *, precision(y), range(y)\n\nend program demo_precision\n```\nResults:\n```text\n > 6 37\n > 15 307\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "PRESENT": "## present\n\n### **Name**\n\n**present** - [STATE:INQUIRY\\] Determine whether an optional dummy argument\nis specified\n\n### **Synopsis**\n```fortran\n result = present(a)\n```\n```fortran\n logical function present (a)\n\n type(TYPE(kind=KIND)) :: a(..)\n```\n### **Characteristics**\n\n- **a** May be of any type and may be a pointer, scalar or array value,\n or a dummy procedure.\n\n### **Description**\n\n **present** can be used in a procedure to determine if an optional\n dummy argument was present on the current call to the procedure.\n\n **a** shall be the name of an optional dummy argument that is accessible\n in the subprogram in which the **present** function reference\n appears. There are no other requirements on **a**.\n\n Note when an argument is not present when the current procedure is\n invoked, you may only pass it as an optional argument to another\n procedure or pass it as an argument to **present**.\n\n### **Options**\n\n- **a**\n : the name of an optional dummy argument accessible within the current\n subroutine or function.\n\n### **Result**\n\n Returns _.true._ if the optional argument **a** is present (was passed\n on the call to the procedure) , or _.false._ otherwise.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_present\nimplicit none\ninteger :: answer\n ! argument to func() is not present\n answer=func()\n write(*,*) answer\n ! argument to func() is present\n answer=func(1492)\n write(*,*) answer\ncontains\n!\ninteger function func(x)\n! the optional characteristic on this definition allows this variable\n! to not be specified on a call; and also allows it to subsequently\n! be passed to PRESENT(3):\ninteger, intent(in), optional :: x\ninteger :: x_local\n !\n ! basic\n if(present(x))then\n ! if present, you can use x like any other variable.\n x_local=x\n else\n ! if not, you cannot define or reference x except to\n ! pass it as an optional parameter to another procedure\n ! or in a call to present(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```\nResults:\n```text\n > factorial of 1 is 1.00000000\n > factorial of 2 is 2.00000000\n > factorial of 3 is 6.00000000\n > factorial of 4 is 24.0000000\n > factorial of 5 is 120.000000\n > factorial of 6 is 720.000000\n > factorial of 7 is 5040.00000\n > factorial of 8 is 40320.0000\n > factorial of 9 is 362880.000\n > factorial of 10 is 3628800.00\n > \n > product of all elements 351000000\n > odd * even = \n > 4875 * 72000 = 351000000\n > \n > zero-sized array=> 1\n > all elements have a false mask=> 1\n > \n > rect :( 2 3 )\n > > [ 1, 2, 3 ]\n > > [ 4, 5, 6 ]\n > product of columns= 4 10 18\n > product of rows= 6 120\n > \n > box 1 :( 2 3 )\n > > [ 1, 2, 3 ]\n > > [ 4, 5, 6 ]\n > \n > box 2 :( 2 3 )\n > > [ 10, 20, 30 ]\n > > [ 40, 50, 60 ]\n > \n > box 3 :( 2 3 )\n > > [ -10, -20, -30 ]\n > > [ -40, -50, -60 ]\n > \n > box 4 :( 2 3 )\n > > [ 2, 4, 6 ]\n > > [ 8, 10, 12 ]\n > no dim gives a scalar 0.171992703E+26\n > \n > negative values :( 3 4 )\n > > [ 1, 1, 400, 1 ]\n > > [ 1, 1, 1000, 1 ]\n > > [ 1, 1, 1800, 1 ]\n > \n > dim=1 :( 3 4 )\n > > [ 4, 400, 400, 16 ]\n > > [ 10, 1000, 1000, 40 ]\n > > [ 18, 1800, 1800, 72 ]\n > \n > dim=2 :( 2 4 )\n > > [ 6, 6000, -6000, 48 ]\n > > [ 120, 120000, -120000, 960 ]\n > \n > dim=3 :( 2 3 )\n > > [ -200, -3200, -16200 ]\n > > [ -51200, -125000, -259200 ]\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** - \\[MODEL:NUMERIC\\] 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 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 write(*,*)x\n write(*,*)y\n end program demo_random_init\n```\nResults:\n\nRUN 1:\n```text\n > 0.825262189 0.191325366 0.155503273 \n > 0.825262189 0.191325366 0.155503273 \n```\n\nRUN 2:\n```text\n > 0.825262189 0.191325366 0.155503273 \n > 0.825262189 0.191325366 0.155503273 \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** - \\[MODEL:NUMERIC\\] 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", "RANK": "## rank\n\n### **Name**\n\n**rank** - \\[ARRAY:INQUIRY\\] Rank of a data object\n\n### **Synopsis**\n```fortran\n result = rank(a)\n```\n```fortran\n integer function rank(a)\n\n type(TYPE(kind=**)),intent(in) :: a(..)\n```\n### **Characteristics**\n\n - **a** can be of any type **TYPE** and rank.\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n **rank** returns the rank of a scalar or array data object.\n\n The rank of an array is the number of dimensions it has (zero for a scalar).\n\n### **Options**\n\n- **a** : is the data object to query the dimensionality of. The rank returned\n may be from 0 to 16.\n\n The argument **a** may be any data object type, including an assumed-rank\n array.\n\n### **Result**\n\n For arrays, their rank is returned; for scalars zero is returned.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_rank\nimplicit none\n\n! a bunch of data objects to query\ninteger :: a\nreal, allocatable :: b(:,:)\nreal, pointer :: c(:)\ncomplex :: d\n\n! make up a type\ntype mytype\n integer :: int\n real :: float\n character :: char\nend type mytype\ntype(mytype) :: any_thing(1,2,3,4,5)\n\n ! basics\n print *, 'rank of scalar a=',rank(a)\n ! you can query this array even though it is not allocated\n print *, 'rank of matrix b=',rank(b)\n print *, 'rank of vector pointer c=',rank(c)\n print *, 'rank of complex scalar d=',rank(d)\n\n ! you can query any type, not just intrinsics\n print *, 'rank of any arbitrary type=',rank(any_thing)\n\n ! an assumed-rank object may be queried\n call query_int(10)\n call query_int([20,30])\n call query_int( reshape([40,50,60,70],[2,2]) )\n\n ! you can even query an unlimited polymorphic entity\n call query_anything(10.0)\n call query_anything([.true.,.false.])\n call query_anything( reshape([40.0,50.0,60.0,70.0],[2,2]) )\n\ncontains\n\nsubroutine query_int(data_object)\n! It is hard to do much with something dimensioned\n! name(..) if not calling C except inside of a\n! SELECT_RANK construct but one thing you can\n! do is call the inquiry functions ...\ninteger,intent(in) :: data_object(..)\ncharacter(len=*),parameter :: all='(*(g0,1x))'\n\n if(rank(data_object).eq.0)then\n print all,&\n & 'passed a scalar to an assumed rank, &\n & rank=',rank(data_object)\n else\n print all,&\n & 'passed an array to an assumed rank, &\n & rank=',rank(data_object)\n endif\n\nend subroutine query_int\n\nsubroutine query_anything(data_object)\nclass(*),intent(in) ::data_object(..)\ncharacter(len=*),parameter :: all='(*(g0,1x))'\n if(rank(data_object).eq.0)then\n print all,&\n &'passed a scalar to an unlimited polymorphic rank=', &\n & rank(data_object)\n else\n print all,&\n & 'passed an array to an unlimited polymorphic, rank=', &\n & rank(data_object)\n endif\nend subroutine query_anything\n\nend program demo_rank\n```\nResults:\n```text\n > rank of scalar a= 0\n > rank of matrix b= 2\n > rank of vector pointer c= 1\n > rank of complex scalar d= 0\n > rank of any arbitrary type= 5\n > passed a scalar to an assumed rank, rank= 0\n > passed an array to an assumed rank, rank= 1\n > passed an array to an assumed rank, rank= 2\n > passed a scalar to an unlimited polymorphic rank= 0\n > passed an array to an unlimited polymorphic, rank= 1\n > passed an array to an unlimited polymorphic, rank= 2\n```\n### **Standard**\n\n### **See also**\n\n#### Array inquiry:\n\n- [**size**(3)](#size) - Determine the size of an array\n- [**rank**](#rank) - Rank of a data object\n- [**shape**(3)](#shape) - Determine the shape of an array\n- [**ubound**(3)](#ubound) - Upper dimension bounds of an array\n- [**lbound**(3)](#lbound) - Lower dimension bounds of an array\n\n#### State Inquiry:\n\n- [**allocated**(3)](#allocated) - Status of an allocatable entity\n- [**is_contiguous**(3)](#is_contiguous) - Test if object is contiguous\n\n#### Kind Inquiry:\n\n- [**kind**(3)](#kind) - Kind of an entity\n\n#### Bit Inquiry:\n\n- [**storage_size**(3)](#storage_size) - Storage size in bits\n- [**bit_size**(3)](#bit_size) - Bit size inquiry function\n- [**btest**(3)](#btest) - Tests a bit of an _integer_ value.\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "REAL": "## real\n\n### **Name**\n\n**real** - \\[TYPE:CONVERSION\\] Convert to real type\n\n### **Synopsis**\n```fortran\n result = real(x [,kind])\n```\n```fortran\n elemental real(kind=KIND) function real(x,KIND)\n\n TYPE(kind=**),intent(in) :: x\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - the type of **x** may be _integer_, _real_, or _complex_; or a BOZ-literal-constant.\n - **kind** is a _integer_ initialization expression (a constant expression)\n + If **kind** is present it defines the kind of the _real_ result\n + if **kind** is not present\n - when **x** is _complex_ the result is a _real_ of the same kind as **x**.\n - when **x** is _real_ or _integer_ the result is a _real_ of default kind\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**real** converts its argument **x** to a _real_ type.\n\nThe real part of a complex value is returned. For complex values this\nis similar to the modern complex-part-designator **%RE** which also\ndesignates the real part of a _complex_ value.\n\n```fortran\n z=(3.0,4.0) ! if z is a complex value\n print *, z%re == real(z) ! these expressions are equivalent\n```\n### **Options**\n\n- **x**\n : An _integer_, _real_, or _complex_ value to convert to _real_.\n\n- **kind**\n : When present the value of **kind** defines the kind of the result.\n\n### **Result**\n\n1. **real(x)** converts **x** to a default _real_ type if **x** is an _integer_\n or _real_ variable.\n\n2. **real(x)** converts a _complex_ value to a _real_ type with the\n magnitude of the real component of the input with kind type\n parameter the same as **x**.\n\n3. **real(x, kind)** is converted to a _real_ type with kind type\n parameter **kind** if **x** is a _complex_, _integer_, or _real_ variable.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_real\nuse,intrinsic :: iso_fortran_env, only : dp=>real64\nimplicit none\ncomplex :: zr = (1.0, 2.0)\ndoubleprecision :: xd=huge(3.0d0)\ncomplex(kind=dp) :: zd=cmplx(4.0e0_dp,5.0e0_dp,kind=dp)\n\n print *, real(zr), aimag(zr)\n print *, dble(zd), aimag(zd)\n\n write(*,*)xd,real(xd,kind=kind(0.0d0)),dble(xd)\nend program demo_real\n```\nResults:\n```text\n > 1.00000000 2.00000000\n > 4.0000000000000000 5.0000000000000000\n > 1.7976931348623157E+308 1.7976931348623157E+308 1.7976931348623157E+30\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n- [**aimag**(3)](#aimag) - Imaginary part of complex number\n- [**cmplx**(3)](#cmplx) - Complex conversion function\n- [**conjg**(3)](#conjg) - Complex conjugate function\n\nFortran has strong support for _complex_ values, including many intrinsics\nthat take or produce _complex_ values in addition to algebraic and\nlogical expressions:\n\n[**abs**(3)](#abs),\n[**acosh**(3)](#acosh),\n[**acos**(3)](#acos),\n[**asinh**(3)](#asinh),\n[**asin**(3)](#asin),\n[**atan2**(3)](#atan2),\n[**atanh**(3)](#atanh),\n[**atan**(3)](#atan),\n[**cosh**(3)](#cosh),\n[**cos**(3)](#cos),\n[**co_sum**(3)](#co_sum),\n[**dble**(3)](#dble),\n[**dot_product**(3)](#dot_product),\n[**exp**(3)](#exp),\n[**int**(3)](#int),\n[**is_contiguous**(3)](#is_contiguous),\n[**kind**(3)](#kind),\n[**log**(3)](#log),\n[**matmul**(3)](#matmul),\n[**precision**(3)](#precision),\n[**product**(3)](#product),\n[**range**(3)](#range),\n[**rank**(3)](#rank),\n[**sinh**(3)](#sinh),\n[**sin**(3)](#sin),\n[**sqrt**(3)](#sqrt),\n[**storage_size**(3)](#storage_size),\n[**sum**(3)](#sum),\n[**tanh**(3)](#tanh),\n[**tan**(3)](#tan),\n[**unpack**(3)](#unpack),\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "REDUCE": "## reduce\n\n### **Name**\n\n**reduce** - \\[ARRAY:TRANSFORMATIONAL\\] General reduction of an array\n\n### **Synopsis**\nThere are two forms to this function:\n```fortran\n result = reduce(array, operation [,mask] [,identity] [,ordered] )\n```\nor\n```fortran\n result = reduce (array, operation, dim &\n & [,mask] [,identity] [,ordered] )\n```\n```fortran\n type(TYPE(kind=KIND)) function reduce &\n & (array, operation, dim, mask, identity, ordered )\n\n type(TYPE(kind=KIND)),intent(in) :: array\n pure function :: operation\n integer,intent(in),optional :: dim\n logical,optional :: mask\n type(TYPE),intent(in),optional :: identity\n logical,intent(in),optional :: ordered\n```\n### **Characteristics**\n\n - **array** is an array of any type\n - **operation** is a pure function with exactly two arguments\n + each argument is scalar, non-allocatable, a nonpointer,\n nonpolymorphic and nonoptional with the same type and kind as array.\n + if one argument has the asynchronous, target, or value attribute so\n shall the other.\n - **dim** is an _integer_ scalar\n - **mask** is a logical conformable with **array**\n - **identity** is a scalar with the same type and type parameters as **array**\n - **ordered** is a logical scalar\n - the result is of the same type and type parameters as **array**.\n\n### **Description**\n\n **reduce** reduces a list of conditionally selected values from\n an array to a single value by iteratively applying a binary function.\n\n Common in functional programming, a **reduce** function applies a\n binary operator (a pure function with two arguments) to all elements\n cumulatively.\n\n **reduce** is a \"higher-order\" function; ie. it is a function that\n receives other functions as arguments.\n\n The **reduce** function receives a binary operator (a function with\n two arguments, just like the basic arithmetic operators). It is first\n applied to two unused values in the list to generate an accumulator\n value which is subsequently used as the first argument to the function\n as the function is recursively applied to all the remaining selected\n values in the input array.\n\n### **Options**\n\n- **array**\n : An array of any type and allowed rank to select values from.\n\n- **operation**\n : shall be a pure function with exactly two arguments;\n each argument shall be a scalar, nonallocatable,\n nonpointer, nonpolymorphic, nonoptional dummy data object\n with the same type and type parameters as **array**. If\n one argument has the ASYNCHRONOUS, TARGET, or VALUE\n attribute, the other shall have that attribute. Its result\n shall be a nonpolymorphic scalar and have the same type\n and type parameters as **array**. **operation** should\n implement a mathematically associative operation. It\n need not be commutative.\n\n NOTE\n\n If **operation** is not computationally associative, REDUCE\n without ORDERED=.TRUE. with the same argument values\n might not always produce the same result, as the processor\n can apply the associative law to the evaluation.\n\n Many operations that mathematically are associative are\n not when applied to floating-point numbers. The order\n you sum values in may affect the result, for example.\n\n- **dim**\n : An integer scalar with a value in the range\n 1<= **dim** <= n, where n is the rank of **array**.\n\n- **mask**\n : (optional) shall be of type logical and shall be\n conformable with **array**.\n\n When present only those elements of **array** are passed\n to **operation** for which the corresponding elements\n of **mask** are true, as if **array** was filtered with\n **pack(3)**.\n\n- **identity**\n : shall be scalar with the same type and type parameters as **array**.\n If the initial sequence is empty, the result has the value **identify**\n if **identify** is present, and otherwise, error termination is\n initiated.\n\n- **ordered**\n : shall be a logical scalar. If **ordered** is present with the value\n _.true._, the calls to the **operator** function begins with the first\n two elements of **array** and the process continues in row-column\n order until the sequence has only one element which is the value of the\n reduction. Otherwise, the compiler is free to assume that the operation\n is commutative and may evaluate the reduction in the most optimal way.\n\n### **Result**\n\nThe result is of the same type and type parameters as **array**. It is\nscalar if **dim** does not appear.\n\nIf **dim** is present, it indicates the one dimension along which to\nperform the reduction, and the resultant array has a rank reduced by\none relative to the input array.\n\n### **Examples**\n\n The following examples all use the function MY\\_MULT, which returns\n the product of its two real arguments.\n```fortran\n program demo_reduce\n implicit none\n character(len=*),parameter :: f='(\"[\",*(g0,\",\",1x),\"]\")'\n integer,allocatable :: arr(:), b(:,:)\n\n ! Basic usage:\n ! the product of the elements of an array\n arr=[1, 2, 3, 4 ]\n write(*,*) arr\n write(*,*) 'product=', reduce(arr, my_mult)\n write(*,*) 'sum=', reduce(arr, my_sum)\n\n ! Examples of masking:\n ! the product of only the positive elements of an array\n arr=[1, -1, 2, -2, 3, -3 ]\n write(*,*)'positive value product=',reduce(arr, my_mult, mask=arr>0)\n ! sum values ignoring negative values\n write(*,*)'sum positive values=',reduce(arr, my_sum, mask=arr>0)\n\n ! a single-valued array returns the single value as the\n ! calls to the operator stop when only one element remains\n arr=[ 1234 ]\n write(*,*)'single value sum',reduce(arr, my_sum )\n write(*,*)'single value product',reduce(arr, my_mult )\n\n ! Example of operations along a dimension:\n ! If B is the array 1 3 5\n ! 2 4 6\n b=reshape([1,2,3,4,5,6],[2,3])\n write(*,f) REDUCE(B, MY_MULT),'should be [720]'\n write(*,f) REDUCE(B, MY_MULT, DIM=1),'should be [2,12,30]'\n write(*,f) REDUCE(B, MY_MULT, DIM=2),'should be [15, 48]'\n\n contains\n\n pure function my_mult(a,b) result(c)\n integer,intent(in) :: a, b\n integer :: c\n c=a*b\n end function my_mult\n\n pure function my_sum(a,b) result(c)\n integer,intent(in) :: a, b\n integer :: c\n c=a+b\n end function my_sum\n\n end program demo_reduce\n```\nResults:\n```text\n > 1 2 3 4\n > product= 24\n > sum= 10\n > positive value sum= 6\n > sum positive values= 6\n > single value sum 1234\n > single value product 1234\n > [720, should be [720],\n > [2, 12, 30, should be [2,12,30],\n > [15, 48, should be [15, 48],\n```\n### **Standard**\n\n Fortran 2018\n\n### **See Also**\n- [co_reduce(3)](#co_reduce)\n\n### **Resources**\n\n- [associative:wikipedia](https://en.wikipedia.org/wiki/Associative_property)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "REPEAT": "## repeat\n\n### **Name**\n\n**repeat** - \\[CHARACTER\\] Repeated string concatenation\n\n### **Synopsis**\n```fortran\n result = repeat(string, ncopies)\n```\n```fortran\n character(len=len(string)*ncopies) function repeat(string, ncopies)\n\n character(len=*),intent(in) :: string\n integer(kind=**),intent(in) :: ncopies\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **string** is a scalar _character_ type.\n - **ncopies** is a scalar integer.\n - the result is a new scalar of type _character_ of the same kind as\n **string**\n\n### **Description**\n\n **repeat** concatenates copies of a string.\n\n### **Options**\n\n- **string**\n : The input string to repeat\n\n- **ncopies**\n : Number of copies to make of **string**, greater than or equal to zero (0).\n\n### **Result**\n\n A new string built up from **ncopies** copies of **string**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_repeat\nimplicit none\n write(*,'(a)') repeat(\"^v\", 35) ! line break\n write(*,'(a)') repeat(\"_\", 70) ! line break\n write(*,'(a)') repeat(\"1234567890\", 7) ! number line\n write(*,'(a)') repeat(\" |\", 7) !\nend program demo_repeat\n```\nResults:\n```text\n > ^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v\n > ______________________________________________________________________\n > 1234567890123456789012345678901234567890123456789012345678901234567890\n > | | | | | | |\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\nFunctions that perform operations on character strings:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n [**scan**(3)](#scan),\n [**verify**(3)](#verify)\n\n- **Non-elemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**](#repeat),\n [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "RESHAPE": "## reshape\n\n### **Name**\n\n**reshape** - \\[ARRAY:RESHAPE\\] Function to reshape an array\n\n### **Synopsis**\n```fortran\n result = reshape( source, shape [,pad] [,order] )\n```\n```fortran\n type(TYPE(kind=KIND)) function reshape\n\n type(TYPE(kind=KIND)),intent(in) :: source(..)\n integer(kind=**),intent(in) :: shape(:)\n type(TYPE(kind=KIND)),intent(in),optional :: pad(..)\n integer(kind=**),intent(in),optional :: order(:)\n```\n### **Characteristics**\n\n - **source** is an array of any type\n - **shape** defines a Fortran shape and therefore an _integer_ vector\n (of rank one) of constant size of up to 16 non-negative values.\n - **pad** is the same type as **source**\n - **order** is the same shape as **shape**\n - The result is an array of shape **shape** with the same type as **source**.\n - a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**reshape** constructs an array of arbitrary shape **shape** using the elements\nfrom **source** and possibly **pad** to fill it.\n\nIf necessary, the new array may be padded with elements from **pad**\nor permuted as defined by **order**.\n\nAmong many other uses, **reshape** can be used to reorder a Fortran array\nto match C array ordering before the array is passed from Fortran to a\nC procedure.\n\n### **Options**\n\n- **source**\n : an array containing the elements to be copied to the result.\n there must be enough elements in the source to fill the new shape\n if **pad** is omitted or has size zero. Expressed in Fortran ...\n```fortran\n if(.not.present(pad))then\n if(size(source) < product(shape))then\n stop 'not enough elements in the old array to fill the new one'\n endif\n endif\n```\n- **shape**\n : This is the shape of the new array being generated.\n Being by definition a shape; all elements are either positive integers\n or zero, the size but be 1 or greater, it may have up to 16 elements\n but must be of constant fixed size and rank one.\n\n- **pad**\n : used to fill in extra values if the result array is larger than **source**.\n It will be used repeatedly after all the elements of **source** have been\n placed in the result until the result has all elements assigned.\n : If it is absent or is a zero-sized array, you can only make\n **source** into another array of the same size as **source** or smaller.\n\n- **order**\n : used to insert elements in the result in an order other\n than the normal Fortran array element order, in which the first dimension\n varies fastest.\n : By definition of ranks the values have to be a permutation of the numbers\n from 1 to n, where n is the rank of **shape**.\n : the elements of **source** and pad are placed into the result in order;\n changing the left-most rank most rapidly by default. To change the order by\n which the elements are placed in the result use **order**.\n\n### **Result**\n\nThe result is an array of shape **shape** with the same type and type\nparameters as **source**. It is first filled with the values of elements\nof **source**, with the remainder filled with repeated copies of **pad**\nuntil all elements are filled. The new array may be smaller than\n**source**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_reshape\nimplicit none\n! notice the use of \"shape(box)\" on the RHS\ninteger :: box(3,4)=reshape([1,2,3,4,5,6,7,8,9,10,11,12],shape(box))\ninteger,allocatable :: v(:,:)\ninteger :: rc(2)\n ! basics0\n ! what is the current shape of the array?\n call printi('shape of box is ',box)\n ! change the shape\n call printi('reshaped ',reshape(box,[2,6]))\n call printi('reshaped ',reshape(box,[4,3]))\n\n ! fill in row column order using order\n v=reshape([1,2,3,4,10,20,30,40,100,200,300,400],[1,12])\n call printi('here is some data to shape',v)\n call printi('normally fills columns first ',reshape([v],[3,4]))\n call printi('fill rows first', reshape([v],[3,4],order=[2,1]))\n\n ! if we take the data and put in back in filling\n ! rows first instead of columns, and flipping the\n ! height and width of the box we not only fill in\n ! a vector using row-column order we actually\n ! transpose it.\n rc(2:1:-1)=shape(box)\n ! copy the data in changing column number fastest\n v=reshape(box,rc,order=[2,1])\n call printi('reshaped and reordered',v)\n ! of course we could have just done a transpose\n call printi('transposed',transpose(box))\n\n ! making the result bigger than source using pad\n v=reshape(box,rc*2,pad=[-1,-2,-3],order=[2,1])\n call printi('bigger and padded and reordered',v)\ncontains\n\nsubroutine printi(title,arr)\nimplicit none\n\n!@(#) print small 2d integer arrays in row-column format\n\ncharacter(len=*),parameter :: all='(*(g0,1x))' ! a handy format\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n print all\n print all, trim(title),':(',shape(arr),')' ! print title\n biggest=' ' ! make buffer to write integer into\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" > [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\n\nend subroutine printi\n\nend program demo_reshape\n```\nResults:\n```text\n shape of box is :( 3 4 )\n > [ 1, 4, 7, 10 ]\n > [ 2, 5, 8, 11 ]\n > [ 3, 6, 9, 12 ]\n\n reshaped :( 2 6 )\n > [ 1, 3, 5, 7, 9, 11 ]\n > [ 2, 4, 6, 8, 10, 12 ]\n\n reshaped :( 4 3 )\n > [ 1, 5, 9 ]\n > [ 2, 6, 10 ]\n > [ 3, 7, 11 ]\n > [ 4, 8, 12 ]\n\n here is some data to shape :( 1 12 )\n > [ 1, 2, 3, 4, 10, 20, 30, 40, 100, 200, 300, 400 ]\n\n normally fills columns first :( 3 4 )\n > [ 1, 4, 30, 200 ]\n > [ 2, 10, 40, 300 ]\n > [ 3, 20, 100, 400 ]\n\n fill rows first :( 3 4 )\n > [ 1, 2, 3, 4 ]\n > [ 10, 20, 30, 40 ]\n > [ 100, 200, 300, 400 ]\n\n reshaped and reordered :( 4 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n > [ 7, 8, 9 ]\n > [ 10, 11, 12 ]\n\n transposed :( 4 3 )\n > [ 1, 2, 3 ]\n > [ 4, 5, 6 ]\n > [ 7, 8, 9 ]\n > [ 10, 11, 12 ]\n\n bigger and padded and reordered :( 8 6 )\n > [ 1, 2, 3, 4, 5, 6 ]\n > [ 7, 8, 9, 10, 11, 12 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n > [ -1, -2, -3, -1, -2, -3 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**shape**(3)](#shape),\n[**pack**(3)](#pack),\n[**transpose**(3)](#transpose)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "RRSPACING": "## rrspacing\n\n### **Name**\n\n**rrspacing** - \\[MODEL_COMPONENTS\\] Reciprocal of the relative\nspacing of a numeric type\n\n### **Synopsis**\n```fortran\n result = rrspacing(x)\n```\n```fortran\n elemental real(kind=KIND) function rrspacing(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is type _real_ of any kind\n - The return value is of the same type and kind as **x**.\n\n### **Description**\n\n**rrspacing** returns the reciprocal of the relative spacing of model\nnumbers near **x**.\n\n\n\n### **Options**\n\n- **x**\n : Shall be of type _real_.\n\n### **Result**\n\n The return value is of the same type and kind as **x**. The value\n returned is equal to\n **abs(fraction(x)) \\* float(radix(x))\\*\\*digits(x)**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_rrspacing\nimplicit none\ninteger, parameter :: sgl = selected_real_kind(p=6, r=37)\ninteger, parameter :: dbl = selected_real_kind(p=13, r=200)\ncharacter(len=*),parameter :: gen='(*(g0))', nl=new_line('A')\nreal(kind=sgl) :: x\n x=-3.0_sgl\n print gen, &\n 'rrspacing(',x,'_sgl)=', rrspacing(x), nl, &\n 'rrspacing(x)=abs(fraction(x))*float(radix(x))**digits(x)', nl, &\n 'so this should be the same as rrspacing():', nl, &\n abs( fraction(x) ) * float( radix(x) )**digits(x), nl, &\n 'RRSPACING (-3.0) has the value 0.75x2**24 for reals', nl, &\n 'on current typical platforms. For reference:', nl, &\n ' 0.75*2**24=', 0.75*2**24, nl, &\n 'sign should not matter, so',rrspacing(x)==rrspacing(-x), nl, &\n 'note the kind of the value is significant', nl, &\n rrspacing(-3.0_dbl), nl, &\n 'for common platforms rrspacing(487923.3d0)=>', nl, &\n ' 8.382458680573952E+015', nl, &\n rrspacing(487923.3d0), nl, &\n ' '\nend program demo_rrspacing\n```\n```text\n > rrspacing(-3.00000000_sgl)=12582912.0\n > rrspacing(x)=abs(fraction(x))*float(radix(x))**digits(x)\n > so this should be the same as rrspacing():\n > 12582912.0\n > RRSPACING (-3.0) has the value 0.75x2**24 for reals\n > on current typical platforms. For reference:\n > 0.75*2**24=12582912.0\n > sign should not matter, soT\n > note the kind of the value is significant\n > 6755399441055744.0\n > for common platforms rrspacing(487923.3d0)=>8.382458680573952E+015\n > 8382458465825587.0\n```\n### **Standard**\n\nFortran 90\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions_\n", "SAME_TYPE_AS": "## same_type_as\n\n### **Name**\n\n**same_type_as** - \\[STATE:INQUIRY\\] Query dynamic types for equality\n\n### **Synopsis**\n```fortran\n result = same_type_as(a, b)\n```\n```fortran\n logical same_type_as(a, b)\n\n type(TYPE(kind=KIND)),intent(in) :: a\n type(TYPE(kind=KIND)),intent(in) :: b\n```\n### **Characteristics**\n\n- **a** shall be an object of extensible declared type or unlimited\n polymorphic. If it is a polymorphic pointer, it shall not have\n an undefined association status.\n\n- **b** shall be an object of extensible declared type or unlimited\n polymorphic. If it is a polymorphic pointer, it shall not have\n an undefined association status.\n\n### **Description**\n\n**same_type_as** queries the dynamic types of objects for equality.\n\n### **Options**\n\n- **a**\n : object to compare to **b** for equality of type\n\n- **b**\n : object to be compared to for equality of type\n\n### **Result**\n\n If the dynamic type of **a** or **b** is extensible, the result is true\n if and only if the dynamic type of **a** is the same as the dynamic\n type of **b**. If neither **a** nor **b** has extensible dynamic type,\n the result is processor dependent.\n\n NOTE1\n\n The dynamic type of a disassociated pointer or unallocated allocatable\n variable is its declared type. An unlimited polymorphic entity has no\n declared type.\n\n NOTE2\n\n The test performed by SAME_TYPE_AS is not the same as the test performed\n by the type guard TYPE IS. The test performed by SAME_TYPE_AS does\n not consider kind type parameters.\n\nSample program:\n```fortran\n ! program demo_same_type_as\n module M_ether\n implicit none\n private\n\n type :: dot\n real :: x=0\n real :: y=0\n end type dot\n\n type, extends(dot) :: point\n real :: z=0\n end type point\n\n type something_else\n end type something_else\n\n public :: dot\n public :: point\n public :: something_else\n\n end module M_ether\n\n program demo_same_type_as\n use M_ether, only : dot, point, something_else\n implicit none\n type(dot) :: dad, mom\n type(point) :: me\n type(something_else) :: alien\n\n write(*,*)same_type_as(me,dad),'I am descended from Dad, but equal?'\n write(*,*)same_type_as(me,me) ,'I am what I am'\n write(*,*)same_type_as(dad,mom) ,'what a pair!'\n\n write(*,*)same_type_as(dad,me),'no paradox here'\n write(*,*)same_type_as(dad,alien),'no relation'\n\n call pointers()\n contains\n subroutine pointers()\n ! Given the declarations and assignments\n type t1\n real c\n end type\n type, extends(t1) :: t2\n end type\n class(t1), pointer :: p, q, r\n allocate (p, q)\n allocate (t2 :: r)\n ! the result of SAME_TYPE_AS (P, Q) will be true, and the result\n ! of SAME_TYPE_AS (P, R) will be false.\n write(*,*)'(P,Q)',same_type_as(p,q),\"mind your P's and Q's\"\n write(*,*)'(P,R)',same_type_as(p,r)\n end subroutine pointers\n\n end program demo_same_type_as\n```\nResults:\n```text\n > F I am descended from Dad, but equal?\n > T I am what I am\n > T what a pair!\n > F no paradox here\n > F no relation\n > (P,Q) T mind your P's and Q's\n > (P,R) F\n```\n### **Standard**\n\nFortran 2003\n\n### **See Also**\n\n[**extends_type_of**(3)](#extends_type_of)\n\n _Fortran intrinsic descriptions_\n", "SCALE": "## scale\n\n### **Name**\n\n**scale** - \\[MODEL:COMPONENTS\\] Scale a real value by a whole power of the radix\n\n### **Synopsis**\n```fortran\n result = scale(x, i)\n```\n```fortran\n elemental real(kind=KIND) function scale(x, i)\n\n real(kind=KIND),intent(in) :: x\n integer(kind=**),intent(in) :: i\n```\n### **Characteristics**\n\n - **x** is type _real_ of any kind\n - **i** is type an _integer_ of any kind\n - the result is _real_ of the same kind as **x**\n\n### **Description**\n\n **scale** returns x \\* **radix(x)\\*\\*i**.\n\n It is almost certain the radix(base) of the platform is two, therefore\n **scale** is generally the same as **x*2\\*\\*i**\n\n### **Options**\n\n- **x**\n : the value to multiply by **radix(x)\\*\\*i**. Its type and kind is used\n to determine the radix for values with its characteristics and determines\n the characteristics of the result, so care must be taken the returned\n value is within the range of the characteristics of **x**.\n\n- **i**\n : The power to raise the radix of the machine to\n\n### **Result**\n\nThe return value is **x \\* radix(x)\\*\\*i**, assuming that value can be\nrepresented by a value of the type and kind of **x**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_scale\nimplicit none\nreal :: x\ncomplex :: c\ninteger :: i\n x = 1.0\n print *, (scale(x,i),i=1,5)\n x = 3.0\n print *, (scale(x,i),i=1,5)\n print *, (scale(log(1.0),i),i=1,5)\n ! on modern machines radix(x) is almost certainly 2\n x = 178.1387e-4\n i = 5\n print *, x, i, scale(x, i), x*radix(x)**i\n ! x*radix(x)**i is the same except roundoff errors are not restricted\n i = 2\n print *, x, i, scale(x, i), x*radix(x)**i\n ! relatively easy to do complex values as well\n c=(3.0,4.0)\n print *, c, i, scale_complex(c, i)!, c*radix(c)**i\ncontains\nfunction scale_complex(x, n)\n! example supporting complex value for default kinds\ncomplex, intent(in) :: x\ninteger, intent(in) :: n\ncomplex :: scale_complex\n scale_complex=cmplx(scale(x%re, n), scale(x%im, n), kind=kind(x%im))\nend function scale_complex\nend program demo_scale\n```\nResults:\n```text\n > 2.00000000 4.00000000 8.00000000 16.0000000 32.0000000\n > 6.00000000 12.0000000 24.0000000 48.0000000 96.0000000\n > 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000\n > 1.78138707E-02 5 0.570043862 0.570043862\n > 1.78138707E-02 2 7.12554827E-02 7.12554827E-02\n > (3.00000000,4.00000000) 2 (12.0000000,16.0000000)\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SCAN": "## scan\n\n### **Name**\n\n**scan** - \\[CHARACTER:SEARCH\\] Scan a string for the presence of a set of characters\n\n### **Synopsis**\n```fortran\n result = scan( string, set, [,back] [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function scan(string,set,back,kind)\n\n character(len=*,kind=**),intent(in) :: string\n character(len=*,kind=**),intent(in) :: set\n logical,intent(in),optional :: back\n integer,intent(in),optional :: kind\n```\n### **Characteristics**\n\n - **string** is a _character_ string of any kind\n - **set** must be a _character_ string with the same kind as **string**\n - **back** is a _logical_\n - **kind** is a scalar _integer_ constant expression\n - the result is an _integer_ with the kind specified by **kind**. If\n **kind** is not present the result is a default _integer_.\n\n### **Description**\n\n **scan** scans a **string** for any of the characters in a **set**\n of characters.\n\n If **back** is either absent or equals _.false._, this function\n returns the position of the leftmost character of **STRING** that is\n in **set**. If **back** equals _.true._, the rightmost position is\n returned. If no character of **set** is found in **string**, the result\n is zero.\n\n### **Options**\n\n- **string**\n : the string to be scanned\n\n- **set**\n : the set of characters which will be matched\n\n- **back**\n : if _.true._ the position of the rightmost character matched is\n returned, instead of the leftmost.\n\n- **kind**\n : the kind of the returned value is the same as **kind** if\n present. Otherwise a default _integer_ kind is returned.\n\n### **Result**\n\n If **back** is absent or is present with the value false and if\n **string** contains at least one character that is in **set**, the value\n of the result is the position of the leftmost character of **string**\n that is in **set**.\n\n If **back** is present with the value true and if **string** contains at\n least one character that is in **set**, the value of the result is the\n position of the rightmost character of **string** that is in **set**.\n\n The value of the result is zero if no character of STRING is in SET\n or if the length of STRING or SET is zero.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_scan\nimplicit none\n write(*,*) scan(\"fortran\", \"ao\") ! 2, found 'o'\n write(*,*) scan(\"fortran\", \"ao\", .true.) ! 6, found 'a'\n write(*,*) scan(\"fortran\", \"c++\") ! 0, found none\nend program demo_scan\n```\nResults:\n```text\n > 2\n > 6\n > 0\n```\n### **Standard**\n\nFortran 95 , with KIND argument - Fortran 2003\n\n### **See Also**\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl), [**adjustr**(3)](#adjustr), [**index**(3)](#index),\n [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len\\_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat), [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SELECTED_CHAR_KIND": "## selected_char_kind\n\n### **Name**\n\n**selected_char_kind** - \\[KIND\\] Select character kind such as \"Unicode\"\n\n### **Synopsis**\n```fortran\n result = selected_char_kind(name)\n```\n```fortran\n integer function selected_char_kind(name)\n\n character(len=*),intent(in) :: name\n```\n### **Characteristics**\n\n - **name** is a default _character_ scalar\n - the result is a default _integer_ scalar\n\n### **Description**\n\n **selected_char_kind** returns a kind parameter value for the\n character set named **name**.\n\n If a name is not supported, -1 is returned. Otherwise the result is a\n value equal to that kind type parameter value.\n\n The list of supported names is processor-dependent except for \"DEFAULT\".\n\n + If **name** has the value \"DEFAULT\", then the result has a value equal to\n that of the kind type parameter of default character. This name is\n always supported.\n\n + If **name** has the value \"ASCII\", then the result has a value equal\n to that of the kind type parameter of ASCII character.\n\n + If **name** has the value \"ISO_10646\", then the result has a value equal\n to that of the kind type parameter of the ISO 10646 character kind\n (corresponding to UCS-4 as specified in ISO/IEC 10646).\n\n + If **name** is a processor-defined name of some other character kind\n supported by the processor, then the result has a value equal to that\n kind type parameter value.\n Pre-defined names include \"ASCII\" and \"ISO_10646\".\n\n The NAME is interpreted without respect to case or trailing blanks.\n\n### **Options**\n\n- **name**\n : A name to query the processor-dependent kind value of, and/or to determine\n if supported. **name**, interpreted without respect to case or\n trailing blanks.\n\n Currently, supported character sets include \"ASCII\" and \"DEFAULT\" and\n \"ISO_10646\" (Universal Character Set, UCS-4) which is commonly known as\n \"Unicode\". Supported names other than \"DEFAULT\" are processor dependent.\n\n### **Result**\n\n\n### **Examples**\n\nSample program:\n\n```fortran\nLinux\nprogram demo_selected_char_kind\nuse iso_fortran_env\nimplicit none\n\nintrinsic date_and_time,selected_char_kind\n\n! set some aliases for common character kinds\n! as the numbers can vary from platform to platform\n\ninteger, parameter :: default = selected_char_kind (\"default\")\ninteger, parameter :: ascii = selected_char_kind (\"ascii\")\ninteger, parameter :: ucs4 = selected_char_kind ('ISO_10646')\ninteger, parameter :: utf8 = selected_char_kind ('utf-8')\n\n! assuming ASCII and UCS4 are supported (ie. not equal to -1)\n! define some string variables\ncharacter(len=26, kind=ascii ) :: alphabet\ncharacter(len=30, kind=ucs4 ) :: hello_world\ncharacter(len=30, kind=ucs4 ) :: string\n\n write(*,*)'ASCII ',&\n & merge('Supported ','Not Supported',ascii /= -1)\n write(*,*)'ISO_10646 ',&\n & merge('Supported ','Not Supported',ucs4 /= -1)\n write(*,*)'UTF-8 ',&\n & merge('Supported ','Not Supported',utf8 /= -1)\n\n if(default.eq.ascii)then\n write(*,*)'ASCII is the default on this processor'\n endif\n\n ! for constants the kind precedes the value, somewhat like a\n ! BOZ constant\n alphabet = ascii_\"abcdefghijklmnopqrstuvwxyz\"\n write (*,*) alphabet\n\n hello_world = ucs4_'Hello World and Ni Hao -- ' &\n // char (int (z'4F60'), ucs4) &\n // char (int (z'597D'), ucs4)\n\n ! an encoding option is required on OPEN for non-default I/O\n if(ucs4 /= -1 )then\n open (output_unit, encoding='UTF-8')\n write (*,*) trim (hello_world)\n else\n write (*,*) 'cannot use utf-8'\n endif\n\n call create_date_string(string)\n write (*,*) trim (string)\n\ncontains\n\n! The following produces a Japanese date stamp.\nsubroutine create_date_string(string)\nintrinsic date_and_time,selected_char_kind\ninteger,parameter :: ucs4 = selected_char_kind(\"ISO_10646\")\ncharacter(len=1,kind=ucs4),parameter :: &\n nen = char(int( z'5e74' ),ucs4), & ! year\n gatsu = char(int( z'6708' ),ucs4), & ! month\n nichi = char(int( z'65e5' ),ucs4) ! day\ncharacter(len= *, kind= ucs4) string\ninteger values(8)\n call date_and_time(values=values)\n write(string,101) values(1),nen,values(2),gatsu,values(3),nichi\n 101 format(*(i0,a))\nend subroutine create_date_string\n\nend program demo_selected_char_kind\n```\nResults:\n\nThe results are very processor-dependent\n```text\n > ASCII Supported\n > ISO_10646 Supported\n > UTF-8 Not Supported\n > ASCII is the default on this processor\n > abcdefghijklmnopqrstuvwxyz\n > Hello World and Ni Hao -- \u4f60\u597d\n > 2022\u5e7410\u670815\u65e5\n```\n### **Standard**\n\nFortran 2003\n\n### **See also**\n\n[**selected_int_kind**(3)](#selected_int_kind),\n[**selected_real_kind**(3)](#selected_real_kind)\n\n[**achar**(3)](#achar),\n[**char**(3)](#char),\n[**ichar**(3)](#ichar),\n[**iachar**(3)](#iachar)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SELECTED_INT_KIND": "## selected_int_kind\n\n### **Name**\n\n**selected_int_kind** - \\[KIND\\] Choose integer kind\n\n### **Synopsis**\n```fortran\n result = selected_int_kind(r)\n```\n```fortran\n integer function selected_int_kind(r)\n\n integer(kind=KIND),intent(in) :: r\n```\n### **Characteristics**\n\n - **r** is an _integer_ scalar.\n - the result is an default integer scalar.\n\n### **Description**\n\n **selected_int_kind** return the kind value of the smallest\n integer type that can represent all values ranging from **-10\\*\\*r**\n (exclusive) to **10\\*\\*r** (exclusive). If there is no integer kind\n that accommodates this range, selected_int_kind returns **-1**.\n\n### **Options**\n\n- **r**\n : The value specifies the required range of powers of ten that need\n supported by the kind type being returned.\n\n### **Result**\n\n The result has a value equal to the value of the kind type parameter\n of an integer type that represents all values in the requested range.\n\n if no such kind type parameter is available on the processor, the\n result is -1.\n\n If more than one kind type parameter meets the criterion, the value\n returned is the one with the smallest decimal exponent range, unless\n there are several such values, in which case the smallest of these\n kind values is returned.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_selected_int_kind\nimplicit none\ninteger,parameter :: k5 = selected_int_kind(5)\ninteger,parameter :: k15 = selected_int_kind(15)\ninteger(kind=k5) :: i5\ninteger(kind=k15) :: i15\n\n print *, huge(i5), huge(i15)\n\n ! the following inequalities are always true\n print *, huge(i5) >= 10_k5**5-1\n print *, huge(i15) >= 10_k15**15-1\nend program demo_selected_int_kind\n```\nResults:\n```text\n > 2147483647 9223372036854775807\n > T\n > T\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**aint**(3)](#aint),\n[**anint**(3)](#anint),\n[**int**(3)](#int),\n[**nint**(3)](#nint),\n[**ceiling**(3)](#ceiling),\n[**floor**(3)](#floor)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SELECTED_REAL_KIND": "## selected_real_kind\n\n### **Name**\n\n**selected_real_kind** - \\[KIND\\] Choose real kind\n\n### **Synopsis**\n```fortran\n result = selected_real_kind([p] [,r] [,radix] )\n```\n```fortran\n integer function selected_int_kind(r)\n\n real(kind=KIND),intent(in),optional :: p\n real(kind=KIND),intent(in),optional :: r\n real(kind=KIND),intent(in),optional :: radix\n```\n### **Characteristics**\n\n - **p** is an _integer_ scalar\n - **r** is an _integer_ scalar\n - **radix** is an _integer_ scalar\n - the result is an default _integer_ scalar\n\n### **Description**\n\n **selected_real_kind** return the kind value of a _real_ data type with\n decimal precision of at least **p** digits, exponent range of at least\n **r**, and with a radix of **radix**. That is, if such a kind exists\n\n + it has the decimal precision as returned by **precision**(3) of at\n least **p** digits.\n + a decimal exponent range, as returned by the function **range**(3)\n of at least **r**\n + a radix, as returned by the function **radix**(3) , of **radix**,\n\n If the requested kind does not exist, -1 is returned.\n\n At least one argument shall be present.\n\n### **Options**\n\n- **p**\n : the requested precision\n\n- **r**\n : the requested range\n\n- **radix**\n : the desired radix\n\n Before **Fortran 2008**, at least one of the arguments **r** or **p** shall\n be present; since **Fortran 2008**, they are assumed to be zero if\n absent.\n\n### **Result**\n\n selected_real_kind returns the value of the kind type parameter of\n a real data type with decimal precision of at least **p** digits,\n a decimal exponent range of at least R, and with the requested\n **radix**.\n\n If **p** or **r** is absent, the result value is the same as if it\n were present with the value zero.\n\n\n If the **radix** parameter is absent, there is no requirement on\n the radix of the selected kind and real kinds with any radix can be\n returned.\n\n If more than one real data type meet the criteria, the kind\n of the data type with the smallest decimal precision is returned. If\n no real data type matches the criteria, the result is\n\n - **-1**\n : if the processor does not support a real data type with a\n precision greater than or equal to **p**, but the **r** and **radix**\n requirements can be fulfilled\n\n - **-2**\n : if the processor does not support a real type with an\n exponent range greater than or equal to **r**, but **p** and **radix** are\n fulfillable\n\n - **-3**\n : if **radix** but not **p** and **r** requirements are fulfillable\n\n - **-4**\n : if **radix** and either **p** or **r** requirements are fulfillable\n\n - **-5**\n : if there is no real type with the given **radix**\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_selected_real_kind\nimplicit none\ninteger,parameter :: p6 = selected_real_kind(6)\ninteger,parameter :: p10r100 = selected_real_kind(10,100)\ninteger,parameter :: r400 = selected_real_kind(r=400)\nreal(kind=p6) :: x\nreal(kind=p10r100) :: y\nreal(kind=r400) :: z\n\n print *, precision(x), range(x)\n print *, precision(y), range(y)\n print *, precision(z), range(z)\nend program demo_selected_real_kind\n```\nResults:\n```text\n > 6 37\n > 15 307\n > 18 4931\n```\n### **Standard**\n\nFortran 95 ; with RADIX - Fortran 2008\n\n### **See Also**\n\n[**precision**(3)](#precision),\n[**range**(3)](#range),\n[**radix**(3)](#radix)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SET_EXPONENT": "## set_exponent\n\n### **Name**\n\n**set_exponent** - \\[MODEL:COMPONENTS\\] real value with specified exponent\n\n### **Synopsis**\n```fortran\n result = set_exponent(x, i)\n```\n```fortran\n elemental real(kind=KIND) function set_exponent(x,i)\n\n real(kind=KIND),intent(in) :: x\n integer(kind=**),intent(in) :: i\n```\n### **Characteristics**\n\n - **x** is type _real_\n - **i** is type _integer_\n - a kind designated as ** may be any supported kind for the type\n\n - The return value is of the same type and kind as **x**.\n\n### **Description**\n\n **set_exponent** returns the real number whose fractional part is\n that of **x** and whose exponent part is **i**.\n\n### **Options**\n\n- **x**\n : Shall be of type _real_.\n\n- **i**\n : Shall be of type _integer_.\n\n### **Result**\n\n The return value is of the same type and kind as **x**. The real number\n whose fractional part is that of **x** and whose exponent part\n if **i** is returned; it is **fraction(x) \\* real(radix(x))\\*\\*i**.\n\n If **x** has the value zero, the result has the same value as **x**.\n\n If **x** is an IEEE infinity, the result is an IEEE NaN.\n\n If **x** is an IEEE NaN, the result is the same NaN.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_setexp\nimplicit none\nreal :: x = 178.1387e-4\ninteger :: i = 17\n print *, set_exponent(x, i), fraction(x) * real(radix(x))**i\nend program demo_setexp\n```\nResults:\n```text\n > 74716.7891 74716.7891\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**spacing**(3)](#spacing),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions_\n", "SHAPE": "## shape\n\n### **Name**\n\n**shape** - \\[ARRAY:INQUIRY\\] Determine the shape of an array or scalar\n\n### **Synopsis**\n```fortran\n result = shape( source [,kind] )\n```\n```fortran\n integer(kind=KIND) function shape( source, KIND )\n\n type(TYPE(kind=**)),intent(in) :: source(..)\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n\n - **source** is an array or scalar of any type. If **source** is a pointer\n it must be associated and allocatable arrays must be allocated. It shall\n not be an assumed-size array.\n\n - **KIND** is a constant _integer_ initialization expression.\n\n - the result is an _integer_ array of rank one with size equal to the\n rank of **source** of the kind specified by **KIND** if **KIND**\n is present, otherwise it has the default integer kind.\n\n### **Description**\n\n **shape** queries the shape of an array.\n\n### **Options**\n\n- **source**\n : an array or scalar of any type. If **source** is a pointer it\n must be associated and allocatable arrays must be allocated.\n\n- **kind**\n : indicates the kind parameter of the result.\n\n### **Result**\n\n An _integer_ array of rank one with as many elements as **source**\n has dimensions.\n\n The elements of the resulting array correspond to the extent of\n **source** along the respective dimensions.\n\n If **source** is a scalar, the result is an empty array (a rank-one\n array of size zero).\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_shape\nimplicit none\ncharacter(len=*),parameter :: all='(*(g0,1x))'\ninteger, dimension(-1:1, -1:2) :: a\n print all, 'shape of array=',shape(a)\n print all, 'shape of constant=',shape(42)\n print all, 'size of shape of constant=',size(shape(42))\n print all, 'ubound of array=',ubound(a)\n print all, 'lbound of array=',lbound(a)\nend program demo_shape\n```\nResults:\n```text\n > shape of array= 3 4\n > shape of constant=\n > size of shape of constant= 0\n > ubound of array= 1 2\n > lbound of array= -1 -1\n```\n### **Standard**\n\nFortran 95 ; with KIND argument Fortran 2003\n\n### **See Also**\n\n#### Array inquiry:\n\n- [**size**(3)](#size) - Determine the size of an array\n- [**rank**(3)](#rank) - Rank of a data object\n- [**ubound**(3)](#ubound) - Upper dimension bounds of an array\n- [**lbound**(3)](#lbound) - Lower dimension bounds of an array\n\n#### State Inquiry:\n\n- [**allocated**(3)](#allocated) - Status of an allocatable entity\n- [**is_contiguous**(3)](#is_contiguous) - Test if object is contiguous\n\n#### Kind Inquiry:\n\n- [**kind**(3)](#kind) - Kind of an entity\n\n#### Bit Inquiry:\n\n- [**storage_size**(3)](#storage_size) - Storage size in bits\n- [**bit_size**(3)](#bit_size) - Bit size inquiry function\n- [**btest**(3)](#btest) - Tests a bit of an _integer_ value.\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SHIFTA": "## shifta\n\n### **Name**\n\n**shifta** - \\[BIT:SHIFT\\] Right shift with fill\n\n### **Synopsis**\n```fortran\n result = shifta(i, shift )\n```\n```fortran\n elemental integer(kind=KIND) function shifta(i, shift)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **i** is an _integer_ of any kind\n - **shift** is an _integer_ of any kind\n - the result will automatically be of the same type, kind and rank as **i**.\n\n### **Description**\n\n **shifta** returns a value corresponding to **i** with all of the\n bits shifted right by **shift** places and the vacated bits on the\n left filled with the value of the original left-most bit.\n\n### **Options**\n\n- **i**\n : The initial value to shift and fill\n\n- **shift**\n : how many bits to shift right.\n It shall be nonnegative and less than or equal to **bit_size(i)**.\n or the value is undefined. If **shift** is zero the result is **i**.\n\n### **Result**\n\n The result has the value obtained by shifting the bits of **i** to\n the right **shift** bits and replicating the leftmost bit of **i**\n in the left **shift** bits (Note the leftmost bit in \"two's complement\"\n representation is the sign bit).\n\n Bits shifted out from the right end are lost.\n\n If **shift** is zero the result is **i**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_shifta\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger(kind=int32) :: ival\ninteger :: shift\ninteger(kind=int32) :: oval\ninteger(kind=int32),allocatable :: ivals(:)\ninteger :: i\ninteger(kind=int8) :: arr(2,2)=reshape([2,4,8,16],[2,2])\n\n ! basic usage\n write(*,*)shifta(100,3)\n\n ! loop through some interesting values\n shift=5\n\n ivals=[ -1, -0, +0, +1, &\n & int(b\"01010101010101010101010101010101\"), &\n & int(b\"10101010101010101010101010101010\"), &\n & int(b\"00000000000000000000000000011111\") ]\n\n ! does your platform distinguish between +0 and -0?\n ! note the original leftmost bit is used to fill in the vacated bits\n\n write(*,'(/,\"SHIFT = \",i0)') shift\n do i=1,size(ivals)\n ival=ivals(i)\n write(*,'( \"I = \",b32.32,\" == \",i0)') ival,ival\n oval=shifta(ival,shift)\n write(*,'( \"RESULT = \",b32.32,\" == \",i0)') oval,oval\n enddo\n ! elemental\n write(*,*)\"characteristics of the result are the same as input\"\n write(*,'(*(g0,1x))') &\n & \"kind=\",kind(shifta(arr,3)), \"shape=\",shape(shifta(arr,3)), &\n & \"size=\",size(shifta(arr,3)) !, \"rank=\",rank(shifta(arr,3))\n\nend program demo_shifta\n```\nResults:\n\n```text\n > 12\n >\n > SHIFT = 5\n > I = 11111111111111111111111111111111 == -1\n > RESULT = 11111111111111111111111111111111 == -1\n > I = 00000000000000000000000000000000 == 0\n > RESULT = 00000000000000000000000000000000 == 0\n > I = 00000000000000000000000000000000 == 0\n > RESULT = 00000000000000000000000000000000 == 0\n > I = 00000000000000000000000000000001 == 1\n > RESULT = 00000000000000000000000000000000 == 0\n > I = 01010101010101010101010101010101 == 1431655765\n > RESULT = 00000010101010101010101010101010 == 44739242\n > I = 10101010101010101010101010101010 == -1431655766\n > RESULT = 11111101010101010101010101010101 == -44739243\n > I = 00000000000000000000000000011111 == 31\n > RESULT = 00000000000000000000000000000000 == 0\n > characteristics of the result are the same as input\n > kind= 1 shape= 2 2 size= 4\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**shiftl**(3)](#shiftl),\n[**shiftr**(3)](#shiftr),\n[**ishft**(3)](#ishft),\n[**ishftc**(3)](#ishftc)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SHIFTL": "## shiftl\n\n### **Name**\n\n**shiftl** - \\[BIT:SHIFT\\] Shift bits left\n\n### **Synopsis**\n```fortran\n result = shiftl( i, shift )\n```\n```fortran\n elemental integer(kind=KIND) function shiftl(i, shift)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **i** is an _integer_ of any kind\n - **shift** is an _integer_ of any kind\n - the result will automatically be of the same type, kind and rank as **i**.\n\n### **Description**\n\n **shiftl** returns a value corresponding to **i** with all of the\n bits shifted left by **shift** places.\n\n Bits shifted out from the left end are lost, and bits shifted in from\n the right end are set to **0**.\n\n If the absolute value of **shift** is greater than **bit_size(i)**,\n the value is undefined.\n\n For example, for a 16-bit integer left-shifted five ...\n```text\n > |a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p| <- original 16-bit example\n > |f|g|h|i|j|k|l|m|n|o|p| <- left-shifted five\n > |f|g|h|i|j|k|l|m|n|o|p|0|0|0|0|0| <- right-padded with zeros\n```\nNote the value of the result is the same as **ishft (i, shift)**.\n\n### **Options**\n\n- **i**\n : The initial value to shift and fill in with zeros\n\n- **shift**\n : how many bits to shift left.\n It shall be nonnegative and less than or equal to **bit_size(i)**.\n\n### **Result**\n\nThe return value is of type _integer_ and of the same kind as **i**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_shiftl\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: shift\ninteger(kind=int32) :: oval\ninteger(kind=int32) :: ival\ninteger(kind=int32),allocatable :: ivals(:)\ninteger :: i\n\n print *, ' basic usage'\n ival=100\n write(*,*)ival, shiftl(ival,3)\n\n ! elemental (input values may be conformant arrays)\n print *, ' elemental'\n\n ! loop through some ivalues\n shift=9\n ivals=[ &\n & int(b\"01010101010101010101010101010101\"), &\n & int(b\"10101010101010101010101010101010\"), &\n & int(b\"11111111111111111111111111111111\") ]\n\n write(*,'(/,\"SHIFT = \",i0)') shift\n do i=1,size(ivals)\n ! print initial value as binary and decimal\n write(*,'( \"I = \",b32.32,\" == \",i0)') ivals(i),ivals(i)\n ! print shifted value as binary and decimal\n oval=shiftl(ivals(i),shift)\n write(*,'( \"RESULT = \",b32.32,\" == \",i0)') oval,oval\n enddo\n\n ! more about elemental\n ELEM : block\n integer(kind=int8) :: arr(2,2)=reshape([2,4,8,16],[2,2])\n write(*,*)\"characteristics of the result are the same as input\"\n write(*,'(*(g0,1x))') &\n & \"kind=\",kind(shiftl(arr,3)), \"shape=\",shape(shiftl(arr,3)), &\n & \"size=\",size(shiftl(arr,3)) !, \"rank=\",rank(shiftl(arr,3))\n endblock ELEM\n\nend program demo_shiftl\n```\nResults:\n```text\n > basic usage\n > 100 800\n > elemental\n >\n > SHIFT = 9\n > I = 01010101010101010101010101010101 == 1431655765\n > RESULT = 10101010101010101010101000000000 == -1431655936\n > I = 10101010101010101010101010101010 == -1431655766\n > RESULT = 01010101010101010101010000000000 == 1431655424\n > I = 11111111111111111111111111111111 == -1\n > RESULT = 11111111111111111111111000000000 == -512\n > characteristics of the result are the same as input\n > kind= 1 shape= 2 2 size= 4\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**shifta**(3)](#shifta),\n[**shiftr**(3)](#shiftr),\n[**ishft**(3)](#ishft),\n[**ishftc**(3)](#ishftc)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SHIFTR": "## shiftr\n\n### **Name**\n\n**shiftr** - \\[BIT:SHIFT\\] Shift bits right\n\n### **Synopsis**\n```fortran\n result = shiftr( i, shift )\n```\n```fortran\n elemental integer(kind=KIND) function shiftr(i, shift)\n\n integer(kind=KIND),intent(in) :: i\n integer(kind=**),intent(in) :: shift\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **i** is an _integer_ of any kind\n - **shift** is an _integer_ of any kind\n - the result will automatically be of the same type, kind and rank as **i**.\n\n### **Description**\n\n **shiftr** returns a value corresponding to **i** with all of the\n bits shifted right by **shift** places.\n\n If the absolute value of **shift** is greater than **bit_size(i)**,\n the value is undefined.\n\n Bits shifted out from the right end are lost, and bits shifted in from\n the left end are set to 0.\n\n For example, for a 16-bit integer right-shifted five ...\n```text\n > |a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p| <- original 16-bit example\n > |a|b|c|d|e|f|g|h|i|j|k| <- right-shifted five\n > |0|0|0|0|0|f|g|h|i|j|k|l|m|n|o|p| <- left-padded with zeros\n```\n Note the value of the result is the same as **ishft (i, -shift)**.\n\n### **Options**\n\n- **i**\n : The value to shift\n\n- **shift**\n : How many bits to shift right.\n It shall be nonnegative and less than or equal to **bit_size(i)**.\n\n### **Result**\n\n The remaining bits shifted right **shift** positions.\n Vacated positions on the left are filled with zeros.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_shiftr\nuse,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64\nimplicit none\ninteger :: shift\ninteger(kind=int32) :: oval\ninteger(kind=int32) :: ival\ninteger(kind=int32),allocatable :: ivals(:)\ninteger :: i\n\n print *,' basic usage'\n ival=100\n write(*,*)ival, shiftr(100,3)\n\n ! elemental (input values may be conformant arrays)\n print *,' elemental'\n shift=9\n ivals=[ &\n & int(b\"01010101010101010101010101010101\"), &\n & int(b\"10101010101010101010101010101010\"), &\n & int(b\"11111111111111111111111111111111\") ]\n\n write(*,'(/,\"SHIFT = \",i0)') shift\n do i=1,size(ivals)\n ! print initial value as binary and decimal\n write(*,'( \"I = \",b32.32,\" == \",i0)') ivals(i),ivals(i)\n ! print shifted value as binary and decimal\n oval=shiftr(ivals(i),shift)\n write(*,'( \"RESULT = \",b32.32,\" == \",i0,/)') oval,oval\n enddo\n\n ! more on elemental\n ELEM : block\n integer(kind=int8) :: arr(2,2)=reshape([2,4,8,16],[2,2])\n write(*,*)\"characteristics of the result are the same as input\"\n write(*,'(*(g0,1x))') &\n & \"kind=\",kind(shiftr(arr,3)), \"shape=\",shape(shiftr(arr,3)), &\n & \"size=\",size(shiftr(arr,3)) !, \"rank=\",rank(shiftr(arr,3))\n endblock ELEM\n\nend program demo_shiftr\n```\nResults:\n```text\n > basic usage\n > 100 12\n > elemental\n >\n > SHIFT = 9\n > I = 01010101010101010101010101010101 == 1431655765\n > RESULT = 00000000001010101010101010101010 == 2796202\n >\n > I = 10101010101010101010101010101010 == -1431655766\n > RESULT = 00000000010101010101010101010101 == 5592405\n >\n > I = 11111111111111111111111111111111 == -1\n > RESULT = 00000000011111111111111111111111 == 8388607\n >\n > characteristics of the result are the same as input\n > kind= 1 shape= 2 2 size= 4\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**shifta**(3)](#shifta),\n[**shiftl**(3)](#shiftl),\n[**ishft**(3)](#ishft),\n[**ishftc**(3)](#ishftc)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SIGN": "## sign\n\n### **Name**\n\n**sign** - \\[NUMERIC\\] Sign copying function\n\n### **Synopsis**\n```fortran\n result = sign(a, b)\n```\n```fortran\n elemental type(TYPE(kind=KIND))function sign(a, b)\n\n type(TYPE(kind=KIND)),intent(in) :: a, b\n```\n### **Characteristics**\n\n - **a** shall be of type integer or real.\n - **b** shall be of the same type as **a**.\n - the characteristics of the result are the same as **a**.\n\n### **Description**\n\n **sign** returns a value with the magnitude of _a_ but with the\n sign of _b_.\n\n For processors that distinguish between positive and negative zeros\n _sign()_ may be used to distinguish between _real_ values 0.0 and\n -0.0. SIGN (1.0, -0.0) will return -1.0 when a negative zero is\n distinguishable.\n\n### **Options**\n\n - **a**\n : The value whose magnitude will be returned.\n\n - **b**\n : The value whose sign will be returned.\n\n### **Result**\n\n a value with the magnitude of **a** with the sign of **b**. That is,\n\n - If _b \\>= 0_ then the result is _abs(a)_\n - else if _b < 0_ it is -_abs(a)_.\n - if _b_ is _real_ and the processor distinguishes between _-0.0_\n and _0.0_ then the\n result is _-abs(a)_\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_sign\nimplicit none\n ! basics\n print *, sign( -12, 1 )\n print *, sign( -12, 0 )\n print *, sign( -12, -1 )\n print *, sign( 12, 1 )\n print *, sign( 12, 0 )\n print *, sign( 12, -1 )\n\n if(sign(1.0,-0.0)== -1.0)then\n print *, 'this processor distinguishes +0 from -0'\n else\n print *, 'this processor does not distinguish +0 from -0'\n endif\n\n print *, 'elemental', sign( -12.0, [1.0, 0.0, -1.0] )\n\nend program demo_sign\n```\nResults:\n```text\n > 12\n > 12\n > -12\n > 12\n > 12\n > -12\n > this processor does not distinguish +0 from -0\n > elemental 12.00000 12.00000 -12.00000\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See also**\n\n[**abs**(3)](#abs)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SIN": "## sin\n\n### **Name**\n\n**sin** - \\[MATHEMATICS:TRIGONOMETRIC\\] Sine function\n\n### **Synopsis**\n```fortran\n result = sin(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function sin(x)\n\n TYPE(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_ or _complex_ type\n - **KIND** may be any kind supported by the associated type of **x**.\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n **sin** computes the sine of an angle given the size of the angle\n in radians.\n\n The sine of an angle in a right-angled triangle is the ratio of the\n length of the side opposite the given angle divided by the length of\n the hypotenuse.\n\n### **Options**\n\n- **x**\n : The angle in radians to compute the sine of.\n\n### **Result**\n\n The return value contains the processor-dependent approximation of\n the sine of **x**\n\n If X is of type _real_, it is regarded as a value in radians.\n\n If X is of type _complex_, its real part is regarded as a value\n in radians.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram sample_sin\nimplicit none\nreal :: x = 0.0\n x = sin(x)\n write(*,*)'X=',x\nend program sample_sin\n```\nResults:\n```text\n > X= 0.0000000E+00\n```\n### Extended Example\n\n#### Haversine Formula\n\n From the article on \"Haversine formula\" in Wikipedia:\n```text\n The haversine formula is an equation important in navigation,\n giving great-circle distances between two points on a sphere from\n their longitudes and latitudes.\n```\n So to show the great-circle distance between the Nashville International\n Airport (BNA) in TN, USA, and the Los Angeles International Airport\n (LAX) in CA, USA you would start with their latitude and longitude,\n commonly given as\n```text\n BNA: N 36 degrees 7.2', W 86 degrees 40.2'\n LAX: N 33 degrees 56.4', W 118 degrees 24.0'\n```\n which converted to floating-point values in degrees is:\n\n - BNA\n latitude=36.12, longitude=-86.67\n\n - LAX\n latitude=33.94, longitude=-118.40\n\n And then use the haversine formula to roughly calculate the distance\n along the surface of the Earth between the locations:\n\nSample program:\n```fortran\nprogram demo_sin\nimplicit none\nreal :: d\n d = haversine(36.12,-86.67, 33.94,-118.40) ! BNA to LAX\n print '(*(A,1x,F9.4,1x))','distance:',d,'km, or',d*0.62137119,'miles'\ncontains\nfunction haversine(latA,lonA,latB,lonB) result (dist)\n!\n! calculate great circle distance in kilometers\n! given latitude and longitude in degrees\n!\nreal,intent(in) :: latA,lonA,latB,lonB\nreal :: a,c,dist,delta_lat,delta_lon,lat1,lat2\nreal,parameter :: radius = 6371 ! mean earth radius in kilometers,\n! recommended by the International Union of Geodesy and Geophysics\n\n! generate constant pi/180\nreal, parameter :: deg_to_rad = atan(1.0)/45.0\n delta_lat = deg_to_rad*(latB-latA)\n delta_lon = deg_to_rad*(lonB-lonA)\n lat1 = deg_to_rad*(latA)\n lat2 = deg_to_rad*(latB)\n a = (sin(delta_lat/2))**2 + &\n & cos(lat1)*cos(lat2)*(sin(delta_lon/2))**2\n c = 2*asin(sqrt(a))\n dist = radius*c\nend function haversine\nend program demo_sin\n```\nResults:\n```text\n > distance: 2886.4446 km, or 1793.5536 miles\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See Also**\n\n[**asin**(3)](#asin),\n[**cos**(3)](#cos),\n[**tan**(3)](#tan),\n[**acosh**(3)](#acosh),\n[**acos**(3)](#acos),\n[**asinh**(3)](#asinh),\n[**atan2**(3)](#atan2),\n[**atanh**(3)](#atanh),\n[**acosh**(3)](#acosh),\n[**asinh**(3)](#asinh),\n[**atanh**(3)](#atanh)\n\n### **Resources**\n\n- [Wikipedia:sine and cosine](https://en.wikipedia.org/wiki/Sine_and_cosine)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SIND": "## sind\n\n### **Name**\n\n**sind** - \\[MATHEMATICS:TRIGONOMETRIC\\] Degree sine function\n\n### **Synopsis**\n```fortran\n result = sind(x)\n```\n```fortran\n elemental real(kind=KIND) function sind(x)\n\n real(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_ type\n - **KIND** may be any kind supported by the associated real type of **x**.\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n **sind** computes the sine of an angle given the size of the angle\n in degrees.\n\n The sine of an angle in a right-angled triangle is the ratio of the\n length of the side opposite the given angle divided by the length of\n the hypotenuse.\n\n### **Options**\n\n- **x**\n : The angle in degrees to compute the sine of.\n\n### **Result**\n\n The return value contains the processor-dependent approximation of\n the sine of **x**, which is regarded as a value in degrees.\n\n\n### **Examples**\n\nsind(180.0) has the value 0.0 (approximately).\n\nSample program:\n\n```fortran\nprogram sample_sind\nimplicit none\n write(*,*)'sind(0.0)=',sind(0.0)\n write(*,*)'sind(45.0)=',sind(45.0)\n write(*,*)'sind(90.0)=',sind(90.0)\n write(*,*)'sind(180.0)=',sind(180.0)\n write(*,*)'sind(270.0)=',sind(270.0)\n write(*,*)'sind(720.0)=',sind(720.0)\n write(*,*)'sind(-720.0d0)=',sind(-720.0d0)\nend program sample_sind\n```\n### Extended Example\n\n#### Haversine Formula\n\n From the article on \"Haversine formula\" in Wikipedia:\n```text\n The haversine formula is an equation important in navigation,\n giving great-circle distances between two points on a sphere from\n their longitudes and latitudes.\n```\n So to show the great-circle distance between the Nashville International\n Airport (BNA) in TN, USA, and the Los Angeles International Airport\n (LAX) in CA, USA you would start with their latitude and longitude,\n commonly given as\n```text\n BNA: N 36 degrees 7.2', W 86 degrees 40.2'\n LAX: N 33 degrees 56.4', W 118 degrees 24.0'\n```\n which converted to floating-point values in degrees is:\n\n - BNA\n latitude=36.12, longitude=-86.67\n\n - LAX\n latitude=33.94, longitude=-118.40\n\n And then use the haversine formula to roughly calculate the distance\n along the surface of the Earth between the locations:\n\nSample program:\n```fortran\nprogram demo_sin\nimplicit none\nreal :: d\n d = haversine(36.12,-86.67, 33.94,-118.40) ! BNA to LAX\n print '(A,F9.4,A)', 'distance: ',d,' km'\ncontains\nfunction haversine(latA,lonA,latB,lonB) result (dist)\n!\n! calculate great circle distance in kilometers\n! given latitude and longitude in degrees\n!\nreal,intent(in) :: latA,lonA,latB,lonB\nreal :: a,c,dist,delta_lat,delta_lon,lat1,lat2\nreal,parameter :: radius = 6371 ! mean earth radius in kilometers,\n! recommended by the International Union of Geodesy and Geophysics\n\n delta_lat = latB-latA\n delta_lon = lonB-lonA\n lat1 = latA\n lat2 = latB\n a = (sind(delta_lat/2))**2 + &\n & cosd(lat1)*cosd(lat2)*(sind(delta_lon/2))**2\n c = 2*asin(sqrt(a))\n dist = radius*c\nend function haversine\nend program demo_sin\n```\nResults:\n```text\n > distance: 2886.4446 km\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n[**asin**(3)](#asin),\n[**cos**(3)](#cos),\n[**tan**(3)](#tan),\n[**acosh**(3)](#acosh),\n[**acos**(3)](#acos),\n[**asinh**(3)](#asinh),\n[**atan2**(3)](#atan2),\n[**atanh**(3)](#atanh),\n[**acosh**(3)](#acosh),\n[**asinh**(3)](#asinh),\n[**atanh**(3)](#atanh)\n\n### **Resources**\n\n- [Wikipedia:sine and cosine](https://en.wikipedia.org/wiki/Sine_and_cosine)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "SINH": "## sinh\n\n### **Name**\n\n**sinh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Hyperbolic sine function\n\n### **Synopsis**\n```fortran\n result = sinh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function sinh(x)\n\n TYPE(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_\n - **KIND** may be any kind supported by the associated type.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n **sinh** computes the hyperbolic sine of **x**.\n\n The hyperbolic sine of x is defined mathematically as:\n```fortran\n sinh(x) = (exp(x) - exp(-x)) / 2.0\n```\n\n### **Options**\n\n- **x**\n : The value to calculate the hyperbolic sine of\n\n### **Result**\n\n The result has a value equal to a processor-dependent approximation\n to sinh(X). If X is of type complex its imaginary part is regarded\n as a value in radians.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_sinh\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = - 1.0_real64\nreal(kind=real64) :: nan, inf\ncharacter(len=20) :: line\n\n ! basics\n print *, sinh(x)\n print *, (exp(x)-exp(-x))/2.0\n\n ! sinh(3) is elemental and can handle an array\n print *, sinh([x,2.0*x,x/3.0])\n\n ! a NaN input returns NaN\n line='NAN'\n read(line,*) nan\n print *, sinh(nan)\n\n ! a Inf input returns Inf\n line='Infinity'\n read(line,*) inf\n print *, sinh(inf)\n\n ! an overflow returns Inf\n x=huge(0.0d0)\n print *, sinh(x)\n\nend program demo_sinh\n```\nResults:\n```text\n > -1.1752011936438014\n > -1.1752011936438014\n > -1.1752011936438014 -3.6268604078470190 -0.33954055725615012\n > NaN\n > Infinity\n > Infinity\n```\n### **Standard**\n\nFortran 95 , for a complex argument Fortran 2008\n\n### **See Also**\n\n[**asinh**(3)](#asinh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SINPI": "## sinpi\n\n### **Name**\n\n**sinpi** - \\[MATHEMATICS:TRIGONOMETRIC\\] Circular sine function\n\n### **Synopsis**\n```fortran\n result = sinpi(x)\n```\n```fortran\n elemental real(kind=KIND) function sinpi(x)\n\n real(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_\n - **KIND** may be any kind supported by the associated real type of **x**.\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n **sinpi** computes the circular sine of an angle given the size of the angle\n in half-revolutions.\n\n **sinpi(X)** is approximately equal to **sin(x\\*PI)**.\n\n The sine of an angle in a right-angled triangle is the ratio of the\n length of the side opposite the given angle divided by the length of\n the hypotenuse.\n\n### **Options**\n\n- **x**\n : The angle in half-revolutions to compute the sine of.\n\n### **Result**\n\n The return value contains the processor-dependent approximation of\n the sine of **x**.\n\n### **Examples**\n\nExample. **sinpi(1.0)** has the value 0.0 (approximately).\n\nSample program:\n\n```fortran\nprogram demo_sinpi\nimplicit none\nreal :: x\ninteger :: i\nreal,parameter :: PI=acos(-1.0)\n do i=0,8\n x=i*0.25\n write(*,*)'x=',x,' sinpi(x)=',sinpi(x)\n enddo\nend program demo_sinpi\n```\nResults:\n```text\n > x= 0.00000000 sinpi(x)= 0.00000000\n > x= 0.250000000 sinpi(x)= 0.707106769\n > x= 0.500000000 sinpi(x)= 1.00000000\n > x= 0.750000000 sinpi(x)= 0.707106769\n > x= 1.00000000 sinpi(x)= -8.74227766E-08\n > x= 1.25000000 sinpi(x)= -0.707106888\n > x= 1.50000000 sinpi(x)= -1.00000000\n > x= 1.75000000 sinpi(x)= -0.707106531\n > x= 2.00000000 sinpi(x)= 1.74845553E-07\n```\n### **Standard**\n\nfortran 2023\n\n### **See Also**\n\n - [**acos**(3)](#acos), [**acosd**(3)](#acosd), [**acospi**(3)](#acospi),\n - [**asin**(3)](#asin), [**asind**(3)](#asind),\n - [**atan2**(3)](#atan2), [**atan2d**(3)](#atan2d), [**atan2pi**(3)](#atan2pi),\n - [**cos**(3)](#cos), [**cosd**(3)](#cosd), [**cospi**(3)](#cospi),\n - [**tan**(3)](#tan), [**tand**(3)](#tand), [**tanpi**(3)](#tanpi),\n - [**acosh**(3)](#acosh),\n - [**acosh**(3)](#acosh),\n - [**asinh**(3)](#asinh),\n - [**asinh**(3)](#asinh),\n - [**atanh**(3)](#atanh)\n - [**atanh**(3)](#atanh),\n\n### **Resources**\n\n- [Wikipedia:sine and cosine](https://en.wikipedia.org/wiki/Sine_and_cosine)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SIZE": "## size\n\n### **Name**\n\n**size** - \\[ARRAY:INQUIRY\\] Determine the size of an array or extent of one dimension\n\n### **Synopsis**\n```fortran\n result = size(array [,dim] [,kind])\n```\n```fortran\n integer(kind=KIND) function size(array,dim,kind)\n\n type(TYPE(kind=KIND)),intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n integer(kind=**),intent(in),optional :: KIND\n```\n### **Characteristics**\n\n- **array** is an assumed-rank array or array of any type and associated\n kind.\n\n If **array** is a pointer it must be associated and allocatable arrays\n must be allocated.\n- **dim** is an integer scalar\n- **kind** is a scalar integer constant expression.\n- the result is an integer scalar of kind **KIND**. If **KIND** is absent\n a _integer_ of default kind is returned.\n- a kind designated as ** may be any supported kind for the type\n\n\n### **Description**\n\n **size(3)** returns the total number of elements in an array, or\n if **dim** is specified returns the number of elements along that\n dimension.\n\n **size** determines the extent of **array** along a specified\n dimension **dim**, or the total number of elements in **array** if\n **dim** is absent.\n\n### **Options**\n\n- **array**\n : the array to measure the number of elements of.\n If **array** is an assumed-size array, **dim** shall be present with a value less\n than the rank of **array**.\n\n- **dim**\n : a value shall be\n in the range from 1 to n, where n equals the rank of **array**.\n\n If not present the total number of elements of the entire array\n are returned.\n\n- **kind**\n : An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n If absent the kind type parameter of the returned value is that of\n default integer type.\n\n The **kind** must allow for the magnitude returned by **size** or\n results are undefined.\n\n If **kind** is absent, the return value is of default _integer_ kind.\n\n### **Result**\n\n If **dim** is not present **array** is assumed-rank, the result has a\n value equal to **PRODUCT(SHAPE(ARRAY,KIND))**. Otherwise, the result\n has a value equal to the total number of elements of **array**.\n\n If **dim** is present the number of elements along that dimension\n are returned, except that if ARRAY is assumed-rank and associated\n with an assumed-size array and DIM is present with a value equal to\n the rank of **array**, the value is -1.\n\n NOTE1\n\n If **array** is assumed-rank and has rank zero, **dim** cannot be\n present since it cannot satisfy the requirement\n\n 1 <= DIM <= 0.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_size\nimplicit none\ninteger :: arr(0:2,-5:5)\n write(*,*)'SIZE of simple two-dimensional array'\n write(*,*)'SIZE(arr) :total count of elements:',size(arr)\n write(*,*)'SIZE(arr,DIM=1) :number of rows :',size(arr,dim=1)\n write(*,*)'SIZE(arr,DIM=2) :number of columns :',size(arr,dim=2)\n\n ! pass the same array to a procedure that passes the value two\n ! different ways\n call interfaced(arr,arr)\ncontains\n\nsubroutine interfaced(arr1,arr2)\n! notice the difference in the array specification\n! for arr1 and arr2.\ninteger,intent(in) :: arr1(:,:)\ninteger,intent(in) :: arr2(2,*)\n !\n write(*,*)'interfaced assumed-shape array'\n write(*,*)'SIZE(arr1) :',size(arr1)\n write(*,*)'SIZE(arr1,DIM=1) :',size(arr1,dim=1)\n write(*,*)'SIZE(arr1,DIM=2) :',size(arr1,dim=2)\n\n! write(*,*)'SIZE(arr2) :',size(arr2)\n write(*,*)'SIZE(arr2,DIM=1) :',size(arr2,dim=1)\n!\n! CANNOT DETERMINE SIZE OF ASSUMED SIZE ARRAY LAST DIMENSION\n! write(*,*)'SIZE(arr2,DIM=2) :',size(arr2,dim=2)\n\nend subroutine interfaced\n\nend program demo_size\n```\nResults:\n```text\n > SIZE of simple two-dimensional array\n > SIZE(arr) :total count of elements: 33\n > SIZE(arr,DIM=1) :number of rows : 3\n > SIZE(arr,DIM=2) :number of columns : 11\n > interfaced assumed-shape array\n > SIZE(arr1) : 33\n > SIZE(arr1,DIM=1) : 3\n > SIZE(arr1,DIM=2) : 11\n > SIZE(arr2,DIM=1) : 2\n```\n### **Standard**\n\nFortran 95 , with **kind** argument - Fortran 2003\n\n### **See Also**\n\n#### Array inquiry:\n\n- [**size**](#size) - Determine the size of an array\n- [**rank**(3)](#rank) - Rank of a data object\n- [**shape**(3)](#shape) - Determine the shape of an array\n- [**ubound**(3)](#ubound) - Upper dimension bounds of an array\n- [**lbound**(3)](#lbound) - Lower dimension bounds of an array\n\n#### State Inquiry:\n\n- [**allocated**(3)](#allocated) - Status of an allocatable entity\n- [**is_contiguous**(3)](#is_contiguous) - Test if object is contiguous\n\n#### Kind Inquiry:\n\n- [**kind**(3)](#kind) - Kind of an entity\n\n#### Bit Inquiry:\n\n- [**storage_size**(3)](#storage_size) - Storage size in bits\n- [**bit_size**(3)](#bit_size) - Bit size inquiry function\n- [**btest**(3)](#btest) - Tests a bit of an _integer_ value.\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SPACING": "## spacing\n\n### **Name**\n\n**spacing** - \\[MODEL_COMPONENTS\\] Smallest distance between two numbers of a given type\n\n### **Synopsis**\n```fortran\n result = spacing(x)\n```\n```fortran\n elemental real(kind=KIND) function spacing(x)\n\n real(kind=KIND), intent(in) :: x\n```\n### **Characteristics**\n\n - **x** is type real of any valid kind\n - The result is of the same type as the input argument **x**.\n\n### **Description**\n\n **spacing** determines the distance between the argument **x**\n and the nearest adjacent number of the same type.\n\n### **Options**\n\n- **x**\n : Shall be of type _real_.\n\n### **Result**\n\n If **x** does not have the value zero and is not an IEEE infinity or\n NaN, the result has the value nearest to **x** for values of the same\n type and kind assuming the value is representable.\n\n Otherwise, the value is the same as **tiny(x)**.\n + zero produces **tiny(x)**\n + IEEE Infinity produces an IEEE Nan\n + if an IEEE NaN, that NaN is returned\n\n If there are two extended model values equally near to **x**, the\n value of greater absolute value is taken.\n\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_spacing\nimplicit none\ninteger, parameter :: sgl = selected_real_kind(p=6, r=37)\ninteger, parameter :: dbl = selected_real_kind(p=13, r=200)\n\n write(*,*) spacing(1.0_sgl)\n write(*,*) nearest(1.0_sgl,+1.0),nearest(1.0_sgl,+1.0)-1.0\n\n write(*,*) spacing(1.0_dbl)\nend program demo_spacing\n```\nResults:\n\nTypical values ...\n\n```text\n > 1.1920929E-07\n > 1.000000 1.1920929E-07\n > 0.9999999 -5.9604645E-08\n > 2.220446049250313E-016\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**tiny**(3)](#tiny)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SPLIT": "## split\n\n### **Name**\n\n**split** - \\[CHARACTER:SPLIT] Parse a string into tokens, one at a time.\n\n### **Synopsis**\n```fortran\n call split (string, set, pos [, back])\n\n character(kind=KIND),intent(in) :: string\n character(len=*,kind=KIND),intent(in) :: set\n integer,intent(inout) :: pos\n logical,intent(in),optional :: back\n```\n### **Characteristics**\n- **string** is a scalar character variable\n- **set** is a scalar character variable of the same kind as **string**.\n\n### **Description**\n\n Find the extent of consecutive tokens in a string. Given a string and\n a position to start looking for a token return the position of the\n end of the token. A set of separator characters may be specified as\n well as the direction of parsing.\n\n Typically consecutive calls are used to parse a string into a set of\n tokens by stepping through the start and end positions of each token.\n\n### **Options**\n\n - **string**\n : The string to search for tokens in.\n\n - **set**\n : Each character in **set** is a token delimiter. A sequence of zero or\n more characters in **string** delimited by any token delimiter,\n or the beginning or end of **string**, comprise a token. Thus, two\n consecutive token delimiters in **string**, or a token delimiter\n in the first or last character of **string**, indicate a token with\n zero length.\n\n - **pos**\n : On input, the position from which to start looking for the next\n separator from. This is typically the first character or the\n last returned value of **pos** if searching from left to right (ie.\n **back** is absent or _.true._) or the last character or the last\n returned value of **pos** when searching from right to left (ie.\n when **back** is _.false._).\n\n If **back** is present with the value _.true._, the value of **pos**\n shall be in the range 0 < POS <= LEN(STRING)+1; otherwise it shall\n be in the range 0 <= POS <= LEN(STRING).\n\n So **pos** on input is typically an end of the string or the\n position of a separator, probably from a previous call to **split**\n but **pos** on input can be any position in the range 1 <= POS <=\n LEN(STRING). If **pos** points to a non-separator character in the\n string the call is still valid but it will start searching from\n the specified position and that will result (somewhat obviously)\n in the string from **pos** on input to the returned **pos** being\n a partial token.\n\n - **back**\n : If **back** is absent or is present with the value _.false._,\n **pos** is assigned the position of the leftmost token delimiter in\n **string** whose position is greater than **pos**, or if there is no\n such character, it is assigned a value one greater than the length\n of **string**. This identifies a token with starting position one\n greater than the value of **pos** on invocation, and ending position\n one less than the value of **pos** on return.\n\n If **back** is present with the value _.true._, **pos** is assigned\n the position of the rightmost token delimiter in **string** whose\n position is less than **pos**, or if there is no such character,\n it is assigned the value zero. This identifies a token with ending\n position one less than the value of **pos** on invocation, and\n starting position one greater than the value of **pos** on return.\n\n### **Example**\nSample program:\n```fortran\nprogram demo_split\n !use m_strings, only: split=>split2020\n implicit none\n character (len=:), allocatable :: input\n integer :: position, istart, iend\n input = \"one,last example,,x,, ,,\"\n position = 0\n ! write a number line\n write(*,'(t3,a)') repeat('1234567890',6)\n ! display the input line\n write(*,'(t3,a)') input\n ! step through the input string locating the bounds of the\n ! next token and printing it\n do while (position < len(input))\n istart = position + 1\n call split (input, set=', ', pos=position)\n iend = position - 1\n if(iend >= istart)then\n print '(t3,a,1x,i0,1x,i0)', input (istart:iend),istart,iend\n else\n ! maybe ignore null fields, maybe not ...\n write(*,'(t3,*(g0))')'null between ',iend,' and ',istart\n endif\n end do\nend program demo_split\n```\nResults:\n```text\n > 123456789012345678901234567890123456789012345678901234567890\n > one,last example,,x,, ,,\n > one 1 3\n > last 5 8\n > example 10 16\n > null between 17 and 18\n > x 19 19\n > null between 20 and 21\n > null between 21 and 22\n > null between 22 and 23\n > null between 23 and 24\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n - [**tokenize**(3)](#tokenize) - Parse a string into tokens\n - [**index**(3)](#index) - Position of a substring within a string\n - [**scan**(3)](#scan) - Scan a string for the presence of a set\n of characters\n - [**verify**(3)](#verify) - Position of a character in a string of\n characters that does not appear in a given set of characters.\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SPREAD": "## spread\n\n### **Name**\n\n**spread** - \\[ARRAY:CONSTRUCTION\\] Add a dimension and replicate data\n\n### **Synopsis**\n```fortran\n result = spread(source, dim, ncopies)\n```\n```fortran\n TYPE(kind=KIND) function spread(source, dim, ncopies)\n\n TYPE(kind=KIND) :: source(..)\n integer(kind=**),intent(in) :: dim\n integer(kind=**),intent(in) :: ncopies\n```\n### **Characteristics**\n\n- **source** is a scalar or array of any type and a rank less than fifteen.\n- **dim** is an _integer_ scalar\n- **ncopies** is an integer scalar\n\n### **Description**\n\n**spread** replicates a **source** array along a specified dimension\n**dim**. The copy is repeated **ncopies** times.\n\nSo to add additional rows to a matrix **dim=1** would be used, but to\nadd additional rows **dim=2** would be used, for example.\n\nIf **source** is scalar, the size of the resulting vector is **ncopies**\nand each element of the result has a value equal to **source**.\n\n### **Options**\n\n- **source**\n : the input data to duplicate\n\n- **dim**\n : The additional dimension value in the range from\n **1** to **n+1**, where **n** equals the rank of **source**.\n\n- **ncopies**\n : the number of copies of the original data to generate\n\n### **Result**\n\nThe result is an array of the same type as **source** and has rank **n+1**\nwhere **n** equals the rank of **source**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_spread\nimplicit none\n\ninteger a1(4,3), a2(3,4), v(4), s\n\n write(*,'(a)' ) &\n 'TEST SPREAD(3) ', &\n ' SPREAD(3) is a FORTRAN90 function which replicates', &\n ' an array by adding a dimension. ', &\n ' '\n\n s = 99\n call printi('suppose we have a scalar S',s)\n\n write(*,*) 'to add a new dimension (1) of extent 4 call'\n call printi('spread( s, dim=1, ncopies=4 )',spread ( s, 1, 4 ))\n\n v = [ 1, 2, 3, 4 ]\n call printi(' first we will set V to',v)\n\n write(*,'(a)')' and then do \"spread ( v, dim=2, ncopies=3 )\"'\n a1 = spread ( v, dim=2, ncopies=3 )\n call printi('uses v as a column and makes 3 columns',a1)\n\n a2 = spread ( v, 1, 3 )\n call printi(' spread(v,1,3) uses v as a row and makes 3 rows',a2)\n\ncontains\n! CONVENIENCE ROUTINE; NOT DIRECTLY CONNECTED TO SPREAD(3)\nsubroutine printi(title,a)\nuse, intrinsic :: iso_fortran_env, only : stderr=>ERROR_UNIT,&\n & stdin=>INPUT_UNIT, stdout=>OUTPUT_UNIT\nimplicit none\n\n!@(#) print small 2d integer scalar, vector, matrix in row-column format\n\ncharacter(len=*),parameter :: all='(\" \",*(g0,1x))'\ncharacter(len=*),intent(in) :: title\ncharacter(len=20) :: row\ninteger,intent(in) :: a(..)\ninteger :: i\n\n write(*,all,advance='no')trim(title)\n ! select rank of input\n select rank(a)\n rank (0); write(*,'(a)')' (a scalar)'\n write(*,'(\" > [ \",i0,\" ]\")')a\n rank (1); write(*,'(a)')' (a vector)'\n ! find how many characters to use for integers\n write(row,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(a))))))+2\n ! use this format to write a row\n row='(\" > [\",*(i'//trim(row)//':,\",\"))'\n do i=1,size(a)\n write(*,fmt=row,advance='no')a(i)\n write(*,'(\" ]\")')\n enddo\n rank (2); write(*,'(a)')' (a matrix) '\n ! find how many characters to use for integers\n write(row,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(a))))))+2\n ! use this format to write a row\n row='(\" > [\",*(i'//trim(row)//':,\",\"))'\n do i=1,size(a,dim=1)\n write(*,fmt=row,advance='no')a(i,:)\n write(*,'(\" ]\")')\n enddo\n rank default\n write(stderr,*)'*printi* did not expect rank=', rank(a), &\n & 'shape=', shape(a),'size=',size(a)\n stop '*printi* unexpected rank'\n end select\n write(*,all) '>shape=',shape(a),',rank=',rank(a),',size=',size(a)\n write(*,*)\n\nend subroutine printi\n\nend program demo_spread\n```\nResults:\n```text\n > TEST SPREAD(3)\n > SPREAD(3) is a FORTRAN90 function which replicates\n > an array by adding a dimension.\n >\n > suppose we have a scalar S (a scalar)\n > > [ 99 ]\n > >shape= ,rank= 0 ,size= 1\n >\n > to add a new dimension (1) of extent 4 call\n > spread( s, dim=1, ncopies=4 ) (a vector)\n > > [ 99 ]\n > > [ 99 ]\n > > [ 99 ]\n > > [ 0 ]\n > >shape= 4 ,rank= 1 ,size= 4\n >\n > first we will set V to (a vector)\n > > [ 1 ]\n > > [ 2 ]\n > > [ 3 ]\n > > [ 4 ]\n > >shape= 4 ,rank= 1 ,size= 4\n >\n > and then do \"spread ( v, dim=2, ncopies=3 )\"\n > uses v as a column and makes 3 columns (a matrix)\n > > [ 1, 1, 1 ]\n > > [ 2, 2, 2 ]\n > > [ 3, 3, 3 ]\n > > [ 4, 4, 4 ]\n > >shape= 4 3 ,rank= 2 ,size= 12\n >\n > spread(v,1,3) uses v as a row and makes 3 rows (a matrix)\n > > [ 1, 2, 3, 4 ]\n > > [ 1, 2, 3, 4 ]\n > > [ 1, 2, 3, 4 ]\n > >shape= 3 4 ,rank= 2 ,size= 12\n >\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**merge**(3)](#merge),\n[**pack**(3)](#pack),\n[**unpack**(3)](#unpack)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "SQRT": "## sqrt\n\n### **Name**\n\n**sqrt** - \\[MATHEMATICS\\] Square-root function\n\n### **Synopsis**\n```fortran\n result = sqrt(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function sqrt(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **TYPE** may be _real_ or _complex_.\n - **KIND** may be any kind valid for the declared type.\n - the result has the same characteristics as **x**.\n\n### **Description**\n\n **sqrt** computes the principal square root of **x**.\n\n The number whose square root is being considered is known as the\n _radicand_.\n\n In mathematics, a square root of a radicand **x** is a number **y**\n such that **y\\*y = x**.\n\n Every nonnegative radicand **x** has two square roots of the same unique\n magnitude, one positive and one negative. The nonnegative square root\n is called the principal square root.\n\n The principal square root of 9 is 3, for example, even though (-3)\\*(-3)\n is also 9.\n\n Square roots of negative numbers are a special case of complex numbers,\n where with **complex** input the components of the _radicand_ need\n not be positive in order to have a valid square root.\n\n### **Options**\n\n- **x**\n : The radicand to find the principal square root of.\n If **x** is _real_ its value must be greater than or equal to zero.\n\n### **Result**\n\n The principal square root of **x** is returned.\n\n For a _complex_ result the real part is greater than or equal to zero.\n\n When the real part of the result is zero, the imaginary part has the\n same sign as the imaginary part of **x**.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_sqrt\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x, x2\ncomplex :: z, z2\n\n ! basics\n x = 2.0_real64\n ! complex\n z = (1.0, 2.0)\n write(*,*)'input values ',x,z\n\n x2 = sqrt(x)\n z2 = sqrt(z)\n write(*,*)'output values ',x2,z2\n\n ! elemental\n write(*,*)'elemental',sqrt([64.0,121.0,30.0])\n\n ! alternatives\n x2 = x**0.5\n z2 = z**0.5\n write(*,*)'alternatively',x2,z2\n\nend program demo_sqrt\n```\nResults:\n```text\n > input values 2.00000000000000 (1.000000,2.000000)\n > output values 1.41421356237310 (1.272020,0.7861513)\n > elemental 8.000000 11.00000 5.477226\n > alternatively 1.41421356237310 (1.272020,0.7861513)\n```\n### **Standard**\n\nFORTRAN 77\n\n### **See also**\n\n[**exp**(3)](#exp),\n[**log**(3)](#log),\n[**log10**(3)](#log10)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "STORAGE_SIZE": "## storage_size\n\n### **Name**\n\n**storage_size** - \\[BIT:INQUIRY\\] Storage size in bits\n\n### **Synopsis**\n```fortran\n result = storage_size(a [,KIND] )\n```\n```fortran\n integer(kind=KIND) storage_size(a,KIND)\n\n type(TYPE(kind=**)) :: a\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n - a kind designated as ** may be any supported kind for the type\n\n - **a** may be of any type and kind. If it is polymorphic it shall not\n be an undefined pointer. If it is unlimited polymorphic or has any\n deferred type parameters, it shall not be an unallocated allocatable\n variable or a disassociated or undefined pointer.\n\n - The kind type parameter of the returned value is that specified by\n the value of **kind**; otherwise, the kind type parameter is that of\n default integer type.\n\n - The result is an _integer_ scalar of default kind unless **kind** is\n specified, in which case it has the kind specified by **kind**.\n\n### **Description**\n\n**storage_size** returns the storage size of argument **a** in bits.\n\n### **Options**\n\n- **a**\n : The entity to determine the storage size of\n\n- **kind**\n : a scalar integer constant expression that defines the kind of the\n output value.\n\n### **Result**\n\n The result value is the size expressed in bits for an element of an\n array that has the dynamic type and type parameters of **a**.\n\n If the type and type parameters are such that storage association\n applies, the result is consistent with the named constants\n defined in the intrinsic module ISO_FORTRAN_ENV.\n\n NOTE1\n\n An array element might take \"type\" more bits to store than an isolated\n scalar, since any hardware-imposed alignment requirements for array\n elements might not apply to a simple scalar variable.\n\n NOTE2\n\n This is intended to be the size in memory that an object takes when it\n is stored; this might differ from the size it takes during expression\n handling (which might be the native register size) or when stored in a\n file. If an object is never stored in memory but only in a register,\n this function nonetheless returns the size it would take if it were\n stored in memory.\n\n### **Examples**\n\nSample program\n```fortran\nprogram demo_storage_size\nimplicit none\n\n ! a default real, integer, and logical are the same storage size\n write(*,*)'size of integer ',storage_size(0)\n write(*,*)'size of real ',storage_size(0.0)\n write(*,*)'size of logical ',storage_size(.true.)\n write(*,*)'size of complex ',storage_size((0.0,0.0))\n\n ! note the size of an element of the array, not the storage size of\n ! the entire array is returned for array arguments\n write(*,*)'size of integer array ',storage_size([0,1,2,3,4,5,6,7,8,9])\n\nend program demo_storage_size\n```\nResults:\n```text\n > size of integer 32\n > size of real 32\n > size of logical 32\n > size of complex 64\n > size of integer array 32\n```\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**c_sizeof**(3)](#c_sizeof)\n\n _Fortran intrinsic descriptions_\n", "SUM": "## sum\n\n### **Name**\n\n**sum** - \\[ARRAY:REDUCTION\\] Sum the elements of an array\n\n### **Synopsis**\n```fortran\n result = sum(array [,dim[,mask]] | [mask] )\n```\n```fortran\n TYPE(kind=KIND) function sum(array, dim, mask)\n\n TYPE(kind=KIND),intent(in) :: array(..)\n integer(kind=**),intent(in),optional :: dim\n logical(kind=**),intent(in),optional :: mask(..)\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **array** may be of any numeric type - _integer_, _real_ or _complex_.\n - **dim** is an _integer_\n - **mask** is _logical_ and conformable with **array**.\n - The result is of the same type and kind as **array**. It is scalar\n if **dim** is not present or **array** is a vector, else it is an array.\n\n### **Description**\n\n **sum** adds the elements of **array**.\n\n When only **array** is specified all elements are summed, but groups\n of sums may be returned along the dimension specified by **dim**\n and/or elements to add may be selected by a logical mask.\n\n No method is designated for how the sum is conducted, so whether or not\n accumulated error is compensated for is processor-dependent.\n\n### **Options**\n\n- **array**\n : an array containing the elements to add\n\n- **dim**\n : a value in the range from 1 to n, where n equals the rank (the number\n of dimensions) of **array**. **dim** designates the dimension\n along which to create sums. When absent a scalar sum of the elements\n optionally selected by **mask** is returned.\n\n- **mask**\n : an array of the same shape as **array** that designates\n which elements to add. If absent all elements are used in the sum(s).\n\n### **Result**\n\n If **dim** is absent, a scalar with the sum of all selected elements\n in **array** is returned. Otherwise, an array of rank n-1, where n\n equals the rank of **array**, and a shape similar to that of **array**\n with dimension **dim** dropped is returned. Since a vector has a rank\n of one, the result is a scalar (if n==1, n-1 is zero; and a rank of\n zero means a scalar).\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_sum\nimplicit none\ninteger :: vector(5) , matrix(3,4), box(5,6,7)\n\n vector = [ 1, 2, -3, 4, 5 ]\n\n matrix(1,:)=[ -1, 2, -3, 4 ]\n matrix(2,:)=[ 10, -20, 30, -40 ]\n matrix(3,:)=[ 100, 200, -300, 400 ]\n\n box=11\n\n ! basics\n print *, 'sum all elements:',sum(vector)\n print *, 'real :',sum([11.0,-5.0,20.0])\n print *, 'complex :',sum([(1.1,-3.3),(4.0,5.0),(8.0,-6.0)])\n ! with MASK option\n print *, 'sum odd elements:',sum(vector, mask=mod(vector, 2)==1)\n print *, 'sum positive values:', sum(vector, mask=vector>0)\n\n call printi('the input array', matrix )\n call printi('sum of all elements in matrix', sum(matrix) )\n call printi('sum of positive elements', sum(matrix,matrix>=0) )\n ! along dimensions\n call printi('sum along rows', sum(matrix,dim=1) )\n call printi('sum along columns', sum(matrix,dim=2) )\n call printi('sum of a vector is always a scalar', sum(vector,dim=1) )\n call printi('sum of a volume by row', sum(box,dim=1) )\n call printi('sum of a volume by column', sum(box,dim=2) )\n call printi('sum of a volume by depth', sum(box,dim=3) )\n\ncontains\n! CONVENIENCE ROUTINE; NOT DIRECTLY CONNECTED TO SPREAD(3)\nsubroutine printi(title,a)\nuse, intrinsic :: iso_fortran_env, only : stderr=>ERROR_UNIT,&\n & stdin=>INPUT_UNIT, stdout=>OUTPUT_UNIT\nimplicit none\n\n!@(#) print small 2d integer scalar, vector, matrix in row-column format\n\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: a(..)\n\ncharacter(len=*),parameter :: all='(\" \",*(g0,1x))'\ncharacter(len=20) :: row\ninteger,allocatable :: b(:,:)\ninteger :: i\n write(*,all,advance='no')trim(title)\n ! copy everything to a matrix to keep code simple\n select rank(a)\n rank (0); write(*,'(a)')' (a scalar)'; b=reshape([a],[1,1])\n rank (1); write(*,'(a)')' (a vector)'; b=reshape(a,[size(a),1])\n rank (2); write(*,'(a)')' (a matrix)'; b=a\n rank default; stop '*printi* unexpected rank'\n end select\n ! find how many characters to use for integers\n write(row,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(b))))))+2\n ! use this format to write a row\n row='(\" > [\",*(i'//trim(row)//':,\",\"))'\n do i=1,size(b,dim=1)\n write(*,fmt=row,advance='no')b(i,:)\n write(*,'(\" ]\")')\n enddo\n write(*,all) '>shape=',shape(a),',rank=',rank(a),',size=',size(a)\n write(*,*)\nend subroutine printi\nend program demo_sum\n```\nResults:\n```text\n > sum all elements: 9\n > real : 26.0000000 \n > complex : (13.1000004,-4.30000019)\n > sum odd elements: 6\n > sum positive values: 12\n > the input array (a matrix)\n > > [ -1, 2, -3, 4 ]\n > > [ 10, -20, 30, -40 ]\n > > [ 100, 200, -300, 400 ]\n > >shape= 3 4 ,rank= 2 ,size= 12\n > \n > sum of all elements in matrix (a scalar)\n > > [ 382 ]\n > >shape= ,rank= 0 ,size= 1\n > \n > sum of positive elements (a scalar)\n > > [ 746 ]\n > >shape= ,rank= 0 ,size= 1\n > \n > sum along rows (a vector)\n > > [ 109 ]\n > > [ 182 ]\n > > [ -273 ]\n > > [ 364 ]\n > >shape= 4 ,rank= 1 ,size= 4\n > \n > sum along columns (a vector)\n > > [ 2 ]\n > > [ -20 ]\n > > [ 400 ]\n > >shape= 3 ,rank= 1 ,size= 3\n > \n > sum of a vector is always a scalar (a scalar)\n > > [ 9 ]\n > >shape= ,rank= 0 ,size= 1\n > \n > sum of a volume by row (a matrix)\n > > [ 55, 55, 55, 55, 55, 55, 55 ]\n > > [ 55, 55, 55, 55, 55, 55, 55 ]\n > > [ 55, 55, 55, 55, 55, 55, 55 ]\n > > [ 55, 55, 55, 55, 55, 55, 55 ]\n > > [ 55, 55, 55, 55, 55, 55, 55 ]\n > > [ 55, 55, 55, 55, 55, 55, 113 ]\n > >shape= 6 7 ,rank= 2 ,size= 42\n > \n > sum of a volume by column (a matrix)\n > > [ 66, 66, 66, 66, 66, 66, 66 ]\n > > [ 66, 66, 66, 66, 66, 66, 66 ]\n > > [ 66, 66, 66, 66, 66, 66, 66 ]\n > > [ 66, 66, 66, 66, 66, 66, 66 ]\n > > [ 66, 66, 66, 66, 66, 66,**** ]\n > >shape= 5 7 ,rank= 2 ,size= 35\n > \n > sum of a volume by depth (a matrix)\n > > [ 77, 77, 77, 77, 77, 77 ]\n > > [ 77, 77, 77, 77, 77, 77 ]\n > > [ 77, 77, 77, 77, 77, 77 ]\n > > [ 77, 77, 77, 77, 77, 77 ]\n > > [ 77, 77, 77, 77, 77,4193 ]\n > >shape= 5 6 ,rank= 2 ,size= 30\n > \n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n - [**all**(3)](#all) - Determines if all the values are true\n - [**any**(3)](#any) - Determines if any of the values in the logical array are true.\n - [**count**(3)](#count) - Count true values in an array\n - [**maxval**(3)](#maxval) - Determines the maximum value in an array\n - [**minval**(3)](#minval) - Minimum value of an array\n - [**product**(3)](#product) - Product of array elements\n - [**merge**(3)](#merge) - Merge variables\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "SYSTEM_CLOCK": "## system_clock\n\n### **Name**\n\n**system_clock** - \\[SYSTEM:TIME\\] Query system clock\n\n### **Synopsis**\n```fortran\n call system_clock([count] [,count_rate] [,count_max] )\n```\n```fortran\n subroutine system_clock(count, count_rate, count_max)\n\n integer(kind=**),intent(out),optional :: count\n type(TYPE(kind=**)),intent(out),optional :: count_rate\n integer(kind=**),intent(out),optional :: count_max\n```\n### **Characteristics**\n\n - **count** is an _integer_ scalar\n - **count_rate** is an _integer_ or _real_ scalar\n - **count_max** is an _integer_ scalar\n\n### **Description**\n\n **system_clock** lets you measure durations of time with the\n precision of the smallest time increment generally available on a\n system by returning processor-dependent values based on the current\n value of the processor clock.\n\n **system_clock** is typically used to measure short time intervals\n (system clocks may be 24-hour clocks or measure processor clock ticks\n since boot, for example). It is most often used for measuring or\n tracking the time spent in code blocks in lieu of using profiling tools.\n\n **count_rate** and **count_max** are assumed constant (even though\n CPU rates can vary on a single platform).\n\n Whether an image has no clock, has a single clock of its own, or shares\n a clock with another image, is processor dependent.\n\n If there is no clock, or querying the clock fails, **count** is set to\n **-huge(count)**, and **count_rate** and **count_max** are set to zero.\n\n The accuracy of the measurements may depend on the kind of the\n arguments!\n\n Timing-related procedures are obviously processor and system-dependent.\n More specific information may generally be found in compiler-specific\n documentation.\n\n### **Options**\n\n- **count**\n : If there is no clock, the returned value for **count** is the negative\n value **-huge(count)**.\n\n Otherwise, the **clock** value is incremented by one for each clock\n count until the value **count_max** is reached and is then reset to\n zero at the next count. **clock** therefore is a modulo value that\n lies in the range **0 to count_max**.\n\n- **count_rate**\n : is assigned a processor-dependent approximation to the number of\n processor clock counts per second, or zero if there is no clock.\n **count_rate** is system dependent and can vary depending on the kind\n of the arguments. Generally, a large _real_ may generate a more precise\n interval.\n\n- **count_max**\n : is assigned the maximum value that **COUNT** can have, or zero if\n there is no clock.\n\n### **Examples**\n\n If the processor clock is a 24-hour clock that registers time at\n approximately 18.20648193 ticks per second, at 11:30 A.M. the reference\n\n```fortran\n call system_clock (count = c, count_rate = r, count_max = m)\n```\n defines\n```text\n C = (11*3600+30*60)*18.20648193 = 753748,\n R = 18.20648193, and\n M = 24*3600*18.20648193-1 = 1573039.\n```\n\nSample program:\n```fortran\nprogram demo_system_clock\nuse, intrinsic :: iso_fortran_env, only: wp => real64, int32, int64\nimplicit none\ncharacter(len=*), parameter :: g = '(1x,*(g0,1x))'\n\ninteger(kind=int64) :: count64, count_rate64, count_max64\ninteger(kind=int64) :: start64, finish64\n\ninteger(kind=int32) :: count32, count_rate32, count_max32\n\nreal(kind=wp) :: time_read\nreal(kind=wp) :: sum\ninteger :: i\n\n print g, 'accuracy may vary with argument type!'\n\n print g, 'query all arguments'\n\n call system_clock(count64, count_rate64, count_max64)\n print g, 'COUNT_MAX(64bit)=', count_max64\n print g, 'COUNT_RATE(64bit)=', count_rate64\n print g, 'CURRENT COUNT(64bit)=', count64\n\n call system_clock(count32, count_rate32, count_max32)\n print g, 'COUNT_MAX(32bit)=', count_max32\n print g, 'COUNT_RATE(32bit)=', count_rate32\n print g, 'CURRENT COUNT(32bit)=', count32\n\n print g, 'time some computation'\n call system_clock(start64)\n\n ! some code to time\n sum = 0.0_wp\n do i = -0, huge(0) - 1\n sum = sum + sqrt(real(i))\n end do\n print g, 'SUM=', sum\n\n call system_clock(finish64)\n\n time_read = (finish64 - start64)/real(count_rate64, wp)\n write (*, '(1x,a,1x,g0,1x,a)') 'time : ', time_read, ' seconds'\n\nend program demo_system_clock\n```\nResults:\n```text\n > accuracy may vary with argument type!\n > query all arguments\n > COUNT_MAX(64bit)= 9223372036854775807\n > COUNT_RATE(64bit)= 1000000000\n > CURRENT COUNT(64bit)= 1105422387865806\n > COUNT_MAX(32bit)= 2147483647\n > COUNT_RATE(32bit)= 1000\n > CURRENT COUNT(32bit)= 1105422387\n > time some computation\n > SUM= 66344288183024.266\n > time : 6.1341038460000004 seconds\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**date_and_time**(3)](#date_and_time),\n[**cpu_time**(3)](#cpu_time)\n\n _Fortran intrinsic descriptions_\n", "TAN": "## tan\n\n### **Name**\n\n**tan** - \\[MATHEMATICS:TRIGONOMETRIC\\] Tangent function\n\n### **Synopsis**\n```fortran\nresult = tan(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function tan(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - the **TYPE** of **x** may be _real_ or _complex_ of any supported kind\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n**tan** computes the tangent of **x**.\n\n### **Options**\n\n- **x**\n : The angle in radians to compute the tangent of when the input\n is _real_. If **x** is of type _complex_, its real part is regarded\n as a value in radians.\n\n### **Result**\n\n The return value is the tangent of the value **x**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_tan\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 0.165_real64\n write(*,*)x, tan(x)\nend program demo_tan\n```\nResults:\n```text\n > 0.16500000000000001 0.16651386310913616\n```\n### **Standard**\n\nFORTRAN 77 . For a complex argument, Fortran 2008 .\n\n### **See Also**\n\n[**atan**(3)](#atan),\n[**atan2**(3)](#atan2),\n[**cos**(3)](#cos),\n[**sin**(3)](#sin)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "TAND": "## tand\n\n### **Name**\n\n**tand** - \\[MATHEMATICS:TRIGONOMETRIC\\] Degree Tangent function\n\n### **Synopsis**\n```fortran\nresult = tand(x)\n```\n```fortran\n elemental real(kind=KIND) function tand(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - the **TYPE** of **x** is _real_ of any supported kind\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n**tand** computes the degree tangent of **x**.\n\n### **Options**\n\n- **x**\n : The angle in degrees to compute the tangent of.\n\n### **Result**\n\n The return value is a processor-dependent approximation to the tangent\n of the value **x** where **x** is regarded as a value in degrees.\n\n### **Examples**\n\ntand(180.0) has the value 0.0 (approximately).\n\nSample program:\n```fortran\nprogram demo_tand\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 0.5_real64\n write(*,*)x, tand(x)\nend program demo_tand\n```\nResult:\n```text\n > 0.50000000000000000 8.7268677907587893E-003\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n[**atand**(3)](#atand),\n[**atan**(3)](#atan),\n[**atan2d**(3)](#atan2d),\n[**atan2**(3)](#atan2),\n[**cosd**(3)](#cosd),\n[**sind**(3)](#sind)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n\n", "TANH": "## tanh\n\n### **Name**\n\n**tanh** - \\[MATHEMATICS:TRIGONOMETRIC\\] Hyperbolic tangent function\n\n### **Synopsis**\n```fortran\n result = tanh(x)\n```\n```fortran\n elemental TYPE(kind=KIND) function tanh(x)\n\n TYPE(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - **x** may be _real_ or _complex_ and any associated kind supported by\n the processor.\n - The returned value will be of the same type and kind as the argument.\n\n### **Description**\n\n**tanh** computes the hyperbolic tangent of **x**.\n\n### **Options**\n\n- **x**\n : The value to compute the Hyperbolic tangent of.\n\n### **Result**\n\nReturns the hyperbolic tangent of **x**.\n\n If **x** is _complex_, the imaginary part of the result is regarded as\n a radian value.\n\n If **x** is _real_, the return value lies in the range\n```\n -1 <= tanh(x) <= 1.\n```\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_tanh\nuse, intrinsic :: iso_fortran_env, only : real32, real64, real128\nimplicit none\nreal(kind=real64) :: x = 2.1_real64\n write(*,*)x, tanh(x)\nend program demo_tanh\n```\nResults:\n```text\n > 2.1000000000000001 0.97045193661345386\n```\n### **Standard**\n\nFORTRAN 77 , for a complex argument Fortran 2008\n\n### **See Also**\n\n[**atanh**(3)](#atanh)\n\n### **Resources**\n\n- [Wikipedia:hyperbolic functions](https://en.wikipedia.org/wiki/Hyperbolic_functions)\n\n _Fortran intrinsic descriptions_\n", "TANPI": "## tanpi\n\n### **Name**\n\n**tanpi** - \\[MATHEMATICS:TRIGONOMETRIC\\] Circular tangent function\n\n### **Synopsis**\n```fortran\nresult = tanpi(x)\n```\n```fortran\n elemental real(kind=KIND) function tanpi(x)\n\n real(kind=KIND),intent(in) :: x\n```\n### **Characteristics**\n\n - the **TYPE** of **x** is _real_ any supported kind\n - The returned value will be of the same type and kind as the argument\n **x**.\n\n### **Description**\n\n **tanpi** computes the Circular Tangent of **x** in\n half-revolutions.\n\n The result has a value equal to a processor-dependent approximation\n to the tangent of X, which is regarded as a value in half-revolutions;\n thus, TANPI (X) is approximately equal to tan(X*PI).\n\n### **Options**\n\n- **x**\n : The angle in half-revolutions to compute the tangent of.\n\n### **Result**\n\n The return value is the tangent of the value **x**.\n\n### **Examples**\n\nExample: TAND(1.0) has the value 0.0 (approximately).\n\nSample program:\n```fortran\nprogram demo_tanpi\nuse, intrinsic :: iso_fortran_env, only : real64\nimplicit none\ninteger :: i\nreal(kind=real64) :: x\n do i=0,8\n x=0.250000000d0*i\n write(*,101)x, tanpi(x), tanpi(x)*180.0d0\n enddo\n101 format(g0,t23,g0,t50,g0)\nend program demo_tanpi\n```\nResults:\n```text\n > .000000000000000 0.000000000000000 0.000000000000000\n > .2500000000000000 0.9999999999999999 180.0000000000000\n > .5000000000000000 0.1633123935319537E+17 0.2939623083575166E+19\n > .7500000000000000 -1.000000000000000 -180.0000000000000\n > 1.000000000000000 -0.1224646799147353E-15 -0.2204364238465236E-13\n > 1.250000000000000 0.9999999999999997 179.9999999999999\n > 1.500000000000000 5443746451065123. 0.9798743611917221E+18\n > 1.750000000000000 -1.000000000000000 -180.0000000000001\n > 2.000000000000000 -0.2449293598294706E-15 -0.4408728476930472E-13\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n[**atand**(3)](#atand),\n[**atand**(3)](#atand),\n[**atan2pi**(3)](#atan2pi),\n[**atan2d**(3)](#atan2d)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "THIS_IMAGE": "## this_image\n\n### **Name**\n\n**this_image** - \\[COLLECTIVE\\] Cosubscript index of this image\n\n### **Synopsis**\n\n```fortran\nresult = this_image() | = this_image(distance) | = this_image(coarray,dim)\n```\n```fortran\n integer function this_image( distance ,coarray, dim )\n\n type(TYPE(kind=**)),optional :: coarray[*]\n integer,intent(in),optional :: distance\n integer,intent(in),optional :: dim\n```\n### **Characteristics**\n\n - a kind designated as ** may be any supported kind for the type\n - **coarray** can be of any type. If **dim** is present it is required.\n - **distance** is not permitted together with **coarray**\n - if **dim** if present, coarray is required.\n\n### **Description**\n\n**this_image** returns the cosubscript for this image.\n\n### **Options**\n\n- **distance**\n : Nonnegative scalar _integer_ (not permitted together with **coarray**).\n\n- **coarray**\n : if **dim** present, required).\n\n- **dim**\n : If present, **dim** shall be between one and the corank of **coarray**.\n\n### **Result**\n\nDefault integer. If **coarray** is not present, it is scalar; if **distance** is\nnot present or has value **0**, its value is the image index on the invoking\nimage for the current team, for values smaller or equal distance to the\ninitial team, it returns the image index on the ancestor team which has\na distance of **distance** from the invoking team. If **distance** is larger\nthan the distance to the initial team, the image index of the initial\nteam is returned. Otherwise when the **coarray** is present, if **dim** is not\npresent, a rank-1 array with corank elements is returned, containing the\ncosubscripts for **coarray** specifying the invoking image. If **dim** is\npresent, a scalar is returned, with the value of the **dim** element of\n**this_image(coarray)**.\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_this_image\nimplicit none\ninteger :: value[*]\ninteger :: i\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\nend program demo_this_image\n```\nResults:\n```text\n > value[1] is 1\n```\n### **Standard**\n\nFortran 2008. With DISTANCE argument, TS 18508\n\n### **See Also**\n\n[**num\\_images**(3)](#num_images),\n[**image\\_index**(3)](#image_index)\n\n _Fortran intrinsic descriptions_\n", "TINY": "## tiny\n\n### **Name**\n\n**tiny** - \\[MODEL:NUMERIC\\] Smallest positive number of a real kind\n\n### **Synopsis**\n```fortran\n result = tiny(x)\n```\n```fortran\n real(kind=KIND) function tiny(x)\n\n real(kind=KIND) :: x\n```\n### **Characteristics**\n\n - **x** may be any _real_ scalar or array\n - the result has the same type and kind as **x**\n\n### **Description**\n\n **tiny** returns the smallest positive (non zero) number of the\n type and kind of **x**.\n\n For real **x**\n```fortran\n result = 2.0**(minexponent(x)-1)\n```\n### **Options**\n\n- **x**\n : The value whose kind is used to determine the model type to query\n\n### **Result**\n\n The smallest positive value for the _real_ type of the specified kind.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_tiny\nimplicit none\n print *, 'default real is from', tiny(0.0), 'to',huge(0.0)\n print *, 'doubleprecision is from ', tiny(0.0d0), 'to',huge(0.0d0)\nend program demo_tiny\n```\nResults:\n\n```text\n > default real is from 1.17549435E-38 to 3.40282347E+38\n > doubleprecision is from 2.2250738585072014E-308 to\n > 1.7976931348623157E+308\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**digits**(3)](#digits),\n[**epsilon**(3)](#epsilon),\n[**exponent**(3)](#exponent),\n[**fraction**(3)](#fraction),\n[**huge**(3)](#huge),\n[**maxexponent**(3)](#maxexponent),\n[**minexponent**(3)](#minexponent),\n[**nearest**(3)](#nearest),\n[**precision**(3)](#precision),\n[**radix**(3)](#radix),\n[**range**(3)](#range),\n[**rrspacing**(3)](#rrspacing),\n[**scale**(3)](#scale),\n[**set_exponent**(3)](#set_exponent),\n[**spacing**(3)](#spacing)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "TOKENIZE": "## tokenize\n\n### **Name**\n\n**tokenize** - \\[CHARACTER:PARSE] Parse a string into tokens.\n\n### **Synopsis**\n TOKEN form (returns array of strings)\n```fortran\n subroutine tokenize(string, set, tokens [, separator])\n\n character(len=*),intent(in) :: string\n character(len=*),intent(in) :: set\n character(len=:),allocatable,intent(out) :: tokens(:)\n character(len=1),allocatable,intent(out),optional :: separator(:)\n```\n ARRAY BOUNDS form (returns arrays defining token positions)\n```fortran\n subroutine tokenize (string, set, first, last)\n\n character(len=*),intent(in) :: string\n character(len=*),intent(in) :: set\n integer,allocatable,intent(out) :: first(:)\n integer,allocatable,intent(out) :: last(:)\n```\n### **Characteristics**\n - **string** - a scalar of type character. It is an INTENT(IN) argument.\n - **set** - a scalar of type character with the same kind type parameter\n as **string**. It is an INTENT(IN) argument.\n - **separator** - (optional) shall be of type character with the same\n kind type parameter as **string**. It is an\n INTENT(OUT)argument. It shall not be a coarray or\n a coindexed object.\n - **tokens** - of type character with the same kind type parameter as\n **string**. It is an INTENT(OUT) argument. It shall\n not be a coarray or a coindexed object.\n - **first**,**last** - an allocatable array of type integer and rank\n one. It is an INTENT(OUT) argument. It shall\n not be a coarray or a coindexed object.\n\n To reiterate, **string**, **set**, **tokens** and **separator** must\n all be of the same CHARACTER kind type parameter.\n\n### **Description**\n\n **tokenize(3)** parses a string into tokens. There are two forms\n of the subroutine **tokenize(3)**.\n\n - The token form returns an array with one token per element, all of\n the same length as the longest token.\n - The array bounds form returns two integer arrays. One contains the\n beginning position of the tokens and the other the end positions.\n\n Since the token form pads all the tokens to the same length the\n original number of trailing spaces of each token accept for the\n longest is lost.\n\n The array bounds form retains information regarding the exact token\n length even when padded by spaces.\n\n\n### **Options**\n- **string**\n : The string to parse into tokens.\n\n- **set**\n : Each character in **set** is a token delimiter. A sequence of zero\n or more characters in **string** delimited by any token delimiter,\n or the beginning or end of **string**, comprise a token. Thus, two\n consecutive token delimiters in **string**, or a token delimiter\n in the first or last character of **string**, indicate a token with\n zero length.\n\n- **tokens**\n : It shall be an allocatable array of rank one with deferred length. It\n is allocated with the lower bound equal to one and the upper bound\n equal to the number of tokens in **string**, and with character\n length equal to the length of the longest token.\n\n The tokens in **string** are assigned in the order found, as if\n by intrinsic assignment, to the elements of **tokens**, in array\n element order.\n\n- **first**\n : shall be an allocatable array of type integer and rank one. It is\n an INTENT(OUT) argument. It shall not be a coarray or a coindexed\n object.\n\n It is allocated with the lower bound equal to one and the\n upper bound equal to the number of tokens in **string**. Each element\n is assigned, in array element order, the starting position of each\n token in **string**, in the order found. \n\n If a token has zero length, the starting position is equal to one\n if the token is at the beginning of **string**, and one greater than\n the position of the preceding delimiter otherwise.\n\n- **last**\n : It is allocated with the lower bound equal to one and the\n upper bound equal to the number of tokens in **string**. Each element\n is assigned, in array element order, the ending position of each\n token in **string**, in the order found. \n\n If a token has zero length, the ending position is one less than\n the starting position.\n\n### **Examples**\n\n Sample of uses\n```fortran\n program demo_tokenize\n !use M_strings, only : tokenize=>split2020\n implicit none\n ! some useful formats\n character(len=*),parameter :: brackets='(*(\"[\",g0,\"]\":,\",\"))'\n character(len=*),parameter :: a_commas='(a,*(g0:,\",\"))'\n character(len=*),parameter :: space='(*(g0:,1x))'\n character(len=*),parameter :: gen='(*(g0))'\n\n ! Execution of TOKEN form (return array of tokens)\n\n block\n character (len=:), allocatable :: string\n character (len=:), allocatable :: tokens(:)\n character (len=:), allocatable :: kludge(:)\n integer :: i\n string = ' first,second ,third '\n call tokenize(string, set=';,', tokens=tokens )\n write(*,brackets)tokens\n\n string = ' first , second ,third '\n call tokenize(string, set=' ,', tokens=tokens )\n write(*,brackets)(trim(tokens(i)),i=1,size(tokens))\n ! remove blank tokens\n ! <<<\n !tokens=pack(tokens, tokens /= '' )\n ! gfortran 13.1.0 bug -- concatenate //'' and use scratch\n ! variable KLUDGE. JSU: 2024-08-18\n kludge=pack(tokens//'', tokens /= '' )\n ! >>>\n write(*,brackets)kludge\n\n endblock\n\n ! Execution of BOUNDS form (return position of tokens)\n\n block\n character (len=:), allocatable :: string\n character (len=*),parameter :: set = \" ,\"\n integer, allocatable :: first(:), last(:)\n write(*,gen)repeat('1234567890',6)\n string = 'first,second,,fourth'\n write(*,gen)string\n call tokenize (string, set, first, last)\n write(*,a_commas)'FIRST=',first\n write(*,a_commas)'LAST=',last\n write(*,a_commas)'HAS LENGTH=',last-first.gt.0\n endblock\n\n end program demo_tokenize\n```\nResults:\n```text\n > [ first ],[second ],[third ]\n > [],[first],[],[],[second],[],[third],[],[],[],[],[]\n > [first ],[second],[third ]\n > 123456789012345678901234567890123456789012345678901234567890\n > first,second,,fourth\n > FIRST=1,7,14,15\n > LAST=5,12,13,20\n > HAS LENGTH=T,T,F,T\n```\n### **Standard**\n\nFortran 2023\n\n### **See Also**\n\n - [**split**(3)](#split) - return tokens from a string, one at a time\n - [**index**(3)](#index) - Position of a substring within a string\n - [**scan**(3)](#scan) - Scan a string for the presence of a set\n of characters\n - [**verify**(3)](#verify) - Position of a character in a string of\n characters that does not appear in a given set of characters.\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "TRAILZ": "## trailz\n\n### **Name**\n\n**trailz** - \\[BIT:COUNT\\] Number of trailing zero bits of an integer\n\n### **Synopsis**\n```fortran\n result = trailz(i)\n```\n```fortran\n elemental integer function trailz(i)\n\n integer(kind=**),intent(in) :: i\n```\n### **Characteristics**\n\n - **i** is an _integer_ of any kind.\n - the result is an _integer_ of default kind\n\n### **Description**\n\n **trailz** returns the number of trailing zero bits of an _integer_\n value.\n\n### **Options**\n\n- **i**\n : the value to count trailing zero bits in\n\n### **Result**\n The number of trailing rightmost zero bits in an _integer_ value after\n the last non-zero bit.\n```text\n > right-most non-zero bit\n > V\n > |0|0|0|1|1|1|0|1|0|0|0|0|0|0|\n > ^ |___________| trailing zero bits\n > bit_size(i)\n```\n If all the bits of **i** are zero, the result is the size of the input\n value in bits, ie. **bit_size(i)**.\n\n The result may also be seen as the position of the rightmost 1 bit\n in **i**, starting with the rightmost bit being zero and counting to\n the left.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_trailz\n\n! some common integer kinds\nuse, intrinsic :: iso_fortran_env, only : &\n & integer_kinds, int8, int16, int32, int64\n\nimplicit none\n\n! a handy format\ncharacter(len=*),parameter :: &\n & show = '(1x,\"value=\",i4,\", value(bits)=\",b32.32,1x,\", trailz=\",i3)'\n\ninteger(kind=int64) :: bigi\n ! basics\n write(*,*)'Note default integer is',bit_size(0),'bits'\n print show, -1, -1, trailz(-1)\n print show, 0, 0, trailz(0)\n print show, 1, 1, trailz(1)\n print show, 96, 96, trailz(96)\n ! elemental\n print *, 'elemental and any integer kind:'\n bigi=2**5\n write(*,*) trailz( [ bigi, bigi*256, bigi/2 ] )\n write(*,'(1x,b64.64)')[ bigi, bigi*256, bigi/2 ]\n\nend program demo_trailz\n```\nResults:\n```text\n > Note default integer is 32 bits\n > value= -1, value(bits)=11111111111111111111111111111111 , trailz= 0\n > value= 0, value(bits)=00000000000000000000000000000000 , trailz= 32\n > value= 1, value(bits)=00000000000000000000000000000001 , trailz= 0\n > value= 96, value(bits)=00000000000000000000000001100000 , trailz= 5\n > elemental and any integer kind:\n > 5 13 4\n > 0000000000000000000000000000000000000000000000000000000000100000\n > 0000000000000000000000000000000000000000000000000010000000000000\n > 0000000000000000000000000000000000000000000000000000000000010000\n```\n### **Standard**\n\n Fortran 2008\n\n### **See Also**\n\n[**bit_size**(3)](#bit_size),\n[**popcnt**(3)](#popcnt),\n[**poppar**(3)](#poppar),\n[**leadz**(3)](#leadz)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "TRANSFER": "## transfer\n\n### **Name**\n\n**transfer** - \\[TYPE:MOLD\\] Transfer bit patterns\n\n### **Synopsis**\n```fortran\n result = transfer(source, mold [,size] )\n```\n```fortran\n type(TYPE(kind=KIND)) function transfer(source,mold,size)\n\n type(TYPE(kind=KIND)),intent(in) :: source(..)\n type(TYPE(kind=KIND)),intent(in) :: mold(..)\n integer(kind=**),intent(in),optional :: size\n```\n### **Characteristics**\n\n- **source** shall be a scalar or an array of any type.\n- **mold** shall be a scalar or an array of any type.\n- **size** shall be a scalar of type _integer_.\n- **result** has the same type as **mold**\n\n### **Description**\n\n**transfer** copies the bitwise representation of **source** in memory\ninto a variable or array of the same type and type parameters as **mold**.\n\nThis is approximately equivalent to the C concept of \"casting\" one type\nto another.\n\n### **Options**\n\n- **source**\n : Holds the bit pattern to be copied\n\n- **mold**\n : the type of **mold** is used to define the type of the returned\n value. In addition, if it is an array the returned value is a\n one-dimensional array. If it is a scalar the returned value is a scalar.\n\n- **size**\n : If **size** is present, the result is a one-dimensional array of\n length **size**.\n\nIf **size** is absent but **mold** is an array (of any size or\nshape), the result is a one-dimensional array of the minimum length\nneeded to contain the entirety of the bitwise representation of **source**.\n\nIf **size** is absent and **mold** is a scalar, the result is a scalar.\n\n### **Result**\n\nThe result has the bit level representation of **source**.\n\nIf the bitwise representation of the result is longer than that of\n**source**, then the leading bits of the result correspond to those of\n**source** but any trailing bits are filled arbitrarily.\n\nWhen the resulting bit representation does not correspond to a valid\nrepresentation of a variable of the same type as **mold**, the results are\nundefined, and subsequent operations on the result cannot be guaranteed to\nproduce sensible behavior. For example, it is possible to create _logical_\nvariables for which **var** and **.not.var** both appear to be true.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_transfer\nuse,intrinsic :: iso_fortran_env, only : int32, real32\ninteger(kind=int32) :: i = 2143289344\nreal(kind=real32) :: x\ncharacter(len=10) :: string\ncharacter(len=1) :: chars(10)\n x=transfer(i, 1.0) ! prints \"nan\" on i686\n ! the bit patterns are the same\n write(*,'(b0,1x,g0)')x,x ! create a NaN\n write(*,'(b0,1x,g0)')i,i\n\n ! a string to an array of characters\n string='abcdefghij'\n chars=transfer(string,chars)\n write(*,'(*(\"[\",a,\"]\":,1x))')string\n write(*,'(*(\"[\",a,\"]\":,1x))')chars\nend program demo_transfer\n```\nResults:\n```text\n > 1111111110000000000000000000000 NaN\n > 1111111110000000000000000000000 2143289344\n > [abcdefghij]\n > [a] [b] [c] [d] [e] [f] [g] [h] [i] [j]\n```\n### **Comments**\n\n_Joe Krahn_: Fortran uses **molding** rather than **casting**.\n\nCasting, as in C, is an in-place reinterpretation. A cast is a device\nthat is built around an object to change its shape.\n\nFortran **transfer** reinterprets data out-of-place. It can be\nconsidered **molding** rather than casting. A **mold** is a device that\nconfers a shape onto an object placed into it.\n\nThe advantage of molding is that data is always valid in the context\nof the variable that holds it. For many cases, a decent compiler should\noptimize **transfer** into a simple assignment.\n\nThere are disadvantages of this approach. It is problematic to define a\nunion of data types because you must know the largest data object, which\ncan vary by compiler or compile options. In many cases, an _EQUIVALENCE_\nwould be far more effective, but Fortran Standards committees seem\noblivious to the benefits of _EQUIVALENCE_ when used sparingly.\n\n### **Standard**\n\nFortran 90\n\n### **See also**\n\n -[equivalence(7)](#equivalence) - alias storage\n\n _Fortran intrinsic descriptions_\n", "TRANSPOSE": "## transpose\n\n### **Name**\n\n**transpose** - \\[ARRAY:MANIPULATION\\] Transpose an array of rank two\n\n### **Synopsis**\n```fortran\n result = transpose(matrix)\n```\n```fortran\n function transpose(matrix)\n\n type(TYPE(kind=KIND)) :: transpose(N,M)\n type(TYPE(kind=KIND)),intent(in) :: matrix(M,N)\n```\n### **Characteristics**\n\n - **matrix** is an array of any type with a rank of two.\n - The result will be the same type and kind as **matrix** and the\n reversed shape of the input array\n\n### **Description**\n\n **transpose** transposes an array of rank two.\n\n An array is transposed by interchanging the rows and columns of the\n given matrix. That is, element (i,j) of the result has the value of\n element (j,i) of the input for all (i,j).\n\n### **Options**\n\n- **matrix**\n : The array to transpose\n\n### **Result**\n\nThe transpose of the input array. The result has the same type as\n**matrix**, and has shape \\[ m, n \\] if **matrix** has shape \\[ n, m \\].\n\n### **Examples**\n\nSample program:\n```fortran\nprogram demo_transpose\nimplicit none\ninteger,allocatable :: array(:,:)\ninteger,parameter :: values(3,5)= reshape([&\n 1, 2, 3, 4, 5, &\n 10, 20, 30, 40, 50, &\n 11, 22, 33, 44, -1055 &\n ],shape(values),order=[2,1])\n\n array=values\n call print_matrix_int('array:',array)\n array=transpose(array)\n call print_matrix_int('array transposed:',array)\n array=transpose(array)\n call print_matrix_int('transposed transpose:',array)\n\ncontains\n\nsubroutine print_matrix_int(title,arr)\n! print small 2d integer arrays in row-column format\nimplicit none\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n write(*,'(a,\" shape(\",i0,\",\",i0,\")\")')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\nend subroutine print_matrix_int\n\nend program demo_transpose\n```\nResults:\n```text\n > array: shape(3,5)\n > [ 1, 2, 3, 4, 5 ]\n > [ 10, 20, 30, 40, 50 ]\n > [ 11, 22, 33, 44, -1055 ]\n > array transposed: shape(5,3)\n > [ 1, 10, 11 ]\n > [ 2, 20, 22 ]\n > [ 3, 30, 33 ]\n > [ 4, 40, 44 ]\n > [ 5, 50, -1055 ]\n > transposed transpose: shape(3,5)\n > [ 1, 2, 3, 4, 5 ]\n > [ 10, 20, 30, 40, 50 ]\n > [ 11, 22, 33, 44, -1055 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See also**\n\n- [**merge**(3)](#merge) - Merge variables\n- [**pack**(3)](#pack) - Pack an array into an array of rank one\n- [**spread**(3)](#spread) - Add a dimension and replicate data\n- [**unpack**(3)](#unpack) - Scatter the elements of a vector\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "TRIM": "## trim\n\n### **Name**\n\n**trim** - \\[CHARACTER:WHITESPACE\\] Remove trailing blank characters from a string\n\n### **Synopsis**\n```fortran\n result = trim(string)\n```\n```fortran\n character(len=:,kind=KIND) function trim(string)\n\n character(len=*,kind=KIND),intent(in) :: string\n```\n### **Characteristics**\n\n - **KIND** can be any kind supported for the _character_ type.\n - The result has the same type and kind as the input argument **string**.\n\n### **Description**\n\n **trim** removes trailing blank characters from a string.\n\n### **Options**\n\n- **string**\n : A string to trim\n\n### **Result**\n\n The result is the same as **string** except trailing blanks are removed.\n\n If **string** is composed entirely of blanks or has zero length,\n the result has zero length.\n\n### **Examples**\n\nSample program:\n\n```fortran\nprogram demo_trim\nimplicit none\ncharacter(len=:), allocatable :: str, strs(:)\ncharacter(len=*),parameter :: brackets='( *(\"[\",a,\"]\":,1x) )'\ninteger :: i\n\n str=' trailing '\n print brackets, str,trim(str) ! trims it\n\n str=' leading'\n print brackets, str,trim(str) ! no effect\n\n str=' '\n print brackets, str,trim(str) ! becomes zero length\n print *, len(str), len(trim(' '))\n\n ! array elements are all the same length, so you often\n ! want to print them\n strs=[character(len=10) :: \"Z\",\" a b c\",\"ABC\",\"\"]\n\n write(*,*)'untrimmed:'\n ! everything prints as ten characters; nice for neat columns\n print brackets, (strs(i), i=1,size(strs))\n print brackets, (strs(i), i=size(strs),1,-1)\n write(*,*)'trimmed:'\n ! everything prints trimmed\n print brackets, (trim(strs(i)), i=1,size(strs))\n print brackets, (trim(strs(i)), i=size(strs),1,-1)\n\nend program demo_trim\n```\nResults:\n```text\n > [ trailing ] [ trailing]\n > [ leading] [ leading]\n > [ ] []\n > 12 0\n > untrimmed:\n > [Z ] [ a b c ] [ABC ] [ ]\n > [ ] [ABC ] [ a b c ] [Z ]\n > trimmed:\n > [Z] [ a b c] [ABC] []\n > [] [ABC] [ a b c] [Z]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n [**scan**(3)](#scan),\n [**verify**(3)](#verify)\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat),\n [**trim**](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "UBOUND": "## ubound\n\n### **Name**\n\n**ubound** - \\[ARRAY:INQUIRY\\] Upper dimension bounds of an array\n\n### **Synopsis**\n```fortran\n result = ubound(array [,dim] [,kind] )\n```\n```fortran\n elemental TYPE(kind=KIND) function ubound(array,dim,kind)\n\n TYPE(kind=KIND),intent(in) :: array\n integer(kind=**),intent(in),optional :: dim\n integer(kind=**),intent(in),optional :: kind\n```\n### **Characteristics**\n\n- **array** shall be assumed-rank or an array, of any type.\n It cannot be an unallocated allocatable array or a pointer that is not associated.\n\n- **dim** shall be a scalar _integer_.\n The corresponding actual argument shall not be an optional dummy\n argument, a disassociated pointer, or an unallocated allocatable.\n\n- **kind** an _integer_ initialization expression indicating the kind\n parameter of the result.\n\n- The return value is of type _integer_ and of kind **kind**. If **kind**\n is absent, the return value is of default integer kind.\n The result is scalar if **dim** is present; otherwise, the result is\n an array of rank one and size n, where n is the rank of **array**.\n\n- a kind designated as ** may be any supported kind for the type\n\n### **Description**\n\n**ubound** returns the upper bounds of an array, or a single upper\nbound along the **dim** dimension.\n\n### **Options**\n\n- **array**\n : The assumed-rank or array of any type whose upper bounds are to be\n determined. If allocatable it must be allocated; if a pointer it must\n be associated. If an assumed-size array, **dim** must be present.\n\n- **dim**\n : a specific dimension of **array** to determine the bounds of.\n If **dim** is absent, the result is an array of the upper bounds of\n **array**. **dim** is required if **array** is an assumed-size array,\n and in that case must be less than or equal to the rank of **array**.\n\n- **kind**\n : indicates the kind parameter of the result. If absent, an _integer_\n of the default kind is returned.\n\n### **Result**\n\nThe return value is of type _integer_ and of kind **kind**. If **kind**\nis absent, the return value is of default integer kind.\n\nIf **dim** is absent, the result is an array of the upper bounds of\neach dimension of the **array**.\n\nIf **dim** is present, the result is a scalar corresponding to the upper\nbound of the array along that dimension.\n\nIf **array** is an expression rather than a whole array or array\nstructure component, or if it has a zero extent along the relevant\ndimension, the upper bound is taken to be the number of elements along\nthe relevant dimension.\n\n NOTE1\n If ARRAY is assumed-rank and has rank zero, DIM cannot be present\n since it cannot satisfy the requirement\n **1 <= DIM <= 0**.\n\n### **Examples**\n\nNote this function should not be used on assumed-size arrays or in any\nfunction without an explicit interface. Errors can occur if there is no\ninterface defined.\n\nSample program\n\n```fortran\n! program demo_ubound\nmodule m2_bounds\nimplicit none\n\ncontains\n\nsubroutine msub(arr)\n!!integer,intent(in) :: arr(*) ! cannot be assumed-size array\ninteger,intent(in) :: arr(:)\n write(*,*)'MSUB: LOWER=',lbound(arr),'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\nend subroutine msub\n\nend module m2_bounds\n!\nprogram demo_ubound\nuse m2_bounds, only : msub\nimplicit none\ninterface\n subroutine esub(arr)\n integer,intent(in) :: arr(:)\n end subroutine esub\nend interface\ninteger :: arr(-10:10)\n write(*,*)'MAIN: LOWER=',lbound(arr),'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\n call csub()\n call msub(arr)\n call esub(arr)\ncontains\nsubroutine csub\n write(*,*)'CSUB: LOWER=',lbound(arr),'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\nend subroutine csub\n\nend\n\nsubroutine esub(arr)\nimplicit none\ninteger,intent(in) :: arr(:)\n ! WARNING: IF CALLED WITHOUT AN EXPLICIT INTERFACE\n ! THIS WILL GIVE UNDEFINED ANSWERS (like 0,0,0)\n write(*,*)'ESUB: LOWER=',lbound(arr),'UPPER=',ubound(arr), &\n & 'SIZE=',size(arr)\nend subroutine esub\n!end program demo_ubound\n```\nResults:\n```text\n > MAIN: LOWER= -10 UPPER= 10 SIZE= 21\n > CSUB: LOWER= -10 UPPER= 10 SIZE= 21\n > MSUB: LOWER= 1 UPPER= 21 SIZE= 21\n > ESUB: LOWER= 1 UPPER= 21 SIZE= 21\n```\n### **Standard**\n\nFortran 95 , with KIND argument Fortran 2003\n\n### **See Also**\n\n#### Array inquiry:\n\n- [**size**(3)](#size) - Determine the size of an array\n- [**rank**(3)](#rank) - Rank of a data object\n- [**shape**(3)](#shape) - Determine the shape of an array\n- [**lbound**(3)](#lbound) - Lower dimension bounds of an array\n\n[**co\\_ubound**(3)](#ucobound),\n[**co\\_lbound**(3)](lcobound)\n\n#### State Inquiry:\n\n- [**allocated**(3)](#allocated) - Status of an allocatable entity\n- [**is_contiguous**(3)](#is_contiguous) - Test if object is contiguous\n\n#### Kind Inquiry:\n\n- [**kind**(3)](#kind) - Kind of an entity\n\n#### Bit Inquiry:\n\n- [**storage_size**(3)](#storage_size) - Storage size in bits\n- [**bit_size**(3)](#bit_size) - Bit size inquiry function\n- [**btest**(3)](#btest) - Tests a bit of an _integer_ value.\n- [**lbound**(3)](#lbound),\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "UCOBOUND": "## ucobound\n\n### **Name**\n\n**ucobound** - \\[COLLECTIVE\\] Upper codimension bounds of an array\n\n### **Synopsis**\n```fortran\n result = ucobound(coarray [,dim] [,kind] )\n```\n```fortran\n```\n### **Characteristics**\n\n### **Description**\n\n**ucobound** returns the upper cobounds of a coarray, or a single\nupper cobound along the **dim** codimension.\n\n### **Options**\n\n- **array**\n : Shall be an coarray, of any type.\n\n- **dim**\n : (Optional) Shall be a scalar _integer_.\n\n- **kind**\n : (Optional) An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\nThe return value is of type _integer_ and of kind **kind**. If **kind** is absent,\nthe return value is of default integer kind. If **dim** is absent, the\nresult is an array of the lower cobounds of **coarray**. If **dim** is present,\nthe result is a scalar corresponding to the lower cobound of the array\nalong that codimension.\n\n### **Standard**\n\nFortran 2008\n\n### **See Also**\n\n[**lcobound**(3)](#lcobound),\n[**lbound**(3)](#lbound),\n[**ubound**(3)](#ubound)\n", "UNPACK": "## unpack\n\n### **Name**\n\n**unpack** - \\[ARRAY:CONSTRUCTION\\] Scatter the elements of a vector\ninto an array using a mask\n\n### **Synopsis**\n```fortran\n result = unpack(vector, mask, field)\n```\n```fortran\n type(TYPE(kind=KIND)) unpack(vector, mask, field)\n\n type(TYPE(kind=KIND)),intent(in) :: vector(:)\n logical,intent(in) :: mask(..)\n type(TYPE(kind=KIND)),intent(in) :: field(..)\n```\n### **Characteristics**\n\n - **vector** is a rank-one array of any type\n - **mask** is a logical array\n - **field** is the same type and type parameters as VECTOR conformable with **mask**.\n - The result is an array of the same type and type parameters as **vector**\n and the same shape as **mask**.\n\n### **Description**\n\n**unpack** scatters the elements of **vector** into a copy of an\narray **field** of any rank using _.true._ values from **mask** in array\nelement order to specify placement of the **vector** values.\n\nSo a copy of **field** is generated with select elements replaced with\nvalues from **vector**. This allows for complex replacement patterns\nthat would be difficult when using array syntax or multiple assignment\nstatements, particularly when the replacements are conditional.\n\n### **Options**\n\n- **vector**\n : New values to place into specified locations in **field**.\n It shall have at least as many elements as **mask** has _.true._\n values.\n\n- **mask**\n : Shall be an array that specifies which values\n in **field** are to be replaced with values from **vector**.\n\n- **field**\n : The input array to be altered.\n\n### **Result**\n\n The element of the result that corresponds to the ith true element of\n **mask**, in array element order, has the value **vector(i)** for i =\n 1, 2, . . ., t, where t is the number of true values in **mask**. Each\n other element has a value equal to **field** if **field** is scalar\n or to the corresponding element of **field** if it is an array.\n\n The resulting array corresponds to **field** with _.true._ elements\n of **mask** replaced by values from **vector** in array element order.\n\n### **Examples**\nParticular values may be \"scattered\" to particular positions in an array\nby using\n```text\n 1 0 0\n If M is the array 0 1 0\n 0 0 1\n\n V is the array [1, 2, 3],\n . T .\n and Q is the logical mask T . .\n . . T\n where \"T\" represents true and \".\" represents false, then the result of\n\n UNPACK (V, MASK = Q, FIELD = M) has the value\n\n 1 2 0\n 1 1 0\n 0 0 3\n\n and the result of UNPACK (V, MASK = Q, FIELD = 0) has the value\n\n 0 2 0\n 1 0 0\n 0 0 3\n```\nSample program:\n\n```fortran\nprogram demo_unpack\nimplicit none\nlogical,parameter :: T=.true., F=.false.\n\ninteger :: vector(2) = [1,1]\n\n! mask and field must conform\ninteger,parameter :: r=2, c=2\nlogical :: mask(r,c) = reshape([ T,F,F,T ],[2,2])\ninteger :: field(r,c) = 0, unity(2,2)\n\n ! basic usage\n unity = unpack( vector, mask, field )\n call print_matrix_int('unity=', unity)\n\n ! if FIELD is a scalar it is used to fill all the elements\n ! not assigned to by the vector and mask.\n call print_matrix_int('scalar field', &\n & unpack( &\n & vector=[ 1, 2, 3, 4 ], &\n & mask=reshape([ T,F,T,F,F,F,T,F,T ], [3,3]), &\n & field=0) )\n\ncontains\n\nsubroutine print_matrix_int(title,arr)\n! convenience routine:\n! just prints small integer arrays in row-column format\nimplicit none\ncharacter(len=*),intent(in) :: title\ninteger,intent(in) :: arr(:,:)\ninteger :: i\ncharacter(len=:),allocatable :: biggest\n\n write(*,*)trim(title)\n ! make buffer to write integer into\n biggest=' '\n ! find how many characters to use for integers\n write(biggest,'(i0)')ceiling(log10(max(1.0,real(maxval(abs(arr))))))+2\n ! use this format to write a row\n biggest='(\" [\",*(i'//trim(biggest)//':,\",\"))'\n ! print one row of array at a time\n do i=1,size(arr,dim=1)\n write(*,fmt=biggest,advance='no')arr(i,:)\n write(*,'(\" ]\")')\n enddo\nend subroutine print_matrix_int\n\nend program demo_unpack\n```\nResults:\n\n```text\n > unity=\n > [ 1, 0 ]\n > [ 0, 1 ]\n > scalar field\n > [ 1, 0, 3 ]\n > [ 0, 0, 0 ]\n > [ 2, 0, 4 ]\n```\n### **Standard**\n\nFortran 95\n\n### **See Also**\n\n[**merge**(3)](#merge),\n[**pack**(3)](#pack),\n[**spread**(3)](#spread)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n", "VERIFY": "## verify\n\n### **Name**\n\n**verify** - \\[CHARACTER:SEARCH\\] Position of a character in a string\nof characters that does not appear in a given set of characters.\n\n### **Synopsis**\n```fortran\n result = verify(string, set [,back] [,kind] )\n```\n```fortran\n elemental integer(kind=KIND) function verify(string,set,back,KIND)\n\n character(len=*,kind=**),intent(in) :: string\n character(len=*,kind=**),intent(in) :: set\n logical,intent(in),optional :: back\n integer,intent(in),optional :: KIND\n```\n### **Characteristics**\n\n - **string** and **set** must be of type _character_ and have the same kind for any\n individual call, but that can be any supported _character_ kind.\n - **KIND** must be a constant _integer_ initialization expression and a\n valid kind for the _integer_ type.\n - **back** shall be of type logical.\n - the kind of the returned value is the same as **kind** if\n present. Otherwise a default _integer_ kind is returned.\n\n### **Description**\n\n **verify** verifies that all the characters in **string** belong\n to the set of characters in **set** by identifying the position of\n the first character in the string that is not in the set.\n\n This makes it easy to verify strings are all uppercase or lowercase,\n follow a basic syntax, only contain printable characters, and many\n of the conditions tested for with the C routines **isalnum**(3c),\n **isalpha**(3c), **isascii**(3c), **isblank**(3c), **iscntrl**(3c),\n **isdigit**(3c), **isgraph**(3c), **islower**(3c), **isprint**(3c),\n **ispunct**(3c), **isspace**(3c), **isupper**(3c), and **isxdigit**(3c);\n but for a string as well as an array of strings.\n\n### **Options**\n\n- **string**\n : The string to search in for an unmatched character.\n\n- **set**\n : The set of characters that must be matched.\n\n- **back**\n : The direction to look for an unmatched character. The left-most\n unmatched character position is returned unless **back** is present\n and _.false._, which causes the position of the right-most unmatched\n character to be returned instead of the left-most unmatched character.\n\n- **kind**\n : An _integer_ initialization expression indicating the kind\n parameter of the result.\n\n### **Result**\n\nIf all characters of **string** are found in **set**, the result is zero.\n\nIf **string** is of zero length a zero (0) is always returned.\n\nOtherwise, if an unmatched character is found\nThe position of the first or last (if **back** is _.false._) unmatched\ncharacter in **string** is returned, starting with position one on the\nleft end of the string.\n\n### **Examples**\n\n#### Sample program I:\n```fortran\nprogram demo_verify\nimplicit none\n! some useful character sets\ncharacter,parameter :: &\n & int*(*) = '1234567890', &\n & low*(*) = 'abcdefghijklmnopqrstuvwxyz', &\n & upp*(*) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', &\n & punc*(*) = \"!\"\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~\", &\n & blank*(*) = ' ', &\n & tab = char(11), &\n & prnt*(*) = int//low//upp//blank//punc\n\ncharacter(len=:),allocatable :: string\ninteger :: i\n print *, 'basics:'\n print *, VERIFY ('ABBA', 'A') ! has the value 2.\n print *, VERIFY ('ABBA', 'A', BACK = .TRUE.) ! has the value 3.\n print *, VERIFY ('ABBA', 'AB') ! has the value 0.\n\n print *,'find first non-uppercase letter'\n ! will produce the location of \"d\", because there is no match in UPP\n write(*,*) 'something unmatched',verify(\"ABCdEFG\", upp)\n\n print *,'if everything is matched return zero'\n ! will produce 0 as all letters have a match\n write(*,*) 'everything matched',verify(\"ffoorrttrraann\", \"nartrof\")\n\n print *,'easily categorize strings as uppercase, lowercase, ...'\n ! easy C-like functionality but does entire strings not just characters\n write(*,*)'isdigit 123?',verify(\"123\", int) == 0\n write(*,*)'islower abc?',verify(\"abc\", low) == 0\n write(*,*)'isalpha aBc?',verify(\"aBc\", low//upp) == 0\n write(*,*)'isblank aBc dEf?',verify(\"aBc dEf\", blank//tab ) /= 0\n ! check if all printable characters\n string=\"aB;cde,fgHI!Jklmno PQRSTU vwxyz\"\n write(*,*)'isprint?',verify(string,prnt) == 0\n ! this now has a nonprintable tab character in it\n string(10:10)=char(11)\n write(*,*)'isprint?',verify(string,prnt) == 0\n\n print *,'VERIFY(3) is very powerful using expressions as masks'\n ! verify(3) is often used in a logical expression\n string=\" This is NOT all UPPERCASE \"\n write(*,*)'all uppercase/spaces?',verify(string, blank//upp) == 0\n string=\" This IS all uppercase \"\n write(*,*) 'string=['//string//']'\n write(*,*)'all uppercase/spaces?',verify(string, blank//upp) == 0\n\n ! set and show complex string to be tested\n string=' Check this out. Let me know '\n ! show the string being examined\n write(*,*) 'string=['//string//']'\n write(*,*) ' '//repeat(int,4) ! number line\n\n ! the Fortran functions returns a position just not a logical like C\n print *, 'returning a position not just a logical is useful'\n ! which can be very useful for parsing strings\n write(*,*)'first non-blank character',verify(string, blank)\n write(*,*)'last non-blank character',verify(string, blank,back=.true.)\n write(*,*)'first non-letter non-blank',verify(string,low//upp//blank)\n\n !VERIFY(3) is elemental so you can check an array of strings in one call\n print *, 'elemental'\n ! are strings all letters (or blanks)?\n write(*,*) 'array of strings',verify( &\n ! strings must all be same length, so force to length 10\n & [character(len=10) :: \"YES\",\"ok\",\"000\",\"good one\",\"Nope!\"], &\n & low//upp//blank) == 0\n\n ! rarer, but the set can be an array, not just the strings to test\n ! you could do ISPRINT() this (harder) way :>\n write(*,*)'isprint?',.not.all(verify(\"aBc\", [(char(i),i=32,126)])==1)\n ! instead of this way\n write(*,*)'isprint?',verify(\"aBc\",prnt) == 0\n\nend program demo_verify\n```\nResults:\n```text\n > basics:\n > 2\n > 3\n > 0\n > find first non-uppercase letter\n > something unmatched 4\n > if everything is matched return zero\n > everything matched 0\n > easily categorize strings as uppercase, lowercase, ...\n > isdigit 123? T\n > islower abc? T\n > isalpha aBc? T\n > isblank aBc dEf? T\n > isprint? T\n > isprint? F\n > VERIFY(3) is very powerful using expressions as masks\n > all uppercase/spaces? F\n > string=[ This IS all uppercase ]\n > all uppercase/spaces? F\n > string=[ Check this out. Let me know ]\n > 1234567890123456789012345678901234567890\n > returning a position not just a logical is useful\n > first non-blank character 3\n > last non-blank character 29\n > first non-letter non-blank 17\n > elemental\n > array of strings T T F T F\n > isprint? T\n > isprint? T\n```\n#### Sample program II:\n\nDetermine if strings are valid integer representations\n\n```fortran\nprogram fortran_ints\nimplicit none\ninteger :: i\ncharacter(len=*),parameter :: ints(*)=[character(len=10) :: &\n '+1 ', &\n '3044848 ', &\n '30.40 ', &\n 'September ', &\n '1 2 3', &\n ' -3000 ', &\n ' ']\n ! show the strings to test\n write(*,'(\"|\",*(g0,\"|\"))') ints\n ! show if strings pass or fail the test done by isint(3)\n write(*,'(\"|\",*(1x,l1,8x,\"|\"))') isint(ints)\n\ncontains\n\nelemental function isint(line) result (lout)\n!\n! determine if string is a valid integer representation\n! ignoring trailing spaces and leading spaces\n!\ncharacter(len=*),parameter :: digits='0123456789'\ncharacter(len=*),intent(in) :: line\ncharacter(len=:),allocatable :: name\nlogical :: lout\n lout=.false.\n ! make sure at least two characters long to simplify tests\n name=adjustl(line)//' '\n ! blank string\n if( name == '' )return\n ! allow one leading sign\n if( verify(name(1:1),'+-') == 0 ) name=name(2:)\n ! was just a sign\n if( name == '' )return\n lout=verify(trim(name), digits) == 0\nend function isint\n\nend program fortran_ints\n```\nResults:\n```text\n|+1 |3044848 |30.40 |September|1 2 3 | -3000 | |\n| T | T | F | F | F | T | F |\n```\n#### Sample program III:\n\nDetermine if strings represent valid Fortran symbol names\n\n```fortran\nprogram fortran_symbol_name\nimplicit none\ninteger :: i\ncharacter(len=*),parameter :: symbols(*)=[character(len=10) :: &\n 'A_ ', &\n '10 ', &\n 'September ', &\n 'A B', &\n '_A ', &\n ' ']\n\n write(*,'(\"|\",*(g0,\"|\"))') symbols\n write(*,'(\"|\",*(1x,l1,8x,\"|\"))') fortran_name(symbols)\n\ncontains\n\nelemental function fortran_name(line) result (lout)\n!\n! determine if a string is a valid Fortran name\n! ignoring trailing spaces (but not leading spaces)\n!\ncharacter(len=*),parameter :: int='0123456789'\ncharacter(len=*),parameter :: lower='abcdefghijklmnopqrstuvwxyz'\ncharacter(len=*),parameter :: upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ'\ncharacter(len=*),parameter :: allowed=upper//lower//int//'_'\n\ncharacter(len=*),intent(in) :: line\ncharacter(len=:),allocatable :: name\nlogical :: lout\n name=trim(line)\n if(len(name).ne.0)then\n ! first character is alphameric\n lout = verify(name(1:1), lower//upper) == 0 &\n ! other characters are allowed in a symbol name\n & .and. verify(name,allowed) == 0 &\n ! allowable length\n & .and. len(name) <= 63\n else\n lout = .false.\n endif\nend function fortran_name\n\nend program fortran_symbol_name\n```\nResults:\n```text\n |A_ |10 |September |A B |_A | |\n | T | F | T | F | F | F |\n```\n#### Sample program IV:\n\ncheck if string is of form NN-HHHHH\n\n```fortran\nprogram checkform\n! check if string is of form NN-HHHHH\nimplicit none\ncharacter(len=*),parameter :: int='1234567890'\ncharacter(len=*),parameter :: hex='abcdefABCDEF0123456789'\nlogical :: lout\ncharacter(len=80) :: chars\n\n chars='32-af43d'\n lout=.true.\n\n ! are the first two characters integer characters?\n lout = lout.and.(verify(chars(1:2), int) == 0)\n\n ! is the third character a dash?\n lout = lout.and.(verify(chars(3:3), '-') == 0)\n\n ! is remaining string a valid representation of a hex value?\n lout = lout.and.(verify(chars(4:8), hex) == 0)\n\n if(lout)then\n write(*,*)trim(chars),' passed'\n else\n write(*,*)trim(chars),' failed'\n endif\nend program checkform\n```\nResults:\n```text\n 32-af43d passed\n```\n#### Sample program V:\n\nexploring uses of elemental functionality and dusty corners\n\n```fortran\nprogram more_verify\nimplicit none\ncharacter(len=*),parameter :: &\n & int='0123456789', &\n & low='abcdefghijklmnopqrstuvwxyz', &\n & upp='ABCDEFGHIJKLMNOPQRSTUVWXYZ', &\n & blank=' '\n! note character variables in an array have to be of the same length\ncharacter(len=6) :: strings(3)=[\"Go \",\"right \",\"home! \"]\ncharacter(len=2) :: sets(3)=[\"do\",\"re\",\"me\"]\n\n ! elemental -- you can use arrays for both strings and for sets\n\n ! check each string from right to left for non-letter/non-blank\n write(*,*)'last non-letter',verify(strings,upp//low//blank,back=.true.)\n\n ! even BACK can be an array\n ! find last non-uppercase character in \"Howdy \"\n ! and first non-lowercase in \"there \"\n write(*,*) verify(strings(1:2),[upp,low],back=[.true.,.false.])\n\n ! using a null string for a set is not well defined. Avoid it\n write(*,*) 'null',verify(\"for tran \", \"\", .true.) ! 8,length of string?\n ! probably what you expected\n write(*,*) 'blank',verify(\"for tran \", \" \", .true.) ! 7,found 'n'\n\n ! first character in \"Go \" not in \"do\",\n ! and first letter in \"right \" not in \"ri\"\n ! and first letter in \"home! \" not in \"me\"\n write(*,*) verify(strings,sets)\n\nend program more_verify\n```\nResults:\n```text\n > last non-letter 0 0 5\n > 6 6\n > null 9\n > blank 8\n > 1 2 1\n```\n### **Standard**\n\nFortran 95 , with **kind** argument - Fortran 2003\n\n### **See Also**\n\nFunctions that perform operations on character strings, return lengths\nof arguments, and search for certain arguments:\n\n- **Elemental:**\n [**adjustl**(3)](#adjustl),\n [**adjustr**(3)](#adjustr),\n [**index**(3)](#index),\n [**scan**(3)](#scan),\n\n- **Nonelemental:**\n [**len_trim**(3)](#len_trim),\n [**len**(3)](#len),\n [**repeat**(3)](#repeat),\n [**trim**(3)](#trim)\n\n _Fortran intrinsic descriptions (license: MIT) \\@urbanjost_\n" } fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/intrinsics.py000066400000000000000000000234701477231266000265560ustar00rootroot00000000000000from __future__ import annotations import glob import json import os from pathlib import Path from fortls.helper_functions import fortran_md, get_placeholders, map_keywords from .ast import FortranAST from .base import FortranObj from .function import Function from .module import Module from .subroutine import Subroutine from .type import Type from .use import Use from .variable import Variable intrinsic_ast = FortranAST() lowercase_intrinsics = False def set_lowercase_intrinsics(): global lowercase_intrinsics lowercase_intrinsics = True def intrinsics_case(name: str, args: str): return (name.lower(), args.lower()) if lowercase_intrinsics else (name, args) class Intrinsic(FortranObj): def __init__( self, name: str, type: int, doc_str: str | None = None, args: str = "", parent=None, ): self.name: str = name self.type: int = type self.doc_str: str | None = doc_str self.args: str = args.replace(" ", "") self.parent = parent self.file_ast: FortranAST = intrinsic_ast self.name, self.args = intrinsics_case(self.name, self.args) def get_type(self): return self.type def get_desc(self): if self.type == 2: return "SUBROUTINE" elif self.type == 14: return "KEYWORD" elif self.type == 15: return "STATEMENT" return "INTRINSIC" def get_snippet(self, name_replace=None, drop_arg=-1): if self.args == "": if self.type >= 14: return None, None arg_str = "()" arg_snip = None else: arg_list = self.args.split(",") arg_str, arg_snip = get_placeholders(arg_list) name = name_replace if name_replace is not None else self.name snippet = name + arg_snip if arg_snip is not None else None return name + arg_str, snippet def get_signature(self): arg_sigs = [{"label": arg} for arg in self.args.split(",")] call_sig, _ = self.get_snippet() return call_sig, self.doc_str, arg_sigs def get_hover(self, long=False): return None, self.doc_str def get_hover_md(self, long=False): msg, docs = self.get_hover(long) msg = msg or "" return fortran_md(msg, docs) def is_callable(self): return self.type == 2 def load_intrinsics(): def create_int_object(name: str, json_obj: dict, type: int): args = json_obj.get("args", "") doc_str = json_obj.get("doc") name, args = intrinsics_case(name, args) return Intrinsic(name, type, doc_str=doc_str, args=args) def create_object(json_obj: dict, enc_obj=None): intrinsic_ast.enc_scope_name = None if enc_obj is not None: intrinsic_ast.enc_scope_name = enc_obj.FQSN keywords = [] keyword_info = {} if "mods" in json_obj: keywords, keyword_info = map_keywords(json_obj["mods"]) name = json_obj["name"] args = json_obj.get("args", "") name, args = intrinsics_case(name, args) if json_obj["type"] == 0: # module, match "type": in JSON files mod_tmp = Module(intrinsic_ast, 0, name) if "use" in json_obj: mod_tmp.add_use(Use(json_obj["use"], line_number=0)) return mod_tmp elif json_obj["type"] == 1: # subroutine, match "type": in JSON files return Subroutine(intrinsic_ast, 0, name, args=args) elif json_obj["type"] == 2: # function, match "type": in JSON files return Function( intrinsic_ast, 0, name, args=args, result_type=json_obj["return"], keywords=keywords, ) elif json_obj["type"] == 3: # variable, match "type": in JSON files return Variable( intrinsic_ast, 0, name, json_obj["desc"], keywords, keyword_info ) elif json_obj["type"] == 4: # derived type, match "type": in JSON files return Type(intrinsic_ast, 0, name, keywords) else: raise ValueError def add_children(json_obj, fort_obj): for child in json_obj.get("children", []): child_obj = create_object(child, enc_obj=fort_obj) fort_obj.add_child(child_obj) add_children(child, child_obj) def load_statements(root: str): """Load the statements from the json file. Fortran statements taken from Intel Fortran documentation (https://www.intel.com/content/www/us/en/develop/documentation/fortran-compiler-oneapi-dev-guide-and-reference/top/language-reference/a-to-z-reference) Parameters ---------- root : str root location of the json file. Returns ------- dict statements dictionary """ json_file = os.path.join(root, "statements.json") statements = {"var_def": [], "int_stmnts": []} with open(json_file, encoding="utf-8") as fid: json_data = json.load(fid) for key in statements: for name, json_obj in sorted(json_data[key].items()): statements[key].append(create_int_object(name, json_obj, 15)) return statements def load_keywords(root: str): """Load the Fortran keywords from the json file. Fortran statements taken from Intel Fortran documentation (https://www.intel.com/content/www/us/en/develop/documentation/fortran-compiler-oneapi-dev-guide-and-reference/top/language-reference/a-to-z-reference) Parameters ---------- root : str root location of the json file. Returns ------- dict keywords dictionary """ json_file = os.path.join(root, "keywords.json") keywords = {"var_def": [], "arg": [], "type_mem": [], "vis": [], "param": []} with open(json_file, encoding="utf-8") as fid: json_data = json.load(fid) for key in keywords: for name, json_obj in sorted(json_data[key].items()): keywords[key].append(create_int_object(name, json_obj, 14)) return keywords def load_intrinsic_procedures(root: str): """Load Intrinsics procedure definitions, from gfortran (https://gcc.gnu.org/onlinedocs/gfortran/intrinsic-procedures.html) Parameters ---------- root : str root location of the json file. Returns ------- dict intrinsic procedures dictionary """ json_file = os.path.join(root, "intrinsic.procedures.markdown.json") with open(json_file, encoding="utf-8") as f: md_files = json.load(f) json_file = os.path.join(root, "intrinsic.procedures.json") intrinsic_procedures = [] with open(json_file, encoding="utf-8") as f: json_data = json.load(f) for name, json_obj in sorted(json_data.items()): # Replace the plain documentation with the Markdown if available if name in md_files: json_obj["doc"] = md_files[name] intrinsic_procedures.append( create_int_object(name, json_obj, json_obj["type"]) ) return intrinsic_procedures def load_intrinsic_modules(root: str): """Load Intrinsics procedure definitions, from gfortran (https://gcc.gnu.org/onlinedocs/gfortran/intrinsic-modules.html) Update OpenACC from here https://www.openacc.org/specification Parameters ---------- root : str root location of the json file. Returns ------- dict intrinsic modules dictionary """ json_file = os.path.join(root, "intrinsic.modules.json") intrinsic_modules = [] with open(json_file, encoding="utf-8") as fid: intrin_file = json.load(fid) for key, json_obj in intrin_file.items(): fort_obj = create_object(json_obj) add_children(json_obj, fort_obj) intrinsic_modules.append(fort_obj) return intrinsic_modules root = os.path.dirname(os.path.abspath(__file__)) statements = load_statements(root) keywords = load_keywords(root) intrinsic_procedures = load_intrinsic_procedures(root) intrinsic_modules = load_intrinsic_modules(root) return statements, keywords, intrinsic_procedures, intrinsic_modules def get_intrinsic_keywords(statements, keywords, context=-1): if context == 0: return statements["int_stmnts"] + statements["var_def"] + keywords["vis"] elif context == 1: return keywords["var_def"] + keywords["vis"] + keywords["param"] elif context == 2: return keywords["var_def"] + keywords["arg"] + keywords["param"] elif context == 3: return keywords["var_def"] + keywords["type_mem"] + keywords["vis"] return keywords["var_def"] + keywords["param"] def update_m_intrinsics(): try: files = glob.glob("M_intrinsics/md3/*.md") markdown_intrinsics = {} for f in sorted(files): key = f.replace("M_intrinsics/md3/", "") key = key.replace(".md", "").upper() # remove md extension val = Path(f).read_text() # remove manpage tag val = val.replace(f"**{key.lower()}**(3)", f"**{key.lower()}**") val = val.replace(f"**{key.upper()}**(3)", f"**{key.upper()}**") markdown_intrinsics[key] = val with open( Path(__file__).parent / "intrinsic.procedures.markdown.json", "w" ) as f: json.dump(markdown_intrinsics, f, indent=2) f.write("\n") # add newline at end of file except Exception as e: print(e) fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/keywords.json000066400000000000000000000060121477231266000265520ustar00rootroot00000000000000{ "var_def": { "ALLOCATABLE": { "doc": "Specifies that an object is allocatable." }, "ASYNCHRONOUS": { "doc": "Specifies that a variable can be used for asynchronous input and output." }, "BIND": { "doc": "Specifies that an object is interoperable with C and has external linkage." }, "CODIMENSION": { "doc": "Specifies that an entity is a coarray, and specifies its corank and cobounds, if any." }, "CONTIGUOUS": { "doc": "Specifies that the target of a pointer or an assumed-sized array is contiguous." }, "DIMENSION(:)": { "doc": "Specifies that an object is an array, and defines the shape of the array." }, "EXTERNAL": { "doc": "Allows an external procedure, a dummy procedure, a procedure pointer, or a block data subprogram to be used as an actual argument." }, "INTRINSIC": { "doc": "Allows the specific name of an intrinsic procedure to be used as an actual argument." }, "POINTER": { "doc": "Specifies that an object or a procedure is a pointer (a dynamic variable)." }, "PROTECTED": { "doc": "Specifies limitations on the use of module entities." }, "TARGET": { "doc": "Specifies that an object can become the target of a pointer (it can be pointed to)." }, "VOLATILE": { "doc": "Specifies that the value of an object is entirely unpredictable, based on information local to the current program unit. It prevents objects from being optimized during compilation." } }, "arg": { "INTENT(IN)": { "doc": "Specifies that the dummy argument will be used only to provide data to the procedure." }, "INTENT(OUT)": { "doc": "Specifies that the dummy argument will be used to pass data from the procedure back to the calling program." }, "INTENT(INOUT)": { "doc": "Specifies that the dummy argument can both provide data to the procedure and return data to the calling program." }, "OPTIONAL": { "doc": "Permits dummy arguments to be omitted in a procedure reference." }, "SAVE": { "doc": "Causes the values and definition of objects to be retained after execution of a RETURN or END statement in a subprogram." }, "VALUE": { "doc": "Specifies a type of argument association for a dummy argument." } }, "type_mem": { "DEFERRED": { "doc": "Indicates that the procedure is deferred. Deferred bindings must only be specified for derived-type definitions with the ABSTRACT attribute." }, "NON_OVERRIDABLE": { "doc": "Determines whether a binding can be overridden in an extended type. You must not specify NON_OVERRIDABLE for a binding with the DEFERRED attribute." }, "NOPASS": { "doc": "Indicate that the procedure has no passed-object dummy argument." }, "PASS": { "doc": "Indicates that the procedure has no passed-object dummy argument.", "args": "arg_name" } }, "vis": { "PRIVATE": {}, "PUBLIC": {} }, "param": { "PARAMETER": {} } } fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/method.py000066400000000000000000000120161477231266000256430ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from fortls.constants import CLASS_TYPE_ID, KEYWORD_ID_DICT, METH_TYPE_ID from fortls.helper_functions import get_paren_substring from .utilities import find_in_scope from .variable import Variable if TYPE_CHECKING: from .ast import FortranAST class Method(Variable): # i.e. TypeBound procedure def __init__( self, file_ast: FortranAST, line_number: int, name: str, var_desc: str, keywords: list, keyword_info: dict, proc_ptr: str = "", # procedure pointer e.g. `foo` in `procedure(foo)` link_obj=None, ): super().__init__( file_ast, line_number, name, var_desc, keywords, keyword_info, kind=proc_ptr, link_obj=link_obj, ) self.drop_arg: int = -1 self.pass_name: str = keyword_info.get("pass") if link_obj is None: self.link_name = get_paren_substring(self.get_desc(True).lower()) def set_parent(self, parent_obj): self.parent = parent_obj if self.parent.get_type() == CLASS_TYPE_ID: if self.keywords.count(KEYWORD_ID_DICT["nopass"]) == 0: self.drop_arg = 0 if ( (self.parent.contains_start is not None) and (self.sline > self.parent.contains_start) and (self.link_name is None) ): self.link_name = self.name.lower() def get_snippet(self, name_replace=None, drop_arg=-1): if self.link_obj is not None: name = self.name if name_replace is None else name_replace return self.link_obj.get_snippet(name, self.drop_arg) return None, None def get_type(self, no_link=False): if (not no_link) and (self.link_obj is not None): return self.link_obj.get_type() # Generic return METH_TYPE_ID def get_documentation(self): if (self.link_obj is not None) and (self.doc_str is None): return self.link_obj.get_documentation() return self.doc_str def get_hover(self, long=False, drop_arg=-1) -> tuple[str, str]: docs = self.get_documentation() # Long hover message if self.link_obj is None: sub_sig, _ = self.get_snippet() hover_str = f"{self.get_desc()} {sub_sig}" else: link_msg, link_docs = self.link_obj.get_hover( long=True, drop_arg=self.drop_arg ) # Replace the name of the linked object with the name of this object hover_str = link_msg.replace(self.link_obj.name, self.name, 1) if isinstance(link_docs, str): # Get just the docstring of the link, if any, no args link_doc_top = self.link_obj.get_documentation() # Replace the linked objects topmost documentation with the # documentation of the procedure pointer if one is present if link_doc_top is not None: docs = link_docs.replace(link_doc_top, docs, 1) # If no top docstring is present at the linked object but there # are docstrings for the arguments, add them to the end of the # documentation for this object elif link_docs: if docs is None: docs = "" docs += " \n" + link_docs return hover_str, docs def get_signature(self, drop_arg=-1): if self.link_obj is not None: call_sig, _ = self.get_snippet() _, _, arg_sigs = self.link_obj.get_signature(self.drop_arg) return call_sig, self.get_documentation(), arg_sigs return None, None, None def get_interface(self, name_replace=None, drop_arg=-1, change_strings=None): if self.link_obj is not None: return self.link_obj.get_interface( name_replace, self.drop_arg, change_strings ) return None def resolve_link(self, obj_tree): if self.link_name is None: return if self.parent is not None: if self.parent.get_type() == CLASS_TYPE_ID: link_obj = find_in_scope(self.parent.parent, self.link_name, obj_tree) else: link_obj = find_in_scope(self.parent, self.link_name, obj_tree) if link_obj is not None: self.link_obj = link_obj if self.pass_name is not None: self.pass_name = self.pass_name.lower() for i, arg in enumerate(link_obj.args_snip.split(",")): if arg.lower() == self.pass_name: self.drop_arg = i break def is_callable(self): return True def check_definition(self, obj_tree, known_types=None, interface=False): if known_types is None: known_types = {} return None, known_types fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/module.py000066400000000000000000000010051477231266000256440ustar00rootroot00000000000000from __future__ import annotations from fortls.constants import MODULE_TYPE_ID from .scope import Scope class Module(Scope): def get_type(self, no_link=False): return MODULE_TYPE_ID def get_desc(self): return "MODULE" def get_hover(self, long=False, drop_arg=-1) -> tuple[str, str]: hover = f"{self.get_desc()} {self.name}" doc_str = self.get_documentation() return hover, doc_str def check_valid_parent(self) -> bool: return self.parent is None fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/parser.py000066400000000000000000002503611477231266000256660ustar00rootroot00000000000000from __future__ import annotations import hashlib import logging import os import re import sys from collections import Counter, deque # Python < 3.8 does not have typing.Literals try: from typing import Literal except ImportError: from typing_extensions import Literal from re import Match, Pattern from fortls.constants import ( DO_TYPE_ID, INTERFACE_TYPE_ID, SELECT_TYPE_ID, SUBMODULE_TYPE_ID, FRegex, Severity, log, ) from fortls.ftypes import ( ClassInfo, FunSig, GenProcDefInfo, InterInfo, Range, ResultSig, SelectInfo, SmodInfo, SubInfo, VarInfo, VisInfo, ) from fortls.helper_functions import ( detect_fixed_format, find_paren_match, find_word_in_line, get_paren_level, get_paren_substring, map_keywords, separate_def_list, strip_line_label, strip_strings, ) from .associate import Associate from .ast import FortranAST from .block import Block from .do import Do from .enum import Enum from .function import Function from .if_block import If from .imports import Import, ImportTypes from .interface import Interface from .method import Method from .module import Module from .program import Program from .scope import Scope from .select import Select from .submodule import Submodule from .subroutine import Subroutine from .type import Type from .use import Use from .variable import Variable from .where import Where def get_line_context(line: str) -> tuple[str, None] | tuple[str, str]: """Get context of ending position in line (for completion) Parameters ---------- line : str file line Returns ------- tuple[str, None] Possible string values: `var_key`, `pro_line`, `var_only`, `mod_mems`, `mod_only`, `pro_link`, `skip`, `import`, `vis`, `call`, `type_only`, `int_only`, `first`, `default` """ last_level, sections = get_paren_level(line) lev1_end = sections[-1].end # Test if variable definition statement test_match = read_var_def(line) if test_match is not None: if test_match[0] == "var": if (test_match[1].var_names is None) and (lev1_end == len(line)): return "var_key", None # Procedure link? if (test_match[1].var_type == "PROCEDURE") and (line.find("=>") > 0): return "pro_link", None return "var_only", None # Test if in USE statement test_match = read_use_stmt(line) if test_match is not None: if len(test_match[1].only_list) > 0: return "mod_mems", test_match[1].mod_name else: return "mod_only", None # Test for interface procedure link if FRegex.PRO_LINK.match(line): return "pro_link", None # Test if scope declaration or end statement (no completion provided) if FRegex.SCOPE_DEF.match(line) or FRegex.END.match(line): return "skip", None # Test if import statement if FRegex.IMPORT.match(line): return "import", None # Test if visibility statement if FRegex.VIS.match(line): return "vis", None # In type-def type_def = False if FRegex.TYPE_DEF.match(line): type_def = True # Test if in call statement if (lev1_end == len(line)) and FRegex.CALL.match(last_level): return "call", None # Test if variable definition using type/class or procedure if (len(sections) == 1) and (sections[0].start >= 1): # Get string one level up test_str, _ = get_paren_level(line[: sections[0].start - 1]) if FRegex.TYPE_STMNT.match(test_str) or ( type_def and FRegex.EXTENDS.search(test_str) ): return "type_only", None if FRegex.PROCEDURE_STMNT.match(test_str): return "int_only", None # Only thing on line? if FRegex.INT_STMNT.match(line): return "first", None # Default or skip context if type_def: return "skip", None else: return "default", None def parse_var_keywords(test_str: str) -> tuple[list[str], str]: """Parse Fortran variable declaration keywords""" # Needs to be this way and not simply call finditer because no regex can # capture nested parenthesis keyword_match = FRegex.KEYWORD_LIST.match(test_str) keywords = [] while keyword_match: tmp_str = re.sub(r"^[, ]*", "", keyword_match.group(0)) test_str = test_str[keyword_match.end(0) :] if tmp_str.lower().startswith("dimension"): match_char = find_paren_match(test_str) if match_char < 0: break # Incomplete dimension statement else: tmp_str += test_str[: match_char + 1] test_str = test_str[match_char + 1 :] tmp_str = re.sub(r"^[, ]*", "", tmp_str) keywords.append(tmp_str.strip().upper()) keyword_match = FRegex.KEYWORD_LIST.match(test_str) return keywords, test_str def read_var_def(line: str, var_type: str | None = None, fun_only: bool = False): """Attempt to read variable definition line""" def parse_kind(line: str): match = FRegex.KIND_SPEC.match(line) if not match: return None, line kind_str = match.group(1).replace(" ", "") line = line[match.end(0) :] if kind_str.find("(") >= 0: match_char = find_paren_match(line) if match_char < 0: # this triggers while typing with autocomplete raise ValueError("Incomplete kind specification") kind_str += line[: match_char + 1].strip() line = line[match_char + 1 :] return kind_str, line if var_type is None: type_match = FRegex.VAR.match(line) if type_match is None: return None var_type = type_match.group(0).strip() trailing_line = line[type_match.end(0) :] else: trailing_line = line[len(var_type) :] var_type = var_type.upper() trailing_line = trailing_line.split("!")[0] if len(trailing_line) == 0: return None # Parse the global kind, if any, for the current line definition # The global kind in some cases, like characters can be overriden by a locally # defined kind try: kind_str, trailing_line = parse_kind(trailing_line) except ValueError: return None # Class and Type statements need a kind spec if not kind_str and var_type in ("TYPE", "CLASS"): return None # Make sure next character is space or comma or colon if not kind_str and not trailing_line[0] in (" ", ",", ":"): return None keywords, trailing_line = parse_var_keywords(trailing_line) # Check if this is a function definition fun_def = read_fun_def( trailing_line, ResultSig(type=var_type, keywords=keywords, kind=kind_str), ) if fun_def or fun_only: return fun_def # Split the type and variable name line_split = trailing_line.split("::") if len(line_split) == 1: if len(keywords) > 0: var_words = None else: trailing_line = line_split[0] var_words = separate_def_list(trailing_line.strip()) else: trailing_line = line_split[1] var_words = separate_def_list(trailing_line.strip()) if var_words is None: var_words = [] return "var", VarInfo( var_type=var_type, keywords=keywords, var_names=var_words, var_kind=kind_str, ) def get_procedure_modifiers( line: str, regex: Pattern ) -> tuple[str, str, str] | tuple[None, None, None]: """Attempt to match procedure modifiers for FUNCTIONS and SUBROUTINES Parameters ---------- line : str document line regex : Pattern regular expression to use e.g. Function or Subroutine sig Returns ------- tuple[str, str, str] | tuple[None, None, None] procedure name, arguments, trailing line """ match = regex.match(line) if match is None: return None, None, None name: str = match.group(1) trailing_line = line[match.end(0) :].split("!")[0] trailing_line = trailing_line.strip() paren_match = FRegex.SUB_PAREN.match(trailing_line) args = "" if paren_match is not None: word_match = FRegex.WORD.findall(paren_match.group(0)) if word_match is not None: word_match = [word for word in word_match] args = ",".join(word_match) trailing_line = trailing_line[paren_match.end(0) :] return name, args, trailing_line def read_fun_def( line: str, result: ResultSig = None, mod_flag: bool = False ) -> tuple[Literal["fun"], FunSig] | None: """Attempt to read FUNCTION definition line To infer the `result` `type` and `name` the variable definition is called with the function only flag Parameters ---------- line : str file line result : RESULT_sig, optional a dataclass containing the result signature of the function mod_flag : bool, optional flag for module and module procedure parsing, by default False Returns ------- tuple[Literal["fun"], FUN_sig] | None a named tuple """ # Get all the keyword modifier mathces keywords = re.findall(FRegex.SUB_MOD, line) # remove modifiers from line line = re.sub(FRegex.SUB_MOD, "", line) # Try and get the result type # Recursively will call read_var_def which will then call read_fun_def # with the variable result having been populated if keywords: tmp_var = read_var_def(line, fun_only=True) if tmp_var is not None: # Update keywords for function into dataclass tmp_var[1].keywords = keywords return tmp_var name, args, trailing_line = get_procedure_modifiers(line, FRegex.FUN) if name is None: return None # Extract if possible the variable name of the result() trailing_line = trailing_line.strip() results_match = FRegex.RESULT.match(trailing_line) if result is None: result = ResultSig() if results_match: result.name = results_match.group(1).strip().lower() return "fun", FunSig(name, args, keywords, mod_flag, result) def read_sub_def( line: str, mod_flag: bool = False ) -> tuple[Literal["sub"], SubInfo] | None: """Attempt to read a SUBROUTINE definition line Parameters ---------- line : str document line mod_flag : bool, optional flag for module and module procedure parsing, by default False Returns ------- tuple[Literal["sub"], SUB_info] | None a SUB_info dataclass object """ # Get all the keyword modifier matches keywords = re.findall(FRegex.SUB_MOD, line) # remove modifiers from line line = re.sub(FRegex.SUB_MOD, "", line) name, args, _ = get_procedure_modifiers(line, FRegex.SUB) if name is None: return None return "sub", SubInfo(name, args, keywords, mod_flag) def read_block_def(line: str) -> tuple[Literal["block"], str] | None: """Attempt to read BLOCK definition line""" block_match = FRegex.BLOCK.match(line) if block_match: name: str = block_match.group(1) if name: name = name.replace(":", " ").strip() return "block", name return None def read_do_def(line: str) -> tuple[Literal["do"], str] | None: """Attempt to read a DO loop Returns ------- tuple[Literal["do"], str] | None Tuple with "do" and a fixed format tag if present """ line_stripped = strip_strings(line, maintain_len=True) line_no_comment = line_stripped.split("!")[0].rstrip() do_match = FRegex.DO.match(line_no_comment) if do_match: return "do", do_match.group(1).strip() return None def read_where_def(line: str) -> tuple[Literal["where"], bool] | None: """Attempt to read a WHERE block Returns ------- tuple[Literal["where"], bool] | None Tuple with "where" and a boolean indicating if labelled on unlabelled """ line_stripped = strip_strings(line, maintain_len=True) line_no_comment = line_stripped.split("!")[0].rstrip() # Match WHERE blocks where_match = FRegex.WHERE.match(line_no_comment) if where_match: trailing_line = line[where_match.end(0) :] close_paren = find_paren_match(trailing_line) if close_paren < 0: return "where", True if FRegex.WORD.match(trailing_line[close_paren + 1 :].strip()): return "where", True else: return "where", False return None def read_if_def(line: str) -> tuple[Literal["if"], None] | None: """Attempt to read an IF conditional Returns ------- tuple[Literal["if"], None] | None A Literal "if" and None tuple """ line_stripped = strip_strings(line, maintain_len=True) line_no_comment = line_stripped.split("!")[0].rstrip() if FRegex.IF.match(line_no_comment) and FRegex.THEN.search(line_no_comment): return "if", None return None def read_associate_def(line: str): assoc_match = FRegex.ASSOCIATE.match(line) if assoc_match is not None: trailing_line = line[assoc_match.end(0) :] match_char = find_paren_match(trailing_line) if match_char < 0: return "assoc", [] var_words = separate_def_list(trailing_line[:match_char].strip()) return "assoc", var_words def read_select_def(line: str): """Attempt to read SELECT definition line""" select_match = FRegex.SELECT.match(line) select_desc = None select_binding = None if select_match is None: select_type_match = FRegex.SELECT_TYPE.match(line) if select_type_match is None: select_default_match = FRegex.SELECT_DEFAULT.match(line) if select_default_match is None: return None else: return "select", SelectInfo(4, None, None) select_type = 3 select_desc = select_type_match.group(1).upper() select_binding = select_type_match.group(2) else: select_word = select_match.group(1) select_type = -1 if select_word.lower().startswith("case"): select_type = 1 elif select_word.lower().startswith("type"): select_type = 2 select_binding = select_match.group(2) return "select", SelectInfo(select_type, select_binding, select_desc) def read_type_def(line: str): """Attempt to read TYPE definition line""" type_match = FRegex.TYPE_DEF.match(line) if type_match is None: return None trailing_line = line[type_match.end(1) :].split("!")[0] trailing_line = trailing_line.strip() # Parse keywords keyword_match = FRegex.TATTR_LIST.match(trailing_line) keywords: list[str] = [] parent = None while keyword_match: keyword_strip = keyword_match.group(0).replace(",", " ").strip().upper() extend_match = FRegex.EXTENDS.match(keyword_strip) if extend_match: parent = extend_match.group(1).lower() else: keywords.append(keyword_strip) # Get visibility and/or extends/abstract modifiers trailing_line = trailing_line[keyword_match.end(0) :] keyword_match = FRegex.TATTR_LIST.match(trailing_line) # Get name line_split = trailing_line.split("::") if len(line_split) == 1: if len(keywords) > 0 and parent is None: return None else: if trailing_line.split("(")[0].strip().lower() == "is": return None trailing_line = line_split[0] else: trailing_line = line_split[1] # word_match = FRegex.WORD.match(trailing_line.strip()) if word_match: name: str = word_match.group(0) else: return None # return "typ", ClassInfo(name, parent, keywords) def read_enum_def(line: str): """Attempt to read ENUM definition line""" if FRegex.ENUM_DEF.match(line): return "enum", None return None def read_generic_def(line: str): """Attempt to read generic procedure definition line""" generic_match = FRegex.GENERIC_PRO.match(line) if generic_match is None: return None # trailing_line = line[generic_match.end(0) - 1 :].split("!")[0].strip() if len(trailing_line) == 0: return None # Set visibility if generic_match.group(2) is None: vis_flag = 0 else: if generic_match.group(2).lower() == "private": vis_flag = -1 else: vis_flag = 1 # i1 = trailing_line.find("=>") if i1 < 0: return None bound_name: str = trailing_line[:i1].strip() if FRegex.GEN_ASSIGN.match(bound_name): return None pro_list = trailing_line[i1 + 2 :].split(",") # pro_out: list[str] = [] for bound_pro in pro_list: if len(bound_pro.strip()) > 0: pro_out.append(bound_pro.strip()) if len(pro_out) == 0: return None # return "gen", GenProcDefInfo(bound_name, pro_out, vis_flag) def read_mod_def(line: str): """Attempt to read MODULE and MODULE PROCEDURE, MODULE FUNCTION definition lines""" # Get all the keyword modifier mathces keywords = re.findall(FRegex.SUB_MOD, line) # remove modifiers from line line = re.sub(FRegex.SUB_MOD, "", line) mod_match = FRegex.MOD.match(line) if mod_match is None: return None name = mod_match.group(1) if name.lower() == "procedure": trailing_line = line[mod_match.end(1) :] pro_names = [] line_split = trailing_line.split(",") for name in line_split: pro_names.append(name.strip().lower()) return "int_pro", pro_names # Check for submodule definition trailing_line = line[mod_match.start(1) :] # module procedure sub_res = read_sub_def(trailing_line, mod_flag=True) if sub_res is not None: return sub_res # module function fun_res = read_var_def(trailing_line, fun_only=True) if fun_res is not None: fun_res[1].mod_flag = True fun_res[1].keywords = keywords return fun_res fun_res = read_fun_def(trailing_line, mod_flag=True) if fun_res is not None: fun_res[1].keywords = keywords return fun_res return "mod", name def read_submod_def(line: str): """Attempt to read SUBMODULE definition line""" submod_match = FRegex.SUBMOD.match(line) if submod_match is None: return None parent_name: str = "" name: str = "" trailing_line = line[submod_match.end(0) :].split("!")[0] trailing_line = trailing_line.strip() parent_match = FRegex.WORD.match(trailing_line) if parent_match: parent_name = parent_match.group(0).lower() if len(trailing_line) > parent_match.end(0) + 1: trailing_line = trailing_line[parent_match.end(0) + 1 :].strip() else: trailing_line = "" name_match = FRegex.WORD.search(trailing_line) if name_match: name = name_match.group(0).lower() return "smod", SmodInfo(name, parent_name) def read_prog_def(line: str) -> tuple[Literal["prog"], str] | None: """Attempt to read PROGRAM definition line""" prog_match = FRegex.PROG.match(line) if prog_match is None: return None return "prog", prog_match.group(1) def read_int_def(line: str) -> tuple[Literal["int"], InterInfo] | None: """Attempt to read INTERFACE definition line""" int_match = FRegex.INT.match(line) if int_match is None: return None int_name = int_match.group(2).lower() is_abstract = int_match.group(1) is not None if int_name == "": return "int", InterInfo(None, is_abstract) if int_name == "assignment" or int_name == "operator": return "int", InterInfo(None, False) return "int", InterInfo(int_match.group(2), is_abstract) def read_use_stmt(line: str) -> tuple[Literal["use"], Use] | None: """Attempt to read USE statement""" use_match = FRegex.USE.match(line) if use_match is None: return None trailing_line = line[use_match.end(0) :].lower().split("!")[0] use_mod = use_match.group(2) only_list: set[str] = set() rename_map: dict[str, str] = {} if use_match.group(3): for only_stmt in trailing_line.split(","): only_split = only_stmt.split("=>") only_name = only_split[0].strip() only_list.add(only_name) if len(only_split) == 2: rename_map[only_name] = only_split[1].strip() return "use", Use(use_mod, only_list, rename_map) def read_imp_stmt(line: str) -> tuple[Literal["import"], Import] | None: """Attempt to read IMPORT statement""" import_match = FRegex.IMPORT.match(line) if import_match is None: return None import_type = import_match.groupdict() is_empty = all(value is None for value in import_type.values()) # import # import, all if is_empty or (import_type["spec"] and import_type["spec"].lower() == "all"): return "import", Import("#import", ImportTypes.ALL) # import, none elif import_type["spec"] and import_type["spec"].lower() == "none": return "import", Import("#import", ImportTypes.NONE) # import, only: a, b, c # import :: a, b, c # import a, b, c trailing_line = line[import_match.end(0) - 1 :].lower() import_list = {import_obj.strip() for import_obj in trailing_line.split(",")} return "import", Import("#import", ImportTypes.ONLY, import_list) def read_inc_stmt(line: str) -> tuple[Literal["inc"], str] | None: """Attempt to read INCLUDE statement""" inc_match = FRegex.INCLUDE.match(line) if inc_match is None: return None inc_path: str = inc_match.group(1) return "inc", inc_path def read_vis_stmnt(line: str) -> tuple[Literal["vis"], VisInfo] | None: """Attempt to read PUBLIC/PRIVATE statement""" vis_match = FRegex.VIS.match(line) if vis_match is None: return None vis_type = 0 if vis_match.group(1).lower() == "private": vis_type = 1 trailing_line = line[vis_match.end(0) :].split("!")[0] mod_words = FRegex.WORD.findall(trailing_line) return "vis", VisInfo(vis_type, mod_words) def_tests = [ read_var_def, read_sub_def, read_fun_def, read_block_def, read_where_def, read_do_def, read_if_def, read_associate_def, read_select_def, read_type_def, read_enum_def, read_use_stmt, read_imp_stmt, read_int_def, read_generic_def, read_mod_def, read_prog_def, read_submod_def, read_inc_stmt, read_vis_stmnt, ] def find_external_type(file_ast: FortranAST, desc_string: str, name: str) -> bool: """Encountered a variable with EXTERNAL as its type Try and find an already defined variable with a NORMAL Fortran Type""" if not desc_string.upper() == "EXTERNAL": return False counter = 0 # Definition without EXTERNAL has already been parsed for v in file_ast.variable_list: if name == v.name: # If variable is already in external objs it has # been parsed correctly so exit if v in file_ast.external_objs: return False v.set_external_attr() file_ast.external_objs.append(v) counter += 1 # TODO: do I need to update AST any more? if counter == 1: return True else: return False def find_external_attr(file_ast: FortranAST, name: str, new_var: Variable) -> bool: """Check if this NORMAL Fortran variable is in the external_objs with only ``EXTERNAL`` as its type. Used to detect seperated ``EXTERNAL`` declarations. Parameters ---------- file_ast : fortran_ast AST file name : str Variable name, stripped new_var : fortran_var Fortran variable to check against Returns ------- bool True if only a single ``EXTERNAL`` definition is encountered False for everything else, which will cause a diagnostic error to be raised """ counter = 0 for v in file_ast.external_objs: if v.name != name: continue if v.desc.upper() != "EXTERNAL": continue # We do this once if counter == 0: v.desc = new_var.desc v.set_external_attr() # TODO: do i need to update AST any more? counter += 1 # Only one definition encountered if counter == 1: return True # If no variable or multiple variables add to AST. # Multiple defs will throw diagnostic error as it should else: return False def find_external( file_ast: FortranAST, desc_string: str, name: str, new_var: Variable, ) -> bool: """Find a procedure, function, subroutine, etc. that has been defined as ``EXTERNAL``. ``EXTERNAL``s are parsed as ``fortran_var``, since there is no way of knowing if ``real, external :: val`` is a function or a subroutine. This method exists solely for ``EXTERNAL`` s that are defined across multiple lines e.g. .. code-block:: fortran EXTERNAL VAR REAL VAR or .. code-block:: fortran REAL VAR EXTERNAL VAR Parameters ---------- file_ast : fortran_ast AST desc_string : str Variable type e.g. ``REAL``, ``INTEGER``, ``EXTERNAL`` name : str Variable name new_var : fortran_var The line variable that we are attempting to match with an ``EXTERNAL`` definition Returns ------- bool True if the variable is ``EXTERNAL`` and we manage to link it to the rest of its components, else False """ if find_external_type(file_ast, desc_string, name): return True elif desc_string.upper() != "EXTERNAL": if find_external_attr(file_ast, name, new_var): return True return False def splitlines(text: str) -> list[str]: """Split text into lines by \r\n, \n, or \r""" return re.split(r"\n|\r\n?", text) class FortranFile: def __init__(self, path: str = None, pp_suffixes: list = None): self.path: str = path self.contents_split: list[str] = [] self.contents_pp: list[str] = [] self.pp_defs: dict = {} self.nLines: int = 0 self.fixed: bool = False self.preproc: bool = False self.ast: FortranAST = None self.hash: str = None if path: _, file_ext = os.path.splitext(os.path.basename(path)) if pp_suffixes: self.preproc = file_ext in pp_suffixes else: self.preproc = file_ext == file_ext.upper() self.COMMENT_LINE_MATCH, self.DOC_COMMENT_MATCH = self.get_comment_regexs() def copy(self) -> FortranFile: """Copy content to new file object (does not copy objects)""" copy_obj = FortranFile(self.path) copy_obj.preproc = self.preproc copy_obj.fixed = self.fixed copy_obj.contents_pp = self.contents_pp copy_obj.contents_split = self.contents_split copy_obj.pp_defs = self.pp_defs copy_obj.set_contents(self.contents_split) return copy_obj def load_from_disk(self) -> tuple[str | None, bool | None]: """Read file from disk or update file contents only if they have changed A MD5 hash is used to determine that Returns ------- tuple[str|None, bool|None] ``str`` : string containing IO error message else None ``bool``: boolean indicating if the file has changed """ contents: str try: with open(self.path, encoding="utf-8", errors="replace") as f: contents = re.sub(r"\t", r" ", f.read()) except OSError: return "Could not read/decode file", None else: # Check if files are the same try: hash = hashlib.md5( contents.encode("utf-8"), usedforsecurity=False ).hexdigest() # Python <=3.8 does not have the `usedforsecurity` option except TypeError: hash = hashlib.md5(contents.encode("utf-8")).hexdigest() if hash == self.hash: return None, False self.hash = hash self.contents_split = splitlines(contents) self.fixed = detect_fixed_format(self.contents_split) self.contents_pp = self.contents_split self.nLines = len(self.contents_split) return None, True def apply_change(self, change: dict) -> bool: """Apply a change to the file.""" def check_change_reparse(line_no: int) -> bool: if (line_no < 0) or (line_no > self.nLines - 1): return True pre_lines, curr_line, _ = self.get_code_line(line_no, forward=False) # Skip comment lines if self.fixed: if FRegex.FIXED_COMMENT.match(curr_line): return False else: if FRegex.FREE_COMMENT.match(curr_line): return False # Check for line labels and semicolons full_line = "".join(pre_lines) + curr_line full_line, line_label = strip_line_label(full_line) if line_label is not None: return True line_stripped = strip_strings(full_line, maintain_len=True) if line_stripped.find(";") >= 0: return True # Find trailing comments comm_ind = line_stripped.find("!") if comm_ind >= 0: line_no_comment = full_line[:comm_ind] else: line_no_comment = full_line # Various single line tests if FRegex.END_WORD.match(line_no_comment): return True if FRegex.IMPLICIT.match(line_no_comment): return True if FRegex.CONTAINS.match(line_no_comment): return True # Generic "non-definition" line if FRegex.NON_DEF.match(line_no_comment): return False # Loop through tests for test in def_tests: if test(line_no_comment): return True return False self.hash = None text = change.get("text", "") change_range = change.get("range") if len(text) == 0: text_split = [""] else: text_split = splitlines(text) # Check for ending newline if (text[-1] == "\n") or (text[-1] == "\r"): text_split.append("") if change_range is None: # The whole file has changed self.set_contents(text_split) return True start_line = change_range["start"]["line"] start_col = change_range["start"]["character"] end_line = change_range["end"]["line"] end_col = change_range["end"]["character"] # Check for an edit occurring at the very end of the file if start_line == self.nLines: self.set_contents(self.contents_split + text_split) return True # Check for single line edit if (start_line == end_line) and (len(text_split) == 1): prev_line = self.contents_split[start_line] self.contents_split[start_line] = ( prev_line[:start_col] + text + prev_line[end_col:] ) self.contents_pp[start_line] = self.contents_split[start_line] return check_change_reparse(start_line) # Apply standard change to document new_contents = [] for i, line in enumerate(self.contents_split): if (i < start_line) or (i > end_line): new_contents.append(line) continue if i == start_line: for j, change_line in enumerate(text_split): if j == 0: new_contents.append(line[:start_col] + change_line) else: new_contents.append(change_line) if i == end_line: new_contents[-1] += line[end_col:] self.set_contents(new_contents) return True def set_contents(self, contents_split: list, detect_format: bool = True): """Set file contents""" self.contents_split = contents_split self.contents_pp = self.contents_split self.nLines = len(self.contents_split) if detect_format: self.fixed = detect_fixed_format(self.contents_split) def get_line(self, line_no: int, pp_content: bool = False) -> str: """Get single line from file""" try: if pp_content: return self.contents_pp[line_no] return self.contents_split[line_no] except (TypeError, IndexError): return None def get_code_line( self, line_no: int, forward: bool = True, backward: bool = True, pp_content: bool = False, strip_comment: bool = False, ) -> tuple[list[str], str, list[str]]: """Get full code line from file including any adjacent continuations""" curr_line = self.get_line(line_no, pp_content) if curr_line is None: return [], None, [] # Search backward for prefix lines line_ind = line_no - 1 pre_lines = [] if backward: if self.fixed: # Fixed format file tmp_line = curr_line while line_ind > 0: if FRegex.FIXED_CONT.match(tmp_line): prev_line = tmp_line tmp_line = self.get_line(line_ind, pp_content) if line_ind == line_no - 1: curr_line = " " * 6 + curr_line[6:] else: pre_lines[-1] = " " * 6 + prev_line[6:] pre_lines.append(tmp_line) else: break line_ind -= 1 else: # Free format file opt_cont_match = FRegex.FREE_CONT.match(curr_line) if opt_cont_match: curr_line = ( " " * opt_cont_match.end(0) + curr_line[opt_cont_match.end(0) :] ) while line_ind > 0: tmp_line = strip_strings( self.get_line(line_ind, pp_content), maintain_len=True ) tmp_no_comm = tmp_line.split("!")[0] cont_ind = tmp_no_comm.rfind("&") opt_cont_match = FRegex.FREE_CONT.match(tmp_no_comm) if opt_cont_match: if cont_ind == opt_cont_match.end(0) - 1: break tmp_no_comm = ( " " * opt_cont_match.end(0) + tmp_no_comm[opt_cont_match.end(0) :] ) if cont_ind >= 0: pre_lines.append(tmp_no_comm[:cont_ind]) else: break line_ind -= 1 # Search forward for trailing lines with continuations line_ind = line_no + 1 post_lines = [] if forward: if self.fixed: if line_ind < self.nLines: next_line = self.get_line(line_ind, pp_content) line_ind += 1 cont_match = FRegex.FIXED_CONT.match(next_line) while (cont_match is not None) and (line_ind < self.nLines): post_lines.append(" " * 6 + next_line[6:]) next_line = self.get_line(line_ind, pp_content) line_ind += 1 cont_match = FRegex.FIXED_CONT.match(next_line) else: line_stripped = strip_strings(curr_line, maintain_len=True) iAmper = line_stripped.find("&") iComm = line_stripped.find("!") if iComm < 0: iComm = iAmper + 1 next_line = "" # Read the next line if needed while (iAmper >= 0) and (iAmper < iComm): if line_ind == line_no + 1: curr_line = curr_line[:iAmper] elif next_line != "": post_lines[-1] = next_line[:iAmper] next_line = self.get_line(line_ind, pp_content) if next_line is None: break line_ind += 1 # Skip any preprocessor statements when seeking the next line if FRegex.PP_ANY.match(next_line): next_line = "" post_lines.append("") continue # Skip empty or comment lines match = FRegex.FREE_COMMENT.match(next_line) if next_line.rstrip() == "" or match: next_line = "" post_lines.append("") continue opt_cont_match = FRegex.FREE_CONT.match(next_line) if opt_cont_match: next_line = next_line[opt_cont_match.end(0) :] post_lines.append(next_line) line_stripped = strip_strings(next_line, maintain_len=True) iAmper = line_stripped.find("&") iComm = line_stripped.find("!") if iComm < 0: iComm = iAmper + 1 # Detect start of comment in current line if strip_comment: curr_line = self.strip_comment(curr_line) pre_lines.reverse() return pre_lines, curr_line, post_lines def strip_comment(self, line: str) -> str: """Strip comment from line""" if self.fixed: if FRegex.FIXED_COMMENT.match(line) and not FRegex.FIXED_OPENMP.match(line): return "" else: if FRegex.FREE_OPENMP.match(line) is None: line = line.split("!")[0] return line def find_word_in_code_line( self, line_no: int, word: str, forward: bool = True, backward: bool = False, pp_content: bool = False, ) -> tuple[int, Range]: back_lines, curr_line, forward_lines = self.get_code_line( line_no, forward=forward, backward=backward, pp_content=pp_content ) word_range = Range(-1, -1) if curr_line is not None: find_word_lower = word.lower() word_range = find_word_in_line(curr_line.lower(), find_word_lower) if backward and (word_range.start < 0): back_lines.reverse() for i, line in enumerate(back_lines): word_range = find_word_in_line(line.lower(), find_word_lower) if word_range.start >= 0: line_no -= i + 1 return line_no, word_range if forward and (word_range.start < 0): for i, line in enumerate(forward_lines): word_range = find_word_in_line(line.lower(), find_word_lower) if word_range.start >= 0: line_no += i + 1 return line_no, word_range return line_no, word_range def preprocess( self, pp_defs: dict = None, include_dirs: set = None, debug: bool = False ) -> tuple[list, list]: if pp_defs is None: pp_defs = {} if include_dirs is None: include_dirs = set() self.contents_pp, pp_skips, pp_defines, self.pp_defs = preprocess_file( self.contents_split, self.path, pp_defs=pp_defs, include_dirs=include_dirs, debug=debug, ) return pp_skips, pp_defines def check_file(self, obj_tree, max_line_length=-1, max_comment_line_length=-1): diagnostics = [] if (max_line_length > 0) or (max_comment_line_length > 0): msg_line = f'Line length exceeds "max_line_length" ({max_line_length})' msg_comment = ( 'Comment line length exceeds "max_comment_line_length"' f" ({max_comment_line_length})" ) if self.fixed: COMMENT_LINE_MATCH = FRegex.FIXED_COMMENT else: COMMENT_LINE_MATCH = FRegex.FREE_COMMENT for i, line in enumerate(self.contents_split): if COMMENT_LINE_MATCH.match(line) is None: if 0 < max_line_length < len(line): self.ast.add_error( msg_line, Severity.warn, i + 1, max_line_length, len(line) ) else: if 0 < max_comment_line_length < len(line): self.ast.add_error( msg_comment, Severity.warn, i + 1, max_comment_line_length, len(line), ) errors, diags_ast = self.ast.check_file(obj_tree) diagnostics += diags_ast for error in errors: diagnostics.append(error.build(self)) return diagnostics def parse( self, debug: bool = False, pp_defs: dict = None, include_dirs: set = None, ) -> FortranAST: """Parse Fortran file contents of a fortran_file object and build an Abstract Syntax Tree (AST) Parameters ---------- debug : bool, optional Set to true to enable debugging, by default False pp_defs : dict, optional Preprocessor definitions and their values, by default None include_dirs : set, optional Preprocessor include directories, by default None Returns ------- fortran_ast An Abstract Syntax Tree """ if pp_defs is None: pp_defs = {} if include_dirs is None: include_dirs = set() # Configure the parser logger if debug: logging.basicConfig( level=logging.DEBUG, stream=sys.stdout, format="%(message)s" ) # This is not necessarily the same as self.ast file_ast = FortranAST(self) if self.preproc: log.debug("=== PreProc Pass ===\n") pp_skips, pp_defines = self.preprocess( pp_defs=pp_defs, include_dirs=include_dirs, debug=debug ) for pp_reg in pp_skips: file_ast.start_ppif(pp_reg[0]) file_ast.end_ppif(pp_reg[1]) log.debug("\n=== Parsing Pass ===\n") else: log.debug("=== No PreProc ===\n") pp_skips = [] pp_defines = [] line_no = 0 line_no_end = 0 block_id_stack = [] docs: list[str] = [] # list used to temporarily store docstrings counters = Counter( do=0, ifs=0, block=0, select=0, imports=0, interface=0, ) multi_lines = deque() self.COMMENT_LINE_MATCH, self.DOC_COMMENT_MATCH = self.get_comment_regexs() while (line_no_end < self.nLines) or multi_lines: # Get next line # Get a normal line, i.e. the stack is empty if not multi_lines: # Check if we need to advance the line number due to `&` continuation line_no = line_no_end if line_no_end > line_no else line_no # get_line has a 0-based index line = self.get_line(line_no, pp_content=True) line_no += 1 # Move to next line line_no_end = line_no get_full = True # Line is part of a multi-line construct, i.e. contained ';' else: line = multi_lines.pop() get_full = False if line == "": continue # Skip empty lines # Parse documentation strings to AST nodes, this implicitly operates # on docs, i.e. appends or nullifies it idx = self.parse_docs(line, line_no, file_ast, docs) if idx: line_no = idx line_no_end = line_no continue # Handle preprocessing regions do_skip = False for pp_reg in pp_skips: if (line_no >= pp_reg[0]) and (line_no <= pp_reg[1]): do_skip = True break if line_no in pp_defines: do_skip = True if do_skip: continue # Get full line, seek forward for code lines # @note line_no-1 refers to the array index for the current line if get_full: _, line, post_lines = self.get_code_line( line_no - 1, backward=False, pp_content=True ) # Save the end of the line for the next iteration. # Need to keep the line number for registering start of Scopes line_no_end += len(post_lines) line = "".join([line] + post_lines) line, line_label = strip_line_label(line) line_stripped = strip_strings(line, maintain_len=True) # Find trailing comments comm_ind = line_stripped.find("!") if comm_ind >= 0: line_no_comment = line[:comm_ind] line_stripped = line_stripped[:comm_ind] docs = self.get_single_line_docstring(line[comm_ind:]) else: line_no_comment = line # Split lines with semicolons, place the multiple lines into a stack if line_stripped.find(";") >= 0: multi_lines.extendleft(line_stripped.split(";")) line = multi_lines.pop() line_stripped = line line_no_comment = line # Test for scope end if file_ast.end_scope_regex is not None: match = FRegex.END_WORD.match(line_no_comment) # Handle end statement if self.parse_end_scope_word(line_no_comment, line_no, file_ast, match): continue # Look for old-style end of DO loops with line labels if self.parse_do_fixed_format( line, line_no, file_ast, line_label, block_id_stack ): continue # Skip if known generic code line if FRegex.NON_DEF.match(line_no_comment): continue # Mark implicit statement if self.parse_implicit(line_no_comment, line_no, file_ast): continue # Mark contains statement if self.parse_contains(line_no_comment, line_no, file_ast): continue # Loop through tests obj_read = self.get_fortran_definition(line) # Move to next line if nothing in the definition tests matches if obj_read is None: continue obj_type: str = obj_read[0] obj_info = obj_read[1] if obj_type == "var": if obj_info.var_names is None: continue link_name: str = None procedure_def = False if obj_info.var_type[:3] == "PRO": if file_ast.current_scope.get_type() == INTERFACE_TYPE_ID: for var_name in obj_info.var_names: file_ast.add_int_member(var_name) log.debug("%s !!! INTERFACE-PRO - Ln:%d", line.strip(), line_no) continue procedure_def = True link_name = get_paren_substring(obj_info.var_type) for var_name in obj_info.var_names: desc = obj_info.var_type link_name: str = None if var_name.find("=>") > -1: name_split = var_name.split("=>") name = name_split[0] link_name = name_split[1].split("(")[0].strip() if link_name.lower() == "null": link_name = None else: name = var_name.split("=")[0] # Add dimension if specified # TODO: turn into function and add support for co-arrays i.e. [*] # Copy global keywords to the individual variable var_keywords: list[str] = obj_info.keywords[:] # The name starts with ( if name.find("(") == 0: continue name, dims = self.parse_imp_dim(name) name, char_len = self.parse_imp_char(name) if dims: var_keywords.append(dims) if char_len: desc += char_len name = name.strip() keywords, keyword_info = map_keywords(var_keywords) if procedure_def: new_var = Method( file_ast, line_no, name, desc, keywords, keyword_info=keyword_info, proc_ptr=obj_info.var_kind, link_obj=link_name, ) else: new_var = Variable( file_ast, line_no, name, desc, keywords, keyword_info=keyword_info, kind=obj_info.var_kind, link_obj=link_name, ) # If the object is fortran_var and a parameter include # the value in hover if new_var.is_parameter(): _, col = find_word_in_line(line, name) match = FRegex.PARAMETER_VAL.match(line[col:]) if match: var = " ".join(match.group(1).strip().split()) new_var.set_parameter_val(var) # Check if the "variable" is external and if so cycle if find_external(file_ast, desc, name, new_var): continue # if not merge_external: file_ast.add_variable(new_var) log.debug("%s !!! VARIABLE - Ln:%d", line, line_no) elif obj_type == "mod": new_mod = Module(file_ast, line_no, obj_info) file_ast.add_scope(new_mod, FRegex.END_MOD) log.debug("%s !!! MODULE - Ln:%d", line, line_no) elif obj_type == "smod": new_smod = Submodule( file_ast, line_no, obj_info.name, ancestor_name=obj_info.parent ) file_ast.add_scope(new_smod, FRegex.END_SMOD) log.debug("%s !!! SUBMODULE - Ln:%d", line, line_no) elif obj_type == "prog": new_prog = Program(file_ast, line_no, obj_info) file_ast.add_scope(new_prog, FRegex.END_PROG) log.debug("%s !!! PROGRAM - Ln:%d", line, line_no) elif obj_type == "sub": keywords, _ = map_keywords(obj_info.keywords) new_sub = Subroutine( file_ast, line_no, obj_info.name, args=obj_info.args, mod_flag=obj_info.mod_flag, keywords=keywords, ) file_ast.add_scope(new_sub, FRegex.END_SUB) log.debug("%s !!! SUBROUTINE - Ln:%d", line, line_no) elif obj_type == "fun": keywords, keyword_info = map_keywords(obj_info.keywords) new_fun = Function( file_ast, line_no, obj_info.name, args=obj_info.args, mod_flag=obj_info.mod_flag, keywords=keywords, keyword_info=keyword_info, result_type=obj_info.result.type, result_name=obj_info.result.name, ) file_ast.add_scope(new_fun, FRegex.END_FUN) # function type is present without result(), register the automatic # result() variable that is the function name if obj_info.result.type: keywords, keyword_info = map_keywords(obj_info.result.keywords) new_obj = Variable( file_ast, line_no, name=obj_info.result.name, var_desc=obj_info.result.type, keywords=keywords, keyword_info=keyword_info, kind=obj_info.result.kind, ) file_ast.add_variable(new_obj) log.debug("%s !!! FUNCTION - Ln:%d", line, line_no) elif obj_type == "block": name = obj_info if name is None: counters["block"] += 1 name = f"#BLOCK{counters['block']}" new_block = Block(file_ast, line_no, name) file_ast.add_scope(new_block, FRegex.END_BLOCK, req_container=True) log.debug("%s !!! BLOCK - Ln:%d", line, line_no) elif obj_type == "do": counters["do"] += 1 name = f"#DO{counters['do']}" if obj_info != "": block_id_stack.append(obj_info) new_do = Do(file_ast, line_no, name) file_ast.add_scope(new_do, FRegex.END_DO, req_container=True) log.debug("%s !!! DO - Ln:%d", line, line_no) elif obj_type == "where": # Add block if WHERE is not single line if not obj_info: counters["do"] += 1 name = f"#WHERE{counters['do']}" new_do = Where(file_ast, line_no, name) file_ast.add_scope(new_do, FRegex.END_WHERE, req_container=True) log.debug("%s !!! WHERE - Ln:%d", line, line_no) elif obj_type == "assoc": counters["block"] += 1 name = f"#ASSOC{counters['block']}" new_assoc = Associate(file_ast, line_no, name) file_ast.add_scope(new_assoc, FRegex.END_ASSOCIATE, req_container=True) for bound_var in obj_info: try: bind_name, link_name = bound_var.split("=>") file_ast.add_variable( new_assoc.create_binding_variable( file_ast, line_no, bind_name.strip(), link_name.strip(), ) ) except ValueError: pass log.debug("%s !!! ASSOCIATE - Ln:%d", line, line_no) elif obj_type == "if": counters["if"] += 1 name = f"#IF{counters['if']}" new_if = If(file_ast, line_no, name) file_ast.add_scope(new_if, FRegex.END_IF, req_container=True) log.debug("%s !!! IF - Ln:%d", line, line_no) elif obj_type == "select": counters["select"] += 1 name = f"#SELECT{counters['select']}" new_select = Select(file_ast, line_no, name, obj_info) file_ast.add_scope(new_select, FRegex.END_SELECT, req_container=True) new_var = new_select.create_binding_variable( file_ast, line_no, f"{obj_info.desc}({obj_info.binding})", obj_info.type, ) if new_var is not None: file_ast.add_variable(new_var) log.debug("%s !!! SELECT - Ln:%d", line, line_no) elif obj_type == "typ": keywords, _ = map_keywords(obj_info.keywords) new_type = Type(file_ast, line_no, obj_info.name, keywords) if obj_info.parent is not None: new_type.set_inherit(obj_info.parent) file_ast.add_scope(new_type, FRegex.END_TYPED, req_container=True) log.debug("%s !!! TYPE - Ln:%d", line, line_no) elif obj_type == "enum": counters["block"] += 1 name = f"#ENUM{counters['block']}" new_enum = Enum(file_ast, line_no, name) file_ast.add_scope(new_enum, FRegex.END_ENUMD, req_container=True) log.debug("%s !!! ENUM - Ln:%d", line, line_no) elif obj_type == "int": name = obj_info.name if name is None: counters["interface"] += 1 name = f"#GEN_INT{counters['interface']}" new_int = Interface(file_ast, line_no, name, abstract=obj_info.abstract) file_ast.add_scope(new_int, FRegex.END_INT, req_container=True) log.debug("%s !!! INTERFACE - Ln:%d", line, line_no) elif obj_type == "gen": new_int = Interface( file_ast, line_no, obj_info.bound_name, abstract=False ) new_int.set_visibility(obj_info.vis_flag) file_ast.add_scope(new_int, FRegex.END_INT, req_container=True) for pro_link in obj_info.pro_links: file_ast.add_int_member(pro_link) file_ast.end_scope(line_no) log.debug("%s !!! GENERIC - Ln:%d", line, line_no) elif obj_type == "int_pro": if file_ast.current_scope is not None: if file_ast.current_scope.get_type() == INTERFACE_TYPE_ID: for name in obj_info: file_ast.add_int_member(name) log.debug("%s !!! INTERFACE-PRO - Ln:%d", line, line_no) elif file_ast.current_scope.get_type() == SUBMODULE_TYPE_ID: new_impl = Scope(file_ast, line_no, obj_info[0]) file_ast.add_scope(new_impl, FRegex.END_PRO) log.debug("%s !!! INTERFACE-IMPL - Ln:%d", line, line_no) elif obj_type == "use": obj_info.line_number = line_no file_ast.add_use(obj_info) log.debug("%s !!! USE - Ln:%d", line, line_no) elif obj_type == "import": obj_info.line_number = line_no obj_info.mod_name += str(counters["import"]) file_ast.add_use(obj_info) counters["imports"] += 1 log.debug("%s !!! IMPORT - Ln:%d", line, line_no) elif obj_type == "inc": file_ast.add_include(obj_info, line_no) log.debug("%s !!! INCLUDE - Ln:%d", line, line_no) elif obj_type == "vis": if file_ast.current_scope is None: msg = "Visibility statement without enclosing scope" file_ast.add_error(msg, Severity.error, line_no, 0) else: if len(obj_info.obj_names) == 0 and obj_info.type == 1: # private file_ast.current_scope.set_default_vis(-1) else: if obj_info.type == 1: # private for word in obj_info.obj_names: file_ast.add_private(word) else: for word in obj_info.obj_names: file_ast.add_public(word) log.debug("%s !!! VISIBILITY - Ln:%d", line, line_no) file_ast.close_file(line_no) if debug: if len(file_ast.end_errors) > 0: log.debug("\n=== Scope Errors ===\n") for error in file_ast.end_errors: if error[0] >= 0: message = f"Unexpected end of scope at line {error[0]}" else: message = "Unexpected end statement: No open scopes" log.debug("%s: %s", error[1], message) if len(file_ast.parse_errors) > 0: log.debug("\n=== Parsing Errors ===\n") for error in file_ast.parse_errors: log.debug("%s: %s", error["range"], error["message"]) return file_ast def parse_imp_dim(self, line: str): """Parse the implicit dimension of an array e.g. var(3,4), var_name(size(val,1)*10) Parameters ---------- line : str line containing variable name Returns ------- tuple[str, str] truncated line, dimension string """ m = re.compile(r"[ ]*\w+[ ]*(\()", re.I).match(line) if not m: return line, None i = find_paren_match(line[m.end(1) :]) if i < 0: return line, None # triggers for autocomplete dims = line[m.start(1) : m.end(1) + i + 1] line = line[: m.start(1)] + line[m.end(1) + i + 1 :] return line, f"dimension{dims}" def parse_imp_char(self, line: str): """Parse the implicit character length from a variable e.g. var_name*10 or var_name*(10), var_name*(size(val, 1)) Parameters ---------- line : str line containing potential variable Returns ------- tuple[str, str] truncated line, character length """ match = re.compile(r"(\w+)[ ]*\*[ ]*(\d+|\()", re.I).match(line) if not match: return line, None if match.group(2) == "(": i = find_paren_match(line[match.end(2) :]) if i < 0: return line, None # triggers for autocomplete char_len = line[match.start(2) : match.end(2) + i + 1] elif match.group(2).isdigit(): char_len = match.group(2) return match.group(1), f"*{char_len}" def parse_end_scope_word( self, line: str, ln: int, file_ast: FortranAST, match: re.Match ) -> bool: """Parses END keyword marking the end of scopes Parameters ---------- line : str Document line ln : int Line number file_ast : fortran_ast AST object match : re.Match END word regular expression match Returns ------- bool True if a AST scope is closed, False otherwise """ if match is None: return False end_scope_word: str = None if match.group(1) is None: end_scope_word = "" if file_ast.current_scope.req_named_end() and ( file_ast.current_scope is not file_ast.none_scope ): file_ast.end_errors.append([ln, file_ast.current_scope.sline]) else: scope_match = file_ast.end_scope_regex.match(line[match.start(1) :]) if scope_match is not None: end_scope_word = scope_match.group(0) if end_scope_word is not None: if (file_ast.current_scope.get_type() == SELECT_TYPE_ID) and ( file_ast.current_scope.is_type_region() ): file_ast.end_scope(ln) file_ast.end_scope(ln) log.debug("%s !!! END %s Scope - Ln:%d", line, end_scope_word.upper(), ln) return True return False def parse_do_fixed_format( self, line: str, ln: int, file_ast: FortranAST, line_label: str, block_id_stack: list[str], ): if (file_ast.current_scope.get_type() == DO_TYPE_ID) and ( line_label is not None ): # TODO: try and move to end_scope pattern did_close = False while (len(block_id_stack) > 0) and (line_label == block_id_stack[-1]): file_ast.end_scope(ln) block_id_stack.pop() did_close = True log.debug("%s !!! END DO-LABELLED - Ln:%d", line, ln) if did_close: return True return False def parse_implicit(self, line: str, ln: int, file_ast: FortranAST) -> bool: """Parse implicit statements from a line Parameters ---------- line : str Document line ln : int Line number file_ast : fortran_ast AST object Returns ------- bool True if an IMPLICIT statements present, False otherwise """ match = FRegex.IMPLICIT.match(line) if match is None: return False if file_ast.current_scope is None: msg = "IMPLICIT statement without enclosing scope" file_ast.add_error(msg, Severity.error, ln, match.start(1), match.end(1)) else: if match.group(1).lower() == "none": file_ast.current_scope.set_implicit(False, ln) else: file_ast.current_scope.set_implicit(True, ln) log.debug("%s !!! IMPLICIT - Ln:%d", line, ln) return True def parse_contains(self, line: str, ln: int, file_ast: FortranAST) -> bool: """Parse contain statements Parameters ---------- line : str Document line ln : int Line number file_ast : fortran_ast AST object Returns ------- bool True if a contains is present, False otherwise """ match = FRegex.CONTAINS.match(line) if match is None: return False msg: str = None try: if file_ast.current_scope is None: msg = "CONTAINS statement without enclosing scope" else: file_ast.current_scope.mark_contains(ln) except ValueError: msg = "Multiple CONTAINS statements in scope" if msg: file_ast.add_error(msg, Severity.error, ln, match.start(1), match.end(1)) log.debug("%s !!! CONTAINS - Ln:%d", line, ln) return True def parse_docs(self, line: str, ln: int, file_ast: FortranAST, docs: list[str]): """Parse documentation stings of style Doxygen or FORD. Multiline docstrings are detected if the first comment starts with `!>` docstring continuations are detected with either `!>`, `!<` or `!!` Parameters ---------- line : str Document line ln : int Line number file_ast : fortran_ast AST object docs : list[str] Docstrings that are pending processing e.g. single line docstrings """ def format(docs: list[str]) -> str: """Format docstrings and parse for Doxygen tags""" if len(docs) == 1: return f"{docs[0]}" docstr = "" has_args = True idx_args = -1 for i, line in enumerate(docs): if line.startswith("@brief"): docstr += line.replace("@brief", "", 1).strip() + "\n" elif line.startswith("@param"): if has_args: docstr += "\n**Parameters:** \n" has_args = False idx_args = len(docstr) docstr += re.sub( r"[@\\]param(?:[\[\(]\s*[\w,]+\s*[\]\)])?\s+(.*?)\s+", r" \n`\1` - ", line + " ", ) elif line.startswith("@return"): docstr += "\n**Returns:** \n" docstr += line.replace("@return", "", 1).strip() + "\n" else: docstr += line.strip() + "\n" # Remove new line characters from 1st @param line if idx_args > 0: docstr = docstr[: idx_args - 3] + docstr[idx_args:].replace( " \n ", "", 1 ) return docstr def add_line_comment(file_ast: FortranAST, docs: list[str]): # Handle dangling comments from previous line if docs: file_ast.add_doc(format(docs)) log.debug("%s !!! Doc string - Line:%d", format(docs), ln) docs[:] = [] # empty the documentation stack # Check for comments in line if not self.COMMENT_LINE_MATCH.match(line): add_line_comment(file_ast, docs) return False # Check for documentation doc_match = self.DOC_COMMENT_MATCH.match(line) if not doc_match: add_line_comment(file_ast, docs) return False _ln = ln ln, docs[:], predocmark = self.get_docstring(ln, line, doc_match, docs) # Count the total length of all the stings in docs # most efficient implementation, see: shorturl.at/dfmyV if len("".join(docs)) > 0: file_ast.add_doc(format(docs), forward=predocmark) for i, doc_line in enumerate(docs): log.debug("%s !!! Doc string - Line:%d", doc_line, _ln + i) docs[:] = [] return ln def get_docstring( self, ln: int, line: str, match: Match[str], docs: list[str] ) -> tuple[int, list[str], bool]: """Extract entire documentation strings from the current file position Parameters ---------- ln : int Line number line : str Document line, not necessarily produced by `get_line()` match : Match[str] Regular expression DOC match docs : list[str] Docstrings that are pending processing e.g. single line docstrings Returns ------- tuple[int, list[str], bool] The new line number at the end of the docstring, the docstring and a boolean flag indicating whether the docstring precedes the AST node (Doxygen style) or succeeds it (traditional FORD style) """ docstring: list[str] = docs docstring.append(line[match.end(0) :].strip()) predocmark = True if match.group(1) == ">" else False if ln >= self.nLines: return ln, docstring, predocmark # @note line index is 0-based # Start from the current line until EOF and check for docs for i in range(ln, self.nLines): next_line = self.get_line(i, pp_content=True) match = self.DOC_COMMENT_MATCH.match(next_line) if not match: ln = i break docstring.append(next_line[match.end(0) :].strip()) return ln, docstring, predocmark def get_single_line_docstring(self, line: str) -> list[str]: """Get a docstring of a single line. This is the same for both Legacy and Modern Fortran Parameters ---------- line : str Line of code Returns ------- list[str] A list containing the docstring. List will be empty if there is no match or the match is an empty string itself """ match = FRegex.FREE_DOC.match(line) if not match: return [] # if the string is empty return an empty list instead doc = line[match.end(0) :].strip() return [doc] if doc else [] def get_comment_regexs(self) -> tuple[Pattern[str], Pattern[str]]: if self.fixed: return FRegex.FIXED_COMMENT, FRegex.FIXED_DOC return FRegex.FREE_COMMENT, FRegex.FREE_DOC def get_fortran_definition(self, line: str): for fortran_def in def_tests: obj = fortran_def(line) if obj is not None: return obj return None def preprocess_file( contents_split: list, file_path: str = None, pp_defs: dict = None, include_dirs: set = None, debug: bool = False, ): # Look for and mark excluded preprocessor paths in file # Initial implementation only looks for "if" and "ifndef" statements. # For "if" statements all blocks are excluded except the "else" block if present # For "ifndef" statements all blocks excluding the first block are excluded def eval_pp_if(text, defs: dict = None): def replace_ops(expr: str): expr = expr.replace("&&", " and ") expr = expr.replace("||", " or ") expr = expr.replace("!=", " <> ") expr = expr.replace("!", " not ") expr = expr.replace(" <> ", " != ") return expr def replace_defined(line: str): i0 = 0 out_line = "" for match in FRegex.DEFINED.finditer(line): if match.group(1) in defs: out_line += line[i0 : match.start(0)] + "(@$@)" else: out_line += line[i0 : match.start(0)] + "(%$%)" i0 = match.end(0) if i0 < len(line): out_line += line[i0:] return out_line def replace_vars(line: str): i0 = 0 out_line = "" for match in FRegex.WORD.finditer(line): if match.group(0) in defs: out_line += line[i0 : match.start(0)] + defs[match.group(0)] else: out_line += line[i0 : match.start(0)] + "False" i0 = match.end(0) if i0 < len(line): out_line += line[i0:] out_line = out_line.replace("@$@", "True") out_line = out_line.replace("%$%", "False") return out_line if defs is None: defs = {} out_line = replace_defined(text) out_line = replace_vars(out_line) try: line_res = eval(replace_ops(out_line)) except: return False else: return line_res def expand_func_macro(def_name: str, def_value: tuple[str, str]): def_args, sub = def_value def_args = def_args.split(",") regex = re.compile(rf"\b{def_name}\s*\({','.join(['(.*)']*len(def_args))}\)") for i, arg in enumerate(def_args, start=1): sub = re.sub(rf"\b({arg.strip()})\b", rf"\\{i}", sub) return regex, sub def append_multiline_macro(def_value: str | tuple, line: str): if isinstance(def_value, tuple): def_args, def_value = def_value def_value += line return (def_args, def_value) return def_value + line if pp_defs is None: pp_defs = {} if include_dirs is None: include_dirs = set() if file_path is not None: include_dirs.add(os.path.abspath(os.path.dirname(file_path))) pp_skips = [] pp_defines = [] pp_stack = [] pp_stack_group = [] defs_tmp = pp_defs.copy() def_regexes = {} output_file = [] def_cont_name = None for i, line in enumerate(contents_split): # Handle multiline macro continuation if def_cont_name is not None: output_file.append("") is_multiline = line.strip()[-1] != "\\" line_to_append = line.strip() if is_multiline else line[0:-1].strip() defs_tmp[def_cont_name] = append_multiline_macro( defs_tmp[def_cont_name], line_to_append ) if is_multiline: def_cont_name = None continue # Handle conditional statements match = FRegex.PP_REGEX.match(line) if match: output_file.append(line) def_name = None if_start = False # Opening conditional statements if match.group(1).lower() == "if ": is_path = eval_pp_if(line[match.end(1) :], defs_tmp) if_start = True elif match.group(1).lower() == "ifdef": if_start = True def_name = line[match.end(0) :].strip() is_path = def_name in defs_tmp elif match.group(1).lower() == "ifndef": if_start = True def_name = line[match.end(0) :].strip() is_path = not (def_name in defs_tmp) if if_start: if is_path: pp_stack.append([-1, -1]) log.debug("%s !!! Conditional TRUE(%d)", line.strip(), i + 1) else: pp_stack.append([i + 1, -1]) log.debug("%s !!! Conditional FALSE(%d)", line.strip(), i + 1) continue if len(pp_stack) == 0: continue # Closing/middle conditional statements inc_start = False exc_start = False exc_continue = False if match.group(1).lower() == "elif": if (not pp_stack_group) or (pp_stack_group[-1][0] != len(pp_stack)): # First elif statement for this elif group if pp_stack[-1][0] < 0: pp_stack_group.append([len(pp_stack), True]) else: pp_stack_group.append([len(pp_stack), False]) if pp_stack_group[-1][1]: # An earlier if or elif in this group has been true exc_continue = True if pp_stack[-1][0] < 0: pp_stack[-1][0] = i + 1 elif eval_pp_if(line[match.end(1) :], defs_tmp): pp_stack[-1][1] = i + 1 pp_skips.append(pp_stack.pop()) pp_stack_group[-1][1] = True pp_stack.append([-1, -1]) inc_start = True else: exc_start = True elif match.group(1).lower() == "else": if pp_stack[-1][0] < 0: pp_stack[-1][0] = i + 1 exc_start = True elif ( pp_stack_group and (pp_stack_group[-1][0] == len(pp_stack)) and (pp_stack_group[-1][1]) ): # An earlier if or elif in this group has been true exc_continue = True else: pp_stack[-1][1] = i + 1 pp_skips.append(pp_stack.pop()) pp_stack.append([-1, -1]) inc_start = True elif match.group(1).lower() == "endif": if pp_stack_group and (pp_stack_group[-1][0] == len(pp_stack)): pp_stack_group.pop() if pp_stack[-1][0] < 0: pp_stack.pop() log.debug("%s !!! Conditional TRUE/END(%d)", line.strip(), i + 1) continue if pp_stack[-1][1] < 0: pp_stack[-1][1] = i + 1 log.debug("%s !!! Conditional FALSE/END(%d)", line.strip(), i + 1) pp_skips.append(pp_stack.pop()) if debug: if inc_start: log.debug("%s !!! Conditional TRUE(%d)", line.strip(), i + 1) elif exc_start: log.debug("%s !!! Conditional FALSE(%d)", line.strip(), i + 1) elif exc_continue: log.debug("%s !!! Conditional EXCLUDED(%d)", line.strip(), i + 1) continue stack_is_true = all(scope[0] < 0 for scope in pp_stack) # Handle variable/macro definitions files match = FRegex.PP_DEF.match(line) if (match is not None) and stack_is_true: output_file.append(line) pp_defines.append(i + 1) def_name = match.group(2) # If this is an argument list of a function add them to the name # get_definition will only return the function name upon hover # hence if the argument list is appended in the def_name then # querying the dictionary will not yield a result. # Need to properly parse the preprocessor files instead of this. # This also does not allow for multiline argument list definitions. # if match.group(3): # def_name += match.group(3) if (match.group(1) == "define") and (def_name not in defs_tmp): eq_ind = line[match.end(0) :].find(" ") if eq_ind >= 0: # Handle multiline macros if line.rstrip()[-1] == "\\": def_value = line[match.end(0) + eq_ind : -1].strip() def_cont_name = def_name else: def_value = line[match.end(0) + eq_ind :].strip() else: def_value = "True" # are there arguments to parse? if match.group(3): def_value = (match.group(4), def_value) defs_tmp[def_name] = def_value elif (match.group(1) == "undef") and (def_name in defs_tmp): defs_tmp.pop(def_name, None) log.debug("%s !!! Define statement(%d)", line.strip(), i + 1) continue # Handle include files match = FRegex.PP_INCLUDE.match(line) if (match is not None) and stack_is_true: log.debug("%s !!! Include statement(%d)", line.strip(), i + 1) include_filename = match.group(1).replace('"', "") include_path = None # Intentionally keep this as a list and not a set. There are cases # where projects play tricks with the include order of their headers # to get their codes to compile. Using a set would not permit that. for include_dir in include_dirs: include_path_tmp = os.path.join(include_dir, include_filename) if os.path.isfile(include_path_tmp): include_path = os.path.abspath(include_path_tmp) break if include_path is not None: try: include_file = FortranFile(include_path) err_string, _ = include_file.load_from_disk() if err_string is None: log.debug("\n!!! Parsing include file '%s'", include_path) _, _, _, defs_tmp = preprocess_file( include_file.contents_split, file_path=include_path, pp_defs=defs_tmp, include_dirs=include_dirs, debug=debug, ) log.debug("!!! Completed parsing include file\n") else: log.debug("!!! Failed to parse include file: %s", err_string) except: log.debug("!!! Failed to parse include file: exception") else: log.debug( "%s !!! Could not locate include file (%d)", line.strip(), i + 1 ) # Substitute (if any) read in preprocessor macros for def_tmp, value in defs_tmp.items(): # Skip if the line does not contain the macro at all. This is supposed to # spare the expensive regex-substitution in case we do not need it at all if def_tmp not in line: continue def_regex = def_regexes.get(def_tmp) if def_regex is None: if isinstance(value, tuple): def_regex = expand_func_macro(def_tmp, value) else: def_regex = re.compile(rf"\b{def_tmp}\b") def_regexes[def_tmp] = def_regex if isinstance(def_regex, tuple): def_regex, value = def_regex line_new, nsubs = def_regex.subn(value, line) if nsubs > 0: log.debug( "%s !!! Macro sub(%d) '%s' -> '%s'", line.strip(), i + 1, def_tmp, value, ) line = line_new output_file.append(line) return output_file, pp_skips, pp_defines, defs_tmp fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/program.py000066400000000000000000000002111477231266000260240ustar00rootroot00000000000000from __future__ import annotations from .module import Module class Program(Module): def get_desc(self): return "PROGRAM" fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/scope.py000066400000000000000000000225751477231266000255070ustar00rootroot00000000000000from __future__ import annotations import copy from typing import TYPE_CHECKING from typing import Type as T from fortls.constants import ( BLOCK_TYPE_ID, FUNCTION_TYPE_ID, INTERFACE_TYPE_ID, MODULE_TYPE_ID, SUBMODULE_TYPE_ID, SUBROUTINE_TYPE_ID, ) from fortls.json_templates import range_json from .base import FortranObj from .diagnostics import Diagnostic from .imports import Import from .utilities import find_in_scope if TYPE_CHECKING: from .ast import FortranAST from .use import Use class Scope(FortranObj): def __init__( self, file_ast: FortranAST, line_number: int, name: str, keywords: list = None, ): super().__init__() if keywords is None: keywords = [] self.file_ast: FortranAST = file_ast self.sline: int = line_number self.eline: int = line_number self.name: str = name self.children: list[T[Scope]] = [] self.members: list = [] self.use: list[Use | Import] = [] self.keywords: list = keywords self.inherit = None self.parent = None self.contains_start = None self.implicit_line = None self.FQSN: str = self.name.lower() if file_ast.enc_scope_name is not None: self.FQSN = f"{file_ast.enc_scope_name.lower()}::{self.name.lower()}" def copy_from(self, copy_source: Scope): # Pass the reference, we don't want shallow copy since that would still # result into 2 versions of attributes between copy_source and self for k, v in copy_source.__dict__.items(): setattr(self, k, v) def add_use(self, use_mod: Use | Import): self.use.append(use_mod) def set_inherit(self, inherit_type): self.inherit = inherit_type def set_parent(self, parent_obj): self.parent = parent_obj def set_implicit(self, implicit_flag, line_number): self.implicit_vars = implicit_flag self.implicit_line = line_number def mark_contains(self, line_number): if self.contains_start is not None: raise ValueError self.contains_start = line_number def add_child(self, child): self.children.append(child) child.set_parent(self) def update_fqsn(self, enc_scope=None): if enc_scope is not None: self.FQSN = f"{enc_scope.lower()}::{self.name.lower()}" else: self.FQSN = self.name.lower() for child in self.children: child.update_fqsn(self.FQSN) def add_member(self, member): self.members.append(member) def get_children(self, public_only=False) -> list[T[FortranObj]]: if not public_only: return copy.copy(self.children) pub_children = [] for child in self.children: if (child.vis < 0) or ((self.def_vis < 0) and (child.vis <= 0)): continue if child.name.startswith("#GEN_INT"): pub_children.append(child) continue pub_children.append(child) return pub_children def check_definitions(self, obj_tree) -> list[Diagnostic]: """Check for definition errors in scope""" fqsn_dict: dict[str, int] = {} errors: list[Diagnostic] = [] known_types: dict[str, FortranObj] = {} for child in self.children: # Skip masking/double checks for interfaces if child.get_type() == INTERFACE_TYPE_ID: continue # Check other variables in current scope if child.FQSN in fqsn_dict: if child.sline < fqsn_dict[child.FQSN]: fqsn_dict[child.FQSN] = child.sline - 1 else: fqsn_dict[child.FQSN] = child.sline - 1 contains_line = -1 if self.get_type() in ( MODULE_TYPE_ID, SUBMODULE_TYPE_ID, SUBROUTINE_TYPE_ID, FUNCTION_TYPE_ID, ): contains_line = ( self.contains_start if self.contains_start is not None else self.eline ) # Detect interface definitions is_interface = ( self.parent is not None and self.parent.get_type() == INTERFACE_TYPE_ID and not self.is_mod_scope() ) for child in self.children: if child.name.startswith("#"): continue line_number = child.sline - 1 # Check for type definition in scope def_error, known_types = child.check_definition( obj_tree, known_types=known_types, interface=is_interface ) if def_error is not None: errors.append(def_error) # Detect contains errors if contains_line >= child.sline and child.get_type(no_link=True) in ( SUBROUTINE_TYPE_ID, FUNCTION_TYPE_ID, ): new_diag = Diagnostic( line_number, message="Subroutine/Function definition before CONTAINS statement", severity=1, ) errors.append(new_diag) # Skip masking/double checks for interfaces and members if ( self.get_type() == INTERFACE_TYPE_ID or child.get_type() == INTERFACE_TYPE_ID ): continue # Check other variables in current scope if child.FQSN in fqsn_dict and line_number > fqsn_dict[child.FQSN]: new_diag = Diagnostic( line_number, message=f'Variable "{child.name}" declared twice in scope', severity=1, find_word=child.name, ) new_diag.add_related( path=self.file_ast.path, line=fqsn_dict[child.FQSN], message="First declaration", ) errors.append(new_diag) continue # Check for masking from parent scope in subroutines, functions, and blocks if self.parent is not None and self.get_type() in ( SUBROUTINE_TYPE_ID, FUNCTION_TYPE_ID, BLOCK_TYPE_ID, ): parent_var = find_in_scope(self.parent, child.name, obj_tree) if parent_var is not None: # Ignore if function return variable if ( self.get_type() == FUNCTION_TYPE_ID and parent_var.FQSN == self.FQSN ): continue new_diag = Diagnostic( line_number, message=( f'Variable "{child.name}" masks variable in parent scope' ), severity=2, find_word=child.name, ) new_diag.add_related( path=parent_var.file_ast.path, line=parent_var.sline - 1, message="First declaration", ) errors.append(new_diag) return errors def check_use(self, obj_tree): errors = [] last_use_line = -1 for use_stmnt in self.use: last_use_line = max(last_use_line, use_stmnt.line_number) if type(use_stmnt) is Import: if (self.parent is None) or ( self.parent.get_type() != INTERFACE_TYPE_ID ): new_diag = Diagnostic( use_stmnt.line_number - 1, message="IMPORT statement outside of interface", severity=1, ) errors.append(new_diag) continue if use_stmnt.mod_name not in obj_tree: new_diag = Diagnostic( use_stmnt.line_number - 1, message=f'Module "{use_stmnt.mod_name}" not found in project', severity=3, find_word=use_stmnt.mod_name, ) errors.append(new_diag) if (self.implicit_line is not None) and (last_use_line >= self.implicit_line): new_diag = Diagnostic( self.implicit_line - 1, message="USE statements after IMPLICIT statement", severity=1, find_word="IMPLICIT", ) errors.append(new_diag) return errors def add_subroutine(self, interface_string, no_contains=False): edits = [] line_number = self.eline - 1 if (self.contains_start is None) and (not no_contains): first_sub_line = line_number for child in self.children: if child.get_type() in (SUBROUTINE_TYPE_ID, FUNCTION_TYPE_ID): first_sub_line = min(first_sub_line, child.sline - 1) edits.append( { **range_json(first_sub_line, 0, first_sub_line, 0), "newText": "CONTAINS\n", } ) edits.append( { **range_json(line_number, 0, line_number, 0), "newText": interface_string + "\n", } ) return self.file_ast.path, edits fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/select.py000066400000000000000000000045371477231266000256530ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from fortls.constants import SELECT_TYPE_ID from .block import Block from .variable import Variable if TYPE_CHECKING: from .ast import FortranAST class Select(Block): def __init__( self, file_ast: FortranAST, line_number: int, name: str, select_info, ): super().__init__(file_ast, line_number, name) self.select_type = select_info.type self.binding_name = None self.bound_var = None self.binding_type = None if self.select_type == 2: binding_split = select_info.binding.split("=>") if len(binding_split) == 1: self.bound_var = binding_split[0].strip() elif len(binding_split) == 2: self.binding_name = binding_split[0].strip() self.bound_var = binding_split[1].strip() elif self.select_type == 3: self.binding_type = select_info.binding # Close previous "TYPE IS" region if open if ( (file_ast.current_scope is not None) and (file_ast.current_scope.get_type() == SELECT_TYPE_ID) and file_ast.current_scope.is_type_region() ): file_ast.end_scope(line_number) def get_type(self, no_link=False): return SELECT_TYPE_ID def get_desc(self): return "SELECT" def is_type_binding(self): return self.select_type == 2 def is_type_region(self): return self.select_type in [3, 4] def create_binding_variable(self, file_ast, line_number, var_desc, case_type): if self.parent.get_type() != SELECT_TYPE_ID: return None binding_name = None bound_var = None if (self.parent is not None) and self.parent.is_type_binding(): binding_name = self.parent.binding_name bound_var = self.parent.bound_var # Check for default case if (binding_name is not None) and (case_type != 4): bound_var = None # Create variable if binding_name is not None: return Variable( file_ast, line_number, binding_name, var_desc, [], link_obj=bound_var ) elif bound_var is not None: return Variable(file_ast, line_number, bound_var, var_desc, []) return None fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/statements.json000066400000000000000000000111351477231266000270740ustar00rootroot00000000000000{ "var_def": { "CHARACTER": { "args": "LEN=len" }, "CLASS": { "args": "name" }, "COMPLEX": { "args": "KIND=kind" }, "DOUBLE COMPLEX": {}, "DOUBLE PRECISION": {}, "INTEGER": { "args": "KIND=kind" }, "LOGICAL": { "args": "KIND=kind" }, "REAL": { "args": "KIND=kind" }, "TYPE": { "args": "KIND=kind" } }, "int_stmnts": { "ALLOCATE": { "doc": "Dynamically creates storage for allocatable variables and pointer targets." }, "BACKSPACE": { "doc": "Positions a sequential file at the beginning of the preceding record, making it available for subsequent I/O processing." }, "CALL": { "doc": "Transfers control to a subroutine subprogram." }, "CLOSE": { "doc": "Disconnects a file from a unit." }, "CONTINUE": { "doc": "Primarily used to terminate a labelled DO construct when the construct would otherwise end improperly with either a GO TO, arithmetic IF, or other prohibited control statement." }, "CYCLE": { "doc": "Interrupts the current execution cycle of the innermost (or named) DO construct." }, "DEALLOCATE": { "doc": "Frees the storage allocated for allocatable variables and nonprocedure pointer targets (and causes the pointers to become disassociated)." }, "ENDFILE": { "doc": "For sequential files, writes an end-of-file record to the file and positions the file after this record (the terminal point)." }, "ERROR STOP": { "doc": "Initiates error termination of an image before the execution of an END statement of the main program." }, "EVENT POST": { "doc": "Allows an image to notify another image that it can proceed to work on tasks that use common resources." }, "EVENT WAIT": { "doc": "Allows an image to wait on events posted by other images." }, "FAIL IMAGE": { "doc": "Forces the failure of the current image of the program unit." }, "FLUSH": { "doc": "Causes data written to a file to become available to other processes or causes data written to a file outside of Fortran to be accessible to a READ statement." }, "FORM TEAM": { "args": "team_number,team_variable", "doc": "Defines team variables; creates one or more teams of images from the images on the current team." }, "FORMAT": { "doc": "Specifies the form of data being transferred and the data conversion (editing) required to achieve that form." }, "INQUIRE": { "doc": "Returns information on the status of specified properties of a file or logical unit." }, "LOCK": { "doc": "Causes a lock variable to become locked by an image." }, "NAMELIST": { "doc": "Associates a name with a list of variables. This group name can be referenced in some input/output operations." }, "NULLIFY": { "doc": "Disassociates a pointer from a target." }, "OPEN": { "doc": "Connects an external file to a unit, creates a new file and connects it to a unit, creates a preconnected file, or changes certain properties of a connection." }, "PRINT": { "doc": "Displays output on the screen." }, "READ": { "doc": "Transfers input data from external sequential, direct-access, or internal records." }, "RETURN": { "doc": "Return control to the calling program unit." }, "REWIND": { "doc": "Positions a sequential or direct access file at the beginning of the file (the initial point)." }, "STOP": { "doc": "Initiates normal termination of an image before the execution of an END statement of the main program." }, "SYNC ALL": { "args": "STAT=stat,ERRMSG=errmsg", "doc": "Performs a synchronization of all images in the current team." }, "SYNC IMAGES": { "args": "image_set,STAT=stat,ERRMSG=errmsg", "doc": "Performs a synchronization of the image with each of the other images in the image set." }, "SYNC MEMORY": { "args": "STAT=stat,ERRMSG=errmsg", "doc": "Ends one image segment and begins another. Each segment can then be ordered in some way with respect to segments on other images." }, "SYNC TEAM": { "args": "team_value,STAT=stat,ERRMSG=errmsg", "doc": "Performs a synchronization of all images on the specified team." }, "UNLOCK": { "doc": "Causes a lock variable to become unlocked by an image." }, "WAIT": { "doc": "Performs a wait operation for a specified pending asynchronous data transfer operation." }, "WRITE": { "doc": "Transfers output data to external sequential, direct-access, or internal records." } } } fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/submodule.py000066400000000000000000000075611477231266000263730ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from typing import Type as T from fortls.constants import ( BASE_TYPE_ID, FUNCTION_TYPE_ID, INTERFACE_TYPE_ID, SUBMODULE_TYPE_ID, SUBROUTINE_TYPE_ID, ) from .function import Function from .module import Module from .subroutine import Subroutine if TYPE_CHECKING: from .ast import FortranAST from .interface import Interface from .scope import Scope class Submodule(Module): def __init__( self, file_ast: FortranAST, line_number: int, name: str, ancestor_name: str = "", ): super().__init__(file_ast, line_number, name) self.ancestor_name = ancestor_name self.ancestor_obj = None def get_type(self, no_link=False): return SUBMODULE_TYPE_ID def get_desc(self): return "SUBMODULE" def get_ancestors(self): if self.ancestor_obj is not None: great_ancestors = self.ancestor_obj.get_ancestors() if great_ancestors is not None: return [self.ancestor_obj] + great_ancestors return [self.ancestor_obj] return [] def resolve_inherit(self, obj_tree, inherit_version): if not self.ancestor_name: return if self.ancestor_name in obj_tree: self.ancestor_obj = obj_tree[self.ancestor_name][0] def require_inherit(self): return True def resolve_link(self, obj_tree): def get_ancestor_interfaces( ancestor_children: list[Scope], ) -> list[T[Interface]]: interfaces = [] for child in ancestor_children: if child.get_type() != INTERFACE_TYPE_ID: continue for interface in child.children: interface_type = interface.get_type() if ( interface_type in (SUBROUTINE_TYPE_ID, FUNCTION_TYPE_ID, BASE_TYPE_ID) ) and interface.is_mod_scope(): interfaces.append(interface) return interfaces def create_child_from_prototype(child: Scope, interface: Interface): if interface.get_type() == SUBROUTINE_TYPE_ID: return Subroutine(child.file_ast, child.sline, child.name) elif interface.get_type() == FUNCTION_TYPE_ID: return Function(child.file_ast, child.sline, child.name) else: raise ValueError(f"Unsupported interface type: {interface.get_type()}") def replace_child_in_scope_list(child: Scope, child_old: Scope): for i, file_scope in enumerate(child.file_ast.scope_list): if file_scope is child_old: child.file_ast.scope_list[i] = child return child # Link subroutine/function implementations to prototypes if self.ancestor_obj is None: return ancestor_interfaces = get_ancestor_interfaces(self.ancestor_obj.children) # Match interface definitions to implementations for interface in ancestor_interfaces: for i, child in enumerate(self.children): if child.name.lower() != interface.name.lower(): continue if child.get_type() == BASE_TYPE_ID: child_old = child child = create_child_from_prototype(child_old, interface) child.copy_from(child_old) self.children[i] = child child = replace_child_in_scope_list(child, child_old) if child.get_type() == interface.get_type(): interface.link_obj = child interface.resolve_link(obj_tree) child.copy_interface(interface) break def require_link(self): return True fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/subroutine.py000066400000000000000000000230231477231266000265620ustar00rootroot00000000000000from __future__ import annotations import copy from typing import TYPE_CHECKING from fortls.constants import ( BLOCK_TYPE_ID, CLASS_TYPE_ID, KEYWORD_ID_DICT, SUBROUTINE_TYPE_ID, ) from fortls.helper_functions import fortran_md, get_keywords, get_placeholders from .diagnostics import Diagnostic from .scope import Scope if TYPE_CHECKING: from .ast import FortranAST from .function import Function class Subroutine(Scope): def __init__( self, file_ast: FortranAST, line_number: int, name: str, args: str = "", mod_flag: bool = False, keywords: list = None, ): super().__init__(file_ast, line_number, name, keywords) self.args: str = args.replace(" ", "") self.args_snip: str = self.args self.arg_objs: list = [] self.in_children: list = [] self.missing_args: list = [] self.mod_scope: bool = mod_flag self.link_obj: Subroutine | Function | None = None def is_mod_scope(self): return self.mod_scope def is_callable(self): return True def copy_interface(self, copy_source: Subroutine) -> list[str]: # Copy arguments self.args = copy_source.args self.args_snip = copy_source.args_snip self.arg_objs = copy_source.arg_objs # Get current fields child_names = [child.name.lower() for child in self.children] # Import arg_objs from copy object self.in_children = [] for child in copy_source.arg_objs: if child is None: continue if child.name.lower() not in child_names: self.in_children.append(child) return child_names def get_children(self, public_only=False): tmp_list = copy.copy(self.children) tmp_list.extend(self.in_children) return tmp_list def resolve_arg_link(self, obj_tree): if (self.args == "") or (len(self.in_children) > 0): return arg_list = self.args.replace(" ", "").split(",") arg_list_lower = self.args.lower().replace(" ", "").split(",") self.arg_objs = [None] * len(arg_list) # check_objs = copy.copy(self.children) # for child in self.children: # if child.is_external_int(): # check_objs += child.get_children() self.missing_args = [] for child in self.children: ind = -1 for i, arg in enumerate(arg_list_lower): if arg == child.name.lower(): ind = i break # If an argument is part of an interface block go through the # block's children i.e. functions and subroutines to see if one matches elif child.name.lower().startswith("#gen_int"): for sub_child in child.children: if arg == sub_child.name.lower(): self.arg_objs[i] = sub_child break if ind < 0: if child.keywords.count(KEYWORD_ID_DICT["intent"]) > 0: self.missing_args.append(child) else: self.arg_objs[ind] = child if child.is_optional(): arg_list[ind] = f"{arg_list[ind]}={arg_list[ind]}" self.args_snip = ",".join(arg_list) def resolve_link(self, obj_tree): self.resolve_arg_link(obj_tree) def require_link(self): return True def get_type(self, no_link=False): return SUBROUTINE_TYPE_ID def get_snippet(self, name_replace=None, drop_arg=-1): arg_list = self.args_snip.split(",") if (drop_arg >= 0) and (drop_arg < len(arg_list)): del arg_list[drop_arg] arg_snip = None if len(arg_list) > 0: arg_str, arg_snip = get_placeholders(arg_list) else: arg_str = "()" name = name_replace if name_replace is not None else self.name snippet = name + arg_snip if arg_snip is not None else None return name + arg_str, snippet def get_desc(self): return "SUBROUTINE" def get_hover(self, long=False, drop_arg=-1): sub_sig, _ = self.get_snippet(drop_arg=drop_arg) keyword_list = get_keywords(self.keywords) keyword_list.append(f"{self.get_desc()} ") hover_array = [" ".join(keyword_list) + sub_sig] hover_array, docs = self.get_docs_full(hover_array, long, drop_arg) return "\n ".join(hover_array), " \n".join(docs) def get_hover_md(self, long=False, drop_arg=-1): return fortran_md(*self.get_hover(long, drop_arg)) def get_docs_full( self, hover_array: list[str], long=False, drop_arg=-1 ) -> tuple[list[str], list[str]]: """Construct the full documentation with the code signature and the documentation string + the documentation of any arguments. Parameters ---------- hover_array : list[str] The list of strings to append the documentation to. long : bool, optional Whether or not to fetch the docs of the arguments, by default False drop_arg : int, optional Whether or not to drop certain arguments from the results, by default -1 Returns ------- tuple[list[str], list[str]] Tuple containing the Fortran signature that should be in code blocks and the documentation string that should be in normal Markdown. """ doc_strs: list[str] = [] doc_str = self.get_documentation() if doc_str is not None: doc_strs.append(doc_str) if long: has_args = True for i, arg_obj in enumerate(self.arg_objs): if arg_obj is None or i == drop_arg: continue arg, doc_str = arg_obj.get_hover() hover_array.append(arg) if doc_str: # If doc_str is not None or "" if has_args: doc_strs.append("\n**Parameters:** ") has_args = False # stripping prevents multiple \n characters from the parser doc_strs.append(f"`{arg_obj.name}` {doc_str}".strip()) return hover_array, doc_strs def get_signature(self, drop_arg=-1): arg_sigs = [] arg_list = self.args.split(",") for i, arg_obj in enumerate(self.arg_objs): if i == drop_arg: continue if arg_obj is None: arg_sigs.append({"label": arg_list[i]}) else: if arg_obj.is_optional(): label = f"{arg_obj.name.lower()}={arg_obj.name.lower()}" else: label = arg_obj.name.lower() msg = arg_obj.get_hover_md() # Create MarkupContent object msg = {"kind": "markdown", "value": msg} arg_sigs.append({"label": label, "documentation": msg}) call_sig, _ = self.get_snippet() return call_sig, self.get_documentation(), arg_sigs # TODO: fix this def get_interface_array( self, keywords: list[str], signature: str, drop_arg=-1, change_strings=None ): interface_array = [" ".join(keywords) + signature] for i, arg_obj in enumerate(self.arg_objs): if arg_obj is None: return None arg_doc, docs = arg_obj.get_hover() if i == drop_arg: i0 = arg_doc.lower().find(change_strings[0].lower()) if i0 >= 0: i1 = i0 + len(change_strings[0]) arg_doc = arg_doc[:i0] + change_strings[1] + arg_doc[i1:] interface_array.append(f"{arg_doc} :: {arg_obj.name}") return interface_array def get_interface(self, name_replace=None, drop_arg=-1, change_strings=None): sub_sig, _ = self.get_snippet(name_replace=name_replace) keyword_list = get_keywords(self.keywords) keyword_list.append("SUBROUTINE ") interface_array = self.get_interface_array( keyword_list, sub_sig, drop_arg, change_strings ) name = name_replace if name_replace is not None else self.name interface_array.append(f"END SUBROUTINE {name}") return "\n".join(interface_array) def check_valid_parent(self): if self.parent is not None: parent_type = self.parent.get_type() if (parent_type == CLASS_TYPE_ID) or (parent_type >= BLOCK_TYPE_ID): return False return True def get_diagnostics(self): errors = [] for missing_obj in self.missing_args: new_diag = Diagnostic( missing_obj.sline - 1, f'Variable "{missing_obj.name}" with INTENT keyword not found in' " argument list", severity=1, find_word=missing_obj.name, ) errors.append(new_diag) implicit_flag = self.get_implicit() if (implicit_flag is None) or implicit_flag: return errors arg_list = self.args.replace(" ", "").split(",") for i, arg_obj in enumerate(self.arg_objs): if arg_obj is None: arg_name = arg_list[i].strip() new_diag = Diagnostic( self.sline - 1, f'No matching declaration found for argument "{arg_name}"', severity=1, find_word=arg_name, ) errors.append(new_diag) return errors fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/type.py000066400000000000000000000146041477231266000253510ustar00rootroot00000000000000from __future__ import annotations import copy from typing import TYPE_CHECKING from fortls.constants import BLOCK_TYPE_ID, CLASS_TYPE_ID, KEYWORD_ID_DICT from fortls.json_templates import range_json from fortls.jsonrpc import path_to_uri from .diagnostics import Diagnostic from .scope import Scope from .utilities import find_in_scope if TYPE_CHECKING: from .ast import FortranAST class Type(Scope): def __init__( self, file_ast: FortranAST, line_number: int, name: str, keywords: list, ): super().__init__(file_ast, line_number, name, keywords) self.in_children: list = [] self.inherit = None self.inherit_var = None self.inherit_tmp = None self.inherit_version = -1 self.abstract = self.keywords.count(KEYWORD_ID_DICT["abstract"]) > 0 if self.keywords.count(KEYWORD_ID_DICT["public"]) > 0: self.vis = 1 if self.keywords.count(KEYWORD_ID_DICT["private"]) > 0: self.vis = -1 def get_type(self, no_link=False): return CLASS_TYPE_ID def get_desc(self): return "TYPE" def get_children(self, public_only=False): tmp_list = copy.copy(self.children) tmp_list.extend(self.in_children) return tmp_list def resolve_inherit(self, obj_tree, inherit_version): if (self.inherit is None) or (self.inherit_version == inherit_version): return self.inherit_version = inherit_version self.inherit_var = find_in_scope(self.parent, self.inherit, obj_tree) if self.inherit_var is not None: self._resolve_inherit_parent(obj_tree, inherit_version) def _resolve_inherit_parent(self, obj_tree, inherit_version): # Resolve parent inheritance while avoiding circular recursion self.inherit_tmp = self.inherit self.inherit = None self.inherit_var.resolve_inherit(obj_tree, inherit_version) self.inherit = self.inherit_tmp self.inherit_tmp = None # Get current fields child_names = [child.name.lower() for child in self.children] # Import for parent objects self.in_children = [] for child in self.inherit_var.get_children(): if child.name.lower() not in child_names: self.in_children.append(child) def require_inherit(self): return True def get_overridden(self, field_name): ret_list = [] field_name = field_name.lower() for child in self.children: if field_name == child.name.lower(): ret_list.append(child) break if self.inherit_var is not None: ret_list += self.inherit_var.get_overridden(field_name) return ret_list def check_valid_parent(self): if self.parent is None: return False parent_type = self.parent.get_type() return parent_type != CLASS_TYPE_ID and parent_type < BLOCK_TYPE_ID def get_diagnostics(self): errors = [] for in_child in self.in_children: if (not self.abstract) and ( in_child.keywords.count(KEYWORD_ID_DICT["deferred"]) > 0 ): new_diag = Diagnostic( self.eline - 1, f'Deferred procedure "{in_child.name}" not implemented', severity=1, ) new_diag.add_related( path=in_child.file_ast.path, line=in_child.sline - 1, message="Inherited procedure declaration", ) errors.append(new_diag) return errors def get_actions(self, sline, eline): actions = [] edits = [] line_number = self.eline - 1 if (line_number < sline) or (line_number > eline): return actions if self.contains_start is None: edits.append( { **range_json(line_number, 0, line_number, 0), "newText": "CONTAINS\n", } ) # diagnostics = [] has_edits = False file_uri = path_to_uri(self.file_ast.path) for in_child in self.in_children: if in_child.keywords.count(KEYWORD_ID_DICT["deferred"]) > 0: # Get interface interface_string = in_child.get_interface( name_replace=in_child.name, change_strings=( f"class({in_child.parent.name})", f"CLASS({self.name})", ), ) if interface_string is None: continue interface_path, interface_edits = self.parent.add_subroutine( interface_string, no_contains=has_edits ) if interface_path != self.file_ast.path: continue edits.append( { **range_json(line_number, 0, line_number, 0), "newText": " PROCEDURE :: {0} => {0}\n".format(in_child.name), } ) edits += interface_edits new_diag = Diagnostic( line_number, f'Deferred procedure "{in_child.name}" not implemented', severity=1, ) new_diag.add_related( path=in_child.file_ast.path, line=in_child.sline - 1, message="Inherited procedure declaration", ) diagnostics.append(new_diag) has_edits = True # if has_edits: actions = [ { "title": "Implement deferred procedures", "kind": "quickfix", "edit": {"changes": {file_uri: edits}}, "diagnostics": diagnostics, } ] return actions def get_hover(self, long=False, drop_arg=-1) -> tuple[str, str]: keywords = [self.get_desc()] if self.abstract: keywords.append("ABSTRACT") if self.inherit: keywords.append(f"EXTENDS({self.inherit})") decl = ", ".join(keywords) hover = f"{decl} :: {self.name}" doc_str = self.get_documentation() return hover, doc_str fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/use.py000066400000000000000000000023531477231266000251620ustar00rootroot00000000000000from __future__ import annotations # Helper classes class Use: """AST node for USE statement""" def __init__( self, mod_name: str, only_list: set[str] = None, rename_map: dict[str, str] = None, line_number: int = 0, ): if only_list is None: only_list = set() if rename_map is None: rename_map = {} self.mod_name: str = mod_name.lower() self._line_no: int = line_number self.only_list: set[str] = only_list self.rename_map: dict[str, str] = rename_map if only_list: self.only_list: set[str] = {only.lower() for only in only_list} if rename_map: self.rename_map = {k.lower(): v.lower() for k, v in rename_map.items()} @property def line_number(self): return self._line_no @line_number.setter def line_number(self, line_number: int): self._line_no = line_number def rename(self, only_list: list[str] = None): """Rename ONLY:, statements""" if only_list is None: only_list = [] if not only_list: only_list = self.only_list return [self.rename_map.get(only_name, only_name) for only_name in only_list] fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/utilities.py000066400000000000000000000252571477231266000264110ustar00rootroot00000000000000from __future__ import annotations import contextlib from typing import TYPE_CHECKING from fortls.constants import MODULE_TYPE_ID from .imports import Import, ImportTypes from .use import Use if TYPE_CHECKING: from .scope import Scope def get_use_tree( scope: Scope, use_dict: dict[str, Use | Import], obj_tree: dict, only_list: list[str] = None, rename_map: dict[str, str] = None, curr_path: list[str] = None, ): if only_list is None: only_list = set() if rename_map is None: rename_map = {} if curr_path is None: curr_path = [] def intersect_only(use_stmnt: Use | Import): tmp_list = [] tmp_map = rename_map.copy() for val1 in only_list: mapped1 = tmp_map.get(val1, val1) if mapped1 in use_stmnt.only_list: tmp_list.append(val1) new_rename = use_stmnt.rename_map.get(mapped1, None) if new_rename is not None: tmp_map[val1] = new_rename else: tmp_map.pop(val1, None) return tmp_list, tmp_map # Detect and break circular references if scope.FQSN in curr_path: return use_dict new_path = curr_path + [scope.FQSN] # Add recursively for use_stmnt in scope.use: # if use_stmnt.mod_name not in obj_tree: if type(use_stmnt) is Use and use_stmnt.mod_name not in obj_tree: continue # Escape any IMPORT, NONE statements if type(use_stmnt) is Import and use_stmnt.import_type is ImportTypes.NONE: continue # Intersect parent and current ONLY list and renaming if not only_list: merged_use_list = use_stmnt.only_list.copy() merged_rename = use_stmnt.rename_map.copy() elif len(use_stmnt.only_list) == 0: merged_use_list = only_list.copy() merged_rename = rename_map.copy() else: merged_use_list, merged_rename = intersect_only(use_stmnt) if len(merged_use_list) == 0: continue # Update ONLY list and renaming for current module # If you have # USE MOD, ONLY: A # USE MOD, ONLY: B # or # IMPORT VAR # IMPORT VAR2 use_dict_mod = use_dict.get(use_stmnt.mod_name) if use_dict_mod is not None: old_len = len(use_dict_mod.only_list) if old_len > 0 and merged_use_list: only_len = old_len for only_name in merged_use_list: use_dict_mod.only_list.add(only_name) if len(use_dict_mod.only_list) == only_len: continue only_len = len(use_dict_mod.only_list) new_rename = merged_rename.get(only_name) if new_rename is None: continue use_dict_mod.rename_map = merged_rename use_dict[use_stmnt.mod_name] = use_dict_mod else: use_dict[use_stmnt.mod_name] = Use(use_stmnt.mod_name) # Skip if we have already visited module with the same only list if old_len == len(use_dict_mod.only_list): continue else: if type(use_stmnt) is Use: use_dict[use_stmnt.mod_name] = Use( mod_name=use_stmnt.mod_name, only_list=set(merged_use_list), rename_map=merged_rename, ) elif type(use_stmnt) is Import: use_dict[use_stmnt.mod_name] = Import( name=use_stmnt.mod_name, import_type=use_stmnt.import_type, only_list=set(merged_use_list), rename_map=merged_rename, ) with contextlib.suppress(AttributeError): use_dict[use_stmnt.mod_name].scope = scope.parent.parent # Do not descent the IMPORT tree, because it does not exist if type(use_stmnt) is Import: continue # Descend USE tree use_dict = get_use_tree( obj_tree[use_stmnt.mod_name][0], use_dict, obj_tree, merged_use_list, merged_rename, new_path, ) return use_dict def find_in_scope( scope: Scope, var_name: str, obj_tree: dict, interface: bool = False, local_only: bool = False, var_line_number: int = None, ): from .include import Include def check_scope( local_scope: Scope, var_name_lower: str, filter_public: bool = False, var_line_number: int = None, ): from .function import Function for child in local_scope.get_children(): if child.name.startswith("#GEN_INT"): tmp_var = check_scope(child, var_name_lower, filter_public) if tmp_var is not None: return tmp_var is_private = child.vis < 0 or (local_scope.def_vis < 0 and child.vis <= 0) if filter_public and is_private: continue if child.name.lower() == var_name_lower: # For functions with an implicit result() variable the name # of the function is used. If we are hovering over the function # definition, we do not want the implicit result() to be returned. # If scope is from a function and child's name is same as functions name # and start of scope i.e. function definition is equal to the request ln # then we are need to skip this child if ( isinstance(local_scope, Function) and local_scope.name.lower() == child.name.lower() and var_line_number in (local_scope.sline, local_scope.eline) ): return None return child return None def check_import_scope(scope: Scope, var_name_lower: str): for use_stmnt in scope.use: if type(use_stmnt) is not Import: continue if use_stmnt.import_type == ImportTypes.ONLY: # Check if name is in only list if var_name_lower in use_stmnt.only_list: return ImportTypes.ONLY # Get the parent scope elif use_stmnt.import_type == ImportTypes.ALL: return ImportTypes.ALL # Skip looking for parent scope elif use_stmnt.import_type == ImportTypes.NONE: return ImportTypes.NONE return None # var_name_lower = var_name.lower() # Check local scope if scope is None: return None tmp_var = check_scope(scope, var_name_lower, var_line_number=var_line_number) if local_only or (tmp_var is not None): return tmp_var # Check INCLUDE statements if scope.file_ast.include_statements: strip_str = var_name.replace('"', "") strip_str = strip_str.replace("'", "") for inc in scope.file_ast.include_statements: if strip_str == inc.path: if inc.file is None: return None return Include(inc.file.ast, inc.line_number, inc.path) # Setup USE search use_dict = get_use_tree(scope, {}, obj_tree) # Look in found use modules for use_mod, use_info in use_dict.items(): # If use_mod is Import then it will not exist in the obj_tree if type(use_info) is Import: continue use_scope = obj_tree[use_mod][0] # Module name is request if use_mod.lower() == var_name_lower: return use_scope # Filter children by only_list if len(use_info.only_list) > 0 and var_name_lower not in use_info.only_list: continue mod_name = use_info.rename_map.get(var_name_lower, var_name_lower) tmp_var = check_scope(use_scope, mod_name, filter_public=True) if tmp_var is not None: return tmp_var # Only search local and imported names for interfaces import_type = ImportTypes.DEFAULT if interface: import_type = check_import_scope(scope, var_name_lower) if import_type is None: return None # Check parent scopes if scope.parent is not None and import_type != ImportTypes.NONE: tmp_var = find_in_scope(scope.parent, var_name, obj_tree) if tmp_var is not None: return tmp_var # Check ancestor scopes for ancestor in scope.get_ancestors(): tmp_var = find_in_scope(ancestor, var_name, obj_tree) if tmp_var is not None: return tmp_var return None def find_in_workspace( obj_tree: dict, query: str, filter_public: bool = False, exact_match: bool = False ): def add_children(mod_obj, query: str): tmp_list = [] for child_obj in mod_obj.get_children(filter_public): if child_obj.name.lower().find(query) >= 0: tmp_list.append(child_obj) return tmp_list matching_symbols = [] query = query.lower() for _, obj_packed in obj_tree.items(): top_obj = obj_packed[0] top_uri = obj_packed[1] if top_uri is not None: if top_obj.name.lower().find(query) > -1: matching_symbols.append(top_obj) if top_obj.get_type() == MODULE_TYPE_ID: matching_symbols += add_children(top_obj, query) if exact_match: filtered_symbols = [] n = len(query) for symbol in matching_symbols: if len(symbol.name) == n: filtered_symbols.append(symbol) matching_symbols = filtered_symbols return matching_symbols def climb_type_tree(var_stack, curr_scope: Scope, obj_tree: dict): """Walk up user-defined type sequence to determine final field type""" # Find base variable in current scope iVar = 0 var_name = var_stack[iVar].strip().lower() var_obj = find_in_scope(curr_scope, var_name, obj_tree) if var_obj is None: return None # Search for type, then next variable in stack and so on for _ in range(30): # Find variable type object type_obj = var_obj.get_type_obj(obj_tree) # Return if not found if type_obj is None: return None # Go to next variable in stack and exit if done iVar += 1 if iVar == len(var_stack) - 1: break # Find next variable by name in type var_name = var_stack[iVar].strip().lower() var_obj = find_in_scope(type_obj, var_name, obj_tree, local_only=True) # Return if not found if var_obj is None: return None else: raise KeyError return type_obj fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/variable.py000066400000000000000000000213021477231266000261460ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from fortls.constants import CLASS_TYPE_ID, KEYWORD_ID_DICT, VAR_TYPE_ID, FRegex from fortls.helper_functions import fortran_md, get_keywords, get_paren_substring from .base import FortranObj from .diagnostics import Diagnostic from .utilities import find_in_scope, find_in_workspace if TYPE_CHECKING: from .ast import FortranAST from .imports import Import from .use import Use class Variable(FortranObj): def __init__( self, file_ast: FortranAST, line_number: int, name: str, var_desc: str, keywords: list, keyword_info: dict = None, kind: str | None = None, link_obj=None, ): super().__init__() if keyword_info is None: keyword_info = {} self.file_ast: FortranAST = file_ast self.sline: int = line_number self.eline: int = line_number self.name: str = name self.desc: str = var_desc self.keywords: list = keywords self.keyword_info: dict = keyword_info self.kind: str | None = kind self.children: list = [] self.use: list[Use | Import] = [] self.link_obj = None self.type_obj = None self.is_const: bool = False self.is_external: bool = False self.param_val: str = None self.link_name: str = None self.callable: bool = FRegex.CLASS_VAR.match(self.get_desc(True)) is not None self.FQSN: str = self.name.lower() if link_obj is not None: self.link_name = link_obj.lower() if file_ast.enc_scope_name is not None: self.FQSN = f"{file_ast.enc_scope_name.lower()}::{self.name.lower()}" if self.keywords.count(KEYWORD_ID_DICT["public"]) > 0: self.vis = 1 if self.keywords.count(KEYWORD_ID_DICT["private"]) > 0: self.vis = -1 if self.keywords.count(KEYWORD_ID_DICT["parameter"]) > 0: self.is_const = True if ( self.keywords.count(KEYWORD_ID_DICT["external"]) > 0 or self.desc.lower() == "external" ): self.is_external = True def update_fqsn(self, enc_scope=None): if enc_scope is not None: self.FQSN = f"{enc_scope.lower()}::{self.name.lower()}" else: self.FQSN = self.name.lower() for child in self.children: child.update_fqsn(self.FQSN) def resolve_link(self, obj_tree): self.link_obj = None if self.link_name is None: return if self.parent is not None: link_obj = find_in_scope(self.parent, self.link_name, obj_tree) if link_obj is not None: self.link_obj = link_obj def require_link(self): return self.link_name is not None def get_type(self, no_link=False): if (not no_link) and (self.link_obj is not None): return self.link_obj.get_type() # Normal variable return VAR_TYPE_ID def get_desc(self, no_link=False): if not no_link and self.link_obj is not None: return self.link_obj.get_desc() # Normal variable return self.desc + self.kind if self.kind else self.desc def get_type_obj(self, obj_tree): if self.link_obj is not None: return self.link_obj.get_type_obj(obj_tree) if (self.type_obj is None) and (self.parent is not None): type_name = get_paren_substring(self.get_desc(no_link=True)) if type_name is not None: search_scope = self.parent if search_scope.get_type() == CLASS_TYPE_ID: search_scope = search_scope.parent if search_scope is not None: type_name = type_name.strip().lower() type_obj = find_in_scope(search_scope, type_name, obj_tree) if type_obj is not None: self.type_obj = type_obj return self.type_obj # XXX: unused delete or use for associate blocks def set_dim(self, dim_str): if KEYWORD_ID_DICT["dimension"] not in self.keywords: self.keywords.append(KEYWORD_ID_DICT["dimension"]) self.keyword_info["dimension"] = dim_str self.keywords.sort() def get_snippet(self, name_replace=None, drop_arg=-1): name = name_replace if name_replace is not None else self.name if self.link_obj is not None: return self.link_obj.get_snippet(name, drop_arg) # Normal variable return None, None def get_hover(self, long=False, drop_arg=-1) -> tuple[str, str]: doc_str = self.get_documentation() # In associated blocks we need to fetch the desc and keywords of the # linked object hover_str = ", ".join([self.get_desc()] + self.get_keywords()) # If this is not a preprocessor variable, we can append the variable name if not hover_str.startswith("#"): hover_str += f" :: {self.name}" if self.is_parameter() and self.param_val: hover_str += f" = {self.param_val}" return hover_str, doc_str def get_hover_md(self, long=False, drop_arg=-1): return fortran_md(*self.get_hover(long, drop_arg)) def get_keywords(self): # TODO: if local keywords are set they should take precedence over link_obj # Alternatively, I could do a dictionary merge with local variables # having precedence by default and use a flag to override? if self.link_obj is not None: return get_keywords(self.link_obj.keywords, self.link_obj.keyword_info) return get_keywords(self.keywords, self.keyword_info) def is_optional(self): return self.keywords.count(KEYWORD_ID_DICT["optional"]) > 0 def is_callable(self): return self.callable def is_parameter(self): return self.is_const def set_parameter_val(self, val: str): self.param_val = val def set_external_attr(self): self.keywords.append(KEYWORD_ID_DICT["external"]) self.is_external = True def check_definition(self, obj_tree, known_types=None, interface=False): if known_types is None: known_types = {} # Check for type definition in scope type_match = FRegex.DEF_KIND.match(self.get_desc(no_link=True)) if type_match is not None: var_type = type_match.group(1).strip().lower() if var_type == "procedure": return None, known_types desc_obj_name = type_match.group(2).strip().lower() if desc_obj_name not in known_types: type_def = find_in_scope( self.parent, desc_obj_name, obj_tree, interface=interface, ) if type_def is None: self._check_definition_type_def( obj_tree, desc_obj_name, known_types, type_match ) else: known_types[desc_obj_name] = (0, type_def) type_info = known_types[desc_obj_name] if type_info is not None and type_info[0] == 1: if interface: out_diag = Diagnostic( self.sline - 1, message=f'Object "{desc_obj_name}" not imported in interface', severity=1, find_word=desc_obj_name, ) else: out_diag = Diagnostic( self.sline - 1, message=f'Object "{desc_obj_name}" not found in scope', severity=1, find_word=desc_obj_name, ) type_def = type_info[1] out_diag.add_related( path=type_def.file_ast.path, line=type_def.sline - 1, message="Possible object", ) return out_diag, known_types return None, known_types def _check_definition_type_def( self, obj_tree, desc_obj_name, known_types, type_match ): type_defs = find_in_workspace( obj_tree, desc_obj_name, filter_public=True, exact_match=True, ) known_types[desc_obj_name] = None var_type = type_match.group(1).strip().lower() filter_id = VAR_TYPE_ID if var_type in ["class", "type"]: filter_id = CLASS_TYPE_ID for type_def in type_defs: if type_def.get_type() == filter_id: known_types[desc_obj_name] = (1, type_def) break fortran-language-server-3.2.2+dfsg/fortls/parsers/internal/where.py000066400000000000000000000007121477231266000254750ustar00rootroot00000000000000from __future__ import annotations from typing import TYPE_CHECKING from fortls.constants import WHERE_TYPE_ID from .block import Block if TYPE_CHECKING: from .ast import FortranAST class Where(Block): def __init__(self, file_ast: FortranAST, line_number: int, name: str): super().__init__(file_ast, line_number, name) def get_type(self, no_link=False): return WHERE_TYPE_ID def get_desc(self): return "WHERE" fortran-language-server-3.2.2+dfsg/fortls/regex_patterns.py000066400000000000000000000213721477231266000241270ustar00rootroot00000000000000from __future__ import annotations from dataclasses import dataclass from re import I, compile from typing import Pattern @dataclass(frozen=True) class FortranRegularExpressions: USE: Pattern = compile( r"[ ]*USE([, ]+(?:INTRINSIC|NON_INTRINSIC))?[ :]+(\w*)([, ]+ONLY[ :]+)?", I, ) IMPORT: Pattern = compile( r"[ ]*IMPORT" r"(?:" r"[ ]*,[ ]*(?PALL|NONE)" # import, [all | none] r"|" # or r"[ ]*,[ ]*(?PONLY)[ ]*:[ ]*(?P[\w_])" # import, only: name-list r"|" # or r"[ ]+(?:::[ ]*)?(?P[\w_])" # import [[::] name-list] r")?", # standalone import I, ) INCLUDE: Pattern = compile(r"[ ]*INCLUDE[ :]*[\'\"]([^\'\"]*)", I) CONTAINS: Pattern = compile(r"[ ]*(CONTAINS)[ ]*$", I) IMPLICIT: Pattern = compile(r"[ ]*IMPLICIT[ ]+([a-z]*)", I) #: Parse procedure keywords but not if they start with , or ( or end with , or ) #: This is to avoid parsing as keywords variables named pure, impure, etc. SUB_MOD: Pattern = compile( r"[ ]*(?!<[,\()][ ]*)\b(PURE|IMPURE|ELEMENTAL|RECURSIVE)\b(?![,\)][ ]*)", I ) SUB: Pattern = compile(r"[ ]*SUBROUTINE[ ]+(\w+)", I) END_SUB: Pattern = compile(r"SUBROUTINE", I) FUN: Pattern = compile(r"[ ]*FUNCTION[ ]+(\w+)", I) RESULT: Pattern = compile(r"RESULT[ ]*\((\w*)\)", I) END_FUN: Pattern = compile(r"FUNCTION", I) MOD: Pattern = compile(r"[ ]*MODULE[ ]+(\w+)", I) END_MOD: Pattern = compile(r"MODULE", I) SUBMOD: Pattern = compile(r"[ ]*SUBMODULE[ ]*\(", I) END_SMOD: Pattern = compile(r"SUBMODULE", I) END_PRO: Pattern = compile(r"(MODULE)?[ ]*PROCEDURE", I) BLOCK: Pattern = compile(r"[ ]*([a-z_]\w*[ ]*:[ ]*)?BLOCK|CRITICAL(?!\w)", I) END_BLOCK: Pattern = compile(r"BLOCK|CRITICAL", I) DO: Pattern = compile(r"[ ]*(?:[a-z_]\w*[ ]*:[ ]*)?DO([ ]+[0-9]*|$)", I) END_DO: Pattern = compile(r"DO", I) WHERE: Pattern = compile(r"[ ]*WHERE[ ]*\(", I) END_WHERE: Pattern = compile(r"WHERE", I) IF: Pattern = compile(r"[ ]*(?:[a-z_]\w*[ ]*:[ ]*)?IF[ ]*\(", I) THEN: Pattern = compile(r"\)[ ]*THEN$", I) END_IF: Pattern = compile(r"IF", I) ASSOCIATE: Pattern = compile(r"[ ]*ASSOCIATE[ ]*\(", I) END_ASSOCIATE: Pattern = compile(r"ASSOCIATE", I) END_FIXED: Pattern = compile(r"[ ]*([0-9]*)[ ]*CONTINUE", I) SELECT: Pattern = compile( r"[ ]*(?:[a-z_]\w*[ ]*:[ ]*)?SELECT[ ]*" r"(CASE|TYPE)[ ]*\(([\w=> ]*)", I, ) SELECT_TYPE: Pattern = compile(r"[ ]*(TYPE|CLASS)[ ]+IS[ ]*\(([\w ]*)", I) SELECT_DEFAULT: Pattern = compile(r"[ ]*CLASS[ ]+DEFAULT", I) END_SELECT: Pattern = compile(r"SELECT", I) PROG: Pattern = compile(r"[ ]*PROGRAM[ ]+(\w+)", I) END_PROG: Pattern = compile(r"PROGRAM", I) INT: Pattern = compile(r"[ ]*(ABSTRACT)?[ ]*INTERFACE[ ]*(\w*)", I) END_INT: Pattern = compile(r"INTERFACE", I) END_WORD: Pattern = compile( r"[ ]*END[ ]*(DO|WHERE|IF|BLOCK|CRITICAL|ASSOCIATE|SELECT" r"|TYPE|ENUM|MODULE|SUBMODULE|PROGRAM|INTERFACE" r"|SUBROUTINE|FUNCTION|PROCEDURE|FORALL)?([ ]+(?!\W)|$)", I, ) TYPE_DEF: Pattern = compile(r"[ ]*(TYPE)[, :]+", I) EXTENDS: Pattern = compile(r"EXTENDS[ ]*\((\w*)\)", I) GENERIC_PRO: Pattern = compile( r"[ ]*(GENERIC)[, ]*(PRIVATE|PUBLIC)?[ ]*::[ ]*[a-z]", I ) GEN_ASSIGN: Pattern = compile(r"(ASSIGNMENT|OPERATOR)\(", I) END_TYPED: Pattern = compile(r"TYPE", I) ENUM_DEF: Pattern = compile(r"[ ]*ENUM[, ]+", I) END_ENUMD: Pattern = compile(r"ENUM", I) VAR: Pattern = compile( r"[ ]*(INTEGER|REAL|DOUBLE[ ]*PRECISION|COMPLEX" r"|DOUBLE[ ]*COMPLEX|CHARACTER|LOGICAL|PROCEDURE" r"|EXTERNAL|CLASS|TYPE)", # external :: variable is handled by this I, ) KIND_SPEC: Pattern = compile(r"[ ]*([*]?\([ ]*[\w*:]|\*[ ]*[0-9:]*)", I) KEYWORD_LIST: Pattern = compile( r"[ ]*,[ ]*(PUBLIC|PRIVATE|ALLOCATABLE|" r"POINTER|TARGET|DIMENSION[ ]*\(|" r"OPTIONAL|INTENT[ ]*\([ ]*(?:IN|OUT|IN[ ]*OUT)[ ]*\)|DEFERRED|NOPASS|" r"PASS[ ]*\(\w*\)|SAVE|PARAMETER|EXTERNAL|" r"CONTIGUOUS)", I, ) PARAMETER_VAL: Pattern = compile(r"\w*[\s\&]*=(([\s\&]*[\w\.\-\+\*\/\'\"])*)", I) TATTR_LIST: Pattern = compile( r"[ ]*,[ ]*(PUBLIC|PRIVATE|ABSTRACT|EXTENDS\(\w*\))", I ) VIS: Pattern = compile(r"[ ]*\b(PUBLIC|PRIVATE)\b", I) WORD: Pattern = compile(r"[a-z_][\w\$]*", I) NUMBER: Pattern = compile( r"[\+\-]?(\b\d+\.?\d*|\.\d+)(_\w+|d[\+\-]?\d+|e[\+\-]?\d+(_\w+)?)?(?!\w)", I, ) LOGICAL: Pattern = compile(r".true.|.false.", I) SUB_PAREN: Pattern = compile(r"\([\w, ]*\)", I) # KIND_SPEC_MATCH: Pattern = compile(r"\([\w, =*]*\)", I) SQ_STRING: Pattern = compile(r"\'[^\']*\'", I) DQ_STRING: Pattern = compile(r"\"[^\"]*\"", I) LINE_LABEL: Pattern = compile(r"[ ]*([0-9]+)[ ]+", I) NON_DEF: Pattern = compile(r"[ ]*(CALL[ ]+[a-z_]|[a-z_][\w%]*[ ]*=)", I) # Fixed format matching rules FIXED_COMMENT: Pattern = compile(r"([!cd*])", I) FIXED_CONT: Pattern = compile(r"( {5}[\S])") FIXED_DOC: Pattern = compile(r"(?:[!cd\*])([<>!])", I) FIXED_OPENMP: Pattern = compile(r"[!c\*]\$OMP", I) # Free format matching rules FREE_COMMENT: Pattern = compile(r"([ ]*!)") FREE_CONT: Pattern = compile(r"([ ]*&)") FREE_DOC: Pattern = compile(r"[ ]*!([<>!])") FREE_OPENMP: Pattern = compile(r"[ ]*!\$OMP", I) FREE_FORMAT_TEST: Pattern = compile(r"[ ]{1,4}[a-z]", I) # Preprocessor matching rules DEFINED: Pattern = compile(r"defined[ ]*\(?[ ]*([a-z_]\w*)[ ]*\)?", I) PP_REGEX: Pattern = compile(r"[ ]*#[ ]*(if |ifdef|ifndef|else|elif|endif)", I) PP_DEF: Pattern = compile( r"[ ]*#[ ]*(define|undef|undefined)[ ]*(\w+)(\([ ]*([ \w,]*?)[ ]*\))?", I, ) PP_DEF_TEST: Pattern = compile(r"(![ ]*)?defined[ ]*\([ ]*(\w*)[ ]*\)$", I) PP_INCLUDE: Pattern = compile(r"[ ]*#[ ]*include[ ]*([\"\w\.]*)", I) PP_ANY: Pattern = compile(r"^[ ]*#:?[ ]*(\w+)") # Context matching rules CALL: Pattern = compile(r"[ ]*CALL[ ]+[\w%]*$", I) INT_STMNT: Pattern = compile(r"^[ ]*[a-z]*$", I) TYPE_STMNT: Pattern = compile(r"[ ]*(TYPE|CLASS)[ ]*(IS)?[ ]*$", I) PROCEDURE_STMNT: Pattern = compile(r"[ ]*(PROCEDURE)[ ]*$", I) PRO_LINK: Pattern = compile(r"[ ]*(MODULE[ ]*PROCEDURE )", I) SCOPE_DEF: Pattern = compile( r"[ ]*(MODULE|PROGRAM|SUBROUTINE|FUNCTION|INTERFACE)[ ]+", I ) END: Pattern = compile( r"[ ]*(END)(" r" |MODULE|PROGRAM|SUBROUTINE|FUNCTION|PROCEDURE|TYPE|DO|IF|SELECT)?", I, ) # Object regex patterns CLASS_VAR: Pattern = compile(r"(TYPE|CLASS)[ ]*\(", I) DEF_KIND: Pattern = compile(r"(\w*)[ ]*\((?:KIND|LEN)?[ =]*(\w*)", I) OBJBREAK: Pattern = compile(r"[\/\-(.,+*<>=: ]", I) # TODO: use this in the main code def create_src_file_exts_regex(input_exts: list[str] = []) -> Pattern[str]: r"""Create a REGEX for which sources the Language Server should parse. Default extensions are (case insensitive): F F03 F05 F08 F18 F77 F90 F95 FOR FPP Parameters ---------- input_exts : list[str], optional Additional list of file extensions to parse, in Python REGEX format that means special characters must be escaped , by default [] Examples -------- >>> regex = create_src_file_exts_regex([r"\.fypp", r"\.inc"]) >>> regex.search("test.fypp") >>> regex.search("test.inc") >>> regex = create_src_file_exts_regex([r"\.inc.*"]) >>> regex.search("test.inc.1") Invalid regex expressions will cause the function to revert to the default extensions >>> regex = create_src_file_exts_regex(["*.inc"]) >>> regex.search("test.inc") is None True Returns ------- Pattern[str] A compiled regular expression for matching file extensions """ import re DEFAULT = r"\.[fF](77|90|95|03|05|08|18|[oO][rR]|[pP]{2})?" EXPRESSIONS = [DEFAULT] try: EXPRESSIONS.extend(input_exts) # Add its expression as an OR and force they match the end of the string return re.compile(rf"(({'$)|('.join(EXPRESSIONS)}$))") except re.error: # TODO: Add a warning to the logger return re.compile(rf"({DEFAULT}$)") def create_src_file_exts_str(input_exts: list[str] = []) -> Pattern[str]: """This is a version of create_src_file_exts_regex that takes a list sanitises the list of input_exts before compiling the regex. For more info see create_src_file_exts_regex """ import re input_exts = [re.escape(ext) for ext in input_exts] return create_src_file_exts_regex(input_exts) fortran-language-server-3.2.2+dfsg/fortls/schema.py000066400000000000000000000021531477231266000223310ustar00rootroot00000000000000from __future__ import annotations import json import pathlib from pydantic import Field, create_model from fortls.interface import cli def create_schema(root: pathlib.Path | None = None): if not root: root = pathlib.Path(__file__).parent parser = cli("fortls") only_vals = {} for arg in parser._actions: if ( arg.dest == "help" or arg.dest == "version" or arg.help == "==SUPPRESS==" or (arg.dest.startswith("debug") and arg.dest != "debug_log") ): continue val = arg.default desc: str = arg.help.replace("%(default)s", str(val)) # type: ignore only_vals[arg.dest] = (type(val), Field(val, description=desc)) # type: ignore m = create_model("fortls schema", **only_vals) m.__doc__ = "Schema for the fortls Fortran Language Server" with open(str(root / "fortls.schema.json"), "w", encoding="utf-8") as f: print(json.dumps(m.model_json_schema(), indent=2), file=f) print(f"Created schema file: {root / 'fortls.schema.json'}") if __name__ == "__main__": create_schema() fortran-language-server-3.2.2+dfsg/fortls/version.py000066400000000000000000000005271477231266000225610ustar00rootroot00000000000000try: from importlib.metadata import PackageNotFoundError, version except ModuleNotFoundError: from importlib_metadata import PackageNotFoundError, version try: __version__ = version(__package__) except PackageNotFoundError: from setuptools_scm import get_version __version__ = get_version(root="..", relative_to=__file__) fortran-language-server-3.2.2+dfsg/licenses/000077500000000000000000000000001477231266000210125ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/licenses/fortran-language-server-license.txt000066400000000000000000000020701477231266000277320ustar00rootroot00000000000000The MIT License (MIT) Copyright 2017-2019 Chris Hansen Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. fortran-language-server-3.2.2+dfsg/pyproject.toml000066400000000000000000000046741477231266000221340ustar00rootroot00000000000000[build-system] requires = ["setuptools >= 61", "wheel", "setuptools_scm[toml] >= 7.0"] build-backend = "setuptools.build_meta" [project] name = "fortls" description = "fortls - Fortran Language Server" readme = "README.md" authors = [{ name = "Giannis Nikiteas", email = "giannis.nikiteas@gmail.com" }] license = { text = "MIT" } classifiers = [ "Development Status :: 4 - Beta", "Intended Audience :: Developers", "Intended Audience :: Science/Research", "License :: OSI Approved :: MIT License", "Natural Language :: English", "Programming Language :: Python", "Programming Language :: Python :: 3", "Programming Language :: Python :: 3.7", "Programming Language :: Python :: 3.8", "Programming Language :: Python :: 3.9", "Programming Language :: Python :: 3.10", "Programming Language :: Python :: 3.11", "Programming Language :: Python :: 3.12", "Programming Language :: Fortran", "Operating System :: Microsoft :: Windows", "Operating System :: POSIX", "Operating System :: Unix", "Operating System :: MacOS", ] keywords = [ "fortran", "language server", "language server protocol", "lsp", "fortls", ] dynamic = ["version"] requires-python = ">=3.7" dependencies = [ "json5", "packaging", "importlib-metadata; python_version < '3.8'", "typing-extensions; python_version < '3.8'", ] [project.optional-dependencies] dev = [ "pytest >= 7.2.0", "pytest-cov >= 4.0.0", "pytest-xdist >= 3.0.2", "black", "isort", "pre-commit", "pydantic", ] docs = [ "sphinx >= 4.0.0", "sphinx-argparse", "sphinx-autodoc-typehints", "sphinx_design", "sphinx-copybutton", "furo", "myst-parser", "sphinx-sitemap", ] [project.urls] homepage = "https://fortls.fortran-lang.org" Documentation = "https://fortls.fortran-lang.org" Changes = "https://github.com/fortran-lang/fortls/blob/master/CHANGELOG.md" Tracker = "https://github.com/fortran-lang/fortls/issues" "Source Code" = "https://github.com/fortran-lang/fortls" [project.scripts] fortls = "fortls.__init__:main" [tool.setuptools.packages.find] include = ["fortls*"] [tool.setuptools.package-data] fortls = ["parsers/internal/*.json"] [tool.setuptools_scm] write_to = "fortls/_version.py" [tool.isort] profile = "black" [tool.pytest.ini_options] minversion = "7.2.0" addopts = "-v --cov=fortls --cov-report=html --cov-report=xml --cov-context=test" testpaths = ["fortls", "test"] fortran-language-server-3.2.2+dfsg/setup.cfg000066400000000000000000000000711477231266000210240ustar00rootroot00000000000000[flake8] max-line-length = 88 extend-ignore = E203, E722 fortran-language-server-3.2.2+dfsg/setup.py000066400000000000000000000001461477231266000207200ustar00rootroot00000000000000#!/usr/bin/env python """Builds the fortls Language Server""" import setuptools setuptools.setup() fortran-language-server-3.2.2+dfsg/test/000077500000000000000000000000001477231266000201645ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/setup_tests.py000066400000000000000000000037451477231266000231310ustar00rootroot00000000000000from __future__ import annotations import shlex import subprocess import sys from io import StringIO from pathlib import Path root_dir = Path(__file__).parent.parent.resolve() sys.path.insert(0, root_dir) # Compromise since isort does not respect noqa from fortls.jsonrpc import path_to_uri # noqa: E402, F401 from fortls.jsonrpc import read_rpc_messages # noqa: E402 from fortls.jsonrpc import write_rpc_notification # noqa: E402, F401 from fortls.jsonrpc import write_rpc_request # noqa: E402, F401 test_dir = root_dir / "test" / "test_source" def check_post_msg(result: dict, msg: str, severity: int): assert result["type"] == severity assert result["message"] == msg def run_request(request, fortls_args: list[str] = None): command = [ sys.executable, "-m", "fortls", "--incremental_sync", ] if fortls_args: # Input args might not be sanitised, fix that for i in fortls_args: command.extend(shlex.split(i, posix=False)) pid = subprocess.Popen( command, stdin=subprocess.PIPE, stdout=subprocess.PIPE, stderr=subprocess.PIPE, ) results = pid.communicate(input=request.encode()) tmp_file = StringIO(results[0].decode()) results = read_rpc_messages(tmp_file) parsed_results = [] for result in results: try: parsed_results.append(result["result"]) except KeyError: try: # Present in `method`s parsed_results.append(result["params"]) except Exception as exc: raise RuntimeError( "Only 'result' and 'params' keys have been implemented for testing." " Please add the new key." ) from exc except Exception as exc: raise RuntimeError( "Unexpected error encountered trying to extract server results" ) from exc errcode = pid.poll() return errcode, parsed_results fortran-language-server-3.2.2+dfsg/test/test_interface.py000066400000000000000000000133741477231266000235450ustar00rootroot00000000000000import os import sys from pathlib import Path sys.path.insert(0, os.path.join(os.path.dirname(__file__), "..")) from fortls.interface import cli # noqa: E402 parser = cli("fortls") def test_command_line_general_options(): args = parser.parse_args( "-c config_file.json -n 2 --notify_init --incremental_sync --sort_keywords" " --disable_autoupdate --debug_log".split() ) assert args.config == "config_file.json" assert args.nthreads == 2 assert args.notify_init assert args.incremental_sync assert args.sort_keywords assert args.disable_autoupdate assert args.debug_log def test_command_line_file_parsing_options(): args = parser.parse_args( "--source_dirs tmp ./local /usr/include/** --incl_suffixes .FF .fpc .h f20" " --excl_suffixes _tmp.f90 _h5hut_tests.F90 --excl_paths exclude tests".split() ) assert args.source_dirs == {"tmp", "./local", "/usr/include/**"} assert args.incl_suffixes == {".FF", ".fpc", ".h", "f20"} assert args.excl_suffixes == {"_tmp.f90", "_h5hut_tests.F90"} assert args.excl_paths == {"exclude", "tests"} def test_command_line_autocomplete_options(): args = parser.parse_args( "--autocomplete_no_prefix --autocomplete_no_snippets --autocomplete_name_only" " --lowercase_intrinsics --use_signature_help".split() ) assert args.autocomplete_no_prefix assert args.autocomplete_no_snippets assert args.autocomplete_name_only assert args.lowercase_intrinsics assert args.use_signature_help def test_command_line_hover_options(): args = parser.parse_args( "--hover_signature --hover_language FortranFreeForm".split() ) assert args.hover_signature assert args.hover_language == "FortranFreeForm" def test_command_line_diagnostic_options(): args = parser.parse_args( "--max_line_length 80 --max_comment_line_length 8 --disable_diagnostics".split() ) assert args.max_line_length == 80 assert args.max_comment_line_length == 8 assert args.disable_diagnostics def test_command_line_preprocessor_options(): args = parser.parse_args( "--pp_suffixes .h .fh --include_dirs /usr/include/** ./local/incl --pp_defs" ' {"HAVE_PETSC":"","HAVE_ZOLTAN":"","Mat":"type(tMat)"}'.split() ) assert args.pp_suffixes == [".h", ".fh"] assert args.include_dirs == {"/usr/include/**", "./local/incl"} assert args.pp_defs == {"HAVE_PETSC": "", "HAVE_ZOLTAN": "", "Mat": "type(tMat)"} def test_command_line_symbol_options(): args = parser.parse_args("--symbol_skip_mem".split()) assert args.symbol_skip_mem def test_command_line_code_actions_options(): args = parser.parse_args("--enable_code_actions".split()) assert args.enable_code_actions def unittest_server_init(conn=None): from fortls.langserver import LangServer root = (Path(__file__).parent / "test_source").resolve() parser = cli("fortls") args = parser.parse_args("-c f90_config.json".split()) server = LangServer(conn, vars(args)) server.root_path = root server._load_config_file() return server, root def test_config_file_general_options(): server, root = unittest_server_init() assert server.nthreads == 8 assert server.notify_init assert server.incremental_sync assert server.sort_keywords assert server.disable_autoupdate assert server.recursion_limit == 1500 def test_config_file_dir_parsing_options(): server, r = unittest_server_init() # File parsing assert server.source_dirs == {"pp/**", "subdir"} assert server.incl_suffixes == {".FF", ".fpc", ".h", "f20"} assert server.excl_suffixes == {"_tmp.f90", "_h5hut_tests.F90"} assert server.excl_paths == {"excldir", "hover/**"} def test_config_file_autocomplete_options(): server, root = unittest_server_init() # Autocomplete options assert server.autocomplete_no_prefix assert server.autocomplete_no_snippets assert server.autocomplete_name_only assert server.lowercase_intrinsics assert server.use_signature_help def test_config_file_hover_options(): server, root = unittest_server_init() # Hover options assert server.hover_signature assert server.hover_language == "FortranFreeForm" def test_config_file_diagnostic_options(): server, root = unittest_server_init() # Diagnostic options assert server.max_line_length == 80 assert server.max_comment_line_length == 80 assert server.disable_diagnostics def test_config_file_preprocessor_options(): server, root = unittest_server_init() # Preprocessor options assert server.pp_suffixes == [".h", ".fh"] assert server.include_dirs == {"./include/**"} assert server.pp_defs == { "HAVE_PETSC": "", "HAVE_ZOLTAN": "", "Mat": "type(tMat)", } def test_config_file_symbols_options(): server, root = unittest_server_init() # Symbols options assert server.symbol_skip_mem def test_config_file_codeactions_options(): server, root = unittest_server_init() # Code Actions options assert server.enable_code_actions def test_version_update_pypi(): from packaging import version from fortls.jsonrpc import JSONRPC2Connection, ReadWriter stdin, stdout = sys.stdin.buffer, sys.stdout.buffer s, root = unittest_server_init(JSONRPC2Connection(ReadWriter(stdin, stdout))) s.disable_autoupdate = False did_update = s._update_version_pypi(test=True) isconda = os.path.exists(os.path.join(sys.prefix, "conda-meta")) assert not did_update if isconda else did_update s.disable_autoupdate = True did_update = s._update_version_pypi() assert not did_update s.disable_autoupdate = False s._version = version.parse("999.0.0") did_update = s._update_version_pypi() assert not did_update fortran-language-server-3.2.2+dfsg/test/test_parser.py000066400000000000000000000057421477231266000231010ustar00rootroot00000000000000import pytest from setup_tests import test_dir from fortls.parsers.internal.parser import FortranFile def test_line_continuations(): file_path = test_dir / "parse" / "line_continuations.f90" file = FortranFile(str(file_path)) err_str, _ = file.load_from_disk() assert err_str is None try: file.parse() assert True except Exception as e: print(e) assert False def test_submodule(): file_path = test_dir / "parse" / "submodule.f90" file = FortranFile(str(file_path)) err_str, _ = file.load_from_disk() assert err_str is None try: ast = file.parse() assert True assert ast.scope_list[0].name == "val" assert ast.scope_list[0].ancestor_name == "p1" assert ast.scope_list[1].name == "" assert ast.scope_list[1].ancestor_name == "p2" except Exception as e: print(e) assert False def test_private_visibility_interfaces(): file_path = test_dir / "vis" / "private.f90" file = FortranFile(str(file_path)) err_str, _ = file.load_from_disk() file.parse() assert err_str is None def test_end_scopes_semicolon(): file_path = test_dir / "parse" / "trailing_semicolon.f90" file = FortranFile(str(file_path)) err_str, _ = file.load_from_disk() ast = file.parse() assert err_str is None assert not ast.end_errors def test_weird_parser_bug(): file_path = test_dir / "parse" / "mixed" / "preproc_and_normal_syntax.F90" file = FortranFile(str(file_path)) err_str, _ = file.load_from_disk() ast = file.parse() assert err_str is None assert not ast.end_errors @pytest.mark.parametrize( "ln_no, pp_defs, reference", [ (6, {}, 6), (7, {}, 6), (8, {}, 6), (11, {"TEST": True}, 60), # not entirely correct ref vals (23, {"MULT": True}, 90), # not entirely correct ref vals (32, {"TEST": True, "MULT": True}, 130), # not entirely correct ref vals (39, {"TEST": True, "MULT": True}, 2400), # not entirely correct ref vals ], ) def test_get_code_line_multilines(ln_no: int, pp_defs: dict, reference: int): """Tests how the get_code_line performs with multi-line and preprocessor Not all the results are correct, since get_code_line is not aware of the preprocessor skips. Instead what it does is it evaluates all the line continuations and appends them in post. """ def calc_result(res: tuple): pre, cur, post = res res = "".join(pre + [cur] + post).replace(" ", "") assert "result" in res, "Fortran variable `result` not found in results" loc = {} exec(res, None, loc) return loc["result"] file_path = test_dir / "parse" / "mixed" / "multilines.F90" file = FortranFile(str(file_path)) file.load_from_disk() file.preprocess(pp_defs=pp_defs) pp = bool(pp_defs) res = file.get_code_line(line_no=ln_no, pp_content=pp) result = calc_result(res) assert result == reference fortran-language-server-3.2.2+dfsg/test/test_preproc.py000066400000000000000000000063401477231266000232520ustar00rootroot00000000000000from __future__ import annotations from setup_tests import run_request, test_dir, write_rpc_request def test_hover(): def hover_req(file_path: str, ln: int, col: int) -> str: return write_rpc_request( 1, "textDocument/hover", { "textDocument": {"uri": str(file_path)}, "position": {"line": ln, "character": col}, }, ) def check_return(result_array, checks): assert len(result_array) == len(checks) for i, check in enumerate(checks): assert result_array[i]["contents"]["value"] == check root_dir = test_dir / "pp" string = write_rpc_request(1, "initialize", {"rootPath": str(root_dir)}) file_path = root_dir / "preproc.F90" string += hover_req(file_path, 5, 8) # user defined type string += hover_req(file_path, 7, 30) # variable string += hover_req(file_path, 7, 40) # multi-lin variable string += hover_req(file_path, 8, 7) # function with if conditional string += hover_req(file_path, 9, 7) # multiline function with if conditional string += hover_req(file_path, 10, 15) # defined without () file_path = root_dir / "preproc_keywords.F90" string += hover_req(file_path, 6, 2) # ignores PP across Fortran line continuations file_path = root_dir / "preproc_else.F90" string += hover_req(file_path, 8, 12) string += hover_req(file_path, 18, 12) file_path = root_dir / "preproc_elif.F90" string += hover_req(file_path, 22, 15) string += hover_req(file_path, 24, 10) file_path = root_dir / "preproc_elif_elif_skip.F90" string += hover_req(file_path, 30, 23) file_path = root_dir / "preproc_if_elif_else.F90" string += hover_req(file_path, 30, 23) file_path = root_dir / "preproc_if_elif_skip.F90" string += hover_req(file_path, 30, 23) file_path = root_dir / "preproc_if_nested.F90" string += hover_req(file_path, 33, 23) config = str(root_dir / ".pp_conf.json") errcode, results = run_request(string, ["--config", config]) assert errcode == 0 # Reference solution ref_results = ( "```fortran90\n#define PCType character*(80)\n```", "```fortran90\n#define PETSC_ERR_INT_OVERFLOW 84\n```", "```fortran90\n#define varVar 55\n```", ( "```fortran90\n#define ewrite(priority, format)" " if (priority <= 3) write((priority), format)\n```" ), ( "```fortran90\n#define ewrite2(priority, format)" " if (priority <= 3) write((priority), format)\n```" ), "```fortran90\n#define SUCCESS .true.\n```", "```fortran90\nREAL, CONTIGUOUS, POINTER, DIMENSION(:) :: var1\n```", "```fortran90\nINTEGER :: var0\n```", "```fortran90\nREAL :: var1\n```", "```fortran90\nINTEGER :: var2\n```", "```fortran90\nINTEGER, INTENT(INOUT) :: var\n```", "```fortran90\nINTEGER, PARAMETER :: res = 0+1+0+0\n```", "```fortran90\nINTEGER, PARAMETER :: res = 0+0+0+1\n```", "```fortran90\nINTEGER, PARAMETER :: res = 1+0+0+0\n```", "```fortran90\nINTEGER, PARAMETER :: res = 0+0+1+0\n```", ) assert len(ref_results) == len(results) - 1 check_return(results[1:], ref_results) fortran-language-server-3.2.2+dfsg/test/test_preproc_parser.py000066400000000000000000000022141477231266000246220ustar00rootroot00000000000000from __future__ import annotations from fortls.parsers.internal.parser import preprocess_file def test_pp_leading_spaces(): lines = [ " #define LEADING_SPACES_INDENT 1", " # define LEADING_SPACES_INDENT2", " # define FILE_ENCODING ,encoding='UTF-8'", "program pp_intentation", " implicit none", " print*, LEADING_SPACES_INDENT", " open(unit=1,file='somefile.txt' FILE_ENCODING)", "end program pp_intentation", ] _, _, _, defs = preprocess_file(lines) ref = { "LEADING_SPACES_INDENT": "1", "LEADING_SPACES_INDENT2": "True", "FILE_ENCODING": ",encoding='UTF-8'", } assert defs == ref def test_pp_macro_expansion(): lines = [ "# define WRAP(PROCEDURE) PROCEDURE , wrap_/**/PROCEDURE", "generic, public :: set => WRAP(abc)", "procedure :: WRAP(abc)", ] ref = [ "# define WRAP(PROCEDURE) PROCEDURE , wrap_/**/PROCEDURE", "generic, public :: set => abc , wrap_/**/abc", "procedure :: abc , wrap_/**/abc", ] output, _, _, _ = preprocess_file(lines) assert output == ref fortran-language-server-3.2.2+dfsg/test/test_regex_patterns.py000066400000000000000000000023061477231266000246300ustar00rootroot00000000000000from __future__ import annotations import pytest from fortls.regex_patterns import create_src_file_exts_regex @pytest.mark.parametrize( "input_exts, input_files, matches", [ ( [], [ "test.f", "test.F", "test.f90", "test.F90", "test.f03", "test.F03", "test.f18", "test.F18", "test.f77", "test.F77", "test.f95", "test.F95", "test.for", "test.FOR", "test.fpp", "test.FPP", ], [True] * 16, ), ([], ["test.ff", "test.f901", "test.f90.ff"], [False, False, False]), ([r"\.inc"], ["test.inc", "testinc", "test.inc2"], [True, False, False]), (["inc.*"], ["test.inc", "testinc", "test.inc2"], [True, True, True]), ], ) def test_src_file_exts( input_exts: list[str], input_files: list[str], matches: list[bool], ): regex = create_src_file_exts_regex(input_exts) results = [bool(regex.search(file)) for file in input_files] assert results == matches fortran-language-server-3.2.2+dfsg/test/test_server.py000066400000000000000000000164331477231266000231120ustar00rootroot00000000000000from setup_tests import run_request, test_dir, write_rpc_notification, write_rpc_request def test_init(): def check_return(result_dict): # Expected capabilities # { # "completionProvider": { # "resolveProvider": false, # "triggerCharacters": ["%"] # }, # "definitionProvider": true, # "documentSymbolProvider": true, # "referencesProvider": True, # "hoverProvider": true, # "textDocumentSync": 2 # } # assert "capabilities" in result_dict assert result_dict["capabilities"]["textDocumentSync"] == 2 assert result_dict["capabilities"]["definitionProvider"] is True assert result_dict["capabilities"]["documentSymbolProvider"] is True assert result_dict["capabilities"]["hoverProvider"] is True assert result_dict["capabilities"]["referencesProvider"] is True assert ( result_dict["capabilities"]["completionProvider"]["resolveProvider"] is False ) assert ( result_dict["capabilities"]["completionProvider"]["triggerCharacters"][0] == "%" ) # string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) errcode, results = run_request(string) # assert errcode == 0 check_return(results[0]) def test_logger(): """Test the logger""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) errcode, results = run_request(string, ["--debug_log"]) assert errcode == 0 assert results[1]["type"] == 3 assert results[1]["message"] == "fortls debugging enabled" def test_open(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = str(test_dir / "subdir" / "test_free.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string, fortls_args=["--disable_diagnostics"]) # assert errcode == 0 assert len(results) == 1 def test_change(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_unknown.f90" string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": str(file_path)}} ) string += write_rpc_notification( "textDocument/didChange", { "textDocument": {"uri": str(file_path)}, "contentChanges": [ { "text": "module test_unkown\nend module test_unknown\n", "range": { "start": {"line": 0, "character": 0}, "end": {"line": 0, "character": 0}, }, } ], }, ) string += write_rpc_request( 2, "textDocument/documentSymbol", {"textDocument": {"uri": str(file_path)}} ) file_path = test_dir / "subdir" / "test_free.f90" string += write_rpc_notification( "textDocument/didChange", { "textDocument": {"uri": str(file_path)}, "contentChanges": [ { "text": " unicode test", "range": { "start": {"line": 3, "character": 3}, "end": {"line": 3, "character": 3}, }, }, { "text": "", "range": { "start": {"line": 6, "character": 0}, "end": {"line": 31, "character": 0}, }, }, { "text": "", "range": { "start": {"line": 7, "character": 0}, "end": {"line": 39, "character": 0}, }, }, ], }, ) string += write_rpc_request( 3, "textDocument/documentSymbol", {"textDocument": {"uri": str(file_path)}} ) errcode, results = run_request(string, fortls_args=["--disable_diagnostics"]) # assert errcode == 0 assert len(results) == 3 assert len(results[1]) == 1 assert len(results[2]) == 5 def test_symbols(): def check_return(result_array): # Expected objects objs = ( ["test_free", 2, 0, 81], ["scale_type", 5, 4, 6], ["val", 13, 5, 5], ["vector", 5, 8, 16], ["n", 13, 9, 9], ["v", 13, 10, 10], ["bound_nopass", 6, 11, 11], ["create", 6, 13, 13], ["norm", 6, 14, 14], ["bound_pass", 6, 15, 15], ["scaled_vector", 5, 18, 23], ["scale", 13, 19, 19], ["set_scale", 6, 21, 21], ["norm", 6, 22, 22], ["fort_wrap", 11, 26, 29], ["vector_create", 12, 35, 41], ["vector_norm", 12, 43, 47], ["scaled_vector_set", 12, 49, 53], ["scaled_vector_norm", 12, 55, 59], ["unscaled_norm", 12, 61, 65], ["test_sig_Sub", 12, 67, 70], ["bound_pass", 12, 72, 80], ) assert len(result_array) == len(objs) for i, obj in enumerate(objs): assert result_array[i]["name"] == obj[0] assert result_array[i]["kind"] == obj[1] assert result_array[i]["location"]["range"]["start"]["line"] == obj[2] assert result_array[i]["location"]["range"]["end"]["line"] == obj[3] # string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" string += write_rpc_request( 2, "textDocument/documentSymbol", {"textDocument": {"uri": str(file_path)}} ) errcode, results = run_request(string) # assert errcode == 0 check_return(results[1]) def test_workspace_symbols(): def check_return(result_array): # Expected objects objs = ( ["test", 6, 7], ["test_abstract", 2, 0], ["test_associate_block", 2, 0], ["test_free", 2, 0], ["test_gen_type", 5, 1], ["test_generic", 2, 0], ["test_inherit", 2, 0], ["test_int", 2, 0], ["test_mod", 2, 0], ["test_nan", 2, 0], ["test_nonint_mod", 2, 0], ["test_preproc_keywords", 2, 0], ["test_private", 2, 8], ["test_program", 2, 0], ["test_rename_sub", 6, 9], ["test_select", 2, 0], ["test_select_sub", 6, 16], ["test_sig_Sub", 6, 67], ["test_str1", 13, 5], ["test_str2", 13, 5], ["test_sub", 6, 8], ["test_vis_mod", 2, 0], ) assert len(result_array) == len(objs) for i, obj in enumerate(objs): assert result_array[i]["name"] == obj[0] assert result_array[i]["kind"] == obj[1] assert result_array[i]["location"]["range"]["start"]["line"] == obj[2] # string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) string += write_rpc_request(2, "workspace/symbol", {"query": "test"}) errcode, results = run_request(string) # assert errcode == 0 check_return(results[1]) fortran-language-server-3.2.2+dfsg/test/test_server_completion.py000066400000000000000000000370551477231266000253460ustar00rootroot00000000000000from setup_tests import run_request, test_dir, write_rpc_request def validate_comp(result_array, checks): assert len(result_array) == checks[0] if checks[0] > 0: assert result_array[0]["label"] == checks[1] assert result_array[0]["detail"] == checks[2] try: assert result_array[0]["insertText"] == checks[3] except KeyError: pass def comp_request(file_path, line, char): return write_rpc_request( 1, "textDocument/completion", { "textDocument": {"uri": str(file_path)}, "position": {"line": line, "character": char}, }, ) def test_comp1(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += comp_request(file_path, 12, 6) string += comp_request(file_path, 13, 6) string += comp_request(file_path, 17, 24) string += comp_request(file_path, 18, 23) string += comp_request(file_path, 20, 7) string += comp_request(file_path, 21, 20) string += comp_request(file_path, 21, 42) string += comp_request(file_path, 23, 26) errcode, results = run_request(string, ["--use_signature_help", "-n1"]) assert errcode == 0 exp_results = ( # test_prog.f08 [1, "myfun", "DOUBLE PRECISION FUNCTION myfun(n, xval)", "myfun"], [9, "glob_sub", "SUBROUTINE glob_sub(n, xval, yval)", "glob_sub"], [1, "bound_nopass", "SUBROUTINE bound_nopass(a, b)", "bound_nopass"], [1, "bound_pass", "SUBROUTINE bound_pass(arg1)", "bound_pass"], [1, "stretch_vector", "TYPE(scaled_vector)"], [6, "scale", "TYPE(scale_type)"], [2, "n", "INTEGER(4)"], [1, "val", "REAL(8)"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp2(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_submod.F90" string += comp_request(file_path, 30, 12) string += comp_request(file_path, 31, 8) string += comp_request(file_path, 31, 23) string += comp_request(file_path, 35, 12) string += comp_request(file_path, 36, 48) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # subdir/test_submod.F90 [1, "point", "TYPE"], [1, "distance", "REAL"], [2, "x", "REAL"], [1, "point", "TYPE"], [2, "x", "REAL"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp3(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_inc.f90" string += comp_request(file_path, 10, 2) file_path = test_dir / "subdir" / "test_inc2.f90" string += comp_request(file_path, 3, 2) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # test_inc.f90 [2, "val1", "REAL(8)"], # subdir/test_inc2.f90 [2, "val1", "REAL(8)"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp4(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_abstract.f90" string += comp_request(file_path, 7, 12) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # subdir/test_abstract.f90 [1, "abs_interface", "SUBROUTINE"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp5(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" string += comp_request(file_path, 10, 22) string += comp_request(file_path, 14, 27) string += comp_request(file_path, 28, 15) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # subdir/test_free.f90 [1, "DIMENSION(:)", "KEYWORD"], [2, "vector_create", "SUBROUTINE"], [3, "INTENT(IN)", "KEYWORD"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp6(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_select.f90" string += comp_request(file_path, 21, 7) string += comp_request(file_path, 23, 7) string += comp_request(file_path, 25, 7) string += comp_request(file_path, 30, 7) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # subdir/test_select.f90 [2, "a", "REAL(8)"], [2, "a", "COMPLEX(8)"], [1, "n", "INTEGER(4)"], [2, "a", "REAL(8)"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp7(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_block.f08" string += comp_request(file_path, 2, 2) string += comp_request(file_path, 5, 4) string += comp_request(file_path, 8, 6) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # test_block.f08 [9, "READ", "STATEMENT"], [10, "READ", "STATEMENT"], [11, "READ", "STATEMENT"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp8(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_inherit.f90" string += comp_request(file_path, 10, 11) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # subdir/test_inherit.f90 [1, "val", "REAL(8)"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp9(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_rename.F90" string += comp_request(file_path, 13, 5) string += comp_request(file_path, 14, 5) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # subdir/test_rename.F90 [1, "localname", "INTEGER"], [2, "renamed_var2", "REAL(8)"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp10(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_vis.f90" string += comp_request(file_path, 8, 10) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # subdir/test_vis.f90 [3, "some_type", "TYPE"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp11(): """Indicate the derived types arguments separated with spaces and types""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += comp_request(file_path, 23, 26) string += comp_request(file_path, 27, 28) string += comp_request(file_path, 28, 30) string += comp_request(file_path, 29, 30) errcode, results = run_request(string, ["--use_signature_help", "-n1"]) assert errcode == 0 exp_results = ( # test_prog.f08 [1, "val", "REAL(8)"], [1, "val", "REAL(8)"], [1, "val", "REAL(8)"], [1, "val", "REAL(8)"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp_import_host_association(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_import.f90" string += comp_request(file_path, 15, 20) errcode, results = run_request(string, ["--use_signature_help", "-n1"]) assert errcode == 0 exp_results = ([1, "mytype", "TYPE"],) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp_visibility_scopes(): """Test that PUBLIC, PRIVATE scopes are enforced in autocomplete results.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "completion" / "test_vis_mod_completion.f90" string += comp_request(file_path, 12, 16) string += comp_request(file_path, 12, 24) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # completion/test_vis_mod_completion.f90 [1, "some_var", "INTEGER"], [3, "length", "INTEGER"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp_interface(): """Test that the interface signature autocompletion, with placeholders, works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_generic.f90" string += comp_request(file_path, 14, 10) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # subdir/test_generic.f90 [ 4, "my_gen", "SUBROUTINE my_gen(self, a, b)", "my_gen(${1:self}, ${2:a}, ${3:b})", ], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp_no_signature_help(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += comp_request(file_path, 12, 6) errcode, results = run_request(string) assert errcode == 0 exp_results = ( # test_prog.f08, completion without signature_help # returns the entire completion as a snippet [ 1, "myfun", "DOUBLE PRECISION FUNCTION myfun(n, xval)", "myfun(${1:n}, ${2:xval})", ], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp_fixed(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_fixed.f" string += comp_request(file_path, 15, 8) string += comp_request(file_path, 15, 21) errcode, results = run_request(string, ["--use_signature_help"]) assert errcode == 0 exp_results = ( # subdir/test_fixed.f90 [1, "bob", "CHARACTER*(LEN=200)"], [1, "dave", "CHARACTER*(20)"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_comp_documentation(): """Test that "documentation" is returned for autocomplete results.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" string += comp_request(file_path, 21, 37) errcode, results = run_request( string, ) assert errcode == 0 exp_results = [ { "label": "scaled_vector_set", "kind": 3, "detail": "SUBROUTINE", "documentation": { "kind": "markdown", "value": ( "```fortran90\n" "SUBROUTINE scaled_vector_set(self, scale)\n" " CLASS(scaled_vector), INTENT(INOUT) :: self\n" " REAL(8), INTENT(IN) :: scale\n" "```\n" "-----\n" "Doc 7 \n\n" "**Parameters:** \n" "`scale` Doc 8" ), }, }, { "label": "scaled_vector_norm", "kind": 3, "detail": "REAL(8) FUNCTION", "documentation": { "kind": "markdown", "value": ( "```fortran90\n" "FUNCTION scaled_vector_norm(self) RESULT(norm)\n" " CLASS(scaled_vector), INTENT(IN) :: self\n" " REAL(8) :: norm\n" "```\n" "-----\n" "Top level docstring \n\n" "**Parameters:** \n" "`self` self value docstring \n\n" "**Return:** \n" "`norm`return value docstring" ), }, }, ] assert len(exp_results) == len(results[1]) assert exp_results == results[1] def test_comp_use_only_interface(): """Test completion of interfaces when using USE ONLY give the right signature.""" string = write_rpc_request( 1, "initialize", {"rootPath": str(test_dir / "completion")} ) file_path = test_dir / "completion" / "use_only_interface.f90" string += comp_request(file_path, 21, 29) errcode, results = run_request( string, ) assert errcode == 0 exp_results = [[1, "some_sub", "INTERFACE"]] assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_import(): """Test that import works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "imp")}) file_path = test_dir / "imp" / "import.f90" string += comp_request(file_path, 13, 16) # import type1 string += comp_request(file_path, 17, 16) # import, only: type2 string += comp_request(file_path, 21, 16) # import, none string += comp_request(file_path, 25, 16) # import, all string += comp_request(file_path, 29, 16) # import string += comp_request(file_path, 34, 16) # import type1; import type2 string += comp_request(file_path, 38, 16) # import :: type1, type2 errcode, results = run_request(string, ["--use_signature_help", "-n1"]) assert errcode == 0 exp_results = ( [1, "type1", "TYPE"], [1, "type2", "TYPE"], [0], [2, "type1", "TYPE"], [2, "type1", "TYPE"], [2, "type1", "TYPE"], [2, "type1", "TYPE"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) def test_use_multiple(): """Test that USE multiple times works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "use")}) file_path = test_dir / "use" / "use.f90" string += comp_request(file_path, 14, 11) string += comp_request(file_path, 15, 12) errcode, results = run_request(string, ["--use_signature_help", "-n1"]) assert errcode == 0 exp_results = ( [5, "val1", "INTEGER"], [1, "val4", "INTEGER"], ) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) fortran-language-server-3.2.2+dfsg/test/test_server_definitions.py000066400000000000000000000204461477231266000255040ustar00rootroot00000000000000from pathlib import Path from setup_tests import path_to_uri, run_request, test_dir, write_rpc_request def validate_def(result_array, checks): # If no definition is given result is None if result_array is None: assert not checks[0] return None assert result_array["uri"] == path_to_uri(checks[2]) assert result_array["range"]["start"]["line"] == checks[0] assert result_array["range"]["start"]["line"] == checks[1] def def_request(uri: Path, line, char): return write_rpc_request( 1, "textDocument/definition", { "textDocument": {"uri": str(uri)}, "position": {"line": line - 1, "character": char - 1}, }, ) def test_def_fun_sub_fixed(): """Test that going to definition of a function or submodule works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += def_request(file_path, 13, 7) string += def_request(file_path, 14, 7) errcode, results = run_request(string) assert errcode == 0 fixed_path = str(test_dir / "subdir" / "test_fixed.f") ref_res = [[0, 0, fixed_path], [22, 22, fixed_path]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_variable(): """Test that going to definition of a variable works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += def_request(file_path, 21, 8) errcode, results = run_request(string) assert errcode == 0 ref_res = [[10, 10, str(test_dir / "test_prog.f08")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_type_bound_procedure1(): """Test that going to definition of type bound procedure works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += def_request(file_path, 22, 21) errcode, results = run_request(string) assert errcode == 0 ref_res = [[21, 21, str(test_dir / "subdir" / "test_free.f90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_type_bound_procedure2(): """Test that going to definition of type bound procedure works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += def_request(file_path, 22, 43) errcode, results = run_request(string) assert errcode == 0 ref_res = [[14, 14, str(test_dir / "subdir" / "test_free.f90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_type_nested_variable(): """Test that going to definition of type bound nested variables works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += def_request(file_path, 24, 27) errcode, results = run_request(string) assert errcode == 0 ref_res = [[5, 5, str(test_dir / "subdir" / "test_free.f90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_type_in_submod_function(): """Test that going into the definition of a type bound function in a submodule""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_submod.F90" string += def_request(file_path, 31, 13) errcode, results = run_request(string) assert errcode == 0 ref_res = [[1, 1, str(test_dir / "subdir" / "test_submod.F90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_type_in_submod_procedure(): """Test that going into the definition of a type bound procedure in a submodule""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_submod.F90" string += def_request(file_path, 36, 13) errcode, results = run_request(string) assert errcode == 0 ref_res = [[1, 1, str(test_dir / "subdir" / "test_submod.F90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_include_file(): """Test that going into the location of an include file works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_inc.f90" string += def_request(file_path, 3, 16) errcode, results = run_request(string) assert errcode == 0 ref_res = [[2, 2, str(test_dir / "subdir" / "test_inc2.f90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_include_variable1(): """Test that going to definition of a variable in an include file works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_inc.f90" string += def_request(file_path, 11, 3) errcode, results = run_request(string) assert errcode == 0 ref_res = [[0, 0, str(test_dir / "subdir" / "test_inc2.f90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_include_variable2(): """Test that going to definition of a variable in an include file works.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_inc2.f90" string += def_request(file_path, 4, 3) errcode, results = run_request(string) assert errcode == 0 ref_res = [[4, 4, str(test_dir / "test_inc.f90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_include_file_missing(): """Test that going to the definition of a missing file will not break fortls""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_inc.f90" string += def_request(file_path, 13, 14) errcode, results = run_request(string) assert errcode == 0 ref_res = [[None]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_rename_only_variable(): """Test that going to definition of a renamed list variable will take you to the original definition. """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_rename.F90" string += def_request(file_path, 14, 6) errcode, results = run_request(string) assert errcode == 0 ref_res = [[6, 6, str(test_dir / "subdir" / "test_rename.F90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_rename_only_variable_nested(): """Test that going to definition of a renamed list variable will take you to the original definition, tests the multiply renamed case. """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_rename.F90" string += def_request(file_path, 15, 6) errcode, results = run_request(string) assert errcode == 0 ref_res = [[1, 1, str(test_dir / "subdir" / "test_rename.F90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) def test_def_function_implicit_result_variable(): """Test that going to definition on the implicitly defined variable RESULT works. """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "functions.f90" string += def_request(file_path, 4, 18) errcode, results = run_request(string) assert errcode == 0 ref_res = [[3, 3, str(test_dir / "hover" / "functions.f90")]] assert len(ref_res) == len(results) - 1 for i, res in enumerate(ref_res): validate_def(results[i + 1], res) fortran-language-server-3.2.2+dfsg/test/test_server_diagnostics.py000066400000000000000000000376551477231266000255120ustar00rootroot00000000000000# from types import NoneType from setup_tests import ( path_to_uri, run_request, test_dir, write_rpc_notification, write_rpc_request, ) def test_interface_args(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test subroutines and functions with interfaces as arguments file_path = str(test_dir / "test_diagnostic_int.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_nonintrinsic(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test that use, non_intrinsic does not raise a diagnostic error file_path = str(test_dir / "test_nonintrinsic.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_submodules_spaced(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test that submodules with spacings in their parent's names are parsed file_path = str(test_dir / "test_submodule.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_end_named_variables(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Tests that variables named end do not close the scope prematurely file_path = str(test_dir / "diag" / "test_scope_end_name_var.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_external(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test that externals can be split between multiple lines # and that diagnostics for multiple definitions of externals can account # for that file_path = str(test_dir / "diag" / "test_external.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) root = path_to_uri(str((test_dir / "diag" / "test_external.f90").resolve())) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [ { "range": { "start": {"line": 7, "character": 17}, "end": {"line": 7, "character": 22}, }, "message": 'Variable "VAR_B" declared twice in scope', "severity": 1, "relatedInformation": [ { "location": { "uri": str(root), "range": { "start": {"line": 5, "character": 0}, "end": {"line": 5, "character": 0}, }, }, "message": "First declaration", } ], }, { "range": { "start": {"line": 8, "character": 17}, "end": {"line": 8, "character": 22}, }, "message": 'Variable "VAR_A" declared twice in scope', "severity": 1, "relatedInformation": [ { "location": { "uri": str(root), "range": { "start": {"line": 3, "character": 0}, "end": {"line": 3, "character": 0}, }, }, "message": "First declaration", } ], }, ] def test_forall(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Checks that forall with end forall inside a case select does not cause # unexpected end of scope. file_path = str(test_dir / "diag" / "test_forall.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_use_ordering(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test USE directive ordering errors file_path = str(test_dir / "diag" / "test_use_ordering.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_where(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test where blocks file_path = str(test_dir / "diag" / "test_where.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_multiline(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test where semicolon (multi-line) file_path = str(test_dir / "diag" / "test_semicolon.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_enum(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test ENUM block file_path = str(test_dir / "diag" / "test_enum.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_module_procedure(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test module procedure in submodules importing scopes file_path = str(test_dir / "subdir" / "test_submod.F90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_max_line_length(): root = test_dir / "diag" string = write_rpc_request(1, "initialize", {"rootPath": str(root)}) file_path = str(root / "test_lines.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) file_path = str(root / "conf_long_lines.json") errcode, results = run_request(string, [f"--config {file_path}"]) assert errcode == 0 assert results[1]["diagnostics"] == [ { "range": { "start": {"line": 2, "character": 80}, "end": {"line": 2, "character": 155}, }, "message": 'Line length exceeds "max_line_length" (80)', "severity": 2, }, { "range": { "start": {"line": 3, "character": 100}, "end": {"line": 3, "character": 127}, }, "message": 'Comment line length exceeds "max_comment_line_length" (100)', "severity": 2, }, ] def test_implicit_none(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test module procedure in submodules importing scopes file_path = str(test_dir / "diag" / "test_implicit_none.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [ { "range": { "start": {"line": 4, "character": 9}, "end": {"line": 4, "character": 13}, }, "message": "IMPLICIT statement without enclosing scope", "severity": 1, }, ] def test_contains(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test module procedure in submodules importing scopes file_path = str(test_dir / "diag" / "test_contains.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [ { "range": { "start": {"line": 3, "character": 4}, "end": {"line": 3, "character": 12}, }, "message": "Multiple CONTAINS statements in scope", "severity": 1, }, { "range": { "start": {"line": 5, "character": 0}, "end": {"line": 5, "character": 8}, }, "message": "CONTAINS statement without enclosing scope", "severity": 1, }, { "range": { "start": {"line": 8, "character": 0}, "end": {"line": 8, "character": 0}, }, "message": "Subroutine/Function definition before CONTAINS statement", "severity": 1, }, ] def test_visibility(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test module procedure in submodules importing scopes file_path = str(test_dir / "diag" / "test_visibility.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [ { "range": { "start": {"line": 5, "character": 0}, "end": {"line": 5, "character": 0}, }, "message": "Visibility statement without enclosing scope", "severity": 1, }, { "range": { "start": {"line": 1, "character": 8}, "end": {"line": 1, "character": 26}, }, "message": 'Module "nonexisting_module" not found in project', "severity": 3, }, { "range": { "start": {"line": 3, "character": 8}, "end": {"line": 3, "character": 11}, }, "message": 'Module "mod" not found in project', "severity": 3, }, { "range": { "start": {"line": 2, "character": 4}, "end": {"line": 2, "character": 12}, }, "message": "USE statements after IMPLICIT statement", "severity": 1, }, ] def test_import(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test module procedure in submodules importing scopes file_path = str(test_dir / "diag" / "test_import.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [ { "range": { "start": {"line": 1, "character": 0}, "end": {"line": 1, "character": 0}, }, "message": "IMPORT statement outside of interface", "severity": 1, } ] def test_variable(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test module procedure in submodules importing scopes file_path = str(test_dir / "diag" / "test_variable.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [ { "range": { "start": {"line": 4, "character": 19}, "end": {"line": 4, "character": 22}, }, "message": 'Variable "val" masks variable in parent scope', "severity": 2, "relatedInformation": [ { "location": { "uri": path_to_uri(str(file_path)), "range": { "start": {"line": 1, "character": 0}, "end": {"line": 1, "character": 0}, }, }, "message": "First declaration", } ], } ] def test_function(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # Test module procedure in submodules importing scopes file_path = str(test_dir / "diag" / "test_function.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string) assert errcode == 0 assert results[1]["diagnostics"] == [ { "range": { "start": {"line": 3, "character": 31}, "end": {"line": 3, "character": 34}, }, "message": 'Variable "bar" with INTENT keyword not found in argument list', "severity": 1, } ] def test_submodule_scopes(): """Test that submodule procedures and functions with modifier keywords are correctly parsed and their scopes correctly closed.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "diag")}) file_path = str(test_dir / "diag" / "test_scope_overreach.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_keyword_arg_list_var_names(): """Test argument list variables named as keywords are correctly parsed.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "diag")}) file_path = str(test_dir / "diag" / "test_function_arg_list.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_attribute_and_variable_name_collision(): """Test variables named with attribute names do not cause a collision.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "diag")}) file_path = str(test_dir / "diag" / "var_shadowing_keyword_arg.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_critical_scope(): """Test that critical scopes are correctly parsed.""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "diag")}) file_path = str(test_dir / "diag" / "tst_critical.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1]["diagnostics"] == [] def test_mixed_case_interface_sub_child(): """ Test that interface sub_child arguments are correctly resolved regardless of their case. """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "diag")}) file_path = str(test_dir / "diag" / "mixed_case_interface_sub_child.f90") string += write_rpc_notification( "textDocument/didOpen", {"textDocument": {"uri": file_path}} ) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1]["diagnostics"] == [] fortran-language-server-3.2.2+dfsg/test/test_server_documentation.py000066400000000000000000000265541477231266000260500ustar00rootroot00000000000000from setup_tests import run_request, test_dir, write_rpc_request def check_return(result_array, checks, only_docs=False): comm_lines = [] found_docs = False idx = 0 for i, hover_line in enumerate(result_array["contents"]["value"].splitlines()): if hover_line == "-----": found_docs = True if found_docs and only_docs: comm_lines.append((idx, hover_line)) idx += 1 elif not only_docs: comm_lines.append((i, hover_line)) assert len(comm_lines) == len(checks) for i in range(len(checks)): assert comm_lines[i][0] == checks[i][0] assert comm_lines[i][1] == checks[i][1] def hover_request(file_path, line, char): return write_rpc_request( 1, "textDocument/hover", { "textDocument": {"uri": str(file_path)}, "position": {"line": line, "character": char}, }, ) def test_doxygen(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "docs")}) file_path = test_dir / "docs" / "test_doxygen.f90" string += hover_request(file_path, 15, 17) errcode, results = run_request(string, ["-n1"]) assert errcode == 0 ref = ( (0, "```fortran90"), (1, "SUBROUTINE insert(list, n, max_size, new_entry)"), (2, " REAL, DIMENSION(:), INTENT(INOUT) :: list"), (3, " INTEGER, INTENT(IN) :: n"), (4, " INTEGER, INTENT(IN) :: max_size"), (5, " REAL, INTENT(IN) :: new_entry"), (6, "```"), (7, "-----"), (8, "inserts a value into an ordered array"), (9, ""), ( 10, ( 'An array "list" consisting of n ascending ordered values. The method' " insert a" ), ), (11, '"new_entry" into the array.'), (12, "hint: use cshift and eo-shift"), (13, ""), (14, ""), (15, "**Parameters:** "), (16, "`list` - a real array, size: max_size "), (17, "`n` - current values in the array "), (18, "`max_size` - size if the array "), (19, "`new_entry` - the value to insert "), ) check_return(results[1], ref) def test_ford(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "docs")}) file_path = test_dir / "docs" / "test_ford.f90" string += hover_request(file_path, 5, 20) errcode, results = run_request(string) assert errcode == 0 ref = ( (0, "```fortran90"), (1, "SUBROUTINE feed_pets(cats, dogs, food, angry)"), (2, " INTEGER, INTENT(IN) :: cats"), (3, " INTEGER, INTENT(IN) :: dogs"), (4, " REAL, INTENT(INOUT) :: food"), (5, " INTEGER, INTENT(OUT) :: angry"), (6, "```"), (7, "-----"), (8, "Feeds your cats and dogs, if enough food is available. If not enough"), (9, "food is available, some of your pets will get angry."), (10, " "), (11, ""), (12, "**Parameters:** "), (13, "`cats` The number of cats to keep track of. "), (14, "`dogs` The number of dogs to keep track of. "), (15, "`food` The amount of pet food (in kilograms) which you have on hand. "), (16, "`angry` The number of pets angry because they weren't fed."), ) check_return(results[1], ref) def test_doc_overwrite_type_bound_procedure_sub(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" # Test we can override method docstring e.g. # procedure :: name => name_imp !< Doc override # We want to preserve the argument list docstring string += hover_request(file_path, 13, 19) errcode, results = run_request(string) assert errcode == 0 check_return( results[1], ( (0, "-----"), (1, "Doc 1 "), (2, ""), (3, "**Parameters:** "), (4, "`n` Doc 5"), ), True, ) def test_doc_type_bound_procedure_sub_implementation(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" # procedure :: name => name_imp !< Doc override # Test that name_imp will yield the full docstring present in the implementation string += hover_request(file_path, 13, 31) errcode, results = run_request(string) assert errcode == 0 check_return( results[1], ( (0, "-----"), (1, "Doc 4 "), (2, ""), (3, "**Parameters:** "), (4, "`n` Doc 5"), ), True, ) def test_doc_variable(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" # n !! Doc 5 # Test that a variable can carry over documentation string += hover_request(file_path, 37, 26) errcode, results = run_request(string) assert errcode == 0 check_return( results[1], ( (0, "-----"), (1, "Doc 5"), ), True, ) def test_doc_overwrite_type_bound_procedure_fun(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" # Test we can override function docstring e.g. # procedure :: name => name_imp !< Doc override # We want to preserve the argument list docstring string += hover_request(file_path, 14, 17) errcode, results = run_request(string) assert errcode == 0 check_return( results[1], ( (0, "-----"), (1, "Doc 2"), ), True, ) def test_doc_type_bound_procedure_fun_implementation(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" # procedure :: name => name_imp !< Doc override # Test that name_imp will yield the full docstring present in the implementation string += hover_request(file_path, 14, 28) errcode, results = run_request(string) assert errcode == 0 check_return( results[1], ( (0, "-----"), (1, "Doc 6"), ), True, ) def test_doc_empty_overwrite_type_bound_procedure_sub(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" # Test we can ignore overriding method docstring and return the original e.g. # procedure :: name => name_imp !< # We want to preserve the argument list docstring # the self argument in the second request is not included because it is # missing a doc string string += hover_request(file_path, 21, 18) string += hover_request(file_path, 21, 37) errcode, results = run_request(string) assert errcode == 0 check_return( results[1], ( (0, "-----"), (1, "Doc 7 "), (2, ""), (3, "**Parameters:** "), (4, "`scale` Doc 8"), ), True, ) check_return( results[2], ( (0, "-----"), (1, "Doc 7 "), (2, ""), (3, "**Parameters:** "), (4, "`scale` Doc 8"), ), True, ) def test_doc_empty_overwrite_type_bound_procedure_fun(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" # procedure :: name => name_imp !< Doc # We want to preserve the procedure docstring but also fetch the empty # docs for the implementation string += hover_request(file_path, 22, 17) string += hover_request(file_path, 22, 32) errcode, results = run_request(string) assert errcode == 0 check_return( results[1], ( (0, "-----"), (1, "Doc 3 "), (2, ""), (3, "**Return:** "), (4, "`norm`return value docstring"), ), True, ) check_return( results[2], ( (0, "-----"), (1, "Top level docstring "), (2, ""), (3, "**Parameters:** "), (4, "`self` self value docstring "), (5, ""), (6, "**Return:** "), (7, "`norm`return value docstring"), ), True, ) def test_doc_multiline_type_bound_procedure_arg_list(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_free.f90" # Check that inline docstrings can be input and carried over in multiple lines # for both the procedure pointer and the implementation string += hover_request(file_path, 15, 32) string += hover_request(file_path, 15, 47) errcode, results = run_request(string) assert errcode == 0 check_return( results[1], ( (0, "-----"), (1, "Doc 3 "), (2, ""), (3, "**Parameters:** "), (4, "`arg1` Doc 9"), (5, "Doc 10"), ), True, ) check_return( results[2], ( (0, "-----"), (1, ""), (2, "**Parameters:** "), (3, "`arg1` Doc 9"), (4, "Doc 10 "), (5, "`self` Doc 11"), (6, "Doc 12"), ), True, ) def test_doxygen_doc_for_module_use(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "docs")}) file_path = test_dir / "docs" / "test_module_and_type_doc.f90" string += hover_request(file_path, 24, 14) errcode, results = run_request(string) assert errcode == 0 ref = ( (0, "```fortran90"), (1, "MODULE doxygen_doc_mod"), (2, "```"), (3, "-----"), (4, "module doc for doxygen_doc_mod"), (5, ""), (6, "with info"), ) check_return(results[1], ref) def test_ford_doc_for_module_use(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "docs")}) file_path = test_dir / "docs" / "test_module_and_type_doc.f90" string += hover_request(file_path, 25, 14) errcode, results = run_request(string) assert errcode == 0 ref = ( (0, "```fortran90"), (1, "MODULE ford_doc_mod"), (2, "```"), (3, "-----"), (4, "Doc for ford_doc_mod"), ) check_return(results[1], ref) def test_doxygen_doc_for_type(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "docs")}) file_path = test_dir / "docs" / "test_module_and_type_doc.f90" string += hover_request(file_path, 27, 11) errcode, results = run_request(string) assert errcode == 0 ref = ( (0, "```fortran90"), (1, "TYPE :: a_t"), (2, "```"), (3, "-----"), (4, "Doc for a_t"), ) check_return(results[1], ref) def test_ford_doc_for_type(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "docs")}) file_path = test_dir / "docs" / "test_module_and_type_doc.f90" string += hover_request(file_path, 28, 11) errcode, results = run_request(string) assert errcode == 0 ref = ( (0, "```fortran90"), (1, "TYPE :: b_t"), (2, "```"), (3, "-----"), (4, "Doc for b_t"), ) check_return(results[1], ref) fortran-language-server-3.2.2+dfsg/test/test_server_hover.py000066400000000000000000000654361477231266000243240ustar00rootroot00000000000000import json from setup_tests import Path, run_request, test_dir, write_rpc_request def hover_req(file_path: Path, ln: int, col: int) -> str: return write_rpc_request( 1, "textDocument/hover", { "textDocument": {"uri": str(file_path)}, "position": {"line": ln, "character": col}, }, ) def validate_hover(result_array: list, checks: list): assert len(result_array) - 1 == len(checks) for i, check in enumerate(checks): assert result_array[i + 1]["contents"]["value"] == check def test_hover_abstract_int_procedure(): """Tests that the binding of an abstract interface is correctly resolved""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_abstract.f90" string += hover_req(file_path, 7, 30) errcode, results = run_request(string, fortls_args=["--sort_keywords", "-n1"]) assert errcode == 0 ref_results = [ """```fortran90 SUBROUTINE test(a, b) INTEGER(4), DIMENSION(3,6), INTENT(IN) :: a REAL(8), DIMENSION(4), INTENT(OUT) :: b ```""" ] validate_hover(results, ref_results) def test_hover_parameter_multiline(): """Test that hover parameters display value correctly across lines""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 2, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, PARAMETER :: var = 1000\n```"] validate_hover(results, ref_results) def test_hover_literal_num(): """Test that hovering over literals shows their type INTEGER""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 3, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER\n```"] validate_hover(results, ref_results) def test_hover_parameter(): """Test that hover parameters display value correctly""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 4, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, PARAMETER :: var2 = 23\n```"] validate_hover(results, ref_results) def test_hover_parameter_dollar(): """Test that hover parameters with dollar in name are recognized correctly""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 20, 31) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER(4), PARAMETER :: SIG$ERR = -1\n```"] validate_hover(results, ref_results) def test_hover_parameter_eqnospace(): """Test that hover parameters display value correctly""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 11, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, PARAMETER :: var_no_space = 123\n```"] validate_hover(results, ref_results) def test_hover_parameter_morespace(): """Test that hover parameters display value correctly""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 12, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, PARAMETER :: var_more_space = 123\n```"] validate_hover(results, ref_results) def test_hover_parameter_var_sum(): """Test that hover parameters display value correctly with sum""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 13, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, PARAMETER :: var_sum1 = 1 + 23\n```"] validate_hover(results, ref_results) def test_hover_parameter_var_neg(): """Test that hover parameters display value correctly with extraction""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 14, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, PARAMETER :: var_ex1 = 1 - 23\n```"] validate_hover(results, ref_results) def test_hover_parameter_var_mul(): """Test that hover parameters display value correctly with multiplication and spaces""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 15, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, PARAMETER :: var_mul1 = 1 * 23\n```"] validate_hover(results, ref_results) def test_hover_parameter_var_div(): """Test that hover parameters display value correctly with value of division""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 16, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, PARAMETER :: var_div1 = 1/1\n```"] validate_hover(results, ref_results) def test_hover_parameter_var_multiline2(): """Test that hover parameters display value correctly with multiplication and spaces. Item 2""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 17, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = [ "```fortran90\nINTEGER, PARAMETER :: var_multi2 = 1 * 23 + 2 /1\n```" ] validate_hover(results, ref_results) def test_hover_parameter_nested(): """Test that hover parameters using other parameter values works""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 4, 41) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, PARAMETER :: var3 = var*var2\n```"] validate_hover(results, ref_results) def test_hover_parameter_multiline_missing_type(): """Test that hover parameters display correctly when type is split across lines""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 6, 28) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, PARAMETER :: var4 = 123\n```"] validate_hover(results, ref_results) def test_hover_literal_real(): """Test that hovering over literals shows their values REAL""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 7, 47) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nREAL\n```"] validate_hover(results, ref_results) def test_hover_parameter_double(): """Test that hovering over parameters shows their type DOUBLE PRECISION""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 7, 38) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nDOUBLE PRECISION, PARAMETER :: somevar = 23.12\n```"] validate_hover(results, ref_results) def test_hover_parameter_double_sf(): """Test that hovering over parameters shows their type scientific notation""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 7, 55) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nDOUBLE PRECISION, PARAMETER :: some = 1e-19\n```"] validate_hover(results, ref_results) def test_hover_parameter_bool(): """Test that hovering over parameters shows their values LOGICAL""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 8, 38) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = [ "```fortran90\nLOGICAL(kind=8), PARAMETER :: long_bool = .true.\n```" ] validate_hover(results, ref_results) def test_hover_literal_bool(): """Test that hovering over literals shows their type LOGICAL""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 8, 50) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nLOGICAL\n```"] validate_hover(results, ref_results) def test_hover_parameter_str_sq(): """Test that hovering over parameters shows their value, single quote STRING""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 9, 37) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nCHARACTER(len=5), PARAMETER :: sq_str = '12345'\n```"] validate_hover(results, ref_results) def test_hover_literal_string_sq(): """Test that hovering over literals shows their values single quote STRING""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 9, 48) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nCHARACTER(LEN=5)\n```"] validate_hover(results, ref_results) def test_hover_parameter_str_dq(): """Test that hovering over parameters shows their value, double quote STRING""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 10, 37) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ['```fortran90\nCHARACTER(len=5), PARAMETER :: dq_str = "12345"\n```'] validate_hover(results, ref_results) def test_hover_literal_string_dq(): """Test that hovering over literals shows their values double quote STRING""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "parameters.f90" string += hover_req(file_path, 10, 48) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nCHARACTER(LEN=5)\n```"] validate_hover(results, ref_results) def test_hover_pointer_attr(): """Test that hovering maintains the variable attributes e.g. POINTER""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "pointers.f90" string += hover_req(file_path, 1, 26) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = ["```fortran90\nINTEGER, POINTER :: val1\n```"] validate_hover(results, ref_results) def test_hover_functions(): """Test that hovering over functions provides the expected results""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "functions.f90" string += hover_req(file_path, 1, 11) string += hover_req(file_path, 7, 19) string += hover_req(file_path, 12, 12) string += hover_req(file_path, 18, 19) string += hover_req(file_path, 23, 34) string += hover_req(file_path, 28, 11) string += hover_req(file_path, 34, 21) string += hover_req(file_path, 46, 11) string += hover_req(file_path, 51, 11) string += hover_req(file_path, 55, 11) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = [ """```fortran90 FUNCTION fun1(arg) RESULT(fun1) INTEGER, INTENT(IN) :: arg INTEGER :: fun1 ```""", """```fortran90 FUNCTION fun2(arg) RESULT(fun2) INTEGER, INTENT(IN) :: arg INTEGER :: fun2 ```""", """```fortran90 FUNCTION fun3(arg) RESULT(retval) INTEGER, INTENT(IN) :: arg INTEGER :: retval ```""", """```fortran90 FUNCTION fun4(arg) RESULT(retval) INTEGER, INTENT(IN) :: arg INTEGER :: retval ```""", # Notice that the order of the modifiers does not match the source code # This is part of the test, ideally they would be identical but previously # any modifiers before the type would be discarded """```fortran90 PURE ELEMENTAL FUNCTION fun5(arg) RESULT(retval) INTEGER, INTENT(IN) :: arg INTEGER :: retval ```""", """```fortran90 FUNCTION fun6(arg) RESULT(retval) INTEGER, INTENT(IN) :: arg INTEGER, DIMENSION(10,10) :: retval ```""", """```fortran90 PURE FUNCTION outer_product(x, y) RESULT(outer_product) REAL, DIMENSION(:), INTENT(IN) :: x REAL, DIMENSION(:), INTENT(IN) :: y REAL, DIMENSION(SIZE(X), SIZE(Y)) :: outer_product ```""", """```fortran90 FUNCTION dlamch(cmach) RESULT(dlamch) CHARACTER :: CMACH ```""", """```fortran90 FUNCTION fun7() RESULT(val) TYPE(c_ptr) :: val ```""", """```fortran90 TYPE(c_ptr) FUNCTION c_loc(x) RESULT(c_loc) ```""", ] validate_hover(results, ref_results) def test_hover_spaced_keywords(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "spaced_keywords.f90" string += hover_req(file_path, 1, 45) string += hover_req(file_path, 2, 99) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = [ """```fortran90\nREAL, DIMENSION(:, :), INTENT(IN) :: arg1\n```""", """```fortran90\nREAL, DIMENSION( SIZE(ARG1, 1), MAXVAL([SIZE(ARG1, 2), """ """SIZE(ARG1, 1)]) ), INTENT(OUT) :: arg2\n```""", ] validate_hover(results, ref_results) def test_hover_recursive(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "recursive.f90" string += hover_req(file_path, 9, 40) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = [ """```fortran90 RECURSIVE SUBROUTINE recursive_assign_descending(node, vector, current_loc) TYPE(tree_inode), POINTER, INTENT(IN) :: node INTEGER, DIMENSION(:), INTENT(INOUT) :: vector INTEGER, INTENT(INOUT) :: current_loc ```""" ] validate_hover(results, ref_results) def test_hover_subroutine(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_submod.F90" string += hover_req(file_path, 29, 24) string += hover_req(file_path, 34, 24) errcode, results = run_request(string, fortls_args=["--sort_keywords"]) assert errcode == 0 ref_results = [ """```fortran90 FUNCTION point_dist(a, b) RESULT(distance) TYPE(point), INTENT(IN) :: a TYPE(point), INTENT(IN) :: b REAL :: distance ```""", """```fortran90 FUNCTION is_point_equal_a(a, b) RESULT(is_point_equal_a) TYPE(point), INTENT(IN) :: a TYPE(point), INTENT(IN) :: b LOGICAL :: is_point_equal_a ```""", ] validate_hover(results, ref_results) def test_hover_interface_as_argument(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_diagnostic_int.f90" string += hover_req(file_path, 19, 14) errcode, results = run_request(string, fortls_args=["--sort_keywords", "-n1"]) assert errcode == 0 ref_results = [ # Could be subject to change """```fortran90 FUNCTION foo2(f, g, h) RESULT(arg3) FUNCTION f(x) FUNCTION g(x) FUNCTION h(x) REAL :: arg3 ```""", ] validate_hover(results, ref_results) def test_hover_block(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "hover")}) file_path = test_dir / "hover" / "associate_block.f90" string += hover_req(file_path, 4, 17) string += hover_req(file_path, 4, 20) # string += hover_req(file_path, 10, 11) # slice of array errcode, results = run_request(string, fortls_args=["--sort_keywords", "-n", "1"]) assert errcode == 0 ref_results = [ "```fortran90\nREAL, DIMENSION(5) :: X\n```", "```fortran90\nREAL :: Y\n```", ] validate_hover(results, ref_results) def test_associate_block_func_result(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "hover")}) file_path = test_dir / "hover" / "associate_block_2.f90" string += hover_req(file_path, 2, 14) string += hover_req(file_path, 3, 9) errorcode, results = run_request(string, fortls_args=["--sort_keywords", "-n", "1"]) assert errorcode == 0 ref_results = [ "```fortran90\nLOGICAL FUNCTION :: hi\n```", "```fortran90\nLOGICAL FUNCTION :: hi\n```", ] validate_hover(results, ref_results) def test_hover_submodule_procedure(): """Test that submodule procedures and functions with modifier keywords are correctly displayed when hovering. """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "diag")}) file_path = test_dir / "diag" / "test_scope_overreach.f90" string += hover_req(file_path, 18, 37) string += hover_req(file_path, 23, 37) errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 ref_results = [ """```fortran90 PURE RECURSIVE FUNCTION foo_sp(x) RESULT(fi) REAL(sp), INTENT(IN) :: x REAL(sp) :: fi ```""", """```fortran90 PURE RECURSIVE FUNCTION foo_dp(x) RESULT(fi) REAL(dp), INTENT(IN) :: x REAL(dp) :: fi ```""", ] validate_hover(results, ref_results) def test_var_type_kinds(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "parse")}) file_path = test_dir / "parse" / "test_kinds_and_dims.f90" string += hover_req(file_path, 2, 24) string += hover_req(file_path, 2, 27) string += hover_req(file_path, 3, 15) string += hover_req(file_path, 3, 19) string += hover_req(file_path, 4, 20) string += hover_req(file_path, 4, 25) string += hover_req(file_path, 5, 23) string += hover_req(file_path, 6, 25) errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 ref_results = [ "```fortran90\nINTEGER(kind=4) :: a\n```", "```fortran90\nINTEGER(kind=4), DIMENSION(3,4) :: b\n```", "```fortran90\nINTEGER*8 :: aa\n```", "```fortran90\nINTEGER*8, DIMENSION(3,4) :: bb\n```", "```fortran90\nINTEGER(8) :: aaa\n```", "```fortran90\nINTEGER(8), DIMENSION(3,4) :: bbb\n```", "```fortran90\nREAL(kind=r15) :: r\n```", "```fortran90\nREAL(kind(0.d0)) :: rr\n```", ] validate_hover(results, ref_results) def test_kind_function_result(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "parse")}) file_path = test_dir / "parse" / "test_kinds_and_dims.f90" string += hover_req(file_path, 9, 18) string += hover_req(file_path, 14, 25) errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 ref_results = [ """```fortran90 FUNCTION foo(val) RESULT(r) REAL(8), INTENT(IN) :: val REAL*8 :: r ```""", """```fortran90 FUNCTION phi(val) RESULT(r) REAL(8), INTENT(IN) :: val REAL(kind=8) :: r ```""", ] validate_hover(results, ref_results) def test_var_type_asterisk(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "parse")}) file_path = test_dir / "parse" / "test_kinds_and_dims.f90" string += hover_req(file_path, 2 + 19, 18) string += hover_req(file_path, 2 + 19, 21) string += hover_req(file_path, 2 + 19, 29) string += hover_req(file_path, 3 + 19, 21) string += hover_req(file_path, 4 + 19, 17) string += hover_req(file_path, 5 + 19, 23) errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 ref_results = [ "```fortran90\nCHARACTER*17 :: A\n```", "```fortran90\nCHARACTER*17, DIMENSION(3,4) :: B\n```", "```fortran90\nCHARACTER*17, DIMENSION(9) :: V\n```", "```fortran90\nCHARACTER*(6+3) :: C\n```", "```fortran90\nCHARACTER*10, DIMENSION(3,4) :: D\n```", "```fortran90\nCHARACTER*(LEN(B)), DIMENSION(3,4) :: DD\n```", ] validate_hover(results, ref_results) def test_var_name_asterisk(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "parse")}) file_path = test_dir / "parse" / "test_kinds_and_dims.f90" string += hover_req(file_path, 26, 15) string += hover_req(file_path, 26, 22) string += hover_req(file_path, 26, 34) string += hover_req(file_path, 27, 15) string += hover_req(file_path, 28, 15) string += hover_req(file_path, 29, 15) string += hover_req(file_path, 31, 24) string += hover_req(file_path, 32, 32) # string += hover_req(file_path, 33, 32) # FIXME: this is not displayed correctly errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 ref_results = [ "```fortran90\nCHARACTER*17 :: AA\n```", "```fortran90\nCHARACTER*17, DIMENSION(3,4) :: BB\n```", "```fortran90\nCHARACTER*17, DIMENSION(9) :: VV\n```", "```fortran90\nCHARACTER*(6+3) :: CC\n```", "```fortran90\nCHARACTER*(LEN(A)) :: AAA\n```", "```fortran90\nCHARACTER*10, DIMENSION(*) :: INPUT\n```", "```fortran90\nCHARACTER(LEN=200) :: F\n```", "```fortran90\nCHARACTER(KIND=4, LEN=200), DIMENSION(3,4) :: FF\n```", # "CHARACTER(KIND=4, LEN=100), DIMENSION(3,4)", ] validate_hover(results, ref_results) def test_intent(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "hover" / "intent.f90" string += hover_req(file_path, 2, 31) string += hover_req(file_path, 3, 29) string += hover_req(file_path, 4, 34) string += hover_req(file_path, 5, 35) string += hover_req(file_path, 6, 35) errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 ref_results = [ """```fortran90\nINTEGER(4), INTENT(IN) :: arg1\n```""", """```fortran90\nINTEGER, INTENT(OUT) :: arg2\n```""", """```fortran90\nINTEGER(4), INTENT(INOUT) :: arg3\n```""", """```fortran90\nINTEGER(4), INTENT(IN OUT) :: arg4\n```""", """```fortran90\nREAL, OPTIONAL, INTENT(IN) :: arg5\n```""", ] validate_hover(results, ref_results) def test_multiline_func_args(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "hover")}) file_path = test_dir / "hover" / "functions.f90" string += hover_req(file_path, 58, 22) string += hover_req(file_path, 59, 22) string += hover_req(file_path, 60, 22) errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 ref_results = [ "```fortran90\nINTEGER, INTENT(IN) :: val1\n```", "```fortran90\nINTEGER, INTENT(IN) :: val2\n```", "```fortran90\nREAL :: val4\n```", ] validate_hover(results, ref_results) def test_intrinsics(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "hover")}) file_path = test_dir / "hover" / "functions.f90" string += hover_req(file_path, 39, 23) errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 path = ( test_dir.parent.parent / "fortls" / "parsers" / "internal" / "intrinsic.procedures.markdown.json" ) with open(path, encoding="utf-8") as f: intrinsics = json.load(f) ref_results = ["\n-----\n" + intrinsics["SIZE"]] validate_hover(results, ref_results) def test_types(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "hover")}) file_path = test_dir / "hover" / "types.f90" string += hover_req(file_path, 3, 25) string += hover_req(file_path, 6, 44) string += hover_req(file_path, 9, 35) errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 ref_results = [ "```fortran90\nTYPE, ABSTRACT :: base_t\n```", "```fortran90\nTYPE, ABSTRACT, EXTENDS(base_t) :: extends_t\n```", "```fortran90\nTYPE, EXTENDS(extends_t) :: a_t\n```", ] validate_hover(results, ref_results) def test_complicated_kind_spec(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "hover")}) file_path = test_dir / "hover" / "complicated_kind_spec.f90" string += hover_req(file_path, 1, 40) string += hover_req(file_path, 2, 40) errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 ref_results = [ '```fortran90\nREAL(int(sin(0.5))+8+len("ab((c")-3) :: y\n```', '```fortran90\nREAL(int(sin(0.5))+8+len("ab))c")-3) :: z\n```', ] validate_hover(results, ref_results) def test_multiline_lexical_token(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "hover")}) file_path = test_dir / "hover" / "multiline_lexical_tokens.f90" string += hover_req(file_path, 4, 8) string += hover_req(file_path, 8, 16) errcode, results = run_request(string, fortls_args=["-n", "1"]) assert errcode == 0 ref_results = [ "```fortran90\nINTEGER :: i\n```", '```fortran90\nREAL(int(sin(0.5))+8+len("ab))c")-3) :: Z\n```', ] validate_hover(results, ref_results) fortran-language-server-3.2.2+dfsg/test/test_server_implementation.py000066400000000000000000000066671477231266000262270ustar00rootroot00000000000000# from types import NoneType from setup_tests import path_to_uri, run_request, test_dir, write_rpc_request from fortls.json_templates import uri_json def imp_request(file, line, char): return write_rpc_request( 1, "textDocument/implementation", { "textDocument": {"uri": path_to_uri(str(file))}, "position": {"line": line, "character": char}, }, ) def check_imp_request(response: dict, references: dict): for uri, changes in response.items(): refs = references[uri] # Loop over all the changes in the current URI, instances of object for c, r in zip(changes, refs): assert c["range"] == r["range"] def create(file, line, schar, echar): return uri_json(path_to_uri(str(file)), line, schar, line, echar) def test_implementation_type_bound(): """Go to implementation of type-bound procedures""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test.f90" string += imp_request(file_path, 3, 17) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1] == create(test_dir / "subdir" / "test_free.f90", 49, 11, 28) def test_implementation_intrinsics(): """Go to implementation of implicit methods is handled gracefully""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) file_path = test_dir / "rename" / "test_rename_intrinsic.f90" string += imp_request(file_path, 11, 18) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1] is None def test_implementation_integer(): """Go to implementation when no implementation is present is handled gracefully""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) file_path = test_dir / "rename" / "test_rename_intrinsic.f90" string += imp_request(file_path, 20, 31) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1] is None def test_implementation_empty(): """Go to implementation for empty lines is handled gracefully""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) file_path = test_dir / "rename" / "test_rename_intrinsic.f90" string += imp_request(file_path, 13, 0) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1] is None def test_implementation_no_file(): """Go to implementation for empty lines is handled gracefully""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) file_path = test_dir / "rename" / "fake.f90" string += imp_request(file_path, 13, 0) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1] is None def test_implementation_submodule(): """Go to implementation for submodule""" root = test_dir / "imp" string = write_rpc_request(1, "initialize", {"rootPath": str(root)}) file_path = root / "submodule.f90" string += imp_request(file_path, 5, 30) string += imp_request(file_path, 8, 30) string += imp_request(file_path, 9, 30) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1] == create(str(root / "submodule.f90"), 19, 20, 34) assert results[2] == create(str(root / "submodule.f90"), 19, 20, 34) assert results[3] is None fortran-language-server-3.2.2+dfsg/test/test_server_init.py000066400000000000000000000015521477231266000241310ustar00rootroot00000000000000import os import tempfile import pytest from setup_tests import Path, run_request, write_rpc_request from fortls.constants import Severity @pytest.fixture() def setup_tmp_file(): levels = 2000 fd, filename = tempfile.mkstemp(suffix=".f90") try: with os.fdopen(fd, "w") as tmp: tmp.write( "program nested_if\n" + str("if (.true.) then\n" * levels) + str("end if\n" * levels) + "end program nested_if" ) yield filename finally: os.remove(filename) def test_recursion_error_handling(setup_tmp_file): root = Path(setup_tmp_file).parent request_string = write_rpc_request(1, "initialize", {"rootPath": str(root)}) errcode, results = run_request(request_string) assert errcode == 0 assert results[0]["type"] == Severity.error fortran-language-server-3.2.2+dfsg/test/test_server_messages.py000066400000000000000000000016671477231266000250040ustar00rootroot00000000000000from setup_tests import run_request, test_dir, write_rpc_request def check_msg(ref, res): assert ref["type"] == res["type"] assert ref["message"] == res["message"] # def test_config_file_non_existent(): # string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) # errcode, results = run_request(string, ["-c", "fake.json"]) # # ref = {"type": 1, "message": "Configuration file 'fake.json' not found"} # assert errcode == 0 # check_msg(ref, results[0]) def test_config_file_non_existent_options(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) errcode, results = run_request(string, ["-c", "wrong_syntax.json"]) ref = { "type": 1, "message": ( 'Error: ":2 Unexpected "," at column 18" while reading' ' "wrong_syntax.json" Configuration file' ), } assert errcode == 0 check_msg(ref, results[0]) fortran-language-server-3.2.2+dfsg/test/test_server_references.py000066400000000000000000000046561477231266000253170ustar00rootroot00000000000000from pathlib import Path from setup_tests import path_to_uri, run_request, test_dir, write_rpc_request def validate_refs(result_array, checks): def find_in_results(uri, sline): for i, result in enumerate(result_array): if (result["uri"] == uri) and (result["range"]["start"]["line"] == sline): del result_array[i] return result return None assert len(result_array) == len(checks) for check in checks: result = find_in_results(path_to_uri(check[0]), check[1]) assert result is not None assert result["range"]["start"]["character"] == check[2] assert result["range"]["end"]["character"] == check[3] def ref_req(uri: Path, ln: int, ch: int): return write_rpc_request( 2, "textDocument/references", { "textDocument": {"uri": str(uri)}, "position": {"line": ln - 1, "character": ch - 1}, }, ) def test_references(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += ref_req(file_path, 10, 9) errcode, results = run_request(string) assert errcode == 0 # free_path = str(test_dir / "subdir" / "test_free.f90") validate_refs( results[1], ( [str(test_dir / "test_prog.f08"), 2, 21, 27], [str(test_dir / "test_prog.f08"), 9, 5, 11], [free_path, 8, 8, 14], [free_path, 16, 9, 15], [free_path, 18, 14, 20], [free_path, 36, 6, 12], [free_path, 44, 6, 12], [free_path, 78, 6, 12], ), ) def test_references_ignore_comments_fixed(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "fixed")}) file_path = test_dir / "fixed" / "comment_as_reference.f" string += ref_req(file_path, 3, 22) errcode, results = run_request(string) assert errcode == 0 assert len(results[1]) == 2 def test_references_ignore_comments_on_use_import(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "use")}) file_path = test_dir / "use" / "comment_after_use.f90" string += ref_req(file_path, 6, 31) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 validate_refs( results[1], ( [str(file_path), 1, 15, 27], [str(file_path), 5, 23, 35], ), ) fortran-language-server-3.2.2+dfsg/test/test_server_rename.py000066400000000000000000000172651477231266000244450ustar00rootroot00000000000000from setup_tests import ( check_post_msg, path_to_uri, run_request, test_dir, write_rpc_request, ) def rename_request(new_name: str, file_path, ln: int, ch: int): return write_rpc_request( 1, "textDocument/rename", { "newName": new_name, "textDocument": {"uri": str(file_path)}, "position": {"line": ln, "character": ch}, }, ) def check_rename_response(response: dict, references: dict): # Loop over URI's if the change spans multiple files there will be more than 1 for uri, changes in response.items(): refs = references[uri] # Loop over all the changes in the current URI, instances of object for c, r in zip(changes, refs): assert c["range"] == r["range"] assert c["newText"] == r["newText"] def create(new_text: str, sln: int, sch: int, eln: int, ech: int): return { "range": { "start": {"line": sln, "character": sch}, "end": {"line": eln, "character": ech}, }, "newText": new_text, } def test_rename_var(): """ "Test simple variable rename""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += rename_request("str_rename", file_path, 5, 25) errcode, results = run_request(string) assert errcode == 0 ref = {} ref[path_to_uri(str(file_path))] = [create("str_rename", 5, 20, 5, 29)] check_rename_response(results[1]["changes"], ref) def test_rename_var_across_module(): """Test renaming objects like variables across modules works""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += rename_request("new_module_var", file_path, 26, 15) errcode, results = run_request(string) assert errcode == 0 ref = {} ref[path_to_uri(str(test_dir / "subdir" / "test_free.f90"))] = [ create("new_module_var", 32, 11, 32, 26) ] ref[path_to_uri(str(file_path))] = [create("new_module_var", 2, 44, 2, 59)] ref[path_to_uri(str(file_path))].append(create("new_module_var", 26, 8, 26, 23)) check_rename_response(results[1]["changes"], ref) def test_rename_empty(): """Test that renaming nothing will not error""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) file_path = test_dir / "rename" / "test_rename_imp_type_bound_proc.f90" string += rename_request("bar", file_path, 9, 0) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 assert results[1] is None def test_rename_member_type_ptr(): """Test that renaming type bound pointers of procedure methods rename only the pointer and not the implementation, even if the pointer and the implementation share the same name """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += rename_request("bp_rename", file_path, 18, 25) errcode, results = run_request(string) assert errcode == 0 ref = {} ref[path_to_uri(str(file_path))] = [create("bp_rename", 18, 16, 18, 26)] ref[path_to_uri(str(test_dir / "subdir" / "test_free.f90"))] = [ create("bp_rename", 15, 27, 15, 37) ] check_rename_response(results[1]["changes"], ref) def test_rename_member_type_ptr_null(): """Test renaming type bound pointers of procedure methods works when pointing to null """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += rename_request("bp_rename", file_path, 17, 25) errcode, results = run_request(string) assert errcode == 0 ref = {} ref[path_to_uri(str(file_path))] = [create("bp_rename", 17, 16, 17, 28)] ref[path_to_uri(str(test_dir / "subdir" / "test_free.f90"))] = [ create("bp_rename", 11, 43, 11, 55) ] check_rename_response(results[1]["changes"], ref) def test_rename_type_bound_proc_no_ptr(): """Test renaming type bound pointers of procedure methods works when no pointer is setup. Requesting to rename the procedure should rename, the implementation and the Method itself i.e. call self%foo() Requesting to rename the implementation should also rename the procedure and all the locations it is called in """ root = test_dir / "rename" string = write_rpc_request(1, "initialize", {"rootPath": str(root)}) file_path = root / "test_rename_imp_type_bound_proc.f90" # Rename the procedure name and check if implementation also renames string += rename_request("bar", file_path, 5, 23) # Rename the implementation name and check if declaration, references change string += rename_request("bar", file_path, 10, 18) errcode, results = run_request(string) assert errcode == 0 ref = {} ref[path_to_uri(str(file_path))] = [create("bar", 5, 21, 5, 24)] ref[path_to_uri(str(file_path))].append(create("bar", 10, 15, 10, 18)) ref[path_to_uri(str(file_path))].append(create("bar", 12, 18, 12, 21)) ref[path_to_uri(str(file_path))].append(create("bar", 13, 19, 13, 22)) check_rename_response(results[1]["changes"], ref) check_rename_response(results[2]["changes"], ref) def test_rename_non_existent_file(): """Test renaming type bound pointers of procedure methods works when pointing to null """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "fake.f90" string += rename_request("bar", file_path, 5, 23) errcode, results = run_request(string) assert errcode == 0 assert results[1] is None def test_rename_nested(): """Test renaming heavily nested constructs works""" string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) file_path = test_dir / "rename" / "test_rename_nested.f90" string += rename_request("bar", file_path, 6, 23) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 ref = {} ref[path_to_uri(str(file_path))] = [create("bar", 6, 23, 6, 26)] ref[path_to_uri(str(file_path))].append(create("bar", 9, 27, 9, 30)) check_rename_response(results[1]["changes"], ref) def test_rename_intrinsic(): """Test renaming an intrinsic function, while no other function exists with the same name, will throw an error """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) file_path = test_dir / "rename" / "test_rename_nested.f90" string += rename_request("bar", file_path, 8, 27) errcode, results = run_request(string, ["-n", "1"]) assert errcode == 0 check_post_msg(results[1], "Rename failed: Cannot rename intrinsics", 2) assert results[2] is None def test_rename_use_only_rename(): """Test renaming constructs of `use mod, only: val => root_val are handled correctly """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "subdir")}) file_path = test_dir / "subdir" / "test_rename.F90" string += rename_request("bar", file_path, 13, 5) errcode, results = run_request(string, ["-n", "1"]) # FIXME: to be implemented assert errcode == 0 def test_rename_skip_intrinsic(): """Test that renaming functions named the same as intrinsic functions e.g. size() will only rename the user defined functions """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) file_path = test_dir / "rename" / "test_rename_intrinsic.f90" string += rename_request("bar", file_path, 22, 13) errcode, results = run_request(string, ["-n", "1"]) # FIXME: to be implemented assert errcode == 0 fortran-language-server-3.2.2+dfsg/test/test_server_signature_help.py000066400000000000000000000074251477231266000262040ustar00rootroot00000000000000from pathlib import Path from setup_tests import run_request, test_dir, write_rpc_request def sigh_request(uri: Path, line: int, char: int): return write_rpc_request( 1, "textDocument/signatureHelp", { "textDocument": {"uri": str(uri)}, "position": {"line": line, "character": char}, }, ) def validate_sigh(results, refs): assert results.get("activeParameter", -1) == refs[0] signatures = results.get("signatures") assert signatures[0].get("label") == refs[2] assert len(signatures[0].get("parameters")) == refs[1] def test_subroutine_signature_help(): """Test that the signature help is correctly resolved for all arguments and that the autocompletion is correct for the subroutine signature. """ string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_prog.f08" string += sigh_request(file_path, 25, 18) string += sigh_request(file_path, 25, 20) string += sigh_request(file_path, 25, 22) string += sigh_request(file_path, 25, 27) string += sigh_request(file_path, 25, 29) errcode, results = run_request(string) assert errcode == 0 sub_sig = "test_sig_Sub(arg1, arg2, opt1=opt1, opt2=opt2, opt3=opt3)" ref = ( [0, 5, sub_sig], [1, 5, sub_sig], [2, 5, sub_sig], [3, 5, sub_sig], [4, 5, sub_sig], ) assert len(ref) == len(results) - 1 for i, r in enumerate(ref): validate_sigh(results[i + 1], r) def test_intrinsics(): string = write_rpc_request( 1, "initialize", {"rootPath": str(test_dir / "signature")} ) file_path = test_dir / "signature" / "nested_sigs.f90" string += sigh_request(file_path, 8, 77) errcode, results = run_request( string, ["--hover_signature", "--use_signature_help", "-n", "1"] ) assert errcode == 0 ref = [[0, 2, "REAL(A, KIND=kind)"]] assert len(ref) == len(results) - 1 for i, r in enumerate(ref): validate_sigh(results[i + 1], r) def test_subroutine_markdown(): """Test that the signature help is correctly resolved for all arguments and that the autocompletion is correct for the subroutine signature, when there is documentation present. """ string = write_rpc_request( 1, "initialize", {"rootPath": str(test_dir / "signature")} ) file_path = test_dir / "signature" / "help.f90" string += sigh_request(file_path, 23, 18) errcode, results = run_request( string, ["--hover_signature", "--use_signature_help", "-n1"] ) assert errcode == 0 # Compare against the full signature help response ref = { "signatures": [ { "label": "sub2call(arg1, arg2=arg2)", "parameters": [ { "label": "arg1", "documentation": { "kind": "markdown", "value": ( "```fortran90\nINTEGER, INTENT(IN) ::" " arg1\n```\n-----\nDoc for arg1" ), }, }, { "label": "arg2=arg2", "documentation": { "kind": "markdown", "value": ( "```fortran90\nINTEGER, INTENT(IN), OPTIONAL ::" " arg2\n```\n-----\nDoc for arg2" ), }, }, ], "documentation": {"kind": "markdown", "value": "Top level Doc"}, } ], "activeParameter": 0, } assert results[1] == ref fortran-language-server-3.2.2+dfsg/test/test_source/000077500000000000000000000000001477231266000225235ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/.fortls000066400000000000000000000004351477231266000240370ustar00rootroot00000000000000{ // Directories to be scanned for source files "source_dirs": [ "**/" ], // These are regular expressions, files and paths that can be ignored "excl_paths": [ "excldir/**", "./diag/", "docs", "rename", "parse", "parse/mixed/**", "vis" ] } fortran-language-server-3.2.2+dfsg/test/test_source/completion/000077500000000000000000000000001477231266000246745ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/completion/test_vis_mod_completion.f90000066400000000000000000000003721477231266000321460ustar00rootroot00000000000000module foo implicit none public :: length private integer :: len integer :: length end module foo program test_private use foo, only: length use test_vis_mod implicit none print*, some_var, length end program test_private fortran-language-server-3.2.2+dfsg/test/test_source/completion/use_only_interface.f90000066400000000000000000000010301477231266000310630ustar00rootroot00000000000000module some_mod implicit none private public :: some_sub interface some_sub module procedure a_subroutine module procedure b_subroutine end interface contains subroutine a_subroutine(x) integer, intent(in) :: x write(*,*) 'x = ', x end subroutine a_subroutine subroutine b_subroutine(x, y) integer, intent(in) :: x, y write(*,*) 'x = ', x write(*,*) 'y = ', y end subroutine b_subroutine end module some_mod program main use some_mod, only: some_sub implicit none end program main fortran-language-server-3.2.2+dfsg/test/test_source/diag/000077500000000000000000000000001477231266000234275ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/diag/conf_long_lines.json000066400000000000000000000000761477231266000274630ustar00rootroot00000000000000{ "max_line_length": 80, "max_comment_line_length": 100 } fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_contains.f90000066400000000000000000000003451477231266000266260ustar00rootroot00000000000000program test_contains implicit none contains contains end program test_contains contains module test_contains2 subroutine foo() ! Err: before contains end subroutine contains end module test_contains2 fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_critical.f90000066400000000000000000000002101477231266000265710ustar00rootroot00000000000000program test_critical implicit none if (.true.) then critical end critical end if end program test_critical fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_enum.f90000066400000000000000000000003761477231266000257600ustar00rootroot00000000000000program test_enum implicit none enum, bind(c) enumerator :: red =1, blue, black =5 enumerator yellow enumerator gold, silver, bronze enumerator :: purple enumerator :: pink, lavender endenum end program test_enum fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_external.f90000066400000000000000000000004351477231266000266320ustar00rootroot00000000000000program test_external implicit none REAL, EXTERNAL :: VAL REAL VAR_A EXTERNAL VAR_A EXTERNAL VAR_B REAL VAR_B EXTERNAL VAR_B ! throw error REAL VAR_A ! throw error EXTERNAL VAR_C end program test_external fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_forall.f90000066400000000000000000000004361477231266000262700ustar00rootroot00000000000000program test_forall implicit none integer :: i, j, dim=3, a(10) = 2 select case (dim) case(3) forall(i=1:10) a(i) = a(i) **2 forall (j=1:i) a(j) = a(j) ** 2 end forall case default call abort() end select end program test_forall fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_function.f90000066400000000000000000000002131477231266000266270ustar00rootroot00000000000000module test_functions contains subroutine foo(val) integer, intent(in) :: bar end subroutine end module test_functions fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_function_arg_list.f90000066400000000000000000000016061477231266000305220ustar00rootroot00000000000000program test_arg_names_as_keywords implicit none integer, parameter :: impure = 8 contains subroutine foo(recursive, ierr) integer, intent(in) :: recursive integer, intent(out) :: ierr print*, recursive end subroutine foo real(8) impure elemental function foo2(recursive, elemental) result(pure) integer, intent(in) :: recursive, elemental end function foo2 real( kind = impure ) pure elemental function foo3(recursive) result(pure) integer, intent(in) :: recursive end function foo3 subroutine foo4(& recursive, & ierr) integer, intent(in) :: recursive integer, intent(out) :: ierr print*, recursive end subroutine foo4 pure real(impure) function foo5(recursive) result(val) integer, intent(in) :: recursive end function foo5 end program test_arg_names_as_keywords fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_implicit_none.f90000066400000000000000000000001071477231266000276350ustar00rootroot00000000000000program test_imp implicit none end program test_imp implicit none fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_import.f90000066400000000000000000000001221477231266000263130ustar00rootroot00000000000000program test_diagnostic_import import some end program test_diagnostic_import fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_lines.f90000066400000000000000000000005301477231266000261160ustar00rootroot00000000000000program test_lines implicit none character(len=123) :: val = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nam sodales imperdiet dolor, sit amet venenatis magna dictum id." ! Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nam sodales imperdiet dolor, sit amet venenatis magna dictum id. end program test_lines fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_mixed_case_interface_sub_child.f90000066400000000000000000000003441477231266000331440ustar00rootroot00000000000000module mixed_case_interface_sub_child implicit none contains subroutine foo(Func) interface function Func() end function Func end interface end subroutine foo end module mixed_case_interface_sub_child fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_scope_end_name_var.f90000066400000000000000000000002311477231266000306110ustar00rootroot00000000000000program scope_end_named_var implicit none integer :: end, endif if (.true.) then end = 10 end if end program scope_end_named_var fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_scope_overreach.f90000066400000000000000000000012201477231266000301500ustar00rootroot00000000000000module m interface module subroutine sub(arg) integer :: arg end subroutine end interface end module m submodule (m) n use, intrinsic :: iso_fortran_env, only: int8, int16, int32, int64 implicit none integer, parameter :: sp = selected_real_kind(6) integer, parameter :: dp = selected_real_kind(15) contains pure recursive module function foo_sp(x) result(fi) real(sp), intent(in) :: x real(sp) :: fi end function foo_sp pure recursive module function foo_dp(x) result(fi) real(dp), intent(in) :: x real(dp) :: fi end function foo_dp end submodule n fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_semicolon.f90000066400000000000000000000010271477231266000267760ustar00rootroot00000000000000program test_semicolon implicit none integer :: a = 1; character(len=1) :: v; real, parameter :: p = 0.1E-4; character(len=10), parameter :: str = "a;val;that" character(len=100), parameter :: str2 = "a;string;"& "that;becomes"// & ";"& &"multiline";integer& :: b;real & &,& parameter& ::& c& =& 100& &0090;real :: d;real::e;real::f print*, "one"; print*, str2 print*, a; print*, p; ! a; comment; that;contains; semi-colons end program test_semicolon fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_use_ordering.f90000066400000000000000000000004141477231266000274720ustar00rootroot00000000000000module mod_a integer, parameter :: q_a = 4 end module module mod_b use mod_a integer, parameter :: q_b = 8 end module program test_use_ordering use mod_b, only: q_b use mod_a real(q_a) :: r_a real(q_b) :: r_b end program test_use_ordering fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_var_shadowing_keyword_arg.f90000066400000000000000000000005411477231266000322360ustar00rootroot00000000000000module var_shadowing_keyword_arg character(len=6), parameter :: TEST = "4.10.4" character(len=6, kind=4), parameter :: TEST2 = "4.10.4" real(kind=8) :: a end module var_shadowing_keyword_arg program program_var_shadowing_keyword_arg use var_shadowing_keyword_arg integer :: len integer :: kind end program program_var_shadowing_keyword_arg fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_variable.f90000066400000000000000000000002471477231266000265760ustar00rootroot00000000000000program test_variable integer :: val contains subroutine foo() integer :: val ! Warn: shadows parent end subroutine end program test_variable fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_visibility.f90000066400000000000000000000002141477231266000271720ustar00rootroot00000000000000program test_visibility use nonexisting_module ! Info: missing module implicit none use mod end program test_visibility public fortran-language-server-3.2.2+dfsg/test/test_source/diag/test_where.f90000066400000000000000000000006501477231266000261210ustar00rootroot00000000000000program test_where implicit none ! Example variables real:: A(5),B(5),C(5) A = 0.0 B = 1.0 C = [0.0, 4.0, 5.0, 10.0, 0.0] ! Oneliner WHERE(B .GT. 0.0) B = SUM(A, DIM=1) ! Simple where construct use where (C/=0) A=B/C elsewhere A=0.0 end where ! Named where construct named: where (C/=0) A=B/C elsewhere A=0.0 end where named end program test_where fortran-language-server-3.2.2+dfsg/test/test_source/docs/000077500000000000000000000000001477231266000234535ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/docs/test_doxygen.f90000066400000000000000000000023661477231266000265160ustar00rootroot00000000000000module test_doxygen implicit none contains !> @brief inserts a value into an ordered array !! !! An array "list" consisting of n ascending ordered values. The method insert a !! "new_entry" into the array. !! hint: use cshift and eo-shift !! !! @param[in,out] list a real array, size: max_size !! @param[in] n current values in the array !! @param[in] max_size size if the array !! @param[in] new_entry the value to insert subroutine insert(list, n, max_size, new_entry) real, dimension (:), intent (inout) :: list integer, intent (in) :: n, max_size real, intent (in) :: new_entry end subroutine insert !> @brief calcs the angle between two given vectors !! !! using the standard formula: !! \f$\cos \theta = \frac{ \vec v \cdot \vec w}{\abs{v}\abs{w}}\f$. !! !! @param[in] \f$v,w\f$ real vectors !! size: n !! @return a real value describing the angle. 0 if \f$\abs v\f$ or \f$\abs w\f$ below a !! threshold. pure function calc_angle(v, w) result (theta) real, dimension (:), intent (in) :: v, w real :: theta end function calc_angle end module test_doxygen fortran-language-server-3.2.2+dfsg/test/test_source/docs/test_ford.f90000066400000000000000000000013251477231266000257650ustar00rootroot00000000000000module test_fortd implicit none contains subroutine feed_pets(cats, dogs, food, angry) !! Feeds your cats and dogs, if enough food is available. If not enough !! food is available, some of your pets will get angry. ! Arguments integer, intent(in) :: cats !! The number of cats to keep track of. integer, intent(in) :: dogs !! The number of dogs to keep track of. real, intent(inout) :: food !! The amount of pet food (in kilograms) which you have on hand. integer, intent(out) :: angry !! The number of pets angry because they weren't fed. return end subroutine feed_pets end module test_fortd fortran-language-server-3.2.2+dfsg/test/test_source/docs/test_module_and_type_doc.f90000066400000000000000000000006131477231266000310270ustar00rootroot00000000000000!> module doc for doxygen_doc_mod !! !! with info module doxygen_doc_mod implicit none !> Doc for a_t type :: a_t end type end module module ford_doc_mod !! Doc for ford_doc_mod implicit none type :: b_t !! Doc for b_t end type end module program main use doxygen_doc_mod use ford_doc_mod type(a_t) :: a type(b_t) :: b end program fortran-language-server-3.2.2+dfsg/test/test_source/excldir/000077500000000000000000000000001477231266000241555ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/excldir/sub1/000077500000000000000000000000001477231266000250275ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/excldir/sub1/tmp.f90000066400000000000000000000013401477231266000261450ustar00rootroot00000000000000module oumods use, intrinsic :: iso_c_binding implicit integer(c_int) (i-k), integer(c_int) (m,n), & & real(c_double) (a-h), real(c_double) (l), real(c_double) (o-z) TYPE :: ex_type INTEGER :: A = 0 CONTAINS FINAL :: del_ex_type PROCEDURE :: sub => ex_sub END TYPE ex_type contains subroutine zI12(t,c,alpha,beta,r) complex(c_double_complex) c,r, x,y,z z = c*t y = exp(z) x = (2.0_c_double * cosh((z - cmplx(0._c_double,3.14159265358979324_c_double, kind(1._c_double))) & & /2._c_double )) / (c / exp((z + cmplx(0._c_double,3.14159265358979324_c_double,kind(1._c_double)))/2._c_double)) r = beta*r+alpha*((t*y - x)/c) end subroutine end module fortran-language-server-3.2.2+dfsg/test/test_source/excldir/sub2/000077500000000000000000000000001477231266000250305ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/excldir/sub2/fake2.f90000066400000000000000000000000001477231266000263260ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/f90_config.json000066400000000000000000000016071477231266000253450ustar00rootroot00000000000000{ "nthreads": 8, "notify_init": true, "incremental_sync": true, "recursion_limit": 1500, "sort_keywords": true, "disable_autoupdate": true, "source_dirs": ["subdir", "pp/**"], "incl_suffixes": [".FF", ".fpc", ".h", "f20"], "excl_suffixes": ["_tmp.f90", "_h5hut_tests.F90"], "excl_paths": ["excldir", "hover/**"], "autocomplete_no_prefix": true, "autocomplete_no_snippets": true, "autocomplete_name_only": true, "lowercase_intrinsics": true, "use_signature_help": true, "variable_hover": true, "hover_signature": true, "hover_language": "FortranFreeForm", "max_line_length": 80, "max_comment_line_length": 80, "disable_diagnostics": true, "pp_suffixes": [".h", ".fh"], "include_dirs": ["./include/**"], "pp_defs": { "HAVE_PETSC": "", "HAVE_ZOLTAN": "", "Mat": "type(tMat)" }, "symbol_skip_mem": true, "enable_code_actions": true } fortran-language-server-3.2.2+dfsg/test/test_source/fixed/000077500000000000000000000000001477231266000236225ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/fixed/comment_as_reference.f000066400000000000000000000003301477231266000301300ustar00rootroot00000000000000 program comment_as_reference C Comment with variable name gets picked as a ref: variable_to_reference real variable_to_reference variable_to_reference = 1 end program comment_as_reference fortran-language-server-3.2.2+dfsg/test/test_source/hover/000077500000000000000000000000001477231266000236465ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/hover/associate_block.f90000066400000000000000000000005271477231266000273170ustar00rootroot00000000000000PROGRAM test_associate_block IMPLICIT NONE REAL :: A(5), B(5,5), C, III = 1 ASSOCIATE (X => A, Y => C) PRINT*, X, Y, III END ASSOCIATE ASSOCIATE (X => 1) PRINT*, X END ASSOCIATE ASSOCIATE (ARRAY => B(:,1)) ARRAY (3) = ARRAY (1) + ARRAY (2) END ASSOCIATE END PROGRAM test_associate_block fortran-language-server-3.2.2+dfsg/test/test_source/hover/associate_block_2.f90000066400000000000000000000002751477231266000275400ustar00rootroot00000000000000program associate_block_2 implicit none associate (hi => say_hi()) if (hi) print *, 'Bye' end associate contains logical function say_hi() say_hi = .true. end end program fortran-language-server-3.2.2+dfsg/test/test_source/hover/complicated_kind_spec.f90000066400000000000000000000001761477231266000304750ustar00rootroot00000000000000program complicated_kind_spec real(int(sin(0.5))+8+len("ab((c")-3) :: y real(int(sin(0.5))+8+len("ab))c")-3) :: z end program fortran-language-server-3.2.2+dfsg/test/test_source/hover/functions.f90000066400000000000000000000032031477231266000261740ustar00rootroot00000000000000! simple function function fun1(arg) integer, intent(in) :: arg integer :: fun1 end function fun1 ! function with type on definition, implied result integer function fun2(arg) integer, intent(in) :: arg end function fun2 ! function with return function fun3(arg) result(retval) integer, intent(in) :: arg integer :: retval end function fun3 ! function with type on definition and return integer function fun4(arg) result(retval) integer, intent(in) :: arg end function fun4 ! function with type on definition, return and keywords pure integer elemental function fun5(arg) result(retval) integer, intent(in) :: arg end function fun5 ! function with type on definition and return function fun6(arg) result(retval) integer, intent(in) :: arg integer, dimension(10,10) :: retval end function fun6 ! functions with complex result type pure function outer_product(x, y) real, dimension(:), intent(in) :: x, y real, dimension(size(x), size(y)) :: outer_product integer :: i, j forall (i=1:size(x)) forall (j=1:size(y)) outer_product(i, j) = x(i) * y(j) end forall end forall end function outer_product ! functions with no result type, common in interfaces function dlamch(CMACH) character :: CMACH end function dlamch ! intrinsic functions like c_loc display a return type function fun7() result(val) use, intrinsic :: iso_c_binding integer, dimension(1), target :: ar type(c_ptr) :: val val = c_loc(ar) end function fun7 real function foobar(val1, & val2) & result(val4) integer, intent(in) :: val1, val2 end function foobar fortran-language-server-3.2.2+dfsg/test/test_source/hover/intent.f90000066400000000000000000000004201477231266000254630ustar00rootroot00000000000000subroutine intent(arg1, arg2, arg3, arg4, arg5) implicit none integer(4), intent(in) :: arg1 integer, intent(out) :: arg2 integer(4), intent(inout) :: arg3 integer(4), intent(in out) :: arg4 real, optional, intent(in) :: arg5 end subroutine intent fortran-language-server-3.2.2+dfsg/test/test_source/hover/multiline_lexical_tokens.f90000066400000000000000000000002141477231266000312510ustar00rootroot00000000000000program multiline_lexical_token implicit none inte& &ger & :: i RE& &AL(int(sin(0.5))& &+8+len("ab)& &)c")-3) :: Z end program fortran-language-server-3.2.2+dfsg/test/test_source/hover/parameters.f90000066400000000000000000000016471477231266000263410ustar00rootroot00000000000000program params implicit none integer, parameter :: var = & 1000, & var2 = 23, var3 = & var*var2, & var4 = 123 double precision, parameter :: somevar = 23.12, some = 1e-19 logical(kind=8), parameter :: long_bool = .true. character(len=5), parameter :: sq_str = '12345' character(len=5), parameter :: dq_str = "12345" integer, parameter :: var_no_space=123 integer, parameter :: var_more_space = 123 integer, parameter :: var_sum1 = 1 + 23 integer, parameter :: var_ex1 = 1 - 23 integer, parameter :: var_mul1 = 1 * 23 integer, parameter :: var_div1 = 1/1 INTEGER, PARAMETER :: var_multi2 = 1 * & 23 + & 2 /1 ! comment INTEGER(4), PARAMETER :: SIG$ERR = -1 end program params fortran-language-server-3.2.2+dfsg/test/test_source/hover/pointers.f90000066400000000000000000000000721477231266000260300ustar00rootroot00000000000000program pointers INTEGER, POINTER :: val1 end program fortran-language-server-3.2.2+dfsg/test/test_source/hover/recursive.f90000066400000000000000000000015511477231266000261770ustar00rootroot00000000000000module tree type tree_inode integer :: value = 0 type (tree_inode), pointer :: left=>null() type (tree_inode), pointer :: right=>null() type (tree_inode), pointer :: parent=>null() end type tree_inode contains recursive subroutine recursive_assign_descending(node, vector, current_loc) type(tree_inode), pointer, intent(in) :: node integer, dimension(:), intent(inout) :: vector integer, intent(inout) :: current_loc if (associated(node)) then call recursive_assign_descending(node%right, vector, current_loc) vector(current_loc) = node%value current_loc = current_loc + 1 call recursive_assign_descending(node%left, vector, current_loc) end if return end subroutine recursive_assign_descending end module tree fortran-language-server-3.2.2+dfsg/test/test_source/hover/spaced_keywords.f90000066400000000000000000000003341477231266000273540ustar00rootroot00000000000000subroutine spaced_keywords(arg1, arg2) real, dimension (:, :), intent (in) :: arg1 real, dimension ( size(arg1, 1), maxval([size(arg1, 2), size(arg1, 1)]) ), intent (out) :: arg2 end subroutine spaced_keywords fortran-language-server-3.2.2+dfsg/test/test_source/hover/types.f90000066400000000000000000000003111477231266000253250ustar00rootroot00000000000000module some_mod implicit none type, abstract :: base_t end type type, abstract, extends(base_t) :: extends_t end type type, extends(extends_t) :: a_t end type end module fortran-language-server-3.2.2+dfsg/test/test_source/imp/000077500000000000000000000000001477231266000233105ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/imp/import.f90000066400000000000000000000024411477231266000251430ustar00rootroot00000000000000module import_mod implicit none type :: type1 real(kind=8) :: value contains procedure :: abs_int => abs_int1 end type type1 type :: type2 type(type1) :: t end type type2 interface subroutine abs_int1(this) import type1 class(type1), intent(inout) :: this ! only type1 end subroutine abs_int1 subroutine abs_int2(this) import, only: type2 class(type2), intent(inout) :: this ! only type2 end subroutine abs_int2 subroutine abs_int3(this) import, none class(type1), intent(inout) :: this ! no comp results end subroutine abs_int3 subroutine abs_int4(this) import, all class(type1), intent(inout) :: this ! type1 and type2 end subroutine abs_int4 subroutine abs_int5(this) import class(type1), intent(inout) :: this ! type1 and type2 end subroutine abs_int5 subroutine abs_int6(this) import type1 import type2 class(type1), intent(inout) :: this ! type1 and type2 end subroutine abs_int6 subroutine abs_int7(this) import :: type1, type2 class(type1), intent(inout) :: this ! type1 and type2 end subroutine abs_int7 end interface end module import_mod program main use import_mod type(type1) :: obj call obj%abs_int() end program main fortran-language-server-3.2.2+dfsg/test/test_source/imp/submodule.f90000066400000000000000000000012171477231266000256300ustar00rootroot00000000000000module parent_mod implicit none type :: typ real(kind=8) :: value contains procedure :: method1 => submod_method1 end type typ interface module subroutine submod_method1(this) class(typ), intent(inout) :: this end subroutine submod_method1 module subroutine submod_method2(this, value) class(typ), intent(inout) :: this real, intent(in) :: value end subroutine submod_method2 end interface end module parent_mod submodule(parent_mod) submod contains module subroutine submod_method1(this) class(typ), intent(inout) :: this this%value = 0 end subroutine submod_method1 end submodule submod fortran-language-server-3.2.2+dfsg/test/test_source/include/000077500000000000000000000000001477231266000241465ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/include/empty.h000066400000000000000000000000001477231266000254430ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/parse/000077500000000000000000000000001477231266000236355ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/parse/.fortls000066400000000000000000000000461477231266000251470ustar00rootroot00000000000000{ "excl_paths": [ "mixed" ] } fortran-language-server-3.2.2+dfsg/test/test_source/parse/line_continuations.f90000066400000000000000000000003641477231266000300640ustar00rootroot00000000000000subroutine parse_line_continuations call report_test("[adaptivity output]", .false., .false., "Congratulations! & & The output from adaptivity might even be OK if you get this far.") end subroutine parse_line_continuations fortran-language-server-3.2.2+dfsg/test/test_source/parse/mixed/000077500000000000000000000000001477231266000247435ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/parse/mixed/multilines.F90000066400000000000000000000017201477231266000274100ustar00rootroot00000000000000program multiline_tests implicit none integer :: result character(len=100) :: str ! Test: Simple multi-line continuation result = 1 + & 2 + & 3 ! Test: Multi-line continuation with a preprocessor directive result = 10 + & #ifdef TEST 20 + & #endif 30 ! Test: Multi-line continuation with string concatenation str = 'Hello' // & & ' ' // & & 'World' ! Test: Multi-line continuation with mixed preprocessor and arithmetic operations result = & #ifdef MULT (10*2) + & #else (10 * 3) + & #endif & 10 * 4 ! Test: Multi-line continuation with C preprocessor && sequence result = 100 + & #if defined(TEST) && defined(MULT) &(20) + & #endif &10 ! Test: multiplee Multi-line continuation with C preprocessor and comments result = 1000 + & ! Comment 0 #if defined( TEST ) && defined( MULT ) &100 + & ! Comment 1 &200+& !! Comment 2 #else 500 + & !!! Comment 3 #endif &600 end program multiline_tests fortran-language-server-3.2.2+dfsg/test/test_source/parse/mixed/preproc_and_normal_syntax.F90000066400000000000000000000001441477231266000324740ustar00rootroot00000000000000 USE base_hooks #if VAR < 8 || VAR == 8 && VAR2 < 3 #define OMP_DEFAULT_NONE_WITH_OOP NONE #endif fortran-language-server-3.2.2+dfsg/test/test_source/parse/submodule.f90000066400000000000000000000000471477231266000261550ustar00rootroot00000000000000submodule (p1) val end submodule (p2) fortran-language-server-3.2.2+dfsg/test/test_source/parse/test_incomplete_dims.f90000066400000000000000000000004531477231266000303710ustar00rootroot00000000000000 ! Tests that the parser will not break, when parsing incomplete variables ! constructs. This is particularly important for autocompletion. program test_incomplete_dims implicit none integer :: dim_val(1, 2 character :: char_val*(10 integer :: ( end program test_incomplete_dims fortran-language-server-3.2.2+dfsg/test/test_source/parse/test_kinds_and_dims.f90000066400000000000000000000025351477231266000301670ustar00rootroot00000000000000subroutine normal_kinds() integer, parameter :: r15 = selected_real_kind(15) integer(kind=4) :: a, b(3,4) integer*8 aa, bb(3,4) integer(8) :: aaa, bbb(3,4) real(kind=r15) :: r real(kind(0.d0)) :: rr end subroutine normal_kinds real*8 function foo(val) result(r) real(8), intent(in) :: val r = val end function foo real(kind=8) function phi(val) result(r) real(8), intent(in) :: val r = val end function phi subroutine character_len_parsing(input) ! global variable_type * length variable_name1, variable_name2,... CHARACTER*17 A, B(3,4), V(9) CHARACTER*(6+3) C CHARACTER*10D(3,4) CHARACTER*(LEN(B))DD(3,4) ! local variable_type variable_name1 * length, variable_name2 * length,... CHARACTER AA*17, BB(3,4)*17, VV(9)*17 CHARACTER CC*(6+3) CHARACTER AAA*(LEN(A)) CHARACTER INPUT(*)*10 ! explicit len and kind for characters CHARACTER(LEN=200) F CHARACTER(KIND=4, LEN=200) FF(3,4) CHARACTER(KIND=4, LEN=200) AAAA(3,4)*100 ! override global length with local length CHARACTER*10 BBB(3,4)*(LEN(B)) ! has the length of len(b) CHARACTER*10CCC(3,4)*(LEN(B)) ! no-space CHARACTER(KIND=4) BBBB(3,4)*(LEN(B)) ! cannot have *10(kind=4) or vice versa INTEGER((4)) INT_KIND_IMP ! FIXME: (()) trips up the regex end subroutine character_len_parsing fortran-language-server-3.2.2+dfsg/test/test_source/parse/trailing_semicolon.f90000066400000000000000000000002271477231266000300370ustar00rootroot00000000000000program trailing_semicolon_in_end_scope integer :: i do i=1, 3 print *, "Hello World!" end do; end program trailing_semicolon_in_end_scope fortran-language-server-3.2.2+dfsg/test/test_source/pp/000077500000000000000000000000001477231266000231425ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/pp/.fortls000077700000000000000000000000001477231266000270442.pp_conf.jsonustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/pp/.pp_conf.json000066400000000000000000000004301477231266000255340ustar00rootroot00000000000000{ "lowercase_intrinsics": true, "use_signature_help": true, "variable_hover": true, "hover_signature": true, "enable_code_actions": true, "pp_suffixes": [".h", ".F90"], "incl_suffixes": [".h"], "include_dirs": ["include"], "pp_defs": { "HAVE_CONTIGUOUS": "" } } fortran-language-server-3.2.2+dfsg/test/test_source/pp/include/000077500000000000000000000000001477231266000245655ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/pp/include/petscerror.h000066400000000000000000000004151477231266000271260ustar00rootroot00000000000000#if !defined (PETSCERRORDEF_H) #define PETSCERRORDEF_H #define PETSC_ERR_MEM 55 #define PETSC_ERR_INT_OVERFLOW 84 #define PETSC_ERR_FLOP_COUNT 90 #if defined PETSC_ERR_MEM || defined PETSC_ERR_INT_OVERFLOW #define SUCCESS .true. #endif #endif fortran-language-server-3.2.2+dfsg/test/test_source/pp/include/petscpc.h000066400000000000000000000005041477231266000263760ustar00rootroot00000000000000#if !defined (PETSCPCDEF_H) #define PETSCPCDEF_H #include "petscerror.h" #define PC type(tPC) #define PCType character*(80) #define ewrite(priority, format) if (priority <= 3) write((priority), format) #define ewrite2(priority, format) \ if (priority <= 3) write((priority), format) #define varVar \ 55 #endif fortran-language-server-3.2.2+dfsg/test/test_source/pp/preproc.F90000066400000000000000000000005651477231266000251020ustar00rootroot00000000000000program preprocessor #include "petscpc.h" #ifdef PETSCPCDEF_H integer, parameter :: var = 1000 PCType :: tmp print*, 999, 3.14, "some", var, PETSC_ERR_MEM print*, PETSC_ERR_INT_OVERFLOW, varVar ewrite(1,*) 'Assemble EP P1 matrix and rhs sytem' ewrite2(1,*) 'Assemble EP P1 matrix and rhs sytem' print*, SUCCESS #endif end program preprocessor fortran-language-server-3.2.2+dfsg/test/test_source/pp/preproc_elif.F90000066400000000000000000000013251477231266000260740ustar00rootroot00000000000000subroutine preprocessor_elif(var, var3, var4, var5, var6) ! This file, as used in test_preproc, checks that ! 1. the steps after the preprocessor parsing has fully finished, are only ! using content from the parts within the preprocessor if-elif-else that ! should be used. To do this, it has some regular fortran code within the ! #if and #elif. ! 2. the #endif correctly concludes the if-elif, so any new #define statements ! that come after the #endif, are picked up during the preprocessor parsing. #if 0 integer, intent(in) :: var #elif 1 integer, intent(inout) :: var var = 3 #else integer, intent(out) :: var var = 5 #endif #define OTHERTYPE integer OTHERTYPE :: var2 PRINT*, var endsubroutine preprocessor_elif fortran-language-server-3.2.2+dfsg/test/test_source/pp/preproc_elif_elif_skip.F90000066400000000000000000000012061477231266000301170ustar00rootroot00000000000000subroutine preprocessor_elif_elif_skip() ! This file, as used in test_preproc, and together with the two similar files, ! tests that when there is an if-elif-elif-else, only the first branch that ! evaluates to true is used, and the others ignored. Also when multiple ! conditions evaluate to true. #if 0 #define PART1 0 #elif 1 #define PART2 1 #elif 1 #define PART3 0 #else #define PART4 0 #endif #ifndef PART1 #define PART1 0 #endif #ifndef PART2 #define PART2 0 #endif #ifndef PART3 #define PART3 0 #endif #ifndef PART4 #define PART4 0 #endif integer, parameter :: res = PART1+PART2+PART3+PART4 end subroutine preprocessor_elif_elif_skip fortran-language-server-3.2.2+dfsg/test/test_source/pp/preproc_else.F90000066400000000000000000000003651477231266000261100ustar00rootroot00000000000000subroutine preprocessor_else(var) #if 0 #define MYTYPE logical #else #define MYTYPE integer #endif MYTYPE :: var0 #undef MYTYPE #if 1 #define MYTYPE real #else #define MYTYPE character #endif MYTYPE :: var1 endsubroutine preprocessor_else fortran-language-server-3.2.2+dfsg/test/test_source/pp/preproc_if_elif_else.F90000066400000000000000000000012011477231266000275530ustar00rootroot00000000000000subroutine preprocessor_if_elif_else() ! This file, as used in test_preproc, and together with the two similar files, ! tests that when there is an if-elif-elif-else, only the first branch that ! evaluates to true is used, and the others ignored. Also when multiple ! conditions evaluate to true. #if 0 #define PART1 0 #elif 0 #define PART2 0 #elif 0 #define PART3 0 #else #define PART4 1 #endif #ifndef PART1 #define PART1 0 #endif #ifndef PART2 #define PART2 0 #endif #ifndef PART3 #define PART3 0 #endif #ifndef PART4 #define PART4 0 #endif integer, parameter :: res = PART1+PART2+PART3+PART4 endsubroutine preprocessor_if_elif_else fortran-language-server-3.2.2+dfsg/test/test_source/pp/preproc_if_elif_skip.F90000066400000000000000000000012021477231266000275720ustar00rootroot00000000000000subroutine preprocessor_if_elif_skip() ! This file, as used in test_preproc, and together with the two similar files, ! tests that when there is an if-elif-elif-else, only the first branch that ! evaluates to true is used, and the others ignored. Also when multiple ! conditions evaluate to true. #if 1 #define PART1 1 #elif 0 #define PART2 0 #elif 1 #define PART3 0 #else #define PART4 0 #endif #ifndef PART1 #define PART1 0 #endif #ifndef PART2 #define PART2 0 #endif #ifndef PART3 #define PART3 0 #endif #ifndef PART4 #define PART4 0 #endif integer, parameter :: res = PART1+PART2+PART3+PART4 end subroutine preprocessor_if_elif_skip fortran-language-server-3.2.2+dfsg/test/test_source/pp/preproc_if_nested.F90000066400000000000000000000011231477231266000271110ustar00rootroot00000000000000subroutine preprocessor_if_nested() ! This file, as used in test_preproc, tests that when there are nested ! if-else preprocessor blocks, only the branches are used where ALL ! statements leading to the definition evaluate to true. #if 0 #if 1 #define PART1 1 #else #define PART2 1 #endif #else #if 1 #define PART3 1 #else #define PART4 1 #endif #endif #ifndef PART1 #define PART1 0 #endif #ifndef PART2 #define PART2 0 #endif #ifndef PART3 #define PART3 0 #endif #ifndef PART4 #define PART4 0 #endif integer, parameter :: res = PART1+PART2+PART3+PART4 endsubroutine preprocessor_if_nested fortran-language-server-3.2.2+dfsg/test/test_source/pp/preproc_keywords.F90000066400000000000000000000002271477231266000270240ustar00rootroot00000000000000program test_preproc_keywords REAL & #ifdef HAVE_CONTIGUOUS , CONTIGUOUS & #endif , POINTER :: & var1(:), & var2(:) end program test_preproc_keywords fortran-language-server-3.2.2+dfsg/test/test_source/rename/000077500000000000000000000000001477231266000237725ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/rename/test_rename_imp_type_bound_proc.f90000066400000000000000000000003501477231266000327360ustar00rootroot00000000000000module mod implicit none type :: t contains procedure :: foo end type t contains subroutine foo(self) class(t), intent(in) :: self call self%foo() end subroutine foo end module mod fortran-language-server-3.2.2+dfsg/test/test_source/rename/test_rename_intrinsic.f90000066400000000000000000000013021477231266000306760ustar00rootroot00000000000000module test_rename_intrinsic implicit none interface size module procedure size_comp end interface size contains subroutine size_comp(val, ret) integer, intent(in) :: val(:) integer, intent(out) :: ret integer, dimension(5) :: fixed ret = maxval([size(val), size(fixed)]) end subroutine size_comp end module test_rename_intrinsic program driver use test_rename_intrinsic implicit none integer, dimension(10) :: val integer, dimension(5) :: tmp integer :: sz call size(val, sz) ! This is fortran_sub and should be renamed print*, size(val) ! This is an intrinsic, should be skipped in renaming end program driver fortran-language-server-3.2.2+dfsg/test/test_source/rename/test_rename_nested.f90000066400000000000000000000004041477231266000301600ustar00rootroot00000000000000module mod implicit none contains subroutine fi() contains subroutine phi() integer :: a(5) print*, size(a) ! this is an intrinsic end subroutine phi end subroutine fi end module mod fortran-language-server-3.2.2+dfsg/test/test_source/signature/000077500000000000000000000000001477231266000245245ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/signature/help.f90000066400000000000000000000013661477231266000260020ustar00rootroot00000000000000module sig_help_markdown implicit none private contains !> Top level Doc subroutine sub2call(arg1, arg2) integer, intent(in) :: arg1 !< Doc for arg1 integer, intent(in), optional :: arg2 !< Doc for arg2 print*, "sub2call: arg1=", arg1 if (present(arg2)) print*, "sub2call: arg2=", arg2 end subroutine sub2call !> Top level Doc function fun2fcall(arg1, arg2) result(res) integer, intent(in) :: arg1 !< Doc for arg1 integer, intent(in), optional :: arg2 !< Doc for arg2 integer :: res res = arg1 if (present(arg2)) res = res + arg2 end function fun2fcall subroutine calling() call sub2call(1, 2) print*, "fun2fcall(1, 2)=", fun2fcall(1, 2) end subroutine calling end module sig_help_markdown fortran-language-server-3.2.2+dfsg/test/test_source/signature/nested_sigs.f90000066400000000000000000000005711477231266000273560ustar00rootroot00000000000000program test_nan use, intrinsic :: iso_fortran_env, only: sp=>real32, dp=>real64, qp=>real128 use, intrinsic :: ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan implicit none complex(qp) :: nan_zp nan_zp = ieee_value(1.,ieee_quiet_nan) print '(A4,2X,F5.1,6X,L1,2X,Z32)','zp',real(nan_zp), ieee_is_nan(real(nan_zp)),nan_zp end program test_nan fortran-language-server-3.2.2+dfsg/test/test_source/subdir/000077500000000000000000000000001477231266000240135ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/subdir/test_abstract.f90000066400000000000000000000003741477231266000272010ustar00rootroot00000000000000MODULE test_abstract ABSTRACT INTERFACE SUBROUTINE abs_interface(a,b) INTEGER(4), DIMENSION(3,6), INTENT(in) :: a REAL(8), INTENT(out) :: b(4) END SUBROUTINE abs_interface END INTERFACE PROCEDURE(abs_interface) :: test END MODULE test_abstract fortran-language-server-3.2.2+dfsg/test/test_source/subdir/test_fixed.f000066400000000000000000000013021477231266000263140ustar00rootroot00000000000000 double precision function myfun(n,xval) integer i,n c ********** double precision xval integer ieq1(2), ieq2(2) double precision req(2) character*(LEN=200) bob character dave*(20) equivalence (req(1),ieq1(1)) equivalence (req(2),ieq2(1)) c data req(1) /1.0000000d-16/ data req(2) /1.0000000d-308/ c myfun = xval bob(1:20) = dave do 10 i = 1, n 10 myfun = myfun + xval return c end c subroutine glob_sub(n,xval,yval) integer i,n c ********** double complex xval,yval c yval = xval do 20 i = 1, n yval = yval + xval 20 continue return c end fortran-language-server-3.2.2+dfsg/test/test_source/subdir/test_free.f90000066400000000000000000000042771477231266000263250ustar00rootroot00000000000000MODULE test_free USE, INTRINSIC :: iso_fortran_env, ONLY: error_unit IMPLICIT NONE ! ą TYPE :: scale_type REAL(8) :: val = 1.d0 END TYPE scale_type ! TYPE :: vector INTEGER(4) :: n REAL(8), POINTER, DIMENSION(:) :: v => NULL() PROCEDURE(fort_wrap), NOPASS, POINTER :: bound_nopass => NULL() CONTAINS PROCEDURE :: create => vector_create !< Doc 1 PROCEDURE :: norm => vector_norm !< Doc 2 PROCEDURE, PASS(self) :: bound_pass => bound_pass !< Doc 3 END TYPE vector ! TYPE, EXTENDS(vector) :: scaled_vector TYPE(scale_type) :: scale CONTAINS PROCEDURE :: set_scale => scaled_vector_set !< PROCEDURE :: norm => scaled_vector_norm !< Doc 3 END TYPE scaled_vector ! INTERFACE SUBROUTINE fort_wrap(a,b) INTEGER(4), INTENT(in) :: a REAL(8), INTENT(out) :: b END SUBROUTINE fort_wrap END INTERFACE ! LOGICAL :: module_variable CONTAINS !> Doc 4 SUBROUTINE vector_create(self, n) CLASS(vector), INTENT(inout) :: self INTEGER(4), INTENT(in) :: n !! Doc 5 self%n=n ALLOCATE(self%v(n)) self%v=0.d0 END SUBROUTINE vector_create !> Doc 6 FUNCTION vector_norm(self) RESULT(norm) CLASS(vector), INTENT(in) :: self REAL(8) :: norm norm = SQRT(DOT_PRODUCT(self%v,self%v)) END FUNCTION vector_norm !> Doc 7 SUBROUTINE scaled_vector_set(self, scale) CLASS(scaled_vector), INTENT(inout) :: self ! no documentation REAL(8), INTENT(in) :: scale !< Doc 8 self%scale%val = scale END SUBROUTINE scaled_vector_set !> Top level docstring FUNCTION scaled_vector_norm(self) RESULT(norm) CLASS(scaled_vector), INTENT(in) :: self !< self value docstring REAL(8) :: norm !< return value docstring norm = self%scale%val*SQRT(DOT_PRODUCT(self%v,self%v)) END FUNCTION scaled_vector_norm ! PURE REAL(8) FUNCTION unscaled_norm(self) CLASS(scaled_vector), INTENT(in) :: self ! REAL(8) :: unscaled_norm unscaled_norm = SQRT(DOT_PRODUCT(self%v,self%v)) END FUNCTION unscaled_norm ! SUBROUTINE test_sig_Sub(arg1,arg2,opt1,opt2,opt3) INTEGER, INTENT(in) :: arg1,arg2 INTEGER, OPTIONAL, INTENT(in) :: opt1,opt2,opt3 END SUBROUTINE test_sig_Sub ! SUBROUTINE bound_pass(arg1, self) INTEGER(4), INTENT(in) :: arg1 !< Doc 9 !! Doc 10 !> Doc 11 !! Doc 12 CLASS(vector), INTENT(inout) :: self self%n = arg1 END SUBROUTINE bound_pass END MODULE test_free fortran-language-server-3.2.2+dfsg/test/test_source/subdir/test_generic.f90000066400000000000000000000023261477231266000270110ustar00rootroot00000000000000MODULE test_generic TYPE :: test_gen_type CONTAINS GENERIC :: my_gen => gen1,gen2 GENERIC :: ASSIGNMENT(=) => assign1, assign2 GENERIC :: OPERATOR(+) => plusop1, plusop2 GENERIC, PRIVATE :: my_gen2 => gen3, gen4 END TYPE test_gen_type CONTAINS ! SUBROUTINE gen1(self,a,b) CLASS(test_gen_type) :: self REAL(8), INTENT(IN) :: a REAL(8), INTENT(OUT) :: b CALL self% END SUBROUTINE gen1 ! SUBROUTINE gen2(self,a,b,c) CLASS(test_gen_type) :: self REAL(8), INTENT(IN) :: a,c REAL(8), INTENT(OUT) :: b END SUBROUTINE gen2 ! SUBROUTINE assign1(outvar,invar) REAL(8) :: outvar CLASS(test_gen_type) :: invar END SUBROUTINE assign1 ! SUBROUTINE assign2(outvar,invar) LOGICAL :: outvar CLASS(test_gen_type) :: invar END SUBROUTINE assign2 ! REAL(8) FUNCTION plusop1(var1,var2) REAL(8) :: var1 CLASS(test_gen_type) :: var2 END FUNCTION plusop1 ! LOGICAL FUNCTION plusop2(var1,var2) LOGICAL :: var1 CLASS(test_gen_type) :: var2 END FUNCTION plusop2 ! SUBROUTINE gen3(self,a,b) CLASS(test_gen_type) :: self REAL(8), INTENT(IN) :: a REAL(8), INTENT(OUT) :: b CALL self% END SUBROUTINE gen3 ! SUBROUTINE gen4(self,a,b,c) CLASS(test_gen_type) :: self REAL(8), INTENT(IN) :: a,c REAL(8), INTENT(OUT) :: b END SUBROUTINE gen4 END MODULE test_generic fortran-language-server-3.2.2+dfsg/test/test_source/subdir/test_inc2.f90000066400000000000000000000000441477231266000262230ustar00rootroot00000000000000INTEGER :: val2 REAL :: cross val1 fortran-language-server-3.2.2+dfsg/test/test_source/subdir/test_inherit.f90000066400000000000000000000004471477231266000270410ustar00rootroot00000000000000MODULE test_inherit USE :: test_free, ONLY: scaled_vector IMPLICIT NONE ! TYPE, EXTENDS(scaled_vector) :: myvec REAL(8) :: x END TYPE myvec CONTAINS SUBROUTINE inherit_completion(self) TYPE(myvec), INTENT(INOUT) :: self self%scale%val END SUBROUTINE inherit_completion END MODULE test_inherit fortran-language-server-3.2.2+dfsg/test/test_source/subdir/test_rename.F90000066400000000000000000000005471477231266000266070ustar00rootroot00000000000000module rename_mod1 real(8) :: var1 end module rename_mod1 ! module rename_mod2 use rename_mod1, only: renamed_var1 => var1 integer :: originalname end module rename_mod2 ! subroutine test_rename_sub() use rename_mod2, only : localname => originalname, renamed_var2 => renamed_var1 implicit none ! localname = 4 renamed_var2 = 4 end subroutine test_rename_sub fortran-language-server-3.2.2+dfsg/test/test_source/subdir/test_select.f90000066400000000000000000000011061477231266000266470ustar00rootroot00000000000000MODULE test_select IMPLICIT NONE ! TYPE :: parent INTEGER(4) :: n END TYPE parent ! TYPE, EXTENDS(parent) :: child1 REAL(8) :: a END TYPE child1 ! TYPE, EXTENDS(parent) :: child2 COMPLEX(8) :: a END TYPE child2 CONTAINS ! SUBROUTINE test_select_sub(self) CLASS(parent), INTENT(inout) :: self ! Select statement with binding SELECT TYPE(this=>self) TYPE IS(child1) this%a CLASS IS(child2) this%a CLASS DEFAULT this%n END SELECT ! Select statement without binding SELECT TYPE(self) TYPE IS(child1) self%a END SELECT END SUBROUTINE test_select_sub END MODULE test_select fortran-language-server-3.2.2+dfsg/test/test_source/subdir/test_submod.F90000066400000000000000000000023751477231266000266320ustar00rootroot00000000000000module points type :: point real :: x, y end type point interface module function point_dist(a, b) result(distance) type(point), intent(in) :: a, b real :: distance end function point_dist module logical function is_point_equal_a(a, b) type(point), intent(in) :: a, b end function is_point_equal_a module subroutine is_point_equal_sub(a, b, test) type(point), intent(in) :: a, b logical, intent(out) :: test end subroutine is_point_equal_sub end interface contains logical function is_point_equal(a, b) type(point), intent(in) :: a, b is_point_equal = merge(.true., .false., a%x == b%x .and. a%y == b%y) end function is_point_equal end module points #define __PARENT_MOD__ points submodule (__PARENT_MOD__) points_a contains module function point_dist(a, b) type(point), intent(in) :: a, b distance = sqrt((a%x - b%x)**2 + (a%y - b%y)**2) end function point_dist module procedure is_point_equal_a type(point) :: c is_point_equal_a = merge(.true., .false., a%x == b%x .and. a%y == b%y) end procedure is_point_equal_a module procedure is_point_equal_sub type(point) :: c test = is_point_equal(a,b) end procedure is_point_equal_sub end submodule points_a fortran-language-server-3.2.2+dfsg/test/test_source/subdir/test_vis.f90000066400000000000000000000003031477231266000261670ustar00rootroot00000000000000module test_vis_mod implicit none private type :: some_type end type some_type integer :: some_var public some_var contains subroutine some_sub end subroutine some_sub end module test_vis_mod fortran-language-server-3.2.2+dfsg/test/test_source/test.f90000066400000000000000000000001761477231266000240260ustar00rootroot00000000000000PROGRAM myprog USE test_free, ONLY: scaled_vector TYPE(scaled_vector) :: myvec CALL myvec%set_scale(scale) END PROGRAM myprog fortran-language-server-3.2.2+dfsg/test/test_source/test_block.f08000066400000000000000000000007661477231266000252040ustar00rootroot00000000000000SUBROUTINE block_sub() INTEGER :: res0,i,j,end_var res0 = 0 add1 : BLOCK INTEGER :: res1 res1 = res0 + 1 BLOCK INTEGER :: res2,blockVar res2 = res1 + 1 blockVar = res0 + 1 END BLOCK END BLOCK add1 ! outer: DO i=1,10 DO j=1,i res0=res0+1 END DO END DO outer ! IF(res0>10)THEN i=res0 END IF ! ASSOCIATE( x=>1 ) i=i+x END ASSOCIATE ! Test variables/labels starting with "end" end_var= 1 end_label: DO i=1,3 end_var = end_var + i END DO end_label END SUBROUTINE block_sub fortran-language-server-3.2.2+dfsg/test/test_source/test_diagnostic_int.f90000066400000000000000000000015551477231266000271060ustar00rootroot00000000000000module test_int implicit none contains subroutine foo(f, arg2) interface function f(x) real, intent(in) :: x real :: f end function end interface integer, intent(in) :: arg2 real :: y y = 1. print*, f(y) end subroutine foo function foo2(f, g, h) result(arg3) interface function f(x) result(z) real, intent(in) :: x real :: z end function function g(x) result(z) real, intent(in) :: x real :: z end function end interface interface function h(x) result(z) real, intent(in) :: x real :: z end function h end interface real :: y real :: arg3 y = 1. arg3 = f(g(h(y))) end function foo2 end module test_int fortran-language-server-3.2.2+dfsg/test/test_source/test_import.f90000066400000000000000000000006351477231266000254200ustar00rootroot00000000000000module mymod implicit none private public mytype, mytype2 integer, public :: int1, int2, int3, int4, int5 type :: mytype integer :: comp end type mytype type :: mytype2 integer :: comp end type mytype2 interface subroutine sub() import int1 import mytype, int2 type(mytype) :: some end subroutine sub end interface end module mymod fortran-language-server-3.2.2+dfsg/test/test_source/test_inc.f90000066400000000000000000000002431477231266000246520ustar00rootroot00000000000000MODULE test_mod include "subdir/test_inc2.f90" REAL(8) :: val1 CONTAINS SUBROUTINE test_sub val2 END SUBROUTINE test_sub include 'mpi.f' END MODULE test_mod fortran-language-server-3.2.2+dfsg/test/test_source/test_nonintrinsic.f90000066400000000000000000000003661477231266000266240ustar00rootroot00000000000000module test_nonint_mod private integer, parameter, public :: DP = kind(0.0D0) end module test_nonint_mod program nonint use, non_intrinsic :: test_nonint_mod, only : DP implicit none real(DP) :: x x = 0.0_DP end program nonint fortran-language-server-3.2.2+dfsg/test/test_source/test_prog.f08000066400000000000000000000015321477231266000250510ustar00rootroot00000000000000PROGRAM test_program ! Here is a commonly included unicode character "–" USE test_free, ONLY: vector, scaled_vector, module_variable, test_sig_sub IMPLICIT NONE ! CHARACTER(LEN=*) :: test_str1 = "i2.2,':',i2.2", test_str2 = 'i2.2,":",i2.2' INTEGER(4) :: n,a,b,c,d REAL(8) :: x,y COMPLEX(8) :: xc,yc TYPE(vector) :: loc_vector TYPE(scaled_vector) :: stretch_vector, vector1d(1) ! y = myfun(n,x) CALL glob_sub(n,xc,yc) ! CALL loc_vector%create(n) x = loc_vector%norm() CALL loc_vector%bound_nopass(a,x) CALL loc_vector%bound_pass(n) ! CALL stretch_vector%create(n) CALL stretch_vector%set_scale(loc_vector%norm(self)) x = stretch_vector%norm() y = stretch_vector%scale%val ! CALL test_sig_Sub(a,b,opt2=c,opt3=d) PRINT*, module_variable y = stretch_vector%scale % val y = stretch_vector % scale % val y = vector1d( 1 ) % scale % val END PROGRAM test_program fortran-language-server-3.2.2+dfsg/test/test_source/test_submodule.f90000066400000000000000000000003071477231266000261010ustar00rootroot00000000000000submodule( foo_module ) submodule1 implicit none contains module procedure foo1 WRITE(*,"(A)") "testing :: "// trim(a) // "::"// trim(b) end procedure foo1 end submodule submodule1 fortran-language-server-3.2.2+dfsg/test/test_source/use/000077500000000000000000000000001477231266000233175ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/use/comment_after_use.f90000066400000000000000000000002331477231266000273340ustar00rootroot00000000000000module dep_mod integer :: dep_variable end module dep_mod module user_mod use dep_mod, only: dep_variable ! disabling comment end module user_mod fortran-language-server-3.2.2+dfsg/test/test_source/use/use.f90000066400000000000000000000005351477231266000244360ustar00rootroot00000000000000module use_mod integer :: val1, val2, val3 contains end module use_mod module use_mod_all integer :: val4, val5 contains end module use_mod_all program use_main use use_mod, only: val1, val2 use use_mod, only: val3_renamed => val3 use use_mod_all, only: val4 use use_mod_all, only: val4, val5 print*, val3_renamed print*, val4 end program use_main fortran-language-server-3.2.2+dfsg/test/test_source/vis/000077500000000000000000000000001477231266000233245ustar00rootroot00000000000000fortran-language-server-3.2.2+dfsg/test/test_source/vis/private.f90000066400000000000000000000007011477231266000253140ustar00rootroot00000000000000module visibility private :: name private :: generic_interf interface name module procedure :: name_sp end interface name interface subroutine generic_interf(noop) integer, intent(in) :: noop end subroutine generic_interf end interface contains subroutine name_sp(val) real(4), intent(in) :: val print *, 'name_sp', val end subroutine name_sp end module visibility fortran-language-server-3.2.2+dfsg/test/test_source/wrong_syntax.json000066400000000000000000000000331477231266000261540ustar00rootroot00000000000000{ "source_dirs", "s" }