Actual source code: bagenum.F
petsc-3.7.1 2016-05-15
Report Typos and Errors

      2: #include "petsc/finclude/petscsysdef.h"
      3: #include "petsc/finclude/petscbagdef.h"

      5:       Subroutine PetscBagRegisterEnum(bag,addr,FArray,def,n,h,ierr)
      6:       use,intrinsic :: iso_c_binding
      7:       implicit none

      9:       PetscBag   bag
     10:       character(*)                n,h
     11:       character(*)                FArray(*)
     12:       PetscEnum                   :: def
     13:       PetscErrorCode,intent(out)  :: ierr
     14:       PetscReal addr(*)

     16:       Type(C_Ptr),Dimension(:),Pointer :: CArray
     17:       character(kind=c_char),pointer   :: nullc => null()
     18:       PetscInt   :: i,Len
     19:       Character(kind=C_char,len=256),Dimension(:),Pointer::list1

     21:       do i=1,256
     22:         if (len_trim(Farray(i)) .eq. 0) then
     23:           Len = i-1
     24:           goto 100
     25:         endif
     26:         if (len_trim(Farray(i)) .gt. 255) then
     27:           PETSC_ERR_ARG_OUTOFRANGE
     28:           return
     29:         endif
     30:       enddo
     31:       PETSC_ERR_ARG_OUTOFRANGE
     32:       return

     34:  100  continue

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

     45:       CArray = (/(c_loc(list1(i)),i=1,Len),c_loc(nullc)/)
     46:       call PetscBagRegisterEnumPrivate(bag,addr,CArray,def,n,h,ierr)
     47:       DeAllocate(CArray)
     48:       DeAllocate(list1)
     49:       End Subroutine