From 800e291240ec3d13c25e9a184c4d6b973349aa2f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 31 Jan 2012 19:18:55 +0000 Subject: [PATCH] made code standard conform to Fortran 2008 (ignoring warning concerning comments beyond character 132). Basically, changing "x" format specifier to "Nx" ("1x") plus removing $ format specifier added compiler switches for gfortran and ifort to check for standard conformity old gnu compilers <4.4 are not longer supported because they don't provide the c binding for fftw --- code/CPFEM.f90 | 32 ++--- code/DAMASK_marc.f90 | 2 +- code/DAMASK_spectral.f90 | 99 +++++++------- code/DAMASK_spectral_interface.f90 | 16 +-- code/IO.f90 | 12 +- code/compilation_info.f90 | 2 +- code/constitutive.f90 | 26 ++-- code/constitutive_dislotwin.f90 | 2 +- code/constitutive_j2.f90 | 4 +- code/constitutive_nonlocal.f90 | 4 +- code/constitutive_phenopowerlaw.f90 | 4 +- code/constitutive_titanmod.f90 | 2 +- code/crystallite.f90 | 202 ++++++++++++++-------------- code/debug.f90 | 58 ++++---- code/homogenization.f90 | 56 ++++---- code/homogenization_RGC.f90 | 120 ++++++++--------- code/homogenization_isostrain.f90 | 2 +- code/lattice.f90 | 6 +- code/makefile | 45 ++++--- code/material.f90 | 16 +-- code/math.f90 | 34 +++-- code/mesh.f90 | 70 +++++----- code/numerics.f90 | 100 +++++++------- code/prec.f90 | 14 +- code/prec_single.f90 | 14 +- 25 files changed, 472 insertions(+), 470 deletions(-) diff --git a/code/CPFEM.f90 b/code/CPFEM.f90 index 90f7c7319..e9beec4bb 100644 --- a/code/CPFEM.f90 +++ b/code/CPFEM.f90 @@ -205,11 +205,11 @@ subroutine CPFEM_init() write(6,*) write(6,*) '<<<+- cpfem init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" if (debug_verbosity > 0) then - write(6,'(a32,x,6(i8,x))') 'CPFEM_cs: ', shape(CPFEM_cs) - write(6,'(a32,x,6(i8,x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE) - write(6,'(a32,x,6(i8,x))') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood) + write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs) + write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE) + write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood) write(6,*) write(6,*) 'parallelExecution: ', parallelExecution write(6,*) 'symmetricSolver: ', symmetricSolver @@ -367,11 +367,11 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP, !$OMP CRITICAL (write2out) write(6,*) write(6,'(a)') '#############################################' - write(6,'(a1,a22,x,f15.7,a6)') '#','theTime',theTime,'#' - write(6,'(a1,a22,x,f15.7,a6)') '#','theDelta',theDelta,'#' - write(6,'(a1,a22,x,i8,a13)') '#','theInc',theInc,'#' - write(6,'(a1,a22,x,i8,a13)') '#','cycleCounter',cycleCounter,'#' - write(6,'(a1,a22,x,i8,a13)') '#','computationMode',mode,'#' + write(6,'(a1,a22,1x,f15.7,a6)') '#','theTime',theTime,'#' + write(6,'(a1,a22,1x,f15.7,a6)') '#','theDelta',theDelta,'#' + write(6,'(a1,a22,1x,i8,a13)') '#','theInc',theInc,'#' + write(6,'(a1,a22,1x,i8,a13)') '#','cycleCounter',cycleCounter,'#' + write(6,'(a1,a22,1x,i8,a13)') '#','computationMode',mode,'#' write(6,'(a)') '#############################################' write(6,*) call flush (6) @@ -404,7 +404,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP, !$OMP CRITICAL (write2out) write(6,'(a)') '<< CPFEM >> Aging states' if (debug_e == cp_en .and. debug_i == IP) then - write(6,'(a,x,i8,x,i2,x,i4,/,(12(x),6(e20.8,x)))') '<< CPFEM >> AGED state of element ip grain',& + write(6,'(a,1x,i8,1x,i2,1x,i4,/,(12x,6(e20.8,1x)))') '<< CPFEM >> AGED state of element ip grain',& cp_en, IP, 1, constitutive_state(1,IP,cp_en)%p write(6,*) endif @@ -492,9 +492,9 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP, if (.not. terminallyIll .and. .not. outdatedFFN1) then if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) - write(6,'(a,x,i8,x,i2)') '<< CPFEM >> OUTDATED at element ip',cp_en,IP - write(6,'(a,/,3(12(x),3(f10.6,x),/))') '<< CPFEM >> FFN1 old:',math_transpose33(materialpoint_F(1:3,1:3,IP,cp_en)) - write(6,'(a,/,3(12(x),3(f10.6,x),/))') '<< CPFEM >> FFN1 now:',math_transpose33(ffn1) + write(6,'(a,1x,i8,1x,i2)') '<< CPFEM >> OUTDATED at element ip',cp_en,IP + write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 old:',math_transpose33(materialpoint_F(1:3,1:3,IP,cp_en)) + write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 now:',math_transpose33(ffn1) !$OMP END CRITICAL (write2out) endif outdatedFFN1 = .true. @@ -519,7 +519,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP, FEsolving_execIP(2,cp_en) = IP if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) - write(6,'(a,i8,x,i2)') '<< CPFEM >> Calculation for element ip ',cp_en,IP + write(6,'(a,i8,1x,i2)') '<< CPFEM >> Calculation for element ip ',cp_en,IP !$OMP END CRITICAL (write2out) endif call materialpoint_stressAndItsTangent(updateJaco, dt) ! calculate stress and its tangent @@ -645,8 +645,8 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP, if (mode < 3 .and. debug_verbosity > 0 .and. ((debug_e == cp_en .and. debug_i == IP) .or. .not. debug_selectiveDebugger)) then !$OMP CRITICAL (write2out) - write(6,'(a,i8,x,i2,/,12(x),6(f10.3,x)/)') '<< CPFEM >> stress/MPa at el ip ', cp_en, IP, cauchyStress/1e6 - write(6,'(a,i8,x,i2,/,6(12(x),6(f10.3,x)/))') '<< CPFEM >> jacobian/GPa at el ip ', cp_en, IP, transpose(jacobian)/1e9 + write(6,'(a,i8,1x,i2,/,12x,6(f10.3,1x)/)') '<< CPFEM >> stress/MPa at el ip ', cp_en, IP, cauchyStress/1e6 + write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') '<< CPFEM >> jacobian/GPa at el ip ', cp_en, IP, transpose(jacobian)/1e9 call flush(6) !$OMP END CRITICAL (write2out) endif diff --git a/code/DAMASK_marc.f90 b/code/DAMASK_marc.f90 index fe5978cfc..63c6e034d 100644 --- a/code/DAMASK_marc.f90 +++ b/code/DAMASK_marc.f90 @@ -73,7 +73,7 @@ subroutine DAMASK_interface_init() write(6,*) write(6,*) '<<<+- DAMASK_marc init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) return end subroutine diff --git a/code/DAMASK_spectral.f90 b/code/DAMASK_spectral.f90 index cf42c3e8e..8d89bffe0 100644 --- a/code/DAMASK_spectral.f90 +++ b/code/DAMASK_spectral.f90 @@ -147,9 +147,7 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! loop variables, convergence etc. real(pReal) :: time = 0.0_pReal, time0 = 0.0_pReal, timeinc ! elapsed time, begin of interval, time interval - real(pReal) :: guessmode, err_div, err_stress, err_stress_tol - complex(pReal), parameter :: differentationFactor = cmplx(0.0_pReal,1.0_pReal)*& ! cmplx(0.0_pReal,2.0_pReal*pi) will give rounding error (wrong type?) - 2.0_pReal * pi + real(pReal) :: guessmode, err_div, err_stress, err_stress_tol real(pReal), dimension(3,3), parameter :: ones = 1.0_pReal, zeroes = 0.0_pReal complex(pReal), dimension(3) :: temp3_Complex complex(pReal), dimension(3,3) :: temp33_Complex @@ -197,7 +195,7 @@ program DAMASK_spectral print '(a)', '' print '(a)', ' <<<+- DAMASK_spectral init -+>>>' print '(a)', ' $Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" print '(a,a)', ' Working Directory: ',trim(getSolverWorkingDirectoryName()) print '(a,a)', ' Solver Job Name: ',trim(getSolverJobName()) print '(a)', '' @@ -413,13 +411,14 @@ program DAMASK_spectral else print '(a)','deformation gradient rate:' endif - print '(3(3(f12.6,x)/)$)', merge(math_transpose33(bc(loadcase)%deformation),& + write (*,'(3(3(f12.7,1x)/))',advance='no') merge(math_transpose33(bc(loadcase)%deformation),& reshape(spread(DAMASK_NaN,1,9),(/3,3/)),transpose(bc(loadcase)%maskDeformation)) - print '(a,/,3(3(f12.6,x)/)$)','stress / GPa:',1e-9*merge(math_transpose33(bc(loadcase)%stress)& - ,reshape(spread(DAMASK_NaN,1,9),(/3,3/))& + write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') ' stress / GPa:',& + 1e-9*merge(math_transpose33(bc(loadcase)%stress),reshape(spread(DAMASK_NaN,1,9),(/3,3/))& ,transpose(bc(loadcase)%maskStress)) if (any(bc(loadcase)%rotation /= math_I3)) & - print '(a,3(3(f12.6,x)/)$)','rotation of loadframe:',math_transpose33(bc(loadcase)%rotation) + write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') ' rotation of loadframe:',& + math_transpose33(bc(loadcase)%rotation) print '(a,f12.6)','temperature:',bc(loadcase)%temperature print '(a,f12.6)','time: ',bc(loadcase)%time print '(a,i5)' ,'increments: ',bc(loadcase)%incs @@ -667,25 +666,25 @@ program DAMASK_spectral ! write header of output file open(538,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())& //'.spectralOut',form='UNFORMATTED',status='REPLACE') - write(538), 'load', trim(getLoadcaseName()) - write(538), 'workingdir', trim(getSolverWorkingDirectoryName()) - write(538), 'geometry', trim(getSolverJobName())//InputFileExtension - write(538), 'resolution', res - write(538), 'dimension', geomdim - write(538), 'materialpoint_sizeResults', materialpoint_sizeResults - write(538), 'loadcases', N_Loadcases - write(538), 'frequencies', bc(1:N_Loadcases)%outputfrequency ! one entry per loadcase - write(538), 'times', bc(1:N_Loadcases)%time ! one entry per loadcase - write(538), 'logscales', bc(1:N_Loadcases)%logscale + write(538) 'load', trim(getLoadcaseName()) + write(538) 'workingdir', trim(getSolverWorkingDirectoryName()) + write(538) 'geometry', trim(getSolverJobName())//InputFileExtension + write(538) 'resolution', res + write(538) 'dimension', geomdim + write(538) 'materialpoint_sizeResults', materialpoint_sizeResults + write(538) 'loadcases', N_Loadcases + write(538) 'frequencies', bc(1:N_Loadcases)%outputfrequency ! one entry per loadcase + write(538) 'times', bc(1:N_Loadcases)%time ! one entry per loadcase + write(538) 'logscales', bc(1:N_Loadcases)%logscale bc(1)%incs = bc(1)%incs + 1_pInt ! additional for zero deformation - write(538), 'increments', bc(1:N_Loadcases)%incs ! one entry per loadcase + write(538) 'increments', bc(1:N_Loadcases)%incs ! one entry per loadcase bc(1)%incs = bc(1)%incs - 1_pInt - write(538), 'startingIncrement', restartReadInc ! start with writing out the previous inc + write(538) 'startingIncrement', restartReadInc ! start with writing out the previous inc - write(538), 'eoh' ! end of header - write(538), materialpoint_results(1_pInt:materialpoint_sizeResults,1,1_pInt:Npoints) ! initial (non-deformed or read-in) results + write(538) 'eoh' ! end of header + write(538) materialpoint_results(1_pInt:materialpoint_sizeResults,1,1_pInt:Npoints) ! initial (non-deformed or read-in) results + if (debugGeneral) print '(a)' , 'Header of result file written out' endif - if (debugGeneral) print '(a)' , 'Header of result file written out' if(totalIncsCounter > restartReadInc) then ! Do calculations (otherwise just forwarding) if(bc(loadcase)%restartFrequency>0_pInt) & @@ -793,7 +792,7 @@ program DAMASK_spectral do n = 1_pInt,3_pInt; do m = 1_pInt,3_pInt defgrad_av_lab(m,n) = sum(defgrad(1:res(1),1:res(2),1:res(3),m,n)) * wgt enddo; enddo - print '(a,/,3(3(f12.7,x)/)$)', 'deformation gradient:',& + write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient:',& math_transpose33(math_rotate_forward33(defgrad_av_lab,bc(loadcase)%rotation)) print '(a)', '' print '(a)', '... update stress field P(F) ................................' @@ -868,8 +867,8 @@ program DAMASK_spectral ! comparing 1 and 3x3 FT results if (debugFFTW) then call fftw_execute_dft_r2c(plan_scalarField_forth,scalarField_real,scalarField_complex) - print '(a,i1,x,i1)', 'checking FT results of compontent ', row, column - print '(a,2(es10.4,x))', 'max FT relative error ',& + print '(a,i1,1x,i1)', 'checking FT results of compontent ', row, column + print '(a,2(es10.4,1x))', 'max FT relative error ',& maxval( real((scalarField_complex(1:res1_red,1:res(2),1:res(3))-& tensorField_complex(1:res1_red,1:res(2),1:res(3),row,column))/& scalarField_complex(1:res1_red,1:res(2),1:res(3)))), & @@ -887,22 +886,22 @@ program DAMASK_spectral do i = 2_pInt, res1_red -1_pInt ! Has somewhere a conj. complex counterpart. Therefore count it twice. err_div_RMS = err_div_RMS & + 2.0_pReal*(sum (real(math_mul33x3_complex(tensorField_complex(i,j,k,1:3,1:3),& ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2. do not take square root and square again - xi(1:3,i,j,k))*differentationFactor)**2.0_pReal)&! --> sum squared L_2 norm of vector + xi(1:3,i,j,k))*two_pi_img)**2.0_pReal)& ! --> sum squared L_2 norm of vector +sum(aimag(math_mul33x3_complex(tensorField_complex(i,j,k,1:3,1:3),& - xi(1:3,i,j,k))*differentationFactor)**2.0_pReal)) + xi(1:3,i,j,k))*two_pi_img)**2.0_pReal)) enddo err_div_RMS = err_div_RMS & ! Those two layers do not have a conjugate complex counterpart + sum(real(math_mul33x3_complex(tensorField_complex(1 ,j,k,1:3,1:3),& - xi(1:3,1 ,j,k))*differentationFactor)**2.0_pReal)& + xi(1:3,1 ,j,k))*two_pi_img)**2.0_pReal)& + sum(aimag(math_mul33x3_complex(tensorField_complex(1 ,j,k,1:3,1:3),& - xi(1:3,1 ,j,k))*differentationFactor)**2.0_pReal)& + xi(1:3,1 ,j,k))*two_pi_img)**2.0_pReal)& + sum(real(math_mul33x3_complex(tensorField_complex(res1_red,j,k,1:3,1:3),& - xi(1:3,res1_red,j,k))*differentationFactor)**2.0_pReal)& + xi(1:3,res1_red,j,k))*two_pi_img)**2.0_pReal)& + sum(aimag(math_mul33x3_complex(tensorField_complex(res1_red,j,k,1:3,1:3),& - xi(1:3,res1_red,j,k))*differentationFactor)**2.0_pReal) + xi(1:3,res1_red,j,k))*two_pi_img)**2.0_pReal) enddo; enddo - err_div_RMS = sqrt(err_div_RMS)*wgt ! RMS in real space calculated with Parsevals theorem from Fourier space - err_div = err_div_RMS/p_hat_avg/sqrt(wgt) * correctionFactor ! criterion to stop iterations + err_div_RMS = sqrt(err_div_RMS)*wgt ! RMS in real space calculated with Parsevals theorem from Fourier space + err_div = err_div_RMS/p_hat_avg/sqrt(wgt) * correctionFactor ! criterion to stop iterations !-------------------------------------------------------------------------------------------------- ! calculate additional divergence criteria and report @@ -910,7 +909,7 @@ program DAMASK_spectral err_div_max = 0.0_pReal do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res1_red temp3_Complex = math_mul33x3_complex(tensorField_complex(i,j,k,1:3,1:3),& - xi(1:3,i,j,k))*differentationFactor + xi(1:3,i,j,k))*two_pi_img err_div_max = max(err_div_max,sqrt(sum(abs(temp3_Complex)**2.0_pReal))) divergence_complex(i,j,k,1:3) = temp3_Complex ! need divergence NOT squared enddo; enddo; enddo @@ -991,7 +990,7 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! comparing 1 and 3x3 inverse FT results if (debugFFTW) then - print '(a,i1,x,i1)', 'checking iFT results of compontent ', row, column + print '(a,i1,1x,i1)', 'checking iFT results of compontent ', row, column call fftw_execute_dft_c2r(plan_scalarField_back,scalarField_complex,scalarField_real) print '(a,es10.4)', 'max iFT relative error ',& maxval((scalarField_real(1:res(1),1:res(2),1:res(3))-& @@ -1012,11 +1011,11 @@ program DAMASK_spectral maxval(math_skew33(tensorField_real(i,j,k,1:3,1:3)))) temp33_Real = temp33_Real + tensorField_real(i,j,k,1:3,1:3) enddo; enddo; enddo - print '(a,x,es10.4)' , 'max symmetrix correction of deformation:',& + print '(a,1x,es10.4)' , 'max symmetrix correction of deformation:',& maxCorrectionSym*wgt - print '(a,x,es10.4)' , 'max skew correction of deformation:',& + print '(a,1x,es10.4)' , 'max skew correction of deformation:',& maxCorrectionSkew*wgt - print '(a,x,es10.4)' , 'max sym/skew of avg correction: ',& + print '(a,1x,es10.4)' , 'max sym/skew of avg correction: ',& maxval(math_symmetric33(temp33_real))/& maxval(math_skew33(temp33_real)) endif @@ -1040,7 +1039,8 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! stress BC handling pstress_av = math_rotate_forward33(pstress_av_lab,bc(loadcase)%rotation) - print '(a,/,3(3(f12.7,x)/)$)', 'Piola-Kirchhoff stress / MPa:',math_transpose33(pstress_av)/1.e6 + write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') ' Piola-Kirchhoff stress / MPa:',& + math_transpose33(pstress_av)/1.e6 if(size_reduced > 0_pInt) then ! calculate stress BC if applied err_stress = maxval(abs(mask_stress * (pstress_av - bc(loadcase)%stress))) ! maximum deviaton (tensor norm not applicable) @@ -1050,8 +1050,9 @@ program DAMASK_spectral print '(a,es10.4,a,f6.2)', 'error stress = ',err_stress, ', rel. error = ', err_stress/err_stress_tol defgradAimCorr = - math_mul3333xx33(s_prev, ((pstress_av - bc(loadcase)%stress))) ! residual on given stress components defgradAim = defgradAim + defgradAimCorr - print '(a,/,3(3(f12.7,x)/)$)', 'new deformation aim: ', math_transpose33(defgradAim) - print '(a,x,es10.4)' , 'with determinant: ', math_det33(defgradAim) + write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') ' new deformation aim: ',& + math_transpose33(defgradAim) + print '(a,1x,es10.4)' , 'with determinant: ', math_det33(defgradAim) else err_stress_tol = 0.0_pReal endif @@ -1062,8 +1063,8 @@ program DAMASK_spectral defgrad(1:res(1),1:res(2),1:res(3),m,n) + (defgradAim_lab(m,n) - defgrad_av_lab(m,n)) ! anticipated target minus current state enddo; enddo if(debugGeneral) then - print '(a,/,3(3(f12.7,x)/)$)', 'average deformation gradient correction:',& - math_transpose33(defgradAim_lab- defgrad_av_lab) + write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') ' average deformation gradient correction:',& + math_transpose33(defgradAim_lab- defgrad_av_lab) !-------------------------------------------------------------------------------------------------- ! calculate bounds of det(F) and report @@ -1076,13 +1077,12 @@ program DAMASK_spectral defgradDetMin = min(defgradDetMin,defgradDet) enddo; enddo; enddo - print '(a,x,es10.4)' , 'max determinant of deformation:', defgradDetMax - print '(a,x,es10.4)' , 'min determinant of deformation:', defgradDetMin + print '(a,1x,es10.4)' , 'max determinant of deformation:', defgradDetMax + print '(a,1x,es10.4)' , 'min determinant of deformation:', defgradDetMin endif enddo ! end looping when convergency is achieved - !$OMP CRITICAL (write2out) print '(a)', '' print '(a)', '=============================================================' if(err_div > err_div_tol .or. err_stress > err_stress_tol) then @@ -1094,25 +1094,22 @@ program DAMASK_spectral if (mod(totalIncsCounter -1_pInt,bc(loadcase)%outputfrequency) == 0_pInt) then ! at output frequency print '(a)', '' print '(a)', '... writing results to file .................................' - write(538), materialpoint_results(1_pInt:materialpoint_sizeResults,1,1_pInt:Npoints) ! write result to file + write(538) materialpoint_results(1_pInt:materialpoint_sizeResults,1,1_pInt:Npoints) ! write result to file endif if (update_gamma) then print*, 'update c0_reference ' c0_reference = c_current*wgt endif - !$OMP END CRITICAL (write2out) endif ! end calculation/forwarding enddo ! end looping over incs in current loadcase deallocate(c_reduced) deallocate(s_reduced) enddo ! end looping over loadcases - !$OMP CRITICAL (write2out) print '(a)', '' print '(a)', '#############################################################' print '(i6.6,a,i6.6,a)', notConvergedCounter, ' out of ', & totalIncsCounter - restartReadInc, ' increments did not converge!' - !$OMP END CRITICAL (write2out) close(538) call fftw_destroy_plan(plan_stress); call fftw_destroy_plan(plan_correction) if (debugDivergence) call fftw_destroy_plan(plan_divergence) diff --git a/code/DAMASK_spectral_interface.f90 b/code/DAMASK_spectral_interface.f90 index 5c516e522..196064787 100644 --- a/code/DAMASK_spectral_interface.f90 +++ b/code/DAMASK_spectral_interface.f90 @@ -49,7 +49,7 @@ subroutine DAMASK_interface_init() if(index(commandLine,' -h ',.true.)>0_pInt .or. index(commandLine,' --help ',.true.)>0_pInt) then ! search for ' -h ' or '--help' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" print '(a)', '#############################################################' print '(a)', 'DAMASK spectral:' print '(a)', 'The spectral method boundary value problem solver for' @@ -131,13 +131,13 @@ subroutine DAMASK_interface_init() write(6,*) write(6,*) '<<<+- DAMASK_spectral_interface init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" - write(6,'(a,2(i2.2,a),i4.4)'), ' Date: ',date_and_time_values(3),'/',& - date_and_time_values(2),'/',& - date_and_time_values(1) - write(6,'(a,2(i2.2,a),i2.2)'), ' Time: ',date_and_time_values(5),':',& - date_and_time_values(6),':',& - date_and_time_values(7) +#include "compilation_info.f90" + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',date_and_time_values(3),'/',& + date_and_time_values(2),'/',& + date_and_time_values(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',date_and_time_values(5),':',& + date_and_time_values(6),':',& + date_and_time_values(7) write(6,*) 'Host Name: ', trim(hostName) write(6,*) 'User Name: ', trim(userName) write(6,*) 'Command line call: ', trim(commandLine) diff --git a/code/IO.f90 b/code/IO.f90 index f43d3befe..3478f8586 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -54,7 +54,7 @@ subroutine IO_init () write(6,*) write(6,*) '<<<+- IO init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" call flush(6) !$OMP END CRITICAL (write2out) @@ -1042,7 +1042,7 @@ endfunction do read(unit,'(A65536)',end=100) line pos = IO_stringPos(line,maxNchunks) - if (verify(IO_stringValue(line,pos,1),"0123456789") > 0) then ! a non-int, i.e. set name + if (verify(IO_stringValue(line,pos,1),'0123456789') > 0) then ! a non-int, i.e. set name do i = 1,lookupMaxN ! loop over known set names if (IO_stringValue(line,pos,1) == lookupName(i)) then ! found matching name IO_continousIntValues = lookupMap(:,i) ! return resp. entity list @@ -1087,7 +1087,7 @@ endfunction do l = 1,count read(unit,'(A65536)',end=100) line pos = IO_stringPos(line,maxNchunks) - if (verify(IO_stringValue(line,pos,1),"0123456789") > 0) then ! a non-int, i.e. set names follow on this line + if (verify(IO_stringValue(line,pos,1),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line do i = 1,pos(1) ! loop over set names in line do j = 1,lookupMaxN ! look thru known set names if (IO_stringValue(line,pos,i) == lookupName(j)) then ! found matching name @@ -1447,12 +1447,12 @@ endfunction if (present(e)) then if (present(i)) then if (present(g)) then - write(6,'(a12,x,i6,x,a2,x,i2,x,a5,x,i4,a2)') '+ at element',e,'IP',i,'grain',g,' +' + write(6,'(a12,1x,i6,1x,a2,1x,i2,1x,a5,1x,i4,a2)') '+ at element',e,'IP',i,'grain',g,' +' else - write(6,'(a12,x,i6,x,a2,x,i2,a13)') '+ at element',e,'IP',i,' +' + write(6,'(a12,1x,i6,1x,a2,1x,i2,a13)') '+ at element',e,'IP',i,' +' endif else - write(6,'(a12,x,i6,a19)') '+ at element',e,' +' + write(6,'(a12,1x,i6,a19)') '+ at element',e,' +' endif endif write(6,'(a38)') '+------------------------------------+' diff --git a/code/compilation_info.f90 b/code/compilation_info.f90 index 5d9e007ce..bf2ac277d 100644 --- a/code/compilation_info.f90 +++ b/code/compilation_info.f90 @@ -9,7 +9,7 @@ #endif #endif #ifdef __INTEL_COMPILER - write(6,'(a,i4.4,a,i8.8)'), ' Compiled with Intel fortran version ', __INTEL_COMPILER,& + write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,& ', build date ', __INTEL_COMPILER_BUILD_DATE #endif write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ diff --git a/code/constitutive.f90 b/code/constitutive.f90 index 9764ad215..58d6946aa 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -341,21 +341,21 @@ constitutive_maxSizePostResults = maxval(constitutive_sizePostResults) write(6,*) write(6,*) '<<<+- constitutive init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" if (debug_verbosity > 0) then - write(6,'(a32,x,7(i8,x))') 'constitutive_state0: ', shape(constitutive_state0) - write(6,'(a32,x,7(i8,x))') 'constitutive_partionedState0: ', shape(constitutive_partionedState0) - write(6,'(a32,x,7(i8,x))') 'constitutive_subState0: ', shape(constitutive_subState0) - write(6,'(a32,x,7(i8,x))') 'constitutive_state: ', shape(constitutive_state) - write(6,'(a32,x,7(i8,x))') 'constitutive_aTolState: ', shape(constitutive_aTolState) - write(6,'(a32,x,7(i8,x))') 'constitutive_dotState: ', shape(constitutive_dotState) - write(6,'(a32,x,7(i8,x))') 'constitutive_sizeState: ', shape(constitutive_sizeState) - write(6,'(a32,x,7(i8,x))') 'constitutive_sizeDotState: ', shape(constitutive_sizeDotState) - write(6,'(a32,x,7(i8,x))') 'constitutive_sizePostResults: ', shape(constitutive_sizePostResults) + write(6,'(a32,1x,7(i8,1x))') 'constitutive_state0: ', shape(constitutive_state0) + write(6,'(a32,1x,7(i8,1x))') 'constitutive_partionedState0: ', shape(constitutive_partionedState0) + write(6,'(a32,1x,7(i8,1x))') 'constitutive_subState0: ', shape(constitutive_subState0) + write(6,'(a32,1x,7(i8,1x))') 'constitutive_state: ', shape(constitutive_state) + write(6,'(a32,1x,7(i8,1x))') 'constitutive_aTolState: ', shape(constitutive_aTolState) + write(6,'(a32,1x,7(i8,1x))') 'constitutive_dotState: ', shape(constitutive_dotState) + write(6,'(a32,1x,7(i8,1x))') 'constitutive_sizeState: ', shape(constitutive_sizeState) + write(6,'(a32,1x,7(i8,1x))') 'constitutive_sizeDotState: ', shape(constitutive_sizeDotState) + write(6,'(a32,1x,7(i8,1x))') 'constitutive_sizePostResults: ', shape(constitutive_sizePostResults) write(6,*) - write(6,'(a32,x,7(i8,x))') 'maxSizeState: ', constitutive_maxSizeState - write(6,'(a32,x,7(i8,x))') 'maxSizeDotState: ', constitutive_maxSizeDotState - write(6,'(a32,x,7(i8,x))') 'maxSizePostResults: ', constitutive_maxSizePostResults + write(6,'(a32,1x,7(i8,1x))') 'maxSizeState: ', constitutive_maxSizeState + write(6,'(a32,1x,7(i8,1x))') 'maxSizeDotState: ', constitutive_maxSizeDotState + write(6,'(a32,1x,7(i8,1x))') 'maxSizePostResults: ', constitutive_maxSizePostResults endif call flush(6) !$OMP END CRITICAL (write2out) diff --git a/code/constitutive_dislotwin.f90 b/code/constitutive_dislotwin.f90 index ee84af527..37f0a948f 100644 --- a/code/constitutive_dislotwin.f90 +++ b/code/constitutive_dislotwin.f90 @@ -152,7 +152,7 @@ character(len=1024) line write(6,*) write(6,*) '<<<+- constitutive_',trim(constitutive_dislotwin_label),' init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) maxNinstance = count(phase_constitution == constitutive_dislotwin_label) diff --git a/code/constitutive_j2.f90 b/code/constitutive_j2.f90 index 35e829b35..8093f6c0d 100644 --- a/code/constitutive_j2.f90 +++ b/code/constitutive_j2.f90 @@ -99,7 +99,7 @@ subroutine constitutive_j2_init(file) write(6,*) write(6,*) '<<<+- constitutive_',trim(constitutive_j2_label),' init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) maxNinstance = count(phase_constitution == constitutive_j2_label) @@ -107,7 +107,7 @@ subroutine constitutive_j2_init(file) if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) - write(6,'(a16,x,i5)') '# instances:',maxNinstance + write(6,'(a16,1x,i5)') '# instances:',maxNinstance write(6,*) !$OMP END CRITICAL (write2out) endif diff --git a/code/constitutive_nonlocal.f90 b/code/constitutive_nonlocal.f90 index 418b36854..d1aa23982 100644 --- a/code/constitutive_nonlocal.f90 +++ b/code/constitutive_nonlocal.f90 @@ -208,7 +208,7 @@ character(len=1024) line write(6,*) write(6,*) '<<<+- constitutive_',trim(constitutive_nonlocal_label),' init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) maxNinstance = count(phase_constitution == constitutive_nonlocal_label) @@ -216,7 +216,7 @@ if (maxNinstance == 0) return if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) - write(6,'(a16,x,i5)') '# instances:',maxNinstance + write(6,'(a16,1x,i5)') '# instances:',maxNinstance !$OMP END CRITICAL (write2out) endif diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90 index 75e5609e3..fce836cef 100644 --- a/code/constitutive_phenopowerlaw.f90 +++ b/code/constitutive_phenopowerlaw.f90 @@ -174,7 +174,7 @@ subroutine constitutive_phenopowerlaw_init(file) write(6,*) write(6,*) '<<<+- constitutive_',trim(constitutive_phenopowerlaw_label),' init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) maxNinstance = count(phase_constitution == constitutive_phenopowerlaw_label) @@ -182,7 +182,7 @@ subroutine constitutive_phenopowerlaw_init(file) if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) - write(6,'(a16,x,i5)') '# instances:',maxNinstance + write(6,'(a16,1x,i5)') '# instances:',maxNinstance write(6,*) !$OMP END CRITICAL (write2out) endif diff --git a/code/constitutive_titanmod.f90 b/code/constitutive_titanmod.f90 index 6330d24cb..abce8b61a 100644 --- a/code/constitutive_titanmod.f90 +++ b/code/constitutive_titanmod.f90 @@ -221,7 +221,7 @@ character(len=1024) line write(6,*) write(6,*) '<<<+- constitutive_',trim(constitutive_titanmod_label),' init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" maxNinstance = count(phase_constitution == constitutive_titanmod_label) if (maxNinstance == 0) return diff --git a/code/crystallite.f90 b/code/crystallite.f90 index 3a476299b..760b39afc 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -174,7 +174,7 @@ character(len=1024) line write(6,*) write(6,*) '<<<+- crystallite init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) @@ -386,50 +386,50 @@ crystallite_fallbackdPdF = crystallite_dPdF ! use initial ela ! *** Output to MARC output file *** if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) - write(6,'(a35,x,7(i8,x))') 'crystallite_Temperature: ', shape(crystallite_Temperature) - write(6,'(a35,x,7(i8,x))') 'crystallite_dotTemperature: ', shape(crystallite_dotTemperature) - write(6,'(a35,x,7(i8,x))') 'crystallite_Fe: ', shape(crystallite_Fe) - write(6,'(a35,x,7(i8,x))') 'crystallite_Fp: ', shape(crystallite_Fp) - write(6,'(a35,x,7(i8,x))') 'crystallite_Lp: ', shape(crystallite_Lp) - write(6,'(a35,x,7(i8,x))') 'crystallite_F0: ', shape(crystallite_F0) - write(6,'(a35,x,7(i8,x))') 'crystallite_Fp0: ', shape(crystallite_Fp0) - write(6,'(a35,x,7(i8,x))') 'crystallite_Lp0: ', shape(crystallite_Lp0) - write(6,'(a35,x,7(i8,x))') 'crystallite_partionedF: ', shape(crystallite_partionedF) - write(6,'(a35,x,7(i8,x))') 'crystallite_partionedTemp0: ', shape(crystallite_partionedTemperature0) - write(6,'(a35,x,7(i8,x))') 'crystallite_partionedF0: ', shape(crystallite_partionedF0) - write(6,'(a35,x,7(i8,x))') 'crystallite_partionedFp0: ', shape(crystallite_partionedFp0) - write(6,'(a35,x,7(i8,x))') 'crystallite_partionedLp0: ', shape(crystallite_partionedLp0) - write(6,'(a35,x,7(i8,x))') 'crystallite_subF: ', shape(crystallite_subF) - write(6,'(a35,x,7(i8,x))') 'crystallite_subTemperature0: ', shape(crystallite_subTemperature0) - write(6,'(a35,x,7(i8,x))') 'crystallite_symmetryID: ', shape(crystallite_symmetryID) - write(6,'(a35,x,7(i8,x))') 'crystallite_subF0: ', shape(crystallite_subF0) - write(6,'(a35,x,7(i8,x))') 'crystallite_subFe0: ', shape(crystallite_subFe0) - write(6,'(a35,x,7(i8,x))') 'crystallite_subFp0: ', shape(crystallite_subFp0) - write(6,'(a35,x,7(i8,x))') 'crystallite_subLp0: ', shape(crystallite_subLp0) - write(6,'(a35,x,7(i8,x))') 'crystallite_P: ', shape(crystallite_P) - write(6,'(a35,x,7(i8,x))') 'crystallite_Tstar_v: ', shape(crystallite_Tstar_v) - write(6,'(a35,x,7(i8,x))') 'crystallite_Tstar0_v: ', shape(crystallite_Tstar0_v) - write(6,'(a35,x,7(i8,x))') 'crystallite_partionedTstar0_v: ', shape(crystallite_partionedTstar0_v) - write(6,'(a35,x,7(i8,x))') 'crystallite_subTstar0_v: ', shape(crystallite_subTstar0_v) - write(6,'(a35,x,7(i8,x))') 'crystallite_dPdF: ', shape(crystallite_dPdF) - write(6,'(a35,x,7(i8,x))') 'crystallite_dPdF0: ', shape(crystallite_dPdF0) - write(6,'(a35,x,7(i8,x))') 'crystallite_partioneddPdF0: ', shape(crystallite_partioneddPdF0) - write(6,'(a35,x,7(i8,x))') 'crystallite_fallbackdPdF: ', shape(crystallite_fallbackdPdF) - write(6,'(a35,x,7(i8,x))') 'crystallite_orientation: ', shape(crystallite_orientation) - write(6,'(a35,x,7(i8,x))') 'crystallite_orientation0: ', shape(crystallite_orientation0) - write(6,'(a35,x,7(i8,x))') 'crystallite_rotation: ', shape(crystallite_rotation) - write(6,'(a35,x,7(i8,x))') 'crystallite_disorientation: ', shape(crystallite_disorientation) - write(6,'(a35,x,7(i8,x))') 'crystallite_dt: ', shape(crystallite_dt) - write(6,'(a35,x,7(i8,x))') 'crystallite_subdt: ', shape(crystallite_subdt) - write(6,'(a35,x,7(i8,x))') 'crystallite_subFrac: ', shape(crystallite_subFrac) - write(6,'(a35,x,7(i8,x))') 'crystallite_subStep: ', shape(crystallite_subStep) - write(6,'(a35,x,7(i8,x))') 'crystallite_stateDamper: ', shape(crystallite_stateDamper) - write(6,'(a35,x,7(i8,x))') 'crystallite_localConstitution: ', shape(crystallite_localConstitution) - write(6,'(a35,x,7(i8,x))') 'crystallite_requested: ', shape(crystallite_requested) - write(6,'(a35,x,7(i8,x))') 'crystallite_todo: ', shape(crystallite_todo) - write(6,'(a35,x,7(i8,x))') 'crystallite_converged: ', shape(crystallite_converged) - write(6,'(a35,x,7(i8,x))') 'crystallite_sizePostResults: ', shape(crystallite_sizePostResults) - write(6,'(a35,x,7(i8,x))') 'crystallite_sizePostResult: ', shape(crystallite_sizePostResult) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_Temperature: ', shape(crystallite_Temperature) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_dotTemperature: ', shape(crystallite_dotTemperature) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_Fe: ', shape(crystallite_Fe) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_Fp: ', shape(crystallite_Fp) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_Lp: ', shape(crystallite_Lp) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_F0: ', shape(crystallite_F0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_Fp0: ', shape(crystallite_Fp0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_Lp0: ', shape(crystallite_Lp0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedF: ', shape(crystallite_partionedF) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedTemp0: ', shape(crystallite_partionedTemperature0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedF0: ', shape(crystallite_partionedF0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedFp0: ', shape(crystallite_partionedFp0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedLp0: ', shape(crystallite_partionedLp0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_subF: ', shape(crystallite_subF) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_subTemperature0: ', shape(crystallite_subTemperature0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_symmetryID: ', shape(crystallite_symmetryID) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_subF0: ', shape(crystallite_subF0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFe0: ', shape(crystallite_subFe0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFp0: ', shape(crystallite_subFp0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_subLp0: ', shape(crystallite_subLp0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_P: ', shape(crystallite_P) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_Tstar_v: ', shape(crystallite_Tstar_v) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_Tstar0_v: ', shape(crystallite_Tstar0_v) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedTstar0_v: ', shape(crystallite_partionedTstar0_v) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_subTstar0_v: ', shape(crystallite_subTstar0_v) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_dPdF: ', shape(crystallite_dPdF) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_dPdF0: ', shape(crystallite_dPdF0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_partioneddPdF0: ', shape(crystallite_partioneddPdF0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_fallbackdPdF: ', shape(crystallite_fallbackdPdF) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_orientation: ', shape(crystallite_orientation) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_orientation0: ', shape(crystallite_orientation0) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_rotation: ', shape(crystallite_rotation) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_disorientation: ', shape(crystallite_disorientation) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_dt: ', shape(crystallite_dt) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_subdt: ', shape(crystallite_subdt) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFrac: ', shape(crystallite_subFrac) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_subStep: ', shape(crystallite_subStep) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_stateDamper: ', shape(crystallite_stateDamper) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_localConstitution: ', shape(crystallite_localConstitution) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_requested: ', shape(crystallite_requested) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_todo: ', shape(crystallite_todo) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_converged: ', shape(crystallite_converged) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_sizePostResults: ', shape(crystallite_sizePostResults) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_sizePostResult: ', shape(crystallite_sizePostResult) write(6,*) write(6,*) 'Number of nonlocal grains: ',count(.not. crystallite_localConstitution) call flush(6) @@ -538,13 +538,13 @@ if (debug_verbosity > 4 .and. debug_e > 0 .and. debug_e <= mesh_NcpElems & .and. debug_g > 0 .and. debug_g <= homogenization_maxNgrains) then !$OMP CRITICAL (write2out) write (6,*) - write (6,'(a,i8,x,i2,x,i3)') '<< CRYST >> crystallite start at el ip g ', debug_e, debug_i, debug_g - write (6,'(a,/,12(x),f14.9)') '<< CRYST >> Temp0', crystallite_partionedTemperature0(debug_g,debug_i,debug_e) - write (6,'(a,/,3(12(x),3(f14.9,x)/))') '<< CRYST >> F0 ', & + write (6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> crystallite start at el ip g ', debug_e, debug_i, debug_g + write (6,'(a,/,12x,f14.9)') '<< CRYST >> Temp0', crystallite_partionedTemperature0(debug_g,debug_i,debug_e) + write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F0 ', & math_transpose33(crystallite_partionedF0(1:3,1:3,debug_g,debug_i,debug_e)) - write (6,'(a,/,3(12(x),3(f14.9,x)/))') '<< CRYST >> Fp0', & + write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp0', & math_transpose33(crystallite_partionedFp0(1:3,1:3,debug_g,debug_i,debug_e)) - write (6,'(a,/,3(12(x),3(f14.9,x)/))') '<< CRYST >> Lp0', & + write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Lp0', & math_transpose33(crystallite_partionedLp0(1:3,1:3,debug_g,debug_i,debug_e)) !$OMP END CRITICAL (write2out) endif @@ -706,11 +706,11 @@ enddo #ifndef _OPENMP if (debug_verbosity > 4 & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger)) then - write (6,'(a,i8,x,i2,x,i3)') '<< CRYST >> central solution of cryst_StressAndTangent at el ip g ',e,i,g + write (6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> central solution of cryst_StressAndTangent at el ip g ',e,i,g write (6,*) - write (6,'(a,/,3(12(x),3(f12.4,x)/))') '<< CRYST >> P / MPa', math_transpose33(crystallite_P(1:3,1:3,g,i,e)) / 1e6 - write (6,'(a,/,3(12(x),3(f14.9,x)/))') '<< CRYST >> Fp', math_transpose33(crystallite_Fp(1:3,1:3,g,i,e)) - write (6,'(a,/,3(12(x),3(f14.9,x)/))') '<< CRYST >> Lp', math_transpose33(crystallite_Lp(1:3,1:3,g,i,e)) + write (6,'(a,/,3(12x,3(f12.4,1x)/))') '<< CRYST >> P / MPa', math_transpose33(crystallite_P(1:3,1:3,g,i,e)) / 1e6 + write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp', math_transpose33(crystallite_Fp(1:3,1:3,g,i,e)) + write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Lp', math_transpose33(crystallite_Lp(1:3,1:3,g,i,e)) write (6,*) endif #endif @@ -763,7 +763,7 @@ if(updateJaco) then #ifndef _OPENMP if (debug_verbosity> 5) then !$OMP CRITICAL (write2out) - write(6,'(a,2(x,i1),x,a)') '<< CRYST >> [[[[[[ Stiffness perturbation',k,l,']]]]]]' + write(6,'(a,2(x,i1),1x,a)') '<< CRYST >> [[[[[[ Stiffness perturbation',k,l,']]]]]]' write(6,*) !$OMP END CRITICAL (write2out) endif @@ -1082,11 +1082,11 @@ do n = 1,4 if (debug_verbosity > 5 & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger)) then mySizeDotState = constitutive_sizeDotState(g,i,e) - write(6,'(a,i8,x,i2,x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g write(6,*) - write(6,'(a,/,(12(x),12(e12.5,x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) + write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) write(6,*) - write(6,'(a,/,(12(x),12(e12.5,x)))') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) + write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) write(6,*) endif #endif @@ -1310,7 +1310,7 @@ endif ! --- FIRST RUNGE KUTTA STEP --- #ifndef _OPENMP if (debug_verbosity > 5) then - write(6,'(a,x,i1)') '<< CRYST >> RUNGE KUTTA STEP',1 + write(6,'(a,1x,i1)') '<< CRYST >> RUNGE KUTTA STEP',1 endif #endif !$OMP DO @@ -1446,7 +1446,7 @@ do n = 1,5 ! --- dot state and RK dot state--- #ifndef _OPENMP if (debug_verbosity > 5) then - write(6,'(a,x,i1)') '<< CRYST >> RUNGE KUTTA STEP',n+1 + write(6,'(a,1x,i1)') '<< CRYST >> RUNGE KUTTA STEP',n+1 endif #endif !$OMP DO @@ -1571,17 +1571,17 @@ relTemperatureResiduum = 0.0_pReal #ifndef _OPENMP if (debug_verbosity > 5 & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger)) then - write(6,'(a,i8,x,i3,x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g + write(6,'(a,i8,1x,i3,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g write(6,*) - write(6,'(a,/,(12(x),12(f12.1,x)))') '<< CRYST >> absolute residuum tolerance', & + write(6,'(a,/,(12x,12(f12.1,1x)))') '<< CRYST >> absolute residuum tolerance', & stateResiduum(1:mySizeDotState,g,i,e) / constitutive_aTolState(g,i,e)%p(1:mySizeDotState) write(6,*) - write(6,'(a,/,(12(x),12(f12.1,x)))') '<< CRYST >> relative residuum tolerance', & + write(6,'(a,/,(12x,12(f12.1,1x)))') '<< CRYST >> relative residuum tolerance', & relStateResiduum(1:mySizeDotState,g,i,e) / rTol_crystalliteState write(6,*) - write(6,'(a,/,(12(x),12(e12.5,x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) + write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) write(6,*) - write(6,'(a,/,(12(x),12(e12.5,x)))') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) + write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) write(6,*) endif #endif @@ -1883,18 +1883,18 @@ relTemperatureResiduum = 0.0_pReal #ifndef _OPENMP if (debug_verbosity > 5 & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger)) then - write(6,'(a,i8,x,i2,x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g write(6,*) - write(6,'(a,/,(12(x),12(f12.1,x)))') '<< CRYST >> absolute residuum tolerance', & + write(6,'(a,/,(12x,12(f12.1,1x)))') '<< CRYST >> absolute residuum tolerance', & stateResiduum(1:mySizeDotState,g,i,e) / constitutive_aTolState(g,i,e)%p(1:mySizeDotState) write(6,*) - write(6,'(a,/,(12(x),12(f12.1,x)))') '<< CRYST >> relative residuum tolerance', & + write(6,'(a,/,(12x,12(f12.1,1x)))') '<< CRYST >> relative residuum tolerance', & relStateResiduum(1:mySizeDotState,g,i,e) / rTol_crystalliteState write(6,*) - write(6,'(a,/,(12(x),12(e12.5,x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) & + write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) & - 2.0_pReal * stateResiduum(1:mySizeDotState,g,i,e) / crystallite_subdt(g,i,e) ! calculate former dotstate from higher order solution and state residuum write(6,*) - write(6,'(a,/,(12(x),12(e12.5,x)))') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) + write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) write(6,*) endif #endif @@ -2057,11 +2057,11 @@ if (numerics_integrationMode < 2) then #ifndef _OPENMP if (debug_verbosity > 5 & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger)) then - write(6,'(a,i8,x,i2,x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g write(6,*) - write(6,'(a,/,(12(x),12(e12.5,x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) + write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) write(6,*) - write(6,'(a,/,(12(x),12(e12.5,x)))') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) + write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) write(6,*) endif #endif @@ -2463,7 +2463,7 @@ residuum = constitutive_state(g,i,e)%p(1:mySize) - constitutive_subState0(g,i,e) if (any(residuum /= residuum)) then ! if NaN occured then return without changing the state #ifndef _OPENMP if (debug_verbosity > 4) then - write(6,'(a,i8,x,i2,x,i3)') '<< CRYST >> updateState encountered NaN at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState encountered NaN at el ip g ',e,i,g endif #endif return @@ -2480,16 +2480,16 @@ converged = all( abs(residuum) < constitutive_aTolState(g,i,e)%p(1:mySize) & #ifndef _OPENMP if (debug_verbosity > 5 .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger)) then if (converged) then - write(6,'(a,i8,x,i2,x,i3)') '<< CRYST >> updateState converged at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState converged at el ip g ',e,i,g else - write(6,'(a,i8,x,i2,x,i3)') '<< CRYST >> updateState did not converge at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState did not converge at el ip g ',e,i,g endif write(6,*) write(6,'(a,f6.1)') '<< CRYST >> crystallite_statedamper ',crystallite_statedamper(g,i,e) write(6,*) - write(6,'(a,/,(12(x),12(e12.5,x)))') '<< CRYST >> dotState',dotState(1:mySize) + write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> dotState',dotState(1:mySize) write(6,*) - write(6,'(a,/,(12(x),12(e12.5,x)))') '<< CRYST >> new state',state(1:mySize) + write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> new state',state(1:mySize) write(6,*) endif #endif @@ -2546,7 +2546,7 @@ residuum = crystallite_Temperature(g,i,e) - crystallite_subTemperature0(g,i,e) & if (residuum /= residuum) then #ifndef _OPENMP if (debug_verbosity > 4) then - write(6,'(a,i8,x,i2,x,i3)') '<< CRYST >> updateTemperature encountered NaN at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateTemperature encountered NaN at el ip g ',e,i,g endif #endif return @@ -2681,7 +2681,7 @@ integer(pLongInt) tick, & crystallite_integrateStress = .false. #ifndef _OPENMP if (debug_verbosity > 5 .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger)) then - write(6,'(a,i8,x,i2,x,i3)') '<< CRYST >> integrateStress at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress at el ip g ',e,i,g endif #endif @@ -2710,10 +2710,10 @@ invFp_current = math_inv33(Fp_current) if (all(invFp_current == 0.0_pReal)) then ! ... failed? #ifndef _OPENMP if (debug_verbosity > 4) then - write(6,'(a,i8,x,i2,x,i3)') '<< CRYST >> integrateStress failed on invFp_current inversion at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on invFp_current inversion at el ip g ',e,i,g if (debug_verbosity > 5 .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger)) then write(6,*) - write(6,'(a,/,3(12(x),3(f12.7,x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new(1:3,1:3)) + write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new(1:3,1:3)) endif endif #endif @@ -2745,7 +2745,7 @@ LpLoop: do if (NiterationStress > nStress) then #ifndef _OPENMP if (debug_verbosity > 4) then - write(6,'(a,i8,x,i2,x,i3)') '<< CRYST >> integrateStress reached loop limit at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress reached loop limit at el ip g ',e,i,g write(6,*) endif #endif @@ -2786,8 +2786,8 @@ LpLoop: do .and. numerics_integrationMode == 1_pInt) then write(6,'(a,i3)') '<< CRYST >> iteration ', NiterationStress write(6,*) - write(6,'(a,/,3(12(x),3(e20.7,x)/))') '<< CRYST >> Lp_constitutive', math_transpose33(Lp_constitutive) - write(6,'(a,/,3(12(x),3(e20.7,x)/))') '<< CRYST >> Lpguess', math_transpose33(Lpguess) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lp_constitutive', math_transpose33(Lp_constitutive) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lpguess', math_transpose33(Lpguess) endif #endif @@ -2810,7 +2810,7 @@ LpLoop: do if (steplength >= steplength0 .and. any(residuum /= residuum)) then #ifndef _OPENMP if (debug_verbosity > 4) then - write(6,'(a,i8,x,i2,x,i3,a,i3,a)') '<< CRYST >> integrateStress encountered NaN at el ip g ',e,i,g,& + write(6,'(a,i8,1x,i2,1x,i3,a,i3,a)') '<< CRYST >> integrateStress encountered NaN at el ip g ',e,i,g,& ' ; iteration ', NiterationStress,& ' >> returning..!' endif @@ -2858,7 +2858,7 @@ LpLoop: do else #ifndef _OPENMP if (debug_verbosity > 5) then - write(6,'(a,i8,x,i2,x,i3,x,a,i3)') '<< CRYST >> integrateStress encountered high-speed crash at el ip g ',e,i,g,& + write(6,'(a,i8,1x,i2,1x,i3,1x,a,i3)') '<< CRYST >> integrateStress encountered high-speed crash at el ip g ',e,i,g,& '; iteration ', NiterationStress endif #endif @@ -2895,17 +2895,17 @@ LpLoop: do if (error) then #ifndef _OPENMP if (debug_verbosity > 4) then - write(6,'(a,i8,x,i2,x,i3,a,i3)') '<< CRYST >> integrateStress failed on dR/dLp inversion at el ip g ',e,i,g + write(6,'(a,i8,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on dR/dLp inversion at el ip g ',e,i,g if (debug_verbosity > 5 & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger)) then write(6,*) - write(6,'(a,/,9(12(x),9(e15.3,x)/))') '<< CRYST >> dR_dLp',transpose(dR_dLp) - write(6,'(a,/,9(12(x),9(e15.3,x)/))') '<< CRYST >> dT_dLp',transpose(dT_dLp) - write(6,'(a,/,9(12(x),9(e15.3,x)/))') '<< CRYST >> dLp_dT_constitutive',transpose(dLp_dT_constitutive) - write(6,'(a,/,3(12(x),3(e20.7,x)/))') '<< CRYST >> AB',math_transpose33(AB) - write(6,'(a,/,3(12(x),3(e20.7,x)/))') '<< CRYST >> BTA',math_transpose33(BTA) - write(6,'(a,/,3(12(x),3(e20.7,x)/))') '<< CRYST >> Lp_constitutive',math_transpose33(Lp_constitutive) - write(6,'(a,/,3(12(x),3(e20.7,x)/))') '<< CRYST >> Lpguess',math_transpose33(Lpguess) + write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dR_dLp',transpose(dR_dLp) + write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dT_dLp',transpose(dT_dLp) + write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLp_dT_constitutive',transpose(dLp_dT_constitutive) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> AB',math_transpose33(AB) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> BTA',math_transpose33(BTA) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lp_constitutive',math_transpose33(Lp_constitutive) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lpguess',math_transpose33(Lpguess) endif endif #endif @@ -2940,11 +2940,11 @@ call math_invert33(invFp_new,Fp_new,det,error) if (error) then #ifndef _OPENMP if (debug_verbosity > 4) then - write(6,'(a,i8,x,i2,x,i3,a,i3)') '<< CRYST >> integrateStress failed on invFp_new inversion at el ip g ',e,i,g, & + write(6,'(a,i8,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on invFp_new inversion at el ip g ',e,i,g, & ' ; iteration ', NiterationStress if (debug_verbosity > 5 .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger)) then write(6,*) - write(6,'(a,/,3(12(x),3(f12.7,x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new) + write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new) endif endif #endif @@ -2974,12 +2974,12 @@ crystallite_integrateStress = .true. #ifndef _OPENMP if (debug_verbosity > 5 .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) .or. .not. debug_selectiveDebugger) & .and. numerics_integrationMode == 1_pInt) then - write(6,'(a,/,3(12(x),3(f12.7,x)/))') '<< CRYST >> P / MPa',math_transpose33(crystallite_P(1:3,1:3,g,i,e))/1e6 - write(6,'(a,/,3(12(x),3(f12.7,x)/))') '<< CRYST >> Cauchy / MPa', & + write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> P / MPa',math_transpose33(crystallite_P(1:3,1:3,g,i,e))/1e6 + write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Cauchy / MPa', & math_mul33x33(crystallite_P(1:3,1:3,g,i,e), math_transpose33(Fg_new)) / 1e6 / math_det33(Fg_new) - write(6,'(a,/,3(12(x),3(f12.7,x)/))') '<< CRYST >> Fe Lp Fe^-1', & + write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fe Lp Fe^-1', & math_transpose33(math_mul33x33(Fe_new, math_mul33x33(crystallite_Lp(1:3,1:3,g,i,e), math_inv33(Fe_new)))) ! transpose to get correct print out order - write(6,'(a,/,3(12(x),3(f12.7,x)/))') '<< CRYST >> Fp',math_transpose33(crystallite_Fp(1:3,1:3,g,i,e)) + write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp',math_transpose33(crystallite_Fp(1:3,1:3,g,i,e)) endif #endif diff --git a/code/debug.f90 b/code/debug.f90 index ca4eb6319..91771e7de 100644 --- a/code/debug.f90 +++ b/code/debug.f90 @@ -96,7 +96,7 @@ subroutine debug_init() write(6,*) write(6,*) '<<<+- debug init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) allocate(debug_StressLoopDistribution(nStress,2)) ; debug_StressLoopDistribution = 0_pInt @@ -163,16 +163,16 @@ subroutine debug_init() if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) - write(6,'(a24,x,i1)') 'verbose: ',debug_verbosity - write(6,'(a24,x,l)') 'selective: ',debug_selectiveDebugger + write(6,'(a24,1x,i1)') 'verbose: ',debug_verbosity + write(6,'(a24,1x,l1)') 'selective: ',debug_selectiveDebugger !$OMP END CRITICAL (write2out) endif if (debug_selectiveDebugger) then if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) - write(6,'(a24,x,i8)') 'element: ',debug_e - write(6,'(a24,x,i8)') 'ip: ',debug_i - write(6,'(a24,x,i8)') 'grain: ',debug_g + write(6,'(a24,1x,i8)') 'element: ',debug_e + write(6,'(a24,1x,i8)') 'ip: ',debug_i + write(6,'(a24,1x,i8)') 'grain: ',debug_g !$OMP END CRITICAL (write2out) endif else @@ -245,24 +245,24 @@ subroutine debug_info() write(6,*) write(6,*) 'DEBUG Info (from previous cycle)' write(6,*) - write(6,'(a33,x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls + write(6,'(a33,1x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls if (debug_cumLpCalls > 0_pInt) then - write(6,'(a33,x,f12.3)') 'total CPU time/s :',dble(debug_cumLpTicks)/tickrate - write(6,'(a33,x,f12.6)') 'avg CPU time/microsecs per call :',& + write(6,'(a33,1x,f12.3)') 'total CPU time/s :',dble(debug_cumLpTicks)/tickrate + write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',& dble(debug_cumLpTicks)*1.0e6_pReal/tickrate/debug_cumLpCalls endif write(6,*) - write(6,'(a33,x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls + write(6,'(a33,1x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls if (debug_cumdotStateCalls > 0_pInt) then - write(6,'(a33,x,f12.3)') 'total CPU time/s :',dble(debug_cumDotStateTicks)/tickrate - write(6,'(a33,x,f12.6)') 'avg CPU time/microsecs per call :',& + write(6,'(a33,1x,f12.3)') 'total CPU time/s :',dble(debug_cumDotStateTicks)/tickrate + write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',& dble(debug_cumDotStateTicks)*1.0e6_pReal/tickrate/debug_cumDotStateCalls endif write(6,*) - write(6,'(a33,x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls + write(6,'(a33,1x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls if (debug_cumdotTemperatureCalls > 0_pInt) then - write(6,'(a33,x,f12.3)') 'total CPU time/s :', dble(debug_cumDotTemperatureTicks)/tickrate - write(6,'(a33,x,f12.6)') 'avg CPU time/microsecs per call :',& + write(6,'(a33,1x,f12.3)') 'total CPU time/s :', dble(debug_cumDotTemperatureTicks)/tickrate + write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',& dble(debug_cumDotTemperatureTicks)*1.0e6_pReal/tickrate/debug_cumDotTemperatureCalls endif @@ -274,11 +274,11 @@ subroutine debug_info() if (any(debug_StressLoopDistribution(i,:) /= 0_pInt ) .or. & any(debug_LeapfrogBreakDistribution(i,:) /= 0_pInt ) ) then integral = integral + i*debug_StressLoopDistribution(i,1) + i*debug_StressLoopDistribution(i,2) - write(6,'(i25,x,i10,x,i10,x,i10,x,i10)') i,debug_StressLoopDistribution(i,1),debug_LeapfrogBreakDistribution(i,1), & + write(6,'(i25,1x,i10,1x,i10,1x,i10,1x,i10)') i,debug_StressLoopDistribution(i,1),debug_LeapfrogBreakDistribution(i,1), & debug_StressLoopDistribution(i,2),debug_LeapfrogBreakDistribution(i,2) endif enddo - write(6,'(a15,i10,x,i10,12x,i10)') ' total',integral,& + write(6,'(a15,i10,1x,i10,12x,i10)') ' total',integral,& sum(debug_StressLoopDistribution(:,1)), & sum(debug_StressLoopDistribution(:,2)) @@ -288,10 +288,10 @@ subroutine debug_info() do i=1,nState if (any(debug_StateLoopDistribution(i,:) /= 0)) then integral = integral + i*debug_StateLoopDistribution(i,1) + i*debug_StateLoopDistribution(i,2) - write(6,'(i25,x,i10,12x,i10)') i,debug_StateLoopDistribution(i,1),debug_StateLoopDistribution(i,2) + write(6,'(i25,1x,i10,12x,i10)') i,debug_StateLoopDistribution(i,1),debug_StateLoopDistribution(i,2) endif enddo - write(6,'(a15,i10,x,i10,12x,i10)') ' total',integral,& + write(6,'(a15,i10,1x,i10,12x,i10)') ' total',integral,& sum(debug_StateLoopDistribution(:,1)), & sum(debug_StateLoopDistribution(:,2)) @@ -302,13 +302,13 @@ subroutine debug_info() if (debug_CrystalliteLoopDistribution(i) /= 0) then integral = integral + i*debug_CrystalliteLoopDistribution(i) if (i <= nCryst) then - write(6,'(i25,x,i10)') i,debug_CrystalliteLoopDistribution(i) + write(6,'(i25,1x,i10)') i,debug_CrystalliteLoopDistribution(i) else write(6,'(i25,a1,i10)') i-1,'+',debug_CrystalliteLoopDistribution(i) endif endif enddo - write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution) + write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution) !$OMP END CRITICAL (write2out) endif @@ -322,10 +322,10 @@ subroutine debug_info() do i=1,nMPstate if (debug_MaterialpointStateLoopDistribution(i) /= 0) then integral = integral + i*debug_MaterialpointStateLoopDistribution(i) - write(6,'(i25,x,i10)') i,debug_MaterialpointStateLoopDistribution(i) + write(6,'(i25,1x,i10)') i,debug_MaterialpointStateLoopDistribution(i) endif enddo - write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_MaterialpointStateLoopDistribution) + write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointStateLoopDistribution) integral = 0_pInt write(6,*) @@ -334,23 +334,23 @@ subroutine debug_info() if (debug_MaterialpointLoopDistribution(i) /= 0) then integral = integral + i*debug_MaterialpointLoopDistribution(i) if (i <= nHomog) then - write(6,'(i25,x,i10)') i,debug_MaterialpointLoopDistribution(i) + write(6,'(i25,1x,i10)') i,debug_MaterialpointLoopDistribution(i) else write(6,'(i25,a1,i10)') i-1,'+',debug_MaterialpointLoopDistribution(i) endif endif enddo - write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution) + write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution) write(6,*) write(6,*) write(6,*) 'Extreme values of returned stress and jacobian' write(6,*) write(6,'(a39)') ' value el ip' - write(6,'(a14,x,e12.3,x,i6,x,i4)') 'stress min :', debug_stressMin, debug_stressMinLocation - write(6,'(a14,x,e12.3,x,i6,x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation - write(6,'(a14,x,e12.3,x,i6,x,i4)') 'jacobian min :', debug_jacobianMin, debug_jacobianMinLocation - write(6,'(a14,x,e12.3,x,i6,x,i4)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation + write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') 'stress min :', debug_stressMin, debug_stressMinLocation + write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation + write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') 'jacobian min :', debug_jacobianMin, debug_jacobianMinLocation + write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation write(6,*) !$OMP END CRITICAL (write2out) diff --git a/code/homogenization.f90 b/code/homogenization.f90 index ec7d86b26..dbd023641 100644 --- a/code/homogenization.f90 +++ b/code/homogenization.f90 @@ -207,32 +207,32 @@ allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpEl write(6,*) write(6,*) '<<<+- homogenization init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" if (debug_verbosity > 0) then - write(6,'(a32,x,7(i8,x))') 'homogenization_state0: ', shape(homogenization_state0) - write(6,'(a32,x,7(i8,x))') 'homogenization_subState0: ', shape(homogenization_subState0) - write(6,'(a32,x,7(i8,x))') 'homogenization_state: ', shape(homogenization_state) - write(6,'(a32,x,7(i8,x))') 'homogenization_sizeState: ', shape(homogenization_sizeState) - write(6,'(a32,x,7(i8,x))') 'homogenization_sizePostResults: ', shape(homogenization_sizePostResults) + write(6,'(a32,1x,7(i8,1x))') 'homogenization_state0: ', shape(homogenization_state0) + write(6,'(a32,1x,7(i8,1x))') 'homogenization_subState0: ', shape(homogenization_subState0) + write(6,'(a32,1x,7(i8,1x))') 'homogenization_state: ', shape(homogenization_state) + write(6,'(a32,1x,7(i8,1x))') 'homogenization_sizeState: ', shape(homogenization_sizeState) + write(6,'(a32,1x,7(i8,1x))') 'homogenization_sizePostResults: ', shape(homogenization_sizePostResults) write(6,*) - write(6,'(a32,x,7(i8,x))') 'materialpoint_dPdF: ', shape(materialpoint_dPdF) - write(6,'(a32,x,7(i8,x))') 'materialpoint_F0: ', shape(materialpoint_F0) - write(6,'(a32,x,7(i8,x))') 'materialpoint_F: ', shape(materialpoint_F) - write(6,'(a32,x,7(i8,x))') 'materialpoint_subF0: ', shape(materialpoint_subF0) - write(6,'(a32,x,7(i8,x))') 'materialpoint_subF: ', shape(materialpoint_subF) - write(6,'(a32,x,7(i8,x))') 'materialpoint_P: ', shape(materialpoint_P) - write(6,'(a32,x,7(i8,x))') 'materialpoint_Temperature: ', shape(materialpoint_Temperature) - write(6,'(a32,x,7(i8,x))') 'materialpoint_subFrac: ', shape(materialpoint_subFrac) - write(6,'(a32,x,7(i8,x))') 'materialpoint_subStep: ', shape(materialpoint_subStep) - write(6,'(a32,x,7(i8,x))') 'materialpoint_subdt: ', shape(materialpoint_subdt) - write(6,'(a32,x,7(i8,x))') 'materialpoint_requested: ', shape(materialpoint_requested) - write(6,'(a32,x,7(i8,x))') 'materialpoint_converged: ', shape(materialpoint_converged) - write(6,'(a32,x,7(i8,x))') 'materialpoint_doneAndHappy: ', shape(materialpoint_doneAndHappy) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_dPdF: ', shape(materialpoint_dPdF) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F0: ', shape(materialpoint_F0) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F: ', shape(materialpoint_F) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subF0: ', shape(materialpoint_subF0) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subF: ', shape(materialpoint_subF) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_P: ', shape(materialpoint_P) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_Temperature: ', shape(materialpoint_Temperature) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subFrac: ', shape(materialpoint_subFrac) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subStep: ', shape(materialpoint_subStep) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subdt: ', shape(materialpoint_subdt) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_requested: ', shape(materialpoint_requested) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_converged: ', shape(materialpoint_converged) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_doneAndHappy: ', shape(materialpoint_doneAndHappy) write(6,*) - write(6,'(a32,x,7(i8,x))') 'materialpoint_results: ', shape(materialpoint_results) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_results: ', shape(materialpoint_results) write(6,*) - write(6,'(a32,x,7(i8,x))') 'maxSizeState: ', homogenization_maxSizeState - write(6,'(a32,x,7(i8,x))') 'maxSizePostResults: ', homogenization_maxSizePostResults + write(6,'(a32,1x,7(i8,1x))') 'maxSizeState: ', homogenization_maxSizeState + write(6,'(a32,1x,7(i8,1x))') 'maxSizePostResults: ', homogenization_maxSizePostResults endif call flush(6) !$OMP END CRITICAL (write2out) @@ -310,10 +310,10 @@ subroutine materialpoint_stressAndItsTangent(& if (debug_verbosity > 2 .and. debug_e > 0 .and. debug_e <= mesh_NcpElems .and. debug_i > 0 .and. debug_i <= mesh_maxNips) then !$OMP CRITICAL (write2out) write (6,*) - write (6,'(a,i5,x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i - write (6,'(a,/,12(x),f14.9)') '<< HOMOG >> Temp0', materialpoint_Temperature(debug_i,debug_e) - write (6,'(a,/,3(12(x),3(f14.9,x)/))') '<< HOMOG >> F0', math_transpose33(materialpoint_F0(1:3,1:3,debug_i,debug_e)) - write (6,'(a,/,3(12(x),3(f14.9,x)/))') '<< HOMOG >> F', math_transpose33(materialpoint_F(1:3,1:3,debug_i,debug_e)) + write (6,'(a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i + write (6,'(a,/,12x,f14.9)') '<< HOMOG >> Temp0', materialpoint_Temperature(debug_i,debug_e) + write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', math_transpose33(materialpoint_F0(1:3,1:3,debug_i,debug_e)) + write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', math_transpose33(materialpoint_F(1:3,1:3,debug_i,debug_e)) !$OMP END CRITICAL (write2out) endif @@ -360,7 +360,7 @@ subroutine materialpoint_stressAndItsTangent(& if ( materialpoint_converged(i,e) ) then #ifndef _OPENMP if (debug_verbosity > 2 .and. ((e == debug_e .and. i == debug_i) .or. .not. debug_selectiveDebugger)) then - write(6,'(a,x,f10.8,x,a,x,f10.8,x,a,/)') '<< HOMOG >> winding forward from', & + write(6,'(a,1x,f10.8,1x,a,1x,f10.8,1x,a,/)') '<< HOMOG >> winding forward from', & materialpoint_subFrac(i,e), 'to current materialpoint_subFrac', & materialpoint_subFrac(i,e)+materialpoint_subStep(i,e),'in materialpoint_stressAndItsTangent' endif @@ -411,7 +411,7 @@ subroutine materialpoint_stressAndItsTangent(& #ifndef _OPENMP if (debug_verbosity > 2 .and. ((e == debug_e .and. i == debug_i) .or. .not. debug_selectiveDebugger)) then - write(6,'(a,x,f10.8,/)') & + write(6,'(a,1x,f10.8,/)') & '<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new materialpoint_subStep:',& materialpoint_subStep(i,e) endif diff --git a/code/homogenization_RGC.f90 b/code/homogenization_RGC.f90 index 3acc05a3f..58c5b0ac0 100644 --- a/code/homogenization_RGC.f90 +++ b/code/homogenization_RGC.f90 @@ -83,7 +83,7 @@ subroutine homogenization_RGC_init(& write(6,*) write(6,*) '<<<+- homogenization_',trim(homogenization_RGC_label),' init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) maxNinstance = count(homogenization_type == homogenization_RGC_label) @@ -172,13 +172,13 @@ subroutine homogenization_RGC_init(& 100 if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) do i = 1,maxNinstance - write(6,'(a15,x,i4)') 'instance: ', i + write(6,'(a15,1x,i4)') 'instance: ', i write(6,*) - write(6,'(a25,3(x,i8))') 'cluster size: ',(homogenization_RGC_Ngrains(j,i),j=1,3) - write(6,'(a25,x,e10.3)') 'scaling parameter: ', homogenization_RGC_xiAlpha(i) - write(6,'(a25,x,e10.3)') 'over-proportionality: ', homogenization_RGC_ciAlpha(i) - write(6,'(a25,3(x,e10.3))') 'grain size: ',(homogenization_RGC_dAlpha(j,i),j=1,3) - write(6,'(a25,3(x,e10.3))') 'cluster orientation: ',(homogenization_RGC_angles(j,i),j=1,3) + write(6,'(a25,3(1x,i8))') 'cluster size: ',(homogenization_RGC_Ngrains(j,i),j=1,3) + write(6,'(a25,1x,e10.3)') 'scaling parameter: ', homogenization_RGC_xiAlpha(i) + write(6,'(a25,1x,e10.3)') 'over-proportionality: ', homogenization_RGC_ciAlpha(i) + write(6,'(a25,3(1x,e10.3))') 'grain size: ',(homogenization_RGC_dAlpha(j,i),j=1,3) + write(6,'(a25,3(1x,e10.3))') 'cluster orientation: ',(homogenization_RGC_angles(j,i),j=1,3) enddo !$OMP END CRITICAL (write2out) endif @@ -278,10 +278,10 @@ subroutine homogenization_RGC_partitionDeformation(& !* Debugging the overall deformation gradient if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) - write(6,'(x,a,i3,a,i3,a)')'========== Increment: ',theInc,' Cycle: ',cycleCounter,' ==========' - write(6,'(x,a32)')'Overall deformation gradient: ' + write(6,'(1x,a,i3,a,i3,a)')'========== Increment: ',theInc,' Cycle: ',cycleCounter,' ==========' + write(6,'(1x,a32)')'Overall deformation gradient: ' do i = 1,3 - write(6,'(x,3(e14.8,x))')(avgF(i,j), j = 1,3) + write(6,'(1x,3(e14.8,1x))')(avgF(i,j), j = 1,3) enddo write(6,*)' ' call flush(6) @@ -305,9 +305,9 @@ subroutine homogenization_RGC_partitionDeformation(& !* Debugging the grain deformation gradients if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) - write(6,'(x,a32,x,i3)')'Deformation gradient of grain: ',iGrain + write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain do i = 1,3 - write(6,'(x,3(e14.8,x))')(F(i,j,iGrain), j = 1,3) + write(6,'(1x,3(e14.8,1x))')(F(i,j,iGrain), j = 1,3) enddo write(6,*)' ' call flush(6) @@ -392,9 +392,9 @@ function homogenization_RGC_updateState(& !* Debugging the obtained state if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) - write(6,'(x,a30)')'Obtained state: ' + write(6,'(1x,a30)')'Obtained state: ' do i = 1,3*nIntFaceTot - write(6,'(x,2(e14.8,x))')state%p(i) + write(6,'(1x,2(e14.8,1x))')state%p(i) enddo write(6,*)' ' !$OMP END CRITICAL (write2out) @@ -410,11 +410,11 @@ function homogenization_RGC_updateState(& if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) do iGrain = 1,nGrain - write(6,'(x,a30,x,i3,x,a4,3(x,e14.8))')'Mismatch magnitude of grain(',iGrain,') :',NN(1,iGrain),NN(2,iGrain),NN(3,iGrain) + write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e14.8))')'Mismatch magnitude of grain(',iGrain,') :',NN(1,iGrain),NN(2,iGrain),NN(3,iGrain) write(6,*)' ' - write(6,'(x,a30,x,i3)')'Stress and penalties of grain: ',iGrain + write(6,'(1x,a30,1x,i3)')'Stress and penalties of grain: ',iGrain do i = 1,3 - write(6,'(x,3(e14.8,x),x,3(e14.8,x),x,3(e14.8,x))')(P(i,j,iGrain), j = 1,3), & + write(6,'(1x,3(e14.8,1x),1x,3(e14.8,1x),1x,3(e14.8,1x))')(P(i,j,iGrain), j = 1,3), & (R(i,j,iGrain), j = 1,3), & (D(i,j,iGrain), j = 1,3) enddo @@ -458,8 +458,8 @@ function homogenization_RGC_updateState(& !* Debugging the residual stress if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) - write(6,'(x,a30,x,i3)')'Traction at interface: ',iNum - write(6,'(x,3(e14.8,x))')(tract(iNum,j), j = 1,3) + write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum + write(6,'(1x,3(e14.8,1x))')(tract(iNum,j), j = 1,3) write(6,*)' ' !$OMP END CRITICAL (write2out) endif @@ -476,11 +476,11 @@ function homogenization_RGC_updateState(& !* Debugging the convergent criteria if (debug_verbosity == 4 .and. debug_e == el .and. debug_i == ip) then !$OMP CRITICAL (write2out) - write(6,'(x,a)')' ' - write(6,'(x,a,x,i2,x,i4)')'RGC residual check ...',ip,el - write(6,'(x,a15,x,e14.8,x,a7,i3,x,a12,i2,i2)')'Max stress: ',stresMax, & + write(6,'(1x,a)')' ' + write(6,'(1x,a,1x,i2,1x,i4)')'RGC residual check ...',ip,el + write(6,'(1x,a15,1x,e14.8,1x,a7,i3,1x,a12,i2,i2)')'Max stress: ',stresMax, & '@ grain',stresLoc(3),'in component',stresLoc(1),stresLoc(2) - write(6,'(x,a15,x,e14.8,x,a7,i3,x,a12,i2)')'Max residual: ',residMax, & + write(6,'(1x,a15,1x,e14.8,1x,a7,i3,1x,a12,i2)')'Max residual: ',residMax, & '@ iface',residLoc(1),'in direction',residLoc(2) call flush(6) !$OMP END CRITICAL (write2out) @@ -493,12 +493,12 @@ function homogenization_RGC_updateState(& if (debug_verbosity == 4 .and. debug_e == el .and. debug_i == ip) then !$OMP CRITICAL (write2out) - write(6,'(x,a55)')'... done and happy' + write(6,'(1x,a55)')'... done and happy' write(6,*)' ' call flush(6) !$OMP END CRITICAL (write2out) endif -! write(6,'(x,a,x,i3,x,a6,x,i3,x,a12)')'RGC_updateState: ip',ip,'| el',el,'converged :)' +! write(6,'(1x,a,1x,i3,1x,a6,1x,i3,1x,a12)')'RGC_updateState: ip',ip,'| el',el,'converged :)' !* Then compute/update the state for postResult, i.e., ... !* ... all energy densities computed by time-integration @@ -523,15 +523,15 @@ function homogenization_RGC_updateState(& if (debug_verbosity == 4 .and. debug_e == el .and. debug_i == ip) then !$OMP CRITICAL (write2out) - write(6,'(x,a30,x,e14.8)')'Constitutive work: ',constitutiveWork - write(6,'(x,a30,3(x,e14.8))')'Magnitude mismatch: ',sum(NN(1,:))/dble(nGrain), & + write(6,'(1x,a30,1x,e14.8)')'Constitutive work: ',constitutiveWork + write(6,'(1x,a30,3(1x,e14.8))')'Magnitude mismatch: ',sum(NN(1,:))/dble(nGrain), & sum(NN(2,:))/dble(nGrain), & sum(NN(3,:))/dble(nGrain) - write(6,'(x,a30,x,e14.8)')'Penalty energy: ',penaltyEnergy - write(6,'(x,a30,x,e14.8)')'Volume discrepancy: ',volDiscrep + write(6,'(1x,a30,1x,e14.8)')'Penalty energy: ',penaltyEnergy + write(6,'(1x,a30,1x,e14.8)')'Volume discrepancy: ',volDiscrep write(6,*)'' - write(6,'(x,a30,x,e14.8)')'Maximum relaxation rate: ',maxval(abs(drelax))/dt - write(6,'(x,a30,x,e14.8)')'Average relaxation rate: ',sum(abs(drelax))/dt/dble(3*nIntFaceTot) + write(6,'(1x,a30,1x,e14.8)')'Maximum relaxation rate: ',maxval(abs(drelax))/dt + write(6,'(1x,a30,1x,e14.8)')'Average relaxation rate: ',sum(abs(drelax))/dt/dble(3*nIntFaceTot) write(6,*)'' call flush(6) !$OMP END CRITICAL (write2out) @@ -547,7 +547,7 @@ function homogenization_RGC_updateState(& if (debug_verbosity == 4 .and. debug_e == el .and. debug_i == ip) then !$OMP CRITICAL (write2out) - write(6,'(x,a55)')'... broken' + write(6,'(1x,a55)')'... broken' write(6,*)' ' call flush(6) !$OMP END CRITICAL (write2out) @@ -561,7 +561,7 @@ function homogenization_RGC_updateState(& if (debug_verbosity == 4 .and. debug_e == el .and. debug_i == ip) then !$OMP CRITICAL (write2out) - write(6,'(x,a55)')'... not yet done' + write(6,'(1x,a55)')'... not yet done' write(6,*)' ' call flush(6) !$OMP END CRITICAL (write2out) @@ -617,9 +617,9 @@ function homogenization_RGC_updateState(& !* Debugging the global Jacobian matrix of stress tangent if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) - write(6,'(x,a30)')'Jacobian matrix of stress' + write(6,'(1x,a30)')'Jacobian matrix of stress' do i = 1,3*nIntFaceTot - write(6,'(x,100(e10.4,x))')(smatrix(i,j), j = 1,3*nIntFaceTot) + write(6,'(1x,100(e10.4,1x))')(smatrix(i,j), j = 1,3*nIntFaceTot) enddo write(6,*)' ' call flush(6) @@ -673,9 +673,9 @@ function homogenization_RGC_updateState(& !* Debugging the global Jacobian matrix of penalty tangent if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) - write(6,'(x,a30)')'Jacobian matrix of penalty' + write(6,'(1x,a30)')'Jacobian matrix of penalty' do i = 1,3*nIntFaceTot - write(6,'(x,100(e10.4,x))')(pmatrix(i,j), j = 1,3*nIntFaceTot) + write(6,'(1x,100(e10.4,1x))')(pmatrix(i,j), j = 1,3*nIntFaceTot) enddo write(6,*)' ' call flush(6) @@ -693,9 +693,9 @@ function homogenization_RGC_updateState(& !* Debugging the global Jacobian matrix of numerical viscosity tangent if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) - write(6,'(x,a30)')'Jacobian matrix of penalty' + write(6,'(1x,a30)')'Jacobian matrix of penalty' do i = 1,3*nIntFaceTot - write(6,'(x,100(e10.4,x))')(rmatrix(i,j), j = 1,3*nIntFaceTot) + write(6,'(1x,100(e10.4,1x))')(rmatrix(i,j), j = 1,3*nIntFaceTot) enddo write(6,*)' ' call flush(6) @@ -707,9 +707,9 @@ function homogenization_RGC_updateState(& if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) - write(6,'(x,a30)')'Jacobian matrix (total)' + write(6,'(1x,a30)')'Jacobian matrix (total)' do i = 1,3*nIntFaceTot - write(6,'(x,100(e10.4,x))')(jmatrix(i,j), j = 1,3*nIntFaceTot) + write(6,'(1x,100(e10.4,1x))')(jmatrix(i,j), j = 1,3*nIntFaceTot) enddo write(6,*)' ' call flush(6) @@ -726,9 +726,9 @@ function homogenization_RGC_updateState(& !* Debugging the inverse Jacobian matrix if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) - write(6,'(x,a30)')'Jacobian inverse' + write(6,'(1x,a30)')'Jacobian inverse' do i = 1,3*nIntFaceTot - write(6,'(x,100(e10.4,x))')(jnverse(i,j), j = 1,3*nIntFaceTot) + write(6,'(1x,100(e10.4,1x))')(jnverse(i,j), j = 1,3*nIntFaceTot) enddo write(6,*)' ' call flush(6) @@ -747,8 +747,8 @@ function homogenization_RGC_updateState(& if (any(abs(drelax(:)) > maxdRelax_RGC)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large homogenization_RGC_updateState = (/.true.,.false./) !$OMP CRITICAL (write2out) - write(6,'(x,a,x,i3,x,a,x,i3,x,a)')'RGC_updateState: ip',ip,'| el',el,'enforces cutback' - write(6,'(x,a,x,e14.8)')'due to large relaxation change =',maxval(abs(drelax)) + write(6,'(1x,a,1x,i3,1x,a,1x,i3,1x,a)')'RGC_updateState: ip',ip,'| el',el,'enforces cutback' + write(6,'(1x,a,1x,e14.8)')'due to large relaxation change =',maxval(abs(drelax)) call flush(6) !$OMP END CRITICAL (write2out) endif @@ -756,9 +756,9 @@ function homogenization_RGC_updateState(& !* Debugging the return state if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) - write(6,'(x,a30)')'Returned state: ' + write(6,'(1x,a30)')'Returned state: ' do i = 1,3*nIntFaceTot - write(6,'(x,2(e14.8,x))')state%p(i) + write(6,'(1x,2(e14.8,1x))')state%p(i) enddo write(6,*)' ' call flush(6) @@ -808,9 +808,9 @@ subroutine homogenization_RGC_averageStressAndItsTangent(& !$OMP CRITICAL (write2out) do iGrain = 1,Ngrains dPdF99 = math_Plain3333to99(dPdF(1:3,1:3,1:3,1:3,iGrain)) - write(6,'(x,a30,x,i3)')'Stress tangent of grain: ',iGrain + write(6,'(1x,a30,1x,i3)')'Stress tangent of grain: ',iGrain do i = 1,9 - write(6,'(x,(e14.8,x))') (dPdF99(i,j), j = 1,9) + write(6,'(1x,(e14.8,1x))') (dPdF99(i,j), j = 1,9) enddo write(6,*)' ' enddo @@ -954,8 +954,8 @@ subroutine homogenization_RGC_stressPenalty(& !* Debugging the surface correction factor ! if (ip == 1 .and. el == 1) then -! write(6,'(x,a20,2(x,i3))')'Correction factor: ',ip,el -! write(6,'(x,3(e10.4,x))')(surfCorr(i), i = 1,3) +! write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el +! write(6,'(1x,3(e10.4,1x))')(surfCorr(i), i = 1,3) ! endif !* ------------------------------------------------------------------------------------------------------------- @@ -1003,11 +1003,11 @@ subroutine homogenization_RGC_stressPenalty(& !* Debugging the mismatch tensor ! if (ip == 1 .and. el == 1) then -! write(6,'(x,a20,i2,x,a20,x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb +! write(6,'(1x,a20,i2,1x,a20,1x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb ! do i = 1,3 -! write(6,'(x,3(e10.4,x))')(nDef(i,j), j = 1,3) +! write(6,'(1x,3(e10.4,1x))')(nDef(i,j), j = 1,3) ! enddo -! write(6,'(x,a20,e10.4))')'with magnitude: ',nDefNorm +! write(6,'(1x,a20,e10.4))')'with magnitude: ',nDefNorm ! endif !* Compute the stress penalty of all interfaces @@ -1028,9 +1028,9 @@ subroutine homogenization_RGC_stressPenalty(& !* Debugging the stress-like penalty ! if (ip == 1 .and. el == 1) then -! write(6,'(x,a20,i2)')'Penalty of grain: ',iGrain +! write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain ! do i = 1,3 -! write(6,'(x,3(e10.4,x))')(rPen(i,j,iGrain), j = 1,3) +! write(6,'(1x,3(e10.4,1x))')(rPen(i,j,iGrain), j = 1,3) ! enddo ! endif @@ -1088,9 +1088,9 @@ subroutine homogenization_RGC_volumePenalty(& !* Debugging the stress-like penalty of volume discrepancy ! if (ip == 1 .and. el == 1) then -! write(6,'(x,a30,i2)')'Volume penalty of grain: ',iGrain +! write(6,'(1x,a30,i2)')'Volume penalty of grain: ',iGrain ! do i = 1,3 -! write(6,'(x,3(e10.4,x))')(vPen(i,j,iGrain), j = 1,3) +! write(6,'(1x,3(e10.4,1x))')(vPen(i,j,iGrain), j = 1,3) ! enddo ! endif @@ -1238,8 +1238,8 @@ function homogenization_RGC_interfaceNormal(& ! map the normal vector into sample coordinate system (basis) ! if (ip == 1 .and. el == 1) then -! write(6,'(x,a32,3(x,i3))')'Interface normal: ',intFace(1) -! write(6,'(x,3(e14.8,x))')(nVect(i), i = 1,3) +! write(6,'(1x,a32,3(1x,i3))')'Interface normal: ',intFace(1) +! write(6,'(1x,3(e14.8,1x))')(nVect(i), i = 1,3) ! write(6,*)' ' ! call flush(6) ! endif diff --git a/code/homogenization_isostrain.f90 b/code/homogenization_isostrain.f90 index ef04cb1a4..edf389dd7 100644 --- a/code/homogenization_isostrain.f90 +++ b/code/homogenization_isostrain.f90 @@ -77,7 +77,7 @@ subroutine homogenization_isostrain_init(& write(6,*) write(6,*) '<<<+- homogenization_',trim(homogenization_isostrain_label),' init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) maxNinstance = count(homogenization_type == homogenization_isostrain_label) diff --git a/code/lattice.f90 b/code/lattice.f90 index 80fe28bf1..dd2421c55 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -739,7 +739,7 @@ subroutine lattice_init() write(6,*) write(6,*) '<<<+- lattice init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) if (.not. IO_open_jobFile(fileunit,material_localFileExt)) then ! no local material configuration present... @@ -752,8 +752,8 @@ subroutine lattice_init() if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) - write(6,'(a16,x,i5)') '# phases:',Nsections - write(6,'(a16,x,i5)') '# structures:',lattice_Nstructure + write(6,'(a16,1x,i5)') '# phases:',Nsections + write(6,'(a16,1x,i5)') '# structures:',lattice_Nstructure write(6,*) !$OMP END CRITICAL (write2out) endif diff --git a/code/makefile b/code/makefile index 1982ad2bd..c184c0087 100644 --- a/code/makefile +++ b/code/makefile @@ -20,17 +20,18 @@ ######################################################################################## # OPTIONS = standard (alternative): meaning #------------------------------------------------------------- -# F90 = ifort (gfortran): compiler, choose Intel or GNU -# COMPILERNAME = overwrite name of Compiler, e.g. using mpich-g90 instead of ifort -# PORTABLE = TRUE (FALSE): decision, if executable is optimized for the machine on which it was built. -# OPTIMIZATION = DEFENSIVE (OFF,AGGRESSIVE,ULTRA): Optimization mode: O2, O0, O3 + further options for most files, O3 + further options for all files -# OPENMP = TRUE (FALSE): OpenMP multiprocessor support -# FFTWROOT = pathinfo:FFTW (will be adjusted by setup_code.py - required in pathinfo) -# IKMLROOT = pathinfo:IKML (will be adjusted by setup_code.py if present in pathinfo) -# ACMLROOT = pathinfo:ACML (will be adjusted by setup_code.py if present in pathinfo) -# LAPACKROOT = pathinfo:LAPACK (will be adjusted by setup_code.py if present in pathinfo) -# PREFIX = arbitrary prefix -# SUFFIX = arbitrary suffix +# F90 = ifort (gfortran): compiler, choose Intel or GNU +# COMPILERNAME = overwrite name of Compiler, e.g. using mpich-g90 instead of ifort +# PORTABLE = TRUE (FALSE): decision, if executable is optimized for the machine on which it was built. +# OPTIMIZATION = DEFENSIVE (OFF,AGGRESSIVE,ULTRA): Optimization mode: O2, O0, O3 + further options for most files, O3 + further options for all files +# OPENMP = TRUE (FALSE): OpenMP multiprocessor support +# FFTWROOT = pathinfo:FFTW (will be adjusted by setup_code.py - required in pathinfo) +# IKMLROOT = pathinfo:IKML (will be adjusted by setup_code.py if present in pathinfo) +# ACMLROOT = pathinfo:ACML (will be adjusted by setup_code.py if present in pathinfo) +# LAPACKROOT = pathinfo:LAPACK (will be adjusted by setup_code.py if present in pathinfo) +# PREFIX = arbitrary prefix +# SUFFIX = arbitrary suffix +# STANDARD_CHECK = checking for Fortran 2008, compiler dependend ######################################################################################## # Here are some useful debugging switches. Switch on by uncommenting the #SUFFIX line at the end of this section: # information on http://software.intel.com/en-us/articles/determining-root-cause-of-sigsegv-or-sigbus-errors/ @@ -46,9 +47,6 @@ DEBUG3 =-fp-stack-check -g -traceback -gen-interfaces -warn interfaces #should not be done for OpenMP, but set "ulimit -s unlimited" on shell. Probably it helps also to unlimit other limits DEBUG4 =-heap-arrays -#checks for standard -DEBUG5 =-stand std03/std95 - #SUFFIX =$(DEBUG1) $(DEBUG2) $(DEBUG3) ######################################################################################## @@ -115,20 +113,29 @@ endif endif endif +ifdef STANDARD_CHECK +STANDARD_CHECK_ifort = $(STANDARD_CHECK) +STANDARD_CHECK_gfortran = $(STANDARD_CHECK) +endif +STANDARD_CHECK_ifort ?= -stand f08 +STANDARD_CHECK_gfortran ?=-std=f2008 + OPTIMIZATION_OFF_ifort :=-O0 OPTIMIZATION_OFF_gfortran :=-O0 OPTIMIZATION_DEFENSIVE_ifort :=-O2 OPTIMIZATION_DEFENSIVE_gfortran :=-O2 -OPTIMIZATION_AGGRESSIVE_ifort :=-O3 $(PORTABLE_SWITCH) -ip -static -fp-model fast=2 -no-prec-div +OPTIMIZATION_AGGRESSIVE_ifort :=-O3 $(PORTABLE_SWITCH) -ip -static -fp-model fast=2 -no-prec-div -xO OPTIMIZATION_AGGRESSIVE_gfortran :=-O3 $(PORTABLE_SWITCH) -ffast-math -funroll-loops -ftree-vectorize -COMPILE_OPTIONS_ifort := -fpp -diag-disable 8291,8290 -COMPILE_OPTIONS_gfortran := -xf95-cpp-input -ffixed-line-length-132 -fno-range-check +COMPILE_OPTIONS_ifort := -fpp -diag-disable 8291,8290,5268 +#warning ID 9291,8290: +#warning ID 5268: Extension to standard: The text exceeds right hand column allowed on the line (we have only comments there) +COMPILE_OPTIONS_gfortran := -xf95-cpp-input -ffree-line-length-132 -fno-range-check -COMPILE = $(OPENMP_FLAG_$(F90)) $(COMPILE_OPTIONS_$(F90)) $(OPTIMIZATION_$(OPTI)_$(F90)) -c -COMPILE_MAXOPTI = $(OPENMP_FLAG_$(F90)) $(COMPILE_OPTIONS_$(F90)) $(OPTIMIZATION_$(MAXOPTI)_$(F90)) -c +COMPILE =$(OPENMP_FLAG_$(F90)) $(COMPILE_OPTIONS_$(F90)) $(STANDARD_CHECK_$(F90)) $(OPTIMIZATION_$(OPTI)_$(F90)) -c +COMPILE_MAXOPTI =$(OPENMP_FLAG_$(F90)) $(COMPILE_OPTIONS_$(F90)) $(STANDARD_CHECK_$(F90)) $(OPTIMIZATION_$(MAXOPTI)_$(F90)) -c diff --git a/code/material.f90 b/code/material.f90 index f4a5e39e0..444a9d51b 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -119,7 +119,7 @@ subroutine material_init() write(6,*) write(6,*) '<<<+- material init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) if (.not. IO_open_jobFile(fileunit,material_localFileExt)) then ! no local material configuration present... @@ -178,20 +178,20 @@ subroutine material_init() write (6,*) write (6,*) 'MATERIAL configuration' write (6,*) - write (6,'(a32,x,a16,x,a6)') 'homogenization ','type ','grains' + write (6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' do i = 1,material_Nhomogenization - write (6,'(x,a32,x,a16,x,i4)') homogenization_name(i),homogenization_type(i),homogenization_Ngrains(i) + write (6,'(1x,a32,1x,a16,1x,i4)') homogenization_name(i),homogenization_type(i),homogenization_Ngrains(i) enddo write (6,*) - write (6,'(a32,x,a11,x,a12,x,a13)') 'microstructure ','crystallite','constituents','homogeneous' + write (6,'(a32,1x,a11,1x,a12,1x,a13)') 'microstructure ','crystallite','constituents','homogeneous' do i = 1,material_Nmicrostructure - write (6,'(a32,4x,i4,8x,i4,8x,l)') microstructure_name(i), & + write (6,'(a32,4x,i4,8x,i4,8x,l1)') microstructure_name(i), & microstructure_crystallite(i), & microstructure_Nconstituents(i), & microstructure_elemhomo(i) if (microstructure_Nconstituents(i) > 0_pInt) then do j = 1,microstructure_Nconstituents(i) - write (6,'(a1,x,a32,x,a32,x,f6.4)') '>',phase_name(microstructure_phase(j,i)),& + write (6,'(a1,1x,a32,1x,a32,1x,f6.4)') '>',phase_name(microstructure_phase(j,i)),& texture_name(microstructure_texture(j,i)),& microstructure_fraction(j,i) enddo @@ -667,7 +667,7 @@ subroutine material_populateGrains() write (6,*) write (6,*) 'MATERIAL grain population' write (6,*) - write (6,'(a32,x,a32,x,a6)') 'homogenization_name','microstructure_name','grain#' + write (6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#' !$OMP END CRITICAL (write2out) endif do homog = 1,material_Nhomogenization ! loop over homogenizations @@ -678,7 +678,7 @@ subroutine material_populateGrains() if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) write (6,*) - write (6,'(a32,x,a32,x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains + write (6,'(a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains !$OMP END CRITICAL (write2out) endif diff --git a/code/math.f90 b/code/math.f90 index 0fda22c90..a55915222 100644 --- a/code/math.f90 +++ b/code/math.f90 @@ -31,6 +31,7 @@ real(pReal), parameter :: pi = 3.14159265358979323846264338327950288419716939937510_pReal real(pReal), parameter :: inDeg = 180.0_pReal/pi real(pReal), parameter :: inRad = pi/180.0_pReal + complex(pReal), parameter :: two_pi_img = (0.0_pReal,2.0_pReal) * pi ! *** 3x3 Identity *** real(pReal), dimension(3,3), parameter :: math_I3 = & @@ -127,8 +128,8 @@ real(pReal), dimension(4,36), parameter :: math_symOperations = & -0.5_pReal, 0.0_pReal, 0.0_pReal, 0.866025403784439_pReal, & 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal & /),(/4,36/)) - - include 'fftw3.f03' + + include 'fftw3.f03' CONTAINS @@ -153,10 +154,10 @@ real(pReal), dimension(4,36), parameter :: math_symOperations = & ! comment the first random_seed call out, set randSize to 1, and use ifort character(len=64) :: error_msg !$OMP CRITICAL (write2out) - write(6,*) + write(6,*) '' write(6,*) '<<<+- math init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) call random_seed(size=randSize) @@ -196,7 +197,7 @@ real(pReal), dimension(4,36), parameter :: math_symOperations = & q2 = math_AxisAngleToQuaternion(axisangle(1:3),axisangle(4)) if ( any(abs( q-q2) > tol_math_check) .and. & any(abs(-q-q2) > tol_math_check) ) then - write (error_msg, '(a,e14.6)' ) 'maximum deviation',min(maxval(abs( q-q2)),maxval(abs(-q-q2))) + write (error_msg, '(a,e14.6)' ) 'maximum deviation ',min(maxval(abs( q-q2)),maxval(abs(-q-q2))) call IO_error(670_pInt,ext_msg=error_msg) endif @@ -205,7 +206,7 @@ real(pReal), dimension(4,36), parameter :: math_symOperations = & q2 = math_RToQuaternion(R) if ( any(abs( q-q2) > tol_math_check) .and. & any(abs(-q-q2) > tol_math_check) ) then - write (error_msg, '(a,e14.6)' ) 'maximum deviation',min(maxval(abs( q-q2)),maxval(abs(-q-q2))) + write (error_msg, '(a,e14.6)' ) 'maximum deviation ',min(maxval(abs( q-q2)),maxval(abs(-q-q2))) call IO_error(671_pInt,ext_msg=error_msg) endif @@ -214,7 +215,7 @@ real(pReal), dimension(4,36), parameter :: math_symOperations = & q2 = math_EulerToQuaternion(Eulers) if ( any(abs( q-q2) > tol_math_check) .and. & any(abs(-q-q2) > tol_math_check) ) then - write (error_msg, '(a,e14.6)' ) 'maximum deviation',min(maxval(abs( q-q2)),maxval(abs(-q-q2))) + write (error_msg, '(a,e14.6)' ) 'maximum deviation ',min(maxval(abs( q-q2)),maxval(abs(-q-q2))) call IO_error(672_pInt,ext_msg=error_msg) endif @@ -222,7 +223,7 @@ real(pReal), dimension(4,36), parameter :: math_symOperations = & Eulers = math_RToEuler(R); R2 = math_EulerToR(Eulers) if ( any(abs( R-R2) > tol_math_check) ) then - write (error_msg, '(a,e14.6)' ) 'maximum deviation',maxval(abs( R-R2)) + write (error_msg, '(a,e14.6)' ) 'maximum deviation ',maxval(abs( R-R2)) call IO_error(673_pInt,ext_msg=error_msg) endif @@ -3267,7 +3268,6 @@ subroutine deformed_fft(res,geomdim,defgrad_av,scaling,defgrad,coords) ! other variables integer(pInt) :: i, j, k, res1_red integer(pInt), dimension(3) :: k_s - complex(pReal), parameter :: integration_factor = cmplx(0.0_pReal,1.0_pReal)*pi*2.0_pReal real(pReal), dimension(3) :: step, offset_coords if (debug_verbosity > 0_pInt) then @@ -3317,11 +3317,11 @@ subroutine deformed_fft(res,geomdim,defgrad_av,scaling,defgrad,coords) do i = 1_pInt, res1_red k_s(1) = i-1_pInt if(i/=1_pInt) coords_complex(i,j,k,1:3) = coords_complex(i,j,k,1:3)& - + defgrad_complex(i,j,k,1:3,1)*geomdim(1)/(real(k_s(1),pReal)*integration_factor) + + defgrad_complex(i,j,k,1:3,1)*geomdim(1)/(real(k_s(1),pReal)*two_pi_img) if(j/=1_pInt) coords_complex(i,j,k,1:3) = coords_complex(i,j,k,1:3)& - + defgrad_complex(i,j,k,1:3,2)*geomdim(2)/(real(k_s(2),pReal)*integration_factor) + + defgrad_complex(i,j,k,1:3,2)*geomdim(2)/(real(k_s(2),pReal)*two_pi_img) if(k/=1_pInt) coords_complex(i,j,k,1:3) = coords_complex(i,j,k,1:3)& - + defgrad_complex(i,j,k,1:3,3)*geomdim(3)/(real(k_s(3),pReal)*integration_factor) + + defgrad_complex(i,j,k,1:3,3)*geomdim(3)/(real(k_s(3),pReal)*two_pi_img) enddo; enddo; enddo call fftw_execute_dft_c2r(fftw_back,coords_complex,coords_real) @@ -3372,7 +3372,6 @@ subroutine curl_fft(res,geomdim,vec_tens,field,curl) integer(pInt) i, j, k, l, res1_red integer(pInt), dimension(3) :: k_s,cutting_freq real(pReal) :: wgt - complex(pReal), parameter :: differentation_factor = cmplx(0.0_pReal,1.0_pReal)*2.0_pReal*pi ! cmplx(0.0_pReal, 2.0_pReal*pi) gets huge rounding error (casting to single prec?) if (debug_verbosity > 0_pInt) then print*, 'Calculating curl of vector/tensor field' @@ -3430,11 +3429,11 @@ subroutine curl_fft(res,geomdim,vec_tens,field,curl) do k = 1, res(3); do j = 1, res(2);do i = 1, res1_red do l = 1, vec_tens curl_complex(i,j,k,l,1) = ( field_complex(i,j,k,l,3)*xi(i,j,k,2)& - -field_complex(i,j,k,l,2)*xi(i,j,k,3) )*differentation_factor + -field_complex(i,j,k,l,2)*xi(i,j,k,3) )*two_pi_img curl_complex(i,j,k,l,2) = (-field_complex(i,j,k,l,3)*xi(i,j,k,1)& - +field_complex(i,j,k,l,1)*xi(i,j,k,3) )*differentation_factor + +field_complex(i,j,k,l,1)*xi(i,j,k,3) )*two_pi_img curl_complex(i,j,k,l,3) = ( field_complex(i,j,k,l,2)*xi(i,j,k,1)& - -field_complex(i,j,k,l,1)*xi(i,j,k,2) )*differentation_factor + -field_complex(i,j,k,l,1)*xi(i,j,k,2) )*two_pi_img enddo enddo; enddo; enddo @@ -3477,7 +3476,6 @@ subroutine divergence_fft(res,geomdim,vec_tens,field,divergence) integer(pInt) :: i, j, k, l, res1_red real(pReal) :: wgt integer(pInt), dimension(3) :: k_s,cutting_freq - complex(pReal), parameter :: differentation_factor = cmplx(0.0_pReal,1.0_pReal)*2.0_pReal*pi ! cmplx(0.0_pReal, 2.0_pReal*pi) gets huge rounding error (casting to single prec?) if (debug_verbosity > 0_pInt) then print '(a)', 'Calculating divergence of tensor/vector field using FFT' @@ -3533,7 +3531,7 @@ subroutine divergence_fft(res,geomdim,vec_tens,field,divergence) do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res1_red do l = 1_pInt, vec_tens divergence_complex(i,j,k,l) = sum(field_complex(i,j,k,l,1:3)*xi(i,j,k,1:3))& - *differentation_factor + *two_pi_img enddo enddo; enddo; enddo call fftw_execute_dft_c2r(fftw_back, divergence_complex, divergence_real) diff --git a/code/mesh.f90 b/code/mesh.f90 index bff65c5bd..10e356212 100644 --- a/code/mesh.f90 +++ b/code/mesh.f90 @@ -276,7 +276,7 @@ write(6,*) write(6,*) '<<<+- mesh init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) call mesh_build_FEdata() ! --- get properties of the different types of elements @@ -3360,32 +3360,32 @@ enddo if (debug_verbosity > 0) then !$OMP CRITICAL (write2out) write (6,*) - write (6,*) "Input Parser: STATISTICS" + write (6,*) 'Input Parser: STATISTICS' write (6,*) - write (6,*) mesh_Nelems, " : total number of elements in mesh" - write (6,*) mesh_NcpElems, " : total number of CP elements in mesh" - write (6,*) mesh_Nnodes, " : total number of nodes in mesh" - write (6,*) mesh_maxNnodes, " : max number of nodes in any CP element" - write (6,*) mesh_maxNips, " : max number of IPs in any CP element" - write (6,*) mesh_maxNipNeighbors, " : max number of IP neighbors in any CP element" - write (6,*) mesh_maxNsubNodes, " : max number of (additional) subnodes in any CP element" - write (6,*) mesh_maxNsharedElems, " : max number of CP elements sharing a node" + write (6,*) mesh_Nelems, ' : total number of elements in mesh' + write (6,*) mesh_NcpElems, ' : total number of CP elements in mesh' + write (6,*) mesh_Nnodes, ' : total number of nodes in mesh' + write (6,*) mesh_maxNnodes, ' : max number of nodes in any CP element' + write (6,*) mesh_maxNips, ' : max number of IPs in any CP element' + write (6,*) mesh_maxNipNeighbors, ' : max number of IP neighbors in any CP element' + write (6,*) mesh_maxNsubNodes, ' : max number of (additional) subnodes in any CP element' + write (6,*) mesh_maxNsharedElems, ' : max number of CP elements sharing a node' write (6,*) - write (6,*) "Input Parser: HOMOGENIZATION/MICROSTRUCTURE" + write (6,*) 'Input Parser: HOMOGENIZATION/MICROSTRUCTURE' write (6,*) - write (6,*) mesh_maxValStateVar(1), " : maximum homogenization index" - write (6,*) mesh_maxValStateVar(2), " : maximum microstructure index" + write (6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' + write (6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' write (6,*) - write (fmt,"(a,i32.32,a)") "(9(x),a2,x,",mesh_maxValStateVar(2),"(i8))" - write (6,fmt) "+-",math_range(mesh_maxValStateVar(2)) - write (fmt,"(a,i32.32,a)") "(i8,x,a2,x,",mesh_maxValStateVar(2),"(i8))" + write (fmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' + write (6,fmt) '+-',math_range(mesh_maxValStateVar(2)) + write (fmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' do i=1,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations - write (6,fmt) i,"| ",mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures + write (6,fmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures enddo write(6,*) - write(6,*) "Input Parser: ADDITIONAL MPIE OPTIONS" + write(6,*) 'Input Parser: ADDITIONAL MPIE OPTIONS' write(6,*) - write(6,*) "periodic surface : ", mesh_periodicSurface + write(6,*) 'periodic surface : ', mesh_periodicSurface write(6,*) call flush(6) !$OMP END CRITICAL (write2out) @@ -3394,9 +3394,9 @@ endif if (debug_verbosity > 1) then !$OMP CRITICAL (write2out) write (6,*) - write (6,*) "Input Parser: SUBNODE COORDINATES" + write (6,*) 'Input Parser: SUBNODE COORDINATES' write (6,*) - write(6,'(a8,x,a5,x,a15,x,a15,x,a20,3(x,a12))') 'elem','IP','IP neighbor','IPFaceNodes','subNodeOnIPFace','x','y','z' + write(6,'(a8,1x,a5,1x,a15,1x,a15,1x,a20,3(1x,a12))') 'elem','IP','IP neighbor','IPFaceNodes','subNodeOnIPFace','x','y','z' do e = 1,mesh_NcpElems ! loop over cpElems if (debug_selectiveDebugger .and. debug_e /= e) cycle t = mesh_element(2,e) ! get elemType @@ -3404,7 +3404,7 @@ if (debug_verbosity > 1) then if (debug_selectiveDebugger .and. debug_i /= i) cycle do f = 1,FE_NipNeighbors(t) ! loop over interfaces of IP do n = 1,FE_NipFaceNodes ! loop over nodes on interface - write(6,'(i8,x,i5,x,i15,x,i15,x,i20,3(x,f12.8))') e,i,f,n,FE_subNodeOnIPFace(n,f,i,t),& + write(6,'(i8,1x,i5,1x,i15,1x,i15,1x,i20,3(1x,f12.8))') e,i,f,n,FE_subNodeOnIPFace(n,f,i,t),& mesh_subNodeCoord(1,FE_subNodeOnIPFace(n,f,i,t),e),& mesh_subNodeCoord(2,FE_subNodeOnIPFace(n,f,i,t),e),& mesh_subNodeCoord(3,FE_subNodeOnIPFace(n,f,i,t),e) @@ -3414,52 +3414,52 @@ if (debug_verbosity > 1) then enddo write(6,*) write(6,*) 'Input Parser: IP COORDINATES' - write(6,'(a8,x,a5,3(x,a12))') 'elem','IP','x','y','z' + write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' do e = 1,mesh_NcpElems if (debug_selectiveDebugger .and. debug_e /= e) cycle do i = 1,FE_Nips(mesh_element(2,e)) if (debug_selectiveDebugger .and. debug_i /= i) cycle - write (6,'(i8,x,i5,3(x,f12.8))') e, i, mesh_ipCenterOfGravity(:,i,e) + write (6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCenterOfGravity(:,i,e) enddo enddo write (6,*) - write (6,*) "Input Parser: ELEMENT VOLUME" + write (6,*) 'Input Parser: ELEMENT VOLUME' write (6,*) - write (6,"(a13,x,e15.8)") "total volume", sum(mesh_ipVolume) + write (6,'(a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) write (6,*) - write (6,"(a8,x,a5,x,a15,x,a5,x,a15,x,a16)") "elem","IP","volume","face","area","-- normal --" + write (6,'(a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' do e = 1,mesh_NcpElems if (debug_selectiveDebugger .and. debug_e /= e) cycle do i = 1,FE_Nips(mesh_element(2,e)) if (debug_selectiveDebugger .and. debug_i /= i) cycle - write (6,"(i8,x,i5,x,e15.8)") e,i,mesh_IPvolume(i,e) + write (6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) do f = 1,FE_NipNeighbors(mesh_element(2,e)) - write (6,"(i33,x,e15.8,x,3(f6.3,x))") f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) + write (6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) enddo enddo enddo write (6,*) - write (6,*) "Input Parser: NODE TWINS" + write (6,*) 'Input Parser: NODE TWINS' write (6,*) - write(6,'(a6,3(3(x),a6))') ' node','twin_x','twin_y','twin_z' + write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' do n = 1,mesh_Nnodes ! loop over cpNodes if (debug_e <= mesh_NcpElems) then if (any(mesh_element(5:,debug_e) == n)) then - write(6,'(i6,3(3(x),i6))') n, mesh_nodeTwins(1:3,n) + write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) endif endif enddo write(6,*) - write(6,*) "Input Parser: IP NEIGHBORHOOD" + write(6,*) 'Input Parser: IP NEIGHBORHOOD' write(6,*) - write(6,"(a8,x,a10,x,a10,x,a3,x,a13,x,a13)") "elem","IP","neighbor","","elemNeighbor","ipNeighbor" + write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' do e = 1,mesh_NcpElems ! loop over cpElems if (debug_selectiveDebugger .and. debug_e /= e) cycle t = mesh_element(2,e) ! get elemType do i = 1,FE_Nips(t) ! loop over IPs of elem if (debug_selectiveDebugger .and. debug_i /= i) cycle do n = 1,FE_NipNeighbors(t) ! loop over neighbors of IP - write (6,"(i8,x,i10,x,i10,x,a3,x,i13,x,i13)") e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) + write (6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) enddo enddo enddo diff --git a/code/numerics.f90 b/code/numerics.f90 index 499daa4e6..7d7866273 100644 --- a/code/numerics.f90 +++ b/code/numerics.f90 @@ -122,7 +122,7 @@ subroutine numerics_init() write(6,*) write(6,*) '<<<+- numerics init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" +#include "compilation_info.f90" !$OMP END CRITICAL (write2out) !$ call GET_ENVIRONMENT_VARIABLE(NAME='DAMASK_NUM_THREADS',VALUE=DAMASK_NumThreadsString,STATUS=gotDAMASK_NUM_THREADS) ! get environment variable DAMASK_NUM_THREADS... @@ -278,67 +278,67 @@ subroutine numerics_init() ! writing parameters to output file !$OMP CRITICAL (write2out) - write(6,'(a24,x,e8.1)') ' relevantStrain: ',relevantStrain - write(6,'(a24,x,e8.1)') ' defgradTolerance: ',defgradTolerance - write(6,'(a24,x,i8)') ' iJacoStiffness: ',iJacoStiffness - write(6,'(a24,x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum - write(6,'(a24,x,e8.1)') ' pert_Fg: ',pert_Fg - write(6,'(a24,x,i8)') ' pert_method: ',pert_method - write(6,'(a24,x,i8)') ' nCryst: ',nCryst - write(6,'(a24,x,e8.1)') ' subStepMinCryst: ',subStepMinCryst - write(6,'(a24,x,e8.1)') ' subStepSizeCryst: ',subStepSizeCryst - write(6,'(a24,x,e8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst - write(6,'(a24,x,i8)') ' nState: ',nState - write(6,'(a24,x,i8)') ' nStress: ',nStress - write(6,'(a24,x,e8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState - write(6,'(a24,x,e8.1)') ' rTol_crystalliteTemp: ',rTol_crystalliteTemperature - write(6,'(a24,x,e8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress - write(6,'(a24,x,e8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress - write(6,'(a24,2(x,i8),/)')' integrator: ',numerics_integrator + write(6,'(a24,1x,e8.1)') ' relevantStrain: ',relevantStrain + write(6,'(a24,1x,e8.1)') ' defgradTolerance: ',defgradTolerance + write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness + write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum + write(6,'(a24,1x,e8.1)') ' pert_Fg: ',pert_Fg + write(6,'(a24,1x,i8)') ' pert_method: ',pert_method + write(6,'(a24,1x,i8)') ' nCryst: ',nCryst + write(6,'(a24,1x,e8.1)') ' subStepMinCryst: ',subStepMinCryst + write(6,'(a24,1x,e8.1)') ' subStepSizeCryst: ',subStepSizeCryst + write(6,'(a24,1x,e8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst + write(6,'(a24,1x,i8)') ' nState: ',nState + write(6,'(a24,1x,i8)') ' nStress: ',nStress + write(6,'(a24,1x,e8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState + write(6,'(a24,1x,e8.1)') ' rTol_crystalliteTemp: ',rTol_crystalliteTemperature + write(6,'(a24,1x,e8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress + write(6,'(a24,1x,e8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress + write(6,'(a24,2(1x,i8),/)')' integrator: ',numerics_integrator - write(6,'(a24,x,i8)') ' nHomog: ',nHomog - write(6,'(a24,x,e8.1)') ' subStepMinHomog: ',subStepMinHomog - write(6,'(a24,x,e8.1)') ' subStepSizeHomog: ',subStepSizeHomog - write(6,'(a24,x,e8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog - write(6,'(a24,x,i8,/)') ' nMPstate: ',nMPstate + write(6,'(a24,1x,i8)') ' nHomog: ',nHomog + write(6,'(a24,1x,e8.1)') ' subStepMinHomog: ',subStepMinHomog + write(6,'(a24,1x,e8.1)') ' subStepSizeHomog: ',subStepSizeHomog + write(6,'(a24,1x,e8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog + write(6,'(a24,1x,i8,/)') ' nMPstate: ',nMPstate !* RGC parameters - write(6,'(a24,x,e8.1)') ' aTol_RGC: ',absTol_RGC - write(6,'(a24,x,e8.1)') ' rTol_RGC: ',relTol_RGC - write(6,'(a24,x,e8.1)') ' aMax_RGC: ',absMax_RGC - write(6,'(a24,x,e8.1)') ' rMax_RGC: ',relMax_RGC - write(6,'(a24,x,e8.1)') ' perturbPenalty_RGC: ',pPert_RGC - write(6,'(a24,x,e8.1)') ' relevantMismatch_RGC: ',xSmoo_RGC - write(6,'(a24,x,e8.1)') ' viscosityrate_RGC: ',viscPower_RGC - write(6,'(a24,x,e8.1)') ' viscositymodulus_RGC: ',viscModus_RGC - write(6,'(a24,x,e8.1)') ' maxrelaxation_RGC: ',maxdRelax_RGC - write(6,'(a24,x,e8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC - write(6,'(a24,x,e8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC - write(6,'(a24,x,e8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC + write(6,'(a24,1x,e8.1)') ' aTol_RGC: ',absTol_RGC + write(6,'(a24,1x,e8.1)') ' rTol_RGC: ',relTol_RGC + write(6,'(a24,1x,e8.1)') ' aMax_RGC: ',absMax_RGC + write(6,'(a24,1x,e8.1)') ' rMax_RGC: ',relMax_RGC + write(6,'(a24,1x,e8.1)') ' perturbPenalty_RGC: ',pPert_RGC + write(6,'(a24,1x,e8.1)') ' relevantMismatch_RGC: ',xSmoo_RGC + write(6,'(a24,1x,e8.1)') ' viscosityrate_RGC: ',viscPower_RGC + write(6,'(a24,1x,e8.1)') ' viscositymodulus_RGC: ',viscModus_RGC + write(6,'(a24,1x,e8.1)') ' maxrelaxation_RGC: ',maxdRelax_RGC + write(6,'(a24,1x,e8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC + write(6,'(a24,1x,e8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC + write(6,'(a24,1x,e8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC !* spectral parameters - write(6,'(a24,x,e8.1)') ' err_div_tol: ',err_div_tol - write(6,'(a24,x,e8.1)') ' err_stress_tolrel: ',err_stress_tolrel - write(6,'(a24,x,i8)') ' itmax: ',itmax - write(6,'(a24,x,L8)') ' memory_efficient: ',memory_efficient + write(6,'(a24,1x,e8.1)') ' err_div_tol: ',err_div_tol + write(6,'(a24,1x,e8.1)') ' err_stress_tolrel: ',err_stress_tolrel + write(6,'(a24,1x,i8)') ' itmax: ',itmax + write(6,'(a24,1x,L8)') ' memory_efficient: ',memory_efficient if(fftw_timelimit<0.0_pReal) then - write(6,'(a24,x,L8)') ' fftw_timelimit: ',.false. + write(6,'(a24,1x,L8)') ' fftw_timelimit: ',.false. else - write(6,'(a24,x,e8.1)') ' fftw_timelimit: ',fftw_timelimit + write(6,'(a24,1x,e8.1)') ' fftw_timelimit: ',fftw_timelimit endif - write(6,'(a24,x,a)') ' fftw_planner_string: ',trim(fftw_planner_string) - write(6,'(a24,x,i8)') ' fftw_planner_flag: ',fftw_planner_flag - write(6,'(a24,x,e8.1)') ' rotation_tol: ',rotation_tol - write(6,'(a24,x,L8,/)') ' divergence_correction: ',divergence_correction - write(6,'(a24,x,L8,/)') ' update_gamma: ',update_gamma - write(6,'(a24,x,L8,/)') ' simplified_algorithm: ',simplified_algorithm - write(6,'(a24,x,e8.1)') ' cut_off_value: ',cut_off_value + write(6,'(a24,1x,a)') ' fftw_planner_string: ',trim(fftw_planner_string) + write(6,'(a24,1x,i8)') ' fftw_planner_flag: ',fftw_planner_flag + write(6,'(a24,1x,e8.1)') ' rotation_tol: ',rotation_tol + write(6,'(a24,1x,L8,/)') ' divergence_correction: ',divergence_correction + write(6,'(a24,1x,L8,/)') ' update_gamma: ',update_gamma + write(6,'(a24,1x,L8,/)') ' simplified_algorithm: ',simplified_algorithm + write(6,'(a24,1x,e8.1)') ' cut_off_value: ',cut_off_value !* Random seeding parameters - write(6,'(a24,x,i16,/)') ' fixed_seed: ',fixedSeed + write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed !$OMP END CRITICAL (write2out) !* openMP parameter -!$ write(6,'(a24,x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt +!$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt ! sanity check if (relevantStrain <= 0.0_pReal) call IO_error(260) diff --git a/code/prec.f90 b/code/prec.f90 index 94d8c42ee..18d9dda6c 100644 --- a/code/prec.f90 +++ b/code/prec.f90 @@ -34,7 +34,7 @@ real(pReal), parameter :: tol_gravityNodePos = 1.0e-100_pReal ! NaN is precision dependent ! from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html ! copy can be found in documentation/Code/Fortran -real(pReal), parameter :: DAMASK_NaN = Z'7FF0000000000001' +real(pReal), parameter :: DAMASK_NaN = real(Z'7FF0000000000001', pReal) type :: p_vec real(pReal), dimension(:), pointer :: p end type p_vec @@ -48,12 +48,12 @@ implicit none write(6,*) write(6,*) '<<<+- prec init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" - write(6,'(a,i3)'), ' Bytes for pReal: ',pReal - write(6,'(a,i3)'), ' Bytes for pInt: ',pInt - write(6,'(a,i3)'), ' Bytes for pLongInt: ',pLongInt - write(6,'(a,e3.3)'), ' NaN: ',DAMASK_NAN - write(6,'(a,l3)'), ' NaN /= NaN: ',DAMASK_NaN/=DAMASK_NaN +#include "compilation_info.f90" + write(6,'(a,i3)') ' Bytes for pReal: ',pReal + write(6,'(a,i3)') ' Bytes for pInt: ',pInt + write(6,'(a,i3)') ' Bytes for pLongInt: ',pLongInt + write(6,'(a,e3.3)') ' NaN: ',DAMASK_NAN + write(6,'(a,l3)') ' NaN /= NaN: ',DAMASK_NaN/=DAMASK_NaN write(6,*) !$OMP END CRITICAL (write2out) diff --git a/code/prec_single.f90 b/code/prec_single.f90 index 30bbc05e2..86ab90c61 100644 --- a/code/prec_single.f90 +++ b/code/prec_single.f90 @@ -34,7 +34,7 @@ real(pReal), parameter :: tol_gravityNodePos = 1.0e-36_pReal ! NaN is precision dependent ! from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html ! copy can be found in documentation/Code/Fortran -real(pReal), parameter :: DAMASK_NaN = Z'7F800001' +real(pReal), parameter :: DAMASK_NaN = real(Z'7F800001', pReal) type :: p_vec real(pReal), dimension(:), pointer :: p end type p_vec @@ -48,12 +48,12 @@ implicit none write(6,*) write(6,*) '<<<+- prec_single init -+>>>' write(6,*) '$Id$' -#include "compilation_info.f90" - write(6,'(a,i3)'), ' Bytes for pReal: ',pReal - write(6,'(a,i3)'), ' Bytes for pInt: ',pInt - write(6,'(a,i3)'), ' Bytes for pLongInt: ',pLongInt - write(6,'(a,e3.3)'), ' NaN: ',DAMASK_NAN - write(6,'(a,l3)'), ' NaN /= NaN: ',DAMASK_NaN/=DAMASK_NaN +#include "compilation_info.f90" + write(6,'(a,i3)') ' Bytes for pReal: ',pReal + write(6,'(a,i3)') ' Bytes for pInt: ',pInt + write(6,'(a,i3)') ' Bytes for pLongInt: ',pLongInt + write(6,'(a,e3.3)') ' NaN: ',DAMASK_NAN + write(6,'(a,l3)') ' NaN /= NaN: ',DAMASK_NaN/=DAMASK_NaN write(6,*) !$OMP END CRITICAL (write2out)