Homec4science
Diffusion FENNECS: Finite Element Non-Neutral Electron Cloud Simulator (geom_testpardiso) Browse

fennecs/src/chkrst.f90
fce363d838e5geom_testpardiso

Last Change
Raw File

chkrst.f90
View Options

SUBROUTINE chkrst(flag)
!
! Process checkpoint/restart file
!
USE basic
USE futils
USE beam
USE fields
IMPLICIT NONE
INTEGER, INTENT(in) :: flag
INTEGER, DIMENSION(:), ALLOCATABLE:: displs
INTEGER :: i
! Only process 0 should save on file
!
! Local vars and arrays
!________________________________________________________________________________
!
SELECT CASE(flag)
!________________________________________________________________________________
! 1. Open and read restart file
!
CASE(0)
IF(mpirank .ne. 0) RETURN
CALL openf(rstfile, fidrst)
CALL getatt(fidrst, '/Basic', 'cstep', cstep)
CALL getatt(fidrst, '/Basic', 'time', time)
CALL getatt(fidrst, '/Basic', 'msim', msim)
CALL getatt(fidrst, '/Basic', 'qsim', qsim)
CALL getatt(fidrst, '/var0d', 'etot0', etot0)
CALL getatt(fidrst, '/var0d', 'epot', epot)
CALL getatt(fidrst, '/var0d', 'ekin', ekin)
CALL getatt(fidrst, '/var0d', 'etot', etot)
! Init Electric and Magnetic Fields
CALL fields_init
CALL getatt(fidrst, '/Parts', 'nplasma', nplasma)
CALL creat_parts(parts,nplasma)
CALL getarr(fidrst, '/Parts/Z', parts%Z)
CALL getarr(fidrst, '/Parts/R', parts%R)
CALL getarr(fidrst, '/Parts/UZ', parts%UZ)
CALL getarr(fidrst, '/Parts/UR', parts%UR)
CALL getarr(fidrst, '/Parts/UTHET', parts%UTHET)
CALL getarr(fidrst, '/Parts/Zindex', parts%Zindex)
CALL getarr(fidrst, '/Parts/Rindex', parts%Rindex)
CALL closef(fidrst)
WRITE(*,'(3x,a)') &
& "Reading from restart file "//TRIM(rstfile)//" completed!"
!________________________________________________________________________________
! 2. Create and write to restart file (DP reals)
!
CASE(1)
ALLOCATE(displs(0:mpisize-1))
displs(0)=1
DO i=1, mpisize-1
displs(i)=displs(i-1)+Nplocs_all(i-1)-1
END DO
IF(mpisize .gt. 1) THEN
IF(mpirank .ne. 0) THEN
! Send Particles informations to root process
CALL MPI_Gatherv(parts%Zindex, Nplocs_all(mpirank), MPI_INTEGER, parts%Zindex, Nplocs_all, displs, &
& MPI_INTEGER,0, MPI_COMM_WORLD, ierr)
CALL MPI_Gatherv(parts%Rindex, Nplocs_all(mpirank), MPI_INTEGER, parts%Rindex, Nplocs_all, displs, &
& MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
RETURN
ELSE
! Receive particle information from all processes
CALL MPI_Gatherv(MPI_IN_PLACE, Nplocs_all(mpirank), MPI_INTEGER, parts%Zindex, Nplocs_all, displs, &
& MPI_INTEGER,0, MPI_COMM_WORLD, ierr)
CALL MPI_Gatherv(MPI_IN_PLACE, Nplocs_all(mpirank), MPI_INTEGER, parts%Rindex, Nplocs_all, displs, &
& MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
END IF
END IF
IF( .NOT. nlsave ) RETURN
CALL mv2bk(rstfile)
CALL creatf(rstfile, fidrst, real_prec='d', desc='Restart file')
CALL creatg(fidrst, '/Basic', 'Basic data')
CALL attach(fidrst, '/Basic', 'cstep', cstep)
CALL attach(fidrst, '/Basic', 'time', time)
CALL attach(fidrst, '/Basic', 'jobnum', jobnum)
CALL attach(fidrst, '/Basic', 'qsim', qsim)
CALL attach(fidrst, '/Basic', 'msim', msim)
!
! 0D variables
!
CALL creatg(fidrst, '/var0d', '0D variables')
CALL attach(fidrst, '/var0d','etot0', etot0)
CALL attach(fidrst, '/var0d','epot', epot)
CALL attach(fidrst, '/var0d','ekin', ekin)
CALL attach(fidrst, '/var0d','etot', etot)
!
! Parts
!
CALL creatg(fidrst, '/Parts', 'Particles data')
CALL attach(fidrst, '/Parts', 'nplasma', parts%Nptot)
CALL putarr(fidrst, '/Parts/Z', parts%Z)
CALL putarr(fidrst, '/Parts/R', parts%R)
CALL putarr(fidrst, '/Parts/UZ', parts%UZ)
CALL putarr(fidrst, '/Parts/UR', parts%UR)
CALL putarr(fidrst, '/Parts/UTHET', parts%UTHET)
CALL putarr(fidrst, '/Parts/Zindex', parts%Zindex)
CALL putarr(fidrst, '/Parts/Rindex', parts%Rindex)
!
! Fields
!
CALL closef(fidrst)
WRITE(*,'(3x,a)') &
& "Writing to restart file "//TRIM(rstfile)//" completed!"
!
END SELECT
!
END SUBROUTINE chkrst
c4science · Help