223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

removed postResults completely

This commit is contained in:
Martin Diehl 2019-12-11 00:10:02 +01:00
parent e3b316bcae
commit 9b67ead62f
9 changed files with 8 additions and 322 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/CPFEM2.f90
View File

@ -65,7 +65,6 @@ subroutine CPFEM_initAll
call constitutive_init call constitutive_init
call crystallite_init call crystallite_init
call homogenization_init call homogenization_init
call materialpoint_postResults
call CPFEM_init call CPFEM_init
end subroutine CPFEM_initAll end subroutine CPFEM_initAll

5
src/DAMASK_abaqus.f
View File

@ -143,9 +143,6 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
outdatedByNewInc, & outdatedByNewInc, &
outdatedFFN1, & outdatedFFN1, &
lastStep lastStep
use homogenization, only: &
materialpoint_sizeResults, &
materialpoint_results
implicit none implicit none
integer(pInt), intent(in) :: & integer(pInt), intent(in) :: &
@ -332,7 +329,7 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
ddsdde(6,:) = ddsdde_h(5,:) ddsdde(6,:) = ddsdde_h(5,:)
end if end if
statev = materialpoint_results(1:min(nstatv,materialpoint_sizeResults),npt,mesh_FEasCP('elem', noel)) statev = 0
if (terminallyIll) pnewdt = 0.5_pReal ! force cutback directly ? if (terminallyIll) pnewdt = 0.5_pReal ! force cutback directly ?
!$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value !$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value

11
src/constitutive.f90
View File

@ -93,16 +93,6 @@ subroutine constitutive_init
write(6,'(/,a)') ' <<<+- constitutive init -+>>>'; flush(6) write(6,'(/,a)') ' <<<+- constitutive init -+>>>'; flush(6)
mainProcess: if (worldrank == 0) then
!--------------------------------------------------------------------------------------------------
! write description file for constitutive output
call IO_write_jobFile(204,'outputConstitutive')
PhaseLoop: do ph = 1,material_Nphase
if (any(material_phaseAt == ph)) write(204,'(/,a,/)') '['//trim(config_name_phase(ph))//']'
enddo PhaseLoop
close(204)
endif mainProcess
constitutive_plasticity_maxSizeDotState = 0 constitutive_plasticity_maxSizeDotState = 0
constitutive_source_maxSizeDotState = 0 constitutive_source_maxSizeDotState = 0
@ -123,7 +113,6 @@ subroutine constitutive_init
maxval(sourceState(ph)%p(:)%sizeDotState)) maxval(sourceState(ph)%p(:)%sizeDotState))
enddo PhaseLoop2 enddo PhaseLoop2
end subroutine constitutive_init end subroutine constitutive_init

8
src/crystallite.f90
View File

@ -118,7 +118,6 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine crystallite_init subroutine crystallite_init
integer, parameter :: FILEUNIT=434
logical, dimension(:,:), allocatable :: devNull logical, dimension(:,:), allocatable :: devNull
integer :: & integer :: &
c, & !< counter in integration point component loop c, & !< counter in integration point component loop
@ -232,13 +231,6 @@ subroutine crystallite_init
#endif #endif
enddo enddo
!--------------------------------------------------------------------------------------------------
! write description file for crystallite output
if (worldrank == 0) then
call IO_write_jobFile(FILEUNIT,'outputCrystallite')
write(FILEUNIT,'(/,a,/)') '[not supported anymore]'
close(FILEUNIT)
endif
call config_deallocate('material.config/phase') call config_deallocate('material.config/phase')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

78
src/grid/DAMASK_grid.f90
View File

