module PetscF2003
   use,intrinsic :: iso_c_binding
#include "finclude/petscdef.h"
   use petsc

   interface
      function PetscIntViewF2003_1(N,idx,viewer) bind(c,name='PetscIntView')
         use,intrinsic :: iso_c_binding
         PetscInt,value             :: N
         type(c_ptr),value          :: idx
         PetscViewer,value          :: viewer
         PetscErrorCode             :: PetscIntViewF2003
      end function PetscIntViewF2003_1
   end interface
   
!   interface
!      function PetscIntViewF2003_2(N,idx,viewer) bind(c,name='PetscIntView')
!         use,intrinsic :: iso_c_binding
!         PetscInt,value             :: N
!         PetscInt                   :: idx
!         PetscViewer,value          :: viewer
!         PetscErrorCode             :: PetscIntViewF2003
!      end function PetscIntViewF2003_2
!   end interface
!!! For some reason, gfortran will not allow two interface to the same C
!!! function. I am not sure this is correct.
   
   interface
      function PetscOptionsGetIntF2003(pre,name,ivalue,set) bind(c,name='PetscOptionsGetInt')
         use,intrinsic :: iso_c_binding
         character(kind=c_char)     :: pre,name
         PetscInt                   :: ivalue
         PetscBool                  :: set
         PetscErrorCode             :: PetscOptionsGetIntF2003
      end function PetscOptionsGetIntF2003
   end interface

   interface
      function PetscOptionsGetEnumF2003(pre,name,list,value,set) bind(c,name='PetscOptionsGetEnum')
         use,intrinsic :: iso_c_binding
         character(kind=c_char)     :: pre,name
         Type(C_Ptr),dimension(*)   :: list
         PetscInt                   :: value
         PetscBool                  :: set
         PetscErrorCode             :: PetscOptionsGetEnumF2003
      end function PetscOptionsGetEnumF2003
   end interface
end module PetscF2003

Program PetscF2003Binding
#include "finclude/petscdef.h"
   use petsc
   use PetscF2003
   implicit none
   
   PetscErrorCode                   :: ierr
   PetscInt,parameter               :: N=5
   PetscInt,pointer                 :: idx(:)
   PetscInt                         :: i 
   PetscBool                        :: set
   character(kind=c_char,len=99)    :: pre,name
   PetscViewer                      :: viewer=0
   character(kind=c_char),pointer   :: nullc => null(nullc)
   type(C_Ptr),dimension(:),pointer :: list
   
   enum, bind(c)
      enumerator  :: a123=1,b456,c789
   end enum
   Character(len=99,kind=C_char),dimension(N),target :: enumNames 
      
   Call PetscInitialize(PETSC_NULL_CHARACTER,ierr);CHKERRQ(ierr)
   
   allocate(idx(N))
   idx = (/ (i**2, i=1,N) /)
   Write(*,*) 'N:   ',N
   Write(*,*) 'idx: ', idx   
   
   !!! Calling PetscIntView using PETSc's fortran binding
   Call PetscIntView(N,idx,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
   
   !!! Calling PetscIntView, bypassing PETSc's fortran binding
   ierr = PetscIntViewF2003_1(N,c_loc(idx(1)),viewer);CHKERRQ(ierr)
   
   !!! For some reason, gfortran will not allow two interface to the same C
   !!! function. I am not sure this is correct.
   !ierr = PetscIntViewF2003_2(N,idx(1),viewer);CHKERRQ(ierr)
   
   pre = C_NULL_CHAR
   name = trim("-i"//C_NULL_CHAR)
   i = -1
   Call PetscOptionsGetInt(pre,name,i,set,ierr);CHKERRQ(ierr)
   Write(*,*) 'i is ', i
   i = -1
   ierr = PetscOptionsGetIntF2003(pre,name,i,set);CHKERRQ(ierr)
   Write(*,*) 'i is ', i 
   deallocate(idx)

   !!! Now working on calling PetscOptionsGetEnum directly.
   !!! This one is a little bit involved, but most of the work below could be done in a     
   !!! fortran wrapper
   enumNames(1) = 'a123'//C_NULL_CHAR
   enumNames(2) = 'b456'//C_NULL_CHAR
   enumNames(3) = 'c789'//C_NULL_CHAR
   enumNames(4) = 'enumNames'//C_NULL_CHAR
   enumNames(5) = ''//C_NULL_CHAR
   !!! terminating the string with C_NULL_CHAR is essentially equivalent to call PetscFixChar

   Write(*,*), 'a123 is ',a123, trim(enumNames(a123+1))
   Write(*,*), 'b456 is ',b456, trim(enumNames(b456+1))
   Write(*,*), 'c789 is ',c789, trim(enumNames(c789+1))
   
   name = trim("-e"//C_NULL_CHAR)
   Allocate(list(size(enumNames)+1))
   list = (/ (c_loc(enumNames(i)), i = 1,size(enumNames) ) /)
   list(size(enumNames)+1) = c_loc(nullc)
   ierr = PetscOptionsGetEnumF2003(pre,name,list,i,set);CHKERRQ(ierr)
   
   Write(*,*) 'i is', i, trim(enumNames(i+1))
   
   Call PetscFinalize(ierr)
End Program PetscF2003Binding