!------------------------------------------------------------------------------| !------------------------------------------------------------------------------| ! | ! ||===\\ | ! || \\ | ! || || //==\\ || || //==|| ||/==\\ | ! || || || || || || || || || || | ! || // || || || || || || || | ! ||===// \\==// \\==\\ \\==\\ || | ! | !------------------------------------------------------------------------------| !------------------------------------------------------------------------------| ! | ! ADJUST MATERIALN MARCH 2013 | ! | !------------------------------------------------------------------------------| !------------------------------------------------------------------------------| subroutine adjust_materialn (params,threadinfo) use definitions use threads !------------------------------------------------------------------------------| !(((((((((((((((( Purpose of the routine )))))))))))))))))))))))))))))))))))))) !------------------------------------------------------------------------------| ! This routine adjusts the params%materialn array to reflect the reduced number ! of surfaces/LSFs !------------------------------------------------------------------------------| !(((((((((((((((( declaration of the subroutine arguments )))))))))))))))))))) !------------------------------------------------------------------------------| implicit none include 'mpif.h' type (parameters) params type (thread) threadinfo !------------------------------------------------------------------------------| !(((((((((((((((( declaration of the subroutine internal variables ))))))))))))) !------------------------------------------------------------------------------| integer,dimension(:),allocatable :: matntemp integer :: iproc,nproc,ierr,i,matncount,matnorig !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- call mpi_comm_size (mpi_comm_world,nproc,ierr) call mpi_comm_rank (mpi_comm_world,iproc,ierr) ! We know that the number of surfaces/LSFs has changed, so we create a new ! params%materialn array for the reduced number of surfaces/LSFs ! First we store the original number of surface-associated materials matnorig=params%nsorig ! Now we allocate a temporary array to store the old materialn, fill it and ! deallocate params%materialn allocate(matntemp(0:matnorig),stat=threadinfo%err) if (params%debug.gt.1) call heap (threadinfo,'matntemp','adjust_materialn',size(matntemp),'dp',+1) matntemp=params%materialn if (params%debug.gt.1) call heap (threadinfo,'params%materialn','adjust_materialn',size(params%materialn),'dp',-1) deallocate (params%materialn) ! Now we reallocate the smaller params%materialn, fill it and deallocate matntemp allocate (params%materialn(0:params%ns),stat=threadinfo%err) if (params%debug.gt.1) call heap (threadinfo,'params%materialn', 'adjust_materialn',size(params%materialn),'dp',+1) matncount=0 params%materialn(0)=matntemp(0) do i=1,matnorig if (params%surfremindex(i) > 0) then matncount=matncount+1 params%materialn(matncount)=matntemp(i) endif enddo if (params%debug.gt.1) call heap (threadinfo,'matntemp','adjust_materialn',size(matntemp),'dp',-1) deallocate (matntemp) end subroutine adjust_materialn !------------------------------------------------------------------------------- !-------------------------------------------------------------------------------