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

fennecs/src/chkrst.f90
742d03fe9302geom_testpardiso

Last Change
Raw File

chkrst.f90
View Options

SUBROUTINE chkrst(flag)
!
! Process checkpoint/restart file
!
USE basic
USE futils
USE beam
USE fields
USE constants, ONLY: elchar, me
IMPLICIT NONE
INTEGER, INTENT(in) :: flag
INTEGER :: remainingparts
REAL(kind=db):: old_msim, old_qsim, old_n0
INTEGER:: partsrank, partsdim(1), i
REAL(kind=db), ALLOCATABLE:: charges(:), weights(:), masses(:)
CHARACTER(len=64):: group
CHARACTER(len=2):: specieindex
! Only process 0 should save on file
!
! Local vars and arrays
!________________________________________________________________________________
!
SELECT CASE(flag)
!________________________________________________________________________________
! 1. Open and read restart file
!
CASE(0)
CALL openf(rstfile, fidrst,'r',real_prec='d')
CALL getatt(fidrst, '/Basic', 'cstep', cstep)
CALL getatt(fidrst, '/Basic', 'time', time)
CALL getatt(fidrst, '/Basic', 'n0', old_n0)
IF(isdataset(fidrst,'/Parts/charges')) THEN
! If we have multiple saved species we need to load all of them
CALL getatt(fidrst,'/Parts','nbspecies',nbspecies)
ALLOCATE(charges(nbspecies),masses(nbspecies),weights(nbspecies))
ALLOCATE(partslist(nbspecies))
CALL getarr(fidrst, '/Parts/charges', charges)
CALL getarr(fidrst, '/Parts/masses', masses)
CALL getarr(fidrst, '/Parts/weights', weights)
weights(1)=weights(1)/old_n0*n0
ELSE
! If we have an old restart file, we load only the electrons
CALL getatt(fidrst, '/Basic', 'msim', old_msim)
CALL getatt(fidrst, '/Basic', 'qsim', old_qsim)
qsim=old_qsim/old_n0*n0
msim=old_msim/old_n0*n0
nbspecies=1
ALLOCATE(charges(nbspecies),masses(nbspecies),weights(nbspecies))
ALLOCATE(partslist(nbspecies))
charges(1)=sign(elchar,qsim)
weights(1)=msim/me
masses(1)=me
END IF
CALL getatt(fidrst, '/var0d', 'etot0', loc_etot0)
loc_etot0=loc_etot0/old_n0*n0
IF(mpirank .ne. 0) loc_etot0=0
etot0=loc_etot0
CALL getatt(fidrst, '/var0d', 'epot', epot)
CALL getatt(fidrst, '/var0d', 'ekin', ekin)
CALL getatt(fidrst, '/var0d', 'etot', etot)
CALL getatt(fidrst, '/Parts', 'nplasma', nplasma)
CALL getatt(fidrst, '/Parts', 'remainingparts', remainingparts)
IF (samplefactor .gt. 1 ) THEN ! We increase the number of macro particles
CALL creat_parts(partslist(1),remainingparts*samplefactor)
ELSE
CALL getdims(fidrst, '/Parts/Z', partsrank, partsdim)
CALL creat_parts(partslist(1),partsdim(1))
END IF
partslist(1)%q=charges(1)
partslist(1)%m=masses(1)
partslist(1)%weight=weights(1)
partslist(1)%qmRatio=charges(1)/masses(1)
CALL getarr(fidrst, '/Parts/Z', partslist(1)%Z)
CALL getarr(fidrst, '/Parts/R', partslist(1)%R)
! Renormalize R and Z
partslist(1)%R=partslist(1)%R*sqrt(n0/old_n0)
partslist(1)%Z=partslist(1)%Z*sqrt(n0/old_n0)
CALL getarr(fidrst, '/Parts/THET', partslist(1)%THET)
CALL getarr(fidrst, '/Parts/UZ', partslist(1)%UZ)
CALL getarr(fidrst, '/Parts/UR', partslist(1)%UR)
CALL getarr(fidrst, '/Parts/UTHET', partslist(1)%UTHET)
CALL getarr(fidrst, '/Parts/Zindex', partslist(1)%Zindex)
CALL getarr(fidrst, '/Parts/Rindex', partslist(1)%Rindex)
CALL getarr(fidrst, '/Parts/partindex', partslist(1)%partindex)
CALL getatt(fidrst, '/Parts', 'remainingparts', partslist(1)%Nploc)
partslist(1)%Nptot=partslist(1)%Nploc
WRITE(*,*) "Read ", partslist(1)%Nploc, " particles out of ", nplasma
IF(isdataset(fidrst,'/Parts/fluidur')) THEN
CALL getarr(fidrst, '/Parts/GAMMA', partslist(1)%Gamma)
IF(temprescale .gt. 0) THEN
CALL Temp_rescale
END IF
END IF
IF(nbspecies .gt. 1) THEN
DO i=2,nbspecies
WRITE(group,'(a,i2)')'/Parts/',i
WRITE(specieindex,'(i2)') i
partsdim=0
CALL getatt(fidrst, trim(group), 'remainingparts', remainingparts)
CALL getdims(fidrst, trim(group) // '/Z', partsrank, partsdim)
IF(partsdim(1).gt.remainingparts) THEN
CALL creat_parts(partslist(i),partsdim(1))
partslist(i)%Nploc=remainingparts
ELSE
CALL creat_parts(partslist(i),remainingparts)
ENDIF
partslist(i)%q=charges(i)
partslist(i)%m=masses(i)
partslist(i)%weight=weights(i)
partslist(i)%qmRatio=charges(i)/masses(i)
partslist(i)%Nptot=remainingparts
CALL getatt(fidrst, trim(group), 'is_test', partslist(i)%is_test)
IF(partslist(i)%Nptot .gt. 0) THEN
CALL getarr(fidrst, trim(group) // '/Z', partslist(i)%Z)
CALL getarr(fidrst, trim(group) // '/R', partslist(i)%R)
CALL getarr(fidrst, trim(group) // '/THET', partslist(i)%THET)
CALL getarr(fidrst, trim(group) // '/UZ', partslist(i)%UZ)
CALL getarr(fidrst, trim(group) // '/UR', partslist(i)%UR)
CALL getarr(fidrst, trim(group) // '/UTHET', partslist(i)%UTHET)
CALL getarr(fidrst, trim(group) // '/GAMMA', partslist(i)%Gamma)
CALL getarr(fidrst, trim(group) // '/Zindex', partslist(i)%Zindex)
CALL getarr(fidrst, trim(group) // '/Rindex', partslist(i)%Rindex)
CALL getarr(fidrst, trim(group) // '/partindex', partslist(i)%partindex)
partslist(i)%R=partslist(i)%R*sqrt(n0/old_n0)
partslist(i)%Z=partslist(i)%Z*sqrt(n0/old_n0)
END IF
END DO
END IF
CALL closef(fidrst)
IF(samplefactor .gt. 1) THEN ! We increase the number of macro particles
CALL upsample(partslist(1), samplefactor)
END IF
WRITE(*,'(3x,a)') "Reading from restart file "//TRIM(rstfile)//" completed!"
!________________________________________________________________________________
! 2. Create and write to restart file (DP reals)
!
CASE(1)
IF(mpisize .gt. 1) THEN
DO i=1,nbspecies
call bound(partslist(i))
call collectparts(partslist(i))
END DO
ELSE
DO i=1,nbspecies
call bound(partslist(i))
partslist(i)%Nptot=partslist(i)%Nploc
END DO
END IF
IF(mpirank .ne. 0) RETURN
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', partslist(1)%q*partslist(1)%weight)
CALL attach(fidrst, '/Basic', 'msim', partslist(1)%m*partslist(1)%weight)
CALL attach(fidrst, '/Basic', 'n0', n0)
!
! 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', nplasma)
nbspecies=size(partslist,1)
CALL attach(fidrst, '/Parts', 'nbspecies', nbspecies)
ALLOCATE(charges(nbspecies),masses(nbspecies),weights(nbspecies))
DO i=1,nbspecies
charges(i) = partslist(i)%q
masses(i) = partslist(i)%m
weights(i) = partslist(i)%weight
END DO
CALL putarr(fidrst, '/Parts/charges', charges)
CALL putarr(fidrst, '/Parts/masses', masses )
CALL putarr(fidrst, '/Parts/weights', weights)
IF(mpisize .gt. 1) THEN
remainingparts=sum(Nplocs_all)
ELSE
remainingparts=partslist(1)%Nploc
END IF
CALL attach(fidrst, '/Parts', 'remainingparts', remainingparts)
CALL putarr(fidrst, '/Parts/Z', partslist(1)%Z)
CALL putarr(fidrst, '/Parts/R', partslist(1)%R)
CALL putarr(fidrst, '/Parts/THET', partslist(1)%THET)
CALL putarr(fidrst, '/Parts/UZ', partslist(1)%UZ)
CALL putarr(fidrst, '/Parts/UR', partslist(1)%UR)
CALL putarr(fidrst, '/Parts/UTHET', partslist(1)%UTHET)
CALL putarr(fidrst, '/Parts/GAMMA', partslist(1)%Gamma)
CALL putarr(fidrst, '/Parts/Zindex', partslist(1)%Zindex)
CALL putarr(fidrst, '/Parts/Rindex', partslist(1)%Rindex)
CALL putarr(fidrst, '/Parts/partindex', partslist(1)%partindex)
CALL putarr(fidrst, '/Parts/fluidur', moments(2,:))
CALL putarr(fidrst, '/Parts/fluiduthet', moments(3,:))
CALL putarr(fidrst, '/Parts/fluiduz', moments(4,:))
IF(nbspecies .gt. 1) THEN
DO i=2,nbspecies
WRITE(group,'(a,i2)')'/Parts/',i
WRITE(specieindex,'(i2)') i
CALL creatg(fidrst, trim(group), 'Particles ' // specieindex// ' data')
CALL attach(fidrst, trim(group), 'remainingparts', partslist(i)%Nptot)
CALL attach(fidrst, trim(group), 'is_test', partslist(i)%is_test)
IF(partslist(i)%Nptot .gt. 0) THEN
CALL putarr(fidrst, trim(group) // '/Z', partslist(i)%Z(1:partslist(i)%Nptot))
CALL putarr(fidrst, trim(group) // '/R', partslist(i)%R(1:partslist(i)%Nptot))
CALL putarr(fidrst, trim(group) // '/THET', partslist(i)%THET(1:partslist(i)%Nptot))
CALL putarr(fidrst, trim(group) // '/UZ', partslist(i)%UZ(1:partslist(i)%Nptot))
CALL putarr(fidrst, trim(group) // '/UR', partslist(i)%UR(1:partslist(i)%Nptot))
CALL putarr(fidrst, trim(group) // '/UTHET', partslist(i)%UTHET(1:partslist(i)%Nptot))
CALL putarr(fidrst, trim(group) // '/GAMMA', partslist(i)%Gamma(1:partslist(i)%Nptot))
CALL putarr(fidrst, trim(group) // '/Zindex', partslist(i)%Zindex(1:partslist(i)%Nptot))
CALL putarr(fidrst, trim(group) // '/Rindex', partslist(i)%Rindex(1:partslist(i)%Nptot))
CALL putarr(fidrst, trim(group) // '/partindex', partslist(i)%partindex(1:partslist(i)%Nptot))
END IF
END DO
END IF
!
! Fields
!
CALL closef(fidrst)
WRITE(*,'(3x,a)') "Writing to restart file "//TRIM(rstfile)//" completed!"
!
END SELECT
!
END SUBROUTINE chkrst
c4science · Help