@ -15,11 +15,7 @@ program DAMASK_spectral
use config use config
use debug use debug
use math use math
use mesh_grid
use CPFEM2 use CPFEM2
use FEsolving
use numerics
use homogenization
use material use material
use spectral_utilities use spectral_utilities
use grid_mech_spectral_basic use grid_mech_spectral_basic
@ -80,12 +76,6 @@ program DAMASK_spectral
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
type(tLoadCase) :: newLoadCase type(tLoadCase) :: newLoadCase
type(tSolutionState), allocatable, dimension(:) :: solres type(tSolutionState), allocatable, dimension(:) :: solres
integer(MPI_OFFSET_KIND) :: fileOffset
integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize
integer, parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742
integer, parameter :: maxRealOut = maxByteOut/pReal
integer(pLongInt), dimension(2) :: outputIndex
PetscErrorCode :: ierr
procedure(grid_mech_spectral_basic_init), pointer :: & procedure(grid_mech_spectral_basic_init), pointer :: &
mech_init mech_init
procedure(grid_mech_spectral_basic_forward), pointer :: & procedure(grid_mech_spectral_basic_forward), pointer :: &
@ -280,10 +270,8 @@ program DAMASK_spectral
enddo enddo
if (any(newLoadCase%stress%maskLogical .eqv. & if (any(newLoadCase%stress%maskLogical .eqv. &
newLoadCase%deformation%maskLogical)) errorID = 831 ! exclusive or masking only newLoadCase%deformation%maskLogical)) errorID = 831 ! exclusive or masking only
if (any(newLoadCase%stress%maskLogical .and. & if (any(newLoadCase%stress%maskLogical .and. transpose(newLoadCase%stress%maskLogical) &
transpose(newLoadCase%stress%maskLogical) .and. & .and. (math_I3<1))) errorID = 838 ! no rotation is allowed by stress BC
reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) &
errorID = 838 ! no rotation is allowed by stress BC
write(6,'(2x,a)') 'stress / GPa:' write(6,'(2x,a)') 'stress / GPa:'
do i = 1, 3; do j = 1, 3 do i = 1, 3; do j = 1, 3
if(newLoadCase%stress%maskLogical(i,j)) then if(newLoadCase%stress%maskLogical(i,j)) then
@ -335,26 +323,10 @@ program DAMASK_spectral
! write header of output file ! write header of output file
if (worldrank == 0) then if (worldrank == 0) then
writeHeader: if (interface_restartInc < 1) then writeHeader: if (interface_restartInc < 1) then
open(newunit=fileUnit,file=trim(getSolverJobName())//&
'.spectralOut',form='UNFORMATTED',status='REPLACE')
write(fileUnit) 'load:', trim(loadCaseFile) ! ... and write header
write(fileUnit) 'workingdir:', 'n/a'
write(fileUnit) 'geometry:', trim(geometryFile)
write(fileUnit) 'grid:', grid
write(fileUnit) 'size:', geomSize
write(fileUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults
write(fileUnit) 'loadcases:', size(loadCases)
write(fileUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase
write(fileUnit) 'times:', loadCases%time ! one entry per LoadCase
write(fileUnit) 'logscales:', loadCases%logscale
write(fileUnit) 'increments:', loadCases%incs ! one entry per LoadCase
write(fileUnit) 'startingIncrement:', interface_restartInc ! start with writing out the previous inc
write(fileUnit) 'eoh'
close(fileUnit) ! end of header
open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE') open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) &
write(6,'(/,a)') ' header of result and statistics file written out' write(6,'(/,a)') ' header of statistics file written out'
flush(6) flush(6)
else writeHeader else writeHeader
open(newunit=statUnit,file=trim(getSolverJobName())//& open(newunit=statUnit,file=trim(getSolverJobName())//&
@ -362,40 +334,11 @@ program DAMASK_spectral
endif writeHeader endif writeHeader
endif endif
!--------------------------------------------------------------------------------------------------
! prepare MPI parallel out (including opening of file)
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) call IO_error(error_ID=894, ext_msg='MPI_allreduce')
call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', &
MPI_MODE_WRONLY + MPI_MODE_APPEND, &
MPI_INFO_NULL, &
fileUnit, &
ierr)
if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_open')
call MPI_file_get_position(fileUnit,fileOffset,ierr) ! get offset from header
if (ierr /= 0) call IO_error(error_ID=894, 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 (fileUnit,fileOffset,MPI_SEEK_SET,ierr)
if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_seek')
writeUndeformed: if (interface_restartInc < 1) then writeUndeformed: if (interface_restartInc < 1) then
write(6,'(1/,a)') ' ... writing initial configuration to file ........................' write(6,'(1/,a)') ' ... writing initial configuration to file ........................'
call CPFEM_results(0,0.0_pReal) call CPFEM_results(0,0.0_pReal)
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)*((maxRealOut)/materialpoint_sizeResults)+1, &
min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), &
[(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), &
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_write')
enddo
fileOffset = fileOffset + sum(outputSize) ! forward to current file position
endif writeUndeformed endif writeUndeformed
loadCaseLooping: do currentLoadCase = 1, size(loadCases) loadCaseLooping: do currentLoadCase = 1, size(loadCases)
time0 = time ! load case start time time0 = time ! load case start time
guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc
@ -526,7 +469,6 @@ program DAMASK_spectral
write(6,'(/,a)') ' cutting back ' write(6,'(/,a)') ' cutting back '
else ! no more options to continue else ! no more options to continue
call IO_warning(850) call IO_warning(850)
call MPI_File_close(fileUnit,ierr)
close(statUnit) close(statUnit)
call quit(0) ! quit call quit(0) ! quit
endif endif
@ -546,19 +488,6 @@ program DAMASK_spectral
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency
write(6,'(1/,a)') ' ... writing results to file ......................................' write(6,'(1/,a)') ' ... writing results to file ......................................'
flush(6) flush(6)
call materialpoint_postResults()
call MPI_File_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr)
if (ierr /= 0) call IO_error(894, ext_msg='MPI_file_seek')
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)*((maxRealOut)/materialpoint_sizeResults)+1, &
min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),&
[(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),&
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
if(ierr /=0) call IO_error(894, ext_msg='MPI_file_write')
enddo
fileOffset = fileOffset + sum(outputSize) ! forward to current file position
call CPFEM_results(totalIncsCounter,time) call CPFEM_results(totalIncsCounter,time)
endif endif
if (mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then if (mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then
@ -575,7 +504,6 @@ program DAMASK_spectral
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report summary of whole calculation ! report summary of whole calculation
write(6,'(/,a)') ' ###########################################################################' write(6,'(/,a)') ' ###########################################################################'
call MPI_file_close(fileUnit,ierr)
close(statUnit) close(statUnit)
call quit(0) ! no complains ;) call quit(0) ! no complains ;)

150
src/homogenization.f90
View File

@ -35,11 +35,6 @@ module homogenization
materialpoint_P !< first P--K stress of IP materialpoint_P !< first P--K stress of IP
real(pReal), dimension(:,:,:,:,:,:), allocatable, public :: & real(pReal), dimension(:,:,:,:,:,:), allocatable, public :: &
materialpoint_dPdF !< tangent of first P--K stress at IP materialpoint_dPdF !< tangent of first P--K stress at IP
real(pReal), dimension(:,:,:), allocatable, public :: &
materialpoint_results !< results array of material point
integer, public, protected :: &
materialpoint_sizeResults, &
thermal_maxSizePostResults
real(pReal), dimension(:,:,:,:), allocatable :: & real(pReal), dimension(:,:,:,:), allocatable :: &
materialpoint_subF0, & !< def grad of IP at beginning of homogenization increment materialpoint_subF0, & !< def grad of IP at beginning of homogenization increment
@ -124,7 +119,6 @@ module homogenization
public :: & public :: &
homogenization_init, & homogenization_init, &
materialpoint_stressAndItsTangent, & materialpoint_stressAndItsTangent, &
materialpoint_postResults, &
homogenization_results homogenization_results
contains contains
@ -135,14 +129,6 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine homogenization_init subroutine homogenization_init
integer, parameter :: FILEUNIT = 200
integer :: e,i,p
integer, dimension(:,:), pointer :: thisSize
integer, dimension(:) , pointer :: thisNoutput
character(len=64), dimension(:,:), pointer :: thisOutput
character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready
logical :: valid
if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init
if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init
if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init
@ -155,51 +141,6 @@ subroutine homogenization_init
if (any(damage_type == DAMAGE_local_ID)) call damage_local_init if (any(damage_type == DAMAGE_local_ID)) call damage_local_init
if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init
!--------------------------------------------------------------------------------------------------
! write description file for homogenization output
mainProcess: if (worldrank == 0) then
call IO_write_jobFile(FILEUNIT,'outputHomogenization')
do p = 1,size(config_homogenization)
if (any(material_homogenizationAt == p)) then
write(FILEUNIT,'(/,a,/)') '['//trim(config_name_homogenization(p))//']'
write(FILEUNIT,'(a)') '(type) n/a'
write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p)
i = thermal_typeInstance(p) ! which instance of this thermal type
valid = .true. ! assume valid
select case(thermal_type(p)) ! split per thermal type
case (THERMAL_isothermal_ID)
outputName = THERMAL_isothermal_label
thisNoutput => null()
thisOutput => null()
thisSize => null()
case (THERMAL_adiabatic_ID)
outputName = THERMAL_adiabatic_label
thisNoutput => thermal_adiabatic_Noutput
thisOutput => thermal_adiabatic_output
thisSize => thermal_adiabatic_sizePostResult
case (THERMAL_conduction_ID)
outputName = THERMAL_conduction_label
thisNoutput => thermal_conduction_Noutput
thisOutput => thermal_conduction_output
thisSize => thermal_conduction_sizePostResult
case default
valid = .false.
end select
if (valid) then
write(FILEUNIT,'(a)') '(thermal)'//char(9)//trim(outputName)
if (thermal_type(p) /= THERMAL_isothermal_ID) then
do e = 1,thisNoutput(i)
write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
enddo
endif
endif
endif
enddo
close(FILEUNIT)
endif mainProcess
call config_deallocate('material.config/homogenization') call config_deallocate('material.config/homogenization')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -219,19 +160,7 @@ subroutine homogenization_init
allocate(materialpoint_converged(discretization_nIP,discretization_nElem), source=.true.) allocate(materialpoint_converged(discretization_nIP,discretization_nElem), source=.true.)
allocate(materialpoint_doneAndHappy(2,discretization_nIP,discretization_nElem), source=.true.) allocate(materialpoint_doneAndHappy(2,discretization_nIP,discretization_nElem), source=.true.)
!-------------------------------------------------------------------------------------------------- write(6,'(/,a)') ' <<<+- homogenization init -+>>>'; flush(6)
! allocate and initialize global state and postresutls variables
thermal_maxSizePostResults = 0
do p = 1,size(config_homogenization)
thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState(p)%sizePostResults)
enddo
materialpoint_sizeResults = 1 & ! grain count
+ 1 + thermal_maxSizePostResults &
+ homogenization_maxNgrains * 2 ! obsolete header information
allocate(materialpoint_results(materialpoint_sizeResults,discretization_nIP,discretization_nElem))
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then
write(6,'(a32,1x,7(i8,1x))') 'materialpoint_dPdF: ', shape(materialpoint_dPdF) write(6,'(a32,1x,7(i8,1x))') 'materialpoint_dPdF: ', shape(materialpoint_dPdF)
@ -547,48 +476,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
end subroutine materialpoint_stressAndItsTangent end subroutine materialpoint_stressAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief calculation of result array at material points
!--------------------------------------------------------------------------------------------------
subroutine materialpoint_postResults
integer :: &
thePos, &
theSize, &
myNgrains, &
g, & !< grain number
i, & !< integration point number
e !< element number
elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNgrains = homogenization_Ngrains(material_homogenizationAt(e))
IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
thePos = 0
theSize = thermalState (material_homogenizationAt(e))%sizePostResults &
+ damageState (material_homogenizationAt(e))%sizePostResults
materialpoint_results(thePos+1,i,e) = real(theSize,pReal) ! tell size of homogenization results
thePos = thePos + 1
if (theSize > 0) then ! any homogenization results to mention?
materialpoint_results(thePos+1:thePos+theSize,i,e) = postResults(i,e)
thePos = thePos + theSize
endif
materialpoint_results(thePos+1,i,e) = real(myNgrains,pReal) ! tell number of grains at materialpoint
thePos = thePos + 1
grainLooping :do g = 1,myNgrains
theSize = 2
materialpoint_results(thePos+1:thePos+theSize,i,e) = 0.0_pReal
thePos = thePos + theSize
enddo grainLooping
enddo IpLooping
enddo elementLooping
end subroutine materialpoint_postResults
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief partition material point def grad onto constituents !> @brief partition material point def grad onto constituents
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -700,41 +587,6 @@ subroutine averageStressAndItsTangent(ip,el)
end subroutine averageStressAndItsTangent end subroutine averageStressAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of homogenization results for post file inclusion. call only,
!> if homogenization_sizePostResults(i,e) > 0 !!
!--------------------------------------------------------------------------------------------------
function postResults(ip,el)
integer, intent(in) :: &
ip, & !< integration point
el !< element number
real(pReal), dimension( thermalState (material_homogenizationAt(el))%sizePostResults) :: &
postResults
integer :: &
startPos, endPos ,&
homog
postResults = 0.0_pReal
startPos = 1
endPos = thermalState(material_homogenizationAt(el))%sizePostResults
chosenThermal: select case (thermal_type(material_homogenizationAt(el)))
case (THERMAL_adiabatic_ID) chosenThermal
homog = material_homogenizationAt(el)
postResults(startPos:endPos) = &
thermal_adiabatic_postResults(homog,thermal_typeInstance(homog),thermalMapping(homog)%p(ip,el))
case (THERMAL_conduction_ID) chosenThermal
homog = material_homogenizationAt(el)
postResults(startPos:endPos) = &
thermal_conduction_postResults(homog,thermal_typeInstance(homog),thermalMapping(homog)%p(ip,el))
end select chosenThermal
end function postResults
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief writes homogenization results to HDF5 output file !> @brief writes homogenization results to HDF5 output file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

