several small corrections/polishing

This commit is contained in:
Martin Diehl 2012-04-20 11:58:41 +00:00
parent c889d20ba0
commit d2c4874db3
5 changed files with 56 additions and 33 deletions

View File

@ -213,7 +213,7 @@ subroutine CPFEM_init
write(6,*) 'parallelExecution: ', parallelExecution
write(6,*) 'symmetricSolver: ', symmetricSolver
endif
call flush(6)
flush(6)
!$OMP END CRITICAL (write2out)
end subroutine CPFEM_init

View File

@ -249,7 +249,6 @@ program DAMASK_spectral
!##################################################################################################
! reading of information from load case file and geometry file
!##################################################################################################
open (6, encoding='UTF-8')
call DAMASK_interface_init
write(6,'(a)') ''
write(6,'(a)') ' <<<+- DAMASK_spectral init -+>>>'
@ -788,7 +787,7 @@ C_ref = C * wgt
P_av_lab = real(P_fourier(1,1,1,1:3,1:3),pReal)*wgt
P_av = math_rotate_forward33(P_av_lab,bc(loadcase)%rotation)
write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') 'Piola-Kirchhoff stress / MPa =',&
write (6,'(a,/,3(3(f12.7,1x)/))',advance='no') 'Piola-Kirchhoff stress / MPa =',&
math_transpose33(P_av)/1.e6_pReal
!--------------------------------------------------------------------------------------------------

View File

@ -67,9 +67,10 @@ subroutine DAMASK_interface_init(loadcaseParameterIn,geometryParameterIn)
length
integer, dimension(8) :: &
dateAndTime ! type default integer
write(6,*)
write(6,*) '<<<+- DAMASK_spectral_interface init -+>>>'
write(6,*) '$Id$'
open (6, encoding='UTF-8')
write(6,'(a)') ''
write(6,'(a)') '<<<+- DAMASK_spectral_interface init -+>>>'
write(6,'(a)') '$Id$'
#include "compilation_info.f90"
if ( present(loadcaseParameterIn) .and. present(geometryParameterIn)) then ! both mandatory parameters given in function call
geometryParameter = geometryParameterIn
@ -189,12 +190,12 @@ subroutine DAMASK_interface_init(loadcaseParameterIn,geometryParameterIn)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',&
dateAndTime(6),':',&
dateAndTime(7)
write(6,*) 'Host Name: ', trim(hostName)
write(6,*) 'User Name: ', trim(userName)
write(6,*) 'Path Separator: ', getPathSep()
write(6,*) 'Command line call: ', trim(commandLine)
write(6,*) 'Geometry Parameter: ', trim(geometryParameter)
write(6,*) 'Loadcase Parameter: ', trim(loadcaseParameter)
write(6,'(a,a)') 'Host Name: ', trim(hostName)
write(6,'(a,a)') 'User Name: ', trim(userName)
write(6,'(a,a)') 'Path Separator: ', getPathSep()
write(6,'(a,a)') 'Command line call: ', trim(commandLine)
write(6,'(a,a)') 'Geometry Parameter: ', trim(geometryParameter)
write(6,'(a,a)') 'Loadcase Parameter: ', trim(loadcaseParameter)
if (start/=3_pInt) write(6,*) 'Restart Parameter: ', trim(commandLine(start:start+length))
end subroutine DAMASK_interface_init

View File

