16dd63270SBarry Smith#include "petsc/finclude/petscbag.h" 26dd63270SBarry Smith 36dd63270SBarry Smith#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES) 46dd63270SBarry Smith!DEC$ ATTRIBUTES DLLEXPORT::PetscBagRegisterEnum 56dd63270SBarry Smith#endif 6*02c639afSMartin Diehl subroutine PetscBagRegisterEnum(bag, addr, FArray, def, n, h, ierr) 76dd63270SBarry Smith use, intrinsic :: iso_c_binding 86dd63270SBarry Smith use petscbag 96dd63270SBarry Smith implicit none 106dd63270SBarry Smith 116dd63270SBarry Smith PetscBag bag 126dd63270SBarry Smith character(*) n, h 136dd63270SBarry Smith character(*) FArray(*) 146dd63270SBarry Smith PetscEnum :: def 156dd63270SBarry Smith PetscErrorCode, intent(out) :: ierr 166dd63270SBarry Smith PetscReal addr(*) 176dd63270SBarry Smith 18*02c639afSMartin Diehl type(C_Ptr), dimension(:), pointer :: CArray 196dd63270SBarry Smith character(kind=c_char), pointer :: nullc => null() 206dd63270SBarry Smith PetscInt :: i, Len 21*02c639afSMartin Diehl character(kind=C_char, len=256), dimension(:), pointer::list1 226dd63270SBarry Smith 236dd63270SBarry Smith do i = 1, 256 244820e4eaSBarry Smith if (len_trim(Farray(i)) == 0) then 256dd63270SBarry Smith Len = i - 1 266dd63270SBarry Smith goto 100 276dd63270SBarry Smith end if 284820e4eaSBarry Smith if (len_trim(Farray(i)) > 255) then 296dd63270SBarry Smith ierr = PETSC_ERR_ARG_OUTOFRANGE 306dd63270SBarry Smith return 316dd63270SBarry Smith end if 326dd63270SBarry Smith end do 336dd63270SBarry Smith ierr = PETSC_ERR_ARG_OUTOFRANGE 346dd63270SBarry Smith return 356dd63270SBarry Smith 366dd63270SBarry Smith100 continue 376dd63270SBarry Smith 38*02c639afSMartin Diehl allocate (list1(Len), stat=ierr) 394820e4eaSBarry Smith if (ierr /= 0) return 40*02c639afSMartin Diehl allocate (CArray(Len + 1), stat=ierr) 414820e4eaSBarry Smith if (ierr /= 0) return 426dd63270SBarry Smith 436dd63270SBarry Smith do i = 1, Len 446dd63270SBarry Smith list1(i) = trim(FArray(i))//C_NULL_CHAR 456dd63270SBarry Smith CArray(i) = c_loc(list1(i)) 466dd63270SBarry Smith end do 476dd63270SBarry Smith 486dd63270SBarry Smith CArray(Len + 1) = c_loc(nullc) 496dd63270SBarry Smith call PetscBagRegisterEnumPrivate(bag, addr, CArray, def, n, h, ierr) 50*02c639afSMartin Diehl deallocate (CArray) 51*02c639afSMartin Diehl deallocate (list1) 52*02c639afSMartin Diehl end subroutine 53