general polishing and removal of redundant do-loop
This commit is contained in:
parent
64db098e2a
commit
6076506738
|
@ -231,8 +231,6 @@ program DAMASK_spectral
|
|||
endif
|
||||
do j = 1_pInt, 9_pInt
|
||||
temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a *
|
||||
enddo
|
||||
do j = 1_pInt,9_pInt
|
||||
if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable
|
||||
enddo
|
||||
loadCases(currentLoadCase)%deformation%maskLogical = & ! logical mask in 3x3 notation
|
||||
|
@ -244,8 +242,6 @@ program DAMASK_spectral
|
|||
temp_valueVector = 0.0_pReal
|
||||
do j = 1_pInt, 9_pInt
|
||||
temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk
|
||||
enddo
|
||||
do j = 1_pInt,9_pInt
|
||||
if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable
|
||||
enddo
|
||||
loadCases(currentLoadCase)%P%maskLogical = transpose(reshape(temp_maskVector,[ 3,3]))
|
||||
|
@ -378,7 +374,7 @@ program DAMASK_spectral
|
|||
call Polarisation_init
|
||||
|
||||
case default
|
||||
call IO_error(error_ID = 891, ext_msg = trim(spectral_solver))
|
||||
call IO_error(error_ID = 891_pInt, ext_msg = trim(spectral_solver))
|
||||
|
||||
end select
|
||||
|
||||
|
@ -428,29 +424,30 @@ program DAMASK_spectral
|
|||
allocate(outputSize(worldsize), source = 0_MPI_OFFSET_KIND)
|
||||
outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND)
|
||||
call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
|
||||
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_allreduce')
|
||||
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce')
|
||||
call MPI_file_open(PETSC_COMM_WORLD, &
|
||||
trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.spectralOut', &
|
||||
MPI_MODE_WRONLY + MPI_MODE_APPEND, &
|
||||
MPI_INFO_NULL, &
|
||||
resUnit, &
|
||||
ierr)
|
||||
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_open')
|
||||
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_open')
|
||||
call MPI_file_get_position(resUnit,fileOffset,ierr) ! get offset from header
|
||||
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_get_position')
|
||||
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_get_position')
|
||||
fileOffset = fileOffset + sum(outputSize(1:worldrank)) ! offset of my process in file (header + processes before me)
|
||||
call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr)
|
||||
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek')
|
||||
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek')
|
||||
|
||||
if (.not. appendToOutFile) then ! if not restarting, write 0th increment
|
||||
do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output
|
||||
outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, &
|
||||
min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
|
||||
call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),&
|
||||
call MPI_file_write(resUnit, &
|
||||
reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), &
|
||||
[(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults]), &
|
||||
(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults, &
|
||||
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
|
||||
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write')
|
||||
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write')
|
||||
enddo
|
||||
fileOffset = fileOffset + sum(outputSize) ! forward to current file position
|
||||
if (worldrank == 0) &
|
||||
|
|
Loading…
Reference in New Issue