3
src/prec.f90
View File

@ -42,8 +42,7 @@ module prec
sizeState = 0, & !< size of state sizeState = 0, & !< size of state
sizeDotState = 0, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates sizeDotState = 0, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates
offsetDeltaState = 0, & !< index offset of delta state offsetDeltaState = 0, & !< index offset of delta state
sizeDeltaState = 0, & !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments sizeDeltaState = 0 !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments
sizePostResults = 0 !< size of output data
real(pReal), pointer, dimension(:), contiguous :: & real(pReal), pointer, dimension(:), contiguous :: &
atolState atolState
real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/doState. However, they will never point to something, but are rather allocated and, hence, contiguous real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/doState. However, they will never point to something, but are rather allocated and, hence, contiguous

37
src/thermal_adiabatic.f90
View File

@ -16,8 +16,6 @@ module thermal_adiabatic
implicit none implicit none
private private
integer, dimension(:,:), allocatable, target, public :: &
thermal_adiabatic_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: & character(len=64), dimension(:,:), allocatable, target, public :: &
thermal_adiabatic_output !< name of each post result output thermal_adiabatic_output !< name of each post result output
@ -38,8 +36,7 @@ module thermal_adiabatic
thermal_adiabatic_getSourceAndItsTangent, & thermal_adiabatic_getSourceAndItsTangent, &
thermal_adiabatic_getSpecificHeat, & thermal_adiabatic_getSpecificHeat, &
thermal_adiabatic_getMassDensity, & thermal_adiabatic_getMassDensity, &
thermal_adiabatic_results, & thermal_adiabatic_results
thermal_adiabatic_postResults
contains contains
@ -59,7 +56,6 @@ subroutine thermal_adiabatic_init
maxNinstance = count(thermal_type == THERMAL_adiabatic_ID) maxNinstance = count(thermal_type == THERMAL_adiabatic_ID)
if (maxNinstance == 0) return if (maxNinstance == 0) return
allocate(thermal_adiabatic_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0)
allocate(thermal_adiabatic_output (maxval(homogenization_Noutput),maxNinstance)) allocate(thermal_adiabatic_output (maxval(homogenization_Noutput),maxNinstance))
thermal_adiabatic_output = '' thermal_adiabatic_output = ''
allocate(thermal_adiabatic_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) allocate(thermal_adiabatic_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
@ -77,14 +73,12 @@ subroutine thermal_adiabatic_init
thermal_adiabatic_Noutput(instance) = thermal_adiabatic_Noutput(instance) + 1 thermal_adiabatic_Noutput(instance) = thermal_adiabatic_Noutput(instance) + 1
thermal_adiabatic_outputID(thermal_adiabatic_Noutput(instance),instance) = temperature_ID thermal_adiabatic_outputID(thermal_adiabatic_Noutput(instance),instance) = temperature_ID
thermal_adiabatic_output(thermal_adiabatic_Noutput(instance),instance) = outputs(i) thermal_adiabatic_output(thermal_adiabatic_Noutput(instance),instance) = outputs(i)
thermal_adiabatic_sizePostResult(thermal_adiabatic_Noutput(instance),instance) = 1
end select end select
enddo enddo
! allocate state arrays ! allocate state arrays
sizeState = 1 sizeState = 1
thermalState(section)%sizeState = sizeState thermalState(section)%sizeState = sizeState
thermalState(section)%sizePostResults = sum(thermal_adiabatic_sizePostResult(:,instance))
allocate(thermalState(section)%state0 (sizeState,NofMyHomog), source=thermal_initialT(section)) allocate(thermalState(section)%state0 (sizeState,NofMyHomog), source=thermal_initialT(section))
allocate(thermalState(section)%subState0(sizeState,NofMyHomog), source=thermal_initialT(section)) allocate(thermalState(section)%subState0(sizeState,NofMyHomog), source=thermal_initialT(section))
allocate(thermalState(section)%state (sizeState,NofMyHomog), source=thermal_initialT(section)) allocate(thermalState(section)%state (sizeState,NofMyHomog), source=thermal_initialT(section))
@ -277,33 +271,4 @@ subroutine thermal_adiabatic_results(homog,group)
end subroutine thermal_adiabatic_results end subroutine thermal_adiabatic_results
!--------------------------------------------------------------------------------------------------
!> @brief return array of thermal results
!--------------------------------------------------------------------------------------------------
function thermal_adiabatic_postResults(homog,instance,of) result(postResults)
integer, intent(in) :: &
homog, &
instance, &
of
real(pReal), dimension(sum(thermal_adiabatic_sizePostResult(:,instance))) :: &
postResults
integer :: &
o, c
c = 0
do o = 1,thermal_adiabatic_Noutput(instance)
select case(thermal_adiabatic_outputID(o,instance))
case (temperature_ID)
postResults(c+1) = temperature(homog)%p(of)
c = c + 1
end select
enddo
end function thermal_adiabatic_postResults
end module thermal_adiabatic end module thermal_adiabatic

37
src/thermal_conduction.f90
View File

@ -15,8 +15,6 @@ module thermal_conduction
implicit none implicit none
private private
integer, dimension(:,:), allocatable, target, public :: &
thermal_conduction_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: & character(len=64), dimension(:,:), allocatable, target, public :: &
thermal_conduction_output !< name of each post result output thermal_conduction_output !< name of each post result output
@ -38,8 +36,7 @@ module thermal_conduction
thermal_conduction_getSpecificHeat, & thermal_conduction_getSpecificHeat, &
thermal_conduction_getMassDensity, & thermal_conduction_getMassDensity, &
thermal_conduction_putTemperatureAndItsRate, & thermal_conduction_putTemperatureAndItsRate, &
thermal_conduction_results, & thermal_conduction_results
thermal_conduction_postResults
contains contains
@ -62,7 +59,6 @@ subroutine thermal_conduction_init
maxNinstance = count(thermal_type == THERMAL_conduction_ID) maxNinstance = count(thermal_type == THERMAL_conduction_ID)
if (maxNinstance == 0) return if (maxNinstance == 0) return
allocate(thermal_conduction_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0)
allocate(thermal_conduction_output (maxval(homogenization_Noutput),maxNinstance)) allocate(thermal_conduction_output (maxval(homogenization_Noutput),maxNinstance))
thermal_conduction_output = '' thermal_conduction_output = ''
allocate(thermal_conduction_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) allocate(thermal_conduction_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
@ -80,7 +76,6 @@ subroutine thermal_conduction_init
thermal_conduction_Noutput(instance) = thermal_conduction_Noutput(instance) + 1 thermal_conduction_Noutput(instance) = thermal_conduction_Noutput(instance) + 1
thermal_conduction_outputID(thermal_conduction_Noutput(instance),instance) = temperature_ID thermal_conduction_outputID(thermal_conduction_Noutput(instance),instance) = temperature_ID
thermal_conduction_output(thermal_conduction_Noutput(instance),instance) = outputs(i) thermal_conduction_output(thermal_conduction_Noutput(instance),instance) = outputs(i)
thermal_conduction_sizePostResult(thermal_conduction_Noutput(instance),instance) = 1
end select end select
enddo enddo
@ -88,7 +83,6 @@ subroutine thermal_conduction_init
! allocate state arrays ! allocate state arrays
sizeState = 0 sizeState = 0
thermalState(section)%sizeState = sizeState thermalState(section)%sizeState = sizeState
thermalState(section)%sizePostResults = sum(thermal_conduction_sizePostResult(:,instance))
allocate(thermalState(section)%state0 (sizeState,NofMyHomog)) allocate(thermalState(section)%state0 (sizeState,NofMyHomog))
allocate(thermalState(section)%subState0(sizeState,NofMyHomog)) allocate(thermalState(section)%subState0(sizeState,NofMyHomog))
allocate(thermalState(section)%state (sizeState,NofMyHomog)) allocate(thermalState(section)%state (sizeState,NofMyHomog))
@ -290,33 +284,4 @@ subroutine thermal_conduction_results(homog,group)
end subroutine thermal_conduction_results end subroutine thermal_conduction_results
!--------------------------------------------------------------------------------------------------
!> @brief return array of thermal results
!--------------------------------------------------------------------------------------------------
function thermal_conduction_postResults(homog,instance,of) result(postResults)
integer, intent(in) :: &
homog, &
instance, &
of
real(pReal), dimension(sum(thermal_conduction_sizePostResult(:,instance))) :: &
postResults
integer :: &
o, c
c = 0
do o = 1,thermal_conduction_Noutput(instance)
select case(thermal_conduction_outputID(o,instance))
case (temperature_ID)
postResults(c+1) = temperature(homog)%p(of)
c = c + 1
end select
enddo
end function thermal_conduction_postResults
end module thermal_conduction end module thermal_conduction