Thanks for using Compiler Explorer
Sponsors
Jakt
C++
Ada
Analysis
Android Java
Android Kotlin
Assembly
C
C3
Carbon
C++ (Circle)
CIRCT
Clean
CMake
CMakeScript
COBOL
C++ for OpenCL
MLIR
Cppx
Cppx-Blue
Cppx-Gold
Cpp2-cppfront
Crystal
C#
CUDA C++
D
Dart
Elixir
Erlang
Fortran
F#
Go
Haskell
HLSL
Hook
Hylo
ispc
Java
Julia
Kotlin
LLVM IR
LLVM MIR
Modula-2
Nim
Objective-C
Objective-C++
OCaml
OpenCL C
Pascal
Pony
Python
Racket
Ruby
Rust
Snowball
Scala
Solidity
Spice
Swift
LLVM TableGen
Toit
TypeScript Native
V
Vala
Visual Basic
WASM
Zig
Javascript
GIMPLE
fortran source #1
Output
Compile to binary object
Link to binary
Execute the code
Intel asm syntax
Demangle identifiers
Verbose demangling
Filters
Unused labels
Library functions
Directives
Comments
Horizontal whitespace
Debug intrinsics
Compiler
AARCH64 gfortran 10.5.0
AARCH64 gfortran 11.4.0
AARCH64 gfortran 12.1.0
AARCH64 gfortran 12.2.0
AARCH64 gfortran 12.3.0
AARCH64 gfortran 12.4.0
AARCH64 gfortran 13.1.0
AARCH64 gfortran 13.2.0
AARCH64 gfortran 13.3.0
AARCH64 gfortran 14.1.0
AARCH64 gfortran 4.9.4
AARCH64 gfortran 5.5.0
AARCH64 gfortran 6.4
AARCH64 gfortran 7.3
AARCH64 gfortran 8.2
ARM (32bit) gfortran 10.5.0
ARM (32bit) gfortran 11.4.0
ARM (32bit) gfortran 12.1.0
ARM (32bit) gfortran 12.2.0
ARM (32bit) gfortran 12.3.0
ARM (32bit) gfortran 12.4.0
ARM (32bit) gfortran 13.1.0
ARM (32bit) gfortran 13.2.0
ARM (32bit) gfortran 13.3.0
ARM (32bit) gfortran 14.1.0
ARM (32bit) gfortran 6.4
ARM (32bit) gfortran 7.3
ARM (32bit) gfortran 8.2
LOONGARCH64 gfortran 12.2.0
LOONGARCH64 gfortran 12.3.0
LOONGARCH64 gfortran 12.4.0
LOONGARCH64 gfortran 13.1.0
LOONGARCH64 gfortran 13.2.0
LOONGARCH64 gfortran 13.3.0
LOONGARCH64 gfortran 14.1.0
MIPS gfortran 12.1.0
MIPS gfortran 12.2.0
MIPS gfortran 12.3.0
MIPS gfortran 12.4.0
MIPS gfortran 13.1.0
MIPS gfortran 13.2.0
MIPS gfortran 13.3.0
MIPS gfortran 14.1.0
MIPS gfortran 4.9.4
MIPS gfortran 5.5.0
MIPS gfortran 9.5.0
MIPS64 gfortran 12.1.0
MIPS64 gfortran 12.2.0
MIPS64 gfortran 12.3.0
MIPS64 gfortran 12.4.0
MIPS64 gfortran 13.1.0
MIPS64 gfortran 13.2.0
MIPS64 gfortran 13.3.0
MIPS64 gfortran 14.1.0
MIPS64 gfortran 4.9.4
MIPS64 gfortran 5.5.0
MIPS64 gfortran 9.5.0
MIPS64el gfortran 12.1.0
MIPS64el gfortran 12.2.0
MIPS64el gfortran 12.3.0
MIPS64el gfortran 12.4.0
MIPS64el gfortran 13.1.0
MIPS64el gfortran 13.2.0
MIPS64el gfortran 13.3.0
MIPS64el gfortran 14.1.0
MIPS64el gfortran 4.9.4
MIPS64el gfortran 5.5.0
MIPS64el gfortran 9.5.0
MIPSel gfortran 12.1.0
MIPSel gfortran 12.2.0
MIPSel gfortran 12.3.0
MIPSel gfortran 12.4.0
MIPSel gfortran 13.1.0
MIPSel gfortran 13.2.0
MIPSel gfortran 13.3.0
MIPSel gfortran 14.1.0
MIPSel gfortran 4.9.4
MIPSel gfortran 5.5.0
MIPSel gfortran 9.5.0
POWER gfortran 12.1.0
POWER gfortran 12.2.0
POWER gfortran 12.3.0
POWER gfortran 12.4.0
POWER gfortran 13.1.0
POWER gfortran 13.2.0
POWER gfortran 13.3.0
POWER gfortran 14.1.0
POWER64 gfortran 12.1.0
POWER64 gfortran 12.2.0
POWER64 gfortran 12.3.0
POWER64 gfortran 12.4.0
POWER64 gfortran 13.1.0
POWER64 gfortran 13.2.0
POWER64 gfortran 13.3.0
POWER64 gfortran 14.1.0
POWER64 gfortran trunk
POWER64le gfortran 12.1.0
POWER64le gfortran 12.2.0
POWER64le gfortran 12.3.0
POWER64le gfortran 12.4.0
POWER64le gfortran 13.1.0
POWER64le gfortran 13.2.0
POWER64le gfortran 13.3.0
POWER64le gfortran 14.1.0
POWER64le gfortran trunk
RISC-V 32-bits gfortran (trunk)
RISC-V 32-bits gfortran 12.1.0
RISC-V 64-bits gfortran (trunk)
RISC-V 64-bits gfortran 12.1.0
RISCV (32bit) gfortran 11.4.0
RISCV (32bit) gfortran 12.2.0
RISCV (32bit) gfortran 12.3.0
RISCV (32bit) gfortran 12.4.0
RISCV (32bit) gfortran 13.1.0
RISCV (32bit) gfortran 13.2.0
RISCV (32bit) gfortran 13.3.0
RISCV (32bit) gfortran 14.1.0
RISCV64 gfortran 11.4.0
RISCV64 gfortran 12.2.0
RISCV64 gfortran 12.3.0
RISCV64 gfortran 12.4.0
RISCV64 gfortran 13.1.0
RISCV64 gfortran 13.2.0
RISCV64 gfortran 13.3.0
RISCV64 gfortran 14.1.0
SPARC LEON gfortran 12.2.0
SPARC LEON gfortran 12.3.0
SPARC LEON gfortran 12.4.0
SPARC LEON gfortran 13.1.0
SPARC LEON gfortran 13.2.0
SPARC LEON gfortran 13.3.0
SPARC LEON gfortran 14.1.0
SPARC gfortran 12.2.0
SPARC gfortran 12.3.0
SPARC gfortran 12.4.0
SPARC gfortran 13.1.0
SPARC gfortran 13.2.0
SPARC gfortran 13.3.0
SPARC gfortran 14.1.0
SPARC64 gfortran 12.2.0
SPARC64 gfortran 12.3.0
SPARC64 gfortran 12.4.0
SPARC64 gfortran 13.1.0
SPARC64 gfortran 13.2.0
SPARC64 gfortran 13.3.0
SPARC64 gfortran 14.1.0
flang-trunk (flang-new)
flang-trunk-fc1 (flang-new)
power64 AT12.0
power64 AT13.0
power64le AT12.0
power64le AT13.0
s390x gfortran 12.1.0
s390x gfortran 12.2.0
s390x gfortran 12.3.0
s390x gfortran 12.4.0
s390x gfortran 13.1.0
s390x gfortran 13.2.0
s390x gfortran 13.3.0
s390x gfortran 14.1.0
x86-64 gfortran (trunk)
x86-64 gfortran 10.1
x86-64 gfortran 10.2
x86-64 gfortran 10.3
x86-64 gfortran 10.4
x86-64 gfortran 10.5
x86-64 gfortran 11.1
x86-64 gfortran 11.2
x86-64 gfortran 11.3
x86-64 gfortran 11.4
x86-64 gfortran 12.1
x86-64 gfortran 12.2
x86-64 gfortran 12.3
x86-64 gfortran 12.4
x86-64 gfortran 13.1
x86-64 gfortran 13.2
x86-64 gfortran 13.3
x86-64 gfortran 14.1
x86-64 gfortran 4.9.4
x86-64 gfortran 5.5
x86-64 gfortran 6.3
x86-64 gfortran 7.1
x86-64 gfortran 7.2
x86-64 gfortran 7.3
x86-64 gfortran 8.1
x86-64 gfortran 8.2
x86-64 gfortran 8.3
x86-64 gfortran 8.4
x86-64 gfortran 8.5
x86-64 gfortran 9.1
x86-64 gfortran 9.2
x86-64 gfortran 9.3
x86-64 gfortran 9.4
x86-64 ifort 19.0.0
x86-64 ifort 2021.1.2
x86-64 ifort 2021.10.0
x86-64 ifort 2021.11.0
x86-64 ifort 2021.2.0
x86-64 ifort 2021.3.0
x86-64 ifort 2021.4.0
x86-64 ifort 2021.5.0
x86-64 ifort 2021.6.0
x86-64 ifort 2021.7.0
x86-64 ifort 2021.7.1
x86-64 ifort 2021.8.0
x86-64 ifort 2021.9.0
x86-64 ifx (latest)
x86-64 ifx 2021.1.2
x86-64 ifx 2021.2.0
x86-64 ifx 2021.3.0
x86-64 ifx 2021.4.0
x86-64 ifx 2022.0.0
x86-64 ifx 2022.1.0
x86-64 ifx 2022.2.0
x86-64 ifx 2022.2.1
x86-64 ifx 2023.0.0
x86-64 ifx 2023.1.0
x86-64 ifx 2023.2.1
x86-64 ifx 2024.0.0
Options
Source code
module subs use iso_fortran_env implicit none integer, parameter :: ip = int8 ! Parameters characterizing voxel meshing integer(ip), parameter :: CELL_MAXNUMFACES = 6_ip integer(ip), parameter :: ISOSURF_FACE_ERROR = 127_ip ! Invalid face integer(ip), parameter :: ISOSURF_FACE_INTERIOR = -127_ip ! Face in the cell's interior integer(ip), parameter :: ISOSURF_FACE_ISO = -126_ip ! Isosurface face integer(ip), parameter :: ISOSURF_FACE_VOLHI = -125_ip ! Face of high-volume wrapping integer(ip), parameter :: ISOSURF_FACE_FULLPARENT = -124_ip ! Face fully overlaps with the parent one integer(ip), parameter :: ISOSURF_FACE_PARTPARENT = -123_ip ! Face partially overlaps with the parent one integer(ip), parameter :: ISOSURF_FACE_MIN_ID = -122_ip contains elemental integer(1) function CREATE_CODE(iface,ichild) integer(1), intent(in) :: iface ! in [1:6] range integer(1), intent(in) :: ichild ! in [1:32] range integer(1), parameter :: CELL_MAXFACES1 = int(CELL_MAXNUMFACES,1) CREATE_CODE = ISOSURF_FACE_MIN_ID + CELL_MAXNUMFACES*(ichild+1_ip) + iface end function CREATE_CODE elemental subroutine UNROLL_CODE(faceID,ifacecell,ichild,facetype) integer(ip), intent(in) :: faceID integer(ip), intent(out) :: ifacecell,ichild integer(ip), intent(out) :: facetype integer(ip), parameter :: ISOSURF_FACE_MIN_ID = -122_ip integer(ip), parameter :: CELL_MAXFACES1 = int(CELL_MAXNUMFACES,1) integer(ip) :: ichildp1 select case (faceID) case (ISOSURF_FACE_ERROR) facetype = ISOSURF_FACE_ERROR ifacecell = -huge(ifacecell) ichild = -huge(ichild) case (ISOSURF_FACE_ISO) facetype = ISOSURF_FACE_ISO ifacecell = -huge(ifacecell) ichild = -huge(ichild) case (ISOSURF_FACE_VOLHI) facetype = ISOSURF_FACE_VOLHI ifacecell = -huge(ifacecell) ichild = -huge(ichild) case (ISOSURF_FACE_MIN_ID+1_ip:82_ip) ifacecell = faceID ichild = -1_ip ! Child ID loop do while (ifacecell>ISOSURF_FACE_MIN_ID+CELL_MAXNUMFACES) ichild = ichild +1_ip ifacecell = ifacecell-CELL_MAXNUMFACES end do ifacecell = ifacecell-ISOSURF_FACE_MIN_ID ! Remainder = ifacecell select case (ichild) case (-1_ip) facetype = ISOSURF_FACE_PARTPARENT case (0_ip) facetype = ISOSURF_FACE_FULLPARENT case default facetype = ISOSURF_FACE_INTERIOR end select case default facetype = ISOSURF_FACE_ERROR ifacecell = -huge(ifacecell) ichild = -huge(ichild) end select end subroutine UNROLL_CODE end module program test_int1 use subs integer(ip) :: ichild,faceID,ichild_chk,iface_chk,facetype,iface_test,ichild_test logical :: iface_OK,child_OK,type_OK,success,code_OK iface_test = 1_ip ichild_test = 32_ip faceID = CREATE_CODE(iface_test,ichild_test) code_OK = faceID==77_ip if (.not.code_OK) print *, ' code not OK: faceID=',faceID,' should be ',77_ip call UNROLL_CODE(faceID,iface_chk,ichild_chk,facetype) ! Check expected results iface_OK = iface_chk==iface_test child_OK = ichild_chk==ichild_test type_OK = facetype==ISOSURF_FACE_INTERIOR success = iface_OK.and.child_OK.and.type_OK print *, merge('SUCCESS!','ERROR ',success) if (.not.success) print *, ' iface=',iface,& ' faceID=',faceID,& ' ifaceOK=',iface_chk,& ' ichild_OK=',ichild_chk,& ' facetype=',facetype end program test_int1
Become a Patron
Sponsor on GitHub
Donate via PayPal
Source on GitHub
Mailing list
Installed libraries
Wiki
Report an issue
How it works
Contact the author
CE on Mastodon
About the author
Statistics
Changelog
Version tree