module Farray_alloc ! ! Dynamical allocation of f and df. ! implicit none real, dimension(:,:,:,:), allocatable :: df real, dimension(:,:,:,:), pointer :: f real, dimension(:,:,:,:), allocatable, target :: f_arr public :: f, df public :: initialize, finalize external :: allocate_shm contains !****************************************************************************** subroutine initialize use Cdata use Messages, only: fatal_error use Syscalls, only: memusage use iso_c_binding integer :: stat integer(KIND=ikind8) :: nelems=mx*my*mz*mfarray type(C_PTR) :: fp interface type(C_PTR) function allocate_shm(num,name) import :: c_ptr, ikind8 integer(KIND=ikind8) :: num character(LEN=*) :: name endfunction end interface !allocate( f(mx,my,mz,nvar+naux+nscratch+nglobal),STAT=stat) !if (stat>0) call fatal_error('farray_alloc','Could not allocate memory for f') !allocate(df(mx,my,mz,nvar),STAT=stat) !if (stat>0) call fatal_error('farray_alloc','Could not allocate memory for df') !!print*, 'stat,mfarry,nfarray=',stat,mvar,maux,mscratch,mglobal,nvar,naux,nscratch,nglobal !mvar=nvar; maux=naux; maux_com=naux_com; mscratch=nscratch; mglobal=nglobal if (shared_mem_name/='') then fp = allocate_shm(nelems,shared_mem_name//char(0)) call c_f_pointer(fp,f,(/mx,my,mz,mfarray/)) else allocate(f_arr(mx,my,mz,mfarray),STAT=stat) f => f_arr endif if (stat>0) call fatal_error('farray_alloc','Could not allocate f') if (nt>0.and..not.lgpu) then allocate(df(mx,my,mz,mvar),STAT=stat) if (stat>0) call fatal_error('farray_alloc','Could not allocate df') else allocate(df(1,1,1,1)) endif endsubroutine initialize !****************************************************************************** subroutine finalize if (allocated(f_arr)) deallocate(f_arr) !if (shared_mem_name=='') deallocate fp !? if (allocated(df)) deallocate(df) endsubroutine finalize !****************************************************************************** endmodule Farray_alloc