	subroutine n0
      type mytype
         integer i
         real x
      end type mytype

   type (mytype) con

 ! Note that the typename is required in the syntax.
	parameter (con = mytype(1,1.2))

 ! This can not be a normal function, from this we can conclude that the
 ! IR should not be building a function to represent the initializer.
 ! parameter (con = mytype(1,cos(1.2)))

   end


!===============================================================================
!> This module contains all experiment specific setup necessary to solve the
!> heat diffusion problem in DISPATCH
!===============================================================================
MODULE experiment_mod
  USE io_mod
  USE trace_mod
  USE solver_mod
  implicit none
  private
  !-----------------------------------------------------------------------------
  ! The experiment relies on the solver selected by SOLVER=heat_diffusion in
  ! the experiment Makefile.  It extends it, and overloads the init and update
  ! procedures, to be able to set parameters and do I/O.
  !-----------------------------------------------------------------------------
  type, public, extends(solver_t):: experiment_t
  contains
    procedure:: init
    procedure:: update
  end type
CONTAINS

!===============================================================================
!> Read experiment parameters and use them to set solver parameters
!===============================================================================
SUBROUTINE init (self)
  class(experiment_t):: self
  !.............................................................................
  integer:: iostat
  real, save:: initial_temperature=1, outside_temperature=2., courant=0.1
  logical, save:: first_time=.true.
  namelist /experiment_params/ courant, initial_temperature, outside_temperature
  !-----------------------------------------------------------------------------
  call trace%begin('experiment_t%init')
  !-----------------------------------------------------------------------------
  ! The OpenMP critical region (input_cr) ensures that only the first thread
  ! that arrives here reads from the namelist file.
  !-----------------------------------------------------------------------------
  !$omp critical (input_cr)
  if (first_time) then
    rewind (io%input)
    read (io%input, experiment_params, iostat=iostat)
    if (iostat/=0) call io%namelist_warning ('experiment_params', iostat < 0)
    write (io%output, experiment_params)
    first_time = .false.
  end if
  !$omp end critical (input_cr)
  !-----------------------------------------------------------------------------
  ! Other threads inherit the saved parameters and set them in all tasks
  !-----------------------------------------------------------------------------
  ! the same parameters when they setup subsequent tasks.
  self%initial_temperature = initial_temperature
  self%outside_temperature = outside_temperature
  !-----------------------------------------------------------------------------
  ! Initialize the solver, setting up memory arrays, coordinates, etc
  !-----------------------------------------------------------------------------
  call self%solver_t%init
  self%courant = courant
  self%time = 0d0
  call trace%end
END SUBROUTINE init

!===============================================================================
!> Update the solution, after first possibly saving snapshot data
!===============================================================================
SUBROUTINE update (self)
  class(experiment_t):: self
  !----------------------------------------------------------------------------
  call trace%begin('experiment_t%update')
  call self%output
  call self%solver_t%update
  call trace%end
END SUBROUTINE update

END MODULE experiment_mod


program hello_world

    ! Load the OpenMP functions library
    use omp_lib

    implicit none

    integer :: nthreads, tid

    !  Fork a team of threads, with private versions of the declared variables.
    !$OMP PARALLEL PRIVATE(nthreads, tid)

    ! Get the thread number and print it
    tid = OMP_GET_THREAD_NUM()
    print *, "Hello World from thread number ", tid

    ! Only the master thread does the following
    if (tid == 0) then
        nthreads = OMP_GET_NUM_THREADS()
        print *, "Number of threads = ", nthreads
    end if

    ! Disband all but the master thread
    !$OMP END PARALLEL

end program hello_world


!RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s --check-prefixes="FIRDialect,OMPDialect"
!RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | fir-opt --cfg-conversion | fir-opt --fir-to-llvm-ir | FileCheck %s --check-prefixes="OMPDialect,LLVMDialect"

!===============================================================================
! Parallel sections construct
!===============================================================================

