diff --git a/code/DAMASK_spectral.f90 b/code/DAMASK_spectral.f90 index fe4818c89..05d775ea5 100644 --- a/code/DAMASK_spectral.f90 +++ b/code/DAMASK_spectral.f90 @@ -152,7 +152,7 @@ program DAMASK_spectral print '(a,/,a)', 'Workingdir: ',trim(getSolverWorkingDirectoryName()) print '(a,/,a)', 'SolverJobName: ',trim(getSolverJobName()) - if (.not. IO_open_file(unit,path)) call IO_error(30,ext_msg = path) + if (.not. IO_open_file(unit,path)) call IO_error(30,ext_msg = trim(path)) rewind(unit) do @@ -181,7 +181,7 @@ program DAMASK_spectral 101 N_Loadcases = N_n if ((N_l + N_Fdot /= N_n) .or. (N_n /= N_t)) & ! sanity check - call IO_error(31,ext_msg = path) ! error message for incomplete loadcase + call IO_error(31,ext_msg = trim(path)) ! error message for incomplete loadcase ! allocate memory depending on lines in input file allocate (bc_deformation(3,3,N_Loadcases)); bc_deformation = 0.0_pReal @@ -476,7 +476,7 @@ program DAMASK_spectral time = time + timeinc if (velGradApplied(loadcase)) & ! calculate fDot from given L and current F - fDot = math_mul33x33(bc_deformation(:,:,loadcase), defgradAim) + fDot = math_mul33x33(bc_deformation(1:3,1:3,loadcase), defgradAim) !winding forward of deformation aim temp33_Real = defgradAim @@ -489,11 +489,11 @@ program DAMASK_spectral do k = 1, resolution(3); do j = 1, resolution(2); do i = 1, resolution(1) temp33_Real = defgrad(i,j,k,:,:) if (velGradApplied(loadcase)) & ! use velocity gradient to calculate new deformation gradient (if not guessing) - fDot = math_mul33x33(bc_deformation(:,:,loadcase),defgradold(i,j,k,:,:)) - defgrad(i,j,k,:,:) = defgrad(i,j,k,:,:) & ! decide if guessing along former trajectory or apply homogeneous addon - + guessmode * (defgrad(i,j,k,:,:) - defgradold(i,j,k,:,:))& ! guessing... + fDot = math_mul33x33(bc_deformation(1:3,1:3,loadcase),defgradold(i,j,k,1:3,1:3)) + defgrad(i,j,k,1:3,1:3) = defgrad(i,j,k,1:3,1:3) & ! decide if guessing along former trajectory or apply homogeneous addon + + guessmode * (defgrad(i,j,k,1:3,1:3) - defgradold(i,j,k,1:3,1:3))& ! guessing... + (1.0_pReal-guessmode) * mask_defgrad * fDot *timeinc ! apply the prescribed value where deformation is given if not guessing - defgradold(i,j,k,:,:) = temp33_Real + defgradold(i,j,k,1:3,1:3) = temp33_Real enddo; enddo; enddo guessmode = 1.0_pReal ! keep guessing along former trajectory during same loadcase diff --git a/code/DAMASK_spectral_interface.f90 b/code/DAMASK_spectral_interface.f90 index fba46e91c..81ce03c4c 100644 --- a/code/DAMASK_spectral_interface.f90 +++ b/code/DAMASK_spectral_interface.f90 @@ -190,7 +190,7 @@ function rectifyPath(path) !remove ./ from path l = len_trim(path) rectifyPath = path - do i = l,2,-1 + do i = l,3,-1 if ( rectifyPath(i-1:i) == './' .and. rectifyPath(i-2:i-2) /= '.' ) & rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' enddo diff --git a/code/IO.f90 b/code/IO.f90 index eb4f2ce60..3ad9fb562 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -58,7 +58,6 @@ subroutine IO_init () call flush(6) !$OMP END CRITICAL (write2out) - return endsubroutine @@ -115,8 +114,7 @@ recursive function IO_abaqus_assembleInputFile(unit1,unit2) result(createSuccess return 200 createSuccess =.false. - return - + end function !*********************************************************** @@ -536,7 +534,7 @@ end function !******************************************************************** ! get tagged content of line !******************************************************************** - pure function IO_getTag (line,openChar,closechar) + pure function IO_getTag (line,openChar,closeChar) use prec, only: pInt implicit none @@ -553,8 +551,6 @@ end function if (left == verify(line,sep) .and. right > left) & ! openChar is first and closeChar occurs IO_getTag = line(left+1:right-1) - return - endfunction diff --git a/code/crystallite.f90 b/code/crystallite.f90 index 2abee3d54..78b82cb91 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -805,7 +805,9 @@ if(updateJaco) then mySizeDotState = constitutive_sizeDotState(g,i,e) constitutive_state(g,i,e)%p(1:mySizeState) = constitutive_state_backup(g,i,e)%p(1:mySizeState) constitutive_dotState(g,i,e)%p(1:mySizeDotState) = constitutive_dotState_backup(g,i,e)%p(1:mySizeDotState) - enddo; enddo; enddo + enddo + enddo + enddo !OMP END PARALLEL DO crystallite_Temperature = Temperature_backup crystallite_subF = F_backup @@ -842,8 +844,10 @@ if(updateJaco) then elseif (crystallite_requested(g,i,e) .and. .not. crystallite_converged(g,i,e)) then ! central solution did not converge crystallite_dPdF(1:3,1:3,1:3,1:3,g,i,e) = crystallite_fallbackdPdF(1:3,1:3,1:3,1:3,g,i,e) ! use (elastic) fallback endif - enddo; enddo; enddo - !OMP END PARALLEL DO + enddo + enddo + enddo + !$OMP END PARALLEL DO endif ! jacobian calculation @@ -2996,8 +3000,7 @@ logical error ! --- UPDATE SOME ADDITIONAL VARIABLES THAT ARE NEEDED FOR NONLOCAL MATERIAL --- ! --- we use crystallite_orientation from above, so need a seperate loop -!$OMP PARALLEL DO PRIVATE(myPhase,myInstance,myStructure,neighboring_e,neighboring_i, & -!$OMP & neighboringPhase,neighboringInstance,neighboringStructure) +!$OMP PARALLEL DO PRIVATE(myPhase,myInstance,myStructure,neighboring_e,neighboring_i,neighboringPhase,neighboringInstance,neighboringStructure) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) myPhase = material_phase(1,i,e) ! get my phase @@ -3161,9 +3164,7 @@ function crystallite_postResults(& crystallite_Temperature(g,i,e), & dt, g, i, e) c = c + constitutive_sizePostResults(g,i,e) - - return - + endfunction diff --git a/code/homogenization_RGC.f90 b/code/homogenization_RGC.f90 index 4fc827451..d03f18a73 100644 --- a/code/homogenization_RGC.f90 +++ b/code/homogenization_RGC.f90 @@ -219,8 +219,6 @@ subroutine homogenization_RGC_init(& ! (6) Volume discrepancy, (7) Avg relaxation rate component, (8) Max relaxation rate component enddo - return - endsubroutine @@ -238,8 +236,6 @@ function homogenization_RGC_stateInit(myInstance) !* Open a debugging file ! open(1978,file='homogenization_RGC_debugging.out',status='unknown') homogenization_RGC_stateInit = 0.0_pReal - - return endfunction @@ -319,8 +315,6 @@ subroutine homogenization_RGC_partitionDeformation(& endif enddo - - return endsubroutine @@ -773,8 +767,6 @@ function homogenization_RGC_updateState(& deallocate(tract,resid,jmatrix,jnverse,relax,drelax,pmatrix,smatrix,p_relax,p_resid) !*** End of calculation of state update - - return endfunction @@ -815,7 +807,7 @@ subroutine homogenization_RGC_averageStressAndItsTangent(& if (debug_verbosity == 4) then !$OMP CRITICAL (write2out) do iGrain = 1,Ngrains - dPdF99 = math_Plain3333to99(dPdF(:,:,:,:,iGrain)) + dPdF99 = math_Plain3333to99(dPdF(1:3,1:3,1:3,1:3,iGrain)) write(6,'(x,a30,x,i3)')'Stress tangent of grain: ',iGrain do i = 1,9 write(6,'(x,(e14.8,x))') (dPdF99(i,j), j = 1,9) @@ -830,8 +822,6 @@ subroutine homogenization_RGC_averageStressAndItsTangent(& avgP = sum(P,3)/dble(Ngrains) dAvgPdAvgF = sum(dPdF,5)/dble(Ngrains) - return - endsubroutine !******************************************************************** @@ -858,8 +848,6 @@ function homogenization_RGC_averageTemperature(& Ngrains = homogenization_Ngrains(mesh_element(3,el)) homogenization_RGC_averageTemperature = sum(Temperature(1:Ngrains))/dble(Ngrains) - return - endfunction !******************************************************************** @@ -915,8 +903,6 @@ pure function homogenization_RGC_postResults(& c = c + 1 end select enddo - - return endfunction @@ -1051,8 +1037,6 @@ subroutine homogenization_RGC_stressPenalty(& enddo !*** End of mismatch and penalty stress tensor calculation - return - endsubroutine !******************************************************************** @@ -1112,8 +1096,6 @@ subroutine homogenization_RGC_volumePenalty(& enddo - return - endsubroutine !******************************************************************** @@ -1159,8 +1141,6 @@ function homogenization_RGC_surfaceCorrection(& sqrt(homogenization_RGC_surfaceCorrection(iBase))*detF enddo - return - endfunction !******************************************************************** @@ -1196,8 +1176,6 @@ function homogenization_RGC_equivalentModuli(& !* Obtain the length of Burgers vector homogenization_RGC_equivalentModuli(2) = constitutive_averageBurgers(grainID,ip,el) - return - endfunction !******************************************************************** @@ -1228,8 +1206,6 @@ function homogenization_RGC_relaxationVector(& if (iNum .gt. 0_pInt) homogenization_RGC_relaxationVector = state%p((3*iNum-2):(3*iNum)) ! get the corresponding entries - return - endfunction !******************************************************************** @@ -1268,8 +1244,6 @@ function homogenization_RGC_interfaceNormal(& ! call flush(6) ! endif - return - endfunction !******************************************************************** @@ -1297,8 +1271,6 @@ function homogenization_RGC_getInterface(& if (iDir < 0_pInt) & ! to have a correlation with coordinate/position in real space homogenization_RGC_getInterface(1_pInt-iDir) = homogenization_RGC_getInterface(1_pInt-iDir)-1_pInt - return - endfunction !******************************************************************** @@ -1324,8 +1296,6 @@ function homogenization_RGC_grain1to3(& homogenization_RGC_grain1to3(2) = 1+mod((grain1-1)/nGDim(1),nGDim(2)) homogenization_RGC_grain1to3(1) = 1+mod((grain1-1),nGDim(1)) - return - endfunction !******************************************************************** @@ -1350,8 +1320,6 @@ function homogenization_RGC_grain3to1(& nGDim = homogenization_RGC_Ngrains(:,homID) homogenization_RGC_grain3to1 = grain3(1) + nGDim(1)*(grain3(2)-1) + nGDim(1)*nGDim(2)*(grain3(3)-1) - return - endfunction !******************************************************************** @@ -1393,8 +1361,6 @@ function homogenization_RGC_interface4to1(& if ((iFace4D(4) == 0_pInt) .or. (iFace4D(4) == nGDim(3))) homogenization_RGC_interface4to1 = 0_pInt endif - return - endfunction !******************************************************************** @@ -1441,8 +1407,6 @@ function homogenization_RGC_interface1to4(& homogenization_RGC_interface1to4(4) = int(dble(iFace1D-nIntFace(2)-nIntFace(1)-1)/dble(nGDim(1))/dble(nGDim(2)))+1 endif - return - endfunction !******************************************************************** @@ -1492,8 +1456,6 @@ subroutine homogenization_RGC_grainDeformation(& enddo F(:,:,iGrain) = F(:,:,iGrain) + avgF(:,:) ! relaxed deformation gradient enddo - - return endsubroutine diff --git a/code/lattice.f90 b/code/lattice.f90 index f70a908e5..61ce71c59 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -811,7 +811,6 @@ function lattice_initializeStructure(struct,CoverA) logical :: processMe integer(pInt) lattice_initializeStructure - processMe = .false. select case(struct(1:3)) ! check first three chars of structure name @@ -825,14 +824,14 @@ function lattice_initializeStructure(struct,CoverA) if (lattice_fcc_Nstructure == 1_pInt) then ! me is first fcc structure processMe = .true. do i = 1,myNslip ! calculate slip system vectors - sd(:,i) = lattice_fcc_systemSlip(1:3,i)/sqrt(math_mul3x3(lattice_fcc_systemSlip(1:3,i),lattice_fcc_systemSlip(1:3,i))) - sn(:,i) = lattice_fcc_systemSlip(4:6,i)/sqrt(math_mul3x3(lattice_fcc_systemSlip(4:6,i),lattice_fcc_systemSlip(4:6,i))) - st(:,i) = math_vectorproduct(sd(:,i),sn(:,i)) + sd(1:3,i) = lattice_fcc_systemSlip(1:3,i)/sqrt(math_mul3x3(lattice_fcc_systemSlip(1:3,i),lattice_fcc_systemSlip(1:3,i))) + sn(1:3,i) = lattice_fcc_systemSlip(4:6,i)/sqrt(math_mul3x3(lattice_fcc_systemSlip(4:6,i),lattice_fcc_systemSlip(4:6,i))) + st(1:3,i) = math_vectorproduct(sd(1:3,i),sn(1:3,i)) enddo do i = 1,myNtwin ! calculate twin system vectors and (assign) shears - td(:,i) = lattice_fcc_systemTwin(1:3,i)/sqrt(math_mul3x3(lattice_fcc_systemTwin(1:3,i),lattice_fcc_systemTwin(1:3,i))) - tn(:,i) = lattice_fcc_systemTwin(4:6,i)/sqrt(math_mul3x3(lattice_fcc_systemTwin(4:6,i),lattice_fcc_systemTwin(4:6,i))) - tt(:,i) = math_vectorproduct(td(:,i),tn(:,i)) + td(1:3,i) = lattice_fcc_systemTwin(1:3,i)/sqrt(math_mul3x3(lattice_fcc_systemTwin(1:3,i),lattice_fcc_systemTwin(1:3,i))) + tn(1:3,i) = lattice_fcc_systemTwin(4:6,i)/sqrt(math_mul3x3(lattice_fcc_systemTwin(4:6,i),lattice_fcc_systemTwin(4:6,i))) + tt(1:3,i) = math_vectorproduct(td(1:3,i),tn(1:3,i)) ts(i) = lattice_fcc_shearTwin(i) enddo interactionSlipSlip => lattice_fcc_interactionSlipSlip @@ -851,14 +850,14 @@ function lattice_initializeStructure(struct,CoverA) if (lattice_bcc_Nstructure == 1_pInt) then ! me is first bcc structure processMe = .true. do i = 1,myNslip ! calculate slip system vectors - sd(:,i) = lattice_bcc_systemSlip(1:3,i)/sqrt(math_mul3x3(lattice_bcc_systemSlip(1:3,i),lattice_bcc_systemSlip(1:3,i))) - sn(:,i) = lattice_bcc_systemSlip(4:6,i)/sqrt(math_mul3x3(lattice_bcc_systemSlip(4:6,i),lattice_bcc_systemSlip(4:6,i))) - st(:,i) = math_vectorproduct(sd(:,i),sn(:,i)) + sd(1:3,i) = lattice_bcc_systemSlip(1:3,i)/sqrt(math_mul3x3(lattice_bcc_systemSlip(1:3,i),lattice_bcc_systemSlip(1:3,i))) + sn(1:3,i) = lattice_bcc_systemSlip(4:6,i)/sqrt(math_mul3x3(lattice_bcc_systemSlip(4:6,i),lattice_bcc_systemSlip(4:6,i))) + st(1:3,i) = math_vectorproduct(sd(1:3,i),sn(1:3,i)) enddo do i = 1,myNtwin ! calculate twin system vectors and (assign) shears - td(:,i) = lattice_bcc_systemTwin(1:3,i)/sqrt(math_mul3x3(lattice_bcc_systemTwin(1:3,i),lattice_bcc_systemTwin(1:3,i))) - tn(:,i) = lattice_bcc_systemTwin(4:6,i)/sqrt(math_mul3x3(lattice_bcc_systemTwin(4:6,i),lattice_bcc_systemTwin(4:6,i))) - tt(:,i) = math_vectorproduct(td(:,i),tn(:,i)) + td(1:3,i) = lattice_bcc_systemTwin(1:3,i)/sqrt(math_mul3x3(lattice_bcc_systemTwin(1:3,i),lattice_bcc_systemTwin(1:3,i))) + tn(1:3,i) = lattice_bcc_systemTwin(4:6,i)/sqrt(math_mul3x3(lattice_bcc_systemTwin(4:6,i),lattice_bcc_systemTwin(4:6,i))) + tt(1:3,i) = math_vectorproduct(td(1:3,i),tn(1:3,i)) ts(i) = lattice_bcc_shearTwin(i) enddo interactionSlipSlip => lattice_bcc_interactionSlipSlip @@ -885,9 +884,9 @@ function lattice_initializeStructure(struct,CoverA) hex_n(2) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))/sqrt(3.0_pReal) hex_n(3) = lattice_hex_systemSlip(8,i)/CoverA - sd(:,i) = hex_d/sqrt(math_mul3x3(hex_d,hex_d)) - sn(:,i) = hex_n/sqrt(math_mul3x3(hex_n,hex_n)) - st(:,i) = math_vectorproduct(sd(:,i),sn(:,i)) + sd(1:3,i) = hex_d/sqrt(math_mul3x3(hex_d,hex_d)) + sn(1:3,i) = hex_n/sqrt(math_mul3x3(hex_n,hex_n)) + st(1:3,i) = math_vectorproduct(sd(1:3,i),sn(1:3,i)) enddo do i = 1,myNtwin hex_d(1) = lattice_hex_systemTwin(1,i)*1.5_pReal @@ -897,9 +896,9 @@ function lattice_initializeStructure(struct,CoverA) hex_n(2) = (lattice_hex_systemTwin(5,i)+2.0_pReal*lattice_hex_systemTwin(6,i))/sqrt(3.0_pReal) hex_n(3) = lattice_hex_systemTwin(8,i)/CoverA - td(:,i) = hex_d/sqrt(math_mul3x3(hex_d,hex_d)) - tn(:,i) = hex_n/sqrt(math_mul3x3(hex_n,hex_n)) - tt(:,i) = math_vectorproduct(td(:,i),tn(:,i)) + td(1:3,i) = hex_d/sqrt(math_mul3x3(hex_d,hex_d)) + tn(1:3,i) = hex_n/sqrt(math_mul3x3(hex_n,hex_n)) + tt(1:3,i) = math_vectorproduct(td(1:3,i),tn(1:3,i)) select case(lattice_hex_shearTwin(i)) ! from Christian & Mahajan 1995 p.29 case (1) ! {10.2}<-10.1> @@ -924,19 +923,19 @@ function lattice_initializeStructure(struct,CoverA) if (myStructure > lattice_Nstructure) & call IO_error(666,0,0,0,'structure index too large') ! check for memory leakage do i = 1,myNslip ! store slip system vectors and Schmid matrix for my structure - lattice_sd(:,i,myStructure) = sd(:,i) - lattice_st(:,i,myStructure) = st(:,i) - lattice_sn(:,i,myStructure) = sn(:,i) - lattice_Sslip(:,:,i,myStructure) = math_tensorproduct(sd(:,i),sn(:,i)) - lattice_Sslip_v(:,i,myStructure) = math_Mandel33to6(math_symmetric3x3(lattice_Sslip(:,:,i,myStructure))) + lattice_sd(1:3,i,myStructure) = sd(1:3,i) + lattice_st(1:3,i,myStructure) = st(1:3,i) + lattice_sn(1:3,i,myStructure) = sn(1:3,i) + lattice_Sslip(1:3,1:3,i,myStructure) = math_tensorproduct(sd(1:3,i),sn(1:3,i)) + lattice_Sslip_v(1:6,i,myStructure) = math_Mandel33to6(math_symmetric3x3(lattice_Sslip(1:3,1:3,i,myStructure))) enddo do i = 1,myNtwin ! store twin system vectors and Schmid plus rotation matrix for my structure - lattice_td(:,i,myStructure) = td(:,i) - lattice_tt(:,i,myStructure) = tt(:,i) - lattice_tn(:,i,myStructure) = tn(:,i) - lattice_Stwin(:,:,i,myStructure) = math_tensorproduct(td(:,i),tn(:,i)) - lattice_Stwin_v(:,i,myStructure) = math_Mandel33to6(math_symmetric3x3(lattice_Stwin(:,:,i,myStructure))) - lattice_Qtwin(:,:,i,myStructure) = math_AxisAngleToR(tn(:,i),180.0_pReal*inRad) + lattice_td(1:3,i,myStructure) = td(1:3,i) + lattice_tt(1:3,i,myStructure) = tt(1:3,i) + lattice_tn(1:3,i,myStructure) = tn(1:3,i) + lattice_Stwin(1:3,1:3,i,myStructure) = math_tensorproduct(td(1:3,i),tn(1:3,i)) + lattice_Stwin_v(1:6,i,myStructure) = math_Mandel33to6(math_symmetric3x3(lattice_Stwin(1:3,1:3,i,myStructure))) + lattice_Qtwin(1:3,1:3,i,myStructure) = math_AxisAngleToR(tn(1:3,i),180.0_pReal*inRad) lattice_shearTwin(i,myStructure) = ts(i) enddo lattice_NslipSystem(1:lattice_maxNslipFamily,myStructure) = myNslipSystem ! number of slip systems in each family diff --git a/code/makefile b/code/makefile index 8e8c3639b..1201a1c1d 100644 --- a/code/makefile +++ b/code/makefile @@ -10,7 +10,7 @@ # Install fftw3 (v3.2.2 is tested) with "./configure --enable-threads --enable-float" and "make", "make install" is not needed # as long as the two library files are copied to the source code directory. -# OPTIONS = standart (alternative): meaning +# OPTIONS = standard (alternative): meaning #------------------------------------------------------------- # PRECISION = double (single): floating point precision # F90 = ifort (gfortran): compiler, choose Intel or GNU @@ -19,6 +19,25 @@ # OPTIMIZATION = DEFENSIVE (OFF,AGGRESSIVE): Optimization mode, O0, O2, O3 # OPENMP = TRUE (FALSE): OpenMP multiprocessor support # ACML = OFF (ON): link with AMD math core library (v. 4.4 need to be installed) +# PREFIX: specifie an arbitrary prefix +# COMPILERNAME = overwrite name of Compiler, e.g. using mpich-g90 instead of ifort + +# Here are some usefull debugging switches. Switch on by uncommenting last line: +#-------------------------------------------------------------------------------- +# information on http://software.intel.com/en-us/articles/determining-root-cause-of-sigsegv-or-sigbus-errors/ +# check if an array index is too small (<1) or too large! +DEBUG1 =-check bounds -g +#will cause a lot of warnings because we create a bunch of temporary arrays +DEBUG2 =-check arg_temp_created +#check from time to time +DEBUG3 =-fp-stack-check -g -traceback -gen-interfaces -warn interfaces + +#should not be done for OpenMP, but set "ulimit -s unlimited" on shell. Porblably it helps to also unlimit other limits +DEBUG4 =-heap-arrays + +#SUFFIX =$(DEBUG1) $(DEBUG2) $(DEBUG3) +#SUFFIX =$(DEBUG1) $(DEBUG3) + ifeq ($(F90), ) F90 =ifort @@ -43,7 +62,7 @@ endif endif ifneq ($(OPENMP), OFF) -OPENMP_FLAG_ifort =-openmp +OPENMP_FLAG_ifort =-openmp -openmp-report0 -parallel OPENMP_FLAG_gfortran =-fopenmp OPENMP =ON endif @@ -59,49 +78,46 @@ OPTIMIZATION_OFF_ifort =-O0 OPTIMIZATION_OFF_gfortran =-O0 OPTIMIZATION_DEFENSIVE_ifort =-O2 OPTIMIZATION_DEFENSIVE_gfortran =-O2 -OPTIMIZATION_AGGRESSIVE_ifort =-O3 -static $(PORTABLE_SWITCH) +OPTIMIZATION_AGGRESSIVE_ifort =-O3 $(PORTABLE_SWITCH) -ip OPTIMIZATION_AGGRESSIVE_gfortran =-O3 -COMPILE_OPTIONS_ifort =-fpp -diag-disable 8291,8290 -COMPILE_OPTIONS_gfortran =-xf95-cpp-input - -HEAP_ARRAYS_ifort =-heap-arrays 500000000 -HEAP_ARRAYS_gfortran = - +COMPILE_OPTIONS_ifort =-fpp -diag-disable 8291,8290 +COMPILE_OPTIONS_gfortran =-xf95-cpp-input -ffree-line-length-none COMPILE =${OPENMP_FLAG_${F90}} ${COMPILE_OPTIONS_${F90}} ${OPTIMIZATION_${OPTIMIZATION}_${F90}} -c -COMPILE_HEAP =$(COMPILE) ${HEAP_ARRAYS_${F90}} -COMPILE_HEAP_MAXOPTI =${OPENMP_FLAG_${F90}} ${COMPILE_OPTIONS_${F90}} ${OPTIMIZATION_${MAXOPTI}_${F90}} ${HEAP_ARRAYS_${F90}} -c +COMPILE_MAXOPTI =${OPENMP_FLAG_${F90}} ${COMPILE_OPTIONS_${F90}} ${OPTIMIZATION_${MAXOPTI}_${F90}} -c + +ifndef COMPILERNAME +COMPILERNAME=$(F90) +endif - ifeq ($(PRECISION),single) DAMASK_spectral_single.exe: DAMASK_spectral_single.o CPFEM.a - $(F90) ${OPENMP_FLAG_${F90}} -o DAMASK_spectral_single.exe DAMASK_spectral_single.o CPFEM.a include/libfftw3f_threads.a include/libfftw3f.a constitutive.a advanced.a basics.a\ - -lpthread ${BLAS_${OPENMP}_${F90}} + $(PREFIX) $(COMPILERNAME) ${OPENMP_FLAG_${F90}} -o DAMASK_spectral_single.exe DAMASK_spectral_single.o CPFEM.a include/libfftw3f_threads.a include/libfftw3f.a\ + constitutive.a advanced.a basics.a -lpthread ${BLAS_${OPENMP}_${F90}} DAMASK_spectral_single.o: DAMASK_spectral_single.f90 CPFEM.o - $(F90) $(COMPILE_HEAP_MAXOPTI) DAMASK_spectral_single.f90 - + $(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) DAMASK_spectral_single.f90 $(SUFFIX) else DAMASK_spectral.exe: DAMASK_spectral.o CPFEM.a - $(F90) ${OPENMP_FLAG_${F90}} -o DAMASK_spectral.exe DAMASK_spectral.o CPFEM.a include/libfftw3_threads.a include/libfftw3.a constitutive.a advanced.a basics.a\ - -lpthread ${BLAS_${OPENMP}_${F90}} + $(PREFIX) $(COMPILERNAME) ${OPENMP_FLAG_${F90}} -o DAMASK_spectral.exe DAMASK_spectral.o CPFEM.a include/libfftw3_threads.a include/libfftw3.a\ + constitutive.a advanced.a basics.a -lpthread ${BLAS_${OPENMP}_${F90}} DAMASK_spectral.o: DAMASK_spectral.f90 CPFEM.o - $(F90) $(COMPILE_HEAP_MAXOPTI) DAMASK_spectral.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) DAMASK_spectral.f90 $(SUFFIX) endif CPFEM.a: CPFEM.o ar rc CPFEM.a homogenization.o homogenization_RGC.o homogenization_isostrain.o crystallite.o CPFEM.o constitutive.o CPFEM.o: CPFEM.f90 homogenization.o - $(F90) $(COMPILE_HEAP) CPFEM.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) CPFEM.f90 $(SUFFIX) homogenization.o: homogenization.f90 homogenization_isostrain.o homogenization_RGC.o crystallite.o - $(F90) $(COMPILE_HEAP) homogenization.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) homogenization.f90 $(SUFFIX) homogenization_RGC.o: homogenization_RGC.f90 constitutive.a - $(F90) $(COMPILE_HEAP) homogenization_RGC.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) homogenization_RGC.f90 $(SUFFIX) homogenization_isostrain.o: homogenization_isostrain.f90 basics.a advanced.a - $(F90) $(COMPILE_HEAP) homogenization_isostrain.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) homogenization_isostrain.f90 $(SUFFIX) crystallite.o: crystallite.f90 constitutive.a - $(F90) $(COMPILE_HEAP) crystallite.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) crystallite.f90 $(SUFFIX) @@ -109,22 +125,22 @@ constitutive.a: constitutive.o ar rc constitutive.a constitutive.o constitutive_titanmod.o constitutive_nonlocal.o constitutive_dislotwin.o constitutive_j2.o constitutive_phenopowerlaw.o basics.a advanced.a constitutive.o: constitutive.f90 constitutive_titanmod.o constitutive_nonlocal.o constitutive_dislotwin.o constitutive_j2.o constitutive_phenopowerlaw.o - $(F90) $(COMPILE_HEAP) constitutive.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive.f90 $(SUFFIX) constitutive_titanmod.o: constitutive_titanmod.f90 basics.a advanced.a - $(F90) $(COMPILE_HEAP) constitutive_titanmod.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive_titanmod.f90 $(SUFFIX) constitutive_nonlocal.o: constitutive_nonlocal.f90 basics.a advanced.a - $(F90) $(COMPILE_HEAP) constitutive_nonlocal.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive_nonlocal.f90 $(SUFFIX) constitutive_dislotwin.o: constitutive_dislotwin.f90 basics.a advanced.a - $(F90) $(COMPILE_HEAP) constitutive_dislotwin.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive_dislotwin.f90 $(SUFFIX) constitutive_j2.o: constitutive_j2.f90 basics.a advanced.a - $(F90) $(COMPILE_HEAP) constitutive_j2.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive_j2.f90 $(SUFFIX) constitutive_phenopowerlaw.o: constitutive_phenopowerlaw.f90 basics.a advanced.a - $(F90) $(COMPILE_HEAP) constitutive_phenopowerlaw.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive_phenopowerlaw.f90 $(SUFFIX) @@ -133,13 +149,13 @@ advanced.a: lattice.o lattice.o: lattice.f90 material.o - $(F90) $(COMPILE_HEAP) lattice.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) lattice.f90 $(SUFFIX) material.o: material.f90 mesh.o - $(F90) $(COMPILE_HEAP) material.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) material.f90 $(SUFFIX) mesh.o: mesh.f90 FEsolving.o - $(F90) $(COMPILE_HEAP) mesh.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) mesh.f90 $(SUFFIX) FEsolving.o: FEsolving.f90 basics.a - $(F90) $(COMPILE_HEAP) FEsolving.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) FEsolving.f90 $(SUFFIX) ifeq ($(PRECISION),single) basics.a: debug.o math.o @@ -150,25 +166,25 @@ basics.a: debug.o math.o endif debug.o: debug.f90 numerics.o - $(F90) $(COMPILE) debug.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) debug.f90 $(SUFFIX) math.o: math.f90 numerics.o - $(F90) $(COMPILE) math.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) math.f90 $(SUFFIX) numerics.o: numerics.f90 IO.o - $(F90) $(COMPILE) numerics.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) numerics.f90 $(SUFFIX) IO.o: IO.f90 DAMASK_spectral_interface.o - $(F90) $(COMPILE) IO.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) IO.f90 $(SUFFIX) ifeq ($(PRECISION),single) DAMASK_spectral_interface.o: DAMASK_spectral_interface.f90 prec_single.o - $(F90) $(COMPILE) DAMASK_spectral_interface.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) DAMASK_spectral_interface.f90 $(SUFFIX) prec_single.o: prec_single.f90 - $(F90) $(COMPILE) prec_single.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) prec_single.f90 $(SUFFIX) else DAMASK_spectral_interface.o: DAMASK_spectral_interface.f90 prec.o - $(F90) $(COMPILE) DAMASK_spectral_interface.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) DAMASK_spectral_interface.f90 $(SUFFIX) prec.o: prec.f90 - $(F90) $(COMPILE) prec.f90 + $(PREFIX) $(COMPILERNAME) $(COMPILE) prec.f90 $(SUFFIX) endif diff --git a/code/material.f90 b/code/material.f90 index 3a3db6c78..618d3624b 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -245,7 +245,6 @@ subroutine material_parseHomogenization(file,myPart) enddo 100 homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) - return endsubroutine @@ -266,7 +265,7 @@ subroutine material_parseMicrostructure(file,myPart) integer(pInt) Nsections, section, constituent, i character(len=64) tag character(len=1024) line - + Nsections = IO_countSections(file,myPart) material_Nmicrostructure = Nsections if (Nsections < 1_pInt) call IO_error(125,ext_msg=myPart) @@ -799,8 +798,6 @@ subroutine material_populateGrains() deallocate(phaseOfGrain) deallocate(textureOfGrain) deallocate(orientationOfGrain) - - return endsubroutine diff --git a/code/mesh.f90 b/code/mesh.f90 index 7d593b4df..64b0421c4 100644 --- a/code/mesh.f90 +++ b/code/mesh.f90 @@ -449,7 +449,6 @@ exit endif enddo - return endfunction @@ -1353,8 +1352,6 @@ FE_ipNeighbor(:FE_NipNeighbors(8),:FE_Nips(8),8) = & ! element 117 6, 7, 7, 6 & /),(/FE_NipFaceNodes,FE_NipNeighbors(10),FE_Nips(10)/)) - return - endsubroutine @@ -1392,9 +1389,7 @@ FE_ipNeighbor(:FE_NipNeighbors(8),:FE_Nips(8),8) = & ! element 117 endif enddo -620 return - - endsubroutine +620 endsubroutine !******************************************************************** @@ -1441,9 +1436,7 @@ do endif enddo -620 return - -endsubroutine +620 endsubroutine !******************************************************************** @@ -1490,9 +1483,7 @@ endsubroutine endif enddo -100 return - - endsubroutine +100 endsubroutine !******************************************************************** ! count overall number of nodes and elements in mesh @@ -1528,9 +1519,7 @@ endsubroutine endif enddo -620 return - - endsubroutine +620 endsubroutine !******************************************************************** ! count overall number of nodes and elements in mesh @@ -1588,8 +1577,6 @@ endsubroutine 620 if (mesh_Nnodes < 2) call IO_error(900) if (mesh_Nelems == 0) call IO_error(901) - - return endsubroutine @@ -1629,9 +1616,7 @@ endsubroutine endif enddo -620 return - - endsubroutine +620 endsubroutine !******************************************************************** @@ -1673,7 +1658,6 @@ endsubroutine 620 continue if (mesh_NelemSets == 0) call IO_error(902) - return endsubroutine @@ -1716,7 +1700,6 @@ endsubroutine 620 if (mesh_Nmaterials == 0) call IO_error(903) - return endsubroutine @@ -1731,7 +1714,6 @@ endsubroutine implicit none mesh_NcpElems = mesh_Nelems - return endsubroutine @@ -1771,9 +1753,7 @@ endsubroutine endif enddo -620 return - - endsubroutine +620 endsubroutine !******************************************************************** @@ -1825,7 +1805,6 @@ endsubroutine 620 if (mesh_NcpElems == 0) call IO_error(906) - return endsubroutine @@ -1865,9 +1844,7 @@ endsubroutine endif enddo -640 return - - endsubroutine +640 endsubroutine !******************************************************************** @@ -1917,7 +1894,6 @@ endsubroutine if (mesh_mapElemSet(1,i) == 0) call IO_error(ID=904,ext_msg=mesh_nameElemSet(i)) enddo - return endsubroutine @@ -1984,7 +1960,6 @@ endsubroutine if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(905) enddo - return endsubroutine @@ -2004,9 +1979,7 @@ endsubroutine allocate (mesh_mapFEtoCPnode(2,mesh_Nnodes)) ; mesh_mapFEtoCPnode = 0_pInt forall (i = 1:mesh_Nnodes) & - mesh_mapFEtoCPnode(:,i) = i - - return + mesh_mapFEtoCPnode(1:2,i) = i endsubroutine @@ -2054,8 +2027,6 @@ endsubroutine enddo 650 call qsort(mesh_mapFEtoCPnode,1,size(mesh_mapFEtoCPnode,2)) - - return endsubroutine @@ -2119,7 +2090,6 @@ endsubroutine 650 call qsort(mesh_mapFEtoCPnode,1,size(mesh_mapFEtoCPnode,2)) if (size(mesh_mapFEtoCPnode) == 0) call IO_error(908) - return endsubroutine @@ -2139,9 +2109,7 @@ endsubroutine allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems)) ; mesh_mapFEtoCPelem = 0_pInt forall (i = 1:mesh_NcpElems) & - mesh_mapFEtoCPelem(:,i) = i - - return + mesh_mapFEtoCPelem(1:2,i) = i endsubroutine @@ -2191,7 +2159,6 @@ endsubroutine 660 call qsort(mesh_mapFEtoCPelem,1,size(mesh_mapFEtoCPelem,2)) ! should be mesh_NcpElems - return endsubroutine @@ -2253,8 +2220,7 @@ endsubroutine 660 call qsort(mesh_mapFEtoCPelem,1,size(mesh_mapFEtoCPelem,2)) ! should be mesh_NcpElems if (size(mesh_mapFEtoCPelem) < 2) call IO_error(907) - - return + endsubroutine @@ -2328,8 +2294,7 @@ subroutine mesh_marc_count_cpSizes (unit) endif enddo -630 return - endsubroutine +630 endsubroutine !******************************************************************** @@ -2392,9 +2357,7 @@ subroutine mesh_marc_count_cpSizes (unit) endif enddo -620 return - - endsubroutine +620 endsubroutine !******************************************************************** @@ -2483,9 +2446,7 @@ subroutine mesh_marc_count_cpSizes (unit) mesh_node = mesh_node0 -100 return - - endsubroutine +100 endsubroutine !******************************************************************** @@ -2528,7 +2489,6 @@ subroutine mesh_marc_count_cpSizes (unit) enddo 670 mesh_node = mesh_node0 -return endsubroutine @@ -2588,7 +2548,6 @@ return 670 if (size(mesh_node0,2) /= mesh_Nnodes) call IO_error(909) mesh_node = mesh_node0 - return endsubroutine @@ -2676,9 +2635,7 @@ return mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) enddo -110 return - - endsubroutine +110 endsubroutine @@ -2762,9 +2719,7 @@ return endif enddo -630 return - - endsubroutine +630 endsubroutine @@ -2867,9 +2822,7 @@ return endselect enddo -630 return - - endsubroutine +630 endsubroutine !******************************************************************** @@ -3247,7 +3200,6 @@ endsubroutine allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) ; mesh_ipArea = 0.0_pReal allocate(mesh_ipAreaNormal(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) ; mesh_ipAreaNormal = 0.0_pReal - do e = 1,mesh_NcpElems ! loop over cpElems t = mesh_element(2,e) ! get elemType do i = 1,FE_Nips(t) ! loop over IPs of elem @@ -3259,14 +3211,13 @@ endsubroutine area(j,n) = sqrt(sum(normal(:,j,n)*normal(:,j,n))) ! and area end forall forall (n = 1:FE_NipFaceNodes, j = 1:Ntriangles, area(j,n) > 0.0_pReal) & - normal(:,j,n) = normal(:,j,n) / area(j,n) ! make unit normal + normal(1:3,j,n) = normal(1:3,j,n) / area(j,n) ! make unit normal mesh_ipArea(f,i,e) = sum(area) / (FE_NipFaceNodes*2.0_pReal) ! area of parallelograms instead of triangles mesh_ipAreaNormal(:,f,i,e) = sum(sum(normal,3),2) / count(area > 0.0_pReal) ! average of all valid normals enddo enddo enddo - return endsubroutine @@ -3399,11 +3350,11 @@ if (debug_verbosity > 0) then write (6,*) mesh_maxValStateVar(1), " : maximum homogenization index" write (6,*) mesh_maxValStateVar(2), " : maximum microstructure index" write (6,*) - write (fmt,"(a,i5,a)") "(9(x),a2,x,",mesh_maxValStateVar(2),"(i8))" + 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,i5,a)") "(i8,x,a2,x,",mesh_maxValStateVar(2),"(i8))" + write (fmt,"(a,i32.32,a)") "(i8,x,a2,x,",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) microstrcutures + write (6,fmt) i,"| ",mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures enddo write(6,*) write(6,*) "Input Parser: ADDITIONAL MPIE OPTIONS"