1*6dd63270SBarry Smith#include "petsc/finclude/petscbag.h" 2*6dd63270SBarry Smith 3*6dd63270SBarry Smith#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES) 4*6dd63270SBarry Smith!DEC$ ATTRIBUTES DLLEXPORT::PetscBagRegisterEnum 5*6dd63270SBarry Smith#endif 6*6dd63270SBarry Smith Subroutine PetscBagRegisterEnum(bag,addr,FArray,def,n,h,ierr) 7*6dd63270SBarry Smith use,intrinsic :: iso_c_binding 8*6dd63270SBarry Smith use petscbag 9*6dd63270SBarry Smith implicit none 10*6dd63270SBarry Smith 11*6dd63270SBarry Smith PetscBag bag 12*6dd63270SBarry Smith character(*) n,h 13*6dd63270SBarry Smith character(*) FArray(*) 14*6dd63270SBarry Smith PetscEnum :: def 15*6dd63270SBarry Smith PetscErrorCode,intent(out) :: ierr 16*6dd63270SBarry Smith PetscReal addr(*) 17*6dd63270SBarry Smith 18*6dd63270SBarry Smith Type(C_Ptr),Dimension(:),Pointer :: CArray 19*6dd63270SBarry Smith character(kind=c_char),pointer :: nullc => null() 20*6dd63270SBarry Smith PetscInt :: i,Len 21*6dd63270SBarry Smith Character(kind=C_char,len=256),Dimension(:),Pointer::list1 22*6dd63270SBarry Smith 23*6dd63270SBarry Smith do i=1,256 24*6dd63270SBarry Smith if (len_trim(Farray(i)) .eq. 0) then 25*6dd63270SBarry Smith Len = i-1 26*6dd63270SBarry Smith goto 100 27*6dd63270SBarry Smith endif 28*6dd63270SBarry Smith if (len_trim(Farray(i)) .gt. 255) then 29*6dd63270SBarry Smith ierr = PETSC_ERR_ARG_OUTOFRANGE 30*6dd63270SBarry Smith return 31*6dd63270SBarry Smith endif 32*6dd63270SBarry Smith enddo 33*6dd63270SBarry Smith ierr = PETSC_ERR_ARG_OUTOFRANGE 34*6dd63270SBarry Smith return 35*6dd63270SBarry Smith 36*6dd63270SBarry Smith 100 continue 37*6dd63270SBarry Smith 38*6dd63270SBarry Smith Allocate(list1(Len),stat=ierr) 39*6dd63270SBarry Smith if (ierr .ne. 0) return 40*6dd63270SBarry Smith Allocate(CArray(Len+1),stat=ierr) 41*6dd63270SBarry Smith if (ierr .ne. 0) return 42*6dd63270SBarry Smith 43*6dd63270SBarry Smith do i=1,Len 44*6dd63270SBarry Smith list1(i) = trim(FArray(i))//C_NULL_CHAR 45*6dd63270SBarry Smith CArray(i) = c_loc(list1(i)) 46*6dd63270SBarry Smith enddo 47*6dd63270SBarry Smith 48*6dd63270SBarry Smith CArray(Len+1) = c_loc(nullc) 49*6dd63270SBarry Smith call PetscBagRegisterEnumPrivate(bag,addr,CArray,def,n,h,ierr) 50*6dd63270SBarry Smith DeAllocate(CArray) 51*6dd63270SBarry Smith DeAllocate(list1) 52*6dd63270SBarry Smith End Subroutine 53