From 3eec0ecdcda68e01a2471b7980b80a873b83f484 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 18 Sep 2013 14:07:55 +0000 Subject: [PATCH] introduced #EOF# as module wide parameter in IO.f90 renamed read/write binary file to read/write real/int removed suffix job from readFile functions as the name of the model is needed as an argument --- code/CPFEM.f90 | 42 +- code/DAMASK_spectral_driver.f90 | 2 - code/DAMASK_spectral_solverAL.f90 | 49 +- code/DAMASK_spectral_solverBasic.f90 | 27 +- code/DAMASK_spectral_solverBasicPETSc.f90 | 31 +- code/DAMASK_spectral_solverPolarisation.f90 | 49 +- code/DAMASK_spectral_utilities.f90 | 4 +- code/IO.f90 | 927 ++++++++++---------- code/constitutive.f90 | 4 +- code/constitutive_dislotwin.f90 | 66 +- code/constitutive_j2.f90 | 2 +- code/constitutive_none.f90 | 2 +- code/constitutive_nonlocal.f90 | 2 +- code/constitutive_phenopowerlaw.f90 | 23 +- code/constitutive_titanmod.f90 | 45 +- code/homogenization.f90 | 4 +- code/material.f90 | 2 +- code/mesh.f90 | 64 +- 18 files changed, 674 insertions(+), 671 deletions(-) diff --git a/code/CPFEM.f90 b/code/CPFEM.f90 index 9f429efa9..4505fb533 100644 --- a/code/CPFEM.f90 +++ b/code/CPFEM.f90 @@ -137,8 +137,8 @@ subroutine CPFEM_init use prec, only: & pInt use IO, only: & - IO_read_jobBinaryFile,& - IO_read_jobBinaryIntFile, & + IO_read_realFile,& + IO_read_intFile, & IO_timeStamp, & IO_error use numerics, only: & @@ -192,31 +192,31 @@ subroutine CPFEM_init !$OMP END CRITICAL (write2out) endif - call IO_read_jobBinaryIntFile(777,'recordedPhase',modelName,size(material_phase)) + call IO_read_intFile(777,'recordedPhase',modelName,size(material_phase)) read (777,rec=1) material_phase close (777) - call IO_read_jobBinaryFile(777,'convergedF',modelName,size(crystallite_F0)) + call IO_read_realFile(777,'convergedF',modelName,size(crystallite_F0)) read (777,rec=1) crystallite_F0 close (777) - call IO_read_jobBinaryFile(777,'convergedFp',modelName,size(crystallite_Fp0)) + call IO_read_realFile(777,'convergedFp',modelName,size(crystallite_Fp0)) read (777,rec=1) crystallite_Fp0 close (777) - call IO_read_jobBinaryFile(777,'convergedLp',modelName,size(crystallite_Lp0)) + call IO_read_realFile(777,'convergedLp',modelName,size(crystallite_Lp0)) read (777,rec=1) crystallite_Lp0 close (777) - call IO_read_jobBinaryFile(777,'convergeddPdF',modelName,size(crystallite_dPdF0)) + call IO_read_realFile(777,'convergeddPdF',modelName,size(crystallite_dPdF0)) read (777,rec=1) crystallite_dPdF0 close (777) - call IO_read_jobBinaryFile(777,'convergedTstar',modelName,size(crystallite_Tstar0_v)) + call IO_read_realFile(777,'convergedTstar',modelName,size(crystallite_Tstar0_v)) read (777,rec=1) crystallite_Tstar0_v close (777) - call IO_read_jobBinaryFile(777,'convergedStateConst',modelName) + call IO_read_realFile(777,'convergedStateConst',modelName) m = 0_pInt do i = 1,homogenization_maxNgrains; do j = 1,mesh_maxNips; do k = 1,mesh_NcpElems do l = 1,size(constitutive_state0(i,j,k)%p) @@ -226,7 +226,7 @@ subroutine CPFEM_init enddo; enddo; enddo close (777) - call IO_read_jobBinaryFile(777,'convergedStateHomog',modelName) + call IO_read_realFile(777,'convergedStateHomog',modelName) m = 0_pInt do k = 1,mesh_NcpElems; do j = 1,mesh_maxNips do l = 1,homogenization_sizeState(j,k) @@ -236,7 +236,7 @@ subroutine CPFEM_init enddo; enddo close (777) - call IO_read_jobBinaryFile(777,'convergeddcsdE',modelName,size(CPFEM_dcsdE)) + call IO_read_realFile(777,'convergeddcsdE',modelName,size(CPFEM_dcsdE)) read (777,rec=1) CPFEM_dcsdE close (777) restartRead = .false. @@ -324,7 +324,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, Temperature, dt, el materialpoint_Temperature, & materialpoint_stressAndItsTangent, & materialpoint_postResults - use IO, only: IO_write_jobBinaryFile, & + use IO, only: IO_write_jobRealFile, & IO_warning use DAMASK_interface @@ -422,31 +422,31 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, Temperature, dt, el !$OMP END CRITICAL (write2out) endif - call IO_write_jobBinaryFile(777,'recordedPhase',size(material_phase)) + call IO_write_jobRealFile(777,'recordedPhase',size(material_phase)) write (777,rec=1) material_phase close (777) - call IO_write_jobBinaryFile(777,'convergedF',size(crystallite_F0)) + call IO_write_jobRealFile(777,'convergedF',size(crystallite_F0)) write (777,rec=1) crystallite_F0 close (777) - call IO_write_jobBinaryFile(777,'convergedFp',size(crystallite_Fp0)) + call IO_write_jobRealFile(777,'convergedFp',size(crystallite_Fp0)) write (777,rec=1) crystallite_Fp0 close (777) - call IO_write_jobBinaryFile(777,'convergedLp',size(crystallite_Lp0)) + call IO_write_jobRealFile(777,'convergedLp',size(crystallite_Lp0)) write (777,rec=1) crystallite_Lp0 close (777) - call IO_write_jobBinaryFile(777,'convergeddPdF',size(crystallite_dPdF0)) + call IO_write_jobRealFile(777,'convergeddPdF',size(crystallite_dPdF0)) write (777,rec=1) crystallite_dPdF0 close (777) - call IO_write_jobBinaryFile(777,'convergedTstar',size(crystallite_Tstar0_v)) + call IO_write_jobRealFile(777,'convergedTstar',size(crystallite_Tstar0_v)) write (777,rec=1) crystallite_Tstar0_v close (777) - call IO_write_jobBinaryFile(777,'convergedStateConst') + call IO_write_jobRealFile(777,'convergedStateConst') m = 0_pInt do i = 1,homogenization_maxNgrains; do j = 1,mesh_maxNips; do k = 1,mesh_NcpElems do l = 1,size(constitutive_state0(i,j,k)%p) @@ -456,7 +456,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, Temperature, dt, el enddo; enddo; enddo close (777) - call IO_write_jobBinaryFile(777,'convergedStateHomog') + call IO_write_jobRealFile(777,'convergedStateHomog') m = 0_pInt do k = 1,mesh_NcpElems; do j = 1,mesh_maxNips do l = 1,homogenization_sizeState(j,k) @@ -466,7 +466,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, Temperature, dt, el enddo; enddo close (777) - call IO_write_jobBinaryFile(777,'convergeddcsdE',size(CPFEM_dcsdE)) + call IO_write_jobRealFile(777,'convergeddcsdE',size(CPFEM_dcsdE)) write (777,rec=1) CPFEM_dcsdE close (777) diff --git a/code/DAMASK_spectral_driver.f90 b/code/DAMASK_spectral_driver.f90 index 3528bc123..ab68d5843 100644 --- a/code/DAMASK_spectral_driver.f90 +++ b/code/DAMASK_spectral_driver.f90 @@ -50,8 +50,6 @@ program DAMASK_spectral_Driver IO_intValue, & IO_error, & IO_lc, & - IO_read_jobBinaryFile, & - IO_write_jobBinaryFile, & IO_intOut, & IO_warning, & IO_timeStamp diff --git a/code/DAMASK_spectral_solverAL.f90 b/code/DAMASK_spectral_solverAL.f90 index 93df06500..8e2982825 100644 --- a/code/DAMASK_spectral_solverAL.f90 +++ b/code/DAMASK_spectral_solverAL.f90 @@ -129,8 +129,7 @@ subroutine AL_init(temperature) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) use IO, only: & IO_intOut, & - IO_read_JobBinaryFile, & - IO_write_JobBinaryFile, & + IO_read_realFile, & IO_timeStamp use debug, only: & debug_level, & @@ -217,38 +216,38 @@ subroutine AL_init(temperature) write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & 'reading values of increment', restartInc - 1_pInt, 'from file' flush(6) - call IO_read_jobBinaryFile(777,'F',& + call IO_read_realFile(777,'F',& trim(getSolverJobName()),size(F)) read (777,rec=1) F close (777) - call IO_read_jobBinaryFile(777,'F_lastInc',& + call IO_read_realFile(777,'F_lastInc',& trim(getSolverJobName()),size(F_lastInc)) read (777,rec=1) F_lastInc close (777) - call IO_read_jobBinaryFile(777,'F_lastInc2',& + call IO_read_realFile(777,'F_lastInc2',& trim(getSolverJobName()),size(F_lastInc2)) read (777,rec=1) F_lastInc2 close (777) F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc - call IO_read_jobBinaryFile(777,'F_lambda',& + call IO_read_realFile(777,'F_lambda',& trim(getSolverJobName()),size(F_lambda)) read (777,rec=1) F_lambda close (777) - call IO_read_jobBinaryFile(777,'F_lambda_lastInc',& + call IO_read_realFile(777,'F_lambda_lastInc',& trim(getSolverJobName()),size(F_lambda_lastInc)) read (777,rec=1) F_lambda_lastInc close (777) - call IO_read_jobBinaryFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) + call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) read (777,rec=1) f_aimDot close (777) - call IO_read_jobBinaryFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) + call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) read (777,rec=1) C_volAvg close (777) - call IO_read_jobBinaryFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) + call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) read (777,rec=1) C_volAvgLastInc close (777) - call IO_read_jobBinaryFile(777,'C_ref',trim(getSolverJobName()),size(temp3333_Real)) + call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(temp3333_Real)) read (777,rec=1) C_minMaxAvg close (777) endif @@ -289,7 +288,7 @@ use mesh, only: & mesh_ipCoordinates, & mesh_deformedCoordsFFT use IO, only: & - IO_write_JobBinaryFile + IO_write_jobRealFile use DAMASK_spectral_Utilities, only: & grid, & geomSize, & @@ -343,25 +342,25 @@ use mesh, only: & if (restartWrite) then write(6,'(/,a)') ' writing converged results for restart' flush(6) - call IO_write_jobBinaryFile(777,'F',size(F)) ! writing deformation gradient field to file + call IO_write_jobRealFile(777,'F',size(F)) ! writing deformation gradient field to file write (777,rec=1) F close (777) - call IO_write_jobBinaryFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file + call IO_write_jobRealFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file write (777,rec=1) F_lastInc close (777) - call IO_write_jobBinaryFile(777,'F_lambda',size(F_lambda)) ! writing deformation gradient field to file + call IO_write_jobRealFile(777,'F_lambda',size(F_lambda)) ! writing deformation gradient field to file write (777,rec=1) F_lambda close (777) - call IO_write_jobBinaryFile(777,'F_lambda_lastInc',size(F_lambda_lastInc)) ! writing F_lastInc field to file + call IO_write_jobRealFile(777,'F_lambda_lastInc',size(F_lambda_lastInc)) ! writing F_lastInc field to file write (777,rec=1) F_lambda_lastInc close (777) - call IO_write_jobBinaryFile(777,'F_aimDot',size(F_aimDot)) + call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) write (777,rec=1) F_aimDot close(777) - call IO_write_jobBinaryFile(777,'C_volAvg',size(C_volAvg)) + call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) write (777,rec=1) C_volAvg close(777) - call IO_write_jobBinaryFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) + call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) write (777,rec=1) C_volAvgLastInc close(777) endif @@ -661,8 +660,8 @@ subroutine AL_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr !-------------------------------------------------------------------------------------------------- ! stress BC handling F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%P_BC))) ! S = 0.0 for no bc - err_BC = maxval(abs((1.0_pReal - mask_stress)*math_mul3333xx33(C_scale,F_aim-F_av) + & - mask_stress *(P_av - params%P_BC))) ! mask = 0.0 for no bc + err_BC = maxval(abs((-mask_stress+1.0_pReal)*math_mul3333xx33(C_scale,F_aim-F_av) + & + mask_stress *(P_av - params%P_BC))) ! mask = 0.0 for no bc !-------------------------------------------------------------------------------------------------- ! error calculation @@ -687,10 +686,10 @@ subroutine AL_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr write(6,'(1/,a)') ' ... reporting .............................................................' write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', & err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')' - write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & - err_div/divTol, ' (',err_div,' / m, tol =',divTol,')' - write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error stress BC = ', & - err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')' + write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & + err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')' + write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', & + err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')' write(6,'(/,a)') ' ===========================================================================' flush(6) diff --git a/code/DAMASK_spectral_solverBasic.f90 b/code/DAMASK_spectral_solverBasic.f90 index 724e7fd89..0e1e158d7 100644 --- a/code/DAMASK_spectral_solverBasic.f90 +++ b/code/DAMASK_spectral_solverBasic.f90 @@ -69,8 +69,7 @@ subroutine basic_init(temperature) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) use IO, only: & - IO_read_JobBinaryFile, & - IO_write_JobBinaryFile, & + IO_read_realFile, & IO_intOut, & IO_timeStamp use debug, only: & @@ -124,11 +123,11 @@ subroutine basic_init(temperature) write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & 'reading values of increment', restartInc - 1_pInt, 'from file' flush(6) - call IO_read_jobBinaryFile(777,'F',& + call IO_read_realFile(777,'F',& trim(getSolverJobName()),size(F)) read (777,rec=1) F close (777) - call IO_read_jobBinaryFile(777,'F_lastInc',& + call IO_read_realFile(777,'F_lastInc',& trim(getSolverJobName()),size(F_lastInc)) read (777,rec=1) F_lastInc close (777) @@ -136,16 +135,16 @@ subroutine basic_init(temperature) F_aim = sum(sum(sum(F,dim=5),dim=4),dim=3) * wgt ! average of F F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc - call IO_read_jobBinaryFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) + call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) read (777,rec=1) f_aimDot close (777) - call IO_read_jobBinaryFile(777,'C',trim(getSolverJobName()),size(C)) + call IO_read_realFile(777,'C',trim(getSolverJobName()),size(C)) read (777,rec=1) C close (777) - call IO_read_jobBinaryFile(777,'C_lastInc',trim(getSolverJobName()),size(C_lastInc)) + call IO_read_realFile(777,'C_lastInc',trim(getSolverJobName()),size(C_lastInc)) read (777,rec=1) C_lastInc close (777) - call IO_read_jobBinaryFile(777,'C_ref',trim(getSolverJobName()),size(temp3333_Real)) + call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(temp3333_Real)) read (777,rec=1) temp3333_Real close (777) endif @@ -179,7 +178,7 @@ type(tSolutionState) function basic_solution(& mesh_ipCoordinates,& mesh_deformedCoordsFFT use IO, only: & - IO_write_JobBinaryFile, & + IO_write_jobRealFile, & IO_intOut use debug, only: & debug_level, & @@ -242,19 +241,19 @@ type(tSolutionState) function basic_solution(& if (restartWrite) then write(6,'(/,a)') ' writing converged results for restart' flush(6) - call IO_write_jobBinaryFile(777,'F',size(F)) ! writing deformation gradient field to file + call IO_write_jobRealFile(777,'F',size(F)) ! writing deformation gradient field to file write (777,rec=1) F close (777) - call IO_write_jobBinaryFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file + call IO_write_jobRealFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file write (777,rec=1) F_lastInc close (777) - call IO_write_jobBinaryFile(777,'F_aimDot',size(f_aimDot)) + call IO_write_jobRealFile(777,'F_aimDot',size(f_aimDot)) write (777,rec=1) f_aimDot close(777) - call IO_write_jobBinaryFile(777,'C',size(C)) + call IO_write_jobRealFile(777,'C',size(C)) write (777,rec=1) C close(777) - call IO_write_jobBinaryFile(777,'C_lastInc',size(C_lastInc)) + call IO_write_jobRealFile(777,'C_lastInc',size(C_lastInc)) write (777,rec=1) C_lastInc close(777) endif diff --git a/code/DAMASK_spectral_solverBasicPETSc.f90 b/code/DAMASK_spectral_solverBasicPETSc.f90 index d3b9e83f3..a4de0f5c4 100644 --- a/code/DAMASK_spectral_solverBasicPETSc.f90 +++ b/code/DAMASK_spectral_solverBasicPETSc.f90 @@ -115,8 +115,7 @@ subroutine basicPETSc_init(temperature) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) use IO, only: & IO_intOut, & - IO_read_JobBinaryFile, & - IO_write_JobBinaryFile, & + IO_read_realFile, & IO_timeStamp use debug, only: & debug_level, & @@ -196,31 +195,31 @@ subroutine basicPETSc_init(temperature) write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & 'reading values of increment', restartInc - 1_pInt, 'from file' flush(6) - call IO_read_jobBinaryFile(777,'F',& + call IO_read_realFile(777,'F',& trim(getSolverJobName()),size(F)) read (777,rec=1) F close (777) - call IO_read_jobBinaryFile(777,'F_lastInc',& + call IO_read_realFile(777,'F_lastInc',& trim(getSolverJobName()),size(F_lastInc)) read (777,rec=1) F_lastInc close (777) - call IO_read_jobBinaryFile(777,'F_lastInc2',& + call IO_read_realFile(777,'F_lastInc2',& trim(getSolverJobName()),size(F_lastInc2)) read (777,rec=1) F_lastInc2 close (777) F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc - call IO_read_jobBinaryFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) + call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) read (777,rec=1) f_aimDot close (777) - call IO_read_jobBinaryFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) + call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) read (777,rec=1) C_volAvg close (777) - call IO_read_jobBinaryFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) + call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) read (777,rec=1) C_volAvgLastInc close (777) - call IO_read_jobBinaryFile(777,'C_ref',trim(getSolverJobName()),size(temp3333_Real)) + call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(temp3333_Real)) read (777,rec=1) temp3333_Real close (777) endif @@ -254,7 +253,7 @@ type(tSolutionState) function basicPETSc_solution( & mesh_ipCoordinates,& mesh_deformedCoordsFFT use IO, only: & - IO_write_JobBinaryFile + IO_write_JobRealFile use DAMASK_spectral_Utilities, only: & grid, & geomSize, & @@ -302,22 +301,22 @@ type(tSolutionState) function basicPETSc_solution( & if (restartWrite) then write(6,'(/,a)') ' writing converged results for restart' flush(6) - call IO_write_jobBinaryFile(777,'F',size(F)) ! writing deformation gradient field to file + call IO_write_jobRealFile(777,'F',size(F)) ! writing deformation gradient field to file write (777,rec=1) F close (777) - call IO_write_jobBinaryFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file + call IO_write_jobRealFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file write (777,rec=1) F_lastInc close (777) - call IO_write_jobBinaryFile(777,'F_lastInc2',size(F_lastInc2)) ! writing F_lastInc field to file + call IO_write_jobRealFile(777,'F_lastInc2',size(F_lastInc2)) ! writing F_lastInc field to file write (777,rec=1) F_lastInc2 close (777) - call IO_write_jobBinaryFile(777,'F_aimDot',size(F_aimDot)) + call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) write (777,rec=1) F_aimDot close(777) - call IO_write_jobBinaryFile(777,'C_volAvg',size(C_volAvg)) + call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) write (777,rec=1) C_volAvg close(777) - call IO_write_jobBinaryFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) + call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) write (777,rec=1) C_volAvgLastInc close(777) endif diff --git a/code/DAMASK_spectral_solverPolarisation.f90 b/code/DAMASK_spectral_solverPolarisation.f90 index e0bb13034..879519e76 100644 --- a/code/DAMASK_spectral_solverPolarisation.f90 +++ b/code/DAMASK_spectral_solverPolarisation.f90 @@ -129,8 +129,7 @@ subroutine Polarisation_init(temperature) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) use IO, only: & IO_intOut, & - IO_read_JobBinaryFile, & - IO_write_JobBinaryFile, & + IO_read_realFile, & IO_timeStamp use debug, only : & debug_level, & @@ -217,38 +216,38 @@ subroutine Polarisation_init(temperature) write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & 'reading values of increment', restartInc - 1_pInt, 'from file' flush(6) - call IO_read_jobBinaryFile(777,'F',& + call IO_read_realFile(777,'F',& trim(getSolverJobName()),size(F)) read (777,rec=1) F close (777) - call IO_read_jobBinaryFile(777,'F_lastInc',& + call IO_read_realFile(777,'F_lastInc',& trim(getSolverJobName()),size(F_lastInc)) read (777,rec=1) F_lastInc close (777) - call IO_read_jobBinaryFile(777,'F_lastInc2',& + call IO_read_realFile(777,'F_lastInc2',& trim(getSolverJobName()),size(F_lastInc2)) read (777,rec=1) F_lastInc2 close (777) F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc - call IO_read_jobBinaryFile(777,'F_tau',& + call IO_read_realFile(777,'F_tau',& trim(getSolverJobName()),size(F_tau)) read (777,rec=1) F_tau close (777) - call IO_read_jobBinaryFile(777,'F_tau_lastInc',& + call IO_read_realFile(777,'F_tau_lastInc',& trim(getSolverJobName()),size(F_tau_lastInc)) read (777,rec=1) F_tau_lastInc close (777) - call IO_read_jobBinaryFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) + call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) read (777,rec=1) f_aimDot close (777) - call IO_read_jobBinaryFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) + call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) read (777,rec=1) C_volAvg close (777) - call IO_read_jobBinaryFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) + call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) read (777,rec=1) C_volAvgLastInc close (777) - call IO_read_jobBinaryFile(777,'C_ref',trim(getSolverJobName()),size(temp3333_Real)) + call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(temp3333_Real)) read (777,rec=1) C_minMaxAvg close (777) endif @@ -289,7 +288,7 @@ use mesh, only: & mesh_ipCoordinates, & mesh_deformedCoordsFFT use IO, only: & - IO_write_JobBinaryFile + IO_write_jobRealFile use DAMASK_spectral_Utilities, only: & grid, & geomSize, & @@ -343,25 +342,25 @@ use mesh, only: & if (restartWrite) then write(6,'(/,a)') ' writing converged results for restart' flush(6) - call IO_write_jobBinaryFile(777,'F',size(F)) ! writing deformation gradient field to file + call IO_write_jobRealFile(777,'F',size(F)) ! writing deformation gradient field to file write (777,rec=1) F close (777) - call IO_write_jobBinaryFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file + call IO_write_jobRealFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file write (777,rec=1) F_lastInc close (777) - call IO_write_jobBinaryFile(777,'F_tau',size(F_tau)) ! writing deformation gradient field to file + call IO_write_jobRealFile(777,'F_tau',size(F_tau)) ! writing deformation gradient field to file write (777,rec=1) F_tau close (777) - call IO_write_jobBinaryFile(777,'F_tau_lastInc',size(F_tau_lastInc)) ! writing F_lastInc field to file + call IO_write_jobRealFile(777,'F_tau_lastInc',size(F_tau_lastInc)) ! writing F_lastInc field to file write (777,rec=1) F_tau_lastInc close (777) - call IO_write_jobBinaryFile(777,'F_aimDot',size(F_aimDot)) + call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) write (777,rec=1) F_aimDot close(777) - call IO_write_jobBinaryFile(777,'C_volAvg',size(C_volAvg)) + call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) write (777,rec=1) C_volAvg close(777) - call IO_write_jobBinaryFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) + call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) write (777,rec=1) C_volAvgLastInc close(777) endif @@ -659,8 +658,8 @@ subroutine Polarisation_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason, !-------------------------------------------------------------------------------------------------- ! stress BC handling F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%P_BC))) ! S = 0.0 for no bc - err_BC = maxval(abs((1.0_pReal - mask_stress)*math_mul3333xx33(C_scale,F_aim-F_av) + & - mask_stress *(P_av - params%P_BC))) ! mask = 0.0 for no bc + err_BC = maxval(abs((-mask_stress+1.0_pReal)*math_mul3333xx33(C_scale,F_aim-F_av) + & + mask_stress *(P_av - params%P_BC))) ! mask = 0.0 for no bc !-------------------------------------------------------------------------------------------------- ! error calculation @@ -685,10 +684,10 @@ subroutine Polarisation_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason, write(6,'(1/,a)') ' ... reporting .............................................................' write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', & err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')' - write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & - err_div/divTol, ' (',err_div,' / m, tol =',divTol,')' - write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', & - err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')' + write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & + err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')' + write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', & + err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')' write(6,'(/,a)') ' ===========================================================================' flush(6) diff --git a/code/DAMASK_spectral_utilities.f90 b/code/DAMASK_spectral_utilities.f90 index a46b13882..25bd09f5c 100644 --- a/code/DAMASK_spectral_utilities.f90 +++ b/code/DAMASK_spectral_utilities.f90 @@ -318,7 +318,7 @@ end subroutine utilities_init !-------------------------------------------------------------------------------------------------- subroutine utilities_updateGamma(C,saveReference) use IO, only: & - IO_write_jobBinaryFile + IO_write_jobRealFile use numerics, only: & memory_efficient use math, only: & @@ -337,7 +337,7 @@ subroutine utilities_updateGamma(C,saveReference) if (saveReference) then write(6,'(/,a)') ' writing reference stiffness to file' flush(6) - call IO_write_jobBinaryFile(777,'C_ref',size(C_ref)) + call IO_write_jobRealFile(777,'C_ref',size(C_ref)) write (777,rec=1) C_ref close(777) endif diff --git a/code/IO.f90 b/code/IO.f90 index bfe41b4ef..71b56d8fd 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -23,7 +23,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief input/output functions, partly depending on chosen solver +!> @brief input/output functions, partly depending on chosen solver !-------------------------------------------------------------------------------------------------- module IO use prec, only: & @@ -32,6 +32,8 @@ module IO implicit none private + character(len=5), parameter, public :: & + IO_EOF = '#EOF#' !< end of file string public :: & IO_init, & IO_read, & @@ -41,10 +43,10 @@ module IO IO_open_file, & IO_open_jobFile, & IO_write_jobFile, & - IO_write_jobBinaryFile, & - IO_write_jobBinaryIntFile, & - IO_read_jobBinaryFile, & - IO_read_jobBinaryIntFile, & + IO_write_jobRealFile, & + IO_write_jobIntFile, & + IO_read_realFile, & + IO_read_intFile, & IO_hybridIA, & IO_isBlank, & IO_getTag, & @@ -96,7 +98,7 @@ contains !-------------------------------------------------------------------------------------------------- -!> @brief only output of revision number +!> @brief only outputs revision number !-------------------------------------------------------------------------------------------------- subroutine IO_init use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) @@ -110,22 +112,23 @@ end subroutine IO_init !-------------------------------------------------------------------------------------------------- -!> @brief recursively reads a line from a file. -!> Recursion is triggered by "{path/to/inputfile}" in a line. +!> @brief recursively reads a line from a text file. +!! Recursion is triggered by "{path/to/inputfile}" in a line !-------------------------------------------------------------------------------------------------- recursive function IO_read(myUnit) result(line) implicit none - integer(pInt), intent(in) :: myUnit - integer(pInt), dimension(10) :: unitOn = 0_pInt ! save the stack of recursive file units - integer(pInt) :: stack = 1_pInt ! current stack position + integer(pInt), intent(in) :: myUnit !< file unit + + integer(pInt), dimension(10) :: unitOn = 0_pInt ! save the stack of recursive file units + integer(pInt) :: stack = 1_pInt ! current stack position character(len=8192), dimension(10) :: pathOn = '' character(len=512) :: path,input integer(pInt) :: myStat logical :: inUse character(len=65536) :: line - character(len=*), parameter :: sep = achar(47)//achar(92) ! forward and backward slash ("/", "\") + character(len=*), parameter :: SEP = achar(47)//achar(92) ! forward and backward slash ("/", "\") unitOn(1) = myUnit @@ -133,23 +136,23 @@ recursive function IO_read(myUnit) result(line) input = IO_getTag(line,'{','}') ! --- normal case --- - if (input == '') return ! regular line + if (input == '') return ! regular line ! --- recursion case --- - if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached + if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached - inquire(UNIT=unitOn(stack),NAME=path) ! path of current file + inquire(UNIT=unitOn(stack),NAME=path) ! path of current file stack = stack+1_pInt - unitOn(stack) = unitOn(stack-1_pInt)+1_pInt ! assume next file unit to be free to use - pathOn(stack) = path(1:scan(path,sep,.true.))//input ! glue include to current file's dir + unitOn(stack) = unitOn(stack-1_pInt)+1_pInt ! assume next file unit to be free to use + pathOn(stack) = path(1:scan(path,SEP,.true.))//input ! glue include to current file's dir do inquire(UNIT=unitOn(stack),OPENED=inUse) if (.not. inUse) exit - unitOn(stack) = unitOn(stack)+1_pInt ! test next fileunit + unitOn(stack) = unitOn(stack)+1_pInt ! test next fileunit enddo - open(unitOn(stack),status='old',iostat=myStat,file=pathOn(stack)) ! open included file + open(unitOn(stack),status='old',iostat=myStat,file=pathOn(stack)) ! open included file if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) line = IO_read(myUnit) @@ -157,27 +160,28 @@ recursive function IO_read(myUnit) result(line) return ! --- end of file case --- -100 if (stack > 1_pInt) then ! can go back to former file +100 if (stack > 1_pInt) then ! can go back to former file close(unitOn(stack)) stack = stack-1_pInt line = IO_read(myUnit) - else ! top-most file reached - line = '#EOF#' !< @ToDo should be made a module parameter + else ! top-most file reached + line = IO_EOF endif end function IO_read !-------------------------------------------------------------------------------------------------- -!> @brief Checks if unit is opened for reading, if true rewinds. Otherwise stops with -!> error message 102 +!> @brief checks if unit is opened for reading, if true rewinds. Otherwise stops with +!! error message !-------------------------------------------------------------------------------------------------- subroutine IO_checkAndRewind(myUnit) -implicit none - integer(pInt), intent(in) :: myUnit - logical :: fileOpened - character(len=15) :: fileRead + implicit none + integer(pInt), intent(in) :: myUnit !< file unit + 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) @@ -186,15 +190,18 @@ end subroutine IO_checkAndRewind !-------------------------------------------------------------------------------------------------- -!> @brief Open existing file to given unit path to file is relative to working directory +!> @brief opens existing file for reading to given unit. Path to file is relative to working +!! directory +!> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return +!! value !-------------------------------------------------------------------------------------------------- subroutine IO_open_file(myUnit,relPath) use DAMASK_interface, only: & getSolverWorkingDirectoryName implicit none - integer(pInt), intent(in) :: myUnit - character(len=*), intent(in) :: relPath + integer(pInt), intent(in) :: myUnit !< file unit + character(len=*), intent(in) :: relPath !< relative path from working directory integer(pInt) :: myStat character(len=1024) :: path @@ -207,15 +214,17 @@ end subroutine IO_open_file !-------------------------------------------------------------------------------------------------- -!> @brief Open existing file to given unit path to file is relative to working directory +!> @brief opens existing file for reading to given unit. Path to file is relative to working +!! directory +!> @details Like IO_open_file, but error is handled via return value and not via call to IO_error !-------------------------------------------------------------------------------------------------- logical function IO_open_file_stat(myUnit,relPath) - use DAMASK_interface, & - only: getSolverWorkingDirectoryName + use DAMASK_interface, only: & + getSolverWorkingDirectoryName implicit none - integer(pInt), intent(in) :: myUnit - character(len=*), intent(in) :: relPath + integer(pInt), intent(in) :: myUnit !< file unit + character(len=*), intent(in) :: relPath !< relative path from working directory integer(pInt) :: myStat character(len=1024) :: path @@ -228,22 +237,24 @@ end function IO_open_file_stat !-------------------------------------------------------------------------------------------------- -!> @brief Open (write) file related to current job but with different extension to given unit +!> @brief opens existing file for reading to given unit. File is named after solver job name +!! plus given extension and located in current working directory +!> @details like IO_open_jobFile_stat, but error is handled via call to IO_error and not via return +!! value !-------------------------------------------------------------------------------------------------- -subroutine IO_open_jobFile(myUnit,newExt) +subroutine IO_open_jobFile(myUnit,ext) use DAMASK_interface, only: & getSolverWorkingDirectoryName, & getSolverJobName implicit none - integer(pInt), intent(in) :: myUnit - character(len=*), intent(in) :: newExt + integer(pInt), intent(in) :: myUnit !< file unit + character(len=*), intent(in) :: ext !< extension of file integer(pInt) :: myStat character(len=1024) :: path - - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt + path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext open(myUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) @@ -251,21 +262,24 @@ end subroutine IO_open_jobFile !-------------------------------------------------------------------------------------------------- -!> @brief Open (write) file related to current job but with different extension to given unit +!> @brief opens existing file for reading to given unit. File is named after solver job name +!! plus given extension and located in current working directory +!> @details Like IO_open_jobFile, but error is handled via return value and not via call to +!! IO_error !-------------------------------------------------------------------------------------------------- -logical function IO_open_jobFile_stat(myUnit,newExt) +logical function IO_open_jobFile_stat(myUnit,ext) use DAMASK_interface, only: & getSolverWorkingDirectoryName, & getSolverJobName implicit none - integer(pInt), intent(in) :: myUnit - character(len=*), intent(in) :: newExt + integer(pInt), intent(in) :: myUnit !< file unit + character(len=*), intent(in) :: ext !< extension of file integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt + path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext open(myUnit,status='old',iostat=myStat,file=path) IO_open_jobFile_stat = (myStat == 0_pInt) @@ -274,42 +288,41 @@ end function IO_open_JobFile_stat #ifndef Spectral !-------------------------------------------------------------------------------------------------- -!> @brief open FEM input file to given unit +!> @brief opens FEM input file for reading located in current working directory to given unit !-------------------------------------------------------------------------------------------------- -subroutine IO_open_inputFile(myUnit,model) +subroutine IO_open_inputFile(myUnit,modelName) use DAMASK_interface, only: & getSolverWorkingDirectoryName,& getSolverJobName, & inputFileExtension implicit none - integer(pInt), intent(in) :: myUnit - character(len=*), intent(in) :: model + integer(pInt), intent(in) :: myUnit !< file unit + character(len=*), intent(in) :: modelName !< model name, in case of restart not solver job name integer(pInt) :: myStat character(len=1024) :: path - #ifdef Abaqus integer(pInt) :: fileType fileType = 1_pInt ! assume .pes - path = trim(getSolverWorkingDirectoryName())//trim(model)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used + path = trim(getSolverWorkingDirectoryName())//trim(modelModel)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used open(myUnit+1,status='old',iostat=myStat,file=path) if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" fileType = 2_pInt - path = trim(getSolverWorkingDirectoryName())//trim(model)//inputFileExtension(fileType) + path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) open(myUnit+1,status='old',iostat=myStat,file=path) endif if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) ! ensure that any file opened works - path = trim(getSolverWorkingDirectoryName())//trim(model)//inputFileExtension(fileType)//'_assembly' + path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)//'_assembly' open(myUnit,iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) if (.not.abaqus_assembleInputFile(myUnit,myUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s close(myUnit+1_pInt) #endif #ifdef Marc4DAMASK - path = trim(getSolverWorkingDirectoryName())//trim(model)//inputFileExtension + path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension open(myUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) #endif @@ -318,7 +331,8 @@ end subroutine IO_open_inputFile !-------------------------------------------------------------------------------------------------- -!> @brief open FEM log file to given Unit +!> @brief opens existing FEM log file for reading to given unit. File is named after solver job +!! name and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(myUnit) use DAMASK_interface, only: & @@ -327,7 +341,7 @@ subroutine IO_open_logFile(myUnit) LogFileExtension implicit none - integer(pInt), intent(in) :: myUnit + integer(pInt), intent(in) :: myUnit !< file unit integer(pInt) :: myStat character(len=1024) :: path @@ -341,21 +355,22 @@ end subroutine IO_open_logFile !-------------------------------------------------------------------------------------------------- -!> @brief open (write) file related to current job with given extension to given unit +!> @brief opens FEM log file for writing to given unit. File is named after solver job name and +!! located in current working directory !-------------------------------------------------------------------------------------------------- -subroutine IO_write_jobFile(myUnit,newExt) - - use DAMASK_interface, only: getSolverWorkingDirectoryName,& - getSolverJobName +subroutine IO_write_jobFile(myUnit,ext) + use DAMASK_interface, only: & + getSolverWorkingDirectoryName, & + getSolverJobName implicit none - integer(pInt), intent(in) :: myUnit - character(len=*), intent(in) :: newExt + integer(pInt), intent(in) :: myUnit !< file unit + character(len=*), intent(in) :: ext !< extension of file integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt + path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext open(myUnit,status='replace',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) @@ -363,23 +378,23 @@ end subroutine IO_write_jobFile !-------------------------------------------------------------------------------------------------- -!> @brief open (write) binary file of pReal array related to current job with given extension to -!> given unit +!> @brief opens binary file containing array of pReal numbers to given unit for writing. File is +!! named after solver job name plus given extension and located in current working directory !-------------------------------------------------------------------------------------------------- -subroutine IO_write_jobBinaryFile(myUnit,newExt,recMultiplier) - - use DAMASK_interface, only: getSolverWorkingDirectoryName, & - getSolverJobName +subroutine IO_write_jobRealFile(myUnit,ext,recMultiplier) + use DAMASK_interface, only: & + getSolverWorkingDirectoryName, & + getSolverJobName implicit none - integer(pInt), intent(in) :: myUnit - integer(pInt), intent(in), optional :: recMultiplier - character(len=*), intent(in) :: newExt + integer(pInt), intent(in) :: myUnit !< file unit + character(len=*), intent(in) :: ext !< extension of file + integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt + path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext if (present(recMultiplier)) then open(myUnit,status='replace',form='unformatted',access='direct', & recl=pReal*recMultiplier,iostat=myStat,file=path) @@ -390,27 +405,27 @@ subroutine IO_write_jobBinaryFile(myUnit,newExt,recMultiplier) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) -end subroutine IO_write_jobBinaryFile +end subroutine IO_write_jobRealFile !-------------------------------------------------------------------------------------------------- -!> @brief open (write) binary file of pInt array related to current job with given extension to -!> given unit +!> @brief opens binary file containing array of pInt numbers to given unit for writing. File is +!! named after solver job name plus given extension and located in current working directory !-------------------------------------------------------------------------------------------------- -subroutine IO_write_jobBinaryIntFile(myUnit,newExt,recMultiplier) +subroutine IO_write_jobIntFile(myUnit,ext,recMultiplier) use DAMASK_interface, only: & getSolverWorkingDirectoryName, & getSolverJobName implicit none - integer(pInt), intent(in) :: myUnit - integer(pInt), intent(in), optional :: recMultiplier - character(len=*), intent(in) :: newExt + integer(pInt), intent(in) :: myUnit !< file unit + character(len=*), intent(in) :: ext !< extension of file + integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt + path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext if (present(recMultiplier)) then open(myUnit,status='replace',form='unformatted',access='direct', & recl=pInt*recMultiplier,iostat=myStat,file=path) @@ -421,26 +436,27 @@ subroutine IO_write_jobBinaryIntFile(myUnit,newExt,recMultiplier) if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) -end subroutine IO_write_jobBinaryIntFile +end subroutine IO_write_jobIntFile !-------------------------------------------------------------------------------------------------- -!> @brief open (read) binary file of pReal array related to restored job with given extension to -!> given unit +!> @brief opens binary file containing array of pReal numbers to given unit for reading. File is +!! located in current working directory !-------------------------------------------------------------------------------------------------- -subroutine IO_read_jobBinaryFile(myUnit,newExt,jobName,recMultiplier) +subroutine IO_read_realFile(myUnit,ext,modelName,recMultiplier) use DAMASK_interface, only: & getSolverWorkingDirectoryName implicit none - integer(pInt), intent(in) :: myUnit - integer(pInt), intent(in), optional :: recMultiplier - character(len=*), intent(in) :: newExt, jobName + integer(pInt), intent(in) :: myUnit !< file unit + character(len=*), intent(in) :: ext, & !< extension of file + modelName !< model name, in case of restart not solver job name + integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(jobName)//'.'//newExt + path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext if (present(recMultiplier)) then open(myUnit,status='old',form='unformatted',access='direct', & recl=pReal*recMultiplier,iostat=myStat,file=path) @@ -450,26 +466,27 @@ subroutine IO_read_jobBinaryFile(myUnit,newExt,jobName,recMultiplier) endif if (myStat /= 0) call IO_error(100_pInt,ext_msg=path) -end subroutine IO_read_jobBinaryFile +end subroutine IO_read_realFile !-------------------------------------------------------------------------------------------------- -!> @brief open (read) binary file of pInt array related to restored job with given extension to -!> given unit +!> @brief opens binary file containing array of pInt numbers to given unit for reading. File is +!! located in current working directory !-------------------------------------------------------------------------------------------------- -subroutine IO_read_jobBinaryIntFile(myUnit,newExt,jobName,recMultiplier) +subroutine IO_read_intFile(myUnit,ext,modelName,recMultiplier) use DAMASK_interface, only: & getSolverWorkingDirectoryName implicit none - integer(pInt), intent(in) :: myUnit - integer(pInt), intent(in), optional :: recMultiplier - character(len=*), intent(in) :: newExt, jobName + integer(pInt), intent(in) :: myUnit !< file unit + character(len=*), intent(in) :: ext, & !< extension of file + modelName !< model name, in case of restart not solver job name + integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(jobName)//'.'//newExt + path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext if (present(recMultiplier)) then open(myUnit,status='old',form='unformatted',access='direct', & recl=pInt*recMultiplier,iostat=myStat,file=path) @@ -479,7 +496,7 @@ subroutine IO_read_jobBinaryIntFile(myUnit,newExt,jobName,recMultiplier) endif if (myStat /= 0) call IO_error(100_pInt,ext_msg=path) -end subroutine IO_read_jobBinaryIntFile +end subroutine IO_read_intFile #ifdef Abaqus @@ -491,8 +508,8 @@ logical function IO_abaqus_hasNoPart(myUnit) implicit none integer(pInt), intent(in) :: myUnit - integer(pInt), parameter :: maxNchunks = 1_pInt - integer(pInt), dimension(1+2*maxNchunks) :: myPos + integer(pInt), parameter :: MAXNCHUNKS = 1_pInt + integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos character(len=65536) :: line IO_abaqus_hasNoPart = .true. @@ -501,7 +518,7 @@ logical function IO_abaqus_hasNoPart(myUnit) rewind(myUnit) do read(myUnit,610,END=620) line - myPos = IO_stringPos(line,maxNchunks) + myPos = IO_stringPos(line,MAXNCHUNKS) if (IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) then IO_abaqus_hasNoPart = .false. exit @@ -517,10 +534,9 @@ logical function IO_abaqus_hasNoPart(myUnit) function IO_hybridIA(Nast,ODFfileName) implicit none - integer(pInt), intent(in) :: Nast - real(pReal), dimension(3,Nast) :: IO_hybridIA - - character(len=*), intent(in) :: ODFfileName + integer(pInt), intent(in) :: Nast !< number of samples? + real(pReal), dimension(3,Nast) :: IO_hybridIA + character(len=*), intent(in) :: ODFfileName !< name of ODF file including total path !-------------------------------------------------------------------------------------------------- ! math module is not available @@ -589,20 +605,16 @@ function IO_hybridIA(Nast,ODFfileName) dg_0 = deltas(1)*deltas(3)*2.0_pReal*sin(deltas(2)/2.0_pReal) NnonZero = 0_pInt - do phi1=1_pInt,steps(1) - do Phi=1_pInt,steps(2) - do phi2=1_pInt,steps(3) - read(999,fmt=*,end=100) prob - if (prob > 0.0_pReal) then - NnonZero = NnonZero+1_pInt - sum_dV_V = sum_dV_V+prob - else - prob = 0.0_pReal - endif - dV_V(phi2,Phi,phi1) = prob*dg_0*sin((Phi-1.0_pReal+center)*deltas(2)) - enddo - enddo - enddo + do phi1=1_pInt,steps(1); do Phi=1_pInt,steps(2); do phi2=1_pInt,steps(3) + read(999,fmt=*,end=100) prob + if (prob > 0.0_pReal) then + NnonZero = NnonZero+1_pInt + sum_dV_V = sum_dV_V+prob + else + prob = 0.0_pReal + endif + dV_V(phi2,Phi,phi1) = prob*dg_0*sin((Phi-1.0_pReal+center)*deltas(2)) + enddo; enddo; enddo dV_V = dV_V/sum_dV_V ! normalize to 1 @@ -657,9 +669,9 @@ function IO_hybridIA(Nast,ODFfileName) j = i endif bin = binSet(j) - IO_hybridIA(1,i) = deltas(1)*(real(mod(bin/(steps(3)*steps(2)),steps(1)),pReal)+center) ! phi1 - IO_hybridIA(2,i) = deltas(2)*(real(mod(bin/ steps(3) ,steps(2)),pReal)+center) ! Phi - IO_hybridIA(3,i) = deltas(3)*(real(mod(bin ,steps(3)),pReal)+center) ! phi2 + IO_hybridIA(1,i) = deltas(1)*(real(mod(bin/(steps(3)*steps(2)),steps(1)),pReal)+center) ! phi1 + IO_hybridIA(2,i) = deltas(2)*(real(mod(bin/ steps(3) ,steps(2)),pReal)+center) ! Phi + IO_hybridIA(3,i) = deltas(3)*(real(mod(bin ,steps(3)),pReal)+center) ! phi2 binSet(j) = binSet(i) enddo @@ -669,72 +681,72 @@ end function IO_hybridIA !-------------------------------------------------------------------------------------------------- -!> @brief identifies lines without content +!> @brief identifies strings without content !-------------------------------------------------------------------------------------------------- -logical pure function IO_isBlank(line) +logical pure function IO_isBlank(string) implicit none - character(len=*), intent(in) :: line + character(len=*), intent(in) :: string !< string to check for content character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces character(len=*), parameter :: comment = achar(35) ! comment id '#' integer :: posNonBlank, posComment ! no pInt - posNonBlank = verify(line,blankChar) - posComment = scan(line,comment) + posNonBlank = verify(string,blankChar) + posComment = scan(string,comment) IO_isBlank = posNonBlank == 0 .or. posNonBlank == posComment end function IO_isBlank !-------------------------------------------------------------------------------------------------- -!> @brief get tagged content of line +!> @brief get tagged content of string !-------------------------------------------------------------------------------------------------- -pure function IO_getTag(line,openChar,closeChar) +pure function IO_getTag(string,openChar,closeChar) implicit none - character(len=*), intent(in) :: line - character(len=len_trim(line)) :: IO_getTag + character(len=*), intent(in) :: string !< string to check for tag + character(len=len_trim(string)) :: IO_getTag - character(len=*), intent(in) :: openChar, & - closeChar + character(len=*), intent(in) :: openChar, & !< indicates beginning of tag + closeChar !< indicates end of tag - character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces + character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces integer :: left,right ! no pInt IO_getTag = '' - left = scan(line,openChar) - right = scan(line,closeChar) + left = scan(string,openChar) + right = scan(string,closeChar) - if (left == verify(line,sep) .and. right > left) & ! openChar is first and closeChar occurs - IO_getTag = line(left+1:right-1) + if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs + IO_getTag = string(left+1:right-1) end function IO_getTag !-------------------------------------------------------------------------------------------------- -!> @brief count sections in given part +!> @brief count number of [sections] in for given file handle !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countSections(myFile,part) +integer(pInt) function IO_countSections(myUnit,part) implicit none - integer(pInt), intent(in) :: myFile - character(len=*), intent(in) :: part + integer(pInt), intent(in) :: myUnit !< file handle + character(len=*), intent(in) :: part !< part name in which sections are counted character(len=65536) :: line line = '' IO_countSections = 0_pInt - rewind(myFile) + rewind(myUnit) - do while (trim(line) /= '#EOF#' .and. IO_getTag(line,'<','>') /= part) ! search for part - line = IO_read(myFile) + do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part + line = IO_read(myUnit) enddo - do while (trim(line) /= '#EOF#') - line = IO_read(myFile) + do while (trim(line) /= IO_EOF) + line = IO_read(myUnit) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier @@ -745,44 +757,41 @@ end function IO_countSections !-------------------------------------------------------------------------------------------------- -!> @brief return array of myTag counts within for at most N[sections] +!> @brief returns array of tag counts within for at most N [sections] !-------------------------------------------------------------------------------------------------- -function IO_countTagInPart(myFile,part,myTag,Nsections) +function IO_countTagInPart(myUnit,part,tag,Nsections) implicit none - integer(pInt), intent(in) :: Nsections + integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for integer(pInt), dimension(Nsections) :: IO_countTagInPart - - integer(pInt), intent(in) :: myFile - character(len=*),intent(in) :: part, & - myTag + integer(pInt), intent(in) :: myUnit !< file handle + character(len=*),intent(in) :: part, & !< part in which tag is searched for + tag !< tag to search for - integer(pInt), parameter :: maxNchunks = 1_pInt + integer(pInt), parameter :: MAXNCHUNKS = 1_pInt integer(pInt), dimension(Nsections) :: counter - integer(pInt), dimension(1+2*maxNchunks) :: positions + integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions integer(pInt) :: section - character(len=65536) :: line, & - tag + character(len=65536) :: line + line = '' counter = 0_pInt section = 0_pInt - rewind(myFile) - do while (trim(line) /= '#EOF#' .and. IO_getTag(line,'<','>') /= part) ! search for part - line = IO_read(myFile) + rewind(myUnit) + do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part + line = IO_read(myUnit) enddo - do while (trim(line) /= '#EOF#') - line = IO_read(myFile) + do while (trim(line) /= IO_EOF) + line = IO_read(myUnit) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part - if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier - section = section + 1_pInt + if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section > 0) then - positions = IO_stringPos(line,maxNchunks) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key - if (tag == myTag) & ! match + positions = IO_stringPos(line,MAXNCHUNKS) + if (tag == trim(IO_lc(IO_stringValue(line,positions,1_pInt)))) & ! match counter(section) = counter(section) + 1_pInt endif enddo @@ -793,87 +802,80 @@ end function IO_countTagInPart !-------------------------------------------------------------------------------------------------- -!> @brief return array of myTag presence within for at most N[sections] +!> @brief returns array of tag presence within for at most N [sections] !-------------------------------------------------------------------------------------------------- -function IO_spotTagInPart(myFile,part,myTag,Nsections) +function IO_spotTagInPart(myUnit,part,tag,Nsections) implicit none - integer(pInt), intent(in) :: Nsections - logical, dimension(Nsections) :: IO_spotTagInPart - - integer(pInt), intent(in) :: myFile - character(len=*), intent(in) :: part, & - myTag + integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for + logical, dimension(Nsections) :: IO_spotTagInPart + integer(pInt), intent(in) :: myUnit !< file handle + character(len=*),intent(in) :: part, & !< part in which tag is searched for + tag !< tag to search for - integer(pInt), parameter :: maxNchunks = 1_pInt + integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension(1+2*maxNchunks) :: positions + integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions integer(pInt) :: section - character(len=65536) :: line, & - tag + character(len=65536) :: line IO_spotTagInPart = .false. ! assume to nowhere spot tag section = 0_pInt line ='' - rewind(myFile) - do while (trim(line) /= '#EOF#' .and. IO_getTag(line,'<','>') /= part) ! search for part - line = IO_read(myFile) + rewind(myUnit) + do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part + line = IO_read(myUnit) enddo - do while (trim(line) /= '#EOF#') - line = IO_read(myFile) + do while (trim(line) /= IO_EOF) + line = IO_read(myUnit) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part - if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier - section = section + 1_pInt + if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section > 0_pInt) then - positions = IO_stringPos(line,maxNchunks) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key - if (tag == myTag) & ! match + positions = IO_stringPos(line,MAXNCHUNKS) + if (tag == trim(IO_lc(IO_stringValue(line,positions,1_pInt)))) & ! matsch ! match IO_spotTagInPart(section) = .true. - endif + endif enddo end function IO_spotTagInPart !-------------------------------------------------------------------------------------------------- -!> @brief return logical whether myTag is present within before any [sections] +!> @brief return logical whether tag is present within before any [sections] !-------------------------------------------------------------------------------------------------- -logical function IO_globalTagInPart(myFile,part,myTag) +logical function IO_globalTagInPart(myUnit,part,tag) implicit none - integer(pInt), intent(in) :: myFile - character(len=*), intent(in) :: part, & - myTag + integer(pInt), intent(in) :: myUnit !< file handle + character(len=*),intent(in) :: part, & !< part in which tag is searched for + tag !< tag to search for - integer(pInt), parameter :: maxNchunks = 1_pInt + integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension(1+2*maxNchunks) :: positions + integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions integer(pInt) :: section - character(len=65536) :: line, & - tag + character(len=65536) :: line IO_globalTagInPart = .false. ! assume to nowhere spot tag section = 0_pInt line ='' - rewind(myFile) - do while (trim(line) /= '#EOF#' .and. IO_getTag(line,'<','>') /= part) ! search for part - line = IO_read(myFile) + rewind(myUnit) + do while (trim(line) /= IO_EOF .and. IO_getTag(line,'<','>') /= part) ! search for part + line = IO_read(myUnit) enddo - do while (trim(line) /= '#EOF#') - line = IO_read(myFile) + do while (trim(line) /= IO_EOF) + line = IO_read(myUnit) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part - if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier - section = section + 1_pInt + if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section == 0_pInt) then - positions = IO_stringPos(line,maxNchunks) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key - if (tag == myTag) & ! match + positions = IO_stringPos(line,MAXNCHUNKS) + if (tag == trim(IO_lc(IO_stringValue(line,positions,1_pInt)))) & ! match IO_globalTagInPart = .true. endif enddo @@ -881,76 +883,19 @@ logical function IO_globalTagInPart(myFile,part,myTag) end function IO_globalTagInPart - !-------------------------------------------------------------------------------------------------- -!> @brief verify integer value in given string +!> @brief locates at most N space-separated parts in string and returns array containing number of +!! parts in string and the left/right positions of at most N to be used by IO_xxxVal +!! IMPORTANT: first element contains number of chunks! !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_verifyIntValue (line,validChars,myName) - - implicit none - character(len=*), intent(in) :: line,validChars,myName - integer(pInt) :: readStatus, invalidWhere - character(len=len(trim(adjustl(line)))) :: trimmed - - trimmed = trim(adjustl(line)) - IO_verifyIntValue = 0_pInt - - invalidWhere = verify(trimmed,validChars) - if (invalidWhere == 0_pInt) then - read(UNIT=trimmed,iostat=readStatus,FMT=*) IO_verifyIntValue ! no offending chars found - if (readStatus /= 0_pInt) & ! error during string to float conversion - call IO_warning(203,ext_msg=myName//'"'//trimmed//'"') - else - call IO_warning(202,ext_msg=myName//'"'//trimmed//'"') ! complain about offending characters - read(UNIT=trimmed(1_pInt:invalidWhere-1_pInt),iostat=readStatus,FMT=*) IO_verifyIntValue ! interpret remaining string - if (readStatus /= 0_pInt) & ! error during string to float conversion - call IO_warning(203,ext_msg=myName//'"'//trimmed(1_pInt:invalidWhere-1_pInt)//'"') - endif - -end function IO_verifyIntValue - - -!-------------------------------------------------------------------------------------------------- -!> @brief verify float value in given string -!-------------------------------------------------------------------------------------------------- -real(pReal) function IO_verifyFloatValue (line,validChars,myName) - - implicit none - character(len=*), intent(in) :: line,validChars,myName - integer(pInt) :: readStatus, invalidWhere - character(len=len(trim(adjustl(line)))) :: trimmed - - trimmed = trim(adjustl(line)) - IO_verifyFloatValue = 0.0_pReal - - invalidWhere = verify(trimmed,validChars) - if (invalidWhere == 0_pInt) then - read(UNIT=trimmed,iostat=readStatus,FMT=*) IO_verifyFloatValue ! no offending chars found - if (readStatus /= 0_pInt) & ! error during string to float conversion - call IO_warning(203,ext_msg=myName//'"'//trimmed//'"') - else - call IO_warning(202,ext_msg=myName//'"'//trimmed//'"') ! complain about offending characters - read(UNIT=trimmed(1_pInt:invalidWhere-1_pInt),iostat=readStatus,FMT=*) IO_verifyFloatValue ! interpret remaining string - if (readStatus /= 0_pInt) & ! error during string to float conversion - call IO_warning(203,ext_msg=myName//'"'//trimmed(1_pInt:invalidWhere-1_pInt)//'"') - endif - -end function IO_verifyFloatValue - - -!-------------------------------------------------------------------------------------------------- -!> @brief locate at most N space-separated parts in line return array containing number of parts -!> in line and the left/right positions of at most N to be used by IO_xxxVal -!> IMPORTANT: first element contains number of chunks! -!-------------------------------------------------------------------------------------------------- -pure function IO_stringPos(line,N) +pure function IO_stringPos(string,N) implicit none - integer(pInt), intent(in) :: N + integer(pInt), intent(in) :: N !< maximum number of parts integer(pInt), dimension(1_pInt+N*2_pInt) :: IO_stringPos - character(len=*), intent(in) :: line + character(len=*), intent(in) :: string !< string in which parts are searched for - character(len=*), parameter :: sep=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces + character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces integer :: left, right ! no pInt (verify and scan return default integer) @@ -958,10 +903,10 @@ pure function IO_stringPos(line,N) IO_stringPos(1) = 0_pInt right = 0 - do while (verify(line(right+1:),sep)>0) - left = right + verify(line(right+1:),sep) - right = left + scan(line(left:),sep) - 2 - if ( line(left:left) == '#' ) then + do while (verify(string(right+1:),SEP)>0) + left = right + verify(string(right+1:),SEP) + right = left + scan(string(left:),SEP) - 2 + if ( string(left:left) == '#' ) then exit endif if ( IO_stringPos(1) @brief read string value at myPos from line +!> @brief reads string value at myPos from string !-------------------------------------------------------------------------------------------------- -function IO_stringValue(line,positions,myPos,silent) +function IO_stringValue(string,positions,myPos,silent) implicit none - character(len=*), intent(in) :: line - integer(pInt), dimension(:), intent(in) :: positions - integer(pInt), intent(in) :: myPos - logical, optional,intent(in) :: silent - character(len=16), parameter :: myName = 'IO_stringValue: ' + integer(pInt), dimension(:), intent(in) :: positions !< positions of tags in string + integer(pInt), intent(in) :: myPos !< position of desired sub string character(len=1+positions(myPos*2+1)-positions(myPos*2)) :: IO_stringValue + character(len=*), intent(in) :: string !< raw input with known positions + logical, optional,intent(in) :: silent !< switch to trigger verbosity + character(len=16), parameter :: MYNAME = 'IO_stringValue: ' + logical :: warn if (.not. present(silent)) then @@ -996,97 +942,99 @@ function IO_stringValue(line,positions,myPos,silent) IO_stringValue = '' if (myPos > positions(1) .or. myPos < 1_pInt) then ! trying to access non-present value - if (warn) call IO_warning(201,e=myPos,ext_msg=myName//trim(line)) + if (warn) call IO_warning(201,el=myPos,ext_msg=MYNAME//trim(string)) else - IO_stringValue = line(positions(myPos*2):positions(myPos*2+1)) + IO_stringValue = string(positions(myPos*2):positions(myPos*2+1)) endif end function IO_stringValue !-------------------------------------------------------------------------------------------------- -!> @brief read string value at myPos from fixed format line +!> @brief reads string value at myPos from fixed format string !-------------------------------------------------------------------------------------------------- -pure function IO_fixedStringValue (line,ends,myPos) +pure function IO_fixedStringValue (string,ends,myPos) implicit none - integer(pInt), intent(in) :: myPos - integer(pInt), dimension(:), intent(in) :: ends + integer(pInt), intent(in) :: myPos !< position of desired sub string + integer(pInt), dimension(:), intent(in) :: ends !< positions of ends in string character(len=ends(myPos+1)-ends(myPos)) :: IO_fixedStringValue - character(len=*), intent(in) :: line + character(len=*), intent(in) :: string !< raw input with known ends - IO_fixedStringValue = line(ends(myPos)+1:ends(myPos+1)) + IO_fixedStringValue = string(ends(myPos)+1:ends(myPos+1)) end function IO_fixedStringValue !-------------------------------------------------------------------------------------------------- -!> @brief read float value at myPos from line +!> @brief reads float value at myPos from string !-------------------------------------------------------------------------------------------------- -real(pReal) function IO_floatValue (line,positions,myPos) +real(pReal) function IO_floatValue (string,positions,myPos) implicit none - character(len=*), intent(in) :: line - integer(pInt), dimension(:), intent(in) :: positions - integer(pInt), intent(in) :: myPos - character(len=15), parameter :: myName = 'IO_floatValue: ' - character(len=17), parameter :: validCharacters = '0123456789eEdD.+-' + integer(pInt), dimension(:), intent(in) :: positions !< positions of tags in string + integer(pInt), intent(in) :: myPos !< position of desired sub string + character(len=1+positions(myPos*2+1)-positions(myPos*2)) :: IO_stringValue + character(len=*), intent(in) :: string !< raw input with known positions + character(len=15), parameter :: MYNAME = 'IO_floatValue: ' + character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' IO_floatValue = 0.0_pReal - if (myPos > positions(1) .or. myPos < 1_pInt) then ! trying to access non-present value - call IO_warning(201,e=myPos,ext_msg=myName//trim(line)) + if (myPos > positions(1) .or. myPos < 1_pInt) then ! trying to access non-present value + call IO_warning(201,el=myPos,ext_msg=MYNAME//trim(string)) else - IO_floatValue = IO_verifyFloatValue(line(positions(myPos*2):positions(myPos*2+1)),& - validCharacters,myName) + IO_floatValue = IO_verifyFloatValue(string(positions(myPos*2):positions(myPos*2+1)),& + VALIDCHARACTERS,MYNAME) endif end function IO_floatValue !-------------------------------------------------------------------------------------------------- -!> @brief read float value at myPos from fixed format line +!> @brief reads float value at myPos from fixed format string !-------------------------------------------------------------------------------------------------- -real(pReal) function IO_fixedFloatValue (line,ends,myPos) +real(pReal) function IO_fixedFloatValue (string,ends,myPos) implicit none - character(len=*), intent(in) :: line - integer(pInt), intent(in) :: myPos - integer(pInt), dimension(:), intent(in) :: ends - character(len=20), parameter :: myName = 'IO_fixedFloatValue: ' - character(len=17), parameter :: validCharacters = '0123456789eEdD.+-' + character(len=*), intent(in) :: string !< raw input with known ends + integer(pInt), intent(in) :: myPos !< position of desired sub string + integer(pInt), dimension(:), intent(in) :: ends !< positions of ends in string + character(len=20), parameter :: MYNAME = 'IO_fixedFloatValue: ' + character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' - IO_fixedFloatValue = IO_verifyFloatValue(line(ends(myPos)+1_pInt:ends(myPos+1_pInt)),& - validCharacters,myName) + IO_fixedFloatValue = IO_verifyFloatValue(string(ends(myPos)+1_pInt:ends(myPos+1_pInt)),& + VALIDCHARACTERS,MYNAME) end function IO_fixedFloatValue !-------------------------------------------------------------------------------------------------- -!> @brief read float x.y+z value at myPos from format line +!> @brief reads float x.y+z value at myPos from format string !-------------------------------------------------------------------------------------------------- -real(pReal) function IO_fixedNoEFloatValue (line,ends,myPos) +real(pReal) function IO_fixedNoEFloatValue (string,ends,myPos) implicit none - character(len=*), intent(in) :: line - integer(pInt), intent(in) :: myPos - integer(pInt), dimension(:), intent(in) :: ends - character(len=22), parameter :: myName = 'IO_fixedNoEFloatValue ' - character(len=13), parameter :: validBase = '0123456789.+-' - character(len=12), parameter :: validExp = '0123456789+-' + character(len=*), intent(in) :: string !< raw input with known ends + integer(pInt), intent(in) :: myPos !< position of desired sub string + integer(pInt), dimension(:), intent(in) :: ends !< positions of ends in string + character(len=22), parameter :: MYNAME = 'IO_fixedNoEFloatValue ' + character(len=13), parameter :: VALIDBASE = '0123456789.+-' + character(len=12), parameter :: VALIDEXP = '0123456789+-' + real(pReal) :: base integer(pInt) :: expon integer :: pos_exp - pos_exp = scan(line(ends(myPos)+1:ends(myPos+1)),'+-',back=.true.) + pos_exp = scan(string(ends(myPos)+1:ends(myPos+1)),'+-',back=.true.) if (pos_exp > 1) then - base = IO_verifyFloatValue(line(ends(myPos)+1_pInt:ends(myPos)+pos_exp-1_pInt),& - validBase,myName//'(base): ') - expon = IO_verifyIntValue(line(ends(myPos)+pos_exp:ends(myPos+1_pInt)),& - validExp,myName//'(exp): ') + base = IO_verifyFloatValue(string(ends(myPos)+1_pInt:ends(myPos)+pos_exp-1_pInt),& + VALIDBASE,MYNAME//'(base): ') + expon = IO_verifyIntValue(string(ends(myPos)+pos_exp:ends(myPos+1_pInt)),& + VALIDEXP,MYNAME//'(exp): ') else - base = IO_verifyFloatValue(line(ends(myPos)+1_pInt:ends(myPos+1_pInt)),& - validBase,myName//'(base): ') + base = IO_verifyFloatValue(string(ends(myPos)+1_pInt:ends(myPos+1_pInt)),& + VALIDBASE,MYNAME//'(base): ') expon = 0_pInt endif IO_fixedNoEFloatValue = base*10.0_pReal**real(expon,pReal) @@ -1095,88 +1043,90 @@ end function IO_fixedNoEFloatValue !-------------------------------------------------------------------------------------------------- -!> @brief read int value at myPos from line +!> @brief reads integer value at myPos from string !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_intValue(line,positions,myPos) +integer(pInt) function IO_intValue(string,ends,myPos) implicit none - character(len=*), intent(in) :: line - integer(pInt), dimension(:), intent(in) :: positions - integer(pInt), intent(in) :: myPos - character(len=13), parameter :: myName = 'IO_intValue: ' - character(len=12), parameter :: validCharacters = '0123456789+-' + character(len=*), intent(in) :: string !< raw input with known ends + integer(pInt), intent(in) :: myPos !< position of desired sub string + integer(pInt), dimension(:), intent(in) :: ends !< positions of ends in string + character(len=13), parameter :: MYNAME = 'IO_intValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' IO_intValue = 0_pInt - if (myPos > positions(1) .or. myPos < 1_pInt) then ! trying to access non-present value - call IO_warning(201,e=myPos,ext_msg=myName//trim(line)) + if (myPos > ends(1) .or. myPos < 1_pInt) then ! trying to access non-present value + call IO_warning(201,el=myPos,ext_msg=MYNAME//trim(string)) else - IO_intValue = IO_verifyIntValue(line(positions(myPos*2):positions(myPos*2+1)),& - validCharacters,myName) + IO_intValue = IO_verifyIntValue(string(ends(myPos*2):ends(myPos*2+1)),& + VALIDCHARACTERS,MYNAME) endif end function IO_intValue !-------------------------------------------------------------------------------------------------- -!> @brief read int value at myPos from fixed format line +!> @brief reads integer value at myPos from fixed format string !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_fixedIntValue(line,ends,myPos) +integer(pInt) function IO_fixedIntValue(string,ends,myPos) implicit none - character(len=*), intent(in) :: line - integer(pInt), intent(in) :: myPos - integer(pInt), dimension(:), intent(in) :: ends - character(len=20), parameter :: myName = 'IO_fixedIntValue: ' - character(len=12), parameter :: validCharacters = '0123456789+-' + character(len=*), intent(in) :: string !< raw input with known ends + integer(pInt), intent(in) :: myPos !< position of desired sub string + integer(pInt), dimension(:), intent(in) :: ends !< positions of ends in string + character(len=20), parameter :: MYNAME = 'IO_fixedIntValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - IO_fixedIntValue = IO_verifyIntValue(line(ends(myPos)+1_pInt:ends(myPos+1_pInt)),& - validCharacters,myName) + IO_fixedIntValue = IO_verifyIntValue(string(ends(myPos)+1_pInt:ends(myPos+1_pInt)),& + VALIDCHARACTERS,MYNAME) end function IO_fixedIntValue !-------------------------------------------------------------------------------------------------- -!> @brief change character in line to lower case +!> @brief changes characters in string to lower case !-------------------------------------------------------------------------------------------------- -pure function IO_lc(line) +pure function IO_lc(string) implicit none - character(26), parameter :: lower = 'abcdefghijklmnopqrstuvwxyz' - character(26), parameter :: upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - character(len=*), intent(in) :: line - character(len=len(line)) :: IO_lc + character(len=*), intent(in) :: string !< string to convert + character(len=len(string)) :: IO_lc + + character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' + character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' integer :: i,n ! no pInt (len returns default integer) - IO_lc = line - do i=1,len(line) - n = index(upper,IO_lc(i:i)) - if (n/=0) IO_lc(i:i) = lower(n:n) + IO_lc = string + do i=1,len(string) + n = index(UPPER,IO_lc(i:i)) + if (n/=0) IO_lc(i:i) = LOWER(n:n) enddo end function IO_lc !-------------------------------------------------------------------------------------------------- -!> @brief in place change of character in line to lower case +!> @brief changes character string to lower case in place !-------------------------------------------------------------------------------------------------- -pure subroutine IO_lcInplace(line) +pure subroutine IO_lcInplace(string) implicit none - character(26), parameter :: lower = 'abcdefghijklmnopqrstuvwxyz' - character(26), parameter :: upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - character(len=*), intent(inout) :: line - character(len=len(line)) :: IO_lc + character(len=*), intent(inout) :: string !< string to convert in place + character(len=len(string)) :: IO_lc - integer :: i,n ! no pInt (len returns default integer) + character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' + character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - do i=1,len(line) - n = index(upper,line(i:i)) + integer :: i,n ! no pInt (len returns default integer) + + do i=1,len(string) + n = index(UPPER,string(i:i)) if (n/=0) then - IO_lc(i:i) = lower(n:n) + IO_lc(i:i) = LOWER(n:n) else - IO_lc(i:i) = line(i:i) + IO_lc(i:i) = string(i:i) endif enddo @@ -1184,47 +1134,47 @@ end subroutine IO_lcInplace !-------------------------------------------------------------------------------------------------- -!> @brief read on in file to skip (at least) N chunks (may be over multiple lines) +!> @brief reads file to skip (at least) N chunks (may be over multiple lines) !-------------------------------------------------------------------------------------------------- subroutine IO_skipChunks(myUnit,N) implicit none - integer(pInt), intent(in) :: myUnit, & - N + integer(pInt), intent(in) :: myUnit, & !< file handle + N !< minimum number of chunks to skip - integer(pInt), parameter :: maxNchunks = 64_pInt + integer(pInt), parameter :: MAXNCHUNKS = 64_pInt integer(pInt) :: remainingChunks - integer(pInt), dimension(1+2*maxNchunks) :: myPos + integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos character(len=65536) :: line remainingChunks = N - do while (remainingChunks > 0) - read(myUnit,'(a65536)',end=100) line - myPos = IO_stringPos(line,maxNchunks) + do while (trim(line) /= IO_EOF .and. remainingChunks > 0) + line = IO_read(myUnit) + myPos = IO_stringPos(line,MAXNCHUNKS) remainingChunks = remainingChunks - myPos(1) enddo -100 end subroutine IO_skipChunks +end subroutine IO_skipChunks !-------------------------------------------------------------------------------------------------- -!> @brief extract value from key=value pair and check whether key matches +!> @brief extracts string value from key=value pair and check whether key matches !-------------------------------------------------------------------------------------------------- -character(len=300) pure function IO_extractValue(line,key) +character(len=300) pure function IO_extractValue(pair,key) implicit none - character(len=*), intent(in) :: line, & - key + character(len=*), intent(in) :: pair, & !< key=value pair + key !< key to be expected - character(len=*), parameter :: sep = achar(61) ! '=' + character(len=*), parameter :: SEP = achar(61) ! '=' integer :: myPos ! no pInt (scan returns default integer) IO_extractValue = '' - myPos = scan(line,sep) - if (myPos > 0 .and. line(:myPos-1) == key(:myPos-1)) & ! key matches expected key - IO_extractValue = line(myPos+1:) ! extract value + myPos = scan(pair,SEP) + if (myPos > 0 .and. pair(:myPos-1) == key(:myPos-1)) & ! key matches expected key + IO_extractValue = pair(myPos+1:) ! extract value end function IO_extractValue @@ -1235,11 +1185,11 @@ end function IO_extractValue integer(pInt) function IO_countDataLines(myUnit) implicit none - integer(pInt), intent(in) :: myUnit + integer(pInt), intent(in) :: myUnit !< file handle - integer(pInt), parameter :: maxNchunks = 1_pInt + integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension(1+2*maxNchunks) :: myPos + integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos character(len=65536) :: line, & tmp @@ -1247,7 +1197,7 @@ integer(pInt) function IO_countDataLines(myUnit) do read(myUnit,'(A65536)',end=100) line - myPos = IO_stringPos(line,maxNchunks) + myPos = IO_stringPos(line,MAXNCHUNKS) tmp = IO_lc(IO_stringValue(line,myPos,1_pInt)) if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword exit @@ -1271,19 +1221,19 @@ integer(pInt) function IO_countContinuousIntValues(myUnit) implicit none integer(pInt), intent(in) :: myUnit - integer(pInt), parameter :: maxNchunks = 8192_pInt + integer(pInt), parameter :: MAXNCHUNKS = 8192_pInt #ifdef Abaqus integer(pInt) :: l,c #endif - integer(pInt), dimension(1+2*maxNchunks) :: myPos + integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos character(len=65536) :: line IO_countContinuousIntValues = 0_pInt #ifndef Abaqus - do - read(myUnit,'(A65536)',end=100) line - myPos = IO_stringPos(line,maxNchunks) + do while (trim(line) /= IO_EOF) + read(myUnit,'(A65536)') line + myPos = IO_stringPos(line,MAXNCHUNKS) if (myPos(1) < 1_pInt) then ! empty line exit elseif (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator @@ -1304,19 +1254,21 @@ integer(pInt) function IO_countContinuousIntValues(myUnit) #else c = IO_countDataLines(myUnit) do l = 1_pInt,c - backspace(myUnit) + backspace(myUnit) ! ToDo: substitute by rewind? enddo - - do l = 1_pInt,c - read(myUnit,'(A65536)',end=100) line - myPos = IO_stringPos(line,maxNchunks) + + l = 1_pInt + do while (trim(line) /= IO_EOF and l <= c) ! ToDo: is this correct + l = l + 1_pInt + read(myUnit,'(A65536)') line + myPos = IO_stringPos(line,MAXNCHUNKS) IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation (IO_intValue(line,myPos,2_pInt)-IO_intValue(line,myPos,1_pInt))/& max(1_pInt,IO_intValue(line,myPos,3_pInt)) enddo #endif -100 end function IO_countContinuousIntValues +end function IO_countContinuousIntValues !-------------------------------------------------------------------------------------------------- @@ -1336,13 +1288,13 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN) lookupMaxN integer(pInt), dimension(:,:), intent(in) :: lookupMap character(len=64), dimension(:), intent(in) :: lookupName - integer(pInt), parameter :: maxNchunks = 8192_pInt + integer(pInt), parameter :: MAXNCHUNKS = 8192_pInt integer(pInt) :: i #ifdef Abaqus integer(pInt) :: j,l,c,first,last #endif - integer(pInt), dimension(1+2*maxNchunks) :: myPos + integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos character(len=65536) line logical rangeGeneration @@ -1352,7 +1304,7 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN) #ifndef Abaqus do read(myUnit,'(A65536)',end=100) line - myPos = IO_stringPos(line,maxNchunks) + myPos = IO_stringPos(line,MAXNCHUNKS) if (myPos(1) < 1_pInt) then ! empty line exit elseif (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name @@ -1395,14 +1347,14 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN) ! check if the element values in the elset are auto generated backspace(myUnit) read(myUnit,'(A65536)',end=100) line - myPos = IO_stringPos(line,maxNchunks) + myPos = IO_stringPos(line,MAXNCHUNKS) do i = 1_pInt,myPos(1) if (IO_lc(IO_stringValue(line,myPos,i)) == 'generate') rangeGeneration = .true. enddo do l = 1_pInt,c read(myUnit,'(A65536)',end=100) line - myPos = IO_stringPos(line,maxNchunks) + myPos = IO_stringPos(line,MAXNCHUNKS) if (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line do i = 1_pInt,myPos(1) ! loop over set names in line do j = 1_pInt,lookupMaxN ! look thru known set names @@ -1464,10 +1416,10 @@ end function IO_timeStamp !> @brief write error statements to standard out and terminate the Marc/spectral run with exit #9xxx !> in ABAQUS either time step is reduced or execution terminated !-------------------------------------------------------------------------------------------------- -subroutine IO_error(error_ID,e,i,g,ext_msg) +subroutine IO_error(error_ID,el,ip,g,ext_msg) implicit none integer(pInt), intent(in) :: error_ID - integer(pInt), optional, intent(in) :: e,i,g + integer(pInt), optional, intent(in) :: el,ip,g character(len=*), optional, intent(in) :: ext_msg character(len=1024) :: msg @@ -1685,37 +1637,35 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) max(1,60-len(trim(ext_msg))-5),'x,a)' write(6,formatString) '+ ', trim(ext_msg),'+' endif - if (present(e)) then - if (present(i)) then + if (present(el)) then + if (present(ip)) then if (present(g)) then - write(6,'(a13,1x,i9,1x,a2,1x,i2,1x,a5,1x,i4,18x,a1)') ' + at element',e,'IP',i,'grain',g,'+' + write(6,'(a13,1x,i9,1x,a2,1x,i2,1x,a5,1x,i4,18x,a1)') ' + at element',el,'IP',ip,'grain',g,'+' else - write(6,'(a13,1x,i9,1x,a2,1x,i2,29x,a1)') ' + at element',e,'IP',i,'+' + write(6,'(a13,1x,i9,1x,a2,1x,i2,29x,a1)') ' + at element',el,'IP',ip,'+' endif else - write(6,'(a13,1x,i9,35x,a1)') ' + at element',e,'+' + write(6,'(a13,1x,i9,35x,a1)') ' + at element',el,'+' endif - elseif (present(i)) then ! now having the meaning of "instance" - write(6,'(a15,1x,i9,33x,a1)') ' + for instance',i,'+' + elseif (present(ip)) then ! now having the meaning of "instance" + write(6,'(a15,1x,i9,33x,a1)') ' + for instance',ip,'+' endif write(6,'(a)') ' +--------------------------------------------------------+' flush(6) call quit(9000_pInt+error_ID) !$OMP END CRITICAL (write2out) -! ABAQUS returns in some cases - end subroutine IO_error !-------------------------------------------------------------------------------------------------- -!> @brief write warning statements to standard out +!> @brief writes warning statement to standard out !-------------------------------------------------------------------------------------------------- -subroutine IO_warning(warning_ID,e,i,g,ext_msg) +subroutine IO_warning(warning_ID,el,ip,g,ext_msg) implicit none integer(pInt), intent(in) :: warning_ID - integer(pInt), optional, intent(in) :: e,i,g + integer(pInt), optional, intent(in) :: el,ip,g character(len=*), optional, intent(in) :: ext_msg character(len=1024) :: msg @@ -1771,15 +1721,15 @@ subroutine IO_warning(warning_ID,e,i,g,ext_msg) max(1,60-len(trim(ext_msg))-5),'x,a)' write(6,formatString) '+ ', trim(ext_msg),'+' endif - if (present(e)) then - if (present(i)) then + if (present(el)) then + if (present(ip)) then if (present(g)) then - write(6,'(a13,1x,i9,1x,a2,1x,i2,1x,a5,1x,i4,18x,a1)') ' + at element',e,'IP',i,'grain',g,'+' + write(6,'(a13,1x,i9,1x,a2,1x,i2,1x,a5,1x,i4,18x,a1)') ' + at element',el,'IP',ip,'grain',g,'+' else - write(6,'(a13,1x,i9,1x,a2,1x,i2,29x,a1)') ' + at element',e,'IP',i,'+' + write(6,'(a13,1x,i9,1x,a2,1x,i2,29x,a1)') ' + at element',el,'IP',ip,'+' endif else - write(6,'(a13,1x,i9,35x,a1)') ' + at element',e,'+' + write(6,'(a13,1x,i9,35x,a1)') ' + at element',el,'+' endif endif write(6,'(a)') ' +--------------------------------------------------------+' @@ -1792,30 +1742,113 @@ end subroutine IO_warning !-------------------------------------------------------------------------------------------------- ! internal helper functions +!-------------------------------------------------------------------------------------------------- +!> @brief returns verified integer value in given string +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_verifyIntValue (string,validChars,myName) + + implicit none + character(len=*), intent(in) :: string, & !< string for conversion to float value + validChars, & !< valid characters in string + myName !< name of caller function (for debugging) + integer(pInt) :: readStatus, invalidWhere + character(len=len(trim(adjustl(string)))) :: trimmed + + trimmed = trim(adjustl(string)) + IO_verifyIntValue = 0_pInt + invalidWhere = verify(trimmed,validChars) + if (invalidWhere == 0_pInt) then + read(UNIT=trimmed,iostat=readStatus,FMT=*) IO_verifyIntValue ! no offending chars found + if (readStatus /= 0_pInt) & ! error during string to float conversion + call IO_warning(203,ext_msg=myName//'"'//trimmed//'"') + else + call IO_warning(202,ext_msg=myName//'"'//trimmed//'"') ! complain about offending characters + read(UNIT=trimmed(1_pInt:invalidWhere-1_pInt),iostat=readStatus,FMT=*) IO_verifyIntValue ! interpret remaining string + if (readStatus /= 0_pInt) & ! error during string to float conversion + call IO_warning(203,ext_msg=myName//'"'//trimmed(1_pInt:invalidWhere-1_pInt)//'"') + endif + +end function IO_verifyIntValue + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns verified float value in given string +!-------------------------------------------------------------------------------------------------- +real(pReal) function IO_verifyFloatValue (string,validChars,myName) + + implicit none + character(len=*), intent(in) :: string, & !< string for conversion to int value + validChars, & !< valid characters in string + myName !< name of caller function (for debugging) + + integer(pInt) :: readStatus, invalidWhere + character(len=len(trim(adjustl(string)))) :: trimmed + + trimmed = trim(adjustl(string)) + IO_verifyFloatValue = 0.0_pReal + + invalidWhere = verify(trimmed,validChars) + if (invalidWhere == 0_pInt) then + read(UNIT=trimmed,iostat=readStatus,FMT=*) IO_verifyFloatValue ! no offending chars found + if (readStatus /= 0_pInt) & ! error during string to float conversion + call IO_warning(203,ext_msg=myName//'"'//trimmed//'"') + else + call IO_warning(202,ext_msg=myName//'"'//trimmed//'"') ! complain about offending characters + read(UNIT=trimmed(1_pInt:invalidWhere-1_pInt),iostat=readStatus,FMT=*) IO_verifyFloatValue ! interpret remaining string + if (readStatus /= 0_pInt) & ! error during string to float conversion + call IO_warning(203,ext_msg=myName//'"'//trimmed(1_pInt:invalidWhere-1_pInt)//'"') + endif + +end function IO_verifyFloatValue + + +!-------------------------------------------------------------------------------------------------- +!> @brief counts hybrid IA repetitions +!-------------------------------------------------------------------------------------------------- +integer(pInt) pure function hybridIA_reps(dV_V,steps,C) + + implicit none + integer(pInt), intent(in), dimension(3) :: steps !< needs description + real(pReal), intent(in), dimension(steps(3),steps(2),steps(1)) :: dV_V !< needs description + real(pReal), intent(in) :: C !< needs description + + integer(pInt) :: phi1,Phi,phi2 + + hybridIA_reps = 0_pInt + do phi1=1_pInt,steps(1) + do Phi =1_pInt,steps(2) + do phi2=1_pInt,steps(3) + hybridIA_reps = hybridIA_reps+nint(C*dV_V(phi2,Phi,phi1), pInt) + enddo + enddo + enddo + +end function hybridIA_reps + #ifdef Abaqus !-------------------------------------------------------------------------------------------------- !> @brief create a new input file for abaqus simulations by removing all comment lines and !> including "include"s !-------------------------------------------------------------------------------------------------- recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) - - use DAMASK_interface, only: getSolverWorkingDirectoryName + use DAMASK_interface, only: & + getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: unit1, & unit2 - integer(pInt), parameter :: maxNchunks = 6_pInt + integer(pInt), parameter :: MAXNCHUNKS = 6_pInt - integer(pInt), dimension(1+2*maxNchunks) :: positions - character(len=65536) :: line,fname + integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + character(len=65536) :: line,fname logical :: createSuccess,fexist do read(unit2,'(A65536)',END=220) line - positions = IO_stringPos(line,maxNchunks) + positions = IO_stringPos(line,MAXNCHUNKS) if (IO_lc(IO_StringValue(line,positions,1_pInt))=='*include') then fname = trim(getSolverWorkingDirectoryName())//trim(line(9+scan(line(9:),'='):)) @@ -1849,30 +1882,4 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) end function abaqus_assembleInputFile #endif - -!-------------------------------------------------------------------------------------------------- -!> @brief hybrid IA repetition counter -!-------------------------------------------------------------------------------------------------- -integer(pInt) pure function hybridIA_reps(dV_V,steps,C) - - implicit none - integer(pInt), intent(in), dimension(3) :: & - steps - real(pReal), intent(in), dimension(steps(3),steps(2),steps(1)) :: & - dV_V - real(pReal), intent(in) :: & - C - integer(pInt) :: phi1,Phi,phi2 - - hybridIA_reps = 0_pInt - do phi1=1_pInt,steps(1) - do Phi =1_pInt,steps(2) - do phi2=1_pInt,steps(3) - hybridIA_reps = hybridIA_reps+nint(C*dV_V(phi2,Phi,phi1), pInt) - enddo - enddo - enddo - -end function hybridIA_reps - end module IO diff --git a/code/constitutive.f90 b/code/constitutive.f90 index 69d24433c..90f6022c4 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -92,7 +92,7 @@ subroutine constitutive_init IO_open_file, & IO_open_jobFile_stat, & IO_write_jobFile, & - IO_write_jobBinaryIntFile, & + IO_write_jobIntFile, & IO_timeStamp use mesh, only: & mesh_maxNips, & @@ -426,7 +426,7 @@ subroutine constitutive_init !-------------------------------------------------------------------------------------------------- ! write out state size file - call IO_write_jobBinaryIntFile(777,'sizeStateConst', size(constitutive_sizeState)) + call IO_write_jobIntFile(777,'sizeStateConst', size(constitutive_sizeState)) write (777,rec=1) constitutive_sizeState close(777) diff --git a/code/constitutive_dislotwin.f90 b/code/constitutive_dislotwin.f90 index 7d1be917f..18fcc4945 100644 --- a/code/constitutive_dislotwin.f90 +++ b/code/constitutive_dislotwin.f90 @@ -489,48 +489,48 @@ enddo myStructure = constitutive_dislotwin_structure(i) !* Sanity checks - if (myStructure < 1_pInt) call IO_error(205_pInt,e=i) - if (sum(constitutive_dislotwin_Nslip(:,i)) < 0_pInt) call IO_error(211_pInt,e=i,ext_msg='Nslip (' & - //constitutive_dislotwin_label//')') - if (sum(constitutive_dislotwin_Ntwin(:,i)) < 0_pInt) call IO_error(211_pInt,e=i,ext_msg='Ntwin (' & - //constitutive_dislotwin_label//')') + if (myStructure < 1_pInt) call IO_error(205_pInt,el=i) + if (sum(constitutive_dislotwin_Nslip(:,i)) < 0_pInt) call IO_error(211_pInt,el=i,ext_msg='Nslip (' & + //constitutive_dislotwin_label//')') + if (sum(constitutive_dislotwin_Ntwin(:,i)) < 0_pInt) call IO_error(211_pInt,el=i,ext_msg='Ntwin (' & + //constitutive_dislotwin_label//')') do f = 1_pInt,lattice_maxNslipFamily if (constitutive_dislotwin_Nslip(f,i) > 0_pInt) then - if (constitutive_dislotwin_rhoEdge0(f,i) < 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='rhoEdge0 (' & - //constitutive_dislotwin_label//')') - if (constitutive_dislotwin_rhoEdgeDip0(f,i) < 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='rhoEdgeDip0 (' & - //constitutive_dislotwin_label//')') - if (constitutive_dislotwin_burgersPerSlipFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='slipBurgers (' & - //constitutive_dislotwin_label//')') - if (constitutive_dislotwin_v0PerSlipFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='v0 (' & - //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_rhoEdge0(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='rhoEdge0 (' & + //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_rhoEdgeDip0(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='rhoEdgeDip0 (' & + //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_burgersPerSlipFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='slipBurgers (' & + //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_v0PerSlipFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='v0 (' & + //constitutive_dislotwin_label//')') endif enddo do f = 1_pInt,lattice_maxNtwinFamily if (constitutive_dislotwin_Ntwin(f,i) > 0_pInt) then - if (constitutive_dislotwin_burgersPerTwinFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='twinburgers (' & - //constitutive_dislotwin_label//')') - if (constitutive_dislotwin_Ndot0PerTwinFamily(f,i) < 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='ndot0 (' & - //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_burgersPerTwinFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='twinburgers (' & + //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_Ndot0PerTwinFamily(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='ndot0 (' & + //constitutive_dislotwin_label//')') endif enddo - if (constitutive_dislotwin_CAtomicVolume(i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='cAtomicVolume (' & - //constitutive_dislotwin_label//')') - if (constitutive_dislotwin_D0(i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='D0 (' & - //constitutive_dislotwin_label//')') - if (constitutive_dislotwin_Qsd(i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='Qsd (' & - //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_CAtomicVolume(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='cAtomicVolume (' & + //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_D0(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='D0 (' & + //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_Qsd(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='Qsd (' & + //constitutive_dislotwin_label//')') if (constitutive_dislotwin_SFE_0K(i) == 0.0_pReal .and. & - constitutive_dislotwin_dSFE_dT(i) == 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='SFE (' & - //constitutive_dislotwin_label//')') - if (constitutive_dislotwin_aTolRho(i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='aTolRho (' & - //constitutive_dislotwin_label//')') - if (constitutive_dislotwin_aTolTwinFrac(i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='aTolTwinFrac (' & - //constitutive_dislotwin_label//')') - if (constitutive_dislotwin_sbResistance(i) < 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='sbResistance (' & - //constitutive_dislotwin_label//')') - if (constitutive_dislotwin_sbVelocity(i) < 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='sbVelocity (' & - //constitutive_dislotwin_label//')') + constitutive_dislotwin_dSFE_dT(i) == 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='SFE (' & + //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_aTolRho(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='aTolRho (' & + //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_aTolTwinFrac(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='aTolTwinFrac (' & + //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_sbResistance(i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='sbResistance (' & + //constitutive_dislotwin_label//')') + if (constitutive_dislotwin_sbVelocity(i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='sbVelocity (' & + //constitutive_dislotwin_label//')') !* Determine total number of active slip or twin systems constitutive_dislotwin_Nslip(:,i) = min(lattice_NslipSystem(:,myStructure),constitutive_dislotwin_Nslip(:,i)) diff --git a/code/constitutive_j2.f90 b/code/constitutive_j2.f90 index ecc6b6218..a89b4e4f6 100644 --- a/code/constitutive_j2.f90 +++ b/code/constitutive_j2.f90 @@ -261,7 +261,7 @@ subroutine constitutive_j2_init(myFile) enddo sanityChecks: do i = 1_pInt,maxNinstance - if (constitutive_j2_structureName(i) == '') call IO_error(205_pInt,e=i) + if (constitutive_j2_structureName(i) == '') call IO_error(205_pInt,el=i) if (constitutive_j2_tau0(i) < 0.0_pReal) call IO_error(211_pInt,ext_msg='tau0 (' & //CONSTITUTIVE_J2_label//')') if (constitutive_j2_gdot0(i) <= 0.0_pReal) call IO_error(211_pInt,ext_msg='gdot0 (' & diff --git a/code/constitutive_none.f90 b/code/constitutive_none.f90 index ff67330f3..b0c431b29 100644 --- a/code/constitutive_none.f90 +++ b/code/constitutive_none.f90 @@ -172,7 +172,7 @@ subroutine constitutive_none_init(myFile) enddo do i = 1_pInt,maxNinstance - if (constitutive_none_structureName(i) == '') call IO_error(205_pInt,e=i) + if (constitutive_none_structureName(i) == '') call IO_error(205_pInt,el=i) enddo instancesLoop: do i = 1_pInt,maxNinstance diff --git a/code/constitutive_nonlocal.f90 b/code/constitutive_nonlocal.f90 index 8a0efb6c1..63125ccf4 100644 --- a/code/constitutive_nonlocal.f90 +++ b/code/constitutive_nonlocal.f90 @@ -611,7 +611,7 @@ do i = 1_pInt,maxNinstance !*** sanity checks if (myStructure < 1_pInt) & - call IO_error(205_pInt,e=i) + call IO_error(205_pInt,el=i) if (sum(Nslip(:,i)) <= 0_pInt) & call IO_error(211_pInt,ext_msg='Nslip ('//CONSTITUTIVE_NONLOCAL_LABEL//')') do o = 1_pInt,maxval(phase_Noutput) diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90 index 3c96b79f3..96db64048 100644 --- a/code/constitutive_phenopowerlaw.f90 +++ b/code/constitutive_phenopowerlaw.f90 @@ -27,8 +27,7 @@ module constitutive_phenopowerlaw use prec, only: & pReal,& - pInt,& - tol_math_check + pInt implicit none private @@ -119,6 +118,8 @@ contains !-------------------------------------------------------------------------------------------------- subroutine constitutive_phenopowerlaw_init(myFile) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use prec, only: & + tol_math_check use math, only: & math_Mandel3333to66, & math_Voigt66to3333 @@ -429,28 +430,28 @@ subroutine constitutive_phenopowerlaw_init(myFile) constitutive_phenopowerlaw_totalNslip(i) = sum(constitutive_phenopowerlaw_Nslip(:,i)) ! how many slip systems altogether constitutive_phenopowerlaw_totalNtwin(i) = sum(constitutive_phenopowerlaw_Ntwin(:,i)) ! how many twin systems altogether - if (constitutive_phenopowerlaw_structure(i) < 1 ) call IO_error(205_pInt,i=i) + if (constitutive_phenopowerlaw_structure(i) < 1 ) call IO_error(205_pInt,el=i) if (any(constitutive_phenopowerlaw_tau0_slip(:,i) < 0.0_pReal .and. & - constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='tau0_slip (' & + constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,el=i,ext_msg='tau0_slip (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') - if (constitutive_phenopowerlaw_gdot0_slip(i) <= 0.0_pReal) call IO_error(211_pInt,i=i,ext_msg='gdot0_slip (' & + if (constitutive_phenopowerlaw_gdot0_slip(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='gdot0_slip (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') - if (constitutive_phenopowerlaw_n_slip(i) <= 0.0_pReal) call IO_error(211_pInt,i=i,ext_msg='n_slip (' & + if (constitutive_phenopowerlaw_n_slip(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='n_slip (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if (any(constitutive_phenopowerlaw_tausat_slip(:,i) <= 0.0_pReal .and. & - constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='tausat_slip (' & + constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,el=i,ext_msg='tausat_slip (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if (any(constitutive_phenopowerlaw_a_slip(i) == 0.0_pReal .and. & - constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='a_slip (' & + constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,el=i,ext_msg='a_slip (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if (any(constitutive_phenopowerlaw_tau0_twin(:,i) < 0.0_pReal .and. & - constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='tau0_twin (' & + constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,el=i,ext_msg='tau0_twin (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if ( constitutive_phenopowerlaw_gdot0_twin(i) <= 0.0_pReal .and. & - any(constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='gdot0_twin (' & + any(constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,el=i,ext_msg='gdot0_twin (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if ( constitutive_phenopowerlaw_n_twin(i) <= 0.0_pReal .and. & - any(constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='n_twin (' & + any(constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,el=i,ext_msg='n_twin (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if (constitutive_phenopowerlaw_aTolResistance(i) <= 0.0_pReal) & constitutive_phenopowerlaw_aTolResistance(i) = 1.0_pReal ! default absolute tolerance 1 Pa diff --git a/code/constitutive_titanmod.f90 b/code/constitutive_titanmod.f90 index 306baa541..5c8a65f95 100644 --- a/code/constitutive_titanmod.f90 +++ b/code/constitutive_titanmod.f90 @@ -615,58 +615,59 @@ subroutine constitutive_titanmod_init(myFile) lattice_initializeStructure(constitutive_titanmod_structureName(i),constitutive_titanmod_CoverA(i)) myStructure = constitutive_titanmod_structure(i) - if (myStructure < 1_pInt) call IO_error(205_pInt,e=i) - if (sum(constitutive_titanmod_Nslip(:,i)) <= 0_pInt) call IO_error(211_pInt,e=i,ext_msg='nslip (' & + if (myStructure < 1_pInt) call IO_error(205_pInt,el=i) + if (sum(constitutive_titanmod_Nslip(:,i)) <= 0_pInt) call IO_error(211_pInt,el=i,ext_msg='nslip (' & //CONSTITUTIVE_TITANMOD_label//')') - if (sum(constitutive_titanmod_Ntwin(:,i)) < 0_pInt) call IO_error(211_pInt,e=i,ext_msg='ntwin (' & + if (sum(constitutive_titanmod_Ntwin(:,i)) < 0_pInt) call IO_error(211_pInt,el=i,ext_msg='ntwin (' & //CONSTITUTIVE_TITANMOD_label//')') do f = 1_pInt,lattice_maxNslipFamily if (constitutive_titanmod_Nslip(f,i) > 0_pInt) then - if (constitutive_titanmod_rho_edge0(f,i) < 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='rho_edge0 (' & + if (constitutive_titanmod_rho_edge0(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='rho_edge0 (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_rho_screw0(f,i) < 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='rho_screw0 (' & + if (constitutive_titanmod_rho_screw0(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='rho_screw0 (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_burgersPerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='slipburgers (' & + if (constitutive_titanmod_burgersPerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='slipburgers (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_f0_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='f0 (' & + if (constitutive_titanmod_f0_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='f0 (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_tau0e_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='tau0e (' & + if (constitutive_titanmod_tau0e_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='tau0e (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_tau0s_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='tau0s (' & + if (constitutive_titanmod_tau0s_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='tau0s (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_capre_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='capre (' & + if (constitutive_titanmod_capre_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='capre (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_caprs_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='caprs (' & + if (constitutive_titanmod_caprs_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='caprs (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_v0e_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='v0e (' & + if (constitutive_titanmod_v0e_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='v0e (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_v0s_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='v0s (' & + if (constitutive_titanmod_v0s_PerSlipFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='v0s (' & //CONSTITUTIVE_TITANMOD_label//')') if (constitutive_titanmod_kinkcriticallength_PerSlipFam(f,i) <= 0.0_pReal) & - call IO_error(211_pInt,e=i,ext_msg='kinkCriticalLength (' & + call IO_error(211_pInt,el=i,ext_msg='kinkCriticalLength (' & //CONSTITUTIVE_TITANMOD_label//')') endif enddo do f = 1_pInt,lattice_maxNtwinFamily if (constitutive_titanmod_Ntwin(f,i) > 0_pInt) then - if (constitutive_titanmod_burgersPerTwinFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='twinburgers (' & + if (constitutive_titanmod_burgersPerTwinFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='twinburgers (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_twinf0_PerTwinFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='twinf0 (' & + if (constitutive_titanmod_twinf0_PerTwinFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='twinf0 (' & //CONSTITUTIVE_TITANMOD_label//')') if (constitutive_titanmod_twinshearconstant_PerTwinFam(f,i) <= 0.0_pReal) & - call IO_error(211_pInt,e=i,ext_msg='twinshearconstant (' & + call IO_error(211_pInt,el=i,ext_msg='twinshearconstant (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_twintau0_PerTwinFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='twintau0 (' & + if (constitutive_titanmod_twintau0_PerTwinFam(f,i) <= 0.0_pReal)call IO_error(211_pInt,el=i,ext_msg='twintau0 (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_twingamma0_PerTwinFam(f,i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='twingamma0 (' & + if (constitutive_titanmod_twingamma0_PerTwinFam(f,i) <= 0.0_pReal) & + call IO_error(211_pInt,el=i,ext_msg='twingamma0 (' & //CONSTITUTIVE_TITANMOD_label//')') endif enddo - if (constitutive_titanmod_dc(i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='dc (' & + if (constitutive_titanmod_dc(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='dc (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_twinhpconstant(i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='twinhpconstant (' & + if (constitutive_titanmod_twinhpconstant(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='twinhpconstant (' & //CONSTITUTIVE_TITANMOD_label//')') - if (constitutive_titanmod_aTolRho(i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='aTolRho (' & + if (constitutive_titanmod_aTolRho(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='aTolRho (' & //CONSTITUTIVE_TITANMOD_label//')') !* Determine total number of active slip or twin systems diff --git a/code/homogenization.f90 b/code/homogenization.f90 index f6a498b31..64abf2690 100644 --- a/code/homogenization.f90 +++ b/code/homogenization.f90 @@ -104,7 +104,7 @@ subroutine homogenization_init(Temperature) IO_open_file, & IO_open_jobFile_stat, & IO_write_jobFile, & - IO_write_jobBinaryIntFile, & + IO_write_jobIntFile, & IO_timeStamp use mesh, only: & mesh_maxNips, & @@ -235,7 +235,7 @@ subroutine homogenization_init(Temperature) !-------------------------------------------------------------------------------------------------- ! write state size file out - call IO_write_jobBinaryIntFile(777,'sizeStateHomog',size(homogenization_sizeState)) + call IO_write_jobIntFile(777,'sizeStateHomog',size(homogenization_sizeState)) write (777,rec=1) homogenization_sizeState close(777) diff --git a/code/material.f90 b/code/material.f90 index a8c4fb103..4bfb0e411 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -878,7 +878,7 @@ subroutine material_populateGrains enddo if (grain /= myNgrains) & - call IO_error(0,e = homog,i = micro,ext_msg = 'inconsistent grain count after volume calc') + call IO_error(0,el = homog,ip = micro,ext_msg = 'inconsistent grain count after volume calc') !-------------------------------------------------------------------------------------------------- ! divide myNgrains as best over constituents diff --git a/code/mesh.f90 b/code/mesh.f90 index 962a5e7ff..9c2fda46e 100644 --- a/code/mesh.f90 +++ b/code/mesh.f90 @@ -1413,10 +1413,10 @@ function mesh_regrid(adaptive,resNewInput,minRes) GeometryFile use IO, only: & IO_open_file, & - IO_read_jobBinaryFile ,& - IO_read_jobBinaryIntFile ,& - IO_write_jobBinaryFile, & - IO_write_jobBinaryIntFile, & + IO_read_realFile ,& + IO_read_intFile ,& + IO_write_jobRealFile, & + IO_write_jobIntFile, & IO_write_jobFile, & IO_error use numerics, only: & @@ -1495,14 +1495,14 @@ function mesh_regrid(adaptive,resNewInput,minRes) select case(myspectralsolver) case('basic') allocate(spectralF33(3,3,grid(1),grid(2),grid(3))) - call IO_read_jobBinaryFile(777,'F',trim(getSolverJobName()),size(spectralF33)) + call IO_read_realFile(777,'F',trim(getSolverJobName()),size(spectralF33)) read (777,rec=1) spectralF33 close (777) Favg = sum(sum(sum(spectralF33,dim=5),dim=4),dim=3) * wgt coordinates = reshape(mesh_deformedCoordsFFT(geomSize,spectralF33),[3,mesh_NcpElems]) case('basicpetsc','al') allocate(spectralF9(9,grid(1),grid(2),grid(3))) - call IO_read_jobBinaryFile(777,'F',trim(getSolverJobName()),size(spectralF9)) + call IO_read_realFile(777,'F',trim(getSolverJobName()),size(spectralF9)) read (777,rec=1) spectralF9 close (777) Favg = reshape(sum(sum(sum(spectralF9,dim=4),dim=3),dim=2) * wgt, [3,3]) @@ -1648,14 +1648,14 @@ function mesh_regrid(adaptive,resNewInput,minRes) case('basic') allocate(spectralF33New(3,3,resNew(1),resNew(2),resNew(3))) spectralF33New = spread(spread(spread(Favg,3,resNew(1)),4,resNew(2)),5,resNew(3)) - call IO_write_jobBinaryFile(777,'F',size(spectralF33New)) + call IO_write_jobRealFile(777,'F',size(spectralF33New)) write (777,rec=1) spectralF33New close (777) case('basicpetsc','al') allocate(spectralF9New(9,resNew(1),resNew(2),resNew(3))) spectralF9New = spread(spread(spread(reshape(Favg,[9]),2,resNew(1)),3,resNew(2)),4,resNew(3)) - call IO_write_jobBinaryFile(777,'F',size(spectralF9New)) + call IO_write_jobRealFile(777,'F',size(spectralF9New)) write (777,rec=1) spectralF9New close (777) end select @@ -1663,14 +1663,14 @@ function mesh_regrid(adaptive,resNewInput,minRes) !--------------------------------------------------------------------------------- allocate(F_lastIncNew(3,3,resNew(1),resNew(2),resNew(3))) - call IO_read_jobBinaryFile(777,'F_aim_lastInc', & + call IO_read_realFile(777,'F_aim_lastInc', & trim(getSolverJobName()),size(Favg_LastInc)) read (777,rec=1) Favg_LastInc close (777) F_lastIncNew = spread(spread(spread(Favg_LastInc,3,resNew(1)),4,resNew(2)),5,resNew(3)) - call IO_write_jobBinaryFile(777,'convergedSpectralDefgrad_lastInc',size(F_LastIncNew)) + call IO_write_jobRealFile(777,'convergedSpectralDefgrad_lastInc',size(F_LastIncNew)) write (777,rec=1) F_LastIncNew close (777) @@ -1679,7 +1679,7 @@ function mesh_regrid(adaptive,resNewInput,minRes) ! relocating data of material subroutine --------------------------------------------------------- allocate(material_phase (1,1, mesh_NcpElems)) allocate(material_phaseNew (1,1, NpointsNew)) - call IO_read_jobBinaryIntFile(777,'recordedPhase',trim(getSolverJobName()),size(material_phase)) + call IO_read_intFile(777,'recordedPhase',trim(getSolverJobName()),size(material_phase)) read (777,rec=1) material_phase close (777) do i = 1, NpointsNew @@ -1691,7 +1691,7 @@ function mesh_regrid(adaptive,resNewInput,minRes) write(6,*) material_phase(1,1,i), 'not found in material_phaseNew' endif enddo - call IO_write_jobBinaryIntFile(777,'recordedPhase',size(material_phaseNew)) + call IO_write_jobIntFile(777,'recordedPhase',size(material_phaseNew)) write (777,rec=1) material_phaseNew close (777) deallocate(material_phase) @@ -1699,14 +1699,14 @@ function mesh_regrid(adaptive,resNewInput,minRes) !--------------------------------------------------------------------------- allocate(F (3,3,1,1, mesh_NcpElems)) allocate(FNew (3,3,1,1, NpointsNew)) - call IO_read_jobBinaryFile(777,'convergedF',trim(getSolverJobName()),size(F)) + call IO_read_realFile(777,'convergedF',trim(getSolverJobName()),size(F)) read (777,rec=1) F close (777) do i = 1, NpointsNew FNew(1:3,1:3,1,1,i) = F(1:3,1:3,1,1,indices(i)) enddo - call IO_write_jobBinaryFile(777,'convergedF',size(FNew)) + call IO_write_jobRealFile(777,'convergedF',size(FNew)) write (777,rec=1) FNew close (777) deallocate(F) @@ -1714,14 +1714,14 @@ function mesh_regrid(adaptive,resNewInput,minRes) !--------------------------------------------------------------------- allocate(Fp (3,3,1,1,mesh_NcpElems)) allocate(FpNew (3,3,1,1,NpointsNew)) - call IO_read_jobBinaryFile(777,'convergedFp',trim(getSolverJobName()),size(Fp)) + call IO_read_realFile(777,'convergedFp',trim(getSolverJobName()),size(Fp)) read (777,rec=1) Fp close (777) do i = 1, NpointsNew FpNew(1:3,1:3,1,1,i) = Fp(1:3,1:3,1,1,indices(i)) enddo - call IO_write_jobBinaryFile(777,'convergedFp',size(FpNew)) + call IO_write_jobRealFile(777,'convergedFp',size(FpNew)) write (777,rec=1) FpNew close (777) deallocate(Fp) @@ -1729,13 +1729,13 @@ function mesh_regrid(adaptive,resNewInput,minRes) !------------------------------------------------------------------------ allocate(Lp (3,3,1,1,mesh_NcpElems)) allocate(LpNew (3,3,1,1,NpointsNew)) - call IO_read_jobBinaryFile(777,'convergedLp',trim(getSolverJobName()),size(Lp)) + call IO_read_realFile(777,'convergedLp',trim(getSolverJobName()),size(Lp)) read (777,rec=1) Lp close (777) do i = 1, NpointsNew LpNew(1:3,1:3,1,1,i) = Lp(1:3,1:3,1,1,indices(i)) enddo - call IO_write_jobBinaryFile(777,'convergedLp',size(LpNew)) + call IO_write_jobRealFile(777,'convergedLp',size(LpNew)) write (777,rec=1) LpNew close (777) deallocate(Lp) @@ -1743,13 +1743,13 @@ function mesh_regrid(adaptive,resNewInput,minRes) !---------------------------------------------------------------------------- allocate(dcsdE (6,6,1,1,mesh_NcpElems)) allocate(dcsdENew (6,6,1,1,NpointsNew)) - call IO_read_jobBinaryFile(777,'convergeddcsdE',trim(getSolverJobName()),size(dcsdE)) + call IO_read_realFile(777,'convergeddcsdE',trim(getSolverJobName()),size(dcsdE)) read (777,rec=1) dcsdE close (777) do i = 1, NpointsNew dcsdENew(1:6,1:6,1,1,i) = dcsdE(1:6,1:6,1,1,indices(i)) enddo - call IO_write_jobBinaryFile(777,'convergeddcsdE',size(dcsdENew)) + call IO_write_jobRealFile(777,'convergeddcsdE',size(dcsdENew)) write (777,rec=1) dcsdENew close (777) deallocate(dcsdE) @@ -1757,13 +1757,13 @@ function mesh_regrid(adaptive,resNewInput,minRes) !--------------------------------------------------------------------------- allocate(dPdF (3,3,3,3,1,1,mesh_NcpElems)) allocate(dPdFNew (3,3,3,3,1,1,NpointsNew)) - call IO_read_jobBinaryFile(777,'convergeddPdF',trim(getSolverJobName()),size(dPdF)) + call IO_read_realFile(777,'convergeddPdF',trim(getSolverJobName()),size(dPdF)) read (777,rec=1) dPdF close (777) do i = 1, NpointsNew dPdFNew(1:3,1:3,1:3,1:3,1,1,i) = dPdF(1:3,1:3,1:3,1:3,1,1,indices(i)) enddo - call IO_write_jobBinaryFile(777,'convergeddPdF',size(dPdFNew)) + call IO_write_jobRealFile(777,'convergeddPdF',size(dPdFNew)) write (777,rec=1) dPdFNew close (777) deallocate(dPdF) @@ -1771,13 +1771,13 @@ function mesh_regrid(adaptive,resNewInput,minRes) !--------------------------------------------------------------------------- allocate(Tstar (6,1,1,mesh_NcpElems)) allocate(TstarNew (6,1,1,NpointsNew)) - call IO_read_jobBinaryFile(777,'convergedTstar',trim(getSolverJobName()),size(Tstar)) + call IO_read_realFile(777,'convergedTstar',trim(getSolverJobName()),size(Tstar)) read (777,rec=1) Tstar close (777) do i = 1, NpointsNew TstarNew(1:6,1,1,i) = Tstar(1:6,1,1,indices(i)) enddo - call IO_write_jobBinaryFile(777,'convergedTstar',size(TstarNew)) + call IO_write_jobRealFile(777,'convergedTstar',size(TstarNew)) write (777,rec=1) TstarNew close (777) deallocate(Tstar) @@ -1785,13 +1785,13 @@ function mesh_regrid(adaptive,resNewInput,minRes) ! for the state, we first have to know the size------------------------------------------------------------------ allocate(sizeStateConst(1,1,mesh_NcpElems)) - call IO_read_jobBinaryIntFile(777,'sizeStateConst',trim(getSolverJobName()),size(sizeStateConst)) + call IO_read_intFile(777,'sizeStateConst',trim(getSolverJobName()),size(sizeStateConst)) read (777,rec=1) sizeStateConst close (777) maxsize = maxval(sizeStateConst(1,1,1:mesh_NcpElems)) allocate(StateConst (1,1,mesh_NcpElems,maxsize)) - call IO_read_jobBinaryFile(777,'convergedStateConst',trim(getSolverJobName())) + call IO_read_realFile(777,'convergedStateConst',trim(getSolverJobName())) k = 0_pInt do i =1, mesh_NcpElems do j = 1,sizeStateConst(1,1,i) @@ -1800,7 +1800,7 @@ function mesh_regrid(adaptive,resNewInput,minRes) enddo enddo close(777) - call IO_write_jobBinaryFile(777,'convergedStateConst') + call IO_write_jobRealFile(777,'convergedStateConst') k = 0_pInt do i = 1,NpointsNew do j = 1,sizeStateConst(1,1,indices(i)) @@ -1813,13 +1813,13 @@ function mesh_regrid(adaptive,resNewInput,minRes) deallocate(StateConst) !---------------------------------------------------------------------------- allocate(sizeStateHomog(1,mesh_NcpElems)) - call IO_read_jobBinaryIntFile(777,'sizeStateHomog',trim(getSolverJobName()),size(sizeStateHomog)) + call IO_read_intFile(777,'sizeStateHomog',trim(getSolverJobName()),size(sizeStateHomog)) read (777,rec=1) sizeStateHomog close (777) maxsize = maxval(sizeStateHomog(1,1:mesh_NcpElems)) allocate(stateHomog (1,mesh_NcpElems,maxsize)) - call IO_read_jobBinaryFile(777,'convergedStateHomog',trim(getSolverJobName())) + call IO_read_realFile(777,'convergedStateHomog',trim(getSolverJobName())) k = 0_pInt do i =1, mesh_NcpElems do j = 1,sizeStateHomog(1,i) @@ -1828,7 +1828,7 @@ function mesh_regrid(adaptive,resNewInput,minRes) enddo enddo close(777) - call IO_write_jobBinaryFile(777,'convergedStateHomog') + call IO_write_jobRealFile(777,'convergedStateHomog') k = 0_pInt do i = 1,NpointsNew do j = 1,sizeStateHomog(1,indices(i)) @@ -4092,8 +4092,8 @@ subroutine mesh_tell_statistics allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2))); mesh_HomogMicro = 0_pInt do e = 1_pInt,mesh_NcpElems - if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,e=e) ! no homogenization specified - if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,e=e) ! no microstructure specified + if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified + if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure enddo