!FIRDialect: func @_QPomp_parallel_sections
subroutine omp_parallel_sections(x, y)
  integer, intent(inout) :: x, y
  !OMPDialect: omp.parallel {
  !OMPDialect: omp.sections {
  !$omp parallel sections
    !OMPDialect: omp.section {
    !$omp section
      !FIRDialect: fir.load
      !FIRDialect: arith.addi
      !FIRDialect: fir.store
      x = x + 12
      !OMPDialect: omp.terminator
    !OMPDialect: omp.section {
    !$omp section
      !FIRDialect: fir.load
      !FIRDialect: arith.subi
      !FIRDialect: fir.store
      y = y - 5
      !OMPDialect: omp.terminator
  !OMPDialect: omp.terminator
  !OMPDialect: omp.terminator
  !$omp end parallel sections
end subroutine omp_parallel_sections

!===============================================================================
! Parallel sections construct with allocate clause
!===============================================================================

!FIRDialect: func @_QPomp_parallel_sections
subroutine omp_parallel_sections_allocate(x, y)
  use omp_lib
  integer, intent(inout) :: x, y
  !FIRDialect: %[[allocator:.*]] = arith.constant 1 : i32
  !LLVMDialect: %[[allocator:.*]] = llvm.mlir.constant(1 : i32) : i32
  !OMPDialect: omp.parallel allocate(%[[allocator]] : i32 -> %{{.*}} : !fir.ref<i32>) {
  !OMPDialect: omp.sections {
  !$omp parallel sections allocate(omp_high_bw_mem_alloc: x)
    !OMPDialect: omp.section {
    !$omp section
      x = x + 12
      !OMPDialect: omp.terminator
    !OMPDialect: omp.section {
    !$omp section
      y = y + 5
      !OMPDialect: omp.terminator
  !OMPDialect: omp.terminator
  !OMPDialect: omp.terminator
  !$omp end parallel sections
end subroutine omp_parallel_sections_allocate


program pointer_simple
    implicit none
    integer, pointer :: a
    integer, pointer :: b
    integer, target  :: t
    integer          :: n

    ! Assign value 1 to target t
    t = 1

    ! Associate pointer a to target t
    a => t

    ! Re-assign new value for target t
    ! note that this will change the value of pointer a too
    t = 2

    ! Associate pointer b to target t
    b => t

    ! sum the two pointers together
    n = a + b

    ! Print the four values
    print *, a, b, t, n

end program pointer_simple


! chk_i0_format --
!     Check: does the compiler support the I0 format for reading?
!
!     Note: this is an extension or an oversight (possibly the format
!     is interpreted just as In, "read n digits or blanks"
!
!     Might require a new category
!
program chk_i0_format
    implicit none

    integer :: ierr
    integer :: x
    character(len=20) :: string = '123'

    write( *, '(a)' ) 'Reading integer value via I0 format'

    x = -1
    read( string, '(i0)', iostat = ierr ) x

    if ( ierr == 0 ) then
        write( *, '(a,i5,2a)' ) '    Integer value read with no problems: ', x, ' - ', &
           merge( 'expected value', 'wrong value   ', x == 123 )
    else
        write( *, '(a,i5)' ) '    An error occurred - I0 format probably not supported for input - iostat = ', ierr
    endif

    write( *, '(a)' ) 'Reading integer value via I0 format with leading blanks'

    string = '    123'

    x = -1
    read( string, '(i0)', iostat = ierr ) x

    if ( ierr == 0 ) then
        write( *, '(a,i5,2a)', iostat = ierr  ) '    Integer value read with no problems: ', x, ' - ', &
           merge( 'expected value', 'wrong value   ', x == 123 )
    else
        write( *, '(a,i5)' ) '    An error occurred - leading blanks probably not allowed - iostat = ', ierr
    endif
end program chk_i0_format


program main
implicit none
integer, target :: v(4)
! target atribute required since v will be pointed to
integer, pointer :: p(:)
! pointer must declared to correct type and rank
v = [10,20,30,40]
p => v(2:3)
associate (w => v(2:3)) ! type of w is inferred
print*,"p =",p
print*,"w =",w
print*,"v =",v
p = p * 10
w = w * 10
! changes to p and w are transmitted to v(2:3)
print*
print*,"p =",p
print*,"w =",w
print*,"v =",v
end associate
! each ASSOCIATE must be terminated with END ASSOCIATE
end program main
! output:
!  p =          20          30
!  w =          20          30
!  v =          10          20          30          40
!
!  p =        2000        3000
!  w =        2000        3000
!  v =          10        2000        3000          40


! { dg-do compile }
! Verify that INTERFACEs don't inherit the implicit types of the
! surrounding namespace.
implicit complex (i-k)

interface
   function f(k,l)
     ! k should be default INTEGER
     dimension l(k)
   end function f
end interface
end


        module precision_mod
        implicit none

        integer, parameter :: dp = selected_real_kind(15,100)

        end module precision_mod


! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
! See https://llvm.org/LICENSE.txt for license information.
! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
!

module shape_mod

type shape
        integer :: color
        logical :: filled
        integer :: x
        integer :: y
end type shape

type, EXTENDS ( shape ) :: rectangle
        integer :: the_length
        integer :: the_width
end type rectangle

type, extends (rectangle) :: square
end type square

end module shape_mod

program p
USE CHECK_MOD
use shape_mod

integer results(8)
integer expect(8)
data expect /.true.,.true.,.true.,.false.,.true.,.true.,.true.,.true./
data results /.false.,.false.,.false.,.true.,.false.,.false.,.false.,.false./
type(square),target :: s(10)
type(rectangle),target :: r(5)
type(rectangle) :: r2
type(square) :: s2
class(rectangle),pointer::ptr(:)

ptr => r

results(1) = SAME_TYPE_AS(ptr(1),r(2))
results(2) = SAME_TYPE_AS(r2,ptr(2))
results(3) = SAME_TYPE_AS(ptr(3), s(2)%rectangle)
results(4) = SAME_TYPE_AS(s2, ptr(4))
results(5) = SAME_TYPE_AS(s2%rectangle, ptr(5))

ptr=>s

results(6) = SAME_TYPE_AS(ptr(6),s(1))
results(7) = SAME_TYPE_AS(s2,ptr(7))
results(8) = EXTENDS_TYPE_OF(s(2),ptr(8))

call check(expect,results,8)

end


program demo_enum

! pseudo-enum
type enum_colors
   integer :: RED=1
   integer :: BLUE=2
   integer :: GREEN=3
   integer :: MAGENTA=4
   integer :: CYAN=5
end type enum_colors
type(enum_colors),parameter :: colors=enum_colors()
integer :: col
write(*,*)colors

   read(*,*)col

   select case(col)
    case(colors%red)
       write(*,*)'red'
    case(colors%green)
       write(*,*)'green'
    case(colors%blue)
       write(*,*)'blue'
   end select

end program demo_enum