Actual source code: optionenum.F90

      1: #include "petsc/finclude/petscsys.h"

      3: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
      4: !DEC$ ATTRIBUTES DLLEXPORT::PetscOptionsGetEnum
      5: !DEC$ ATTRIBUTES DLLEXPORT::PetscOptionsEnum
      6: #endif

      8: Subroutine PetscOptionsGetEnum(po,pre,name,FArray,opt,set,ierr)
      9:   use,intrinsic :: iso_c_binding
     10:   use petscsysdef
     11:   implicit none

     13:   character(*)                pre,name
     14:   character(*)                FArray(*)
     15:   PetscEnum                   :: opt
     16:   PetscBool                   :: set
     17:   PetscOptions                :: po
     18:   PetscErrorCode,intent(out)  :: ierr

     20:   Type(C_Ptr),Dimension(:),Pointer :: CArray
     21:   character(kind=c_char),pointer   :: nullc => null()
     22:   PetscInt   :: i,Len
     23:   Character(kind=C_char,len=99),Dimension(:),Pointer::list1

     25:   Len=0
     26:   do i=1,100
     27:     if (len_trim(Farray(i)) .eq. 0) then
     28:       Len = i-1
     29:       goto 100
     30:     endif
     31:   enddo
     32: 100  continue

     34:   Allocate(list1(Len),stat=ierr)
     35:   if (ierr .ne. 0) return
     36:   Allocate(CArray(Len+1),stat=ierr)
     37:   if (ierr .ne. 0) return
     38:   do i=1,Len
     39:       list1(i) = trim(FArray(i))//C_NULL_CHAR
     40:       CArray(i) = c_loc(list1(i))
     41:   enddo

     43:   CArray(Len+1) = c_loc(nullc)
     44:   call PetscOptionsGetEnumPrivate(po,pre,name,CArray,opt,set,ierr)
     45:   DeAllocate(CArray)
     46:   DeAllocate(list1)
     47: End Subroutine

     49: Subroutine PetscOptionsEnum(opt,text,man,Flist,curr,ivalue,set,ierr)
     50:   use,intrinsic :: iso_c_binding
     51:   use petscsysdef
     52:   implicit none

     54:   character(*)                opt,text,man
     55:   character(*)                Flist(*)
     56:   PetscEnum                   :: curr,ivalue
     57:   PetscBool                   :: set
     58:   PetscErrorCode,intent(out)  :: ierr

     60:   Type(C_Ptr),Dimension(:),Pointer :: CArray
     61:   character(kind=c_char),pointer   :: nullc => null()
     62:   PetscInt   :: i,Len
     63:   Character(kind=C_char,len=99),Dimension(:),Pointer::list1

     65:   Len=0
     66:   do i=1,100
     67:     if (len_trim(Flist(i)) .eq. 0) then
     68:       Len = i-1
     69:       goto 100
     70:     endif
     71:   enddo
     72: 100  continue

     74:   Allocate(list1(Len),stat=ierr)
     75:   if (ierr .ne. 0) return
     76:   Allocate(CArray(Len+1),stat=ierr)
     77:   if (ierr .ne. 0) return
     78:   do i=1,Len
     79:       list1(i) = trim(Flist(i))//C_NULL_CHAR
     80:       CArray(i) = c_loc(list1(i))
     81:   enddo

     83:   CArray(Len+1) = c_loc(nullc)
     84:   call PetscOptionsEnumPrivate(opt,text,man,CArray,curr,ivalue,set,ierr)

     86:   DeAllocate(CArray)
     87:   DeAllocate(list1)
     88: End Subroutine PetscOptionsEnum