@ -26,6 +26,7 @@ module IO
implicit none
private
public :: IO_init, &
IO_checkAndRewind, &
IO_open_file_stat, &
IO_open_jobFile_stat, &
IO_open_file, &
@ -81,6 +82,20 @@ subroutine IO_init
end subroutine IO_init
!********************************************************************
! checks if myUnit is opened for reading and rewinds
!********************************************************************
subroutine IO_checkAndRewind(myUnit)
implicit none
integer(pInt), intent(in) :: myUnit
logical :: fileOpened
character(len=15) :: fileRead
inquire(unit=myUnit, opened=fileOpened, read = fileRead)
if (fileOpened .neqv. .true. .or. trim(fileRead)/='YES') call IO_error(102_pInt)
rewind(myUnit)
end subroutine IO_checkAndRewind
!********************************************************************
! open existing file to given myUnit
@ -314,9 +329,7 @@ subroutine IO_read_jobBinaryFile(myUnit,newExt,jobName,recMultiplier)
open(myUnit,status='old',form='unformatted',access='direct', &
recl=pReal,iostat=myStat,file=path)
endif
if (myStat /= 0) then
call IO_error(100_pInt,ext_msg=path)
endif
if (myStat /= 0) call IO_error(100_pInt,ext_msg=path)
end subroutine IO_read_jobBinaryFile
@ -995,7 +1008,7 @@ integer(pInt) function IO_countContinuousIntValues(myUnit)
if (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator
IO_countContinuousIntValues = 1_pInt + IO_intValue(line,myPos,3_pInt) - IO_intValue(line,myPos,1_pInt)
exit ! only one single range indicator allowed
else if (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'copies' .and.
else if (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'copies' .and. &
IO_lc(IO_stringValue(line,myPos,3_pInt)) == 'of' ) then ! found multiple entries indicator
IO_countContinuousIntValues = IO_intValue(line,myPos,1_pInt)
exit ! only one single multiplier allowed
@ -1078,7 +1091,7 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN)
IO_continuousIntValues(1+IO_continuousIntValues(1)) = i
enddo
exit
else if (myPos(1) > 3_pInt .and. IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'copies'
else if (myPos(1) > 3_pInt .and. IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'copies' &
.and. IO_lc(IO_stringValue(line,myPos,3_pInt)) == 'of' ) then ! found multiple entries indicator
IO_continuousIntValues(1) = IO_intValue(line,myPos,1_pInt)
IO_continuousIntValues(2:IO_continuousIntValues(1)+1) = IO_intValue(line,myPos,4_pInt)

View File

@ -1439,10 +1439,11 @@ end subroutine mesh_build_FEdata
!********************************************************************
subroutine mesh_marc_get_tableStyles(myUnit)
use IO, only: IO_lc, &
IO_intValue, &
IO_stringValue, &
IO_stringPos
use IO, only: &
IO_lc, &
IO_intValue, &
IO_stringValue, &
IO_stringPos
implicit none
integer(pInt), intent(in) :: myUnit
@ -1491,7 +1492,7 @@ integer(pInt), dimension (1+2*maxNchunks) :: myPos
integer(pInt) chunk, Nchunks
character(len=300) line, keyword, damaskOption, v
mesh_periodicSurface = (/.false., .false., .false./)
mesh_periodicSurface = .false.
610 FORMAT(A300)
@ -2632,13 +2633,15 @@ end subroutine mesh_abaqus_build_nodes
!********************************************************************
subroutine mesh_spectral_build_elements(myUnit)
use IO, only: IO_lc, &
IO_stringValue, &
IO_stringPos, &
IO_error, &
IO_continuousIntValues, &
IO_intValue, &
IO_countContinuousIntValues
use IO, only: &
IO_checkAndRewind, &
IO_lc, &
IO_stringValue, &
IO_stringPos, &
IO_error, &
IO_continuousIntValues, &
IO_intValue, &
IO_countContinuousIntValues
implicit none
integer(pInt), intent(in) :: myUnit
@ -2655,7 +2658,8 @@ subroutine mesh_spectral_build_elements(myUnit)
res = mesh_spectral_getResolution(myUnit)
homog = mesh_spectral_getHomogenization(myUnit)
rewind(myUnit)
call IO_checkAndRewind(myUnit)
read(myUnit,'(a65536)') line
myPos = IO_stringPos(line,2_pInt)
keyword = IO_lc(IO_StringValue(line,myPos,2_pInt))
@ -3552,6 +3556,7 @@ end subroutine mesh_regrid
function mesh_spectral_getDimension(fileUnit)
use IO, only: &
IO_checkAndRewind, &
IO_open_file, &
IO_stringPos, &
IO_lc, &
@ -3581,7 +3586,8 @@ function mesh_spectral_getDimension(fileUnit)
myUnit = fileUnit
endif
rewind(myUnit)
call IO_checkAndRewind(myUnit)
read(myUnit,'(a1024)') line
positions = IO_stringPos(line,2_pInt)
keyword = IO_lc(IO_StringValue(line,positions,2_pInt))
@ -3622,6 +3628,7 @@ end function mesh_spectral_getDimension
function mesh_spectral_getResolution(fileUnit)
use IO, only: &
IO_checkAndRewind, &
IO_open_file, &
IO_stringPos, &
IO_lc, &
@ -3651,7 +3658,8 @@ function mesh_spectral_getResolution(fileUnit)
myUnit = fileUnit
endif
rewind(myUnit)
call IO_checkAndRewind(myUnit)
read(myUnit,'(a1024)') line
positions = IO_stringPos(line,2_pInt)
keyword = IO_lc(IO_StringValue(line,positions,2_pInt))
@ -3694,6 +3702,7 @@ end function mesh_spectral_getResolution
function mesh_spectral_getHomogenization(fileUnit)
use IO, only: &
IO_checkAndRewind, &
IO_open_file, &
IO_stringPos, &
IO_lc, &
@ -3722,7 +3731,8 @@ function mesh_spectral_getHomogenization(fileUnit)
myUnit = fileUnit
endif
rewind(myUnit)
call IO_checkAndRewind(myUnit)
read(myUnit,'(a1024)') line
positions = IO_stringPos(line,2_pInt)
keyword = IO_lc(IO_StringValue(line,positions,2_pInt))