diff --git a/LICENSE b/LICENSE index 97d799216..f6371f259 100644 --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ Copyright 2011-17 Max-Planck-Institut für Eisenforschung GmbH -This program is free software: you can redistribute it and/or modify +DAMASK is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. diff --git a/PRIVATE b/PRIVATE index 55a263fc3..4708233ea 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 55a263fc30c40c16ef337be050f8901dd2747390 +Subproject commit 4708233eab5ba78931f2039fe374b7332a1e7ec7 diff --git a/VERSION b/VERSION index 1a0e0e677..63005f482 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.1-933-gf1e04ee +v2.0.1-976-g035215e diff --git a/img/COPYING b/img/COPYING new file mode 100644 index 000000000..55872ace2 --- /dev/null +++ b/img/COPYING @@ -0,0 +1,94 @@ +Creative Commons Attribution-NoDerivatives 4.0 International Public License + +By exercising the Licensed Rights (defined below), You accept and agree to be bound by the terms and conditions of this Creative Commons Attribution-NoDerivatives 4.0 International Public License ("Public License"). To the extent this Public License may be interpreted as a contract, You are granted the Licensed Rights in consideration of Your acceptance of these terms and conditions, and the Licensor grants You such rights in consideration of benefits the Licensor receives from making the Licensed Material available under these terms and conditions. + +Section 1 – Definitions. + + Adapted Material means material subject to Copyright and Similar Rights that is derived from or based upon the Licensed Material and in which the Licensed Material is translated, altered, arranged, transformed, or otherwise modified in a manner requiring permission under the Copyright and Similar Rights held by the Licensor. For purposes of this Public License, where the Licensed Material is a musical work, performance, or sound recording, Adapted Material is always produced where the Licensed Material is synched in timed relation with a moving image. + Copyright and Similar Rights means copyright and/or similar rights closely related to copyright including, without limitation, performance, broadcast, sound recording, and Sui Generis Database Rights, without regard to how the rights are labeled or categorized. For purposes of this Public License, the rights specified in Section 2(b)(1)-(2) are not Copyright and Similar Rights. + Effective Technological Measures means those measures that, in the absence of proper authority, may not be circumvented under laws fulfilling obligations under Article 11 of the WIPO Copyright Treaty adopted on December 20, 1996, and/or similar international agreements. + Exceptions and Limitations means fair use, fair dealing, and/or any other exception or limitation to Copyright and Similar Rights that applies to Your use of the Licensed Material. + Licensed Material means the artistic or literary work, database, or other material to which the Licensor applied this Public License. + Licensed Rights means the rights granted to You subject to the terms and conditions of this Public License, which are limited to all Copyright and Similar Rights that apply to Your use of the Licensed Material and that the Licensor has authority to license. + Licensor means the individual(s) or entity(ies) granting rights under this Public License. + Share means to provide material to the public by any means or process that requires permission under the Licensed Rights, such as reproduction, public display, public performance, distribution, dissemination, communication, or importation, and to make material available to the public including in ways that members of the public may access the material from a place and at a time individually chosen by them. + Sui Generis Database Rights means rights other than copyright resulting from Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, as amended and/or succeeded, as well as other essentially equivalent rights anywhere in the world. + You means the individual or entity exercising the Licensed Rights under this Public License. Your has a corresponding meaning. + +Section 2 – Scope. + + License grant. + Subject to the terms and conditions of this Public License, the Licensor hereby grants You a worldwide, royalty-free, non-sublicensable, non-exclusive, irrevocable license to exercise the Licensed Rights in the Licensed Material to: + reproduce and Share the Licensed Material, in whole or in part; and + produce and reproduce, but not Share, Adapted Material. + Exceptions and Limitations. For the avoidance of doubt, where Exceptions and Limitations apply to Your use, this Public License does not apply, and You do not need to comply with its terms and conditions. + Term. The term of this Public License is specified in Section 6(a). + Media and formats; technical modifications allowed. The Licensor authorizes You to exercise the Licensed Rights in all media and formats whether now known or hereafter created, and to make technical modifications necessary to do so. The Licensor waives and/or agrees not to assert any right or authority to forbid You from making technical modifications necessary to exercise the Licensed Rights, including technical modifications necessary to circumvent Effective Technological Measures. For purposes of this Public License, simply making modifications authorized by this Section 2(a)(4) never produces Adapted Material. + Downstream recipients. + Offer from the Licensor – Licensed Material. Every recipient of the Licensed Material automatically receives an offer from the Licensor to exercise the Licensed Rights under the terms and conditions of this Public License. + No downstream restrictions. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, the Licensed Material if doing so restricts exercise of the Licensed Rights by any recipient of the Licensed Material. + No endorsement. Nothing in this Public License constitutes or may be construed as permission to assert or imply that You are, or that Your use of the Licensed Material is, connected with, or sponsored, endorsed, or granted official status by, the Licensor or others designated to receive attribution as provided in Section 3(a)(1)(A)(i). + + Other rights. + Moral rights, such as the right of integrity, are not licensed under this Public License, nor are publicity, privacy, and/or other similar personality rights; however, to the extent possible, the Licensor waives and/or agrees not to assert any such rights held by the Licensor to the limited extent necessary to allow You to exercise the Licensed Rights, but not otherwise. + Patent and trademark rights are not licensed under this Public License. + To the extent possible, the Licensor waives any right to collect royalties from You for the exercise of the Licensed Rights, whether directly or through a collecting society under any voluntary or waivable statutory or compulsory licensing scheme. In all other cases the Licensor expressly reserves any right to collect such royalties. + +Section 3 – License Conditions. + +Your exercise of the Licensed Rights is expressly made subject to the following conditions. + + Attribution. + + If You Share the Licensed Material, You must: + retain the following if it is supplied by the Licensor with the Licensed Material: + identification of the creator(s) of the Licensed Material and any others designated to receive attribution, in any reasonable manner requested by the Licensor (including by pseudonym if designated); + a copyright notice; + a notice that refers to this Public License; + a notice that refers to the disclaimer of warranties; + a URI or hyperlink to the Licensed Material to the extent reasonably practicable; + indicate if You modified the Licensed Material and retain an indication of any previous modifications; and + indicate the Licensed Material is licensed under this Public License, and include the text of, or the URI or hyperlink to, this Public License. + For the avoidance of doubt, You do not have permission under this Public License to Share Adapted Material. + You may satisfy the conditions in Section 3(a)(1) in any reasonable manner based on the medium, means, and context in which You Share the Licensed Material. For example, it may be reasonable to satisfy the conditions by providing a URI or hyperlink to a resource that includes the required information. + If requested by the Licensor, You must remove any of the information required by Section 3(a)(1)(A) to the extent reasonably practicable. + +Section 4 – Sui Generis Database Rights. + +Where the Licensed Rights include Sui Generis Database Rights that apply to Your use of the Licensed Material: + + for the avoidance of doubt, Section 2(a)(1) grants You the right to extract, reuse, reproduce, and Share all or a substantial portion of the contents of the database, provided You do not Share Adapted Material; + if You include all or a substantial portion of the database contents in a database in which You have Sui Generis Database Rights, then the database in which You have Sui Generis Database Rights (but not its individual contents) is Adapted Material; and + You must comply with the conditions in Section 3(a) if You Share all or a substantial portion of the contents of the database. + +For the avoidance of doubt, this Section 4 supplements and does not replace Your obligations under this Public License where the Licensed Rights include other Copyright and Similar Rights. + +Section 5 – Disclaimer of Warranties and Limitation of Liability. + + Unless otherwise separately undertaken by the Licensor, to the extent possible, the Licensor offers the Licensed Material as-is and as-available, and makes no representations or warranties of any kind concerning the Licensed Material, whether express, implied, statutory, or other. This includes, without limitation, warranties of title, merchantability, fitness for a particular purpose, non-infringement, absence of latent or other defects, accuracy, or the presence or absence of errors, whether or not known or discoverable. Where disclaimers of warranties are not allowed in full or in part, this disclaimer may not apply to You. + To the extent possible, in no event will the Licensor be liable to You on any legal theory (including, without limitation, negligence) or otherwise for any direct, special, indirect, incidental, consequential, punitive, exemplary, or other losses, costs, expenses, or damages arising out of this Public License or use of the Licensed Material, even if the Licensor has been advised of the possibility of such losses, costs, expenses, or damages. Where a limitation of liability is not allowed in full or in part, this limitation may not apply to You. + + The disclaimer of warranties and limitation of liability provided above shall be interpreted in a manner that, to the extent possible, most closely approximates an absolute disclaimer and waiver of all liability. + +Section 6 – Term and Termination. + + This Public License applies for the term of the Copyright and Similar Rights licensed here. However, if You fail to comply with this Public License, then Your rights under this Public License terminate automatically. + + Where Your right to use the Licensed Material has terminated under Section 6(a), it reinstates: + automatically as of the date the violation is cured, provided it is cured within 30 days of Your discovery of the violation; or + upon express reinstatement by the Licensor. + For the avoidance of doubt, this Section 6(b) does not affect any right the Licensor may have to seek remedies for Your violations of this Public License. + For the avoidance of doubt, the Licensor may also offer the Licensed Material under separate terms or conditions or stop distributing the Licensed Material at any time; however, doing so will not terminate this Public License. + Sections 1, 5, 6, 7, and 8 survive termination of this Public License. + +Section 7 – Other Terms and Conditions. + + The Licensor shall not be bound by any additional or different terms or conditions communicated by You unless expressly agreed. + Any arrangements, understandings, or agreements regarding the Licensed Material not stated herein are separate from and independent of the terms and conditions of this Public License. + +Section 8 – Interpretation. + + For the avoidance of doubt, this Public License does not, and shall not be interpreted to, reduce, limit, restrict, or impose conditions on any use of the Licensed Material that could lawfully be made without permission under this Public License. + To the extent possible, if any provision of this Public License is deemed unenforceable, it shall be automatically reformed to the minimum extent necessary to make it enforceable. If the provision cannot be reformed, it shall be severed from this Public License without affecting the enforceability of the remaining terms and conditions. + No term or condition of this Public License will be waived and no failure to comply consented to unless expressly agreed to by the Licensor. + Nothing in this Public License constitutes or may be interpreted as a limitation upon, or waiver of, any privileges and immunities that apply to the Licensor or You, including from the legal processes of any jurisdiction or authority. diff --git a/misc/DAMASK_Favicon.ico b/img/DAMASK_Favicon.ico similarity index 100% rename from misc/DAMASK_Favicon.ico rename to img/DAMASK_Favicon.ico diff --git a/misc/DAMASK_Favicon.png b/img/DAMASK_Favicon.png similarity index 100% rename from misc/DAMASK_Favicon.png rename to img/DAMASK_Favicon.png diff --git a/img/DAMASK_Logo.png b/img/DAMASK_Logo.png new file mode 100644 index 000000000..4508c869a Binary files /dev/null and b/img/DAMASK_Logo.png differ diff --git a/img/DAMASK_Logo.psd b/img/DAMASK_Logo.psd new file mode 100644 index 000000000..781750059 Binary files /dev/null and b/img/DAMASK_Logo.psd differ diff --git a/img/DAMASK_Logo.svg b/img/DAMASK_Logo.svg new file mode 100644 index 000000000..763a717ac --- /dev/null +++ b/img/DAMASK_Logo.svg @@ -0,0 +1,131 @@ + +DAMASK logoimage/svg+xmlDAMASK logoPhilip EisenlohrDAMASK; Crystal Plasticity; Multi-PhysicsMax-Planck-Institut für Eisenforschung GmbHDAMASK +The Düsseldorf Advanced Material Simulation KitCropping frameDüsseldorf Advanced Material Simulation Kit +DAMASK + \ No newline at end of file diff --git a/img/DAMASK_LogoSmall.png b/img/DAMASK_LogoSmall.png new file mode 100644 index 000000000..1ead3266d Binary files /dev/null and b/img/DAMASK_LogoSmall.png differ diff --git a/img/DAMASK_QR-Code.png b/img/DAMASK_QR-Code.png new file mode 100644 index 000000000..854820884 Binary files /dev/null and b/img/DAMASK_QR-Code.png differ diff --git a/img/DAMASK_QR-CodeBW.png b/img/DAMASK_QR-CodeBW.png new file mode 100644 index 000000000..25445c59a Binary files /dev/null and b/img/DAMASK_QR-CodeBW.png differ diff --git a/misc/DAMASK_QR-CodeBW.svg b/img/DAMASK_QR-CodeBW.svg similarity index 83% rename from misc/DAMASK_QR-CodeBW.svg rename to img/DAMASK_QR-CodeBW.svg index 38a294ed3..0fd68cffc 100644 --- a/misc/DAMASK_QR-CodeBW.svg +++ b/img/DAMASK_QR-CodeBW.svg @@ -5,11 +5,37 @@ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:svg="http://www.w3.org/2000/svg" xmlns="http://www.w3.org/2000/svg" + xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" + xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" viewBox="0 0 104.4 104.4" height="104.4" width="104.4" version="1.1" - id="svg4314"> + id="svg4314" + sodipodi:docname="DAMASK_QR-CodeBW.svg" + inkscape:version="0.92.1 r15371"> + DAMASK QR code + @@ -18,8 +44,32 @@ image/svg+xml - + DAMASK QR code + + + + Franz Roters + + + + + DAMASK; Crystal Plasticity; Multi-Physics + + + link to https://damask.mpie.de + + + + + + + +The following is a human-readable summary of (and not a substitute for) the license: + +You are free to: + + Share — copy and redistribute the material in any medium or format for any purpose, + even commercially. + + The licensor cannot revoke these freedoms as long as you follow the license terms. + +Under the following terms: + + Attribution — You must give appropriate credit, provide a link to the license, and + indicate if changes were made. You may do so in any reasonable manner, but not in + any way that suggests the licensor endorses you or your use. + + NoDerivatives — If you remix, transform, or build upon the material, you may not + distribute the modified material. + + No additional restrictions — You may not apply legal terms or technological measures + that legally restrict others from doing anything the license permits. + diff --git a/installation/mods_Abaqus/abaqus_v6.env b/installation/mods_Abaqus/abaqus_v6.env index 0bc5063a1..8d040cb23 100644 --- a/installation/mods_Abaqus/abaqus_v6.env +++ b/installation/mods_Abaqus/abaqus_v6.env @@ -44,16 +44,6 @@ double_precision=BOTH # The user will not be asked whether old job files of the same name should be deleted. ask_delete=OFF -# You can compile DAMASK into a library to be used with abaqus -# it saves you from compiling the subroutine for each job -# in this case you do not have to specify a usersubroutine file -# however if you still do, the compiled version will override that in the library -# Procedure: -# 1. create a library directory, e.g. abqlib, in your prefered location -# 2. build the library replacing your_prefered_location/abqlib with the correct path to the directory created in 1.: -# abaqus make -l DAMASK_abaqus_std.f -dir your_prefered_location/abqlib -# abaqus make -l DAMASK_abaqus_exp.f -dir your_prefered_location/abqlib -# 3. uncomment the next line after replacing your_prefered_location/abqlib with the correct path to the directory created in 1. # usub_lib_dir='your_prefered_location/abqlib' # Remove the temporary names from the namespace diff --git a/installation/mods_Abaqus/abaqus_v6_serial.env b/installation/mods_Abaqus/abaqus_v6_serial.env index 0469dc5f9..8e4d8e367 100644 --- a/installation/mods_Abaqus/abaqus_v6_serial.env +++ b/installation/mods_Abaqus/abaqus_v6_serial.env @@ -44,16 +44,6 @@ double_precision=BOTH # The user will not be asked whether old job files of the same name should be deleted. ask_delete=OFF -# You can compile DAMASK into a library to be used with abaqus -# it saves you from compiling the subroutine for each job -# in this case you do not have to specify a usersubroutine file -# however if you still do, the compiled version will override that in the library -# Procedure: -# 1. create a library directory, e.g. abqlib, in your prefered location -# 2. build the library replacing your_prefered_location/abqlib with the correct path to the directory created in 1.: -# abaqus make -l DAMASK_abaqus_std.f -dir your_prefered_location/abqlib -# abaqus make -l DAMASK_abaqus_exp.f -dir your_prefered_location/abqlib -# 3. uncomment the next line after replacing your_prefered_location/abqlib with the correct path to the directory created in 1. # usub_lib_dir='your_prefered_location/abqlib' # Remove the temporary names from the namespace diff --git a/installation/patch/PETSc3.8 b/installation/patch/PETSc3.8 new file mode 100644 index 000000000..c6b95f775 --- /dev/null +++ b/installation/patch/PETSc3.8 @@ -0,0 +1,1528 @@ +From 2355d41203f829e5a24154184ab1a1a05e40b5e2 Mon Sep 17 00:00:00 2001 +From: Martin Diehl +Date: Sun, 5 Nov 2017 12:48:31 +0100 +Subject: [PATCH 1/3] adjusted calling of PETSc routines. Compiles but crashes + conditional prints for worldrank not needed (redirected to /dev/null) failing + during compilation is faster than during runtime + +--- + src/DAMASK_spectral.f90 | 27 ++++++------------ + src/constitutive.f90 | 6 ++-- + src/damage_local.f90 | 8 ++---- + src/damage_none.f90 | 8 ++---- + src/damage_nonlocal.f90 | 8 ++---- + src/homogenization_RGC.f90 | 8 ++---- + src/homogenization_isostrain.f90 | 8 ++---- + src/homogenization_none.f90 | 10 ++----- + src/hydrogenflux_cahnhilliard.f90 | 8 ++---- + src/hydrogenflux_isoconc.f90 | 10 ++----- + src/kinematics_cleavage_opening.f90 | 8 ++---- + src/kinematics_slipplane_opening.f90 | 8 ++---- + src/kinematics_thermal_expansion.f90 | 8 ++---- + src/kinematics_vacancy_strain.f90 | 8 ++---- + src/mesh.f90 | 10 +++---- + src/numerics.f90 | 13 ++++----- + src/spectral_damage.f90 | 37 +++++++----------------- + src/spectral_interface.f90 | 31 ++++++++++---------- + src/spectral_mech_AL.f90 | 43 +++++++++------------------- + src/spectral_mech_Basic.f90 | 48 +++++++++++-------------------- + src/spectral_mech_Polarisation.f90 | 49 +++++++++++--------------------- + src/spectral_thermal.f90 | 55 ++++++++++++++++-------------------- + src/spectral_utilities.f90 | 34 ++++++++-------------- + 23 files changed, 156 insertions(+), 297 deletions(-) + +diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 +index dc529b2e..ee6b20fc 100644 +--- a/src/DAMASK_spectral.f90 ++++ b/src/DAMASK_spectral.f90 +@@ -12,6 +12,8 @@ program DAMASK_spectral + compiler_version, & + compiler_options + #endif ++#include ++ use PETSC + use prec, only: & + pInt, & + pLongInt, & +@@ -85,11 +87,8 @@ program DAMASK_spectral + use spectral_damage + use spectral_thermal + +- + implicit none + +-#include +- + !-------------------------------------------------------------------------------------------------- + ! variables related to information from load case and geom file + real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0) +@@ -144,18 +143,11 @@ program DAMASK_spectral + integer(pInt), parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742 + integer(pInt), parameter :: maxRealOut = maxByteOut/pReal + integer(pLongInt), dimension(2) :: outputIndex +- PetscErrorCode :: ierr ++ integer :: ierr ++ + external :: & +- quit, & +- MPI_file_open, & +- MPI_file_close, & +- MPI_file_seek, & +- MPI_file_get_position, & +- MPI_file_write, & +- MPI_abort, & +- MPI_finalize, & +- MPI_allreduce, & +- PETScFinalize ++ quit ++ + + !-------------------------------------------------------------------------------------------------- + ! init DAMASK (all modules) +@@ -448,7 +440,7 @@ program DAMASK_spectral + call MPI_file_write(resUnit, & + reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & + [(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults]), & +- (outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults, & ++ int((outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults), & + MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) + if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write') + enddo +@@ -636,8 +628,7 @@ program DAMASK_spectral + notConvergedCounter = notConvergedCounter + 1_pInt + endif; flush(6) + if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency +- if (worldrank == 0) & +- write(6,'(1/,a)') ' ... writing results to file ......................................' ++ write(6,'(1/,a)') ' ... writing results to file ......................................' + call materialpoint_postResults() + call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') +@@ -646,7 +637,7 @@ program DAMASK_spectral + min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) + call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),& + [(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults]), & +- (outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults,& ++ int((outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults), & + MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write') + enddo +diff --git a/src/constitutive.f90 b/src/constitutive.f90 +index 202242ae..f124e545 100644 +--- a/src/constitutive.f90 ++++ b/src/constitutive.f90 +@@ -186,11 +186,11 @@ subroutine constitutive_init() + if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) + close(FILEUNIT) + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- constitutive init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- constitutive init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" + ++ mainProcess: if (worldrank == 0) then + !-------------------------------------------------------------------------------------------------- + ! write description file for constitutive output + call IO_write_jobFile(FILEUNIT,'outputConstitutive') +diff --git a/src/damage_local.f90 b/src/damage_local.f90 +index a24f0b1a..2f301493 100644 +--- a/src/damage_local.f90 ++++ b/src/damage_local.f90 +@@ -72,8 +72,6 @@ subroutine damage_local_init(fileUnit) + damage, & + damage_initialPhi, & + material_partHomogenization +- use numerics,only: & +- worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit +@@ -86,11 +84,9 @@ subroutine damage_local_init(fileUnit) + tag = '', & + line = '' + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt) + if (maxNinstance == 0_pInt) return +diff --git a/src/damage_none.f90 b/src/damage_none.f90 +index 746de340..4750f594 100644 +--- a/src/damage_none.f90 ++++ b/src/damage_none.f90 +@@ -26,19 +26,15 @@ subroutine damage_none_init() + use IO, only: & + IO_timeStamp + use material +- use numerics, only: & +- worldrank + + implicit none + integer(pInt) :: & + homog, & + NofMyHomog + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + initializeInstances: do homog = 1_pInt, material_Nhomogenization + +diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 +index fb960ed7..cd6ba8a5 100644 +--- a/src/damage_nonlocal.f90 ++++ b/src/damage_nonlocal.f90 +@@ -77,8 +77,6 @@ subroutine damage_nonlocal_init(fileUnit) + damage, & + damage_initialPhi, & + material_partHomogenization +- use numerics,only: & +- worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit +@@ -91,11 +89,9 @@ subroutine damage_nonlocal_init(fileUnit) + tag = '', & + line = '' + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt) + if (maxNinstance == 0_pInt) return +diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 +index 43c16a39..84cb594d 100644 +--- a/src/homogenization_RGC.f90 ++++ b/src/homogenization_RGC.f90 +@@ -100,8 +100,6 @@ subroutine homogenization_RGC_init(fileUnit) + FE_geomtype + use IO + use material +- use numerics, only: & +- worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration +@@ -117,11 +115,9 @@ subroutine homogenization_RGC_init(fileUnit) + tag = '', & + line = '' + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + maxNinstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) + if (maxNinstance == 0_pInt) return +diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 +index aeb77c27..055bfbb4 100644 +--- a/src/homogenization_isostrain.f90 ++++ b/src/homogenization_isostrain.f90 +@@ -62,8 +62,6 @@ subroutine homogenization_isostrain_init(fileUnit) + debug_levelBasic + use IO + use material +- use numerics, only: & +- worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit +@@ -80,11 +78,9 @@ subroutine homogenization_isostrain_init(fileUnit) + tag = '', & + line = '' + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + maxNinstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) + if (maxNinstance == 0) return +diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 +index 11bed781..75d8bcd3 100644 +--- a/src/homogenization_none.f90 ++++ b/src/homogenization_none.f90 +@@ -29,21 +29,17 @@ subroutine homogenization_none_init() + use IO, only: & + IO_timeStamp + use material +- use numerics, only: & +- worldrank + + implicit none + integer(pInt) :: & + homog, & + NofMyHomog + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + +- initializeInstances: do homog = 1_pInt, material_Nhomogenization ++ initializeInstances: do homog = 1_pInt, material_Nhomogenization + + myhomog: if (homogenization_type(homog) == HOMOGENIZATION_none_ID) then + NofMyHomog = count(material_homog == homog) +diff --git a/src/hydrogenflux_cahnhilliard.f90 b/src/hydrogenflux_cahnhilliard.f90 +index db08bf5d..89479a9c 100644 +--- a/src/hydrogenflux_cahnhilliard.f90 ++++ b/src/hydrogenflux_cahnhilliard.f90 +@@ -84,8 +84,6 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) + hydrogenflux_initialCh, & + material_partHomogenization, & + material_partPhase +- use numerics,only: & +- worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit +@@ -98,11 +96,9 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) + tag = '', & + line = '' + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + maxNinstance = int(count(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID),pInt) + if (maxNinstance == 0_pInt) return +diff --git a/src/hydrogenflux_isoconc.f90 b/src/hydrogenflux_isoconc.f90 +index df5c01e6..bef2a843 100644 +--- a/src/hydrogenflux_isoconc.f90 ++++ b/src/hydrogenflux_isoconc.f90 +@@ -27,21 +27,17 @@ subroutine hydrogenflux_isoconc_init() + use IO, only: & + IO_timeStamp + use material +- use numerics, only: & +- worldrank + + implicit none + integer(pInt) :: & + homog, & + NofMyHomog + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + +- initializeInstances: do homog = 1_pInt, material_Nhomogenization ++ initializeInstances: do homog = 1_pInt, material_Nhomogenization + + myhomog: if (hydrogenflux_type(homog) == HYDROGENFLUX_isoconc_ID) then + NofMyHomog = count(material_homog == homog) +diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 +index 146918f5..fffa2616 100644 +--- a/src/kinematics_cleavage_opening.f90 ++++ b/src/kinematics_cleavage_opening.f90 +@@ -81,8 +81,6 @@ subroutine kinematics_cleavage_opening_init(fileUnit) + KINEMATICS_cleavage_opening_ID, & + material_Nphase, & + MATERIAL_partPhase +- use numerics,only: & +- worldrank + use lattice, only: & + lattice_maxNcleavageFamily, & + lattice_NcleavageSystem +@@ -97,11 +95,9 @@ subroutine kinematics_cleavage_opening_init(fileUnit) + tag = '', & + line = '' + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt) + if (maxNinstance == 0_pInt) return +diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 +index f32efa92..07b98aa2 100644 +--- a/src/kinematics_slipplane_opening.f90 ++++ b/src/kinematics_slipplane_opening.f90 +@@ -81,8 +81,6 @@ subroutine kinematics_slipplane_opening_init(fileUnit) + KINEMATICS_slipplane_opening_ID, & + material_Nphase, & + MATERIAL_partPhase +- use numerics,only: & +- worldrank + use lattice, only: & + lattice_maxNslipFamily, & + lattice_NslipSystem +@@ -97,11 +95,9 @@ subroutine kinematics_slipplane_opening_init(fileUnit) + tag = '', & + line = '' + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + maxNinstance = int(count(phase_kinematics == KINEMATICS_slipplane_opening_ID),pInt) + if (maxNinstance == 0_pInt) return +diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 +index 30c267d3..e7cbca67 100644 +--- a/src/kinematics_thermal_expansion.f90 ++++ b/src/kinematics_thermal_expansion.f90 +@@ -71,8 +71,6 @@ subroutine kinematics_thermal_expansion_init(fileUnit) + KINEMATICS_thermal_expansion_ID, & + material_Nphase, & + MATERIAL_partPhase +- use numerics,only: & +- worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit +@@ -83,11 +81,9 @@ subroutine kinematics_thermal_expansion_init(fileUnit) + tag = '', & + line = '' + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + maxNinstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt) + if (maxNinstance == 0_pInt) return +diff --git a/src/kinematics_vacancy_strain.f90 b/src/kinematics_vacancy_strain.f90 +index 791c0e3c..9558f506 100644 +--- a/src/kinematics_vacancy_strain.f90 ++++ b/src/kinematics_vacancy_strain.f90 +@@ -71,8 +71,6 @@ subroutine kinematics_vacancy_strain_init(fileUnit) + KINEMATICS_vacancy_strain_ID, & + material_Nphase, & + MATERIAL_partPhase +- use numerics,only: & +- worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit +@@ -83,11 +81,9 @@ subroutine kinematics_vacancy_strain_init(fileUnit) + tag = '', & + line = '' + +- mainProcess: if (worldrank == 0) then +- write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + maxNinstance = int(count(phase_kinematics == KINEMATICS_vacancy_strain_ID),pInt) + if (maxNinstance == 0_pInt) return +diff --git a/src/mesh.f90 b/src/mesh.f90 +index 87160f2c..6e3b4823 100644 +--- a/src/mesh.f90 ++++ b/src/mesh.f90 +@@ -115,11 +115,6 @@ module mesh + logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information + #endif + +-#ifdef Spectral +-#include +- include 'fftw3-mpi.f03' +-#endif +- + ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) + ! Hence, I suggest to prefix with "FE_" + +@@ -476,6 +471,10 @@ subroutine mesh_init(ip,el) + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options ++#endif ++#ifdef Spectral ++#include ++ use petscsys + #endif + use DAMASK_interface + use IO, only: & +@@ -511,6 +510,7 @@ subroutine mesh_init(ip,el) + + implicit none + #ifdef Spectral ++ include 'fftw3-mpi.f03' + integer(C_INTPTR_T) :: devNull, local_K, local_K_offset + integer :: ierr, worldsize + #endif +diff --git a/src/numerics.f90 b/src/numerics.f90 +index 2085e221..d2d00f3e 100644 +--- a/src/numerics.f90 ++++ b/src/numerics.f90 +@@ -10,9 +10,6 @@ module numerics + + implicit none + private +-#ifdef PETSc +-#include +-#endif + character(len=64), parameter, private :: & + numerics_CONFIGFILE = 'numerics.config' !< name of configuration file + +@@ -216,6 +213,10 @@ subroutine numerics_init + IO_warning, & + IO_timeStamp, & + IO_EOF ++#ifdef PETSc ++#include ++ use petscsys ++#endif + #if defined(Spectral) || defined(FEM) + !$ use OMP_LIB, only: omp_set_num_threads ! Use the standard conforming module file for omp if using the spectral solver + implicit none +@@ -232,10 +233,8 @@ subroutine numerics_init + line + !$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS + external :: & +- MPI_Comm_rank, & +- MPI_Comm_size, & +- MPI_Abort +- ++ PETScErrorF ! is called in the CHKERRQ macro ++ + #ifdef PETSc + call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) + call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr) +diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 +index 72765987..cea6f69c 100644 +--- a/src/spectral_damage.f90 ++++ b/src/spectral_damage.f90 +@@ -4,8 +4,10 @@ + !> @brief Spectral solver for nonlocal damage + !-------------------------------------------------------------------------------------------------- + module spectral_damage ++#include ++ use PETSC + use prec, only: & +- pInt, & ++ PInt, & + pReal + use math, only: & + math_I3 +@@ -18,7 +20,6 @@ module spectral_damage + + implicit none + private +-#include + + character (len=*), parameter, public :: & + spectral_damage_label = 'spectraldamage' +@@ -48,11 +49,9 @@ module spectral_damage + spectral_damage_solution, & + spectral_damage_forward, & + spectral_damage_destroy ++ + external :: & +- PETScFinalize, & +- MPI_Abort, & +- MPI_Bcast, & +- MPI_Allreduce ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -86,21 +85,12 @@ subroutine spectral_damage_init() + Vec :: uBound, lBound + PetscErrorCode :: ierr + character(len=100) :: snes_type +- + external :: & +- SNESCreate, & + SNESSetOptionsPrefix, & ++ SNESGetType, & + DMDACreate3D, & +- SNESSetDM, & + DMDAGetCorners, & +- DMCreateGlobalVector, & +- DMDASNESSetFunctionLocal, & +- SNESSetFromOptions, & +- SNESGetType, & +- VecSet, & +- DMGetGlobalVector, & +- DMRestoreGlobalVector, & +- SNESVISetVariableBounds ++ DMDASNESSetFunctionLocal + + write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +@@ -114,7 +104,7 @@ subroutine spectral_damage_init() + do proc = 1, worldsize + call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) + enddo +- call DMDACreate3d(PETSC_COMM_WORLD, & ++ call DMDACreate3D(PETSC_COMM_WORLD, & + DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & !< cut off stencil at boundary + DMDA_STENCIL_BOX, & !< Moore (26) neighborhood around central point + grid(1),grid(2),grid(3), & !< global grid +@@ -126,7 +116,7 @@ subroutine spectral_damage_init() + call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da + call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor) + call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,& +- PETSC_NULL_OBJECT,ierr) !< residual vector of same shape as solution vector ++ PETSC_NULL_SNES,ierr) !< residual vector of same shape as solution vector + CHKERRQ(ierr) + call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) !< pull it all together with additional cli arguments + call SNESGetType(damage_snes,snes_type,ierr); CHKERRQ(ierr) +@@ -214,7 +204,7 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC + params%timeinc = timeinc + params%timeincOld = timeinc_old + +- call SNESSolve(damage_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr) ++ call SNESSolve(damage_snes,PETSC_NULL_SNES,solution,ierr); CHKERRQ(ierr) + call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr) + + if (reason < 1) then +@@ -360,9 +350,6 @@ subroutine spectral_damage_forward() + PetscScalar, dimension(:,:,:), pointer :: x_scal + PetscErrorCode :: ierr + +- external :: & +- SNESGetDM +- + if (cutBack) then + damage_current = damage_lastInc + damage_stagInc = damage_lastInc +@@ -405,10 +392,6 @@ subroutine spectral_damage_destroy() + implicit none + PetscErrorCode :: ierr + +- external :: & +- VecDestroy, & +- SNESDestroy +- + call VecDestroy(solution,ierr); CHKERRQ(ierr) + call SNESDestroy(damage_snes,ierr); CHKERRQ(ierr) + +diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 +index 3c8489d0..51360ac1 100644 +--- a/src/spectral_interface.f90 ++++ b/src/spectral_interface.f90 +@@ -11,9 +11,9 @@ + module DAMASK_interface + use prec, only: & + pInt ++ + implicit none + private +-#include + logical, public, protected :: appendToOutFile = .false. !< Append to existing spectralOut file (in case of restart, not in case of regridding) + integer(pInt), public, protected :: spectralRestartInc = 1_pInt !< Increment at which calculation starts + character(len=1024), public, protected :: & +@@ -44,7 +44,13 @@ contains + subroutine DAMASK_interface_init() + use, intrinsic :: & + iso_fortran_env +- ++#include ++#if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR!=8 ++=================================================================================================== ++========================= THIS VERSION OF DAMASK REQUIRES PETSc 3.8.x ========================= ++=================================================================================================== ++#endif ++ use PETScSys + use system_routines, only: & + getHostName + +@@ -71,12 +77,9 @@ subroutine DAMASK_interface_init() + PetscErrorCode :: ierr + logical :: error + external :: & +- quit,& +- MPI_Comm_rank,& +- MPI_Comm_size,& +- PETScInitialize, & +- MPI_Init_Thread, & +- MPI_abort ++ quit, & ++ PETScErrorF, & ! is called in the CHKERRQ macro ++ PETScInitialize + + open(6, encoding='UTF-8') ! for special characters in output + +@@ -89,7 +92,7 @@ subroutine DAMASK_interface_init() + call quit(1_pInt) + endif + #endif +- call PetscInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code ++ call PETScInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code + CHKERRQ(ierr) ! this is a macro definition, it is case sensitive + call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) + call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr) +@@ -102,10 +105,6 @@ subroutine DAMASK_interface_init() + write(output_unit,'(a)') ' STDERR != 0' + call quit(1_pInt) + endif +- if (PETSC_VERSION_MAJOR /= 3 .or. PETSC_VERSION_MINOR /= 7) then +- write(6,'(a,2(i1.1,a))') 'PETSc ',PETSC_VERSION_MAJOR,'.',PETSC_VERSION_MINOR,'.x not supported' +- call quit(1_pInt) +- endif + else mainProcess + close(6) ! disable output for non-master processes (open 6 to rank specific file for debug) + open(6,file='/dev/null',status='replace') ! close(6) alone will leave some temp files in cwd +@@ -312,9 +311,9 @@ character(len=1024) function getGeometryFile(geometryParameter) + geometryParameter + character(len=1024) :: & + cwd +- integer :: posExt, posSep +- logical :: error +- external :: quit ++ integer :: posExt, posSep ++ logical :: error ++ external :: quit + + getGeometryFile = geometryParameter + posExt = scan(getGeometryFile,'.',back=.true.) +diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 +index 6d0fff28..e7ff0fbe 100644 +--- a/src/spectral_mech_AL.f90 ++++ b/src/spectral_mech_AL.f90 +@@ -5,6 +5,8 @@ + !> @brief AL scheme solver + !-------------------------------------------------------------------------------------------------- + module spectral_mech_AL ++#include ++ use PETSC + use prec, only: & + pInt, & + pReal +@@ -16,7 +18,6 @@ module spectral_mech_AL + + implicit none + private +-#include + + character (len=*), parameter, public :: & + DAMASK_spectral_solverAL_label = 'al' +@@ -71,11 +72,9 @@ module spectral_mech_AL + AL_solution, & + AL_forward, & + AL_destroy ++ + external :: & +- PETScFinalize, & +- MPI_Abort, & +- MPI_Bcast, & +- MPI_Allreduce ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -121,21 +120,17 @@ subroutine AL_init + + PetscErrorCode :: ierr + PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_lambda ++ + integer(pInt), dimension(:), allocatable :: localK + integer(pInt) :: proc + character(len=1024) :: rankStr +- ++ + external :: & +- SNESCreate, & +- SNESSetOptionsPrefix, & +- DMDACreate3D, & +- SNESSetDM, & +- DMCreateGlobalVector, & +- DMDASNESSetFunctionLocal, & +- SNESGetConvergedReason, & ++ SNESsetOptionsPrefix, & + SNESSetConvergenceTest, & +- SNESSetFromOptions +- ++ DMDAcreate3D, & ++ DMDASNESsetFunctionLocal ++ + write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +@@ -166,9 +161,9 @@ subroutine AL_init + CHKERRQ(ierr) + call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) + call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) +- call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,PETSC_NULL_OBJECT,ierr) ++ call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,PETSC_NULL_SNES,ierr) + CHKERRQ(ierr) +- call SNESSetConvergenceTest(snes,AL_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) ++ call SNESSetConvergenceTest(snes,AL_converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) + CHKERRQ(ierr) + call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) + +@@ -280,8 +275,7 @@ type(tSolutionState) function & + SNESConvergedReason :: reason + + external :: & +- SNESSolve, & +- SNESGetConvergedReason ++ SNESsolve + + incInfo = incInfoIn + +@@ -304,7 +298,7 @@ type(tSolutionState) function & + + !-------------------------------------------------------------------------------------------------- + ! solve BVP +- call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) ++ call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) + CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- +@@ -383,10 +377,6 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr) + integer(pInt) :: & + i, j, k, e + +- external :: & +- SNESGetNumberFunctionEvals, & +- SNESGetIterationNumber +- + F => x_scal(1:3,1:3,1,& + XG_RANGE,YG_RANGE,ZG_RANGE) + F_lambda => x_scal(1:3,1:3,2,& +@@ -697,11 +687,6 @@ subroutine AL_destroy() + implicit none + PetscErrorCode :: ierr + +- external :: & +- VecDestroy, & +- SNESDestroy, & +- DMDestroy +- + call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) + call SNESDestroy(snes,ierr); CHKERRQ(ierr) + call DMDestroy(da,ierr); CHKERRQ(ierr) +diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 +index cfb72712..b02cfd8c 100644 +--- a/src/spectral_mech_Basic.f90 ++++ b/src/spectral_mech_Basic.f90 +@@ -5,6 +5,8 @@ + !> @brief Basic scheme PETSc solver + !-------------------------------------------------------------------------------------------------- + module spectral_mech_basic ++#include ++ use PETSC + use prec, only: & + pInt, & + pReal +@@ -16,7 +18,6 @@ module spectral_mech_basic + + implicit none + private +-#include + + character (len=*), parameter, public :: & + DAMASK_spectral_SolverBasicPETSC_label = 'basicpetsc' +@@ -60,11 +61,9 @@ module spectral_mech_basic + basicPETSc_solution, & + BasicPETSc_forward, & + basicPETSc_destroy ++ + external :: & +- PETScFinalize, & +- MPI_Abort, & +- MPI_Bcast, & +- MPI_Allreduce ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -116,16 +115,11 @@ subroutine basicPETSc_init + character(len=1024) :: rankStr + + external :: & +- SNESCreate, & +- SNESSetOptionsPrefix, & +- DMDACreate3D, & +- SNESSetDM, & +- DMCreateGlobalVector, & +- DMDASNESSetFunctionLocal, & +- SNESGetConvergedReason, & ++ SNESsetOptionsPrefix, & + SNESSetConvergenceTest, & +- SNESSetFromOptions +- ++ DMDAcreate3D, & ++ DMDASNESsetFunctionLocal ++ + write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +@@ -152,14 +146,14 @@ subroutine basicPETSc_init + grid(1),grid(2),localK, & ! local grid + da,ierr) ! handle, error + CHKERRQ(ierr) +- call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) +- call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) +- call DMDASNESSetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector ++ call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) ++ call DMDASNESsetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector + CHKERRQ(ierr) +- call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ! connect snes to da +- call SNESSetConvergenceTest(snes,BasicPETSC_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged" ++ call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) ! connect snes to da ++ call SNESsetConvergenceTest(snes,BasicPETSC_converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged" + CHKERRQ(ierr) +- call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments ++ call SNESsetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments + + !-------------------------------------------------------------------------------------------------- + ! init fields +@@ -253,8 +247,7 @@ type(tSolutionState) function & + SNESConvergedReason :: reason + + external :: & +- SNESSolve, & +- SNESGetConvergedReason ++ SNESsolve + + incInfo = incInfoIn + +@@ -274,7 +267,7 @@ type(tSolutionState) function & + + !-------------------------------------------------------------------------------------------------- + ! solve BVP +- call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) ++ call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) + CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- +@@ -337,10 +330,6 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) + PetscObject :: dummy + PetscErrorCode :: ierr + +- external :: & +- SNESGetNumberFunctionEvals, & +- SNESGetIterationNumber +- + call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) + call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) + +@@ -556,11 +545,6 @@ subroutine BasicPETSc_destroy() + implicit none + PetscErrorCode :: ierr + +- external :: & +- VecDestroy, & +- SNESDestroy, & +- DMDestroy +- + call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) + call SNESDestroy(snes,ierr); CHKERRQ(ierr) + call DMDestroy(da,ierr); CHKERRQ(ierr) +diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 +index ecf707d4..2b9dddc0 100644 +--- a/src/spectral_mech_Polarisation.f90 ++++ b/src/spectral_mech_Polarisation.f90 +@@ -5,6 +5,8 @@ + !> @brief Polarisation scheme solver + !-------------------------------------------------------------------------------------------------- + module spectral_mech_Polarisation ++#include ++ use PETSC + use prec, only: & + pInt, & + pReal +@@ -16,7 +18,6 @@ module spectral_mech_Polarisation + + implicit none + private +-#include + + character (len=*), parameter, public :: & + DAMASK_spectral_solverPolarisation_label = 'polarisation' +@@ -71,11 +72,9 @@ module spectral_mech_Polarisation + Polarisation_solution, & + Polarisation_forward, & + Polarisation_destroy ++ + external :: & +- PETScFinalize, & +- MPI_Abort, & +- MPI_Bcast, & +- MPI_Allreduce ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -121,21 +120,17 @@ subroutine Polarisation_init + + PetscErrorCode :: ierr + PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_tau ++ + integer(pInt), dimension(:), allocatable :: localK + integer(pInt) :: proc + character(len=1024) :: rankStr +- ++ + external :: & +- SNESCreate, & +- SNESSetOptionsPrefix, & +- DMDACreate3D, & +- SNESSetDM, & +- DMCreateGlobalVector, & +- DMDASNESSetFunctionLocal, & +- SNESGetConvergedReason, & ++ SNESsetOptionsPrefix, & + SNESSetConvergenceTest, & +- SNESSetFromOptions +- ++ DMDAcreate3D, & ++ DMDASNESsetFunctionLocal ++ + write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +@@ -164,13 +159,13 @@ subroutine Polarisation_init + grid(1),grid(2),localK, & ! local grid + da,ierr) ! handle, error + CHKERRQ(ierr) +- call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) +- call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) +- call DMDASNESSetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_OBJECT,ierr) ++ call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ++ call DMDASNESsetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_SNES,ierr) + CHKERRQ(ierr) +- call SNESSetConvergenceTest(snes,Polarisation_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) ++ call SNESsetConvergenceTest(snes,Polarisation_converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) + CHKERRQ(ierr) +- call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) ++ call SNESsetFromOptions(snes,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! init fields +@@ -280,8 +275,7 @@ type(tSolutionState) function & + SNESConvergedReason :: reason + + external :: & +- SNESSolve, & +- SNESGetConvergedReason ++ SNESsolve + + incInfo = incInfoIn + +@@ -304,7 +298,7 @@ type(tSolutionState) function & + + !-------------------------------------------------------------------------------------------------- + ! solve BVP +- call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) ++ call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) + CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- +@@ -383,10 +377,6 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr) + integer(pInt) :: & + i, j, k, e + +- external :: & +- SNESGetNumberFunctionEvals, & +- SNESGetIterationNumber +- + F => x_scal(1:3,1:3,1,& + XG_RANGE,YG_RANGE,ZG_RANGE) + F_tau => x_scal(1:3,1:3,2,& +@@ -698,11 +688,6 @@ subroutine Polarisation_destroy() + implicit none + PetscErrorCode :: ierr + +- external :: & +- VecDestroy, & +- SNESDestroy, & +- DMDestroy +- + call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) + call SNESDestroy(snes,ierr); CHKERRQ(ierr) + call DMDestroy(da,ierr); CHKERRQ(ierr) +diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 +index 322f1203..cc0f7678 100644 +--- a/src/spectral_thermal.f90 ++++ b/src/spectral_thermal.f90 +@@ -4,6 +4,8 @@ + !> @brief Spectral solver for thermal conduction + !-------------------------------------------------------------------------------------------------- + module spectral_thermal ++#include ++ use PETSC + use prec, only: & + pInt, & + pReal +@@ -18,7 +20,6 @@ module spectral_thermal + + implicit none + private +-#include + + character (len=*), parameter, public :: & + spectral_thermal_label = 'spectralthermal' +@@ -48,11 +49,9 @@ module spectral_thermal + spectral_thermal_solution, & + spectral_thermal_forward, & + spectral_thermal_destroy ++ + external :: & +- PETScFinalize, & +- MPI_Abort, & +- MPI_Bcast, & +- MPI_Allreduce ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -84,28 +83,24 @@ subroutine spectral_thermal_init + thermalMapping + + implicit none +- integer(pInt), dimension(:), allocatable :: localK +- integer(pInt) :: proc + integer(pInt) :: i, j, k, cell + DM :: thermal_grid +- PetscScalar, dimension(:,:,:), pointer :: x_scal ++ + PetscErrorCode :: ierr ++ PetscScalar, dimension(:,:,:), pointer :: x_scal ++ ++ integer(pInt), dimension(:), allocatable :: localK ++ integer(pInt) :: proc + + external :: & +- SNESCreate, & +- SNESSetOptionsPrefix, & +- DMDACreate3D, & +- SNESSetDM, & +- DMDAGetCorners, & +- DMCreateGlobalVector, & +- DMDASNESSetFunctionLocal, & +- SNESSetFromOptions +- +- mainProcess: if (worldrank == 0_pInt) then +- write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ SNESsetOptionsPrefix, & ++ DMDAcreate3D, & ++ DMDAgetCorners, & ++ DMDASNESsetFunctionLocal ++ ++ write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + !-------------------------------------------------------------------------------------------------- + ! initialize solver specific parts of PETSc +@@ -127,7 +122,7 @@ subroutine spectral_thermal_init + call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da + call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) + call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& +- PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector ++ PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector + CHKERRQ(ierr) + call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments + +@@ -215,7 +210,7 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load + params%timeinc = timeinc + params%timeincOld = timeinc_old + +- call SNESSolve(thermal_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr) ++ call SNESSolve(thermal_snes,PETSC_NULL_SNES,solution,ierr); CHKERRQ(ierr) + call SNESGetConvergedReason(thermal_snes,reason,ierr); CHKERRQ(ierr) + + if (reason < 1) then +@@ -245,14 +240,12 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load + + call VecMin(solution,position,minTemperature,ierr); CHKERRQ(ierr) + call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr) +- if (worldrank == 0) then +- if (spectral_thermal_solution%converged) & +- write(6,'(/,a)') ' ... thermal conduction converged ..................................' +- write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',& +- minTemperature, maxTemperature, stagNorm +- write(6,'(/,a)') ' ===========================================================================' +- flush(6) +- endif ++ if (spectral_thermal_solution%converged) & ++ write(6,'(/,a)') ' ... thermal conduction converged ..................................' ++ write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',& ++ minTemperature, maxTemperature, stagNorm ++ write(6,'(/,a)') ' ===========================================================================' ++ flush(6) + + end function spectral_thermal_solution + +diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 +index 1ad25174..bbef337f 100644 +--- a/src/spectral_utilities.f90 ++++ b/src/spectral_utilities.f90 +@@ -5,15 +5,16 @@ + !-------------------------------------------------------------------------------------------------- + module spectral_utilities + use, intrinsic :: iso_c_binding ++#include ++ use PETScSys + use prec, only: & + pReal, & + pInt + use math, only: & + math_I3 +- ++ + implicit none + private +-#include + include 'fftw3-mpi.f03' + + logical, public :: cutBack =.false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill +@@ -148,6 +149,8 @@ module spectral_utilities + FIELD_DAMAGE_ID + private :: & + utilities_getFreqDerivative ++ external :: & ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -196,12 +199,6 @@ subroutine utilities_init() + geomSize + + implicit none +- +- external :: & +- PETScOptionsClear, & +- PETScOptionsInsertString, & +- MPI_Abort +- + PetscErrorCode :: ierr + integer(pInt) :: i, j, k + integer(pInt), dimension(3) :: k_s +@@ -215,6 +212,8 @@ subroutine utilities_init() + scalarSize = 1_C_INTPTR_T, & + vecSize = 3_C_INTPTR_T, & + tensorSize = 9_C_INTPTR_T ++ external :: & ++ PetscOptionsInsertString + + write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +@@ -231,13 +230,13 @@ subroutine utilities_init() + trim(PETScDebug), & + ' add more using the PETSc_Options keyword in numerics.config '; flush(6) + +- call PetscOptionsClear(PETSC_NULL_OBJECT,ierr) ++ call PETScOptionsClear(PETSC_NULL_OPTIONS,ierr) + CHKERRQ(ierr) +- if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(PETSCDEBUG),ierr) ++ if(debugPETSc) call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr) + CHKERRQ(ierr) +- call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_defaultOptions),ierr) ++ call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr) + CHKERRQ(ierr) +- call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_options),ierr) ++ call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr) + CHKERRQ(ierr) + + grid1Red = grid(1)/2_pInt + 1_pInt +@@ -632,9 +631,6 @@ real(pReal) function utilities_divergenceRMS() + integer(pInt) :: i, j, k, ierr + complex(pReal), dimension(3) :: rescaledGeom + +- external :: & +- MPI_Allreduce +- + write(6,'(/,a)') ' ... calculating divergence ................................................' + flush(6) + +@@ -686,9 +682,6 @@ real(pReal) function utilities_curlRMS() + complex(pReal), dimension(3,3) :: curl_fourier + complex(pReal), dimension(3) :: rescaledGeom + +- external :: & +- MPI_Allreduce +- + write(6,'(/,a)') ' ... calculating curl ......................................................' + flush(6) + +@@ -1096,9 +1089,6 @@ function utilities_forwardField(timeinc,field_lastInc,rate,aim) + real(pReal), dimension(3,3) :: fieldDiff !< - aim + PetscErrorCode :: ierr + +- external :: & +- MPI_Allreduce +- + utilities_forwardField = field_lastInc + rate*timeinc + if (present(aim)) then !< correct to match average + fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt +@@ -1190,8 +1180,6 @@ subroutine utilities_updateIPcoords(F) + integer(pInt) :: i, j, k, m, ierr + real(pReal), dimension(3) :: step, offset_coords + real(pReal), dimension(3,3) :: Favg +- external & +- MPI_Bcast + + !-------------------------------------------------------------------------------------------------- + ! integration in Fourier space +-- +2.15.0 + + +From 237f199bbf574bb2509123ce8b037ac751abd15d Mon Sep 17 00:00:00 2001 +From: Martin Diehl +Date: Sun, 5 Nov 2017 13:45:52 +0100 +Subject: [PATCH 2/3] extra function calls for da needed + (https://lists.mcs.anl.gov/pipermail/petsc-users/2017-February/031538.html) + SNESsolve requires PETSC_NULL_VEC not PETSC_NULL_SNES (indicating b=0) + +--- + src/spectral_damage.f90 | 4 +++- + src/spectral_mech_AL.f90 | 5 +++-- + src/spectral_mech_Basic.f90 | 6 +++--- + src/spectral_mech_Polarisation.f90 | 5 +++-- + src/spectral_thermal.f90 | 22 ++++++++++++---------- + 5 files changed, 24 insertions(+), 18 deletions(-) + +diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 +index cea6f69c..2c195c56 100644 +--- a/src/spectral_damage.f90 ++++ b/src/spectral_damage.f90 +@@ -114,6 +114,8 @@ subroutine spectral_damage_init() + damage_grid,ierr) !< handle, error + CHKERRQ(ierr) + call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) + call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor) + call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,& + PETSC_NULL_SNES,ierr) !< residual vector of same shape as solution vector +@@ -204,7 +206,7 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC + params%timeinc = timeinc + params%timeincOld = timeinc_old + +- call SNESSolve(damage_snes,PETSC_NULL_SNES,solution,ierr); CHKERRQ(ierr) ++ call SNESSolve(damage_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) + call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr) + + if (reason < 1) then +diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 +index e7ff0fbe..dc221f6c 100644 +--- a/src/spectral_mech_AL.f90 ++++ b/src/spectral_mech_AL.f90 +@@ -160,6 +160,8 @@ subroutine AL_init + da,ierr) ! handle, error + CHKERRQ(ierr) + call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) + call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) + call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,PETSC_NULL_SNES,ierr) + CHKERRQ(ierr) +@@ -298,8 +300,7 @@ type(tSolutionState) function & + + !-------------------------------------------------------------------------------------------------- + ! solve BVP +- call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) +- CHKERRQ(ierr) ++ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! check convergence +diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 +index b02cfd8c..c335f2d7 100644 +--- a/src/spectral_mech_Basic.f90 ++++ b/src/spectral_mech_Basic.f90 +@@ -147,6 +147,8 @@ subroutine basicPETSc_init + da,ierr) ! handle, error + CHKERRQ(ierr) + call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) + call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) + call DMDASNESsetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector + CHKERRQ(ierr) +@@ -158,7 +160,6 @@ subroutine basicPETSc_init + !-------------------------------------------------------------------------------------------------- + ! init fields + call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! get the data out of PETSc to work with +- + restart: if (restartInc > 1_pInt) then + if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & + write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & +@@ -267,8 +268,7 @@ type(tSolutionState) function & + + !-------------------------------------------------------------------------------------------------- + ! solve BVP +- call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) +- CHKERRQ(ierr) ++ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! check convergence +diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 +index 2b9dddc0..3b024f56 100644 +--- a/src/spectral_mech_Polarisation.f90 ++++ b/src/spectral_mech_Polarisation.f90 +@@ -160,6 +160,8 @@ subroutine Polarisation_init + da,ierr) ! handle, error + CHKERRQ(ierr) + call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) + call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) + call DMDASNESsetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_SNES,ierr) + CHKERRQ(ierr) +@@ -298,8 +300,7 @@ type(tSolutionState) function & + + !-------------------------------------------------------------------------------------------------- + ! solve BVP +- call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) +- CHKERRQ(ierr) ++ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! check convergence +diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 +index cc0f7678..7115538c 100644 +--- a/src/spectral_thermal.f90 ++++ b/src/spectral_thermal.f90 +@@ -119,16 +119,18 @@ subroutine spectral_thermal_init + grid (1),grid(2),localK, & ! local grid + thermal_grid,ierr) ! handle, error + CHKERRQ(ierr) +- call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da +- call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) +- call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& ++ call SNESsetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) ++ call DMcreateGlobalVector(thermal_grid,solution,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) ++ call DMDASNESsetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& + PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector + CHKERRQ(ierr) +- call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments ++ call SNESsetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments + + !-------------------------------------------------------------------------------------------------- + ! init fields +- call DMDAGetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) ++ call DMDAgetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) + CHKERRQ(ierr) + xend = xstart + xend - 1 + yend = ystart + yend - 1 +@@ -144,9 +146,9 @@ subroutine spectral_thermal_init + temperature_lastInc(i,j,k) = temperature_current(i,j,k) + temperature_stagInc(i,j,k) = temperature_current(i,j,k) + enddo; enddo; enddo +- call DMDAVecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with ++ call DMDAvecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with + x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current +- call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) ++ call DMDAvecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! thermal reference diffusion update +@@ -200,8 +202,8 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load + external :: & + VecMin, & + VecMax, & +- SNESSolve, & +- SNESGetConvergedReason ++ SNESsolve, & ++ SNESgetConvergedReason + + spectral_thermal_solution%converged =.false. + +@@ -210,7 +212,7 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load + params%timeinc = timeinc + params%timeincOld = timeinc_old + +- call SNESSolve(thermal_snes,PETSC_NULL_SNES,solution,ierr); CHKERRQ(ierr) ++ call SNESsolve(thermal_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) + call SNESGetConvergedReason(thermal_snes,reason,ierr); CHKERRQ(ierr) + + if (reason < 1) then +-- +2.15.0 + + +From 1af2e332a1b86f388aa9e481255f4405874d7960 Mon Sep 17 00:00:00 2001 +From: Martin Diehl +Date: Sun, 5 Nov 2017 14:18:45 +0100 +Subject: [PATCH 3/3] named better in thermal and damage + +--- + src/spectral_damage.f90 | 4 ++-- + src/spectral_thermal.f90 | 4 ++-- + 2 files changed, 4 insertions(+), 4 deletions(-) + +diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 +index 2c195c56..11da3b96 100644 +--- a/src/spectral_damage.f90 ++++ b/src/spectral_damage.f90 +@@ -114,8 +114,8 @@ subroutine spectral_damage_init() + damage_grid,ierr) !< handle, error + CHKERRQ(ierr) + call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da +- call DMsetFromOptions(da,ierr); CHKERRQ(ierr) +- call DMsetUp(da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(damage_grid,ierr); CHKERRQ(ierr) ++ call DMsetUp(damage_grid,ierr); CHKERRQ(ierr) + call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor) + call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,& + PETSC_NULL_SNES,ierr) !< residual vector of same shape as solution vector +diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 +index 7115538c..2374d83b 100644 +--- a/src/spectral_thermal.f90 ++++ b/src/spectral_thermal.f90 +@@ -120,8 +120,8 @@ subroutine spectral_thermal_init + thermal_grid,ierr) ! handle, error + CHKERRQ(ierr) + call SNESsetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da +- call DMsetFromOptions(da,ierr); CHKERRQ(ierr) +- call DMsetUp(da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(thermal_grid,ierr); CHKERRQ(ierr) ++ call DMsetUp(thermal_grid,ierr); CHKERRQ(ierr) + call DMcreateGlobalVector(thermal_grid,solution,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) + call DMDASNESsetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& + PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector +-- +2.15.0 + diff --git a/installation/patch/README.md b/installation/patch/README.md index f5b9f9706..cd4549b2b 100644 --- a/installation/patch/README.md +++ b/installation/patch/README.md @@ -13,3 +13,6 @@ patch -p1 < installation/patch/nameOfPatch * **fwbw_derivative** switches the default spatial derivative from continuous to forward/backward difference. This generally reduces spurious oscillations in the result as the spatial accuracy of the derivative is then compatible with the underlying solution grid. + + * **PETSc-3.8** adjusts all includes nad calls to PETSc to the 3.8.x API + This allows to use the current version of PETSc diff --git a/misc/DAMASK_LogoLarge.png b/misc/DAMASK_LogoLarge.png deleted file mode 100644 index 2622feab4..000000000 Binary files a/misc/DAMASK_LogoLarge.png and /dev/null differ diff --git a/misc/DAMASK_LogoSmall.png b/misc/DAMASK_LogoSmall.png deleted file mode 100644 index 6897cfeea..000000000 Binary files a/misc/DAMASK_LogoSmall.png and /dev/null differ diff --git a/misc/DAMASK_QR-Code.png b/misc/DAMASK_QR-Code.png deleted file mode 100644 index 8fb9bace9..000000000 Binary files a/misc/DAMASK_QR-Code.png and /dev/null differ diff --git a/misc/DAMASK_QR-CodeBW.png b/misc/DAMASK_QR-CodeBW.png deleted file mode 100644 index b9e46a2ca..000000000 Binary files a/misc/DAMASK_QR-CodeBW.png and /dev/null differ diff --git a/processing/post/addCauchy.py b/processing/post/addCauchy.py index ab619722e..a21d91064 100755 --- a/processing/post/addCauchy.py +++ b/processing/post/addCauchy.py @@ -72,6 +72,7 @@ for name in filenames: table.head_write() # ------------------------------------------ process data ------------------------------------------ + outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table F = np.array(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9]),'d').reshape(3,3) diff --git a/processing/post/addSpectralDecomposition.py b/processing/post/addSpectralDecomposition.py index f02133f1c..76bf2e875 100755 --- a/processing/post/addSpectralDecomposition.py +++ b/processing/post/addSpectralDecomposition.py @@ -49,7 +49,8 @@ for name in filenames: table.head_read() -# ------------------------------------------ sanity checks ---------------------------------------- + +# ------------------------------------------ assemble header 1 ------------------------------------ items = { 'tensor': {'dim': 9, 'shape': [3,3], 'labels':options.tensor, 'column': []}, @@ -74,12 +75,12 @@ for name in filenames: table.close(dismiss = True) continue -# ------------------------------------------ assemble header -------------------------------------- +# ------------------------------------------ assemble header 2 ------------------------------------ table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) table.head_write() -# ------------------------------------------ process data ------------------------------------------ +# ------------------------------------------ process data ----------------------------------------- outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table diff --git a/processing/post/postResults.py b/processing/post/postResults.py index 7cac229e4..8b7e610e3 100755 --- a/processing/post/postResults.py +++ b/processing/post/postResults.py @@ -451,9 +451,9 @@ def mapIncremental(label, mapping, N, base, new): # ----------------------------- def OpenPostfile(name,type,nodal = False): """Open postfile with extrapolation mode 'translate'""" - p = {\ - 'spectral': MPIEspectral_result,\ - 'marc': post_open,\ + p = { + 'spectral': MPIEspectral_result, + 'marc': post_open, }[type](name) p.extrapolation({True:'linear',False:'translate'}[nodal]) p.moveto(1) @@ -512,19 +512,19 @@ def ParsePostfile(p,filename, outputFormat): needs "outputFormat" for mapping of output names to postfile output indices """ - stat = { \ - 'IndexOfLabel': {}, \ - 'Title': p.title(), \ - 'Extrapolation': p.extrapolate, \ - 'NumberOfIncrements': p.increments(), \ - 'NumberOfNodes': p.nodes(), \ - 'NumberOfNodalScalars': p.node_scalars(), \ - 'LabelOfNodalScalar': [None]*p.node_scalars() , \ - 'NumberOfElements': p.elements(), \ - 'NumberOfElementalScalars': p.element_scalars(), \ - 'LabelOfElementalScalar': [None]*p.element_scalars() , \ - 'NumberOfElementalTensors': p.element_tensors(), \ - 'LabelOfElementalTensor': [None]*p.element_tensors(), \ + stat = { + 'IndexOfLabel': {}, + 'Title': p.title(), + 'Extrapolation': p.extrapolate, + 'NumberOfIncrements': p.increments(), + 'NumberOfNodes': p.nodes(), + 'NumberOfNodalScalars': p.node_scalars(), + 'LabelOfNodalScalar': [None]*p.node_scalars(), + 'NumberOfElements': p.elements(), + 'NumberOfElementalScalars': p.element_scalars(), + 'LabelOfElementalScalar': [None]*p.element_scalars(), + 'NumberOfElementalTensors': p.element_tensors(), + 'LabelOfElementalTensor': [None]*p.element_tensors(), } # --- find labels @@ -671,6 +671,9 @@ parser.add_option('-m','--map', dest='func', parser.add_option('-p','--type', dest='filetype', metavar = 'string', help = 'type of result file [auto]') +parser.add_option('-q','--quiet', dest='verbose', + action = 'store_false', + help = 'suppress verbose output') group_material = OptionGroup(parser,'Material identifier') @@ -711,24 +714,26 @@ parser.add_option_group(group_material) parser.add_option_group(group_general) parser.add_option_group(group_special) -parser.set_defaults(info = False) -parser.set_defaults(legacy = False) -parser.set_defaults(nodal = False) -parser.set_defaults(prefix = '') -parser.set_defaults(suffix = '') -parser.set_defaults(dir = 'postProc') -parser.set_defaults(filetype = None) -parser.set_defaults(func = 'avg') -parser.set_defaults(homog = '1') -parser.set_defaults(cryst = '1') -parser.set_defaults(phase = '1') -parser.set_defaults(filter = '') -parser.set_defaults(sep = []) -parser.set_defaults(sort = []) -parser.set_defaults(inc = False) -parser.set_defaults(time = False) -parser.set_defaults(separateFiles = False) -parser.set_defaults(getIncrements= False) +parser.set_defaults(info = False, + verbose = True, + legacy = False, + nodal = False, + prefix = '', + suffix = '', + dir = 'postProc', + filetype = None, + func = 'avg', + homog = '1', + cryst = '1', + phase = '1', + filter = '', + sep = [], + sort = [], + inc = False, + time = False, + separateFiles = False, + getIncrements= False, + ) (options, files) = parser.parse_args() @@ -797,8 +802,9 @@ options.sep.reverse() # --- start background messaging -bg = damask.util.backgroundMessage() -bg.start() +if options.verbose: + bg = damask.util.backgroundMessage() + bg.start() # --- parse .output and .t16 files @@ -816,7 +822,7 @@ me = { 'Constitutive': options.phase, } -bg.set_message('parsing .output files...') +if options.verbose: bg.set_message('parsing .output files...') for what in me: outputFormat[what] = ParseOutputFormat(filename, what, me[what]) @@ -824,9 +830,10 @@ for what in me: print("\nsection '{}' not found in <{}>".format(me[what], what)) print('\n'.join(map(lambda x:' [%s]'%x, outputFormat[what]['specials']['brothers']))) -bg.set_message('opening result file...') +if options.verbose: bg.set_message('opening result file...') + p = OpenPostfile(filename+extension,options.filetype,options.nodal) -bg.set_message('parsing result file...') +if options.verbose: bg.set_message('parsing result file...') stat = ParsePostfile(p, filename, outputFormat) if options.filetype == 'marc': stat['NumberOfIncrements'] -= 1 # t16 contains one "virtual" increment (at 0) @@ -870,8 +877,7 @@ if options.info: elementsOfNode = {} for e in range(stat['NumberOfElements']): - if e%1000 == 0: - bg.set_message('connect elem %i...'%e) + if options.verbose and e%1000 == 0: bg.set_message('connect elem %i...'%e) for n in map(p.node_sequence,p.element(e).items): if n not in elementsOfNode: elementsOfNode[n] = [p.element_id(e)] @@ -893,8 +899,7 @@ memberCount = 0 if options.nodalScalar: for n in range(stat['NumberOfNodes']): - if n%1000 == 0: - bg.set_message('scan node %i...'%n) + if options.verbose and n%1000 == 0: bg.set_message('scan node %i...'%n) myNodeID = p.node_id(n) myNodeCoordinates = [p.node(n).x, p.node(n).y, p.node(n).z] myElemID = 0 @@ -928,8 +933,7 @@ if options.nodalScalar: else: for e in range(stat['NumberOfElements']): - if e%1000 == 0: - bg.set_message('scan elem %i...'%e) + if options.verbose and e%1000 == 0: bg.set_message('scan elem %i...'%e) myElemID = p.element_id(e) myIpCoordinates = ipCoords(p.element(e).type, map(lambda node: [node.x, node.y, node.z], map(p.node, map(p.node_sequence, p.element(e).items)))) @@ -995,7 +999,7 @@ if 'none' not in map(str.lower, options.sort): theKeys.append('x[0][%i]'%where[criterium]) sortKeys = eval('lambda x:(%s)'%(','.join(theKeys))) -bg.set_message('sorting groups...') +if options.verbose: bg.set_message('sorting groups...') groups.sort(key = sortKeys) # in-place sorting to save mem @@ -1014,7 +1018,7 @@ standard = ['inc'] + \ # --------------------------- loop over positions -------------------------------- -bg.set_message('getting map between positions and increments...') +if options.verbose: bg.set_message('getting map between positions and increments...') incAtPosition = {} positionOfInc = {} @@ -1075,7 +1079,7 @@ for incCount,position in enumerate(locations): # walk through locations member += 1 if member%1000 == 0: time_delta = ((len(locations)*memberCount)/float(member+incCount*memberCount)-1.0)*(time.time()-time_start) - bg.set_message('(%02i:%02i:%02i) processing point %i of %i from increment %i (position %i)...' + if options.verbose: bg.set_message('(%02i:%02i:%02i) processing point %i of %i from increment %i (position %i)...' %(time_delta//3600,time_delta%3600//60,time_delta%60,member,memberCount,increments[incCount],position)) newby = [] # current member's data diff --git a/processing/pre/3DRVEfrom2Dang.py b/processing/pre/3DRVEfrom2Dang.py new file mode 100644 index 000000000..58607c4be --- /dev/null +++ b/processing/pre/3DRVEfrom2Dang.py @@ -0,0 +1,119 @@ +#!/usr/bin/env python2.7 +# -*- coding: UTF-8 no BOM -*- + +import os,sys,math +from optparse import OptionParser +import damask +import pipes + +scriptName = os.path.splitext(os.path.basename(__file__))[0] +scriptID = ' '.join([scriptName,damask.version]) + +# -------------------------------------------------------------------- +# MAIN +# -------------------------------------------------------------------- + +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', + description ='generate 3D RVE from .ang files of EBSD slices .', + version = scriptID) + +parser.add_option('--offset', + dest='offset', + type='float', + help='offset of EBSD slices [%default]', + metavar='float') +parser.add_option('--outname', + dest='outName', + type='string', + help='output file name [%default]', metavar='string') +parser.add_option('--vtr', + action="store_true", + dest='vtr') +parser.add_option('--geom', + action="store_true", + dest='geom') +parser.set_defaults(offset = 1.0, + outName = 'RVE3D') + +(options,filenames) = parser.parse_args() + +numFiles = len(filenames) +formatwidth = 1+int(math.log10(numFiles)) + +# copy original files to tmp files to not alter originals +for i in range(numFiles): + sliceID = 'slice' + str(i).zfill(formatwidth) + '.tmp' + strCommand = 'cp ' + pipes.quote(filenames[i]) + ' ' + sliceID + os.system(strCommand) + +# modify tmp files +print('Add z-coordinates') +for i in range(numFiles): + sliceID = 'slice' + str(i).zfill(formatwidth) + '.tmp' + strCommand = 'OIMgrainFile_toTable ' + sliceID + os.system(strCommand) + strCommand = 'addCalculation --label 3Dpos --formula "np.array(#pos#.tolist()+[' + str(i*options.offset) + '])" ' + sliceID + os.system(strCommand) + +# join temp files into one + +print('\n Colocate files') +fileOut = open(options.outName + '.ang','w') + +# take header information from 1st file +sliceID = 'slice' + str(0).zfill(formatwidth) + '.tmp' +fileRead = open(sliceID) +data = fileRead.readlines() +fileRead.close() +headerLines = int(data[0].split()[0]) +fileOut.write(str(headerLines+1) + '\t header\n') +for line in data[1:headerLines]: + fileOut.write(line) +fileOut.write(scriptID + '\t' + ' '.join(sys.argv[1:]) + '\n') +for line in data[headerLines:]: + fileOut.write(line) + +# append other files content without header +for i in range(numFiles-1): + sliceID = 'slice' + str(i+1).zfill(formatwidth) + '.tmp' + fileRead = open(sliceID) + data = fileRead.readlines() + fileRead.close() + headerLines = int(data[0].split()[0]) + for line in data[headerLines+1:]: + fileOut.write(line) +fileOut.close() + +# tidy up and add phase column +print('\n Remove temp data and add phase info') +strCommand = 'filterTable --black pos ' + options.outName + '.ang' +os.system(strCommand) +strCommand = 'reLabel --label 3Dpos --substitute pos ' + options.outName + '.ang' +os.system(strCommand) +strCommand = 'addCalculation -l phase -f 1 ' + options.outName + '.ang' +os.system(strCommand) + + +# create geom file when asked for +if options.geom: + print('\n Build geometry file') + strCommand = 'geom_fromTable --phase phase --eulers euler --coordinates pos ' + pipes.quote(options.outName) + '.ang' + os.system(strCommand) + +# create paraview file when asked for + +if options.vtr: + print('\n Build Paraview file') + strCommand = 'addIPFcolor --eulers euler --pole 0.0 0.0 1.0 ' + options.outName + '.ang' + os.system(strCommand) + strCommand = 'vtk_rectilinearGrid ' + pipes.quote(options.outName) + '.ang' + os.system(strCommand) + os.rename(pipes.quote(options.outName) + '_pos(cell)'+'.vtr', pipes.quote(options.outName) + '.vtr') + strCommand = 'vtk_addRectilinearGridData --vtk '+ pipes.quote(options.outName) + '.vtr --color IPF_001_cubic '\ + + pipes.quote(options.outName) + '.ang' + os.system(strCommand) + +# delete tmp files +for i in range(numFiles): + sliceID = 'slice' + str(i).zfill(formatwidth) + '.tmp' + os.remove(sliceID) \ No newline at end of file diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index eb1448028..eade66e17 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -74,10 +74,8 @@ add_library (PLASTIC OBJECT "plastic_disloUCLA.f90" "plastic_isotropic.f90" "plastic_phenopowerlaw.f90" - "plastic_titanmod.f90" "plastic_nonlocal.f90" - "plastic_none.f90" - "plastic_phenoplus.f90") + "plastic_none.f90") add_dependencies(PLASTIC DAMASK_HELPERS) list(APPEND OBJECTFILES $) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index eef56506f..b3848a9eb 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -113,7 +113,11 @@ end subroutine CPFEM_initAll !> @brief allocate the arrays defined in module CPFEM and initialize them !-------------------------------------------------------------------------------------------------- subroutine CPFEM_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pInt use IO, only: & diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 3e926ee71..0ac916046 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -82,7 +82,11 @@ end subroutine CPFEM_initAll !> @brief allocate the arrays defined in module CPFEM and initialize them !-------------------------------------------------------------------------------------------------- subroutine CPFEM_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pInt use IO, only: & diff --git a/src/DAMASK_marc2017.f90 b/src/DAMASK_marc2017.f90 new file mode 120000 index 000000000..2c5bec706 --- /dev/null +++ b/src/DAMASK_marc2017.f90 @@ -0,0 +1 @@ +DAMASK_marc.f90 \ No newline at end of file diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index ad3226502..f32bfb7b3 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -7,8 +7,11 @@ !> results !-------------------------------------------------------------------------------------------------- program DAMASK_spectral - use, intrinsic :: & - iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pInt, & pLongInt, & diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 index 8e09a1524..5fdb2ebf8 100644 --- a/src/FEsolving.f90 +++ b/src/FEsolving.f90 @@ -43,7 +43,11 @@ contains !> solver the information is provided by the interface module !-------------------------------------------------------------------------------------------------- subroutine FE_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level, & debug_FEsolving, & diff --git a/src/IO.f90 b/src/IO.f90 index a00559708..224fad8c4 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -81,7 +81,11 @@ contains !> @brief only outputs revision number !-------------------------------------------------------------------------------------------------- subroutine IO_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif implicit none @@ -1587,6 +1591,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) ! DAMASK_marc errors case (700_pInt) msg = 'invalid materialpoint result requested' + case (701_pInt) + msg = 'not supported input file format, use Marc 2016 or earlier' !------------------------------------------------------------------------------------------------- ! errors related to spectral solver diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 7b95490b0..51848ece5 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -28,8 +28,6 @@ #include "plastic_none.f90" #include "plastic_isotropic.f90" #include "plastic_phenopowerlaw.f90" -#include "plastic_phenoplus.f90" -#include "plastic_titanmod.f90" #include "plastic_dislotwin.f90" #include "plastic_disloUCLA.f90" #include "plastic_nonlocal.f90" diff --git a/src/constitutive.f90 b/src/constitutive.f90 index de8f61c2a..202242aec 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -37,7 +37,11 @@ contains !> @brief allocates arrays pointing to array of the various constitutive modules !-------------------------------------------------------------------------------------------------- subroutine constitutive_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pReal use debug, only: & @@ -70,10 +74,8 @@ subroutine constitutive_init() PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & - PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & - PLASTICITY_titanmod_ID, & PLASTICITY_nonlocal_ID ,& SOURCE_thermal_dissipation_ID, & SOURCE_thermal_externalheat_ID, & @@ -93,10 +95,8 @@ subroutine constitutive_init() PLASTICITY_NONE_label, & PLASTICITY_ISOTROPIC_label, & PLASTICITY_PHENOPOWERLAW_label, & - PLASTICITY_PHENOPLUS_label, & PLASTICITY_DISLOTWIN_label, & PLASTICITY_DISLOUCLA_label, & - PLASTICITY_TITANMOD_label, & PLASTICITY_NONLOCAL_label, & SOURCE_thermal_dissipation_label, & SOURCE_thermal_externalheat_label, & @@ -113,10 +113,8 @@ subroutine constitutive_init() use plastic_none use plastic_isotropic use plastic_phenopowerlaw - use plastic_phenoplus use plastic_dislotwin use plastic_disloucla - use plastic_titanmod use plastic_nonlocal use source_thermal_dissipation use source_thermal_externalheat @@ -158,10 +156,8 @@ subroutine constitutive_init() if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(FILEUNIT) - if (any(phase_plasticity == PLASTICITY_PHENOPLUS_ID)) call plastic_phenoplus_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT) - if (any(phase_plasticity == PLASTICITY_TITANMOD_ID)) call plastic_titanmod_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then call plastic_nonlocal_init(FILEUNIT) call plastic_nonlocal_stateInit() @@ -218,11 +214,6 @@ subroutine constitutive_init() thisNoutput => plastic_phenopowerlaw_Noutput thisOutput => plastic_phenopowerlaw_output thisSize => plastic_phenopowerlaw_sizePostResult - case (PLASTICITY_PHENOPLUS_ID) plasticityType - outputName = PLASTICITY_PHENOPLUS_label - thisNoutput => plastic_phenoplus_Noutput - thisOutput => plastic_phenoplus_output - thisSize => plastic_phenoplus_sizePostResult case (PLASTICITY_DISLOTWIN_ID) plasticityType outputName = PLASTICITY_DISLOTWIN_label thisNoutput => plastic_dislotwin_Noutput @@ -233,11 +224,6 @@ subroutine constitutive_init() thisNoutput => plastic_disloucla_Noutput thisOutput => plastic_disloucla_output thisSize => plastic_disloucla_sizePostResult - case (PLASTICITY_TITANMOD_ID) plasticityType - outputName = PLASTICITY_TITANMOD_label - thisNoutput => plastic_titanmod_Noutput - thisOutput => plastic_titanmod_output - thisSize => plastic_titanmod_sizePostResult case (PLASTICITY_NONLOCAL_ID) plasticityType outputName = PLASTICITY_NONLOCAL_label thisNoutput => plastic_nonlocal_Noutput @@ -392,11 +378,8 @@ function constitutive_homogenizedC(ipc,ip,el) use material, only: & phase_plasticity, & material_phase, & - PLASTICITY_TITANMOD_ID, & PLASTICITY_DISLOTWIN_ID, & PLASTICITY_DISLOUCLA_ID - use plastic_titanmod, only: & - plastic_titanmod_homogenizedC use plastic_dislotwin, only: & plastic_dislotwin_homogenizedC use lattice, only: & @@ -412,8 +395,6 @@ function constitutive_homogenizedC(ipc,ip,el) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_DISLOTWIN_ID) plasticityType constitutive_homogenizedC = plastic_dislotwin_homogenizedC(ipc,ip,el) - case (PLASTICITY_TITANMOD_ID) plasticityType - constitutive_homogenizedC = plastic_titanmod_homogenizedC (ipc,ip,el) case default plasticityType constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phase (ipc,ip,el)) end select plasticityType @@ -434,19 +415,13 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) thermalMapping, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & - PLASTICITY_titanmod_ID, & - PLASTICITY_nonlocal_ID, & - PLASTICITY_phenoplus_ID - use plastic_titanmod, only: & - plastic_titanmod_microstructure + PLASTICITY_nonlocal_ID use plastic_nonlocal, only: & plastic_nonlocal_microstructure use plastic_dislotwin, only: & plastic_dislotwin_microstructure use plastic_disloucla, only: & plastic_disloucla_microstructure - use plastic_phenoplus, only: & - plastic_phenoplus_microstructure implicit none integer(pInt), intent(in) :: & @@ -470,12 +445,8 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) call plastic_dislotwin_microstructure(temperature(ho)%p(tme),ipc,ip,el) case (PLASTICITY_DISLOUCLA_ID) plasticityType call plastic_disloucla_microstructure(temperature(ho)%p(tme),ipc,ip,el) - case (PLASTICITY_TITANMOD_ID) plasticityType - call plastic_titanmod_microstructure (temperature(ho)%p(tme),ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_microstructure (Fe,Fp,ip,el) - case (PLASTICITY_PHENOPLUS_ID) plasticityType - call plastic_phenoplus_microstructure(orientations,ipc,ip,el) end select plasticityType end subroutine constitutive_microstructure @@ -501,23 +472,17 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_PHENOPLUS_ID, & PLASTICITY_DISLOTWIN_ID, & PLASTICITY_DISLOUCLA_ID, & - PLASTICITY_TITANMOD_ID, & PLASTICITY_NONLOCAL_ID use plastic_isotropic, only: & plastic_isotropic_LpAndItsTangent use plastic_phenopowerlaw, only: & plastic_phenopowerlaw_LpAndItsTangent - use plastic_phenoplus, only: & - plastic_phenoplus_LpAndItsTangent use plastic_dislotwin, only: & plastic_dislotwin_LpAndItsTangent use plastic_disloucla, only: & plastic_disloucla_LpAndItsTangent - use plastic_titanmod, only: & - plastic_titanmod_LpAndItsTangent use plastic_nonlocal, only: & plastic_nonlocal_LpAndItsTangent @@ -560,8 +525,6 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v call plastic_isotropic_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v,ipc,ip,el) - case (PLASTICITY_PHENOPLUS_ID) plasticityType - call plastic_phenoplus_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, & temperature(ho)%p(tme),ip,el) @@ -571,9 +534,6 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v case (PLASTICITY_DISLOUCLA_ID) plasticityType call plastic_disloucla_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, & temperature(ho)%p(tme), ipc,ip,el) - case (PLASTICITY_TITANMOD_ID) plasticityType - call plastic_titanmod_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, & - temperature(ho)%p(tme), ipc,ip,el) end select plasticityType dLp_dTstar3333 = math_Plain99to3333(dLp_dMstar) @@ -884,10 +844,8 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & - PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & - PLASTICITY_titanmod_ID, & PLASTICITY_nonlocal_ID, & SOURCE_damage_isoDuctile_ID, & SOURCE_damage_anisoBrittle_ID, & @@ -897,14 +855,10 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra plastic_isotropic_dotState use plastic_phenopowerlaw, only: & plastic_phenopowerlaw_dotState - use plastic_phenoplus, only: & - plastic_phenoplus_dotState use plastic_dislotwin, only: & plastic_dislotwin_dotState use plastic_disloucla, only: & plastic_disloucla_dotState - use plastic_titanmod, only: & - plastic_titanmod_dotState use plastic_nonlocal, only: & plastic_nonlocal_dotState use source_damage_isoDuctile, only: & @@ -950,17 +904,12 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra call plastic_isotropic_dotState (Tstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType call plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) - case (PLASTICITY_PHENOPLUS_ID) plasticityType - call plastic_phenoplus_dotState (Tstar_v,ipc,ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType call plastic_dislotwin_dotState (Tstar_v,temperature(ho)%p(tme), & ipc,ip,el) case (PLASTICITY_DISLOUCLA_ID) plasticityType call plastic_disloucla_dotState (Tstar_v,temperature(ho)%p(tme), & ipc,ip,el) - case (PLASTICITY_TITANMOD_ID) plasticityType - call plastic_titanmod_dotState (Tstar_v,temperature(ho)%p(tme), & - ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_dotState (Tstar_v,FeArray,FpArray,temperature(ho)%p(tme), & subdt,subfracArray,ip,el) @@ -1093,10 +1042,8 @@ function constitutive_postResults(Tstar_v, FeArray, ipc, ip, el) PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_PHENOPLUS_ID, & PLASTICITY_DISLOTWIN_ID, & PLASTICITY_DISLOUCLA_ID, & - PLASTICITY_TITANMOD_ID, & PLASTICITY_NONLOCAL_ID, & SOURCE_damage_isoBrittle_ID, & SOURCE_damage_isoDuctile_ID, & @@ -1106,14 +1053,10 @@ function constitutive_postResults(Tstar_v, FeArray, ipc, ip, el) plastic_isotropic_postResults use plastic_phenopowerlaw, only: & plastic_phenopowerlaw_postResults - use plastic_phenoplus, only: & - plastic_phenoplus_postResults use plastic_dislotwin, only: & plastic_dislotwin_postResults use plastic_disloucla, only: & plastic_disloucla_postResults - use plastic_titanmod, only: & - plastic_titanmod_postResults use plastic_nonlocal, only: & plastic_nonlocal_postResults use source_damage_isoBrittle, only: & @@ -1153,16 +1096,11 @@ function constitutive_postResults(Tstar_v, FeArray, ipc, ip, el) endPos = plasticState(material_phase(ipc,ip,el))%sizePostResults plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) - case (PLASTICITY_TITANMOD_ID) plasticityType - constitutive_postResults(startPos:endPos) = plastic_titanmod_postResults(ipc,ip,el) case (PLASTICITY_ISOTROPIC_ID) plasticityType constitutive_postResults(startPos:endPos) = plastic_isotropic_postResults(Tstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType constitutive_postResults(startPos:endPos) = & plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) - case (PLASTICITY_PHENOPLUS_ID) plasticityType - constitutive_postResults(startPos:endPos) = & - plastic_phenoplus_postResults(Tstar_v,ipc,ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType constitutive_postResults(startPos:endPos) = & plastic_dislotwin_postResults(Tstar_v,temperature(ho)%p(tme),ipc,ip,el) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b4f1c1d36..7f4f6fa44 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -137,7 +137,11 @@ contains !> @brief allocates and initialize per grain variables !-------------------------------------------------------------------------------------------------- subroutine crystallite_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_info, & debug_reset, & diff --git a/src/damage_local.f90 b/src/damage_local.f90 index b604c2be4..a24f0b1a5 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -41,7 +41,11 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine damage_local_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_read, & IO_lc, & diff --git a/src/damage_none.f90 b/src/damage_none.f90 index a9ecfb5de..746de340c 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -16,7 +16,11 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine damage_none_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pInt use IO, only: & diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 65d012705..fb960ed7f 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -46,7 +46,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_read, & IO_lc, & diff --git a/src/debug.f90 b/src/debug.f90 index 03a0d6f08..396454c19 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -102,7 +102,11 @@ contains !> @brief reads in parameters from debug.config and allocates arrays !-------------------------------------------------------------------------------------------------- subroutine debug_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use numerics, only: & nStress, & nState, & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 8b7da3b28..5a30a72c8 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -71,7 +71,11 @@ contains !> @brief module initialization !-------------------------------------------------------------------------------------------------- subroutine homogenization_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use math, only: & math_I3 use debug, only: & diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index ef293fc22..43c16a39d 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -72,7 +72,11 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine homogenization_RGC_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pReal, & pInt diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index b12e30ab3..aeb77c275 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -49,7 +49,11 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine homogenization_isostrain_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pReal use debug, only: & diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index 7f9518e90..11bed7813 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -18,7 +18,11 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine homogenization_none_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pReal, & pInt diff --git a/src/hydrogenflux_cahnhilliard.f90 b/src/hydrogenflux_cahnhilliard.f90 index 35168da2d..db08bf5d8 100644 --- a/src/hydrogenflux_cahnhilliard.f90 +++ b/src/hydrogenflux_cahnhilliard.f90 @@ -51,7 +51,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine hydrogenflux_cahnhilliard_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_read, & IO_lc, & diff --git a/src/hydrogenflux_isoconc.f90 b/src/hydrogenflux_isoconc.f90 index b4bcfb5e3..df5c01e68 100644 --- a/src/hydrogenflux_isoconc.f90 +++ b/src/hydrogenflux_isoconc.f90 @@ -16,7 +16,11 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine hydrogenflux_isoconc_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pReal, & pInt diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 8ac1a5646..146918f5c 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -51,7 +51,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine kinematics_cleavage_opening_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/kinematics_hydrogen_strain.f90 b/src/kinematics_hydrogen_strain.f90 index 7a33d1a5f..c3af7e2a2 100644 --- a/src/kinematics_hydrogen_strain.f90 +++ b/src/kinematics_hydrogen_strain.f90 @@ -41,7 +41,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine kinematics_hydrogen_strain_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 60487e5b4..f32efa929 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -51,7 +51,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine kinematics_slipplane_opening_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 572fd91af..30c267d34 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -41,7 +41,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine kinematics_thermal_expansion_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/kinematics_vacancy_strain.f90 b/src/kinematics_vacancy_strain.f90 index 704de7d1f..791c0e3c1 100644 --- a/src/kinematics_vacancy_strain.f90 +++ b/src/kinematics_vacancy_strain.f90 @@ -41,7 +41,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine kinematics_vacancy_strain_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/lattice.f90 b/src/lattice.f90 index a970ed85a..328d65380 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1243,7 +1243,11 @@ contains !> @brief Module initialization !-------------------------------------------------------------------------------------------------- subroutine lattice_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_open_file,& IO_open_jobFile_stat, & diff --git a/src/material.f90 b/src/material.f90 index a77c4871a..aad71d49c 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -25,10 +25,8 @@ module material PLASTICITY_none_label = 'none', & PLASTICITY_isotropic_label = 'isotropic', & PLASTICITY_phenopowerlaw_label = 'phenopowerlaw', & - PLASTICITY_phenoplus_label = 'phenoplus', & PLASTICITY_dislotwin_label = 'dislotwin', & PLASTICITY_disloucla_label = 'disloucla', & - PLASTICITY_titanmod_label = 'titanmod', & PLASTICITY_nonlocal_label = 'nonlocal', & SOURCE_thermal_dissipation_label = 'thermal_dissipation', & SOURCE_thermal_externalheat_label = 'thermal_externalheat', & @@ -74,10 +72,8 @@ module material PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & - PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & - PLASTICITY_titanmod_ID, & PLASTICITY_nonlocal_ID end enum @@ -312,10 +308,8 @@ module material PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & - PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & - PLASTICITY_titanmod_ID, & PLASTICITY_nonlocal_ID, & SOURCE_thermal_dissipation_ID, & SOURCE_thermal_externalheat_ID, & @@ -367,7 +361,11 @@ contains !> material.config !-------------------------------------------------------------------------------------------------- subroutine material_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_error, & IO_open_file, & @@ -985,14 +983,10 @@ subroutine material_parsePhase(fileUnit,myPart) phase_plasticity(section) = PLASTICITY_ISOTROPIC_ID case (PLASTICITY_PHENOPOWERLAW_label) phase_plasticity(section) = PLASTICITY_PHENOPOWERLAW_ID - case (PLASTICITY_PHENOPLUS_label) - phase_plasticity(section) = PLASTICITY_PHENOPLUS_ID case (PLASTICITY_DISLOTWIN_label) phase_plasticity(section) = PLASTICITY_DISLOTWIN_ID case (PLASTICITY_DISLOUCLA_label) phase_plasticity(section) = PLASTICITY_DISLOUCLA_ID - case (PLASTICITY_TITANMOD_label) - phase_plasticity(section) = PLASTICITY_TITANMOD_ID case (PLASTICITY_NONLOCAL_label) phase_plasticity(section) = PLASTICITY_NONLOCAL_ID case default diff --git a/src/math.f90 b/src/math.f90 index 82da6dfb2..80bf239a3 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -172,7 +172,11 @@ contains !-------------------------------------------------------------------------------------------------- subroutine math_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use numerics, only: fixedSeed use IO, only: IO_timeStamp @@ -1435,35 +1439,37 @@ end function math_RtoQ !-------------------------------------------------------------------------------------------------- -!> @brief rotation matrix from Euler angles (in radians) -!> @details rotation matrix is meant to represent a PASSIVE rotation, -!> @details composed of INTRINSIC rotations around the axes of the -!> @details rotating reference frame -!> @details (see http://en.wikipedia.org/wiki/Euler_angles for definitions) +!> @brief rotation matrix from Bunge-Euler (3-1-3) angles (in radians) +!> @details rotation matrix is meant to represent a PASSIVE rotation, composed of INTRINSIC +!> @details rotations around the axes of the details rotating reference frame. +!> @details similar to eu2om from "D Rowenhorst et al. Consistent representations of and conversions +!> @details between 3D rotations, Model. Simul. Mater. Sci. Eng. 23-8 (2015)", but R is transposed !-------------------------------------------------------------------------------------------------- pure function math_EulerToR(Euler) implicit none real(pReal), dimension(3), intent(in) :: Euler real(pReal), dimension(3,3) :: math_EulerToR - real(pReal) c1, c, c2, s1, s, s2 + real(pReal) :: c1, C, c2, s1, S, s2 - C1 = cos(Euler(1)) + c1 = cos(Euler(1)) C = cos(Euler(2)) - C2 = cos(Euler(3)) - S1 = sin(Euler(1)) + c2 = cos(Euler(3)) + s1 = sin(Euler(1)) S = sin(Euler(2)) - S2 = sin(Euler(3)) + s2 = sin(Euler(3)) - math_EulerToR(1,1)=C1*C2-S1*S2*C - math_EulerToR(1,2)=-C1*S2-S1*C2*C - math_EulerToR(1,3)=S1*S - math_EulerToR(2,1)=S1*C2+C1*S2*C - math_EulerToR(2,2)=-S1*S2+C1*C2*C - math_EulerToR(2,3)=-C1*S - math_EulerToR(3,1)=S2*S - math_EulerToR(3,2)=C2*S - math_EulerToR(3,3)=C + math_EulerToR(1,1) = c1*c2 -s1*C*s2 + math_EulerToR(1,2) = -c1*s2 -s1*C*c2 + math_EulerToR(1,3) = s1*S + + math_EulerToR(2,1) = s1*c2 +c1*C*s2 + math_EulerToR(2,2) = -s1*s2 +c1*C*c2 + math_EulerToR(2,3) = -c1*S + + math_EulerToR(3,1) = S*s2 + math_EulerToR(3,2) = S*c2 + math_EulerToR(3,3) = C math_EulerToR = transpose(math_EulerToR) ! convert to passive rotation @@ -1471,29 +1477,29 @@ end function math_EulerToR !-------------------------------------------------------------------------------------------------- -!> @brief quaternion (w+ix+jy+kz) from 3-1-3 Euler angles (in radians) -!> @details quaternion is meant to represent a PASSIVE rotation, -!> @details composed of INTRINSIC rotations around the axes of the -!> @details rotating reference frame -!> @details (see http://en.wikipedia.org/wiki/Euler_angles for definitions) +!> @brief quaternion (w+ix+jy+kz) from Bunge-Euler (3-1-3) angles (in radians) +!> @details rotation matrix is meant to represent a PASSIVE rotation, composed of INTRINSIC +!> @details rotations around the axes of the details rotating reference frame. +!> @details similar to eu2qu from "D Rowenhorst et al. Consistent representations of and +!> @details conversions between 3D rotations, Model. Simul. Mater. Sci. Eng. 23-8 (2015)", but +!> @details Q is conjucated and Q is not reversed for Q(0) < 0. !-------------------------------------------------------------------------------------------------- pure function math_EulerToQ(eulerangles) implicit none real(pReal), dimension(3), intent(in) :: eulerangles real(pReal), dimension(4) :: math_EulerToQ - real(pReal), dimension(3) :: halfangles - real(pReal) :: c, s + real(pReal) :: c, s, sigma, delta - halfangles = 0.5_pReal * eulerangles - - c = cos(halfangles(2)) - s = sin(halfangles(2)) - - math_EulerToQ= [cos(halfangles(1)+halfangles(3)) * c, & - cos(halfangles(1)-halfangles(3)) * s, & - sin(halfangles(1)-halfangles(3)) * s, & - sin(halfangles(1)+halfangles(3)) * c ] + c = cos(0.5_pReal * eulerangles(2)) + s = sin(0.5_pReal * eulerangles(2)) + sigma = 0.5_pReal * (eulerangles(1)+eulerangles(3)) + delta = 0.5_pReal * (eulerangles(1)-eulerangles(3)) + + math_EulerToQ= [c * cos(sigma), & + s * cos(delta), & + s * sin(delta), & + c * sin(sigma) ] math_EulerToQ = math_qConj(math_EulerToQ) ! convert to passive rotation end function math_EulerToQ @@ -1504,6 +1510,8 @@ end function math_EulerToQ !> @details rotation matrix is meant to represent a ACTIVE rotation !> @details (see http://en.wikipedia.org/wiki/Euler_angles for definitions) !> @details formula for active rotation taken from http://mathworld.wolfram.com/RodriguesRotationFormula.html +!> @details equivalent to eu2om (P=-1) from "D Rowenhorst et al. Consistent representations of and +!> @details conversions between 3D rotations, Model. Simul. Mater. Sci. Eng. 23-8 (2015)" !-------------------------------------------------------------------------------------------------- pure function math_axisAngleToR(axis,omega) @@ -1511,31 +1519,31 @@ pure function math_axisAngleToR(axis,omega) real(pReal), dimension(3,3) :: math_axisAngleToR real(pReal), dimension(3), intent(in) :: axis real(pReal), intent(in) :: omega - real(pReal), dimension(3) :: axisNrm + real(pReal), dimension(3) :: n real(pReal) :: norm,s,c,c1 norm = norm2(axis) - if (norm > 1.0e-8_pReal) then ! non-zero rotation - axisNrm = axis/norm ! normalize axis to be sure + wellDefined: if (norm > 1.0e-8_pReal) then + n = axis/norm ! normalize axis to be sure s = sin(omega) c = cos(omega) c1 = 1.0_pReal - c - math_axisAngleToR(1,1) = c + c1*axisNrm(1)**2.0_pReal - math_axisAngleToR(1,2) = -s*axisNrm(3) + c1*axisNrm(1)*axisNrm(2) - math_axisAngleToR(1,3) = s*axisNrm(2) + c1*axisNrm(1)*axisNrm(3) + math_axisAngleToR(1,1) = c + c1*n(1)**2.0_pReal + math_axisAngleToR(1,2) = c1*n(1)*n(2) - s*n(3) + math_axisAngleToR(1,3) = c1*n(1)*n(3) + s*n(2) - math_axisAngleToR(2,1) = s*axisNrm(3) + c1*axisNrm(2)*axisNrm(1) - math_axisAngleToR(2,2) = c + c1*axisNrm(2)**2.0_pReal - math_axisAngleToR(2,3) = -s*axisNrm(1) + c1*axisNrm(2)*axisNrm(3) + math_axisAngleToR(2,1) = c1*n(1)*n(2) + s*n(3) + math_axisAngleToR(2,2) = c + c1*n(2)**2.0_pReal + math_axisAngleToR(2,3) = c1*n(2)*n(3) - s*n(1) - math_axisAngleToR(3,1) = -s*axisNrm(2) + c1*axisNrm(3)*axisNrm(1) - math_axisAngleToR(3,2) = s*axisNrm(1) + c1*axisNrm(3)*axisNrm(2) - math_axisAngleToR(3,3) = c + c1*axisNrm(3)**2.0_pReal - else + math_axisAngleToR(3,1) = c1*n(1)*n(3) - s*n(2) + math_axisAngleToR(3,2) = c1*n(2)*n(3) + s*n(1) + math_axisAngleToR(3,3) = c + c1*n(3)**2.0_pReal + else wellDefined math_axisAngleToR = math_I3 - endif + endif wellDefined end function math_axisAngleToR @@ -1544,6 +1552,8 @@ end function math_axisAngleToR !> @brief rotation matrix from axis and angle (in radians) !> @details rotation matrix is meant to represent a PASSIVE rotation !> @details (see http://en.wikipedia.org/wiki/Euler_angles for definitions) +!> @details eq-uivalent to eu2qu (P=+1) from "D Rowenhorst et al. Consistent representations of and +!> @details conversions between 3D rotations, Model. Simul. Mater. Sci. Eng. 23-8 (2015)" !-------------------------------------------------------------------------------------------------- pure function math_EulerAxisAngleToR(axis,omega) @@ -1580,8 +1590,10 @@ end function math_EulerAxisAngleToQ !> @brief quaternion (w+ix+jy+kz) from axis and angle (in radians) !> @details quaternion is meant to represent an ACTIVE rotation !> @details (see http://en.wikipedia.org/wiki/Euler_angles for definitions) -!> @details formula for active rotation taken from +!> @details formula for active rotation taken from !> @details http://en.wikipedia.org/wiki/Rotation_representation_%28mathematics%29#Rodrigues_parameters +!> @details equivalent to eu2qu (P=+1) from "D Rowenhorst et al. Consistent representations of and +!> @details conversions between 3D rotations, Model. Simul. Mater. Sci. Eng. 23-8 (2015)" !-------------------------------------------------------------------------------------------------- pure function math_axisAngleToQ(axis,omega) @@ -1592,13 +1604,13 @@ pure function math_axisAngleToQ(axis,omega) real(pReal), dimension(3) :: axisNrm real(pReal) :: norm - norm = sqrt(math_mul3x3(axis,axis)) - rotation: if (norm > 1.0e-8_pReal) then + norm = norm2(axis) + wellDefined: if (norm > 1.0e-8_pReal) then axisNrm = axis/norm ! normalize axis to be sure math_axisAngleToQ = [cos(0.5_pReal*omega), sin(0.5_pReal*omega) * axisNrm(1:3)] - else rotation + else wellDefined math_axisAngleToQ = [1.0_pReal,0.0_pReal,0.0_pReal,0.0_pReal] - endif rotation + endif wellDefined end function math_axisAngleToQ diff --git a/src/mesh.f90 b/src/mesh.f90 index 33dc89643..666fe1e33 100644 --- a/src/mesh.f90 +++ b/src/mesh.f90 @@ -472,7 +472,11 @@ contains !! Order and routines strongly depend on type of solver !-------------------------------------------------------------------------------------------------- subroutine mesh_init(ip,el) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use DAMASK_interface use IO, only: & #ifdef Abaqus @@ -708,7 +712,6 @@ integer(pInt) function mesh_FEasCP(what,myID) mesh_FEasCP = lookupMap(2_pInt,upper) return endif - ! this might be the reason for the heap problems binarySearch: do while (upper-lower > 1_pInt) center = (lower+upper)/2_pInt if (lookupMap(1_pInt,center) < myID) then @@ -1694,13 +1697,15 @@ subroutine mesh_marc_count_cpElements(fileUnit) use IO, only: IO_lc, & IO_stringValue, & IO_stringPos, & - IO_countContinuousIntValues + IO_countContinuousIntValues, & + IO_error, & + IO_intValue implicit none integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i + integer(pInt) :: i, version character(len=300):: line mesh_NcpElems = 0_pInt @@ -1711,15 +1716,26 @@ subroutine mesh_marc_count_cpElements(fileUnit) do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then + version = IO_intValue(line,chunkPos,2_pInt) + if (version < 13) then ! Marc 2016 or earlier + rewind(fileUnit) + do read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines + read (fileUnit,610,END=620) line + enddo + mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? keyword hypoelastic might appear several times + exit + endif enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? - exit - endif - enddo + else ! Marc2017 and later + call IO_error(error_ID=701_pInt) + end if + end if + enddo 620 end subroutine mesh_marc_count_cpElements diff --git a/src/numerics.f90 b/src/numerics.f90 index db7bf0fe4..2085e221e 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -198,7 +198,11 @@ contains ! a sanity check !-------------------------------------------------------------------------------------------------- subroutine numerics_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_read, & IO_error, & diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 62d09186f..75e087770 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -119,7 +119,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_disloUCLA_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 43fe0c6d8..50b14bdf9 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -198,7 +198,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & dEq0, & dNeq0, & diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 54cb241c2..14c282f9a 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -90,7 +90,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level, & debug_constitutive, & diff --git a/src/plastic_none.f90 b/src/plastic_none.f90 index 7a7589774..839a4fa9f 100644 --- a/src/plastic_none.f90 +++ b/src/plastic_none.f90 @@ -26,7 +26,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_none_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level, & debug_constitutive, & diff --git a/src/plastic_phenoplus.f90 b/src/plastic_phenoplus.f90 deleted file mode 100644 index 105a64b34..000000000 --- a/src/plastic_phenoplus.f90 +++ /dev/null @@ -1,1412 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @author Chen Zhang, Michigan State University -!> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw -!... fitting -!-------------------------------------------------------------------------------------------------- -module plastic_phenoplus - use prec, only: & - pReal,& - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_phenoplus_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_phenoplus_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_phenoplus_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_phenoplus_Noutput !< number of outputs per instance of this constitution - - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_phenoplus_totalNslip, & !< no. of slip system used in simulation - plastic_phenoplus_totalNtwin, & !< no. of twin system used in simulation - plastic_phenoplus_totalNtrans !< no. of trans system used in simulation - - integer(pInt), dimension(:,:), allocatable, private :: & - plastic_phenoplus_Nslip, & !< active number of slip systems per family (input parameter, per family) - plastic_phenoplus_Ntwin, & !< active number of twin systems per family (input parameter, per family) - plastic_phenoplus_Ntrans !< active number of trans systems per family (input parameter, per family) - - real(pReal), dimension(:), allocatable, private :: & - plastic_phenoplus_gdot0_slip, & !< reference shear strain rate for slip (input parameter) - plastic_phenoplus_gdot0_twin, & !< reference shear strain rate for twin (input parameter) - plastic_phenoplus_n_slip, & !< stress exponent for slip (input parameter) - plastic_phenoplus_n_twin, & !< stress exponent for twin (input parameter) - plastic_phenoplus_spr, & !< push-up factor for slip saturation due to twinning - plastic_phenoplus_twinB, & - plastic_phenoplus_twinC, & - plastic_phenoplus_twinD, & - plastic_phenoplus_twinE, & - plastic_phenoplus_h0_SlipSlip, & !< reference hardening slip - slip (input parameter) - plastic_phenoplus_h0_TwinSlip, & !< reference hardening twin - slip (input parameter) - plastic_phenoplus_h0_TwinTwin, & !< reference hardening twin - twin (input parameter) - plastic_phenoplus_a_slip, & - plastic_phenoplus_aTolResistance, & - plastic_phenoplus_aTolShear, & - plastic_phenoplus_aTolTwinfrac, & - plastic_phenoplus_aTolTransfrac, & - plastic_phenoplus_Cnuc, & !< coefficient for strain-induced martensite nucleation - plastic_phenoplus_Cdwp, & !< coefficient for double well potential - plastic_phenoplus_Cgro, & !< coefficient for stress-assisted martensite growth - plastic_phenoplus_deltaG, & !< free energy difference between austensite and martensite [MPa] - plastic_phenoplus_kappa_max !< capped kappa for each slip system - - real(pReal), dimension(:,:), allocatable, private :: & - plastic_phenoplus_tau0_slip, & !< initial critical shear stress for slip (input parameter, per family) - plastic_phenoplus_tau0_twin, & !< initial critical shear stress for twin (input parameter, per family) - plastic_phenoplus_tausat_slip, & !< maximum critical shear stress for slip (input parameter, per family) - plastic_phenoplus_nonSchmidCoeff, & - - plastic_phenoplus_interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) - plastic_phenoplus_interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) - plastic_phenoplus_interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) - plastic_phenoplus_interaction_TwinTwin !< interaction factors twin - twin (input parameter) - - real(pReal), dimension(:,:,:), allocatable, private :: & - plastic_phenoplus_hardeningMatrix_SlipSlip, & - plastic_phenoplus_hardeningMatrix_SlipTwin, & - plastic_phenoplus_hardeningMatrix_TwinSlip, & - plastic_phenoplus_hardeningMatrix_TwinTwin - - enum, bind(c) - enumerator :: undefined_ID, & - resistance_slip_ID, & - accumulatedshear_slip_ID, & - shearrate_slip_ID, & - resolvedstress_slip_ID, & - kappa_slip_ID, & - totalshear_ID, & - resistance_twin_ID, & - accumulatedshear_twin_ID, & - shearrate_twin_ID, & - resolvedstress_twin_ID, & - totalvolfrac_twin_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - plastic_phenoplus_outputID !< ID of each post result output - - public :: & - plastic_phenoplus_init, & - plastic_phenoplus_microstructure, & - plastic_phenoplus_LpAndItsTangent, & - plastic_phenoplus_dotState, & - plastic_phenoplus_postResults - private :: & - plastic_phenoplus_aTolState, & - plastic_phenoplus_stateInit - - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) - use prec, only: & - dEq0 - use debug, only: & - debug_level, & - debug_constitutive,& - debug_levelBasic - use math, only: & - math_Mandel3333to66, & - math_Voigt66to3333 - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use material, only: & - phase_plasticity, & - phase_plasticityInstance, & - phase_Noutput, & - PLASTICITY_PHENOPLUS_label, & - PLASTICITY_PHENOPLUS_ID, & - material_phase, & - plasticState, & - MATERIAL_partPhase - use lattice - use numerics,only: & - numerics_integrator - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: & - maxNinstance, & - instance,phase,j,k, f,o, & - Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & - Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & - Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, & - Nchunks_TransFamilies = 0_pInt, Nchunks_nonSchmid = 0_pInt, & - NipcMyPhase, & - offset_slip, index_myFamily, index_otherFamily, & - mySize=0_pInt,sizeState,sizeDotState, sizeDeltaState - character(len=65536) :: & - tag = '', & - line = '' - real(pReal), dimension(:), allocatable :: tempPerSlip - - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPLUS_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPLUS_ID),pInt) - if (maxNinstance == 0_pInt) return - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(plastic_phenoplus_sizePostResults(maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_sizePostResult(maxval(phase_Noutput),maxNinstance), & - source=0_pInt) - allocate(plastic_phenoplus_output(maxval(phase_Noutput),maxNinstance)) - plastic_phenoplus_output = '' - allocate(plastic_phenoplus_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) - allocate(plastic_phenoplus_Noutput(maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_Ntrans(lattice_maxNtransFamily,maxNinstance),source=0_pInt) - allocate(plastic_phenoplus_totalNslip(maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_totalNtwin(maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_totalNtrans(maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_gdot0_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_n_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_tau0_slip(lattice_maxNslipFamily,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_tausat_slip(lattice_maxNslipFamily,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_gdot0_twin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_n_twin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_tau0_twin(lattice_maxNtwinFamily,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_spr(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_twinB(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_twinC(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_twinD(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_twinE(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_h0_SlipSlip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_h0_TwinSlip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_h0_TwinTwin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_a_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_aTolResistance(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_aTolShear(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_aTolTwinfrac(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_aTolTransfrac(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_Cnuc(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_Cdwp(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_Cgro(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_deltaG(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_kappa_max(maxNinstance), source=0.0_pReal) - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase - phase = phase + 1_pInt ! advance phase section counter - if (phase_plasticity(phase) == PLASTICITY_PHENOPLUS_ID) then - Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase - Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase - Nchunks_TransFamilies = count(lattice_NtransSystem(:,phase) > 0_pInt) ! maximum number of trans families according to lattice type of current phase - Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) - Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) - Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) - Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) - Nchunks_nonSchmid = lattice_NnonSchmid(phase) - if(allocated(tempPerSlip)) deallocate(tempPerSlip) - allocate(tempPerSlip(Nchunks_SlipFamilies)) - endif - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_PHENOPLUS_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran - instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('resistance_slip') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resistance_slip_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('accumulatedshear_slip','accumulated_shear_slip') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = accumulatedshear_slip_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shearrate_slip') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = shearrate_slip_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resolvedstress_slip') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resolvedstress_slip_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('kappa_slip') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = kappa_slip_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('totalshear') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = totalshear_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resistance_twin') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resistance_twin_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('accumulatedshear_twin','accumulated_shear_twin') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = accumulatedshear_twin_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shearrate_twin') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = shearrate_twin_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resolvedstress_twin') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resolvedstress_twin_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('totalvolfrac_twin') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = totalvolfrac_twin_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case default - - end select -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of slip families - case ('nslip') - if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) - do j = 1_pInt, Nchunks_SlipFamilies - plastic_phenoplus_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - case ('tausat_slip','tau0_slip') - tempPerSlip = 0.0_pReal - do j = 1_pInt, Nchunks_SlipFamilies - if (plastic_phenoplus_Nslip(j,instance) > 0_pInt) & - tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - select case(tag) - case ('tausat_slip') - plastic_phenoplus_tausat_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('tau0_slip') - plastic_phenoplus_tau0_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - end select -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of twin families - case ('ntwin') - if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & - call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - Nchunks_TwinFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_TwinFamilies - plastic_phenoplus_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - case ('tau0_twin') - do j = 1_pInt, Nchunks_TwinFamilies - if (plastic_phenoplus_Ntwin(j,instance) > 0_pInt) & - plastic_phenoplus_tau0_twin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of transformation families - case ('ntrans') - if (chunkPos(1) < Nchunks_TransFamilies + 1_pInt) & - call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - if (chunkPos(1) > Nchunks_TransFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - Nchunks_TransFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_TransFamilies - plastic_phenoplus_Ntrans(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of interactions - case ('interaction_slipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - do j = 1_pInt, Nchunks_SlipSlip - plastic_phenoplus_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_sliptwin') - if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - do j = 1_pInt, Nchunks_SlipTwin - plastic_phenoplus_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_twinslip') - if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - do j = 1_pInt, Nchunks_TwinSlip - plastic_phenoplus_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_twintwin') - if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - do j = 1_pInt, Nchunks_TwinTwin - plastic_phenoplus_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('nonschmid_coefficients') - if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - do j = 1_pInt,Nchunks_nonSchmid - plastic_phenoplus_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- -! parameters independent of number of slip/twin systems - case ('gdot0_slip') - plastic_phenoplus_gdot0_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('n_slip') - plastic_phenoplus_n_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('a_slip', 'w0_slip') - plastic_phenoplus_a_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('gdot0_twin') - plastic_phenoplus_gdot0_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('n_twin') - plastic_phenoplus_n_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('s_pr') - plastic_phenoplus_spr(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_b') - plastic_phenoplus_twinB(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_c') - plastic_phenoplus_twinC(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_d') - plastic_phenoplus_twinD(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_e') - plastic_phenoplus_twinE(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_slipslip') - plastic_phenoplus_h0_SlipSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_twinslip') - plastic_phenoplus_h0_TwinSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_twintwin') - plastic_phenoplus_h0_TwinTwin(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_resistance') - plastic_phenoplus_aTolResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_shear') - plastic_phenoplus_aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_twinfrac') - plastic_phenoplus_aTolTwinfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_transfrac') - plastic_phenoplus_aTolTransfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('kappa_max') - plastic_phenoplus_kappa_max(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cnuc') - plastic_phenoplus_Cnuc(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cdwp') - plastic_phenoplus_Cdwp(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cgro') - plastic_phenoplus_Cgro(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('deltag') - plastic_phenoplus_deltaG(instance) = IO_floatValue(line,chunkPos,2_pInt) - case default - - end select - endif; endif - enddo parsingFile - - sanityChecks: do phase = 1_pInt, size(phase_plasticity) - myPhase: if (phase_plasticity(phase) == PLASTICITY_phenoplus_ID) then - instance = phase_plasticityInstance(phase) - plastic_phenoplus_Nslip(1:lattice_maxNslipFamily,instance) = & - min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active slip systems per family to min of available and requested - plastic_phenoplus_Nslip(1:lattice_maxNslipFamily,instance)) - plastic_phenoplus_Ntwin(1:lattice_maxNtwinFamily,instance) = & - min(lattice_NtwinSystem(1:lattice_maxNtwinFamily,phase),& ! limit active twin systems per family to min of available and requested - plastic_phenoplus_Ntwin(:,instance)) - plastic_phenoplus_totalNslip(instance) = sum(plastic_phenoplus_Nslip(:,instance)) ! how many slip systems altogether - plastic_phenoplus_totalNtwin(instance) = sum(plastic_phenoplus_Ntwin(:,instance)) ! how many twin systems altogether - plastic_phenoplus_totalNtrans(instance) = sum(plastic_phenoplus_Ntrans(:,instance)) ! how many trans systems altogether - - if (any(plastic_phenoplus_tau0_slip(:,instance) < 0.0_pReal .and. & - plastic_phenoplus_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPLUS_label//')') - if (plastic_phenoplus_gdot0_slip(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPLUS_label//')') - if (plastic_phenoplus_n_slip(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPLUS_label//')') - if (any(plastic_phenoplus_tausat_slip(:,instance) <= 0.0_pReal .and. & - plastic_phenoplus_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPLUS_label//')') - if (any(dEq0(plastic_phenoplus_a_slip(instance)) .and. plastic_phenoplus_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPLUS_label//')') - if (any(plastic_phenoplus_tau0_twin(:,instance) < 0.0_pReal .and. & - plastic_phenoplus_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPLUS_label//')') - if ( plastic_phenoplus_gdot0_twin(instance) <= 0.0_pReal .and. & - any(plastic_phenoplus_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPLUS_label//')') - if ( plastic_phenoplus_n_twin(instance) <= 0.0_pReal .and. & - any(plastic_phenoplus_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPLUS_label//')') - if (plastic_phenoplus_aTolResistance(instance) <= 0.0_pReal) & - plastic_phenoplus_aTolResistance(instance) = 1.0_pReal ! default absolute tolerance 1 Pa - if (plastic_phenoplus_aTolShear(instance) <= 0.0_pReal) & - plastic_phenoplus_aTolShear(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (plastic_phenoplus_aTolTwinfrac(instance) <= 0.0_pReal) & - plastic_phenoplus_aTolTwinfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (plastic_phenoplus_aTolTransfrac(instance) <= 0.0_pReal) & - plastic_phenoplus_aTolTransfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - endif myPhase - enddo sanityChecks - -!-------------------------------------------------------------------------------------------------- -! allocation of variables whose size depends on the total number of active slip systems - allocate(plastic_phenoplus_hardeningMatrix_SlipSlip(maxval(plastic_phenoplus_totalNslip),& ! slip resistance from slip activity - maxval(plastic_phenoplus_totalNslip),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_hardeningMatrix_SlipTwin(maxval(plastic_phenoplus_totalNslip),& ! slip resistance from twin activity - maxval(plastic_phenoplus_totalNtwin),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_hardeningMatrix_TwinSlip(maxval(plastic_phenoplus_totalNtwin),& ! twin resistance from slip activity - maxval(plastic_phenoplus_totalNslip),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_hardeningMatrix_TwinTwin(maxval(plastic_phenoplus_totalNtwin),& ! twin resistance from twin activity - maxval(plastic_phenoplus_totalNtwin),& - maxNinstance), source=0.0_pReal) - - initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config - myPhase2: if (phase_plasticity(phase) == PLASTICITY_phenoplus_ID) then ! only consider my phase - NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - instance = phase_plasticityInstance(phase) ! which instance of my phase - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,plastic_phenoplus_Noutput(instance) - select case(plastic_phenoplus_outputID(o,instance)) - case(resistance_slip_ID, & - shearrate_slip_ID, & - accumulatedshear_slip_ID, & - resolvedstress_slip_ID, & - kappa_slip_ID & - ) - mySize = plastic_phenoplus_totalNslip(instance) - case(resistance_twin_ID, & - shearrate_twin_ID, & - accumulatedshear_twin_ID, & - resolvedstress_twin_ID & - ) - mySize = plastic_phenoplus_totalNtwin(instance) - case(totalshear_ID, & - totalvolfrac_twin_ID & - ) - mySize = 1_pInt - case default - end select - - outputFound: if (mySize > 0_pInt) then - plastic_phenoplus_sizePostResult(o,instance) = mySize - plastic_phenoplus_sizePostResults(instance) = plastic_phenoplus_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop -!-------------------------------------------------------------------------------------------------- -! allocate state arrays - sizeState = plastic_phenoplus_totalNslip(instance) & ! s_slip - + plastic_phenoplus_totalNtwin(instance) & ! s_twin - + 2_pInt & ! sum(gamma) + sum(f) - + plastic_phenoplus_totalNslip(instance) & ! accshear_slip - + plastic_phenoplus_totalNtwin(instance) & ! accshear_twin - + plastic_phenoplus_totalNslip(instance) ! kappa - - !sizeDotState = sizeState ! same as sizeState - !QUICK FIX: the dotState cannot have redundancy, which could cause unknown error - ! explicitly specify the size of the dotState to avoid this potential - ! memory leak issue. - sizeDotState = plastic_phenoplus_totalNslip(instance) & ! s_slip - + plastic_phenoplus_totalNtwin(instance) & ! s_twin - + 2_pInt & ! sum(gamma) + sum(f) - + plastic_phenoplus_totalNslip(instance) & ! accshear_slip - + plastic_phenoplus_totalNtwin(instance) ! accshear_twin - - sizeDeltaState = 0_pInt - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = plastic_phenoplus_sizePostResults(instance) - plasticState(phase)%nSlip =plastic_phenoplus_totalNslip(instance) - plasticState(phase)%nTwin =plastic_phenoplus_totalNtwin(instance) - plasticState(phase)%nTrans=plastic_phenoplus_totalNtrans(instance) - allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) - allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) - - offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - - do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X - index_myFamily = sum(plastic_phenoplus_Nslip(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_phenoplus_Nslip(f,instance) ! loop over (active) systems in my family (slip) - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_phenoplus_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenoplus_Nslip(o,instance) ! loop over (active) systems in other family (slip) - plastic_phenoplus_hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenoplus_interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,phase))+j, & - sum(lattice_NslipSystem(1:o-1,phase))+k, & - phase), instance ) - enddo; enddo - - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(plastic_phenoplus_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenoplus_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - plastic_phenoplus_hardeningMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenoplus_interaction_SlipTwin(lattice_interactionSlipTwin( & - sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & - phase), instance ) - enddo; enddo - - enddo; enddo - - do f = 1_pInt,lattice_maxNtwinFamily ! >>> interaction twin -- X - index_myFamily = sum(plastic_phenoplus_Ntwin(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_phenoplus_Ntwin(f,instance) ! loop over (active) systems in my family (twin) - - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_phenoplus_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenoplus_Nslip(o,instance) ! loop over (active) systems in other family (slip) - plastic_phenoplus_hardeningMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenoplus_interaction_TwinSlip(lattice_interactionTwinSlip( & - sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & - phase), instance ) - enddo; enddo - - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(plastic_phenoplus_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenoplus_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - plastic_phenoplus_hardeningMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenoplus_interaction_TwinTwin(lattice_interactionTwinTwin( & - sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & - phase), instance ) - enddo; enddo - - enddo; enddo - - call plastic_phenoplus_stateInit(phase,instance) - call plastic_phenoplus_aTolState(phase,instance) - endif myPhase2 - enddo initializeInstances - -end subroutine plastic_phenoplus_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_stateInit(ph,instance) - use lattice, only: & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - ph - integer(pInt) :: & - i - real(pReal), dimension(plasticState(ph)%sizeState) :: & - tempState - - tempState = 0.0_pReal - do i = 1_pInt,lattice_maxNslipFamily - tempState(1+sum(plastic_phenoplus_Nslip(1:i-1,instance)) : & - sum(plastic_phenoplus_Nslip(1:i ,instance))) = & - plastic_phenoplus_tau0_slip(i,instance) - enddo - - do i = 1_pInt,lattice_maxNtwinFamily - tempState(1+sum(plastic_phenoplus_Nslip(:,instance))+& - sum(plastic_phenoplus_Ntwin(1:i-1,instance)) : & - sum(plastic_phenoplus_Nslip(:,instance))+& - sum(plastic_phenoplus_Ntwin(1:i ,instance))) = & - plastic_phenoplus_tau0_twin(i,instance) - enddo - - plasticState(ph)%state0(:,:) = spread(tempState, & ! spread single tempstate array - 2, & ! along dimension 2 - size(plasticState(ph)%state0(1,:))) ! number of copies (number of IPCs) - -end subroutine plastic_phenoplus_stateInit - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_aTolState(ph,instance) - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - ph - - plasticState(ph)%aTolState(1:plastic_phenoplus_totalNslip(instance)+ & - plastic_phenoplus_totalNtwin(instance)) = & - plastic_phenoplus_aTolResistance(instance) - plasticState(ph)%aTolState(1+plastic_phenoplus_totalNslip(instance)+ & - plastic_phenoplus_totalNtwin(instance)) = & - plastic_phenoplus_aTolShear(instance) - plasticState(ph)%aTolState(2+plastic_phenoplus_totalNslip(instance)+ & - plastic_phenoplus_totalNtwin(instance)) = & - plastic_phenoplus_aTolTwinFrac(instance) - plasticState(ph)%aTolState(3+plastic_phenoplus_totalNslip(instance)+ & - plastic_phenoplus_totalNtwin(instance): & - 2+2*(plastic_phenoplus_totalNslip(instance)+ & - plastic_phenoplus_totalNtwin(instance))) = & - plastic_phenoplus_aTolShear(instance) - -end subroutine plastic_phenoplus_aTolState - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate push-up factors (kappa) for each voxel based on its neighbors -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_microstructure(orientation,ipc,ip,el) - use math, only: pi, & - math_mul33x33, & - math_mul3x3, & - math_transpose33, & - math_qDot, & - math_qRot, & - indeg - - use mesh, only: mesh_element, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype, & - mesh_maxNips, & - mesh_NcpElems, & - mesh_ipNeighborhood - - use material, only: material_phase, & - material_texture, & - phase_plasticityInstance, & - phaseAt, phasememberAt, & - homogenization_maxNgrains, & - plasticState - - use lattice, only: lattice_sn, & - lattice_sd, & - lattice_qDisorientation - - !***input variables - implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(4,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & - orientation ! crystal orientation in quaternions - - !***local variables - integer(pInt) instance, & !my instance of this plasticity - ph, & !my phase - of, & !my spatial position in memory (offset) - textureID, & !my texture - Nneighbors, & !number of neighbors (<= 6) - vld_Nneighbors, & !number of my valid neighbors - n, & !neighbor index (for iterating through all neighbors) - ns, & !number of slip system - nt, & !number of twin system - me_slip, & !my slip system index - neighbor_el, & !element number of neighboring material point - neighbor_ip, & !integration point of neighboring material point - neighbor_n, & !I have no idea what is this - neighbor_of, & !spatial position in memory for this neighbor (offset) - neighbor_ph, & !neighbor's phase - neighbor_tex, & !neighbor's texture ID - ne_slip_ac, & !loop to find neighbor shear - ne_slip, & !slip system index for neighbor - index_kappa, & !index of pushup factors in plasticState - offset_acshear_slip, & !offset in PlasticState for the accumulative shear - j !quickly loop through slip families - - real(pReal) kappa_max, & ! - tmp_myshear_slip, & !temp storage for accumulative shear for me - mprime_cut, & !m' cutoff to consider neighboring effect - avg_acshear_ne, & !the average accumulative shear from my neighbor - tmp_mprime, & !temp holder for m' value - tmp_acshear !temp holder for accumulative shear for m' - - - real(pReal), dimension(plastic_phenoplus_totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - m_primes, & !m' between me_alpha(one) and neighbor beta(all) - me_acshear, & !temp storage for ac_shear of one particular system for me - ne_acshear !temp storage for ac_shear of one particular system for one of my neighbor - - real(pReal), dimension(3,plastic_phenoplus_totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - slipNormal, & - slipDirect - - real(pReal), dimension(4) :: my_orientation, & !store my orientation - neighbor_orientation, & !store my neighbor orientation - absMisorientation - - real(pReal), dimension(FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) :: & - ne_mprimes !m' between each neighbor - - !***Get my properties - Nneighbors = FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) - ph = phaseAt(ipc,ip,el) !get my phase - of = phasememberAt(ipc,ip,el) !get my spatial location offset in memory - textureID = material_texture(1,ip,el) !get my texture ID - instance = phase_plasticityInstance(ph) !get my instance based on phase ID - ns = plastic_phenoplus_totalNslip(instance) - nt = plastic_phenoplus_totalNtwin(instance) - offset_acshear_slip = ns + nt + 2_pInt - index_kappa = ns + nt + 2_pInt + ns + nt !location of kappa in plasticState - mprime_cut = 0.7_pReal !set by Dr.Bieler - - !***gather my accumulative shear from palsticState - FINDMYSHEAR: do j = 1_pInt,ns - me_acshear(j) = plasticState(ph)%state(offset_acshear_slip+j, of) - enddo FINDMYSHEAR - - !***gather my orientation and slip systems - my_orientation = orientation(1:4, ipc, ip, el) - slipNormal(1:3, 1:ns) = lattice_sn(1:3, 1:ns, ph) - slipDirect(1:3, 1:ns) = lattice_sd(1:3, 1:ns, ph) - kappa_max = plastic_phenoplus_kappa_max(instance) !maximum pushups allowed (READIN) - - !***calculate kappa between me and all my neighbors - LOOPMYSLIP: DO me_slip=1_pInt,ns - vld_Nneighbors = Nneighbors - tmp_myshear_slip = me_acshear(me_slip) - tmp_mprime = 0.0_pReal !highest m' from all neighbors - tmp_acshear = 0.0_pReal !accumulative shear from highest m' - - !***go through my neighbors to find highest m' - LOOPNEIGHBORS: DO n=1_pInt,Nneighbors - neighbor_el = mesh_ipNeighborhood(1,n,ip,el) - neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) - neighbor_n = 1 !It is ipc - neighbor_of = phasememberAt( neighbor_n, neighbor_ip, neighbor_el) - neighbor_ph = phaseAt( neighbor_n, neighbor_ip, neighbor_el) - neighbor_tex = material_texture(1,neighbor_ip,neighbor_el) - neighbor_orientation = orientation(1:4, neighbor_n, neighbor_ip, neighbor_el) !ipc is always 1. - absMisorientation = lattice_qDisorientation(my_orientation, & - neighbor_orientation, & - 0_pInt) !no need for explicit calculation of symmetry - - !***find the accumulative shear for this neighbor - LOOPFINDNEISHEAR: DO ne_slip_ac=1_pInt, ns - ne_acshear(ne_slip_ac) = plasticState(ph)%state(offset_acshear_slip+ne_slip_ac, & - neighbor_of) - ENDDO LOOPFINDNEISHEAR - - !***calculate the average accumulative shear and use it as cutoff - avg_acshear_ne = sum(ne_acshear)/real(ns,pReal) - - !*** - IF (ph==neighbor_ph) THEN - !***walk through all the - LOOPNEIGHBORSLIP: DO ne_slip=1_pInt,ns - !***only consider slip system that is active (above average accumulative shear) - IF (ne_acshear(ne_slip) > avg_acshear_ne) THEN - m_primes(ne_slip) = abs(math_mul3x3(slipNormal(1:3,me_slip), & - math_qRot(absMisorientation, slipNormal(1:3,ne_slip)))) & - *abs(math_mul3x3(slipDirect(1:3,me_slip), & - math_qRot(absMisorientation, slipDirect(1:3,ne_slip)))) - !***find the highest m' and corresponding accumulative shear - IF (m_primes(ne_slip) > tmp_mprime) THEN - tmp_mprime = m_primes(ne_slip) - tmp_acshear = ne_acshear(ne_slip) - ENDIF - ENDIF - ENDDO LOOPNEIGHBORSLIP - - ELSE - ne_mprimes(n) = 0.0_pReal - vld_Nneighbors = vld_Nneighbors - 1_pInt - ENDIF - - ENDDO LOOPNEIGHBORS - - !***check if this element close to rim - IF (vld_Nneighbors < Nneighbors) THEN - !***rim voxel, no modification allowed - plasticState(ph)%state(index_kappa+me_slip, of) = 1.0_pReal - ELSE - !***patch voxel, started to calculate push up factor for gamma_dot - IF ((tmp_mprime > mprime_cut) .AND. (tmp_acshear > tmp_myshear_slip)) THEN - plasticState(ph)%state(index_kappa+me_slip, of) = 1.0_pReal / tmp_mprime - ELSE - !***minimum damping factor is 0.5 - plasticState(ph)%state(index_kappa+me_slip, of) = 0.5_pReal + tmp_mprime * 0.5_pReal - ENDIF - ENDIF - - ENDDO LOOPMYSLIP - -end subroutine plastic_phenoplus_microstructure - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates plastic velocity gradient and its tangent -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) - use prec, only: & - dNeq0 - use math, only: & - math_Plain3333to99, & - math_Mandel6to33 - use lattice, only: & - lattice_Sslip, & - lattice_Sslip_v, & - lattice_Stwin, & - lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_NnonSchmid - use material, only: & - plasticState, & - phaseAt, phasememberAt, & - phase_plasticityInstance - - implicit none - real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(9,9), intent(out) :: & - dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress - - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - - integer(pInt) :: & - instance, & - nSlip, & - nTwin,index_Gamma,index_F,index_myFamily, index_kappa, & - f,i,j,k,l,m,n, & - of, & - ph - real(pReal) :: & - tau_slip_pos,tau_slip_neg, & - gdot_slip_pos,gdot_slip_neg, & - dgdot_dtauslip_pos,dgdot_dtauslip_neg, & - gdot_twin,dgdot_dtautwin,tau_twin - real(pReal), dimension(3,3,3,3) :: & - dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor - real(pReal), dimension(3,3,2) :: & - nonSchmid_tensor - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - nSlip = plastic_phenoplus_totalNslip(instance) - nTwin = plastic_phenoplus_totalNtwin(instance) - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - index_kappa = nSlip + nTwin + 2_pInt +nSlip + nTwin - - Lp = 0.0_pReal - dLp_dTstar3333 = 0.0_pReal - dLp_dTstar99 = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! Slip part - j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) - j = j+1_pInt - - ! Calculation of Lp - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_pos - nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) - do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + plastic_phenoplus_nonSchmidCoeff(k,instance)*& - lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_phenoplus_nonSchmidCoeff(k,instance)*& - lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) - enddo - - !***insert non-local effect here by modify gdot with kappa in plastic state - !***this implementation will most likely cause convergence issue - ! gdot_slip_pos = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & - ! ((abs(tau_slip_pos)/(plasticState(ph)%state(j, of)* & - ! plasticState(ph)%state(j+index_kappa, of))) & !in-place modification of gdot - ! **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_pos) - - ! gdot_slip_neg = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & - ! ((abs(tau_slip_neg)/(plasticState(ph)%state(j, of)* & - ! plasticState(ph)%state(j+index_kappa, of))) & !?should we make it direction aware - ! **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_neg) - - !***original calculation - gdot_slip_pos = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & - ((abs(tau_slip_pos)/(plasticState(ph)%state(j, of))) & !in-place modification of gdot - **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_pos) - - gdot_slip_neg = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & - ((abs(tau_slip_neg)/(plasticState(ph)%state(j, of))) & !?should we make it direction aware - **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_neg) - - !***MAGIC HERE***! - !***directly modify the amount of shear happens considering neighborhood - gdot_slip_pos = gdot_slip_pos * plasticState(ph)%state(j+index_kappa, of) - gdot_slip_neg = gdot_slip_neg * plasticState(ph)%state(j+index_kappa, of) - - Lp = Lp + (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) - - ! Calculation of the tangent of Lp - if (dNeq0(gdot_slip_pos)) then - dgdot_dtauslip_pos = gdot_slip_pos*plastic_phenoplus_n_slip(instance)/tau_slip_pos - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtauslip_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & - nonSchmid_tensor(m,n,1) - endif - - if (dNeq0(gdot_slip_neg)) then - dgdot_dtauslip_neg = gdot_slip_neg*plastic_phenoplus_n_slip(instance)/tau_slip_neg - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtauslip_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & - nonSchmid_tensor(m,n,2) - endif - enddo slipSystems - enddo slipFamilies - -!-------------------------------------------------------------------------------------------------- -! Twinning part - j = 0_pInt - twinFamilies: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) - j = j+1_pInt - - ! Calculation of Lp - tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenoplus_gdot0_twin(instance)*& - (abs(tau_twin)/plasticState(ph)%state(nSlip+j,of))**& - plastic_phenoplus_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) - Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) - - ! Calculation of the tangent of Lp - if (dNeq0(gdot_twin)) then - dgdot_dtautwin = gdot_twin*plastic_phenoplus_n_twin(instance)/tau_twin - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtautwin*lattice_Stwin(k,l,index_myFamily+i,ph)* & - lattice_Stwin(m,n,index_myFamily+i,ph) - endif - enddo twinSystems - enddo twinFamilies - - dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) - - -end subroutine plastic_phenoplus_LpAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_dotState(Tstar_v,ipc,ip,el) - use lattice, only: & - lattice_Sslip_v, & - lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_shearTwin, & - lattice_NnonSchmid - use material, only: & - material_phase, & - phaseAt, phasememberAt, & - plasticState, & - phase_plasticityInstance - - implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element !< microstructure state - - integer(pInt) :: & - instance,ph, & - nSlip,nTwin, & - f,i,j,k, & - index_Gamma,index_F,index_myFamily,& - offset_accshear_slip,offset_accshear_twin, offset_kappa, & - of - real(pReal) :: & - c_SlipSlip,c_TwinSlip,c_TwinTwin, & - ssat_offset, & - tau_slip_pos,tau_slip_neg,tau_twin - - real(pReal), dimension(plastic_phenoplus_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip - real(pReal), dimension(plastic_phenoplus_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - - nSlip = plastic_phenoplus_totalNslip(instance) - nTwin = plastic_phenoplus_totalNtwin(instance) - - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - offset_accshear_slip = nSlip + nTwin + 2_pInt - offset_accshear_twin = nSlip + nTwin + 2_pInt + nSlip - offset_kappa = nSlip + nTwin + 2_pInt + nSlip + nTwin - plasticState(ph)%dotState(:,of) = 0.0_pReal - - -!-------------------------------------------------------------------------------------------------- -! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices - c_SlipSlip = plastic_phenoplus_h0_SlipSlip(instance)*& - (1.0_pReal + plastic_phenoplus_twinC(instance)*plasticState(ph)%state(index_F,of)**& - plastic_phenoplus_twinB(instance)) - c_TwinSlip = plastic_phenoplus_h0_TwinSlip(instance)*& - plasticState(ph)%state(index_Gamma,of)**plastic_phenoplus_twinE(instance) - c_TwinTwin = plastic_phenoplus_h0_TwinTwin(instance)*& - plasticState(ph)%state(index_F,of)**plastic_phenoplus_twinD(instance) - -!-------------------------------------------------------------------------------------------------- -! calculate left and right vectors and calculate dot gammas - ssat_offset = plastic_phenoplus_spr(instance)*sqrt(plasticState(ph)%state(index_F,of)) - j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) - j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal ! no system-dependent left part - left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part - !***original implementation - right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) & - **plastic_phenoplus_a_slip(instance)& - *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) - !***modify a_slip to get nonlocal effect - ! right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & - ! (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) & - ! **(plastic_phenoplus_a_slip(instance)*plasticState(ph)%state(j+offset_kappa, of))& - ! *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - ! (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) - right_TwinSlip(j) = 1.0_pReal ! no system-dependent part - -!-------------------------------------------------------------------------------------------------- -! Calculation of dot gamma - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - enddo nonSchmidSystems - gdot_slip(j) = plastic_phenoplus_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**plastic_phenoplus_n_slip(instance) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**plastic_phenoplus_n_slip(instance))& - *sign(1.0_pReal,tau_slip_pos) - enddo slipSystems1 - enddo slipFamilies1 - - - j = 0_pInt - twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) - j = j+1_pInt - left_TwinSlip(j) = 1.0_pReal ! no system-dependent left part - left_TwinTwin(j) = 1.0_pReal ! no system-dependent left part - right_SlipTwin(j) = 1.0_pReal ! no system-dependent right part - right_TwinTwin(j) = 1.0_pReal ! no system-dependent right part - -!-------------------------------------------------------------------------------------------------- -! Calculation of dot vol frac - tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenoplus_gdot0_twin(instance)*& - (abs(tau_twin)/plasticState(ph)%state(nslip+j,of))**& - plastic_phenoplus_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) - enddo twinSystems1 - enddo twinFamilies1 - -!-------------------------------------------------------------------------------------------------- -! calculate the overall hardening based on above - j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily - slipSystems2: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) - j = j+1_pInt - plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j - c_SlipSlip * left_SlipSlip(j) * & - dot_product(plastic_phenoplus_hardeningMatrix_SlipSlip(j,1:nSlip,instance), & - right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(plastic_phenoplus_hardeningMatrix_SlipTwin(j,1:nTwin,instance), & - right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor - plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + & - abs(gdot_slip(j)) - plasticState(ph)%dotState(offset_accshear_slip+j,of) = abs(gdot_slip(j)) - enddo slipSystems2 - enddo slipFamilies2 - - j = 0_pInt - twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) - j = j+1_pInt - plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j - c_TwinSlip * left_TwinSlip(j) * & - dot_product(plastic_phenoplus_hardeningMatrix_TwinSlip(j,1:nSlip,instance), & - right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - c_TwinTwin * left_TwinTwin(j) * & - dot_product(plastic_phenoplus_hardeningMatrix_TwinTwin(j,1:nTwin,instance), & - right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor - if (plasticState(ph)%state(index_F,of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 - plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + & - gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) - plasticState(ph)%dotState(offset_accshear_twin+j,of) = abs(gdot_twin(j)) - enddo twinSystems2 - enddo twinFamilies2 - - -end subroutine plastic_phenoplus_dotState - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of constitutive results -!-------------------------------------------------------------------------------------------------- -function plastic_phenoplus_postResults(Tstar_v,ipc,ip,el) - use material, only: & - material_phase, & - plasticState, & - phaseAt, phasememberAt, & - phase_plasticityInstance - use lattice, only: & - lattice_Sslip_v, & - lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_NnonSchmid - - implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element !< microstructure state - - real(pReal), dimension(plastic_phenoplus_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - plastic_phenoplus_postResults - - integer(pInt) :: & - instance,ph, of, & - nSlip,nTwin, & - o,f,i,c,j,k, & - index_Gamma,index_F,index_accshear_slip,index_accshear_twin,index_myFamily,index_kappa - real(pReal) :: & - tau_slip_pos,tau_slip_neg,tau - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - - nSlip = plastic_phenoplus_totalNslip(instance) - nTwin = plastic_phenoplus_totalNtwin(instance) - - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - index_accshear_slip = nSlip + nTwin + 2_pInt + 1_pInt - index_accshear_twin = nSlip + nTwin + 2_pInt + nSlip + 1_pInt - index_kappa = nSlip + nTwin + 2_pInt + nSlip + nTwin + 1_pInt - - plastic_phenoplus_postResults = 0.0_pReal - c = 0_pInt - - outputsLoop: do o = 1_pInt,plastic_phenoplus_Noutput(instance) - select case(plastic_phenoplus_outputID(o,instance)) - case (resistance_slip_ID) - plastic_phenoplus_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(1:nSlip,of) - c = c + nSlip - - case (accumulatedshear_slip_ID) - plastic_phenoplus_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(index_accshear_slip:& - index_accshear_slip+nSlip-1_pInt,of) - c = c + nSlip - - case (shearrate_slip_ID) - j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) - j = j + 1_pInt - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_pos - do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - enddo - plastic_phenoplus_postResults(c+j) = plastic_phenoplus_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**plastic_phenoplus_n_slip(instance) & - +(abs(tau_slip_neg)/plasticState(ph)%state(j,of))**plastic_phenoplus_n_slip(instance))& - *sign(1.0_pReal,tau_slip_pos) - - enddo slipSystems1 - enddo slipFamilies1 - c = c + nSlip - - case (resolvedstress_slip_ID) - j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems2: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) - j = j + 1_pInt - plastic_phenoplus_postResults(c+j) = & - dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - enddo slipSystems2 - enddo slipFamilies2 - c = c + nSlip - - case (kappa_slip_ID) - plastic_phenoplus_postResults(c+1_pInt:c+nSlip) = & - plasticState(ph)%state(index_kappa:index_kappa+nSlip-1_pInt,of) - c = c + nSlip - - case (totalshear_ID) - plastic_phenoplus_postResults(c+1_pInt) = & - plasticState(ph)%state(index_Gamma,of) - c = c + 1_pInt - - case (resistance_twin_ID) - plastic_phenoplus_postResults(c+1_pInt:c+nTwin) = & - plasticState(ph)%state(1_pInt+nSlip:1_pInt+nSlip+nTwin-1_pInt,of) - c = c + nTwin - - case (accumulatedshear_twin_ID) - plastic_phenoplus_postResults(c+1_pInt:c+nTwin) = & - plasticState(ph)%state(index_accshear_twin:index_accshear_twin+nTwin-1_pInt,of) - c = c + nTwin - - case (shearrate_twin_ID) - j = 0_pInt - twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) - j = j + 1_pInt - tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - plastic_phenoplus_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenoplus_gdot0_twin(instance)*& - (abs(tau)/plasticState(ph)%state(j+nSlip,of))**& - plastic_phenoplus_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) - enddo twinSystems1 - enddo twinFamilies1 - c = c + nTwin - - case (resolvedstress_twin_ID) - j = 0_pInt - twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) - j = j + 1_pInt - plastic_phenoplus_postResults(c+j) = & - dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - enddo twinSystems2 - enddo twinFamilies2 - c = c + nTwin - - case (totalvolfrac_twin_ID) - plastic_phenoplus_postResults(c+1_pInt) = plasticState(ph)%state(index_F,of) - c = c + 1_pInt - - end select - enddo outputsLoop - -end function plastic_phenoplus_postResults - -end module plastic_phenoplus diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index a7c7b10e6..55d31fa9b 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -123,7 +123,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & dEq0 use debug, only: & diff --git a/src/plastic_titanmod.f90 b/src/plastic_titanmod.f90 deleted file mode 100644 index ac80af82b..000000000 --- a/src/plastic_titanmod.f90 +++ /dev/null @@ -1,1903 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Alankar Alankar, Max-Planck-Institut für Eisenforschung GmbH -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for titanium -!-------------------------------------------------------------------------------------------------- -module plastic_titanmod - use prec, only: & - pReal, & - pInt - - implicit none - private - character(len=18), dimension(3), parameter, private :: & - plastic_titanmod_listBasicSlipStates = & - ['rho_edge ', 'rho_screw ', 'shear_system'] - character(len=18), dimension(1), parameter, private :: & - plastic_titanmod_listBasicTwinStates = ['gdot_twin'] - character(len=19), dimension(11), parameter, private :: & - plastic_titanmod_listDependentSlipStates = & - ['segment_edge ', 'segment_screw ', & - 'resistance_edge ', 'resistance_screw ', & - 'tau_slip ', & - 'velocity_edge ', 'velocity_screw ', & - 'gdot_slip_edge ', 'gdot_slip_screw ', & - 'stressratio_edge_p ', 'stressratio_screw_p' ] - character(len=18), dimension(2), parameter, private :: & - plastic_titanmod_listDependentTwinStates = & - ['twin_fraction', 'tau_twin '] - real(pReal), parameter, private :: & - kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin - - - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_titanmod_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_titanmod_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_titanmod_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_titanmod_Noutput !< number of outputs per instance of this plasticity !< ID of the lattice structure - - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_titanmod_totalNslip, & !< total number of active slip systems for each instance - plastic_titanmod_totalNtwin !< total number of active twin systems for each instance - - integer(pInt), dimension(:,:), allocatable, private :: & - plastic_titanmod_Nslip, & !< number of active slip systems for each family and instance - plastic_titanmod_Ntwin, & !< number of active twin systems for each family and instance - plastic_titanmod_slipFamily, & !< lookup table relating active slip system to slip family for each instance - plastic_titanmod_twinFamily, & !< lookup table relating active twin system to twin family for each instance - plastic_titanmod_slipSystemLattice, & !< lookup table relating active slip system index to lattice slip system index for each instance - plastic_titanmod_twinSystemLattice !< lookup table relating active twin system index to lattice twin system index for each instance - - real(pReal), dimension(:), allocatable, private :: & - plastic_titanmod_debyefrequency, & !< Debye frequency - plastic_titanmod_kinkf0, & !< - plastic_titanmod_CAtomicVolume, & !< atomic volume in Bugers vector unit - plastic_titanmod_dc, & !< prefactor for self-diffusion coefficient - plastic_titanmod_twinhpconstant, & !< activation energy for dislocation climb - plastic_titanmod_GrainSize, & !< grain size - Not being used - plastic_titanmod_MaxTwinFraction, & !< maximum allowed total twin volume fraction - plastic_titanmod_r, & !< r-exponent in twin nucleation rate - plastic_titanmod_CEdgeDipMinDistance, & !< Not being used - plastic_titanmod_Cmfptwin, & !< Not being used - plastic_titanmod_Cthresholdtwin, & !< Not being used - plastic_titanmod_aTolRho !< absolute tolerance for integration of dislocation density - - real(pReal), dimension(:,:), allocatable, private :: & - plastic_titanmod_rho_edge0, & !< initial edge dislocation density per slip system for each family and instance - plastic_titanmod_rho_screw0, & !< initial screw dislocation density per slip system for each family and instance - plastic_titanmod_shear_system0, & !< accumulated shear on each system - plastic_titanmod_burgersPerSlipFam, & !< absolute length of burgers vector [m] for each slip family and instance - plastic_titanmod_burgersPerSlipSys, & !< absolute length of burgers vector [m] for each slip system and instance - plastic_titanmod_burgersPerTwinFam, & !< absolute length of burgers vector [m] for each twin family and instance - plastic_titanmod_burgersPerTwinSys, & !< absolute length of burgers vector [m] for each twin system and instance - plastic_titanmod_f0_PerSlipFam, & !< activation energy for glide [J] for each slip family and instance - plastic_titanmod_f0_PerSlipSys, & !< activation energy for glide [J] for each slip system and instance - plastic_titanmod_twinf0_PerTwinFam, & !< activation energy for glide [J] for each twin family and instance - plastic_titanmod_twinf0_PerTwinSys, & !< activation energy for glide [J] for each twin system and instance - plastic_titanmod_twinshearconstant_PerTwinFam, & !< activation energy for glide [J] for each twin family and instance - plastic_titanmod_twinshearconstant_PerTwinSys, & !< activation energy for glide [J] for each twin system and instance - plastic_titanmod_tau0e_PerSlipFam, & !< Initial yield stress for edge dislocations per slip family - plastic_titanmod_tau0e_PerSlipSys, & !< Initial yield stress for edge dislocations per slip system - plastic_titanmod_tau0s_PerSlipFam, & !< Initial yield stress for screw dislocations per slip family - plastic_titanmod_tau0s_PerSlipSys, & !< Initial yield stress for screw dislocations per slip system - plastic_titanmod_twintau0_PerTwinFam, & !< Initial yield stress for edge dislocations per twin family - plastic_titanmod_twintau0_PerTwinSys, & !< Initial yield stress for edge dislocations per twin system - plastic_titanmod_capre_PerSlipFam, & !< Capture radii for edge dislocations per slip family - plastic_titanmod_capre_PerSlipSys, & !< Capture radii for edge dislocations per slip system - plastic_titanmod_caprs_PerSlipFam, & !< Capture radii for screw dislocations per slip family - plastic_titanmod_caprs_PerSlipSys, & !< Capture radii for screw dislocations per slip system - plastic_titanmod_pe_PerSlipFam, & !< p-exponent in glide velocity - plastic_titanmod_ps_PerSlipFam, & !< p-exponent in glide velocity - plastic_titanmod_qe_PerSlipFam, & !< q-exponent in glide velocity - plastic_titanmod_qs_PerSlipFam, & !< q-exponent in glide velocity - plastic_titanmod_pe_PerSlipSys, & !< p-exponent in glide velocity - plastic_titanmod_ps_PerSlipSys, & !< p-exponent in glide velocity - plastic_titanmod_qe_PerSlipSys, & !< q-exponent in glide velocity - plastic_titanmod_qs_PerSlipSys, & !< q-exponent in glide velocity - plastic_titanmod_twinp_PerTwinFam, & !< p-exponent in glide velocity - plastic_titanmod_twinq_PerTwinFam, & !< q-exponent in glide velocity - plastic_titanmod_twinp_PerTwinSys, & !< p-exponent in glide velocity - plastic_titanmod_twinq_PerTwinSys, & !< p-exponent in glide velocity - plastic_titanmod_v0e_PerSlipFam, & !< edge dislocation velocity prefactor [m/s] for each family and instance - plastic_titanmod_v0e_PerSlipSys, & !< screw dislocation velocity prefactor [m/s] for each slip system and instance - plastic_titanmod_v0s_PerSlipFam, & !< edge dislocation velocity prefactor [m/s] for each family and instance - plastic_titanmod_v0s_PerSlipSys, & !< screw dislocation velocity prefactor [m/s] for each slip system and instance - plastic_titanmod_twingamma0_PerTwinFam, & !< edge dislocation velocity prefactor [m/s] for each family and instance - plastic_titanmod_twingamma0_PerTwinSys, & !< screw dislocation velocity prefactor [m/s] for each slip system and instance - plastic_titanmod_kinkcriticallength_PerSlipFam, & !< screw dislocation mobility prefactor for kink-pairs per slip family - plastic_titanmod_kinkcriticallength_PerSlipSys, & !< screw dislocation mobility prefactor for kink-pairs per slip system - plastic_titanmod_twinsizePerTwinFam, & !< twin thickness [m] for each twin family and instance - plastic_titanmod_twinsizePerTwinSys, & !< twin thickness [m] for each twin system and instance - plastic_titanmod_CeLambdaSlipPerSlipFam, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance - plastic_titanmod_CeLambdaSlipPerSlipSys, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance - plastic_titanmod_CsLambdaSlipPerSlipFam, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance - plastic_titanmod_CsLambdaSlipPerSlipSys, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance - plastic_titanmod_twinLambdaSlipPerTwinFam, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance - plastic_titanmod_twinLambdaSlipPerTwinSys, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance - plastic_titanmod_interactionSlipSlip, & !< coefficients for slip-slip interaction for each interaction type and instance - plastic_titanmod_interaction_ee, & !< coefficients for e-e interaction for each interaction type and instance - plastic_titanmod_interaction_ss, & !< coefficients for s-s interaction for each interaction type and instance - plastic_titanmod_interaction_es, & !< coefficients for e-s-twin interaction for each interaction type and instance - plastic_titanmod_interactionSlipTwin, & !< coefficients for twin-slip interaction for each interaction type and instance - plastic_titanmod_interactionTwinSlip, & !< coefficients for twin-slip interaction for each interaction type and instance - plastic_titanmod_interactionTwinTwin !< coefficients for twin-twin interaction for each interaction type and instance - - real(pReal), dimension(:,:,:), allocatable, private :: & - plastic_titanmod_interactionMatrixSlipSlip, & !< interaction matrix of the different slip systems for each instance - plastic_titanmod_interactionMatrix_ee, & !< interaction matrix of e-e for each instance - plastic_titanmod_interactionMatrix_ss, & !< interaction matrix of s-s for each instance - plastic_titanmod_interactionMatrix_es, & !< interaction matrix of e-s for each instance - plastic_titanmod_interactionMatrixSlipTwin, & !< interaction matrix of slip systems with twin systems for each instance - plastic_titanmod_interactionMatrixTwinSlip, & !< interaction matrix of twin systems with slip systems for each instance - plastic_titanmod_interactionMatrixTwinTwin, & !< interaction matrix of the different twin systems for each instance - plastic_titanmod_forestProjectionEdge, & !< matrix of forest projections of edge dislocations for each instance - plastic_titanmod_forestProjectionScrew, & !< matrix of forest projections of screw dislocations for each instance - plastic_titanmod_TwinforestProjectionEdge, & !< matrix of forest projections of edge dislocations in twin system for each instance - plastic_titanmod_TwinforestProjectionScrew !< matrix of forest projections of screw dislocations in twin system for each instance - - real(pReal), dimension(:,:,:,:), allocatable, private :: & - plastic_titanmod_Ctwin66 !< twin elasticity matrix in Mandel notation for each instance - - real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & - plastic_titanmod_Ctwin3333 !< twin elasticity matrix for each instance - - enum, bind(c) - enumerator :: undefined_ID, & - rhoedge_ID, rhoscrew_ID, & - segment_edge_ID, segment_screw_ID, & - resistance_edge_ID, resistance_screw_ID, & - velocity_edge_ID, velocity_screw_ID, & - tau_slip_ID, & - gdot_slip_edge_ID, gdot_slip_screw_ID, & - gdot_slip_ID, & - stressratio_edge_p_ID, stressratio_screw_p_ID, & - shear_system_ID, & - twin_fraction_ID, & - shear_basal_ID, shear_prism_ID, shear_pyra_ID, shear_pyrca_ID, & - rhoedge_basal_ID, rhoedge_prism_ID, rhoedge_pyra_ID, rhoedge_pyrca_ID, & - rhoscrew_basal_ID, rhoscrew_prism_ID, rhoscrew_pyra_ID, rhoscrew_pyrca_ID, & - shear_total_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - plastic_titanmod_outputID !< ID of each post result output - - public :: & - plastic_titanmod_microstructure, & - plastic_titanmod_stateInit, & - plastic_titanmod_init, & - plastic_titanmod_LpAndItsTangent, & - plastic_titanmod_dotState, & - plastic_titanmod_postResults, & - plastic_titanmod_homogenizedC - - contains - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine plastic_titanmod_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use math, only: & - math_Mandel3333to66,& - math_Voigt66to3333,& - math_mul3x3 - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use material, only: & - phase_plasticity, & - phase_plasticityInstance, & - phase_Noutput, & - PLASTICITY_TITANMOD_label, & - PLASTICITY_TITANMOD_ID, & - plasticState, & - MATERIAL_partPhase - use lattice - use numerics,only: & - numerics_integrator - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: & - phase, & - instance, j, k, l, m, n, p, q, r, & - f, o, & - s, s1, s2, & - t, t1, t2, & - ns, nt, & - Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & - Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, & - offset_slip, mySize, & - maxTotalNslip,maxTotalNtwin, maxNinstance - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase = 0_pInt - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_TITANMOD_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(phase_plasticity == PLASTICITY_TITANMOD_ID),pInt) - if (maxNinstance == 0_pInt) return - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(plastic_titanmod_sizePostResults(maxNinstance), source=0_pInt) - allocate(plastic_titanmod_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt) - allocate(plastic_titanmod_output(maxval(phase_Noutput),maxNinstance)) - plastic_titanmod_output = '' - allocate(plastic_titanmod_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(plastic_titanmod_Noutput(maxNinstance), source=0_pInt) - - allocate(plastic_titanmod_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_slipFamily(lattice_maxNslip,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_twinFamily(lattice_maxNtwin,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_slipSystemLattice(lattice_maxNslip,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_twinSystemLattice(lattice_maxNtwin,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_totalNslip(maxNinstance), source=0_pInt) - allocate(plastic_titanmod_totalNtwin(maxNinstance), source=0_pInt) - allocate(plastic_titanmod_debyefrequency(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_kinkf0(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CAtomicVolume(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_dc(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinhpconstant(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_GrainSize(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_MaxTwinFraction(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_r(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_Cmfptwin(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_Cthresholdtwin(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_aTolRho(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_rho_edge0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_rho_screw0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_shear_system0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_burgersPerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_burgersPerTwinFam(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_f0_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_tau0e_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_tau0s_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_capre_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_caprs_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_pe_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_ps_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_qe_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_qs_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_v0e_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_v0s_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_kinkcriticallength_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinsizePerTwinFam(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CeLambdaSlipPerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CsLambdaSlipPerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - - allocate(plastic_titanmod_twinf0_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinshearconstant_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twintau0_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinp_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinq_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twingamma0_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinLambdaSlipPerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - - allocate(plastic_titanmod_interactionSlipSlip(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interaction_ee(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interaction_ss(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interaction_es(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionSlipTwin(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionTwinSlip(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionTwinTwin(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next section - phase = phase + 1_pInt ! advance section counter - if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then - Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) - Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) - Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) - Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) - Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) - Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) - endif - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then ! one of my sections. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran - instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('rhoedge') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoscrew') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('segment_edge') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = segment_edge_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('segment_screw') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = segment_screw_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resistance_edge') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = resistance_edge_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resistance_screw') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = resistance_screw_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('velocity_edge') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = velocity_edge_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('velocity_screw') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = velocity_screw_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('tau_slip') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = tau_slip_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('gdot_slip_edge') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_edge_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('gdot_slip_screw') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_screw_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('gdot_slip') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('stressratio_edge_p') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = stressratio_edge_p_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('stressratio_screw_p') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = stressratio_screw_p_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_system') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_system_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('twin_fraction') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = twin_fraction_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_basal') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_basal_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_prism') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_prism_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_pyra') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_pyra_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_pyrca') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_pyrca_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoedge_basal') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_basal_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoedge_prism') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_prism_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoedge_pyra') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_pyra_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoedge_pyrca') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_pyrca_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoscrew_basal') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_basal_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoscrew_prism') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_prism_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoscrew_pyra') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_pyra_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoscrew_pyrca') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_pyrca_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_total') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_total_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - case ('debyefrequency') - plastic_titanmod_debyefrequency(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('kinkf0') - plastic_titanmod_kinkf0(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('nslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - case ('ntwin') - if (chunkPos(1) < 1_pInt + Nchunks_TwinFamilies) & - call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - case ('rho_edge0') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_rho_edge0(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('rho_screw0') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_rho_screw0(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('slipburgers') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_burgersPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinburgers') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_burgersPerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('f0') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_f0_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinf0') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinf0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('tau0e') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_tau0e_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twintau0') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twintau0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('tau0s') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_tau0s_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('capre') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_capre_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('caprs') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_caprs_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('v0e') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_v0e_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twingamma0') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twingamma0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('v0s') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_v0s_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('kinkcriticallength') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_kinkcriticallength_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinsize') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinsizePerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('celambdaslip') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_CeLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinlambdaslip') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinlambdaslipPerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('cslambdaslip') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_CsLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('grainsize') - plastic_titanmod_GrainSize(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('maxtwinfraction') - plastic_titanmod_MaxTwinFraction(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('pe') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_pe_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinp') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinp_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('ps') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_ps_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('qe') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_qe_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinq') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinq_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('qs') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_qs_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinshearconstant') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinshearconstant_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('dc') - plastic_titanmod_dc(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twinhpconstant') - plastic_titanmod_twinhpconstant(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_rho') - plastic_titanmod_aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('interactionee') - do j = 1_pInt, lattice_maxNinteraction - plastic_titanmod_interaction_ee(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interactionss') - do j = 1_pInt, lattice_maxNinteraction - plastic_titanmod_interaction_ss(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interactiones') - do j = 1_pInt, lattice_maxNinteraction - plastic_titanmod_interaction_es(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_slipslip','interactionslipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_SlipSlip - plastic_titanmod_interactionSlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_sliptwin','interactionsliptwin') - if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_SlipTwin - plastic_titanmod_interactionSlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_twinslip','interactiontwinslip') - if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_TwinSlip - plastic_titanmod_interactionTwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_twintwin','interactiontwintwin') - if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_TwinTwin - plastic_titanmod_interactionTwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - end select - endif; endif - enddo parsingFile - - sanityChecks: do phase = 1_pInt, size(phase_plasticity) - myPhase: if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then - instance = phase_plasticityInstance(phase) - if (sum(plastic_titanmod_Nslip(:,instance)) < 0_pInt) & - call IO_error(211_pInt,el=instance,ext_msg='nslip ('//PLASTICITY_TITANMOD_label//')') - if (sum(plastic_titanmod_Ntwin(:,instance)) < 0_pInt) & - call IO_error(211_pInt,el=instance,ext_msg='ntwin ('//PLASTICITY_TITANMOD_label//')') - do f = 1_pInt,lattice_maxNslipFamily - if (plastic_titanmod_Nslip(f,instance) > 0_pInt) then - if (plastic_titanmod_rho_edge0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rho_edge0 ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_rho_screw0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rho_screw0 ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_burgersPerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='slipburgers ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_f0_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='f0 ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_tau0e_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='tau0e ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_tau0s_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='tau0s ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_capre_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='capre ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_caprs_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='caprs ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_v0e_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='v0e ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_v0s_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='v0s ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_kinkcriticallength_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='kinkCriticalLength ('//PLASTICITY_TITANMOD_label//')') - endif - enddo - do f = 1_pInt,lattice_maxNtwinFamily - if (plastic_titanmod_Ntwin(f,instance) > 0_pInt) then - if (plastic_titanmod_burgersPerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinburgers ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_twinf0_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinf0 ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_twinshearconstant_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinshearconstant ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_twintau0_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twintau0 ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_twingamma0_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twingamma0 ('//PLASTICITY_TITANMOD_label//')') - endif - enddo - if (plastic_titanmod_dc(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='dc ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_twinhpconstant(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinhpconstant ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_aTolRho(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTol_rho ('//PLASTICITY_TITANMOD_label//')') - -!-------------------------------------------------------------------------------------------------- -! determine total number of active slip or twin systems - plastic_titanmod_Nslip(:,instance) = min(lattice_NslipSystem(:,phase),plastic_titanmod_Nslip(:,instance)) - plastic_titanmod_Ntwin(:,instance) = min(lattice_NtwinSystem(:,phase),plastic_titanmod_Ntwin(:,instance)) - plastic_titanmod_totalNslip(instance) = sum(plastic_titanmod_Nslip(:,instance)) - plastic_titanmod_totalNtwin(instance) = sum(plastic_titanmod_Ntwin(:,instance)) - endif myPhase - enddo sanityChecks - -!-------------------------------------------------------------------------------------------------- -! allocation of variables whose size depends on the total number of active slip systems - maxTotalNslip = maxval(plastic_titanmod_totalNslip) - maxTotalNtwin = maxval(plastic_titanmod_totalNtwin) - - allocate(plastic_titanmod_burgersPerSlipSys(maxTotalNslip, maxNinstance), source=0.0_pReal) - - allocate(plastic_titanmod_f0_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_tau0e_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_tau0s_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_capre_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_caprs_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_pe_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_ps_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_qe_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_qs_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_v0e_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_v0s_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_kinkcriticallength_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CeLambdaSlipPerSlipSys(maxTotalNslip, maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CsLambdaSlipPerSlipSys(maxTotalNslip, maxNinstance), source=0.0_pReal) - - allocate(plastic_titanmod_burgersPerTwinSys(maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinf0_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinshearconstant_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twintau0_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinp_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinq_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twingamma0_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinsizePerTwinSys(maxTotalNtwin, maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinLambdaSlipPerTwinSys(maxTotalNtwin, maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_Ctwin66 (6,6,maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_Ctwin3333 (3,3,3,3,maxTotalNtwin,maxNinstance), source=0.0_pReal) - - allocate(plastic_titanmod_interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrix_ee(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrix_ss(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrix_es(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrixSlipTwin(maxTotalNslip,maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrixTwinSlip(maxTotalNtwin,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrixTwinTwin(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_TwinforestProjectionEdge(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_TwinforestProjectionScrew(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) - - initializeInstances: do phase = 1_pInt, size(phase_plasticity) - if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then - instance = phase_plasticityInstance(phase) - -!-------------------------------------------------------------------------------------------------- -! inverse lookup of slip system family - l = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily - do s = 1_pInt,plastic_titanmod_Nslip(f,instance) - l = l + 1_pInt - plastic_titanmod_slipFamily(l,instance) = f - plastic_titanmod_slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt,phase)) + s - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! inverse lookup of twin system family - l = 0_pInt - do f = 1_pInt,lattice_maxNtwinFamily - do t = 1_pInt,plastic_titanmod_Ntwin(f,instance) - l = l + 1_pInt - plastic_titanmod_twinFamily(l,instance) = f - plastic_titanmod_twinSystemLattice(l,instance) = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) + t - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! determine size of state array - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - - sizeDotState = & - size(plastic_titanmod_listBasicSlipStates)*ns + & - size(plastic_titanmod_listBasicTwinStates)*nt - sizeState = sizeDotState+ & - size(plastic_titanmod_listDependentSlipStates)*ns + & - size(plastic_titanmod_listDependentTwinStates)*nt - sizeDeltaState = 0_pInt - -!-------------------------------------------------------------------------------------------------- -! determine size of postResults array - outputsLoop: do o = 1_pInt,plastic_titanmod_Noutput(instance) - mySize = 0_pInt - select case(plastic_titanmod_outputID(o,instance)) - case(rhoedge_ID, rhoscrew_ID, & - segment_edge_ID, segment_screw_ID, & - resistance_edge_ID, resistance_screw_ID, & - velocity_edge_ID, velocity_screw_ID, & - tau_slip_ID, & - gdot_slip_edge_ID, gdot_slip_screw_ID, & - gdot_slip_ID, & - stressratio_edge_p_ID, stressratio_screw_p_ID, & - shear_system_ID) - mySize = plastic_titanmod_totalNslip(instance) - case(twin_fraction_ID) - mySize = plastic_titanmod_totalNtwin(instance) - case(shear_basal_ID, shear_prism_ID, shear_pyra_ID, shear_pyrca_ID, & ! use only if all 4 slip families in hex are considered - rhoedge_basal_ID, rhoedge_prism_ID, rhoedge_pyra_ID, rhoedge_pyrca_ID, & - rhoscrew_basal_ID, rhoscrew_prism_ID, rhoscrew_pyra_ID, rhoscrew_pyrca_ID, & - shear_total_ID) - mySize = 1_pInt - case default - call IO_error(105_pInt,ext_msg=plastic_titanmod_output(o,instance)// & - ' ('//PLASTICITY_TITANMOD_label//')') - end select - - outputFound: if (mySize > 0_pInt) then - plastic_titanmod_sizePostResult(o,instance) = mySize - plastic_titanmod_sizePostResults(instance) = plastic_titanmod_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop -! Determine size of state array - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = plastic_titanmod_sizePostResults(instance) - plasticState(phase)%nSlip =plastic_titanmod_totalNslip(instance) - plasticState(phase)%nTwin = 0_pInt - plasticState(phase)%nTrans= 0_pInt - allocate(plasticState(phase)%aTolState (sizeState), source=plastic_titanmod_aTolRho(instance)) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) - offset_slip = 2_pInt*plasticState(phase)%nSlip+1 - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state (offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) -!-------------------------------------------------------------------------------------------------- -! construction of the twin elasticity matrices - do j=1_pInt,lattice_maxNtwinFamily - do k=1_pInt,plastic_titanmod_Ntwin(j,instance) - do l=1_pInt,3_pInt ; do m=1_pInt,3_pInt ; do n=1_pInt,3_pInt ; do o=1_pInt,3_pInt - do p=1_pInt,3_pInt ; do q=1_pInt,3_pInt ; do r=1_pInt,3_pInt ; do s=1_pInt,3_pInt - plastic_titanmod_Ctwin3333(l,m,n,o,sum(plastic_titanmod_Nslip(1:j-1_pInt,instance))+k,instance) = & - plastic_titanmod_Ctwin3333(l,m,n,o,sum(plastic_titanmod_Nslip(1:j-1_pInt,instance))+k,instance) + & - lattice_C3333(p,q,r,s,phase)*& - lattice_Qtwin(l,p,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & - lattice_Qtwin(m,q,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & - lattice_Qtwin(n,r,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & - lattice_Qtwin(o,s,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase) - enddo; enddo; enddo; enddo - enddo; enddo; enddo ; enddo - plastic_titanmod_Ctwin66(1:6,1:6,k,instance) = & - math_Mandel3333to66(plastic_titanmod_Ctwin3333(1:3,1:3,1:3,1:3,k,instance)) - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! Burgers vector, dislocation velocity prefactor for each slip system - do s = 1_pInt,plastic_titanmod_totalNslip(instance) - f = plastic_titanmod_slipFamily(s,instance) - - plastic_titanmod_burgersPerSlipSys(s,instance) = & - plastic_titanmod_burgersPerSlipFam(f,instance) - - plastic_titanmod_f0_PerSlipSys(s,instance) = & - plastic_titanmod_f0_PerSlipFam(f,instance) - - plastic_titanmod_tau0e_PerSlipSys(s,instance) = & - plastic_titanmod_tau0e_PerSlipFam(f,instance) - - plastic_titanmod_tau0s_PerSlipSys(s,instance) = & - plastic_titanmod_tau0s_PerSlipFam(f,instance) - - plastic_titanmod_capre_PerSlipSys(s,instance) = & - plastic_titanmod_capre_PerSlipFam(f,instance) - - plastic_titanmod_caprs_PerSlipSys(s,instance) = & - plastic_titanmod_caprs_PerSlipFam(f,instance) - - plastic_titanmod_v0e_PerSlipSys(s,instance) = & - plastic_titanmod_v0e_PerSlipFam(f,instance) - - plastic_titanmod_v0s_PerSlipSys(s,instance) = & - plastic_titanmod_v0s_PerSlipFam(f,instance) - - plastic_titanmod_kinkcriticallength_PerSlipSys(s,instance) = & - plastic_titanmod_kinkcriticallength_PerSlipFam(f,instance) - - plastic_titanmod_pe_PerSlipSys(s,instance) = & - plastic_titanmod_pe_PerSlipFam(f,instance) - - plastic_titanmod_ps_PerSlipSys(s,instance) = & - plastic_titanmod_ps_PerSlipFam(f,instance) - - plastic_titanmod_qe_PerSlipSys(s,instance) = & - plastic_titanmod_qe_PerSlipFam(f,instance) - - plastic_titanmod_qs_PerSlipSys(s,instance) = & - plastic_titanmod_qs_PerSlipFam(f,instance) - - plastic_titanmod_CeLambdaSlipPerSlipSys(s,instance) = & - plastic_titanmod_CeLambdaSlipPerSlipFam(f,instance) - - plastic_titanmod_CsLambdaSlipPerSlipSys(s,instance) = & - plastic_titanmod_CsLambdaSlipPerSlipFam(f,instance) - enddo - -!-------------------------------------------------------------------------------------------------- -! Burgers vector, nucleation rate prefactor and twin size for each twin system - do t = 1_pInt,plastic_titanmod_totalNtwin(instance) - f = plastic_titanmod_twinFamily(t,instance) - - plastic_titanmod_burgersPerTwinSys(t,instance) = & - plastic_titanmod_burgersPerTwinFam(f,instance) - - plastic_titanmod_twinsizePerTwinSys(t,instance) = & - plastic_titanmod_twinsizePerTwinFam(f,instance) - - plastic_titanmod_twinf0_PerTwinSys(t,instance) = & - plastic_titanmod_twinf0_PerTwinFam(f,instance) - - plastic_titanmod_twinshearconstant_PerTwinSys(t,instance) = & - plastic_titanmod_twinshearconstant_PerTwinFam(f,instance) - - plastic_titanmod_twintau0_PerTwinSys(t,instance) = & - plastic_titanmod_twintau0_PerTwinFam(f,instance) - - plastic_titanmod_twingamma0_PerTwinSys(t,instance) = & - plastic_titanmod_twingamma0_PerTwinFam(f,instance) - - plastic_titanmod_twinp_PerTwinSys(t,instance) = & - plastic_titanmod_twinp_PerTwinFam(f,instance) - - plastic_titanmod_twinq_PerTwinSys(t,instance) = & - plastic_titanmod_twinq_PerTwinFam(f,instance) - - plastic_titanmod_twinLambdaSlipPerTwinSys(t,instance) = & - plastic_titanmod_twinLambdaSlipPerTwinFam(f,instance) - enddo - -!-------------------------------------------------------------------------------------------------- -! Construction of interaction matrices - do s1 = 1_pInt,plastic_titanmod_totalNslip(instance) - do s2 = 1_pInt,plastic_titanmod_totalNslip(instance) - plastic_titanmod_interactionMatrixSlipSlip(s1,s2,instance) = & - plastic_titanmod_interactionSlipSlip(lattice_interactionSlipSlip( & - plastic_titanmod_slipSystemLattice(s1,instance),& - plastic_titanmod_slipSystemLattice(s2,instance),phase),instance) - - plastic_titanmod_interactionMatrix_ee(s1,s2,instance) = & - plastic_titanmod_interaction_ee(lattice_interactionSlipSlip ( & - plastic_titanmod_slipSystemLattice(s1,instance), & - plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) - - plastic_titanmod_interactionMatrix_ss(s1,s2,instance) = & - plastic_titanmod_interaction_ss(lattice_interactionSlipSlip( & - plastic_titanmod_slipSystemLattice(s1,instance), & - plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) - - plastic_titanmod_interactionMatrix_es(s1,s2,instance) = & - plastic_titanmod_interaction_es(lattice_interactionSlipSlip( & - plastic_titanmod_slipSystemLattice(s1,instance), & - plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) - enddo; enddo - - do s1 = 1_pInt,plastic_titanmod_totalNslip(instance) - do t2 = 1_pInt,plastic_titanmod_totalNtwin(instance) - plastic_titanmod_interactionMatrixSlipTwin(s1,t2,instance) = & - plastic_titanmod_interactionSlipTwin(lattice_interactionSlipTwin( & - plastic_titanmod_slipSystemLattice(s1,instance), & - plastic_titanmod_twinSystemLattice(t2,instance), phase),instance) - enddo; enddo - - do t1 = 1_pInt,plastic_titanmod_totalNtwin(instance) - do s2 = 1_pInt,plastic_titanmod_totalNslip(instance) - plastic_titanmod_interactionMatrixTwinSlip(t1,s2,instance) = & - plastic_titanmod_interactionTwinSlip(lattice_interactionTwinSlip( & - plastic_titanmod_twinSystemLattice(t1,instance), & - plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) - enddo; enddo - - do t1 = 1_pInt,plastic_titanmod_totalNtwin(instance) - do t2 = 1_pInt,plastic_titanmod_totalNtwin(instance) - plastic_titanmod_interactionMatrixTwinTwin(t1,t2,instance) = & - plastic_titanmod_interactionTwinTwin(lattice_interactionTwinTwin( & - plastic_titanmod_twinSystemLattice(t1,instance), & - plastic_titanmod_twinSystemLattice(t2,instance), phase),instance) - enddo; enddo - - do s1 = 1_pInt,plastic_titanmod_totalNslip(instance) - do s2 = 1_pInt,plastic_titanmod_totalNslip(instance) -!-------------------------------------------------------------------------------------------------- -! calculation of forest projections for edge dislocations - plastic_titanmod_forestProjectionEdge(s1,s2,instance) = & - abs(math_mul3x3(lattice_sn(:,plastic_titanmod_slipSystemLattice(s1,instance),phase), & - lattice_st(:,plastic_titanmod_slipSystemLattice(s2,instance),phase))) - -!-------------------------------------------------------------------------------------------------- -! calculation of forest projections for screw dislocations - plastic_titanmod_forestProjectionScrew(s1,s2,instance) = & - abs(math_mul3x3(lattice_sn(:,plastic_titanmod_slipSystemLattice(s1,instance),phase), & - lattice_sd(:,plastic_titanmod_slipSystemLattice(s2,instance),phase))) - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! calculation of forest projections for edge dislocations in twin system - do t1 = 1_pInt,plastic_titanmod_totalNtwin(instance) - do t2 = 1_pInt,plastic_titanmod_totalNtwin(instance) - plastic_titanmod_TwinforestProjectionEdge(t1,t2,instance) = & - abs(math_mul3x3(lattice_tn(:,plastic_titanmod_twinSystemLattice(t1,instance),phase), & - lattice_tt(:,plastic_titanmod_twinSystemLattice(t2,instance),phase))) - -!-------------------------------------------------------------------------------------------------- -! calculation of forest projections for screw dislocations in twin system - plastic_titanmod_TwinforestProjectionScrew(t1,t2,instance) = & - abs(math_mul3x3(lattice_tn(:,plastic_titanmod_twinSystemLattice(t1,instance),phase), & - lattice_td(:,plastic_titanmod_twinSystemLattice(t2,instance),phase))) - enddo; enddo - call plastic_titanmod_stateInit(phase,instance) - endif - enddo initializeInstances - -end subroutine plastic_titanmod_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_titanmod_stateInit(ph,instance) - use lattice, only: & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_mu - - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - integer(pInt), intent(in) :: ph !< number specifying the phase of the plasticity - - - integer(pInt) :: & - s,s0,s1, & - t,t0,t1, & - ns,nt,f - real(pReal), dimension(plastic_titanmod_totalNslip(instance)) :: & - rho_edge0, & - rho_screw0, & - shear_system0, & - segment_edge0, & - segment_screw0, & - resistance_edge0, & - resistance_screw0 - real(pReal), dimension(plastic_titanmod_totalNtwin(instance)) :: & - twingamma_dot0, & - resistance_twin0 - real(pReal), dimension(plasticState(ph)%sizeState) :: tempState !!!!!!!!!????????? check - - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - - tempState = 0.0_pReal -!-------------------------------------------------------------------------------------------------- -! initialize basic slip state variables for slip - s1 = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily - s0 = s1 + 1_pInt - s1 = s0 + plastic_titanmod_Nslip(f,instance) - 1_pInt - do s = s0,s1 - rho_edge0(s) = plastic_titanmod_rho_edge0(f,instance) - rho_screw0(s) = plastic_titanmod_rho_screw0(f,instance) - shear_system0(s) = 0.0_pReal - enddo - enddo - -!-------------------------------------------------------------------------------------------------- -! initialize basic slip state variables for twin - t1 = 0_pInt - do f = 1_pInt,lattice_maxNtwinFamily - t0 = t1 + 1_pInt - t1 = t0 + plastic_titanmod_Ntwin(f,instance) - 1_pInt - do t = t0,t1 - twingamma_dot0(t)=0.0_pReal - enddo - enddo - -!-------------------------------------------------------------------------------------------------- -! initialize dependent slip microstructural variables - forall (s = 1_pInt:ns) - segment_edge0(s) = plastic_titanmod_CeLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product((rho_edge0),plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product((rho_screw0),plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) - segment_screw0(s) = plastic_titanmod_CsLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product((rho_edge0),plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product((rho_screw0),plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) - resistance_edge0(s) = & - lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)* & - sqrt(dot_product((rho_edge0),plastic_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & - dot_product((rho_screw0),plastic_titanmod_interactionMatrix_es(1:ns,s,instance))) - resistance_screw0(s) = & - lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)* & - sqrt(dot_product((rho_edge0),plastic_titanmod_interactionMatrix_es(1:ns,s,instance))+ & - dot_product((rho_screw0), plastic_titanmod_interactionMatrix_ss(1:ns,s,instance))) - end forall - - forall (t = 1_pInt:nt) & - resistance_twin0(t) = 0.0_pReal - -tempState = 0.0_pReal -tempState (1:ns) = rho_edge0 -tempState (1_pInt*ns+1_pInt:2_pInt*ns) = rho_screw0 -tempState (2_pInt*ns+1_pInt:3_pInt*ns) = shear_system0 -tempState (3_pInt*ns+1_pInt:3_pInt*ns+nt) = twingamma_dot0 -tempState (3_pInt*ns+nt+1_pInt:4_pInt*ns+nt) = segment_edge0 -tempState (4_pInt*ns+nt+1_pInt:5_pInt*ns+nt) = segment_screw0 -tempState (5_pInt*ns+nt+1_pInt:6_pInt*ns+nt) = resistance_edge0 -tempState (6_pInt*ns+nt+1_pInt:7_pInt*ns+nt) = resistance_screw0 -tempState (7_pInt*ns+nt+1_pInt:7_pInt*ns+2_pInt*nt)=resistance_twin0 - -plasticState(ph)%state0 = spread(tempState,2,size(plasticState(ph)%state(1,:))) -end subroutine plastic_titanmod_stateInit - -!-------------------------------------------------------------------------------------------------- -!> @brief returns the homogenized elasticity matrix -!-------------------------------------------------------------------------------------------------- -function plastic_titanmod_homogenizedC(ipc,ip,el) - use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt - use lattice, only: & - lattice_C66 - -implicit none - real(pReal), dimension(6,6) :: & - plastic_titanmod_homogenizedC - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element -real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - volumefraction_PerTwinSys - integer(pInt) :: & - ph, & - of, & - instance, & - ns, nt, & - i - real(pReal) :: & - sumf - -!-------------------------------------------------------------------------------------------------- -! shortened notation -! ph = material_phase(ipc,ip,el) - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - -!-------------------------------------------------------------------------------------------------- -! total twin volume fraction - do i=1_pInt,nt - volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & - plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) - enddo - sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 - -!-------------------------------------------------------------------------------------------------- -! homogenized elasticity matrix - plastic_titanmod_homogenizedC = (1.0_pReal-sumf)*lattice_C66(1:6,1:6,ph) - do i=1_pInt,nt - plastic_titanmod_homogenizedC = plastic_titanmod_homogenizedC & - + volumefraction_PerTwinSys(i)*& - plastic_titanmod_Ctwin66(1:6,1:6,i,instance) - enddo - -end function plastic_titanmod_homogenizedC - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -subroutine plastic_titanmod_microstructure(temperature,ipc,ip,el) - - use material, only: & - material_phase,& - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt - use lattice, only: & - lattice_mu - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in) :: & - temperature !< temperature at IP - integer(pInt) :: & - instance, & - ns, nt, s, t, & - i, & - ph, & - of - real(pReal) :: & - sumf, & - sfe ! stacking fault energy - real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - volumefraction_PerTwinSys - -!-------------------------------------------------------------------------------------------------- - -!Shortened notation - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - -!-------------------------------------------------------------------------------------------------- -! total twin volume fraction - forall (i = 1_pInt:nt) & - volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & - plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) - - sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 - - sfe = 0.0002_pReal*Temperature-0.0396_pReal - -!-------------------------------------------------------------------------------------------------- -! average segment length for edge dislocations in matrix - forall (s = 1_pInt:ns) & - plasticState(ph)%state(3_pInt*ns+nt+s, of) = plastic_titanmod_CeLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product(plasticState(ph)%state(1:ns, of), & - plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product(plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of), & - plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) -!-------------------------------------------------------------------------------------------------- -! average segment length for screw dislocations in matrix - forall (s = 1_pInt:ns) & - plasticState(ph)%state(4_pInt*ns+nt+s, of) = plastic_titanmod_CsLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product(plasticState(ph)%state(1:ns, of), & - plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product(plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of), & - plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) -!-------------------------------------------------------------------------------------------------- -! threshold stress or slip resistance for edge dislocation motion - forall (s = 1_pInt:ns) & - plasticState(ph)%state(5_pInt*ns+nt+s, of) = & - lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)*& - sqrt(dot_product((plasticState(ph)%state(1:ns, of)),& - plastic_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & - dot_product((plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of)),& - plastic_titanmod_interactionMatrix_es(1:ns,s,instance))) -!-------------------------------------------------------------------------------------------------- -! threshold stress or slip resistance for screw dislocation motion - forall (s = 1_pInt:ns) & - plasticState(ph)%state(6_pInt*ns+nt+s, of) = & - lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)*& - sqrt(dot_product((plasticState(ph)%state(1:ns, of)),& - plastic_titanmod_interactionMatrix_es(1:ns,s,instance))+ & - dot_product((plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of)),& - plastic_titanmod_interactionMatrix_ss(1:ns,s,instance))) -!-------------------------------------------------------------------------------------------------- -! threshold stress or slip resistance for dislocation motion in twin - forall (t = 1_pInt:nt) & - plasticState(ph)%state(7_pInt*ns+nt+t, of) = & - lattice_mu(ph)*plastic_titanmod_burgersPerTwinSys(t,instance)*& - (dot_product((abs(plasticState(ph)%state(2_pInt*ns+1_pInt:2_pInt*ns+nt, of))),& - plastic_titanmod_interactionMatrixTwinTwin(1:nt,t,instance))) - -! state=tempState - -end subroutine plastic_titanmod_microstructure - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates plastic velocity gradient and its tangent -!-------------------------------------------------------------------------------------------------- -subroutine plastic_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,temperature,ipc,ip,el) - use math, only: & - math_Plain3333to99, & - math_Mandel6to33 - use lattice, only: & - lattice_Sslip, & - lattice_Sslip_v, & - lattice_Stwin, & - lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_structure, & - LATTICE_hex_ID - use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt - - implicit none - real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(9,9), intent(out) :: & - dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress - - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), intent(in) :: & - temperature !< temperature at IP - integer(pInt) :: & - index_myFamily, instance, & - ns,nt, & - f,i,j,k,l,m,n, & - ph, & - of - real(pReal) :: sumf, & - StressRatio_edge_p, minusStressRatio_edge_p, StressRatio_edge_pminus1, BoltzmannRatioedge, & - StressRatio_screw_p, minusStressRatio_screw_p, StressRatio_screw_pminus1, BoltzmannRatioscrew, & - twinStressRatio_p, twinminusStressRatio_p, twinStressRatio_pminus1, BoltzmannRatiotwin, & - twinDotGamma0, bottomstress_edge, bottomstress_screw, screwvelocity_prefactor - real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 - real(pReal), dimension(plastic_titanmod_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_slip,dgdot_dtauslip,tau_slip, & - edge_velocity, screw_velocity, & - gdot_slip_edge, gdot_slip_screw - real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_twin,dgdot_dtautwin,tau_twin, volumefraction_PerTwinSys - -! tempState=state - - - -!-------------------------------------------------------------------------------------------------- -! shortened notation - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - - do i=1_pInt,nt - volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & - plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) - - enddo - - sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 - - - Lp = 0.0_pReal - dLp_dTstar3333 = 0.0_pReal - dLp_dTstar99 = 0.0_pReal - - !* Dislocation glide part - gdot_slip = 0.0_pReal - gdot_slip_edge = 0.0_pReal - gdot_slip_screw = 0.0_pReal - dgdot_dtauslip = 0.0_pReal - j = 0_pInt - slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - do i = 1_pInt,plastic_titanmod_Nslip(f,instance) ! process each (active) slip system in family - j = j+1_pInt - - !* Calculation of Lp - !* Resolved shear stress on slip system - tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) - if(lattice_structure(ph)==LATTICE_hex_ID) then ! only for prismatic and pyr systems in hex - screwvelocity_prefactor=plastic_titanmod_debyefrequency(instance)* & - plasticState(ph)%state(4_pInt*ns+nt+j, of)*(plastic_titanmod_burgersPerSlipSys(j,instance)/ & - plastic_titanmod_kinkcriticallength_PerSlipSys(j,instance))**2 - - !* Stress ratio for screw ! No slip resistance for screw dislocations, only Peierls stress - bottomstress_screw=plastic_titanmod_tau0s_PerSlipSys(j,instance) - StressRatio_screw_p = ((abs(tau_slip(j)))/ & - ( bottomstress_screw) & - )**plastic_titanmod_ps_PerSlipSys(j,instance) - - if((1.0_pReal-StressRatio_screw_p)>0.001_pReal) then - minusStressRatio_screw_p=1.0_pReal-StressRatio_screw_p - else - minusStressRatio_screw_p=0.001_pReal - endif - - bottomstress_screw=plastic_titanmod_tau0s_PerSlipSys(j,instance) - StressRatio_screw_pminus1 = ((abs(tau_slip(j)))/ & - ( bottomstress_screw) & - )**(plastic_titanmod_ps_PerSlipSys(j,instance)-1.0_pReal) - - !* Boltzmann ratio for screw - BoltzmannRatioscrew = plastic_titanmod_kinkf0(instance)/(kB*Temperature) - - else ! if the structure is not hex or the slip family is basal - screwvelocity_prefactor=plastic_titanmod_v0s_PerSlipSys(j,instance) - bottomstress_screw=plastic_titanmod_tau0s_PerSlipSys(j,instance)+ & - plasticState(ph)%state(6*ns+nt+j, of) - StressRatio_screw_p = ((abs(tau_slip(j)))/( bottomstress_screw ))**plastic_titanmod_ps_PerSlipSys(j,instance) - - if((1.0_pReal-StressRatio_screw_p)>0.001_pReal) then - minusStressRatio_screw_p=1.0_pReal-StressRatio_screw_p - else - minusStressRatio_screw_p=0.001_pReal - endif - - StressRatio_screw_pminus1 = ((abs(tau_slip(j)))/( bottomstress_screw))** & - (plastic_titanmod_ps_PerSlipSys(j,instance)-1.0_pReal) - - !* Boltzmann ratio for screw - BoltzmannRatioscrew = plastic_titanmod_f0_PerSlipSys(j,instance)/(kB*Temperature) - - endif - - !* Stress ratio for edge - bottomstress_edge=plastic_titanmod_tau0e_PerSlipSys(j,instance)+ & - plasticState(ph)%state(5*ns+nt+j, of) - StressRatio_edge_p = ((abs(tau_slip(j)))/ & - ( bottomstress_edge) & - )**plastic_titanmod_pe_PerSlipSys(j,instance) - - if((1.0_pReal-StressRatio_edge_p)>0.001_pReal) then - minusStressRatio_edge_p=1.0_pReal-StressRatio_edge_p - else - minusStressRatio_edge_p=0.001_pReal - endif - - StressRatio_edge_pminus1 = ((abs(tau_slip(j)))/( bottomstress_edge))** & - (plastic_titanmod_pe_PerSlipSys(j,instance)-1.0_pReal) - - !* Boltzmann ratio for edge. For screws it is defined above - BoltzmannRatioedge = plastic_titanmod_f0_PerSlipSys(j,instance)/(kB*Temperature) - - screw_velocity(j) =screwvelocity_prefactor * & ! there is no v0 for screw now because it is included in the prefactor - exp(-BoltzmannRatioscrew*(minusStressRatio_screw_p)** & - plastic_titanmod_qs_PerSlipSys(j,instance)) - - edge_velocity(j) =plastic_titanmod_v0e_PerSlipSys(j,instance)*exp(-BoltzmannRatioedge* & - (minusStressRatio_edge_p)** & - plastic_titanmod_qe_PerSlipSys(j,instance)) - - !* Shear rates due to edge slip - gdot_slip_edge(j) = plastic_titanmod_burgersPerSlipSys(j,instance)*(plasticState(ph)%state(j, of)* & - edge_velocity(j))* sign(1.0_pReal,tau_slip(j)) - !* Shear rates due to screw slip - gdot_slip_screw(j) = plastic_titanmod_burgersPerSlipSys(j,instance)*(plasticState(ph)%state(ns+j, of) * & - screw_velocity(j))* sign(1.0_pReal,tau_slip(j)) - !Total shear rate - - gdot_slip(j) = gdot_slip_edge(j) + gdot_slip_screw(j) - - plasticState(ph)%state( 7*ns+2*nt+j, of)= edge_velocity(j) - plasticState(ph)%state( 8*ns+2*nt+j, of)= screw_velocity(j) - plasticState(ph)%state( 9*ns+2*nt+j, of)= tau_slip(j) - plasticState(ph)%state(10*ns+2*nt+j, of)= gdot_slip_edge(j) - plasticState(ph)%state(11*ns+2*nt+j, of)= gdot_slip_screw(j) - plasticState(ph)%state(12*ns+2*nt+j, of)= StressRatio_edge_p - plasticState(ph)%state(13*ns+2*nt+j, of)= StressRatio_screw_p - - !* Derivatives of shear rates - dgdot_dtauslip(j) = plastic_titanmod_burgersPerSlipSys(j,instance)*(( & - ( & - ( & - ( & - (edge_velocity(j)*plasticState(ph)%state(j, of))) * & - BoltzmannRatioedge*& - plastic_titanmod_pe_PerSlipSys(j,instance)* & - plastic_titanmod_qe_PerSlipSys(j,instance) & - )/ & - bottomstress_edge & - )*& - StressRatio_edge_pminus1*(minusStressRatio_edge_p)** & - (plastic_titanmod_qe_PerSlipSys(j,instance)-1.0_pReal) & - ) + & - ( & - ( & - ( & - (plasticState(ph)%state(ns+j, of) * screw_velocity(j)) * & - BoltzmannRatioscrew* & - plastic_titanmod_ps_PerSlipSys(j,instance)* & - plastic_titanmod_qs_PerSlipSys(j,instance) & - )/ & - bottomstress_screw & - )*& - StressRatio_screw_pminus1*(minusStressRatio_screw_p)**(plastic_titanmod_qs_PerSlipSys(j,instance)-1.0_pReal) & - ) & - ) !* sign(1.0_pReal,tau_slip(j)) - - - -!************************************************* -!sumf=0.0_pReal - !* Plastic velocity gradient for dislocation glide - Lp = Lp + (1.0_pReal - sumf)*gdot_slip(j)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) - - !* Calculation of the tangent of Lp - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar3333(k,l,m,n) = & - dLp_dTstar3333(k,l,m,n) + dgdot_dtauslip(j)*& - lattice_Sslip(k,l,1,index_myFamily+i,ph)*& - lattice_Sslip(m,n,1,index_myFamily+i,ph) - enddo - enddo slipFamiliesLoop - -!* Mechanical twinning part - gdot_twin = 0.0_pReal - dgdot_dtautwin = 0.0_pReal - j = 0_pInt - twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - do i = 1_pInt,plastic_titanmod_Ntwin(f,instance) ! process each (active) slip system in family - j = j+1_pInt - - !* Calculation of Lp - !* Resolved shear stress on twin system - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) - -!************************************************************************************** - !* Stress ratios -! StressRatio_r = (plasticState(ph)%state6*ns+3*nt+j, of)/tau_twin(j))**plastic_titanmod_r(instance) - - !* Shear rates and their derivatives due to twin -! if ( tau_twin(j) > 0.0_pReal ) !then -! gdot_twin(j) = 0.0_pReal!& -! (plastic_titanmod_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,ph)*& -! plasticState(ph)%state(6*ns+4*nt+j, of)*plastic_titanmod_Ndot0PerTwinSys(f,instance)*exp(-StressRatio_r) -! dgdot_dtautwin(j) = ((gdot_twin(j)*plastic_titanmod_r(instance))/tau_twin(j))*StressRatio_r -! endif -!************************************************************************************** - - !* Stress ratio for edge - twinStressRatio_p = ((abs(tau_twin(j)))/ & - ( plastic_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & - )**plastic_titanmod_twinp_PerTwinSys(j,instance) - - if((1.0_pReal-twinStressRatio_p)>0.001_pReal) then - twinminusStressRatio_p=1.0_pReal-twinStressRatio_p - else - twinminusStressRatio_p=0.001_pReal - endif - - twinStressRatio_pminus1 = ((abs(tau_twin(j)))/ & - ( plastic_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & - )**(plastic_titanmod_twinp_PerTwinSys(j,instance)-1.0_pReal) - - !* Boltzmann ratio - BoltzmannRatiotwin = plastic_titanmod_twinf0_PerTwinSys(j,instance)/(kB*Temperature) - - !* Initial twin shear rates - TwinDotGamma0 = & - plastic_titanmod_twingamma0_PerTwinSys(j,instance) - - !* Shear rates due to twin - gdot_twin(j) =sign(1.0_pReal,tau_twin(j))*plastic_titanmod_twingamma0_PerTwinSys(j,instance)* & - exp(-BoltzmannRatiotwin*(twinminusStressRatio_p)**plastic_titanmod_twinq_PerTwinSys(j,instance)) - - - !* Derivatives of shear rates in twin - dgdot_dtautwin(j) = ( & - ( & - ( & - (abs(gdot_twin(j))) * & - BoltzmannRatiotwin*& - plastic_titanmod_twinp_PerTwinSys(j,instance)* & - plastic_titanmod_twinq_PerTwinSys(j,instance) & - )/ & - plastic_titanmod_twintau0_PerTwinSys(j,instance) & - )*& - twinStressRatio_pminus1*(twinminusStressRatio_p)** & - (plastic_titanmod_twinq_PerTwinSys(j,instance)-1.0_pReal) & - ) !* sign(1.0_pReal,tau_slip(j)) - - !* Plastic velocity gradient for mechanical twinning -! Lp = Lp + sumf*gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,ph) - Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,ph) - - !* Calculation of the tangent of Lp - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar3333(k,l,m,n) = & - dLp_dTstar3333(k,l,m,n) + dgdot_dtautwin(j)*& - lattice_Stwin(k,l,index_myFamily+i,ph)*& - lattice_Stwin(m,n,index_myFamily+i,ph) - enddo - enddo twinFamiliesLoop - -dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) -! tempState=state - - -end subroutine plastic_titanmod_LpAndItsTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -subroutine plastic_titanmod_dotState(Tstar_v,temperature,ipc,ip,el) - use lattice, only: & - lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_NslipSystem, & - lattice_NtwinSystem - use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt - -implicit none - real(pReal), dimension(6), intent(in):: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), intent(in) :: & - temperature !< temperature at integration point - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - - integer(pInt) :: & - index_myFamily, instance, & - ns,nt,& - f,i,j, & - ph, & - of - real(pReal) :: & - sumf,BoltzmannRatio, & - twinStressRatio_p,twinminusStressRatio_p - real(pReal), dimension(plastic_titanmod_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - DotRhoEdgeGeneration, & - DotRhoEdgeAnnihilation, & - DotRhoScrewGeneration, & - DotRhoScrewAnnihilation - real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_twin, & - tau_twin, & - volumefraction_PerTwinSys - -!-------------------------------------------------------------------------------------------------- -! shortened notation - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - do i=1_pInt,nt - volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & - plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) - - enddo - - sumf = sum(abs(volumefraction_PerTwinSys(1_pInt:nt))) ! safe for nt == 0 - - plasticState(ph)%dotState(:,of) = 0.0_pReal - j = 0_pInt - slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - do i = 1_pInt,plastic_titanmod_Nslip(f,instance) ! process each (active) slip system in family - j = j+1_pInt - - DotRhoEdgeGeneration(j) = & ! multiplication of edge dislocations - plasticState(ph)%state(ns+j, of)*plasticState(ph)%state(8*ns+2*nt+j, of)/plasticState(ph)%state(4*ns+nt+j, of) - DotRhoScrewGeneration(j) = & ! multiplication of screw dislocations - plasticState(ph)%state(j, of)*plasticState(ph)%state(7*ns+2*nt+j, of)/plasticState(ph)%state(3*ns+nt+j, of) - DotRhoEdgeAnnihilation(j) = -((plasticState(ph)%state(j, of))**2)* & ! annihilation of edge dislocations - plastic_titanmod_capre_PerSlipSys(j,instance)*plasticState(ph)%state(7*ns+2*nt+j, of)*0.5_pReal - DotRhoScrewAnnihilation(j) = -((plasticState(ph)%state(ns+j, of))**2)* & ! annihilation of screw dislocations - plastic_titanmod_caprs_PerSlipSys(j,instance)*plasticState(ph)%state(8*ns+2*nt+j, of)*0.5_pReal - plasticState(ph)%dotState(j, of) = & ! edge dislocation density rate of change - DotRhoEdgeGeneration(j)+DotRhoEdgeAnnihilation(j) - - plasticState(ph)%dotState(ns+j, of) = & ! screw dislocation density rate of change - DotRhoScrewGeneration(j)+DotRhoScrewAnnihilation(j) - - plasticState(ph)%dotState(2*ns+j, of) = & ! sum of shear due to edge and screw - plasticState(ph)%state(10*ns+2*nt+j, of)+plasticState(ph)%state(11*ns+2*nt+j, of) - enddo - enddo slipFamiliesLoop - -!* Twin fraction evolution - j = 0_pInt - twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - do i = 1_pInt,plastic_titanmod_Ntwin(f,instance) ! process each (active) twin system in family - j = j+1_pInt - - !* Resolved shear stress on twin system - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) - - !* Stress ratio for edge - twinStressRatio_p = ((abs(tau_twin(j)))/ & - ( plastic_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & - )**(plastic_titanmod_twinp_PerTwinSys(j,instance)) - - - if((1.0_pReal-twinStressRatio_p)>0.001_pReal) then - twinminusStressRatio_p=1.0_pReal-twinStressRatio_p - else - twinminusStressRatio_p=0.001_pReal - endif - - BoltzmannRatio = plastic_titanmod_twinf0_PerTwinSys(j,instance)/(kB*Temperature) - - gdot_twin(j) =plastic_titanmod_twingamma0_PerTwinSys(j,instance)*exp(-BoltzmannRatio* & - (twinminusStressRatio_p)** & - plastic_titanmod_twinq_PerTwinSys(j,instance))*sign(1.0_pReal,tau_twin(j)) - - plasticState(ph)%dotState(3*ns+j, of)=gdot_twin(j) - - enddo - enddo twinFamiliesLoop - -end subroutine plastic_titanmod_dotState - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of constitutive results -!-------------------------------------------------------------------------------------------------- -function plastic_titanmod_postResults(ipc,ip,el) - use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(plastic_titanmod_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - plastic_titanmod_postResults - - integer(pInt) :: & - instance, & - ns,nt,& - o,i,c, & - ph, & - of - real(pReal) :: sumf - - real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - volumefraction_PerTwinSys - -!-------------------------------------------------------------------------------------------------- -! shortened notation - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - - do i=1_pInt,nt - volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & - plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) - enddo - - sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 - - -!-------------------------------------------------------------------------------------------------- -! required output - c = 0_pInt - plastic_titanmod_postResults = 0.0_pReal - - do o = 1_pInt,plastic_titanmod_Noutput(instance) - select case(plastic_titanmod_outputID(o,instance)) - case (rhoedge_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(1_pInt:ns, of) - c = c + ns - case (rhoscrew_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of) - c = c + ns - case (segment_edge_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(3_pInt*ns+nt+1_pInt:4_pInt*ns+nt, of) - c = c + ns - case (segment_screw_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(4_pInt*ns+nt+1_pInt:5_pInt*ns+nt, of) - c = c + ns - case (resistance_edge_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(5_pInt*ns+nt+1_pInt:6_pInt*ns+nt, of) - c = c + ns - case (resistance_screw_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(6_pInt*ns+nt+1_pInt:7_pInt*ns+nt, of) - c = c + ns - case (velocity_edge_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(7*ns+2*nt+1:8*ns+2*nt, of) - c = c + ns - case (velocity_screw_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(8*ns+2*nt+1:9*ns+2*nt, of) - c = c + ns - case (tau_slip_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(9*ns+2*nt+1:10*ns+2*nt, of)) - c = c + ns - case (gdot_slip_edge_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(10*ns+2*nt+1:11*ns+2*nt, of)) - c = c + ns - case (gdot_slip_screw_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(11*ns+2*nt+1:12*ns+2*nt, of)) - c = c + ns - case (gdot_slip_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(10*ns+2*nt+1:11*ns+2*nt, of)) + & - abs(plasticState(ph)%state(11*ns+2*nt+1:12*ns+2*nt, of)) - c = c + ns - case (stressratio_edge_p_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(12*ns+2*nt+1:13*ns+2*nt, of)) - c = c + ns - case (stressratio_screw_p_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(13*ns+2*nt+1:14*ns+2*nt, of)) - c = c + ns - case (shear_system_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(2*ns+1:3*ns, of)) - c = c + ns - case (shear_basal_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+1:2*ns+3, of))) - c = c + 1_pInt - case (shear_prism_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+4:2*ns+6, of))) - c = c + 1_pInt - case (shear_pyra_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+7:2*ns+12, of))) - c = c + 1_pInt - case (shear_pyrca_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+13:2*ns+24, of))) - c = c + 1_pInt - - case (rhoedge_basal_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(1:3, of)) - c = c + 1_pInt - case (rhoedge_prism_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(4:6, of)) - c = c + 1_pInt - case (rhoedge_pyra_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(7:12,of)) - c = c + 1_pInt - case (rhoedge_pyrca_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(13:24, of)) - c = c + 1_pInt - - case (rhoscrew_basal_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+1:ns+3, of)) - c = c + 1_pInt - case (rhoscrew_prism_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+4:ns+6, of)) - c = c + 1_pInt - case (rhoscrew_pyra_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+7:ns+12, of)) - c = c + 1_pInt - case (rhoscrew_pyrca_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+13:ns+24, of)) - c = c + 1_pInt - case (shear_total_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+1:3*ns, of))) - c = c + 1_pInt - case (twin_fraction_ID) - plastic_titanmod_postResults(c+1_pInt:c+nt) = abs(volumefraction_PerTwinSys(1:nt)) - c = c + nt - end select - enddo - -end function plastic_titanmod_postResults - -end module plastic_titanmod diff --git a/src/porosity_none.f90 b/src/porosity_none.f90 index 1e6ea9dc9..2bca99384 100644 --- a/src/porosity_none.f90 +++ b/src/porosity_none.f90 @@ -16,7 +16,11 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine porosity_none_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pReal, & pInt diff --git a/src/porosity_phasefield.f90 b/src/porosity_phasefield.f90 index b41ae2756..3f1c853a4 100644 --- a/src/porosity_phasefield.f90 +++ b/src/porosity_phasefield.f90 @@ -48,7 +48,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine porosity_phasefield_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_read, & IO_lc, & diff --git a/src/prec.f90 b/src/prec.f90 index c130ba007..0e3b276db 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -111,8 +111,11 @@ contains !> @brief reporting precision !-------------------------------------------------------------------------------------------------- subroutine prec_init - use, intrinsic :: & - iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif implicit none external :: & diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 53cc411af..cad6bf1e4 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -63,7 +63,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoBrittle_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 1a79e3b34..959e62e26 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -67,7 +67,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoDuctile_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 18194618e..bd1026765 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -53,7 +53,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_isoBrittle_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index f30f9a72e..5d7e4f862 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -53,7 +53,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_isoDuctile_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index d649549ad..99c41f062 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -39,7 +39,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_thermal_dissipation_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 60aaebe42..6b015689a 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -45,7 +45,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_thermal_externalheat_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/source_vacancy_irradiation.f90 b/src/source_vacancy_irradiation.f90 index 986c229ff..8f24b39be 100644 --- a/src/source_vacancy_irradiation.f90 +++ b/src/source_vacancy_irradiation.f90 @@ -41,7 +41,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_vacancy_irradiation_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/source_vacancy_phenoplasticity.f90 b/src/source_vacancy_phenoplasticity.f90 index 924490637..26c3ae828 100644 --- a/src/source_vacancy_phenoplasticity.f90 +++ b/src/source_vacancy_phenoplasticity.f90 @@ -39,7 +39,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_vacancy_phenoplasticity_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/source_vacancy_thermalfluc.f90 b/src/source_vacancy_thermalfluc.f90 index b835e8bce..e5d3b0574 100644 --- a/src/source_vacancy_thermalfluc.f90 +++ b/src/source_vacancy_thermalfluc.f90 @@ -41,7 +41,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_vacancy_thermalfluc_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use debug, only: & debug_level,& debug_constitutive,& diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 index 9c259a2fb..727659870 100644 --- a/src/spectral_damage.f90 +++ b/src/spectral_damage.f90 @@ -60,7 +60,11 @@ contains !> @brief allocates all neccessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine spectral_damage_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_intOut, & IO_read_realFile, & diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index 80a109a10..3c8489d04 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -42,7 +42,9 @@ contains !! information on computation to screen !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use, intrinsic :: & + iso_fortran_env + use system_routines, only: & getHostName diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 index 951ab2521..6d0fff286 100644 --- a/src/spectral_mech_AL.f90 +++ b/src/spectral_mech_AL.f90 @@ -84,7 +84,11 @@ contains !> @todo use sourced allocation, e.g. allocate(Fdot,source = F_lastInc) !-------------------------------------------------------------------------------------------------- subroutine AL_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_intOut, & IO_read_realFile, & diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index b6a0977f9..55403ee7c 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -72,7 +72,11 @@ contains !> @brief allocates all neccessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine basicPETSc_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_intOut, & IO_read_realFile, & diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index ed44793bb..ecf707d46 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -84,7 +84,11 @@ contains !> @todo use sourced allocation, e.g. allocate(Fdot,source = F_lastInc) !-------------------------------------------------------------------------------------------------- subroutine Polarisation_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_intOut, & IO_read_realFile, & diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index 490325ab7..322f12031 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -60,7 +60,11 @@ contains !> @brief allocates all neccessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine spectral_thermal_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_intOut, & IO_read_realFile, & diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index e515a95a3..1bbf2e608 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -160,7 +160,11 @@ contains !> Initializes FFTW. !-------------------------------------------------------------------------------------------------- subroutine utilities_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_error, & IO_warning, & diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index a0626af62..7f23a81b5 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -46,7 +46,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_read, & IO_lc, & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 973ae2d03..c55d1d3eb 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -47,7 +47,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine thermal_conduction_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_read, & IO_lc, & diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index 30ca7562a..87e846f12 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -16,7 +16,11 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine thermal_isothermal_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pReal, & pInt diff --git a/src/vacancyflux_cahnhilliard.f90 b/src/vacancyflux_cahnhilliard.f90 index f73f66631..9f6ecd8b0 100644 --- a/src/vacancyflux_cahnhilliard.f90 +++ b/src/vacancyflux_cahnhilliard.f90 @@ -61,7 +61,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine vacancyflux_cahnhilliard_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_read, & IO_lc, & diff --git a/src/vacancyflux_isochempot.f90 b/src/vacancyflux_isochempot.f90 index 642d5a2e0..8c256467f 100644 --- a/src/vacancyflux_isochempot.f90 +++ b/src/vacancyflux_isochempot.f90 @@ -44,7 +44,11 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine vacancyflux_isochempot_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_read, & IO_lc, & diff --git a/src/vacancyflux_isoconc.f90 b/src/vacancyflux_isoconc.f90 index e4c20b246..ad7842e3f 100644 --- a/src/vacancyflux_isoconc.f90 +++ b/src/vacancyflux_isoconc.f90 @@ -16,7 +16,11 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine vacancyflux_isoconc_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef __GFORTRAN__ + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & pReal, & pInt