From 81b971374b8aee176efc45342e8922a9421339b5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 19:29:48 +0100 Subject: [PATCH 01/67] no need to use pInt --- src/element.f90 | 337 ++++++++++++++++++++++++------------------------ src/prec.f90 | 66 +++++----- 2 files changed, 201 insertions(+), 202 deletions(-) diff --git a/src/element.f90 b/src/element.f90 index 473d9c73c..fd56532af 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -4,7 +4,6 @@ !-------------------------------------------------------------------------------------------------- module element use prec, only: & - pInt, & pReal implicit none @@ -14,7 +13,7 @@ module element !> Properties of a single element (the element used in the mesh) !--------------------------------------------------------------------------------------------------- type, public :: tElement - integer(pInt) :: & + integer :: & elemType, & geomType, & ! geometry type (same for same dimension and same number of integration points) cellType, & @@ -24,7 +23,7 @@ module element nIPs, & nIPneighbors, & ! ToDo: MD: Do all IPs in one element type have the same number of neighbors? maxNnodeAtIP - integer(pInt), dimension(:,:), allocatable :: & + integer, dimension(:,:), allocatable :: & Cell, & ! intra-element (cell) nodes that constitute a cell NnodeAtIP, & IPneighbor, & @@ -39,11 +38,11 @@ module element procedure :: init => tElement_init end type - integer(pInt), parameter, private :: & - NELEMTYPE = 13_pInt + integer, parameter, private :: & + NELEMTYPE = 13 - integer(pInt), dimension(NelemType), parameter, private :: NNODE = & - int([ & + integer, dimension(NelemType), parameter, private :: NNODE = & + [ & 3, & ! 2D 3node 1ip 6, & ! 2D 6node 3ip 4, & ! 2D 4node 4ip @@ -58,10 +57,10 @@ module element 8, & ! 3D 8node 8ip 20, & ! 3D 20node 8ip 20 & ! 3D 20node 27ip - ],pInt) !< number of nodes that constitute a specific type of element + ] !< number of nodes that constitute a specific type of element - integer(pInt), dimension(NelemType), parameter, public :: GEOMTYPE = & - int([ & + integer, dimension(NelemType), parameter, public :: GEOMTYPE = & + [ & 1, & ! 2D 3node 1ip 2, & ! 2D 6node 3ip 3, & ! 2D 4node 4ip @@ -76,11 +75,11 @@ module element 9, & ! 3D 8node 8ip 9, & ! 3D 20node 8ip 10 & ! 3D 20node 27ip - ],pInt) !< geometry type of particular element type + ] !< geometry type of particular element type - !integer(pInt), dimension(maxval(geomType)), parameter, private :: NCELLNODE = & ! Intel 16.0 complains - integer(pInt), dimension(10), parameter, private :: NCELLNODE = & - int([ & + !integer, dimension(maxval(geomType)), parameter, private :: NCELLNODE = & ! Intel 16.0 complains + integer, dimension(10), parameter, private :: NCELLNODE = & + [ & 3, & 7, & 9, & @@ -91,11 +90,11 @@ module element 8, & 27, & 64 & - ],pInt) !< number of cell nodes in a specific geometry type + ] !< number of cell nodes in a specific geometry type - !integer(pInt), dimension(maxval(geomType)), parameter, private :: NIP = & ! Intel 16.0 complains - integer(pInt), dimension(10), parameter, private :: NIP = & - int([ & + !integer, dimension(maxval(geomType)), parameter, private :: NIP = & ! Intel 16.0 complains + integer, dimension(10), parameter, private :: NIP = & + [ & 1, & 3, & 4, & @@ -106,11 +105,11 @@ module element 1, & 8, & 27 & - ],pInt) !< number of IPs in a specific geometry type + ] !< number of IPs in a specific geometry type - !integer(pInt), dimension(maxval(geomType)), parameter, private :: CELLTYPE = & ! Intel 16.0 complains - integer(pInt), dimension(10), parameter, private :: CELLTYPE = & !< cell type that is used by each geometry type - int([ & + !integer, dimension(maxval(geomType)), parameter, private :: CELLTYPE = & ! Intel 16.0 complains + integer, dimension(10), parameter, private :: CELLTYPE = & !< cell type that is used by each geometry type + [ & 1, & ! 2D 3node 2, & ! 2D 4node 2, & ! 2D 4node @@ -121,29 +120,29 @@ module element 4, & ! 3D 8node 4, & ! 3D 8node 4 & ! 3D 8node - ],pInt) + ] - !integer(pInt), dimension(maxval(cellType)), parameter, private :: nIPNeighbor = & ! causes problem with Intel 16.0 - integer(pInt), dimension(4), parameter, private :: NIPNEIGHBOR = & !< number of ip neighbors / cell faces in a specific cell type - int([& + !integer, dimension(maxval(cellType)), parameter, private :: nIPNeighbor = & ! causes problem with Intel 16.0 + integer, dimension(4), parameter, private :: NIPNEIGHBOR = & !< number of ip neighbors / cell faces in a specific cell type + [& 3, & ! 2D 3node 4, & ! 2D 4node 4, & ! 3D 4node 6 & ! 3D 8node - ],pInt) + ] - !integer(pInt), dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = & - integer(pInt), dimension(4), parameter, private :: NCELLNODEPERCELLFACE = & !< number of cell nodes in a specific cell type - int([ & + !integer, dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = & + integer, dimension(4), parameter, private :: NCELLNODEPERCELLFACE = & !< number of cell nodes in a specific cell type + [ & 2, & ! 2D 3node 2, & ! 2D 4node 3, & ! 3D 4node 4 & ! 3D 8node - ],pInt) + ] - !integer(pInt), dimension(maxval(geomType)), parameter, private :: maxNodeAtIP = & ! causes problem with Intel 16.0 - integer(pInt), dimension(10), parameter, private :: maxNnodeAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element - int([ & + !integer, dimension(maxval(geomType)), parameter, private :: maxNodeAtIP = & ! causes problem with Intel 16.0 + integer, dimension(10), parameter, private :: maxNnodeAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element + [ & 3, & 1, & 1, & @@ -154,40 +153,40 @@ module element 8, & 1, & 4 & - ],pInt) + ] - !integer(pInt), dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = & ! Intel 16.0 complains - integer(pInt), dimension(4), parameter, private :: NCELLNODEPERCELL = & !< number of cell nodes in a specific cell type - int([ & + !integer, dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = & ! Intel 16.0 complains + integer, dimension(4), parameter, private :: NCELLNODEPERCELL = & !< number of cell nodes in a specific cell type + [ & 3, & ! 2D 3node 4, & ! 2D 4node 4, & ! 3D 4node 8 & ! 3D 8node - ],pInt) + ] - integer(pInt), dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = & - reshape(int([& + integer, dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = & + reshape([& 1,2,3 & - ],pInt),[maxNnodeAtIP(1),nIP(1)]) + ],[maxNnodeAtIP(1),nIP(1)]) - integer(pInt), dimension(maxNnodeAtIP(2),nIP(2)), parameter, private :: NnodeAtIP2 = & - reshape(int([& + integer, dimension(maxNnodeAtIP(2),nIP(2)), parameter, private :: NnodeAtIP2 = & + reshape([& 1, & 2, & 3 & - ],pInt),[maxNnodeAtIP(2),nIP(2)]) + ],[maxNnodeAtIP(2),nIP(2)]) - integer(pInt), dimension(maxNnodeAtIP(3),nIP(3)), parameter, private :: NnodeAtIP3 = & - reshape(int([& + integer, dimension(maxNnodeAtIP(3),nIP(3)), parameter, private :: NnodeAtIP3 = & + reshape([& 1, & 2, & 4, & 3 & - ],pInt),[maxNnodeAtIP(3),nIP(3)]) + ],[maxNnodeAtIP(3),nIP(3)]) - integer(pInt), dimension(maxNnodeAtIP(4),nIP(4)), parameter, private :: NnodeAtIP4 = & - reshape(int([& + integer, dimension(maxNnodeAtIP(4),nIP(4)), parameter, private :: NnodeAtIP4 = & + reshape([& 1,0, & 1,2, & 2,0, & @@ -197,38 +196,38 @@ module element 4,0, & 3,4, & 3,0 & - ],pInt),[maxNnodeAtIP(4),nIP(4)]) + ],[maxNnodeAtIP(4),nIP(4)]) - integer(pInt), dimension(maxNnodeAtIP(5),nIP(5)), parameter, private :: NnodeAtIP5 = & - reshape(int([& + integer, dimension(maxNnodeAtIP(5),nIP(5)), parameter, private :: NnodeAtIP5 = & + reshape([& 1,2,3,4 & - ],pInt),[maxNnodeAtIP(5),nIP(5)]) + ],[maxNnodeAtIP(5),nIP(5)]) - integer(pInt), dimension(maxNnodeAtIP(6),nIP(6)), parameter, private :: NnodeAtIP6 = & - reshape(int([& + integer, dimension(maxNnodeAtIP(6),nIP(6)), parameter, private :: NnodeAtIP6 = & + reshape([& 1, & 2, & 3, & 4 & - ],pInt),[maxNnodeAtIP(6),nIP(6)]) + ],[maxNnodeAtIP(6),nIP(6)]) - integer(pInt), dimension(maxNnodeAtIP(7),nIP(7)), parameter, private :: NnodeAtIP7 = & - reshape(int([& + integer, dimension(maxNnodeAtIP(7),nIP(7)), parameter, private :: NnodeAtIP7 = & + reshape([& 1, & 2, & 3, & 4, & 5, & 6 & - ],pInt),[maxNnodeAtIP(7),nIP(7)]) + ],[maxNnodeAtIP(7),nIP(7)]) - integer(pInt), dimension(maxNnodeAtIP(8),nIP(8)), parameter, private :: NnodeAtIP8 = & - reshape(int([& + integer, dimension(maxNnodeAtIP(8),nIP(8)), parameter, private :: NnodeAtIP8 = & + reshape([& 1,2,3,4,5,6,7,8 & - ],pInt),[maxNnodeAtIP(8),nIP(8)]) + ],[maxNnodeAtIP(8),nIP(8)]) - integer(pInt), dimension(maxNnodeAtIP(9),nIP(9)), parameter, private :: NnodeAtIP9 = & - reshape(int([& + integer, dimension(maxNnodeAtIP(9),nIP(9)), parameter, private :: NnodeAtIP9 = & + reshape([& 1, & 2, & 4, & @@ -237,10 +236,10 @@ module element 6, & 8, & 7 & - ],pInt),[maxNnodeAtIP(9),nIP(9)]) + ],[maxNnodeAtIP(9),nIP(9)]) - integer(pInt), dimension(maxNnodeAtIP(10),nIP(10)), parameter, private :: NnodeAtIP10 = & - reshape(int([& + integer, dimension(maxNnodeAtIP(10),nIP(10)), parameter, private :: NnodeAtIP10 = & + reshape([& 1,0, 0,0, & 1,2, 0,0, & 2,0, 0,0, & @@ -268,7 +267,7 @@ module element 8,0, 0,0, & 7,8, 0,0, & 7,0, 0,0 & - ],pInt),[maxNnodeAtIP(10),nIP(10)]) + ],[maxNnodeAtIP(10),nIP(10)]) ! *** FE_ipNeighbor *** ! is a list of the neighborhood of each IP. @@ -277,28 +276,28 @@ module element ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. - integer(pInt), dimension(nIPneighbor(cellType(1)),nIP(1)), parameter, private :: IPneighbor1 = & - reshape(int([& + integer, dimension(nIPneighbor(cellType(1)),nIP(1)), parameter, private :: IPneighbor1 = & + reshape([& -2,-3,-1 & - ],pInt),[nIPneighbor(cellType(1)),nIP(1)]) + ],[nIPneighbor(cellType(1)),nIP(1)]) - integer(pInt), dimension(nIPneighbor(cellType(2)),nIP(2)), parameter, private :: IPneighbor2 = & - reshape(int([& + integer, dimension(nIPneighbor(cellType(2)),nIP(2)), parameter, private :: IPneighbor2 = & + reshape([& 2,-3, 3,-1, & -2, 1, 3,-1, & 2,-3,-2, 1 & - ],pInt),[nIPneighbor(cellType(2)),nIP(2)]) + ],[nIPneighbor(cellType(2)),nIP(2)]) - integer(pInt), dimension(nIPneighbor(cellType(3)),nIP(3)), parameter, private :: IPneighbor3 = & - reshape(int([& + integer, dimension(nIPneighbor(cellType(3)),nIP(3)), parameter, private :: IPneighbor3 = & + reshape([& 2,-4, 3,-1, & -2, 1, 4,-1, & 4,-4,-3, 1, & -2, 3,-3, 2 & - ],pInt),[nIPneighbor(cellType(3)),nIP(3)]) + ],[nIPneighbor(cellType(3)),nIP(3)]) - integer(pInt), dimension(nIPneighbor(cellType(4)),nIP(4)), parameter, private :: IPneighbor4 = & - reshape(int([& + integer, dimension(nIPneighbor(cellType(4)),nIP(4)), parameter, private :: IPneighbor4 = & + reshape([& 2,-4, 4,-1, & 3, 1, 5,-1, & -2, 2, 6,-1, & @@ -308,38 +307,38 @@ module element 8,-4,-3, 4, & 9, 7,-3, 5, & -2, 8,-3, 6 & - ],pInt),[nIPneighbor(cellType(4)),nIP(4)]) + ],[nIPneighbor(cellType(4)),nIP(4)]) - integer(pInt), dimension(nIPneighbor(cellType(5)),nIP(5)), parameter, private :: IPneighbor5 = & - reshape(int([& + integer, dimension(nIPneighbor(cellType(5)),nIP(5)), parameter, private :: IPneighbor5 = & + reshape([& -1,-2,-3,-4 & - ],pInt),[nIPneighbor(cellType(5)),nIP(5)]) + ],[nIPneighbor(cellType(5)),nIP(5)]) - integer(pInt), dimension(nIPneighbor(cellType(6)),nIP(6)), parameter, private :: IPneighbor6 = & - reshape(int([& + integer, dimension(nIPneighbor(cellType(6)),nIP(6)), parameter, private :: IPneighbor6 = & + reshape([& 2,-4, 3,-2, 4,-1, & -2, 1, 3,-2, 4,-1, & 2,-4,-3, 1, 4,-1, & 2,-4, 3,-2,-3, 1 & - ],pInt),[nIPneighbor(cellType(6)),nIP(6)]) + ],[nIPneighbor(cellType(6)),nIP(6)]) - integer(pInt), dimension(nIPneighbor(cellType(7)),nIP(7)), parameter, private :: IPneighbor7 = & - reshape(int([& + integer, dimension(nIPneighbor(cellType(7)),nIP(7)), parameter, private :: IPneighbor7 = & + reshape([& 2,-4, 3,-2, 4,-1, & -3, 1, 3,-2, 5,-1, & 2,-4,-3, 1, 6,-1, & 5,-4, 6,-2,-5, 1, & -3, 4, 6,-2,-5, 2, & 5,-4,-3, 4,-5, 3 & - ],pInt),[nIPneighbor(cellType(7)),nIP(7)]) + ],[nIPneighbor(cellType(7)),nIP(7)]) - integer(pInt), dimension(nIPneighbor(cellType(8)),nIP(8)), parameter, private :: IPneighbor8 = & - reshape(int([& + integer, dimension(nIPneighbor(cellType(8)),nIP(8)), parameter, private :: IPneighbor8 = & + reshape([& -3,-5,-4,-2,-6,-1 & - ],pInt),[nIPneighbor(cellType(8)),nIP(8)]) + ],[nIPneighbor(cellType(8)),nIP(8)]) - integer(pInt), dimension(nIPneighbor(cellType(9)),nIP(9)), parameter, private :: IPneighbor9 = & - reshape(int([& + integer, dimension(nIPneighbor(cellType(9)),nIP(9)), parameter, private :: IPneighbor9 = & + reshape([& 2,-5, 3,-2, 5,-1, & -3, 1, 4,-2, 6,-1, & 4,-5,-4, 1, 7,-1, & @@ -348,10 +347,10 @@ module element -3, 5, 8,-2,-6, 2, & 8,-5,-4, 5,-6, 3, & -3, 7,-4, 6,-6, 4 & - ],pInt),[nIPneighbor(cellType(9)),nIP(9)]) + ],[nIPneighbor(cellType(9)),nIP(9)]) - integer(pInt), dimension(nIPneighbor(cellType(10)),nIP(10)), parameter, private :: IPneighbor10 = & - reshape(int([& + integer, dimension(nIPneighbor(cellType(10)),nIP(10)), parameter, private :: IPneighbor10 = & + reshape([& 2,-5, 4,-2,10,-1, & 3, 1, 5,-2,11,-1, & -3, 2, 6,-2,12,-1, & @@ -379,7 +378,7 @@ module element 26,-5,-4,22,-6,16, & 27,25,-4,23,-6,17, & -3,26,-4,24,-6,18 & - ],pInt),[nIPneighbor(cellType(10)),nIP(10)]) + ],[nIPneighbor(cellType(10)),nIP(10)]) real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = & @@ -660,28 +659,28 @@ module element ],pReal),[nNode(13),NcellNode(geomType(13))]) ! 3D 20node 27ip - integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)), parameter :: CELL1 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)), parameter :: CELL1 = & + reshape([& 1,2,3 & - ],pInt),[NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)]) + ],[NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)]) - integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)), parameter :: CELL2 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)), parameter :: CELL2 = & + reshape([& 1, 4, 7, 6, & 2, 5, 7, 4, & 3, 6, 7, 5 & - ],pInt),[NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)]) + ],[NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)]) - integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)), parameter :: CELL3 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)), parameter :: CELL3 = & + reshape([& 1, 5, 9, 8, & 5, 2, 6, 9, & 8, 9, 7, 4, & 9, 6, 3, 7 & - ],pInt),[NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)]) + ],[NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)]) - integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)), parameter :: CELL4 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)), parameter :: CELL4 = & + reshape([& 1, 5,13,12, & 5, 6,14,13, & 6, 2, 7,14, & @@ -691,38 +690,38 @@ module element 11,16,10, 4, & 16,15, 9,10, & 15, 8, 3, 9 & - ],pInt),[NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)]) + ],[NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)]) - integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)), parameter :: CELL5 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)), parameter :: CELL5 = & + reshape([& 1, 2, 3, 4 & - ],pInt),[NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)]) + ],[NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)]) - integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)), parameter :: CELL6 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)), parameter :: CELL6 = & + reshape([& 1, 5,11, 7, 8,12,15,14, & 5, 2, 6,11,12, 9,13,15, & 7,11, 6, 3,14,15,13,10, & 8,12,15, 4, 4, 9,13,10 & - ],pInt),[NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)]) + ],[NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)]) - integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)), parameter :: CELL7 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)), parameter :: CELL7 = & + reshape([& 1, 7,16, 9,10,17,21,19, & 7, 2, 8,16,17,11,18,21, & 9,16, 8, 3,19,21,18,12, & 10,17,21,19, 4,13,20,15, & 17,11,18,21,13, 5,14,20, & 19,21,18,12,15,20,14, 6 & - ],pInt),[NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)]) + ],[NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)]) - integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)), parameter :: CELL8 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)), parameter :: CELL8 = & + reshape([& 1, 2, 3, 4, 5, 6, 7, 8 & - ],pInt),[NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)]) + ],[NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)]) - integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)), parameter :: CELL9 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)), parameter :: CELL9 = & + reshape([& 1, 9,21,12,13,22,27,25, & 9, 2,10,21,22,14,23,27, & 12,21,11, 4,25,27,24,16, & @@ -731,10 +730,10 @@ module element 22,14,23,27,17, 6,18,26, & 25,27,24,16,20,26,19, 8, & 27,23,15,24,26,18, 7,19 & - ],pInt),[NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)]) + ],[NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)]) - integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)), parameter :: CELL10 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)), parameter :: CELL10 = & + reshape([& 1, 9,33,16,17,37,57,44, & 9,10,34,33,37,38,58,57, & 10, 2,11,34,38,18,39,58, & @@ -762,41 +761,41 @@ module element 51,64,50,24,31,56,30, 8, & 64,63,49,50,56,55,29,30, & 63,48,23,49,55,28, 7,29 & - ],pInt),[NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)]) + ],[NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)]) - integer(pInt), dimension(NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)), parameter :: CELLFACE1 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)), parameter :: CELLFACE1 = & + reshape([& 2,3, & 3,1, & 1,2 & - ],pInt),[NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)]) ! 2D 3node, VTK_TRIANGLE (5) + ],[NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)]) ! 2D 3node, VTK_TRIANGLE (5) - integer(pInt), dimension(NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)), parameter :: CELLFACE2 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)), parameter :: CELLFACE2 = & + reshape([& 2,3, & 4,1, & 3,4, & 1,2 & - ],pInt),[NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)]) ! 2D 4node, VTK_QUAD (9) + ],[NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)]) ! 2D 4node, VTK_QUAD (9) - integer(pInt), dimension(NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)), parameter :: CELLFACE3 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)), parameter :: CELLFACE3 = & + reshape([& 1,3,2, & 1,2,4, & 2,3,4, & 1,4,3 & - ],pInt),[NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)]) ! 3D 4node, VTK_TETRA (10) + ],[NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)]) ! 3D 4node, VTK_TETRA (10) - integer(pInt), dimension(NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)), parameter :: CELLFACE4 = & - reshape(int([& + integer, dimension(NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)), parameter :: CELLFACE4 = & + reshape([& 2,3,7,6, & 4,1,5,8, & 3,4,8,7, & 1,2,6,5, & 5,6,7,8, & 1,4,3,2 & - ],pInt),[NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)]) ! 3D 8node, VTK_HEXAHEDRON (12) + ],[NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)]) ! 3D 8node, VTK_HEXAHEDRON (12) contains @@ -804,37 +803,37 @@ contains subroutine tElement_init(self,elemType) implicit none class(tElement) :: self - integer(pInt), intent(in) :: elemType + integer, intent(in) :: elemType self%elemType = elemType self%Nnodes = Nnode (self%elemType) self%geomType = geomType (self%elemType) select case (self%elemType) - case(1_pInt) + case(1) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights1 - case(2_pInt) + case(2) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights2 - case(3_pInt) + case(3) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights3 - case(4_pInt) + case(4) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights4 - case(5_pInt) + case(5) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights5 - case(6_pInt) + case(6) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights6 - case(7_pInt) + case(7) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights7 - case(8_pInt) + case(8) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights8 - case(9_pInt) + case(9) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights9 - case(10_pInt) + case(10) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights10 - case(11_pInt) + case(11) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights11 - case(12_pInt) + case(12) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights12 - case(13_pInt) + case(13) self%cellNodeParentNodeWeights = cellNodeParentNodeWeights13 case default print*, 'Mist' @@ -848,43 +847,43 @@ contains select case (self%geomType) - case(1_pInt) + case(1) self%NnodeAtIP = NnodeAtIP1 self%IPneighbor = IPneighbor1 self%cell = CELL1 - case(2_pInt) + case(2) self%NnodeAtIP = NnodeAtIP2 self%IPneighbor = IPneighbor2 self%cell = CELL2 - case(3_pInt) + case(3) self%NnodeAtIP = NnodeAtIP3 self%IPneighbor = IPneighbor3 self%cell = CELL3 - case(4_pInt) + case(4) self%NnodeAtIP = NnodeAtIP4 self%IPneighbor = IPneighbor4 self%cell = CELL4 - case(5_pInt) + case(5) self%NnodeAtIP = NnodeAtIP5 self%IPneighbor = IPneighbor5 self%cell = CELL5 - case(6_pInt) + case(6) self%NnodeAtIP = NnodeAtIP6 self%IPneighbor = IPneighbor6 self%cell = CELL6 - case(7_pInt) + case(7) self%NnodeAtIP = NnodeAtIP7 self%IPneighbor = IPneighbor7 self%cell = CELL7 - case(8_pInt) + case(8) self%NnodeAtIP = NnodeAtIP8 self%IPneighbor = IPneighbor8 self%cell = CELL8 - case(9_pInt) + case(9) self%NnodeAtIP = NnodeAtIP9 self%IPneighbor = IPneighbor9 self%cell = CELL9 - case(10_pInt) + case(10) self%NnodeAtIP = NnodeAtIP10 self%IPneighbor = IPneighbor10 self%cell = CELL10 @@ -892,13 +891,13 @@ contains self%NcellNodesPerCell = NCELLNODEPERCELL(self%cellType) select case(self%cellType) - case(1_pInt) + case(1) self%cellFace = CELLFACE1 - case(2_pInt) + case(2) self%cellFace = CELLFACE2 - case(3_pInt) + case(3) self%cellFace = CELLFACE3 - case(4_pInt) + case(4) self%cellFace = CELLFACE4 end select diff --git a/src/prec.f90 b/src/prec.f90 index f591a25d3..8b981b897 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -9,9 +9,9 @@ module prec use, intrinsic :: IEEE_arithmetic, only:& IEEE_selected_real_kind - + implicit none - private + private ! https://software.intel.com/en-us/blogs/2017/03/27/doctor-fortran-in-it-takes-all-kinds integer, parameter, public :: pReal = IEEE_selected_real_kind(15,307) !< number with 15 significant digits, up to 1e+-307 (typically 64 bit) @@ -31,20 +31,20 @@ module prec end type group_float type, public :: group_int - integer(pInt), dimension(:), pointer :: p + integer, dimension(:), pointer :: p end type group_int ! http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array type, public :: tState - integer(pInt) :: & - sizeState = 0_pInt, & !< size of state - sizeDotState = 0_pInt, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates - offsetDeltaState = 0_pInt, & !< index offset of delta state - sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments - sizePostResults = 0_pInt !< size of output data + integer :: & + sizeState = 0, & !< size of state + sizeDotState = 0, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates + offsetDeltaState = 0, & !< index offset of delta state + sizeDeltaState = 0, & !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments + sizePostResults = 0 !< size of output data real(pReal), pointer, dimension(:), contiguous :: & atolState - real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/doState. However, they will never point to something, but are rather allocated and, hence, contiguous + real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/doState. However, they will never point to something, but are rather allocated and, hence, contiguous state0, & state, & !< state dotState, & !< rate of state change @@ -60,11 +60,11 @@ module prec end type type, extends(tState), public :: tPlasticState - integer(pInt) :: & - nSlip = 0_pInt , & - nTwin = 0_pInt, & - nTrans = 0_pInt - logical :: & + integer :: & + nSlip = 0, & + nTwin = 0, & + nTrans = 0 + logical :: & nonlocal = .false. real(pReal), pointer, dimension(:,:) :: & slipRate, & !< slip rate @@ -74,12 +74,12 @@ module prec type, public :: tSourceState type(tState), dimension(:), allocatable :: p !< tState for each active source mechanism in a phase end type - - type, public :: tHomogMapping - integer(pInt), pointer, dimension(:,:) :: p - end type - real(pReal), private, parameter :: PREAL_EPSILON = epsilon(0.0_pReal) !< minimum positive number such that 1.0 + EPSILON /= 1.0. + type, public :: tHomogMapping + integer, pointer, dimension(:,:) :: p + end type + + real(pReal), private, parameter :: PREAL_EPSILON = epsilon(0.0_pReal) !< minimum positive number such that 1.0 + EPSILON /= 1.0. real(pReal), private, parameter :: PREAL_MIN = tiny(0.0_pReal) !< smallest normalized floating point number public :: & @@ -90,7 +90,7 @@ module prec dNeq, & dNeq0, & cNeq - + contains @@ -100,23 +100,23 @@ contains subroutine prec_init implicit none - integer(pInt), allocatable, dimension(:) :: realloc_lhs_test + integer, allocatable, dimension(:) :: realloc_lhs_test external :: & quit write(6,'(/,a)') ' <<<+- prec init -+>>>' - write(6,'(a,i3)') ' Size of integer in bit: ',bit_size(0_pInt) - write(6,'(a,i19)') ' Maximum value: ',huge(0_pInt) + write(6,'(a,i3)') ' Size of integer in bit: ',bit_size(0) + write(6,'(a,i19)') ' Maximum value: ',huge(0) write(6,'(/,a,i3)') ' Size of float in bit: ',storage_size(0.0_pReal) write(6,'(a,e10.3)') ' Maximum value: ',huge(0.0_pReal) write(6,'(a,e10.3)') ' Minimum value: ',tiny(0.0_pReal) write(6,'(a,i3)') ' Decimal precision: ',precision(0.0_pReal) - realloc_lhs_test = [1_pInt,2_pInt] - if (realloc_lhs_test(2)/=2_pInt) call quit(9000) - + realloc_lhs_test = [1,2] + if (realloc_lhs_test(2)/=2) call quit(9000) + end subroutine prec_init @@ -132,7 +132,7 @@ logical elemental pure function dEq(a,b,tol) real(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol real(pReal) :: eps - + if (present(tol)) then eps = tol else @@ -156,7 +156,7 @@ logical elemental pure function dNeq(a,b,tol) real(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol real(pReal) :: eps - + if (present(tol)) then eps = tol else @@ -180,7 +180,7 @@ logical elemental pure function dEq0(a,tol) real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol real(pReal) :: eps - + if (present(tol)) then eps = tol else @@ -204,7 +204,7 @@ logical elemental pure function dNeq0(a,tol) real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol real(pReal) :: eps - + if (present(tol)) then eps = tol else @@ -229,7 +229,7 @@ logical elemental pure function cEq(a,b,tol) complex(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol real(pReal) :: eps - + if (present(tol)) then eps = tol else @@ -254,7 +254,7 @@ logical elemental pure function cNeq(a,b,tol) complex(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol real(pReal) :: eps - + if (present(tol)) then eps = tol else From 215598ade9c0a0d6b25ab0021bc3c4c590ec32cb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 20:39:33 +0100 Subject: [PATCH 02/67] consistent formatting: always indent by 2 spaces --- src/element.f90 | 1512 ++++++++++++++++++++++++----------------------- 1 file changed, 757 insertions(+), 755 deletions(-) diff --git a/src/element.f90 b/src/element.f90 index fd56532af..bbce2154a 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -3,849 +3,850 @@ !> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH !-------------------------------------------------------------------------------------------------- module element - use prec, only: & - pReal - - implicit none - private + use prec, only: & + pReal + + implicit none + private !--------------------------------------------------------------------------------------------------- !> Properties of a single element (the element used in the mesh) !--------------------------------------------------------------------------------------------------- - type, public :: tElement - integer :: & - elemType, & - geomType, & ! geometry type (same for same dimension and same number of integration points) - cellType, & - Nnodes, & - Ncellnodes, & - NcellnodesPerCell, & - nIPs, & - nIPneighbors, & ! ToDo: MD: Do all IPs in one element type have the same number of neighbors? - maxNnodeAtIP - integer, dimension(:,:), allocatable :: & - Cell, & ! intra-element (cell) nodes that constitute a cell - NnodeAtIP, & - IPneighbor, & - cellFace - real(pReal), dimension(:,:), allocatable :: & - ! center of gravity of the weighted nodes gives the position of the cell node. - ! example: face-centered cell node with face nodes 1,2,5,6 to be used in, - ! e.g., an 8 node element, would be encoded: - ! 1, 1, 0, 0, 1, 1, 0, 0 - cellNodeParentNodeWeights - contains - procedure :: init => tElement_init - end type + type, public :: tElement + integer :: & + elemType, & + geomType, & !< geometry type (same for same dimension and same number of integration points) + cellType, & + Nnodes, & + Ncellnodes, & + NcellnodesPerCell, & + nIPs, & + nIPneighbors, & ! ToDo: MD: Do all IPs in one element type have the same number of neighbors? + maxNnodeAtIP + integer, dimension(:,:), allocatable :: & + Cell, & !< intra-element (cell) nodes that constitute a cell + NnodeAtIP, & + IPneighbor, & + cellFace + real(pReal), dimension(:,:), allocatable :: & + ! center of gravity of the weighted nodes gives the position of the cell node. + ! example: face-centered cell node with face nodes 1,2,5,6 to be used in, + ! e.g., an 8 node element, would be encoded: 1, 1, 0, 0, 1, 1, 0, 0 + cellNodeParentNodeWeights + contains + procedure :: init => tElement_init + end type tElement - integer, parameter, private :: & - NELEMTYPE = 13 - integer, dimension(NelemType), parameter, private :: NNODE = & - [ & - 3, & ! 2D 3node 1ip - 6, & ! 2D 6node 3ip - 4, & ! 2D 4node 4ip - 8, & ! 2D 8node 9ip - 8, & ! 2D 8node 4ip - !-------------------- - 4, & ! 3D 4node 1ip - 5, & ! 3D 5node 4ip - 10, & ! 3D 10node 4ip - 6, & ! 3D 6node 6ip - 8, & ! 3D 8node 1ip - 8, & ! 3D 8node 8ip - 20, & ! 3D 20node 8ip - 20 & ! 3D 20node 27ip - ] !< number of nodes that constitute a specific type of element - - integer, dimension(NelemType), parameter, public :: GEOMTYPE = & - [ & - 1, & ! 2D 3node 1ip - 2, & ! 2D 6node 3ip - 3, & ! 2D 4node 4ip - 4, & ! 2D 8node 9ip - 3, & ! 2D 8node 4ip - !-------------------- - 5, & ! 3D 4node 1ip - 6, & ! 3D 5node 4ip - 6, & ! 3D 10node 4ip - 7, & ! 3D 6node 6ip - 8, & ! 3D 8node 1ip - 9, & ! 3D 8node 8ip - 9, & ! 3D 20node 8ip - 10 & ! 3D 20node 27ip - ] !< geometry type of particular element type - - !integer, dimension(maxval(geomType)), parameter, private :: NCELLNODE = & ! Intel 16.0 complains - integer, dimension(10), parameter, private :: NCELLNODE = & - [ & - 3, & - 7, & - 9, & - 16, & - 4, & - 15, & - 21, & - 8, & - 27, & - 64 & - ] !< number of cell nodes in a specific geometry type - - !integer, dimension(maxval(geomType)), parameter, private :: NIP = & ! Intel 16.0 complains - integer, dimension(10), parameter, private :: NIP = & - [ & - 1, & - 3, & - 4, & - 9, & - 1, & - 4, & - 6, & - 1, & - 8, & - 27 & - ] !< number of IPs in a specific geometry type - - !integer, dimension(maxval(geomType)), parameter, private :: CELLTYPE = & ! Intel 16.0 complains - integer, dimension(10), parameter, private :: CELLTYPE = & !< cell type that is used by each geometry type - [ & - 1, & ! 2D 3node - 2, & ! 2D 4node - 2, & ! 2D 4node - 2, & ! 2D 4node - 3, & ! 3D 4node - 4, & ! 3D 8node - 4, & ! 3D 8node - 4, & ! 3D 8node - 4, & ! 3D 8node - 4 & ! 3D 8node - ] + integer, parameter, private :: & + NELEMTYPE = 13 - !integer, dimension(maxval(cellType)), parameter, private :: nIPNeighbor = & ! causes problem with Intel 16.0 - integer, dimension(4), parameter, private :: NIPNEIGHBOR = & !< number of ip neighbors / cell faces in a specific cell type - [& - 3, & ! 2D 3node - 4, & ! 2D 4node - 4, & ! 3D 4node - 6 & ! 3D 8node - ] + integer, dimension(NelemType), parameter, private :: NNODE = & + [ & + 3, & ! 2D 3node 1ip + 6, & ! 2D 6node 3ip + 4, & ! 2D 4node 4ip + 8, & ! 2D 8node 9ip + 8, & ! 2D 8node 4ip + !-------------------- + 4, & ! 3D 4node 1ip + 5, & ! 3D 5node 4ip + 10, & ! 3D 10node 4ip + 6, & ! 3D 6node 6ip + 8, & ! 3D 8node 1ip + 8, & ! 3D 8node 8ip + 20, & ! 3D 20node 8ip + 20 & ! 3D 20node 27ip + ] !< number of nodes that constitute a specific type of element + + integer, dimension(NelemType), parameter, public :: GEOMTYPE = & + [ & + 1, & + 2, & + 3, & + 4, & + 3, & + 5, & + 6, & + 6, & + 7, & + 8, & + 9, & + 9, & + 10 & + ] !< geometry type of particular element type + + !integer, dimension(maxval(geomType)), parameter, private :: NCELLNODE = & ! Intel 16.0 complains + integer, dimension(10), parameter, private :: NCELLNODE = & + [ & + 3, & + 7, & + 9, & + 16, & + 4, & + 15, & + 21, & + 8, & + 27, & + 64 & + ] !< number of cell nodes in a specific geometry type + + !integer, dimension(maxval(geomType)), parameter, private :: NIP = & ! Intel 16.0 complains + integer, dimension(10), parameter, private :: NIP = & + [ & + 1, & + 3, & + 4, & + 9, & + 1, & + 4, & + 6, & + 1, & + 8, & + 27 & + ] !< number of IPs in a specific geometry type + + !integer, dimension(maxval(geomType)), parameter, private :: CELLTYPE = & ! Intel 16.0 complains + integer, dimension(10), parameter, private :: CELLTYPE = & + [ & + 1, & ! 2D 3node + 2, & ! 2D 4node + 2, & ! 2D 4node + 2, & ! 2D 4node + 3, & ! 3D 4node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4 & ! 3D 8node + ] !< cell type that is used by each geometry type - !integer, dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = & - integer, dimension(4), parameter, private :: NCELLNODEPERCELLFACE = & !< number of cell nodes in a specific cell type - [ & - 2, & ! 2D 3node - 2, & ! 2D 4node - 3, & ! 3D 4node - 4 & ! 3D 8node - ] + !integer, dimension(maxval(cellType)), parameter, private :: nIPNeighbor = & ! Intel 16.0 complains + integer, dimension(4), parameter, private :: NIPNEIGHBOR = & + [ & + 3, & ! 2D 3node + 4, & ! 2D 4node + 4, & ! 3D 4node + 6 & ! 3D 8node + ] !< number of ip neighbors / cell faces in a specific cell type - !integer, dimension(maxval(geomType)), parameter, private :: maxNodeAtIP = & ! causes problem with Intel 16.0 - integer, dimension(10), parameter, private :: maxNnodeAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element - [ & - 3, & + !integer, dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = & + integer, dimension(4), parameter, private :: NCELLNODEPERCELLFACE = & + [ & + 2, & ! 2D 3node + 2, & ! 2D 4node + 3, & ! 3D 4node + 4 & ! 3D 8node + ] !< number of cell nodes in a specific cell type + + !integer, dimension(maxval(geomType)), parameter, private :: maxNodeAtIP = & ! Intel 16.0 complains + integer, dimension(10), parameter, private :: maxNnodeAtIP = & + [ & + 3, & + 1, & + 1, & + 2, & + 4, & + 1, & + 1, & + 8, & + 1, & + 4 & + ] !< maximum number of parent nodes that belong to an IP for a specific type of element + + !integer, dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = & ! Intel 16.0 complains + integer, dimension(4), parameter, private :: NCELLNODEPERCELL = & + [ & + 3, & ! 2D 3node + 4, & ! 2D 4node + 4, & ! 3D 4node + 8 & ! 3D 8node + ] !< number of cell nodes in a specific cell type + + integer, dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = & + reshape([& + 1,2,3 & + ],[maxNnodeAtIP(1),nIP(1)]) + + integer, dimension(maxNnodeAtIP(2),nIP(2)), parameter, private :: NnodeAtIP2 = & + reshape([& 1, & + 2, & + 3 & + ],[maxNnodeAtIP(2),nIP(2)]) + + integer, dimension(maxNnodeAtIP(3),nIP(3)), parameter, private :: NnodeAtIP3 = & + reshape([& 1, & 2, & 4, & - 1, & - 1, & - 8, & - 1, & - 4 & - ] - - - !integer, dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = & ! Intel 16.0 complains - integer, dimension(4), parameter, private :: NCELLNODEPERCELL = & !< number of cell nodes in a specific cell type - [ & - 3, & ! 2D 3node - 4, & ! 2D 4node - 4, & ! 3D 4node - 8 & ! 3D 8node - ] - - integer, dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = & - reshape([& - 1,2,3 & - ],[maxNnodeAtIP(1),nIP(1)]) - - integer, dimension(maxNnodeAtIP(2),nIP(2)), parameter, private :: NnodeAtIP2 = & - reshape([& - 1, & - 2, & - 3 & - ],[maxNnodeAtIP(2),nIP(2)]) - - integer, dimension(maxNnodeAtIP(3),nIP(3)), parameter, private :: NnodeAtIP3 = & - reshape([& - 1, & - 2, & - 4, & - 3 & + 3 & ],[maxNnodeAtIP(3),nIP(3)]) - - integer, dimension(maxNnodeAtIP(4),nIP(4)), parameter, private :: NnodeAtIP4 = & + + integer, dimension(maxNnodeAtIP(4),nIP(4)), parameter, private :: NnodeAtIP4 = & reshape([& - 1,0, & - 1,2, & - 2,0, & - 1,4, & - 0,0, & - 2,3, & - 4,0, & - 3,4, & - 3,0 & - ],[maxNnodeAtIP(4),nIP(4)]) - - integer, dimension(maxNnodeAtIP(5),nIP(5)), parameter, private :: NnodeAtIP5 = & + 1,0, & + 1,2, & + 2,0, & + 1,4, & + 0,0, & + 2,3, & + 4,0, & + 3,4, & + 3,0 & + ],[maxNnodeAtIP(4),nIP(4)]) + + integer, dimension(maxNnodeAtIP(5),nIP(5)), parameter, private :: NnodeAtIP5 = & reshape([& - 1,2,3,4 & + 1,2,3,4 & ],[maxNnodeAtIP(5),nIP(5)]) - - integer, dimension(maxNnodeAtIP(6),nIP(6)), parameter, private :: NnodeAtIP6 = & + + integer, dimension(maxNnodeAtIP(6),nIP(6)), parameter, private :: NnodeAtIP6 = & reshape([& - 1, & - 2, & - 3, & - 4 & + 1, & + 2, & + 3, & + 4 & ],[maxNnodeAtIP(6),nIP(6)]) - - integer, dimension(maxNnodeAtIP(7),nIP(7)), parameter, private :: NnodeAtIP7 = & + + integer, dimension(maxNnodeAtIP(7),nIP(7)), parameter, private :: NnodeAtIP7 = & reshape([& - 1, & - 2, & - 3, & - 4, & - 5, & - 6 & + 1, & + 2, & + 3, & + 4, & + 5, & + 6 & ],[maxNnodeAtIP(7),nIP(7)]) - - integer, dimension(maxNnodeAtIP(8),nIP(8)), parameter, private :: NnodeAtIP8 = & + + integer, dimension(maxNnodeAtIP(8),nIP(8)), parameter, private :: NnodeAtIP8 = & reshape([& - 1,2,3,4,5,6,7,8 & + 1,2,3,4,5,6,7,8 & ],[maxNnodeAtIP(8),nIP(8)]) - - integer, dimension(maxNnodeAtIP(9),nIP(9)), parameter, private :: NnodeAtIP9 = & + + integer, dimension(maxNnodeAtIP(9),nIP(9)), parameter, private :: NnodeAtIP9 = & reshape([& - 1, & - 2, & - 4, & - 3, & - 5, & - 6, & - 8, & - 7 & + 1, & + 2, & + 4, & + 3, & + 5, & + 6, & + 8, & + 7 & ],[maxNnodeAtIP(9),nIP(9)]) - - integer, dimension(maxNnodeAtIP(10),nIP(10)), parameter, private :: NnodeAtIP10 = & + + integer, dimension(maxNnodeAtIP(10),nIP(10)), parameter, private :: NnodeAtIP10 = & reshape([& - 1,0, 0,0, & - 1,2, 0,0, & - 2,0, 0,0, & - 1,4, 0,0, & - 1,3, 2,4, & - 2,3, 0,0, & - 4,0, 0,0, & - 3,4, 0,0, & - 3,0, 0,0, & - 1,5, 0,0, & - 1,6, 2,5, & - 2,6, 0,0, & - 1,8, 4,5, & - 0,0, 0,0, & - 2,7, 3,6, & - 4,8, 0,0, & - 3,8, 4,7, & - 3,7, 0,0, & - 5,0, 0,0, & - 5,6, 0,0, & - 6,0, 0,0, & - 5,8, 0,0, & - 5,7, 6,8, & - 6,7, 0,0, & - 8,0, 0,0, & - 7,8, 0,0, & - 7,0, 0,0 & + 1,0, 0,0, & + 1,2, 0,0, & + 2,0, 0,0, & + 1,4, 0,0, & + 1,3, 2,4, & + 2,3, 0,0, & + 4,0, 0,0, & + 3,4, 0,0, & + 3,0, 0,0, & + 1,5, 0,0, & + 1,6, 2,5, & + 2,6, 0,0, & + 1,8, 4,5, & + 0,0, 0,0, & + 2,7, 3,6, & + 4,8, 0,0, & + 3,8, 4,7, & + 3,7, 0,0, & + 5,0, 0,0, & + 5,6, 0,0, & + 6,0, 0,0, & + 5,8, 0,0, & + 5,7, 6,8, & + 6,7, 0,0, & + 8,0, 0,0, & + 7,8, 0,0, & + 7,0, 0,0 & ],[maxNnodeAtIP(10),nIP(10)]) - ! *** FE_ipNeighbor *** - ! is a list of the neighborhood of each IP. - ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. - ! Positive integers denote an intra-FE IP identifier. - ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. - - integer, dimension(nIPneighbor(cellType(1)),nIP(1)), parameter, private :: IPneighbor1 = & + ! *** FE_ipNeighbor *** + ! is a list of the neighborhood of each IP. + ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. + ! Positive integers denote an intra-FE IP identifier. + ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. + + integer, dimension(nIPneighbor(cellType(1)),nIP(1)), parameter, private :: IPneighbor1 = & reshape([& - -2,-3,-1 & + -2,-3,-1 & ],[nIPneighbor(cellType(1)),nIP(1)]) - - integer, dimension(nIPneighbor(cellType(2)),nIP(2)), parameter, private :: IPneighbor2 = & - reshape([& - 2,-3, 3,-1, & - -2, 1, 3,-1, & - 2,-3,-2, 1 & + + integer, dimension(nIPneighbor(cellType(2)),nIP(2)), parameter, private :: IPneighbor2 = & + reshape([& + 2,-3, 3,-1, & + -2, 1, 3,-1, & + 2,-3,-2, 1 & ],[nIPneighbor(cellType(2)),nIP(2)]) - - integer, dimension(nIPneighbor(cellType(3)),nIP(3)), parameter, private :: IPneighbor3 = & - reshape([& - 2,-4, 3,-1, & - -2, 1, 4,-1, & - 4,-4,-3, 1, & - -2, 3,-3, 2 & + + integer, dimension(nIPneighbor(cellType(3)),nIP(3)), parameter, private :: IPneighbor3 = & + reshape([& + 2,-4, 3,-1, & + -2, 1, 4,-1, & + 4,-4,-3, 1, & + -2, 3,-3, 2 & ],[nIPneighbor(cellType(3)),nIP(3)]) - - integer, dimension(nIPneighbor(cellType(4)),nIP(4)), parameter, private :: IPneighbor4 = & - reshape([& - 2,-4, 4,-1, & - 3, 1, 5,-1, & - -2, 2, 6,-1, & - 5,-4, 7, 1, & - 6, 4, 8, 2, & - -2, 5, 9, 3, & - 8,-4,-3, 4, & - 9, 7,-3, 5, & - -2, 8,-3, 6 & + + integer, dimension(nIPneighbor(cellType(4)),nIP(4)), parameter, private :: IPneighbor4 = & + reshape([& + 2,-4, 4,-1, & + 3, 1, 5,-1, & + -2, 2, 6,-1, & + 5,-4, 7, 1, & + 6, 4, 8, 2, & + -2, 5, 9, 3, & + 8,-4,-3, 4, & + 9, 7,-3, 5, & + -2, 8,-3, 6 & ],[nIPneighbor(cellType(4)),nIP(4)]) - - integer, dimension(nIPneighbor(cellType(5)),nIP(5)), parameter, private :: IPneighbor5 = & - reshape([& - -1,-2,-3,-4 & + + integer, dimension(nIPneighbor(cellType(5)),nIP(5)), parameter, private :: IPneighbor5 = & + reshape([& + -1,-2,-3,-4 & ],[nIPneighbor(cellType(5)),nIP(5)]) - - integer, dimension(nIPneighbor(cellType(6)),nIP(6)), parameter, private :: IPneighbor6 = & - reshape([& - 2,-4, 3,-2, 4,-1, & - -2, 1, 3,-2, 4,-1, & - 2,-4,-3, 1, 4,-1, & - 2,-4, 3,-2,-3, 1 & + + integer, dimension(nIPneighbor(cellType(6)),nIP(6)), parameter, private :: IPneighbor6 = & + reshape([& + 2,-4, 3,-2, 4,-1, & + -2, 1, 3,-2, 4,-1, & + 2,-4,-3, 1, 4,-1, & + 2,-4, 3,-2,-3, 1 & ],[nIPneighbor(cellType(6)),nIP(6)]) - - integer, dimension(nIPneighbor(cellType(7)),nIP(7)), parameter, private :: IPneighbor7 = & - reshape([& - 2,-4, 3,-2, 4,-1, & - -3, 1, 3,-2, 5,-1, & - 2,-4,-3, 1, 6,-1, & - 5,-4, 6,-2,-5, 1, & - -3, 4, 6,-2,-5, 2, & - 5,-4,-3, 4,-5, 3 & + + integer, dimension(nIPneighbor(cellType(7)),nIP(7)), parameter, private :: IPneighbor7 = & + reshape([& + 2,-4, 3,-2, 4,-1, & + -3, 1, 3,-2, 5,-1, & + 2,-4,-3, 1, 6,-1, & + 5,-4, 6,-2,-5, 1, & + -3, 4, 6,-2,-5, 2, & + 5,-4,-3, 4,-5, 3 & ],[nIPneighbor(cellType(7)),nIP(7)]) - - integer, dimension(nIPneighbor(cellType(8)),nIP(8)), parameter, private :: IPneighbor8 = & - reshape([& - -3,-5,-4,-2,-6,-1 & + + integer, dimension(nIPneighbor(cellType(8)),nIP(8)), parameter, private :: IPneighbor8 = & + reshape([& + -3,-5,-4,-2,-6,-1 & ],[nIPneighbor(cellType(8)),nIP(8)]) - - integer, dimension(nIPneighbor(cellType(9)),nIP(9)), parameter, private :: IPneighbor9 = & - reshape([& - 2,-5, 3,-2, 5,-1, & - -3, 1, 4,-2, 6,-1, & - 4,-5,-4, 1, 7,-1, & - -3, 3,-4, 2, 8,-1, & - 6,-5, 7,-2,-6, 1, & - -3, 5, 8,-2,-6, 2, & - 8,-5,-4, 5,-6, 3, & - -3, 7,-4, 6,-6, 4 & + + integer, dimension(nIPneighbor(cellType(9)),nIP(9)), parameter, private :: IPneighbor9 = & + reshape([& + 2,-5, 3,-2, 5,-1, & + -3, 1, 4,-2, 6,-1, & + 4,-5,-4, 1, 7,-1, & + -3, 3,-4, 2, 8,-1, & + 6,-5, 7,-2,-6, 1, & + -3, 5, 8,-2,-6, 2, & + 8,-5,-4, 5,-6, 3, & + -3, 7,-4, 6,-6, 4 & ],[nIPneighbor(cellType(9)),nIP(9)]) + + integer, dimension(nIPneighbor(cellType(10)),nIP(10)), parameter, private :: IPneighbor10 = & + reshape([& + 2,-5, 4,-2,10,-1, & + 3, 1, 5,-2,11,-1, & + -3, 2, 6,-2,12,-1, & + 5,-5, 7, 1,13,-1, & + 6, 4, 8, 2,14,-1, & + -3, 5, 9, 3,15,-1, & + 8,-5,-4, 4,16,-1, & + 9, 7,-4, 5,17,-1, & + -3, 8,-4, 6,18,-1, & + 11,-5,13,-2,19, 1, & + 12,10,14,-2,20, 2, & + -3,11,15,-2,21, 3, & + 14,-5,16,10,22, 4, & + 15,13,17,11,23, 5, & + -3,14,18,12,24, 6, & + 17,-5,-4,13,25, 7, & + 18,16,-4,14,26, 8, & + -3,17,-4,15,27, 9, & + 20,-5,22,-2,-6,10, & + 21,19,23,-2,-6,11, & + -3,20,24,-2,-6,12, & + 23,-5,25,19,-6,13, & + 24,22,26,20,-6,14, & + -3,23,27,21,-6,15, & + 26,-5,-4,22,-6,16, & + 27,25,-4,23,-6,17, & + -3,26,-4,24,-6,18 & + ],[nIPneighbor(cellType(10)),nIP(10)]) - integer, dimension(nIPneighbor(cellType(10)),nIP(10)), parameter, private :: IPneighbor10 = & - reshape([& - 2,-5, 4,-2,10,-1, & - 3, 1, 5,-2,11,-1, & - -3, 2, 6,-2,12,-1, & - 5,-5, 7, 1,13,-1, & - 6, 4, 8, 2,14,-1, & - -3, 5, 9, 3,15,-1, & - 8,-5,-4, 4,16,-1, & - 9, 7,-4, 5,17,-1, & - -3, 8,-4, 6,18,-1, & - 11,-5,13,-2,19, 1, & - 12,10,14,-2,20, 2, & - -3,11,15,-2,21, 3, & - 14,-5,16,10,22, 4, & - 15,13,17,11,23, 5, & - -3,14,18,12,24, 6, & - 17,-5,-4,13,25, 7, & - 18,16,-4,14,26, 8, & - -3,17,-4,15,27, 9, & - 20,-5,22,-2,-6,10, & - 21,19,23,-2,-6,11, & - -3,20,24,-2,-6,12, & - 23,-5,25,19,-6,13, & - 24,22,26,20,-6,14, & - -3,23,27,21,-6,15, & - 26,-5,-4,22,-6,16, & - 27,25,-4,23,-6,17, & - -3,26,-4,24,-6,18 & - ],[nIPneighbor(cellType(10)),nIP(10)]) - - - real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = & + + real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = & reshape(real([& - 1, 0, 0, & - 0, 1, 0, & - 0, 0, 1 & + 1, 0, 0, & + 0, 1, 0, & + 0, 0, 1 & ],pReal),[nNode(1),NcellNode(geomType(1))]) ! 2D 3node 1ip - - real(pReal), dimension(nNode(2),NcellNode(geomType(2))), parameter :: cellNodeParentNodeWeights2 = & - reshape(real([& - 1, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 2, 2, 2 & + + real(pReal), dimension(nNode(2),NcellNode(geomType(2))), parameter :: cellNodeParentNodeWeights2 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 2, 2, 2 & ],pReal),[nNode(2),NcellNode(geomType(2))]) ! 2D 6node 3ip - - real(pReal), dimension(nNode(3),NcellNode(geomType(3))), parameter :: cellNodeParentNodeWeights3 = & + + real(pReal), dimension(nNode(3),NcellNode(geomType(3))), parameter :: cellNodeParentNodeWeights3 = & reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1, & - 1, 1, 0, 0, & - 0, 1, 1, 0, & - 0, 0, 1, 1, & - 1, 0, 0, 1, & - 1, 1, 1, 1 & - ],pReal),[nNode(3),NcellNode(geomType(3))]) ! 2D 6node 3ip - - real(pReal), dimension(nNode(4),NcellNode(geomType(4))), parameter :: cellNodeParentNodeWeights4 = & + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1, & + 1, 1, 0, 0, & + 0, 1, 1, 0, & + 0, 0, 1, 1, & + 1, 0, 0, 1, & + 1, 1, 1, 1 & + ],pReal),[nNode(3),NcellNode(geomType(3))]) ! 2D 6node 3ip + + real(pReal), dimension(nNode(4),NcellNode(geomType(4))), parameter :: cellNodeParentNodeWeights4 = & reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 1, 0, 0, 0, 2, 0, 0, 0, & - 0, 1, 0, 0, 2, 0, 0, 0, & - 0, 1, 0, 0, 0, 2, 0, 0, & - 0, 0, 1, 0, 0, 2, 0, 0, & - 0, 0, 1, 0, 0, 0, 2, 0, & - 0, 0, 0, 1, 0, 0, 2, 0, & - 0, 0, 0, 1, 0, 0, 0, 2, & - 1, 0, 0, 0, 0, 0, 0, 2, & - 4, 1, 1, 1, 8, 2, 2, 8, & - 1, 4, 1, 1, 8, 8, 2, 2, & - 1, 1, 4, 1, 2, 8, 8, 2, & - 1, 1, 1, 4, 2, 2, 8, 8 & + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 1, 0, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 0, 2, & + 1, 0, 0, 0, 0, 0, 0, 2, & + 4, 1, 1, 1, 8, 2, 2, 8, & + 1, 4, 1, 1, 8, 8, 2, 2, & + 1, 1, 4, 1, 2, 8, 8, 2, & + 1, 1, 1, 4, 2, 2, 8, 8 & ],pReal),[nNode(4),NcellNode(geomType(4))]) ! 2D 8node 9ip - - real(pReal), dimension(nNode(5),NcellNode(geomType(5))), parameter :: cellNodeParentNodeWeights5 = & + + real(pReal), dimension(nNode(5),NcellNode(geomType(5))), parameter :: cellNodeParentNodeWeights5 = & reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 1, 2, 2, 2, 2 & + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 1, 2, 2, 2, 2 & ],pReal),[nNode(5),NcellNode(geomType(5))]) ! 2D 8node 4ip - - real(pReal), dimension(nNode(6),NcellNode(geomType(6))), parameter :: cellNodeParentNodeWeights6 = & + + real(pReal), dimension(nNode(6),NcellNode(geomType(6))), parameter :: cellNodeParentNodeWeights6 = & reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1 & + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1 & ],pReal),[nNode(6),NcellNode(geomType(6))]) ! 3D 4node 1ip - - real(pReal), dimension(nNode(7),NcellNode(geomType(7))), parameter :: cellNodeParentNodeWeights7 = & + + real(pReal), dimension(nNode(7),NcellNode(geomType(7))), parameter :: cellNodeParentNodeWeights7 = & reshape(real([& - 1, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, & - 0, 0, 1, 0, 0, & - 0, 0, 0, 1, 0, & - 1, 1, 0, 0, 0, & - 0, 1, 1, 0, 0, & - 1, 0, 1, 0, 0, & - 1, 0, 0, 1, 0, & - 0, 1, 0, 1, 0, & - 0, 0, 1, 1, 0, & - 1, 1, 1, 0, 0, & - 1, 1, 0, 1, 0, & - 0, 1, 1, 1, 0, & - 1, 0, 1, 1, 0, & - 0, 0, 0, 0, 1 & + 1, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, & + 0, 0, 1, 0, 0, & + 0, 0, 0, 1, 0, & + 1, 1, 0, 0, 0, & + 0, 1, 1, 0, 0, & + 1, 0, 1, 0, 0, & + 1, 0, 0, 1, 0, & + 0, 1, 0, 1, 0, & + 0, 0, 1, 1, 0, & + 1, 1, 1, 0, 0, & + 1, 1, 0, 1, 0, & + 0, 1, 1, 1, 0, & + 1, 0, 1, 1, 0, & + 0, 0, 0, 0, 1 & ],pReal),[nNode(7),NcellNode(geomType(7))]) ! 3D 5node 4ip - - real(pReal), dimension(nNode(8),NcellNode(geomType(8))), parameter :: cellNodeParentNodeWeights8 = & + + real(pReal), dimension(nNode(8),NcellNode(geomType(8))), parameter :: cellNodeParentNodeWeights8 = & reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & - 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & - 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & - 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & - 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & + 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & + 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & + 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & + 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & ],pReal),[nNode(8),NcellNode(geomType(8))]) ! 3D 10node 4ip - - real(pReal), dimension(nNode(9),NcellNode(geomType(9))), parameter :: cellNodeParentNodeWeights9 = & + + real(pReal), dimension(nNode(9),NcellNode(geomType(9))), parameter :: cellNodeParentNodeWeights9 = & reshape(real([& - 1, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 1, & - 1, 1, 0, 0, 0, 0, & - 0, 1, 1, 0, 0, 0, & - 1, 0, 1, 0, 0, 0, & - 1, 0, 0, 1, 0, 0, & - 0, 1, 0, 0, 1, 0, & - 0, 0, 1, 0, 0, 1, & - 0, 0, 0, 1, 1, 0, & - 0, 0, 0, 0, 1, 1, & - 0, 0, 0, 1, 0, 1, & - 1, 1, 1, 0, 0, 0, & - 1, 1, 0, 1, 1, 0, & - 0, 1, 1, 0, 1, 1, & - 1, 0, 1, 1, 0, 1, & - 0, 0, 0, 1, 1, 1, & - 1, 1, 1, 1, 1, 1 & + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 0, 0, 0, 0, & + 0, 1, 1, 0, 0, 0, & + 1, 0, 1, 0, 0, 0, & + 1, 0, 0, 1, 0, 0, & + 0, 1, 0, 0, 1, 0, & + 0, 0, 1, 0, 0, 1, & + 0, 0, 0, 1, 1, 0, & + 0, 0, 0, 0, 1, 1, & + 0, 0, 0, 1, 0, 1, & + 1, 1, 1, 0, 0, 0, & + 1, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 1, & + 1, 0, 1, 1, 0, 1, & + 0, 0, 0, 1, 1, 1, & + 1, 1, 1, 1, 1, 1 & ],pReal),[nNode(9),NcellNode(geomType(9))]) ! 3D 6node 6ip - - real(pReal), dimension(nNode(10),NcellNode(geomType(10))), parameter :: cellNodeParentNodeWeights10 = & + + real(pReal), dimension(nNode(10),NcellNode(geomType(10))), parameter :: cellNodeParentNodeWeights10 = & reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 1 & + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1 & ],pReal),[nNode(10),NcellNode(geomType(10))]) ! 3D 8node 1ip - - real(pReal), dimension(nNode(11),NcellNode(geomType(11))), parameter :: cellNodeParentNodeWeights11 = & + + real(pReal), dimension(nNode(11),NcellNode(geomType(11))), parameter :: cellNodeParentNodeWeights11 = & reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, & ! - 1, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 1, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 1, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 1, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 1, & ! - 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, & ! - 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, & ! - 1, 1, 1, 1, 1, 1, 1, 1 & ! + 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, & ! + 1, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 1, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 1, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 1, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 1, & ! + 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, & ! + 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, & ! + 1, 1, 1, 1, 1, 1, 1, 1 & ! ],pReal),[nNode(11),NcellNode(geomType(11))]) ! 3D 8node 8ip - - real(pReal), dimension(nNode(12),NcellNode(geomType(12))), parameter :: cellNodeParentNodeWeights12 = & + + real(pReal), dimension(nNode(12),NcellNode(geomType(12))), parameter :: cellNodeParentNodeWeights12 = & reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! - 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! - 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! + 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! + 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! ],pReal),[nNode(12),NcellNode(geomType(12))]) ! 3D 20node 8ip - - real(pReal), dimension(nNode(13),NcellNode(geomType(13))), parameter :: cellNodeParentNodeWeights13 = & + + real(pReal), dimension(nNode(13),NcellNode(geomType(13))), parameter :: cellNodeParentNodeWeights13 = & reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 - 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! - 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 - 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! - 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! - 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! - 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 - 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! - 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 - 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! - 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! - 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 - 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! - 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! - 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! - 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! - 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 - 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! - 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! - 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! - 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 + 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! + 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 + 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! + 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! + 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! + 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 + 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! + 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 + 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! + 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! + 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 + 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! + 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! + 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! + 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! + 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 + 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! + 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! + 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! + 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! ],pReal),[nNode(13),NcellNode(geomType(13))]) ! 3D 20node 27ip - - - integer, dimension(NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)), parameter :: CELL1 = & + + + integer, dimension(NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)), parameter :: CELL1 = & reshape([& - 1,2,3 & + 1,2,3 & ],[NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)]) - - integer, dimension(NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)), parameter :: CELL2 = & + + integer, dimension(NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)), parameter :: CELL2 = & reshape([& - 1, 4, 7, 6, & - 2, 5, 7, 4, & - 3, 6, 7, 5 & + 1, 4, 7, 6, & + 2, 5, 7, 4, & + 3, 6, 7, 5 & ],[NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)]) - - integer, dimension(NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)), parameter :: CELL3 = & + + integer, dimension(NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)), parameter :: CELL3 = & reshape([& - 1, 5, 9, 8, & - 5, 2, 6, 9, & - 8, 9, 7, 4, & - 9, 6, 3, 7 & + 1, 5, 9, 8, & + 5, 2, 6, 9, & + 8, 9, 7, 4, & + 9, 6, 3, 7 & ],[NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)]) - - integer, dimension(NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)), parameter :: CELL4 = & + + integer, dimension(NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)), parameter :: CELL4 = & reshape([& - 1, 5,13,12, & - 5, 6,14,13, & - 6, 2, 7,14, & - 12,13,16,11, & - 13,14,15,16, & - 14, 7, 8,15, & - 11,16,10, 4, & - 16,15, 9,10, & - 15, 8, 3, 9 & + 1, 5,13,12, & + 5, 6,14,13, & + 6, 2, 7,14, & + 12,13,16,11, & + 13,14,15,16, & + 14, 7, 8,15, & + 11,16,10, 4, & + 16,15, 9,10, & + 15, 8, 3, 9 & ],[NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)]) - - integer, dimension(NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)), parameter :: CELL5 = & + + integer, dimension(NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)), parameter :: CELL5 = & reshape([& - 1, 2, 3, 4 & + 1, 2, 3, 4 & ],[NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)]) - - integer, dimension(NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)), parameter :: CELL6 = & + + integer, dimension(NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)), parameter :: CELL6 = & reshape([& - 1, 5,11, 7, 8,12,15,14, & - 5, 2, 6,11,12, 9,13,15, & - 7,11, 6, 3,14,15,13,10, & - 8,12,15, 4, 4, 9,13,10 & + 1, 5,11, 7, 8,12,15,14, & + 5, 2, 6,11,12, 9,13,15, & + 7,11, 6, 3,14,15,13,10, & + 8,12,15, 4, 4, 9,13,10 & ],[NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)]) - - integer, dimension(NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)), parameter :: CELL7 = & + + integer, dimension(NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)), parameter :: CELL7 = & reshape([& - 1, 7,16, 9,10,17,21,19, & - 7, 2, 8,16,17,11,18,21, & - 9,16, 8, 3,19,21,18,12, & - 10,17,21,19, 4,13,20,15, & - 17,11,18,21,13, 5,14,20, & - 19,21,18,12,15,20,14, 6 & + 1, 7,16, 9,10,17,21,19, & + 7, 2, 8,16,17,11,18,21, & + 9,16, 8, 3,19,21,18,12, & + 10,17,21,19, 4,13,20,15, & + 17,11,18,21,13, 5,14,20, & + 19,21,18,12,15,20,14, 6 & ],[NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)]) - - integer, dimension(NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)), parameter :: CELL8 = & + + integer, dimension(NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)), parameter :: CELL8 = & reshape([& - 1, 2, 3, 4, 5, 6, 7, 8 & + 1, 2, 3, 4, 5, 6, 7, 8 & ],[NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)]) - - integer, dimension(NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)), parameter :: CELL9 = & + + integer, dimension(NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)), parameter :: CELL9 = & reshape([& - 1, 9,21,12,13,22,27,25, & - 9, 2,10,21,22,14,23,27, & - 12,21,11, 4,25,27,24,16, & - 21,10, 3,11,27,23,15,24, & - 13,22,27,25, 5,17,26,20, & - 22,14,23,27,17, 6,18,26, & - 25,27,24,16,20,26,19, 8, & - 27,23,15,24,26,18, 7,19 & + 1, 9,21,12,13,22,27,25, & + 9, 2,10,21,22,14,23,27, & + 12,21,11, 4,25,27,24,16, & + 21,10, 3,11,27,23,15,24, & + 13,22,27,25, 5,17,26,20, & + 22,14,23,27,17, 6,18,26, & + 25,27,24,16,20,26,19, 8, & + 27,23,15,24,26,18, 7,19 & ],[NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)]) - - integer, dimension(NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)), parameter :: CELL10 = & + + integer, dimension(NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)), parameter :: CELL10 = & reshape([& - 1, 9,33,16,17,37,57,44, & - 9,10,34,33,37,38,58,57, & - 10, 2,11,34,38,18,39,58, & - 16,33,36,15,44,57,60,43, & - 33,34,35,36,57,58,59,60, & - 34,11,12,35,58,39,40,59, & - 15,36,14, 4,43,60,42,20, & - 36,35,13,14,60,59,41,42, & - 35,12, 3,13,59,40,19,41, & - 17,37,57,44,21,45,61,52, & - 37,38,58,57,45,46,62,61, & - 38,18,39,58,46,22,47,62, & - 44,57,60,43,52,61,64,51, & - 57,58,59,60,61,62,63,64, & - 58,39,40,59,62,47,48,63, & - 43,60,42,20,51,64,50,24, & - 60,59,41,42,64,63,49,50, & - 59,40,19,41,63,48,23,49, & - 21,45,61,52, 5,25,53,32, & - 45,46,62,61,25,26,54,53, & - 46,22,47,62,26, 6,27,54, & - 52,61,64,51,32,53,56,31, & - 61,62,63,64,53,54,55,56, & - 62,47,48,63,54,27,28,55, & - 51,64,50,24,31,56,30, 8, & - 64,63,49,50,56,55,29,30, & - 63,48,23,49,55,28, 7,29 & + 1, 9,33,16,17,37,57,44, & + 9,10,34,33,37,38,58,57, & + 10, 2,11,34,38,18,39,58, & + 16,33,36,15,44,57,60,43, & + 33,34,35,36,57,58,59,60, & + 34,11,12,35,58,39,40,59, & + 15,36,14, 4,43,60,42,20, & + 36,35,13,14,60,59,41,42, & + 35,12, 3,13,59,40,19,41, & + 17,37,57,44,21,45,61,52, & + 37,38,58,57,45,46,62,61, & + 38,18,39,58,46,22,47,62, & + 44,57,60,43,52,61,64,51, & + 57,58,59,60,61,62,63,64, & + 58,39,40,59,62,47,48,63, & + 43,60,42,20,51,64,50,24, & + 60,59,41,42,64,63,49,50, & + 59,40,19,41,63,48,23,49, & + 21,45,61,52, 5,25,53,32, & + 45,46,62,61,25,26,54,53, & + 46,22,47,62,26, 6,27,54, & + 52,61,64,51,32,53,56,31, & + 61,62,63,64,53,54,55,56, & + 62,47,48,63,54,27,28,55, & + 51,64,50,24,31,56,30, 8, & + 64,63,49,50,56,55,29,30, & + 63,48,23,49,55,28, 7,29 & ],[NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)]) - - + + integer, dimension(NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)), parameter :: CELLFACE1 = & reshape([& - 2,3, & - 3,1, & - 1,2 & - ],[NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)]) ! 2D 3node, VTK_TRIANGLE (5) - - integer, dimension(NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)), parameter :: CELLFACE2 = & + 2,3, & + 3,1, & + 1,2 & + ],[NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)]) !< 2D 3node, VTK_TRIANGLE (5) + + integer, dimension(NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)), parameter :: CELLFACE2 = & reshape([& - 2,3, & - 4,1, & - 3,4, & - 1,2 & - ],[NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)]) ! 2D 4node, VTK_QUAD (9) - - integer, dimension(NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)), parameter :: CELLFACE3 = & + 2,3, & + 4,1, & + 3,4, & + 1,2 & + ],[NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)]) !< 2D 4node, VTK_QUAD (9) + + integer, dimension(NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)), parameter :: CELLFACE3 = & reshape([& - 1,3,2, & - 1,2,4, & - 2,3,4, & - 1,4,3 & - ],[NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)]) ! 3D 4node, VTK_TETRA (10) - - integer, dimension(NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)), parameter :: CELLFACE4 = & + 1,3,2, & + 1,2,4, & + 2,3,4, & + 1,4,3 & + ],[NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)]) !< 3D 4node, VTK_TETRA (10) + + integer, dimension(NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)), parameter :: CELLFACE4 = & reshape([& - 2,3,7,6, & - 4,1,5,8, & - 3,4,8,7, & - 1,2,6,5, & - 5,6,7,8, & - 1,4,3,2 & - ],[NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)]) ! 3D 8node, VTK_HEXAHEDRON (12) - - -contains - + 2,3,7,6, & + 4,1,5,8, & + 3,4,8,7, & + 1,2,6,5, & + 5,6,7,8, & + 1,4,3,2 & + ],[NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)]) !< 3D 8node, VTK_HEXAHEDRON (12) + + + contains + subroutine tElement_init(self,elemType) + use IO, only: & + IO_error + implicit none class(tElement) :: self integer, intent(in) :: elemType self%elemType = elemType - + self%Nnodes = Nnode (self%elemType) self%geomType = geomType (self%elemType) select case (self%elemType) case(1) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights1 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights1 case(2) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights2 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights2 case(3) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights3 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights3 case(4) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights4 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights4 case(5) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights5 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights5 case(6) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights6 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights6 case(7) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights7 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights7 case(8) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights8 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights8 case(9) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights9 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights9 case(10) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights10 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights10 case(11) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights11 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights11 case(12) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights12 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights12 case(13) - self%cellNodeParentNodeWeights = cellNodeParentNodeWeights13 + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights13 case default - print*, 'Mist' - end select - - + call IO_error(0,ext_msg='invalid element type') + end select + + self%NcellNodes = NcellNode (self%geomType) self%maxNnodeAtIP = maxNnodeAtIP (self%geomType) self%nIPs = nIP (self%geomType) self%cellType = cellType (self%geomType) - - + + select case (self%geomType) case(1) self%NnodeAtIP = NnodeAtIP1 @@ -887,34 +888,35 @@ contains self%NnodeAtIP = NnodeAtIP10 self%IPneighbor = IPneighbor10 self%cell = CELL10 - end select - self%NcellNodesPerCell = NCELLNODEPERCELL(self%cellType) - - select case(self%cellType) - case(1) - self%cellFace = CELLFACE1 - case(2) - self%cellFace = CELLFACE2 - case(3) - self%cellFace = CELLFACE3 - case(4) - self%cellFace = CELLFACE4 end select - - self%nIPneighbors = size(self%IPneighbor,1) - - write(6,'(/,a)') ' <<<+- element_init -+>>>' - - write(6,*)' element type ',self%elemType - write(6,*)' geom type ',self%geomType - write(6,*)' cell type ',self%cellType - write(6,*)' # node ',self%Nnodes - write(6,*)' # IP ',self%nIPs - write(6,*)' # cellnode ',self%Ncellnodes - write(6,*)' # cellnode/cell ',self%NcellnodesPerCell - write(6,*)' # IP neighbor ',self%nIPneighbors - write(6,*)' max # node at IP ',self%maxNnodeAtIP - + + self%NcellNodesPerCell = NCELLNODEPERCELL(self%cellType) + + select case(self%cellType) + case(1) + self%cellFace = CELLFACE1 + case(2) + self%cellFace = CELLFACE2 + case(3) + self%cellFace = CELLFACE3 + case(4) + self%cellFace = CELLFACE4 + end select + + self%nIPneighbors = size(self%IPneighbor,1) + + write(6,'(/,a)') ' <<<+- element_init -+>>>' + + write(6,*)' element type: ',self%elemType + write(6,*)' geom type: ',self%geomType + write(6,*)' cell type: ',self%cellType + write(6,*)' # node: ',self%Nnodes + write(6,*)' # IP: ',self%nIPs + write(6,*)' # cellnode: ',self%Ncellnodes + write(6,*)' # cellnode/cell: ',self%NcellnodesPerCell + write(6,*)' # IP neighbor: ',self%nIPneighbors + write(6,*)' max # node at IP: ',self%maxNnodeAtIP + end subroutine tElement_init end module element From 79a01ef823e67c462f362f7c4d67224ed45b9e2a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 20:46:34 +0100 Subject: [PATCH 03/67] no need to set integer precision --- CMakeLists.txt | 8 -------- 1 file changed, 8 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 6096c8824..8d4bfd81a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -182,8 +182,6 @@ add_definitions (-DDAMASKVERSION="${DAMASK_V}") # definition of other macros add_definitions (-DPETSc) -add_definitions (-DFLOAT=8) -add_definitions (-DINT=4) set (DAMASK_INCLUDE_FLAGS "${DAMASK_INCLUDE_FLAGS} ${PETSC_INCLUDES}") @@ -303,8 +301,6 @@ if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") # precision settings set (PRECISION_FLAGS "${PRECISION_FLAGS} -real-size 64") # set precision for standard real to 32 | 64 | 128 (= 4 | 8 | 16 bytes, type pReal is always 8 bytes) - set (PRECISION_FLAGS "${PRECISION_FLAGS} -integer-size 32") - # set precision for standard int to 16 | 32 | 64 (= 2 | 4 | 8 bytes, type pInt is always 4 bytes) ################################################################################################### @@ -439,13 +435,9 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") # precision settings set (PRECISION_FLAGS "${PRECISION_FLAGS} -fdefault-real-8") # set precision to 8 bytes for standard real (=8 for pReal). Will set size of double to 16 bytes as long as -fdefault-double-8 is not set - set (PRECISION_FLAGS "${PRECISION_FLAGS} -fdefault-double-8") # set precision to 8 bytes for double real, would be 16 bytes if -fdefault-real-8 is used - # Additional options - # -fdefault-integer-8: Use it to set precision to 8 bytes for integer, don't use it for the standard case of pInt=4 (there is no -fdefault-integer-4) - ################################################################################################### # PGI Compiler From 12587be5956923470631329236489ef6405a8383 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 20:48:09 +0100 Subject: [PATCH 04/67] was not used anymore status bar can be used as a replacement, it does to flood log files as extensively as the background thread --- python/damask/util.py | 71 ------------------------------------------- 1 file changed, 71 deletions(-) diff --git a/python/damask/util.py b/python/damask/util.py index ac32ae108..c3cd3fdd4 100644 --- a/python/damask/util.py +++ b/python/damask/util.py @@ -169,77 +169,6 @@ def progressBar(iteration, total, prefix='', bar_length=50): if iteration == total: sys.stderr.write('\n') sys.stderr.flush() -# ----------------------------- -class backgroundMessage(threading.Thread): - """Reporting with animation to indicate progress""" - - choices = {'bounce': ['_', 'o', 'O', '°', '‾', '‾', '°', 'O', 'o', '_'], - 'spin': ['◜', '◝', '◞', '◟'], - 'circle': ['◴', '◵', '◶', '◷'], - 'hexagon': ['⬢', '⬣'], - 'square': ['▖', '▘', '▝', '▗'], - 'triangle': ['ᐊ', 'ᐊ', 'ᐃ', 'ᐅ', 'ᐅ', 'ᐃ'], - 'amoeba': ['▖', '▏', '▘', '▔', '▝', '▕', '▗', '▁'], - 'beat': ['▁', '▂', '▃', '▅', '▆', '▇', '▇', '▆', '▅', '▃', '▂'], - 'prison': ['ᚋ', 'ᚌ', 'ᚍ', 'ᚏ', 'ᚎ', 'ᚍ', 'ᚌ', 'ᚋ'], - 'breath': ['ᚐ', 'ᚑ', 'ᚒ', 'ᚓ', 'ᚔ', 'ᚓ', 'ᚒ', 'ᚑ', 'ᚐ'], - 'pulse': ['·', '•', '●', '●', '•'], - 'ant': ['⠁', '⠂', '⠐', '⠠', '⠄', '⡀', '⢀', '⠠', '⠄', '⠂', '⠐', '⠈'], - 'juggle': ['꜈', '꜉', '꜊', '꜋', '꜌', '꜑', '꜐', '꜏', '꜍'], -# 'wobbler': ['▁', '◣', '▏', '◤', '▔', '◥', '▕', '◢'], - 'grout': ['▁', '▏', '▔', '▕'], - 'partner': ['⚬', '⚭', '⚮', '⚯', '⚮', '⚭'], - 'classic': ['-', '\\', '|', '/',], - } - - def __init__(self,symbol = None,wait = 0.1): - """Sets animation symbol""" - super(backgroundMessage, self).__init__() - self._stop = threading.Event() - self.message = '' - self.new_message = '' - self.counter = 0 - self.gap = ' ' - self.symbols = self.choices[symbol if symbol in self.choices else random.choice(list(self.choices.keys()))] - self.waittime = wait - - def __quit__(self): - """Cleans output""" - length = len(self.symbols[self.counter] + self.gap + self.message) - sys.stderr.write(chr(8)*length + ' '*length + chr(8)*length) - sys.stderr.write('') - sys.stderr.flush() - - def stop(self): - self._stop.set() - - def stopped(self): - return self._stop.is_set() - - def run(self): - while not threading.enumerate()[0]._Thread__stopped: - time.sleep(self.waittime) - self.update_message() - self.__quit__() - - def set_message(self, new_message): - self.new_message = new_message - self.print_message() - - def print_message(self): - length = len(self.symbols[self.counter] + self.gap + self.message) - sys.stderr.write(chr(8)*length + ' '*length + chr(8)*length + \ - self.symbols[self.counter] + self.gap + self.new_message) # delete former and print new message - sys.stderr.flush() - self.message = self.new_message - - def update_message(self): - self.counter = (self.counter + 1)%len(self.symbols) - self.print_message() - - def animation(self,which = None): - return ''.join(self.choices[which]) if which in self.choices else '' - def leastsqBound(func, x0, args=(), bounds=None, Dfun=None, full_output=0, col_deriv=0, ftol=1.49012e-8, xtol=1.49012e-8, From a80b57c96b6e970c9739928c3e05e7e18d69b48c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 20:51:14 +0100 Subject: [PATCH 05/67] forgotten during removal of vacancy/porosity/hydrogen --- src/numerics.f90 | 4 ++-- src/source_thermal_dissipation.f90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/numerics.f90 b/src/numerics.f90 index fbc5f52dc..1d0102cd9 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -377,8 +377,8 @@ subroutine numerics_init case ('bbarstabilisation') BBarStabilisation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt #else - case ('integrationorder','structorder','thermalorder', 'damageorder','vacancyfluxorder', & - 'porosityorder','hydrogenfluxorder','bbarstabilisation') + case ('integrationorder','structorder','thermalorder', 'damageorder', & + 'bbarstabilisation') call IO_warning(40_pInt,ext_msg=tag) #endif case default ! found unknown keyword diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index db37c8286..7c46e64ae 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -106,7 +106,7 @@ end subroutine source_thermal_dissipation_init !-------------------------------------------------------------------------------------------------- -!> @brief returns local vacancy generation rate +!> @brief returns dissipation rate !-------------------------------------------------------------------------------------------------- subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDOT_dT, Tstar, Lp, phase) From 7ad9ef7d84c9572d207da00ea269883f9c675b82 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 20:54:00 +0100 Subject: [PATCH 06/67] not needed anymore --- installation/mods_Abaqus/abaqus_v6.env | 5 ++--- installation/mods_Abaqus/abaqus_v6_debug.env | 5 ++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/installation/mods_Abaqus/abaqus_v6.env b/installation/mods_Abaqus/abaqus_v6.env index 0b4a7fd43..6704b0444 100644 --- a/installation/mods_Abaqus/abaqus_v6.env +++ b/installation/mods_Abaqus/abaqus_v6.env @@ -36,15 +36,14 @@ else: # -implicitnone assume no implicit types (e.g. i for integer) # -standard-semantics sets standard (Fortran 2008) and some other conventions # -assume nostd_mod_proc_name avoid problems with libraries compiled without that option -# -real-size 64 -DFLOAT=8 assume size of real to be 8 bytes, matches our definition of pReal -# -integer-size 32 -DINT=4 assume size of integer to be 4 bytes, matches our definition of pInt +# -real-size 64 assume size of real to be 8 bytes, matches our definition of pReal compile_fortran = (fortCmd + " -c -fPIC -auto -shared-intel " + "-I%I -free -O3 -fpp -fopenmp " + "-ftz -diag-disable 5268 " + "-implicitnone -standard-semantics " + "-assume nostd_mod_proc_name " + - "-real-size 64 -integer-size 32 -DFLOAT=8 -DINT=4 " + + "-real-size 64 " + '-DDAMASKVERSION=\\\"%s\\\"'%DAMASKVERSION) # Abaqus/CAE will generate an input file without parts and assemblies. diff --git a/installation/mods_Abaqus/abaqus_v6_debug.env b/installation/mods_Abaqus/abaqus_v6_debug.env index c967c1e65..1bf6b1a6e 100644 --- a/installation/mods_Abaqus/abaqus_v6_debug.env +++ b/installation/mods_Abaqus/abaqus_v6_debug.env @@ -36,8 +36,7 @@ else: # -implicitnone assume no implicit types (e.g. i for integer) # -standard-semantics sets standard (Fortran 2008) and some other conventions # -assume nostd_mod_proc_name avoid problems with libraries compiled without that option -# -real-size 64 -DFLOAT=8 assume size of real to be 8 bytes, matches our definition of pReal -# -integer-size 32 -DINT=4 assume size of integer to be 4 bytes, matches our definition of pInt +# -real-size 64 assume size of real to be 8 bytes, matches our definition of pReal # 'check pointers' does not work @@ -46,7 +45,7 @@ compile_fortran = (fortCmd + " -c -fPIC -auto -shared-intel " + "-ftz -diag-disable 5268 " + "-implicitnone -standard-semantics " + "-assume nostd_mod_proc_name " + - "-real-size 64 -integer-size 32 -DFLOAT=8 -DINT=4 " + + "-real-size 64 " + "-check bounds,format,output_conversion,uninit " + "-ftrapuv -fpe-all0 " + "-g -traceback -gen-interfaces -fp-stack-check -fp-model strict " + From 3b8b83fbd9c44027a8b31ddb1fd208658db87c83 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 22:18:29 +0100 Subject: [PATCH 07/67] FLOAT is not defined anymore --- src/rotations.f90 | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/rotations.f90 b/src/rotations.f90 index cf6f66af8..3f6778e1a 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -552,14 +552,8 @@ function om2ax(om) result(ax) LWORK = 20 ! call the eigenvalue solver -#if (FLOAT==8) call dgeev('N','V',3,o,3,Wr,Wi,devNull,3,VR,3,WORK,LWORK,INFO) -#elif (FLOAT==4) - call sgeev('N','V',3,o,3,Wr,Wi,devNull,3,VR,3,WORK,LWORK,INFO) -#else - NO SUITABLE PRECISION FOR REAL SELECTED, STOPPING COMPILATION -#endif - if (INFO /= 0) call IO_error(0_pInt,ext_msg='Error in om2ax/(s/d)geev: (S/D)GEEV return not zero') + if (INFO /= 0) call IO_error(0_pInt,ext_msg='Error in om2ax DGEEV return not zero') i = maxloc(merge(1.0_pReal,0.0_pReal,cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal)),dim=1) ! poor substitute for findloc ax(1:3) = VR(1:3,i) where ( dNeq0([om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])) & From b03208bc69aa246a705761284f6acc27f7f5a41c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 22:19:08 +0100 Subject: [PATCH 08/67] unused function --- src/IO.f90 | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 3d330a2df..a77393893 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -23,7 +23,6 @@ module IO IO_init, & IO_read, & IO_recursiveRead, & - IO_checkAndRewind, & IO_open_file_stat, & IO_open_jobFile_stat, & IO_open_file, & @@ -232,24 +231,6 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent) end function IO_recursiveRead -!-------------------------------------------------------------------------------------------------- -!> @brief checks if unit is opened for reading, if true rewinds. Otherwise stops with -!! error message -!-------------------------------------------------------------------------------------------------- -subroutine IO_checkAndRewind(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - logical :: fileOpened - character(len=15) :: fileRead - - inquire(unit=fileUnit, opened=fileOpened, read=fileRead) - if (.not. fileOpened .or. trim(fileRead)/='YES') call IO_error(102_pInt) - rewind(fileUnit) - -end subroutine IO_checkAndRewind - - !-------------------------------------------------------------------------------------------------- !> @brief opens existing file for reading to given unit. Path to file is relative to working !! directory From 9e05b2fcf03644424b692de6c7fb26c77327b930 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 22:20:00 +0100 Subject: [PATCH 09/67] using new name --- src/DAMASK_spectral.f90 | 6 +++--- src/spectral_utilities.f90 | 8 ++++---- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index fca67c97d..c53d339df 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -246,7 +246,7 @@ program DAMASK_spectral enddo newLoadCase%deformation%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) ! logical mask in 3x3 notation newLoadCase%deformation%maskFloat = merge(ones,zeros,newLoadCase%deformation%maskLogical)! float (1.0/0.0) mask in 3x3 notation - newLoadCase%deformation%values = math_plain9to33(temp_valueVector) ! values in 3x3 notation + newLoadCase%deformation%values = math_9to33(temp_valueVector) ! values in 3x3 notation case('p','pk1','piolakirchhoff','stress', 's') temp_valueVector = 0.0_pReal do j = 1_pInt, 9_pInt @@ -255,7 +255,7 @@ program DAMASK_spectral enddo newLoadCase%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) newLoadCase%stress%maskFloat = merge(ones,zeros,newLoadCase%stress%maskLogical) - newLoadCase%stress%values = math_plain9to33(temp_valueVector) + newLoadCase%stress%values = math_9to33(temp_valueVector) case('t','time','delta') ! increment time newLoadCase%time = IO_floatValue(line,chunkPos,i+1_pInt) case('n','incs','increments','steps') ! number of increments @@ -291,7 +291,7 @@ program DAMASK_spectral do j = 1_pInt, 9_pInt temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) enddo - newLoadCase%rotation = math_plain9to33(temp_valueVector) + newLoadCase%rotation = math_9to33(temp_valueVector) end select enddo readIn diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 532ec40b5..09bfd647a 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -720,8 +720,8 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) use IO, only: & IO_error use math, only: & - math_Plain3333to99, & - math_plain99to3333, & + math_3333to99, & + math_99to3333, & math_rotate_forward3333, & math_rotate_forward33, & math_invert @@ -748,7 +748,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) allocate (c_reduced(size_reduced,size_reduced), source =0.0_pReal) allocate (s_reduced(size_reduced,size_reduced), source =0.0_pReal) allocate (sTimesC(size_reduced,size_reduced), source =0.0_pReal) - temp99_Real = math_Plain3333to99(math_rotate_forward3333(C,rot_BC)) + temp99_Real = math_3333to99(math_rotate_forward3333(C,rot_BC)) if(debugGeneral) then write(6,'(/,a)') ' ... updating masked compliance ............................................' @@ -808,7 +808,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) ' Masked Compliance (load) * GPa =', transpose(temp99_Real)*1.0e9_pReal flush(6) endif - utilities_maskedCompliance = math_Plain99to3333(temp99_Real) + utilities_maskedCompliance = math_99to3333(temp99_Real) end function utilities_maskedCompliance From f0eeb3d9b41080d56613edb47d1b4583fa19472a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 22:22:49 +0100 Subject: [PATCH 10/67] using naming convention of numpy --- src/math.f90 | 128 ++++++++++++++++----------------------------------- 1 file changed, 39 insertions(+), 89 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 21e92eaf4..288675703 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -68,49 +68,28 @@ module math ],[2,9]) !< arrangement in Plain notation !-------------------------------------------------------------------------------------------------- -! Provide deprecated names for compatibility - - interface math_cross - module procedure math_crossproduct - end interface math_cross - -! ToDo MD: Our naming scheme was a little bit odd: We use essentially the re-ordering according to Nye -! (convenient because Abaqus and Marc want to have 12 on position 4) -! but weight the shear components according to Mandel (convenient for matrix multiplications) - - interface math_Plain33to9 - module procedure math_33to9 - end interface math_Plain33to9 - - interface math_Plain9to33 - module procedure math_9to33 - end interface math_Plain9to33 - - interface math_Mandel33to6 - module procedure math_sym33to6 - end interface math_Mandel33to6 - - interface math_Mandel6to33 - module procedure math_6toSym33 - end interface math_Mandel6to33 - - interface math_Plain3333to99 - module procedure math_3333to99 - end interface math_Plain3333to99 - - interface math_Plain99to3333 - module procedure math_99to3333 - end interface math_Plain99to3333 - +! Provide deprecated name for compatibility + interface math_crossproduct + module procedure math_cross + end interface math_crossproduct + interface math_tensorproduct + module procedure math_outer + end interface math_tensorproduct + interface math_tensorproduct33 + module procedure math_outer + end interface math_tensorproduct33 + interface math_mul3x3 + module procedure math_inner + end interface math_mul3x3 public :: & - math_Plain33to9, & - math_Plain9to33, & - math_Mandel33to6, & - math_Mandel6to33, & - math_Plain3333to99, & - math_Plain99to3333 + math_mul3x3, & + math_mul6x6, & + math_tensorproduct33, & + math_tensorproduct, & + math_crossproduct !--------------------------------------------------------------------------------------------------- + public :: & #if defined(__PGI) norm2, & @@ -124,10 +103,8 @@ module math math_civita, & math_delta, & math_cross, & - math_crossproduct, & - math_tensorproduct33, & - math_mul3x3, & - math_mul6x6, & + math_outer, & + math_inner, & math_mul33xx33, & math_mul3333xx33, & math_mul3333xx3333, & @@ -537,73 +514,46 @@ end function math_delta !-------------------------------------------------------------------------------------------------- !> @brief cross product a x b !-------------------------------------------------------------------------------------------------- -pure function math_crossproduct(A,B) +pure function math_cross(A,B) implicit none real(pReal), dimension(3), intent(in) :: A,B - real(pReal), dimension(3) :: math_crossproduct + real(pReal), dimension(3) :: math_cross - math_crossproduct = [ A(2)*B(3) -A(3)*B(2), & - A(3)*B(1) -A(1)*B(3), & - A(1)*B(2) -A(2)*B(1) ] + math_cross = [ A(2)*B(3) -A(3)*B(2), & + A(3)*B(1) -A(1)*B(3), & + A(1)*B(2) -A(2)*B(1) ] -end function math_crossproduct +end function math_cross !-------------------------------------------------------------------------------------------------- -!> @brief tensor product A \otimes B of arbitrary sized vectors A and B +!> @brief outer product A \otimes B of arbitrary sized vectors A and B !-------------------------------------------------------------------------------------------------- -pure function math_tensorproduct(A,B) +pure function math_outer(A,B) implicit none real(pReal), dimension(:), intent(in) :: A,B - real(pReal), dimension(size(A,1),size(B,1)) :: math_tensorproduct + real(pReal), dimension(size(A,1),size(B,1)) :: math_outer integer(pInt) :: i,j - forall(i=1_pInt:size(A,1),j=1_pInt:size(B,1)) math_tensorproduct(i,j) = A(i)*B(j) + forall(i=1_pInt:size(A,1),j=1_pInt:size(B,1)) math_outer(i,j) = A(i)*B(j) -end function math_tensorproduct +end function math_outer !-------------------------------------------------------------------------------------------------- -!> @brief tensor product A \otimes B of leght-3 vectors A and B +!> @brief outer product A \otimes B of arbitrary sized vectors A and B !-------------------------------------------------------------------------------------------------- -pure function math_tensorproduct33(A,B) +real(pReal) pure function math_inner(A,B) implicit none - real(pReal), dimension(3,3) :: math_tensorproduct33 - real(pReal), dimension(3), intent(in) :: A,B - integer(pInt) :: i,j + real(pReal), dimension(:), intent(in) :: A + real(pReal), dimension(size(A,1)), intent(in) :: B - forall(i=1_pInt:3_pInt,j=1_pInt:3_pInt) math_tensorproduct33(i,j) = A(i)*B(j) + math_inner = sum(A*B) -end function math_tensorproduct33 - - -!-------------------------------------------------------------------------------------------------- -!> @brief matrix multiplication 3x3 = 1 -!-------------------------------------------------------------------------------------------------- -real(pReal) pure function math_mul3x3(A,B) - - implicit none - real(pReal), dimension(3), intent(in) :: A,B - - math_mul3x3 = sum(A*B) - -end function math_mul3x3 - - -!-------------------------------------------------------------------------------------------------- -!> @brief matrix multiplication 6x6 = 1 -!-------------------------------------------------------------------------------------------------- -real(pReal) pure function math_mul6x6(A,B) - - implicit none - real(pReal), dimension(6), intent(in) :: A,B - - math_mul6x6 = sum(A*B) - -end function math_mul6x6 +end function math_inner !-------------------------------------------------------------------------------------------------- @@ -2108,7 +2058,7 @@ function math_eigenvectorBasisSym(m) do i=1_pInt, size(m,1) math_eigenvectorBasisSym = math_eigenvectorBasisSym & - + sqrt(values(i)) * math_tensorproduct(vectors(:,i),vectors(:,i)) + + sqrt(values(i)) * math_outer(vectors(:,i),vectors(:,i)) enddo end function math_eigenvectorBasisSym From 8224797e75fadd9a692da3bd1fafe525ab208b40 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 22:31:54 +0100 Subject: [PATCH 11/67] simplified --- src/CMakeLists.txt | 2 +- src/HDF5_utilities.f90 | 56 +++++++++++++++++++++--------------------- src/math.f90 | 1 - 3 files changed, 29 insertions(+), 30 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index cdd9b1d02..b9da4c6bf 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -19,7 +19,7 @@ add_library(PREC OBJECT "prec.f90") list(APPEND OBJECTFILES $) add_library(ELEMENT OBJECT "element.f90") -add_dependencies(ELEMENT PREC) +add_dependencies(ELEMENT PREC IO) list(APPEND OBJECTFILES $) add_library(QUIT OBJECT "quit.f90") diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 9878f1c76..9894e0f06 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -461,7 +461,7 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -502,7 +502,7 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -543,7 +543,7 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -584,7 +584,7 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -625,7 +625,7 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -666,7 +666,7 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -707,7 +707,7 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -749,7 +749,7 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -790,7 +790,7 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -831,7 +831,7 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -872,7 +872,7 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -913,7 +913,7 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -954,7 +954,7 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -995,7 +995,7 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1039,7 +1039,7 @@ subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1079,7 +1079,7 @@ subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1119,7 +1119,7 @@ subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1159,7 +1159,7 @@ subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1200,7 +1200,7 @@ subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1240,7 +1240,7 @@ subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1280,7 +1280,7 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1321,7 +1321,7 @@ subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1361,7 +1361,7 @@ subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1401,7 +1401,7 @@ subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1441,7 +1441,7 @@ subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1481,7 +1481,7 @@ subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1521,7 +1521,7 @@ subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1561,7 +1561,7 @@ subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & + integer(HSIZE_T), dimension(rank(dataset)) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) diff --git a/src/math.f90 b/src/math.f90 index 288675703..01304c112 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -83,7 +83,6 @@ module math end interface math_mul3x3 public :: & math_mul3x3, & - math_mul6x6, & math_tensorproduct33, & math_tensorproduct, & math_crossproduct From 85a535b99c018e6b115639dec207685a1548d06b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 22:35:14 +0100 Subject: [PATCH 12/67] is not used anymore --- python/damask/util.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/damask/util.py b/python/damask/util.py index c3cd3fdd4..02cb4a2c6 100644 --- a/python/damask/util.py +++ b/python/damask/util.py @@ -1,5 +1,5 @@ # -*- coding: UTF-8 no BOM -*- -import sys,time,random,threading,os,subprocess,shlex +import sys,time,os,subprocess,shlex import numpy as np from optparse import Option From 4a636dbd99040c8c7f7496b65da73bf33b7b9515 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 22:41:07 +0100 Subject: [PATCH 13/67] not used at all --- src/math.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 01304c112..ff127fd68 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -108,8 +108,6 @@ module math math_mul3333xx33, & math_mul3333xx3333, & math_mul33x33, & - math_mul66x66, & - math_mul99x99, & math_mul33x3, & math_mul33x3_complex, & math_mul66x6 , & From a4cdbab7cf7ca0873b237c4fb15299857000a70e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 22:44:33 +0100 Subject: [PATCH 14/67] not needed --- src/math.f90 | 19 +++++-------------- 1 file changed, 5 insertions(+), 14 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index ff127fd68..43e78c477 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -188,25 +188,16 @@ contains !> @brief initialization of random seed generator !-------------------------------------------------------------------------------------------------- subroutine math_init - -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use numerics, only: randomSeed - use IO, only: IO_timeStamp + use numerics, only: & + randomSeed implicit none integer(pInt) :: i real(pReal), dimension(4) :: randTest -! the following variables are system dependend and shound NOT be pInt - integer :: randSize ! gfortran requires a variable length to compile - integer, dimension(:), allocatable :: randInit ! if recalculations of former randomness (with given seed) is necessary - ! comment the first random_seed call out, set randSize to 1, and use ifort + integer :: randSize + integer, dimension(:), allocatable :: randInit + write(6,'(/,a)') ' <<<+- math init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" call random_seed(size=randSize) if (allocated(randInit)) deallocate(randInit) From de6fd605ee9f50cb32e93f6c2952a93ee55e041f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 22:47:45 +0100 Subject: [PATCH 15/67] is not used anywhere else --- src/config.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/config.f90 b/src/config.f90 index b184f2a6b..b963d9086 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -17,7 +17,7 @@ module config integer(pInt), dimension(:), allocatable :: pos end type tPartitionedString - type, public :: tPartitionedStringList + type, private :: tPartitionedStringList type(tPartitionedString) :: string type(tPartitionedStringList), pointer :: next => null() contains From 3b1328163c0e5338b12effd8e4c0059550c6331b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Mar 2019 23:19:39 +0100 Subject: [PATCH 16/67] cleaned --- src/homogenization_RGC.f90 | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 8ac76606a..64558beaa 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -42,7 +42,7 @@ module homogenization_RGC of_debug = 0_pInt integer(kind(undefined_ID)), dimension(:), allocatable :: & outputID - end type + end type tParameters type, private :: tRGCstate real(pReal), pointer, dimension(:) :: & @@ -92,11 +92,6 @@ contains !> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine homogenization_RGC_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use debug, only: & #ifdef DEBUG debug_i, & @@ -109,8 +104,7 @@ subroutine homogenization_RGC_init() math_EulerToR, & INRAD use IO, only: & - IO_error, & - IO_timeStamp + IO_error use material, only: & #ifdef DEBUG material_homogenizationAt, & @@ -147,8 +141,6 @@ subroutine homogenization_RGC_init() write(6,'(a)') ' https://doi.org/10.1007/s12289-009-0619-1' write(6,'(/,a)') ' Tjahjanto et al., Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010' write(6,'(a)') ' https://doi.org/10.1088/0965-0393/18/1/015006' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" Ninstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & From de330517eb2106ac66cb23b8ce6aefa746205bd8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 07:42:13 +0100 Subject: [PATCH 17/67] rank not supported by older compiler/older dialects --- CMakeLists.txt | 2 +- src/CMakeLists.txt | 2 +- src/HDF5_utilities.f90 | 136 ++++++++++++++++++++--------------------- 3 files changed, 70 insertions(+), 70 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 8d4bfd81a..495e55f85 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -205,7 +205,7 @@ if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") # -assume std_mod_proc_name (included in -standard-semantics) causes problems if other modules # (PETSc, HDF5) are not compiled with this option (https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/62172) - set (STANDARD_CHECK "-stand f08 -standard-semantics -assume nostd_mod_proc_name") + set (STANDARD_CHECK "-stand f15 -standard-semantics -assume nostd_mod_proc_name") set (LINKER_FLAGS "${LINKER_FLAGS} -shared-intel") # Link against shared Intel libraries instead of static ones diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index b9da4c6bf..dcbbe444a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -19,7 +19,7 @@ add_library(PREC OBJECT "prec.f90") list(APPEND OBJECTFILES $) add_library(ELEMENT OBJECT "element.f90") -add_dependencies(ELEMENT PREC IO) +add_dependencies(ELEMENT IO) list(APPEND OBJECTFILES $) add_library(QUIT OBJECT "quit.f90") diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 9894e0f06..07b7cace1 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -461,48 +461,7 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & - myStart, & - localShape, & !< shape of the dataset (this process) - globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr - -!--------------------------------------------------------------------------------------------------- -! determine shape of dataset - localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - -!--------------------------------------------------------------------------------------------------- -! initialize HDF5 data structures - if (present(parallel)) then - call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, loc_id,localShape,datasetName,parallel) - else - call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, loc_id,localShape,datasetName,.false.) - endif - - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& - file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f') - - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) - -end subroutine HDF5_read_pReal1 - -!-------------------------------------------------------------------------------------------------- -!> @brief read dataset of type pReal with 2 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) - - implicit none - real(pReal), intent(inout), dimension(:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel - - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & ! ToDo: Fortran 2018 size(shape(A)) = rank(A) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -528,6 +487,47 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f') call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + +end subroutine HDF5_read_pReal1 + +!-------------------------------------------------------------------------------------------------- +!> @brief read dataset of type pReal with 2 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) + + implicit none + real(pReal), intent(inout), dimension(:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel + + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr + +!--------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, loc_id,localShape,datasetName,.false.) + endif + + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal2 @@ -543,7 +543,7 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -584,7 +584,7 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -625,7 +625,7 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -666,7 +666,7 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -707,7 +707,7 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -749,7 +749,7 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -790,7 +790,7 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -831,7 +831,7 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -872,7 +872,7 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -913,7 +913,7 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -954,7 +954,7 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -995,7 +995,7 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1039,7 +1039,7 @@ subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1079,7 +1079,7 @@ subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1119,7 +1119,7 @@ subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1159,7 +1159,7 @@ subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1200,7 +1200,7 @@ subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1240,7 +1240,7 @@ subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1280,7 +1280,7 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1321,7 +1321,7 @@ subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1361,7 +1361,7 @@ subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1401,7 +1401,7 @@ subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1441,7 +1441,7 @@ subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1481,7 +1481,7 @@ subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1521,7 +1521,7 @@ subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) @@ -1561,7 +1561,7 @@ subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & + integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) From ce0e84f4186047618ed14d0efab9357e0c986a24 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 07:52:39 +0100 Subject: [PATCH 18/67] was not used anymore --- src/constitutive.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 36886da18..064224d0c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -47,8 +47,6 @@ subroutine constitutive_init() worldrank use IO, only: & IO_error, & - IO_open_file, & - IO_open_jobFile_stat, & IO_write_jobFile use config, only: & material_Nphase, & From 0f6bf382998151eba0d4e2e6ae928d77b71ce140 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 08:04:03 +0100 Subject: [PATCH 19/67] unused functionality --- src/IO.f90 | 30 ------------------------------ src/mesh_FEM.f90 | 1 - 2 files changed, 31 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index a77393893..6f655b145 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -24,7 +24,6 @@ module IO IO_read, & IO_recursiveRead, & IO_open_file_stat, & - IO_open_jobFile_stat, & IO_open_file, & IO_write_jobFile, & IO_write_jobRealFile, & @@ -271,30 +270,6 @@ logical function IO_open_file_stat(fileUnit,path) end function IO_open_file_stat -!-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. File is named after solver job name -!! plus given extension and located in current working directory -!> @details Like IO_open_jobFile, but error is handled via return value and not via call to -!! IO_error -!-------------------------------------------------------------------------------------------------- -logical function IO_open_jobFile_stat(fileUnit,ext) - use DAMASK_interface, only: & - getSolverJobName - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext !< extension of file - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(getSolverJobName())//'.'//ext - open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') - if (myStat /= 0_pInt) close(fileUnit) - IO_open_jobFile_stat = (myStat == 0_pInt) - -end function IO_open_JobFile_stat - #if defined(Marc4DAMASK) || defined(Abaqus) !-------------------------------------------------------------------------------------------------- @@ -1198,7 +1173,6 @@ integer(pInt) function IO_countDataLines(fileUnit) chunkPos = IO_stringPos(line) tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword - line = IO_read(fileUnit, .true.) ! reset IO_read exit else if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt @@ -1234,7 +1208,6 @@ integer(pInt) function IO_countNumericalDataLines(fileUnit) if (verify(trim(tmp),'0123456789') == 0) then ! numerical values IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt else - line = IO_read(fileUnit, .true.) ! reset IO_read exit endif enddo @@ -1290,18 +1263,15 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) if (chunkPos(1) < 1_pInt) then ! empty line - line = IO_read(fileUnit, .true.) ! reset IO_read exit elseif (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) & - IO_intValue(line,chunkPos,1_pInt)) - line = IO_read(fileUnit, .true.) ! reset IO_read exit ! only one single range indicator allowed else IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c' if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt - line = IO_read(fileUnit, .true.) ! reset IO_read exit ! data ended endif endif diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index ed80cbcba..4df5840c7 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -132,7 +132,6 @@ subroutine mesh_init() IO_stringPos, & IO_intValue, & IO_EOF, & - IO_read, & IO_isBlank use debug, only: & debug_e, & From 5ab8e50d090faac4abd5dbb2417984a1806352f8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 08:19:42 +0100 Subject: [PATCH 20/67] consistent with reference paper --- PRIVATE | 2 +- processing/post/addOrientations.py | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/PRIVATE b/PRIVATE index 35bfe75df..219fe1741 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 35bfe75dfc93e8b708b2e0349ce2fb89ceae1ad4 +Subproject commit 219fe1741a801b4af02616b9eed7eb5d70a6b8ed diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index dfaa54196..436a2df6a 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -22,11 +22,11 @@ Additional (globally fixed) rotations of the lab frame and/or crystal frame can """, version = scriptID) representations = { - 'quaternion': ['quat',4], #ToDo: Use here Rowenhorst names (qu/ro/om/ax?) - 'rodrigues': ['rodr',4], - 'eulers': ['eulr',3], - 'matrix': ['mtrx',9], - 'angleaxis': ['aaxs',4], + 'quaternion': ['qu',4], + 'rodrigues': ['ro',4], + 'eulers': ['eu',3], + 'matrix': ['om',9], + 'angleaxis': ['ax',4], } parser.add_option('-o', From 622372bd64f2e5ce9b2c0a6b3b1358a99528aebc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 08:47:30 +0100 Subject: [PATCH 21/67] where within forall does not work with PGI --- src/plastic_nonlocal.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 75d40fba1..a92f1bbfd 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -1378,7 +1378,7 @@ dv_dtau(1:ns,2) = dv_dtau(1:ns,1) dv_dtauNS(1:ns,2) = dv_dtauNS(1:ns,1) !screws -if (size(prm%nonSchmidCoeff) == 0_pInt) then ! no non-Schmid contributions +if (size(prm%nonSchmidCoeff) == 0_pInt) then ! no non-Schmid contributions forall(t = 3_pInt:4_pInt) v(1:ns,t) = v(1:ns,1) dv_dtau(1:ns,t) = dv_dtau(1:ns,1) @@ -1548,13 +1548,13 @@ dUpper(1:ns,1) = prm%mu * prm%burgers & dUpper(1:ns,2) = prm%mu * prm%burgers / (4.0_pReal * PI * abs(tau)) -forall (c = 1_pInt:2_pInt) +do c = 1, 2 where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& +abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) & dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & dUpper(1:ns,c)) -end forall +enddo dUpper = max(dUpper,dLower) deltaDUpper = dUpper - dUpperOld @@ -1804,13 +1804,13 @@ dUpper(1:ns,1) = prm%mu * prm%burgers(1:ns) & / (8.0_pReal * pi * (1.0_pReal - prm%nu) * abs(tau)) dUpper(1:ns,2) = prm%mu * prm%burgers(1:ns) & / (4.0_pReal * pi * abs(tau)) -forall (c = 1_pInt:2_pInt) +do c = 1, 2 where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& +abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) & dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & dUpper(1:ns,c)) -end forall +enddo dUpper = max(dUpper,dLower) !**************************************************************************** @@ -2385,13 +2385,13 @@ dUpper(1:ns,1) = prm%mu * prm%burgers(1:ns) & / (8.0_pReal * pi * (1.0_pReal - prm%nu) * abs(tau)) dUpper(1:ns,2) = prm%mu * prm%burgers(1:ns) & / (4.0_pReal * pi * abs(tau)) -forall (c = 1_pInt:2_pInt) +do c = 1, 2 where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& +abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) & dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & dUpper(1:ns,c)) -end forall +enddo dUpper = max(dUpper,dLower) From 67dcb6d2d6ac944784d68edc2accb1d37f21d442 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 08:48:06 +0100 Subject: [PATCH 22/67] not needed --- src/config.f90 | 35 +++++++++++------------------------ src/constitutive.f90 | 2 -- 2 files changed, 11 insertions(+), 26 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index b963d9086..e8321d9a4 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -75,11 +75,6 @@ module config material_Nmicrostructure, & !< number of microstructures material_Ncrystallite !< number of crystallite settings -! ToDo: make private, no one needs to know that - character(len=*), parameter, public :: & - MATERIAL_configFile = 'material.config', & !< generic name for material configuration file - MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file - public :: & config_init, & config_deallocate @@ -90,11 +85,6 @@ contains !> @brief reads material.config and stores its content per part !-------------------------------------------------------------------------------------------------- subroutine config_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & pStringLen use DAMASK_interface, only: & @@ -103,9 +93,7 @@ subroutine config_init() IO_error, & IO_lc, & IO_recursiveRead, & - IO_getTag, & - IO_timeStamp, & - IO_EOF + IO_getTag use debug, only: & debug_level, & debug_material, & @@ -121,14 +109,12 @@ subroutine config_init() logical :: fileExists write(6,'(/,a)') ' <<<+- config init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" myDebug = debug_level(debug_material) - inquire(file=trim(getSolverJobName())//'.'//material_localFileExt,exist=fileExists) + inquire(file=trim(getSolverJobName())//'.materialConfig',exist=fileExists) if(fileExists) then - fileContent = IO_recursiveRead(trim(getSolverJobName())//'.'//material_localFileExt) + fileContent = IO_recursiveRead(trim(getSolverJobName())//'.materialConfig') else inquire(file='material.config',exist=fileExists) if(.not. fileExists) call IO_error(100_pInt,ext_msg='material.config') @@ -163,16 +149,17 @@ subroutine config_init() end select enddo - + material_Nhomogenization = size(config_homogenization) - if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) material_Nmicrostructure = size(config_microstructure) + material_Ncrystallite = size(config_crystallite) + material_Nphase = size(config_phase) + + if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure) - material_Ncrystallite = size(config_crystallite) - if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite) - material_Nphase = size(config_phase) - if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) - if (size(config_texture) < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) + if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite) + if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) + if (size(config_texture) < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) end subroutine config_init diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 064224d0c..086ee1327 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -50,9 +50,7 @@ subroutine constitutive_init() IO_write_jobFile use config, only: & material_Nphase, & - material_localFileExt, & phase_name, & - material_configFile, & config_deallocate use material, only: & material_phase, & From 363a95d5b7c40fdc57799a5d5bc04016d6a6ac2c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 09:16:31 +0100 Subject: [PATCH 23/67] not needed --- src/IO.f90 | 30 +++++++++--------------------- src/mesh_abaqus.f90 | 4 +--- src/mesh_grid.f90 | 5 +---- src/mesh_marc.f90 | 4 +--- 4 files changed, 12 insertions(+), 31 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 6f655b145..8364c00db 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -415,26 +415,22 @@ end subroutine IO_write_jobFile !> @brief opens binary file containing array of pReal numbers to given unit for writing. File is !! named after solver job name plus given extension and located in current working directory !-------------------------------------------------------------------------------------------------- -subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) +subroutine IO_write_jobRealFile(fileUnit,ext) use DAMASK_interface, only: & getSolverJobName implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: ext !< extension of file - integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt) :: myStat character(len=1024) :: path path = trim(getSolverJobName())//'.'//ext - if (present(recMultiplier)) then - open(fileUnit,status='replace',form='unformatted',access='direct', & - recl=pReal*recMultiplier,iostat=myStat,file=path) - else + open(fileUnit,status='replace',form='unformatted',access='direct', & recl=pReal,iostat=myStat,file=path) - endif + if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -445,25 +441,21 @@ end subroutine IO_write_jobRealFile !> @brief opens binary file containing array of pReal numbers to given unit for reading. File is !! located in current working directory !-------------------------------------------------------------------------------------------------- -subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) +subroutine IO_read_realFile(fileUnit,ext,modelName) implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: ext, & !< extension of file modelName !< model name, in case of restart not solver job name - integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt) :: myStat character(len=1024) :: path path = trim(modelName)//'.'//ext - if (present(recMultiplier)) then - open(fileUnit,status='old',form='unformatted',access='direct', & - recl=pReal*recMultiplier,iostat=myStat,file=path) - else + open(fileUnit,status='old',form='unformatted',access='direct', & recl=pReal,iostat=myStat,file=path) - endif + if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) end subroutine IO_read_realFile @@ -473,25 +465,21 @@ end subroutine IO_read_realFile !> @brief opens binary file containing array of pInt numbers to given unit for reading. File is !! located in current working directory !-------------------------------------------------------------------------------------------------- -subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) +subroutine IO_read_intFile(fileUnit,ext,modelName) implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: ext, & !< extension of file modelName !< model name, in case of restart not solver job name - integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) integer(pInt) :: myStat character(len=1024) :: path path = trim(modelName)//'.'//ext - if (present(recMultiplier)) then - open(fileUnit,status='old',form='unformatted',access='direct', & - recl=pInt*recMultiplier,iostat=myStat,file=path) - else + open(fileUnit,status='old',form='unformatted',access='direct', & recl=pInt,iostat=myStat,file=path) - endif + if (myStat /= 0) call IO_error(100_pInt,ext_msg=path) end subroutine IO_read_intFile diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 4e923606e..d871203af 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -427,9 +427,7 @@ subroutine mesh_init(ip,el) use DAMASK_interface use IO, only: & IO_open_InputFile, & - IO_timeStamp, & - IO_error, & - IO_write_jobFile + IO_error use debug, only: & debug_e, & debug_i, & diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 424456e3a..6235e4c1d 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -176,10 +176,7 @@ subroutine mesh_init(ip,el) use DAMASK_interface use IO, only: & IO_open_file, & - IO_error, & - IO_timeStamp, & - IO_error, & - IO_write_jobFile + IO_error use debug, only: & debug_e, & debug_i, & diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 0c7d332c9..0bb54ffb8 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -286,9 +286,7 @@ subroutine mesh_init(ip,el) use DAMASK_interface use IO, only: & IO_open_InputFile, & - IO_timeStamp, & - IO_error, & - IO_write_jobFile + IO_error use debug, only: & debug_e, & debug_i, & From 09a7427193d36d3c55c52a3ca0a15948a5a94e27 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 23:16:08 +0100 Subject: [PATCH 24/67] temporarly disabled restart --- src/CPFEM.f90 | 246 +++++++++++++++++++++++--------------------------- 1 file changed, 112 insertions(+), 134 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index ba18f7d52..ebbf705aa 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -116,20 +116,8 @@ end subroutine CPFEM_initAll !> @brief allocate the arrays defined in module CPFEM and initialize them !-------------------------------------------------------------------------------------------------- subroutine CPFEM_init -#if __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use prec, only: & - pInt use IO, only: & - IO_read_realFile,& - IO_read_intFile, & - IO_timeStamp, & IO_error - use numerics, only: & - worldrank use debug, only: & debug_level, & debug_CPFEM, & @@ -157,85 +145,79 @@ subroutine CPFEM_init crystallite_Tstar0_v implicit none - integer(pInt) :: k,l,m,ph,homog - character(len=1024) :: rankStr + integer :: k,l,m,ph,homog - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - flush(6) - endif mainProcess + write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' + flush(6) allocate(CPFEM_cs( 6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) allocate(CPFEM_dcsdE( 6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) allocate(CPFEM_dcsdE_knownGood(6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) ! *** restore the last converged values of each essential variable from the binary file - if (restartRead) then - if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) then - write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from binary files' - flush(6) - endif - - write(rankStr,'(a1,i0)')'_',worldrank - - call IO_read_intFile(777,'recordedPhase'//trim(rankStr),modelName,size(material_phase)) - read (777,rec=1) material_phase - close (777) - - call IO_read_realFile(777,'convergedF'//trim(rankStr),modelName,size(crystallite_F0)) - read (777,rec=1) crystallite_F0 - close (777) - - call IO_read_realFile(777,'convergedFp'//trim(rankStr),modelName,size(crystallite_Fp0)) - read (777,rec=1) crystallite_Fp0 - close (777) - - call IO_read_realFile(777,'convergedFi'//trim(rankStr),modelName,size(crystallite_Fi0)) - read (777,rec=1) crystallite_Fi0 - close (777) - - call IO_read_realFile(777,'convergedLp'//trim(rankStr),modelName,size(crystallite_Lp0)) - read (777,rec=1) crystallite_Lp0 - close (777) - - call IO_read_realFile(777,'convergedLi'//trim(rankStr),modelName,size(crystallite_Li0)) - read (777,rec=1) crystallite_Li0 - close (777) + !if (restartRead) then + ! if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) then + ! write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from binary files' + ! flush(6) + ! endif - call IO_read_realFile(777,'convergedTstar'//trim(rankStr),modelName,size(crystallite_Tstar0_v)) - read (777,rec=1) crystallite_Tstar0_v - close (777) + ! call IO_read_intFile(777,'recordedPhase'//trim(rankStr),modelName,size(material_phase)) + ! read (777,rec=1) material_phase + ! close (777) - call IO_read_realFile(777,'convergedStateConst'//trim(rankStr),modelName) - m = 0_pInt - readPlasticityInstances: do ph = 1_pInt, size(phase_plasticity) - do k = 1_pInt, plasticState(ph)%sizeState - do l = 1, size(plasticState(ph)%state0(1,:)) - m = m+1_pInt - read(777,rec=m) plasticState(ph)%state0(k,l) - enddo; enddo - enddo readPlasticityInstances - close (777) + ! call IO_read_realFile(777,'convergedF'//trim(rankStr),modelName,size(crystallite_F0)) + ! read (777,rec=1) crystallite_F0 + ! close (777) - call IO_read_realFile(777,'convergedStateHomog'//trim(rankStr),modelName) - m = 0_pInt - readHomogInstances: do homog = 1_pInt, material_Nhomogenization - do k = 1_pInt, homogState(homog)%sizeState - do l = 1, size(homogState(homog)%state0(1,:)) - m = m+1_pInt - read(777,rec=m) homogState(homog)%state0(k,l) - enddo; enddo - enddo readHomogInstances - close (777) + ! call IO_read_realFile(777,'convergedFp'//trim(rankStr),modelName,size(crystallite_Fp0)) + ! read (777,rec=1) crystallite_Fp0 + ! close (777) - call IO_read_realFile(777,'convergeddcsdE',modelName,size(CPFEM_dcsdE)) - read (777,rec=1) CPFEM_dcsdE - close (777) - restartRead = .false. - endif + ! call IO_read_realFile(777,'convergedFi'//trim(rankStr),modelName,size(crystallite_Fi0)) + ! read (777,rec=1) crystallite_Fi0 + ! close (777) + + ! call IO_read_realFile(777,'convergedLp'//trim(rankStr),modelName,size(crystallite_Lp0)) + ! read (777,rec=1) crystallite_Lp0 + ! close (777) + + ! call IO_read_realFile(777,'convergedLi'//trim(rankStr),modelName,size(crystallite_Li0)) + ! read (777,rec=1) crystallite_Li0 + ! close (777) + + + ! call IO_read_realFile(777,'convergedTstar'//trim(rankStr),modelName,size(crystallite_Tstar0_v)) + ! read (777,rec=1) crystallite_Tstar0_v + ! close (777) + + ! call IO_read_realFile(777,'convergedStateConst'//trim(rankStr),modelName) + ! m = 0_pInt + ! readPlasticityInstances: do ph = 1_pInt, size(phase_plasticity) + ! do k = 1_pInt, plasticState(ph)%sizeState + ! do l = 1, size(plasticState(ph)%state0(1,:)) + ! m = m+1_pInt + ! read(777,rec=m) plasticState(ph)%state0(k,l) + ! enddo; enddo + ! enddo readPlasticityInstances + ! close (777) + + ! call IO_read_realFile(777,'convergedStateHomog'//trim(rankStr),modelName) + ! m = 0_pInt + ! readHomogInstances: do homog = 1_pInt, material_Nhomogenization + ! do k = 1_pInt, homogState(homog)%sizeState + ! do l = 1, size(homogState(homog)%state0(1,:)) + ! m = m+1_pInt + ! read(777,rec=m) homogState(homog)%state0(k,l) + ! enddo; enddo + ! enddo readHomogInstances + ! close (777) + + ! call IO_read_realFile(777,'convergeddcsdE',modelName,size(CPFEM_dcsdE)) + ! read (777,rec=1) CPFEM_dcsdE + ! close (777) + ! restartRead = .false. + !endif if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs) write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE) @@ -253,8 +235,7 @@ end subroutine CPFEM_init subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyStress, jacobian) use numerics, only: & defgradTolerance, & - iJacoStiffness, & - worldrank + iJacoStiffness use debug, only: & debug_level, & debug_CPFEM, & @@ -331,7 +312,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt materialpoint_stressAndItsTangent, & materialpoint_postResults use IO, only: & - IO_write_jobRealFile, & IO_warning use DAMASK_interface @@ -358,7 +338,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt integer(pInt) elCP, & ! crystal plasticity element number i, j, k, l, m, n, ph, homog, mySource logical updateJaco ! flag indicating if JAcobian has to be updated - character(len=1024) :: rankStr elCP = mesh_FEasCP('elem',elFE) @@ -414,68 +393,67 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt ! * dump the last converged values of each essential variable to a binary file - if (restartWrite) then - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & - write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files' - - write(rankStr,'(a1,i0)')'_',worldrank + !if (restartWrite) then + ! if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + ! write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files' + ! - call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase)) - write (777,rec=1) material_phase - close (777) + ! call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase)) + ! write (777,rec=1) material_phase + ! close (777) - call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0)) - write (777,rec=1) crystallite_F0 - close (777) + ! call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0)) + ! write (777,rec=1) crystallite_F0 + ! close (777) - call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0)) - write (777,rec=1) crystallite_Fp0 - close (777) + ! call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0)) + ! write (777,rec=1) crystallite_Fp0 + ! close (777) - call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0)) - write (777,rec=1) crystallite_Fi0 - close (777) + ! call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0)) + ! write (777,rec=1) crystallite_Fi0 + ! close (777) - call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0)) - write (777,rec=1) crystallite_Lp0 - close (777) + ! call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0)) + ! write (777,rec=1) crystallite_Lp0 + ! close (777) - call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0)) - write (777,rec=1) crystallite_Li0 - close (777) + ! call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0)) + ! write (777,rec=1) crystallite_Li0 + ! close (777) - call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v)) - write (777,rec=1) crystallite_Tstar0_v - close (777) + ! call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v)) + ! write (777,rec=1) crystallite_Tstar0_v + ! close (777) - call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr)) - m = 0_pInt - writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity) - do k = 1_pInt, plasticState(ph)%sizeState - do l = 1, size(plasticState(ph)%state0(1,:)) - m = m+1_pInt - write(777,rec=m) plasticState(ph)%state0(k,l) - enddo; enddo - enddo writePlasticityInstances - close (777) + ! call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr)) + ! m = 0_pInt + ! writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity) + ! do k = 1_pInt, plasticState(ph)%sizeState + ! do l = 1, size(plasticState(ph)%state0(1,:)) + ! m = m+1_pInt + ! write(777,rec=m) plasticState(ph)%state0(k,l) + ! enddo; enddo + ! enddo writePlasticityInstances + ! close (777) - call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr)) - m = 0_pInt - writeHomogInstances: do homog = 1_pInt, material_Nhomogenization - do k = 1_pInt, homogState(homog)%sizeState - do l = 1, size(homogState(homog)%state0(1,:)) - m = m+1_pInt - write(777,rec=m) homogState(homog)%state0(k,l) - enddo; enddo - enddo writeHomogInstances - close (777) + ! call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr)) + ! m = 0_pInt + ! writeHomogInstances: do homog = 1_pInt, material_Nhomogenization + ! do k = 1_pInt, homogState(homog)%sizeState + ! do l = 1, size(homogState(homog)%state0(1,:)) + ! m = m+1_pInt + ! write(777,rec=m) homogState(homog)%state0(k,l) + ! enddo; enddo + ! enddo writeHomogInstances + ! close (777) - call IO_write_jobRealFile(777,'convergeddcsdE',size(CPFEM_dcsdE)) - write (777,rec=1) CPFEM_dcsdE - close (777) + ! call IO_write_jobRealFile(777,'convergeddcsdE',size(CPFEM_dcsdE)) + ! write (777,rec=1) CPFEM_dcsdE + ! close (777) - endif - endif ! results aging + !endif + endif From 48cfc35996f6362ca081437d0bbe8942bebe1bb0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 23:16:35 +0100 Subject: [PATCH 25/67] polishing --- src/HDF5_utilities.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 07b7cace1..afb4be5dd 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -117,7 +117,7 @@ end subroutine HDF5_utilities_init !-------------------------------------------------------------------------------------------------- !> @brief open and initializes HDF5 output file !-------------------------------------------------------------------------------------------------- -integer(HID_T) function HDF5_openFile(fileName,mode,parallel) +integer(HID_T) function HDF5_openFile(fileName,mode,parallel) ! ToDo: simply "open" is enough implicit none character(len=*), intent(in) :: fileName @@ -146,7 +146,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel) if (m == 'w') then call h5fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,access_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fcreate_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fcreate_f (w)') elseif(m == 'a') then call h5fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (a)') @@ -154,7 +154,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel) call h5fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (r)') else - call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f unknown access mode') + call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f unknown access mode: '//trim(m)) endif call h5pclose_f(plist_id, hdferr) From af707c671c5f62881fc13f72b004f5d687148cb5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 23:16:56 +0100 Subject: [PATCH 26/67] improved IO functionality - naming for file opening follows python - damage modules do not read from file any more --- src/CPFEM2.f90 | 10 -- src/IO.f90 | 221 +++++++++++++---------------- src/damage_local.f90 | 152 ++++++++------------ src/damage_nonlocal.f90 | 171 ++++++++-------------- src/homogenization.f90 | 22 +-- src/spectral_damage.f90 | 11 +- src/spectral_mech_Basic.f90 | 69 +++++---- src/spectral_mech_Polarisation.f90 | 89 ++++++------ src/spectral_utilities.f90 | 108 +++++++------- 9 files changed, 355 insertions(+), 498 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 087328bf6..e44822089 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -87,11 +87,6 @@ end subroutine CPFEM_initAll !> @brief allocate the arrays defined in module CPFEM and initialize them !-------------------------------------------------------------------------------------------------- subroutine CPFEM_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & pInt, pReal use IO, only: & @@ -136,8 +131,6 @@ subroutine CPFEM_init integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" flush(6) ! *** restore the last converged values of each essential variable from the binary file @@ -223,9 +216,6 @@ subroutine CPFEM_age() crystallite_dPdF, & crystallite_Tstar0_v, & crystallite_Tstar_v - use IO, only: & - IO_write_jobRealFile, & - IO_warning use HDF5_utilities, only: & HDF5_openFile, & HDF5_closeFile, & diff --git a/src/IO.f90 b/src/IO.f90 index 8364c00db..9f9c71ae4 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -25,10 +25,8 @@ module IO IO_recursiveRead, & IO_open_file_stat, & IO_open_file, & + IO_open_jobFile_binary, & IO_write_jobFile, & - IO_write_jobRealFile, & - IO_read_realFile, & - IO_read_intFile, & IO_isBlank, & IO_getTag, & IO_stringPos, & @@ -229,7 +227,6 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent) end function IO_recursiveRead - !-------------------------------------------------------------------------------------------------- !> @brief opens existing file for reading to given unit. Path to file is relative to working !! directory @@ -250,6 +247,61 @@ subroutine IO_open_file(fileUnit,path) end subroutine IO_open_file +!-------------------------------------------------------------------------------------------------- +!> @brief opens an existing file for reading or a new file for writing. Name is the job name +!> @details replaces an existing file when writing +!-------------------------------------------------------------------------------------------------- +integer function IO_open_jobFile_binary(extension,mode) + use DAMASK_interface, only: & + getSolverJobName + + implicit none + character(len=*), intent(in) :: extension + character, intent(in), optional :: mode + + if (present(mode)) then + IO_open_jobFile_binary = IO_open_binary(trim(getSolverJobName())//'.'//trim(extension),mode) + else + IO_open_jobFile_binary = IO_open_binary(trim(getSolverJobName())//'.'//trim(extension)) + endif + +end function IO_open_jobFile_binary + + +!-------------------------------------------------------------------------------------------------- +!> @brief opens an existing file for reading or a new file for writing. +!> @details replaces an existing file when writing +!-------------------------------------------------------------------------------------------------- +integer function IO_open_binary(fileName,mode) + + implicit none + character(len=*), intent(in) :: fileName + character, intent(in), optional :: mode + + character :: m + integer :: ierr + + if (present(mode)) then + m = mode + else + m = 'r' + endif + + if (m == 'w') then + open(newunit=IO_open_binary, file=trim(fileName),& + status='replace',access='stream',action='write',iostat=ierr) + if (ierr /= 0) call IO_error(100,ext_msg='could not open file (w): '//trim(fileName)) + elseif(m == 'r') then + open(newunit=IO_open_binary, file=trim(fileName),& + status='old', access='stream',action='read', iostat=ierr) + if (ierr /= 0) call IO_error(100,ext_msg='could not open file (r): '//trim(fileName)) + else + call IO_error(100,ext_msg='unknown access mode: '//m) + endif + +end function IO_open_binary + + !-------------------------------------------------------------------------------------------------- !> @brief opens existing file for reading to given unit. Path to file is relative to working !! directory @@ -277,7 +329,6 @@ end function IO_open_file_stat !-------------------------------------------------------------------------------------------------- subroutine IO_open_inputFile(fileUnit,modelName) use DAMASK_interface, only: & - getSolverJobName, & inputFileExtension implicit none @@ -411,80 +462,6 @@ subroutine IO_write_jobFile(fileUnit,ext) end subroutine IO_write_jobFile -!-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pReal numbers to given unit for writing. File is -!! named after solver job name plus given extension and located in current working directory -!-------------------------------------------------------------------------------------------------- -subroutine IO_write_jobRealFile(fileUnit,ext) - use DAMASK_interface, only: & - getSolverJobName - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext !< extension of file - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(getSolverJobName())//'.'//ext - - open(fileUnit,status='replace',form='unformatted',access='direct', & - recl=pReal,iostat=myStat,file=path) - - - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - -end subroutine IO_write_jobRealFile - - -!-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pReal numbers to given unit for reading. File is -!! located in current working directory -!-------------------------------------------------------------------------------------------------- -subroutine IO_read_realFile(fileUnit,ext,modelName) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext, & !< extension of file - modelName !< model name, in case of restart not solver job name - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(modelName)//'.'//ext - - open(fileUnit,status='old',form='unformatted',access='direct', & - recl=pReal,iostat=myStat,file=path) - - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - -end subroutine IO_read_realFile - - -!-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pInt numbers to given unit for reading. File is -!! located in current working directory -!-------------------------------------------------------------------------------------------------- -subroutine IO_read_intFile(fileUnit,ext,modelName) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext, & !< extension of file - modelName !< model name, in case of restart not solver job name - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(modelName)//'.'//ext - - open(fileUnit,status='old',form='unformatted',access='direct', & - recl=pInt,iostat=myStat,file=path) - - if (myStat /= 0) call IO_error(100_pInt,ext_msg=path) - -end subroutine IO_read_intFile - - !-------------------------------------------------------------------------------------------------- !> @brief identifies strings without content !-------------------------------------------------------------------------------------------------- @@ -1401,27 +1378,27 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) !> @brief returns verified integer value in given string !-------------------------------------------------------------------------------------------------- integer(pInt) function IO_verifyIntValue (string,validChars,myName) - - implicit none - character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! - validChars, & !< valid characters in string - myName !< name of caller function (for debugging) - integer(pInt) :: readStatus, invalidWhere - - IO_verifyIntValue = 0_pInt - - invalidWhere = verify(string,validChars) - if (invalidWhere == 0_pInt) then - read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyIntValue ! no offending chars found - if (readStatus /= 0_pInt) & ! error during string to integer conversion - call IO_warning(203_pInt,ext_msg=myName//'"'//string//'"') - else - call IO_warning(202_pInt,ext_msg=myName//'"'//string//'"') ! complain about offending characters - read(UNIT=string(1_pInt:invalidWhere-1_pInt),iostat=readStatus,FMT=*) IO_verifyIntValue ! interpret remaining string - if (readStatus /= 0_pInt) & ! error during string to integer conversion - call IO_warning(203_pInt,ext_msg=myName//'"'//string(1_pInt:invalidWhere-1_pInt)//'"') - endif - + + implicit none + character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! + validChars, & !< valid characters in string + myName !< name of caller function (for debugging) + integer :: readStatus, invalidWhere + + IO_verifyIntValue = 0 + + invalidWhere = verify(string,validChars) + if (invalidWhere == 0) then + read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyIntValue ! no offending chars found + if (readStatus /= 0) & ! error during string to integer conversion + call IO_warning(203,ext_msg=myName//'"'//string//'"') + else + call IO_warning(202,ext_msg=myName//'"'//string//'"') ! complain about offending characters + read(UNIT=string(1:invalidWhere-1),iostat=readStatus,FMT=*) IO_verifyIntValue ! interpret remaining string + if (readStatus /= 0) & ! error during string to integer conversion + call IO_warning(203,ext_msg=myName//'"'//string(1:invalidWhere-1)//'"') + endif + end function IO_verifyIntValue @@ -1429,28 +1406,28 @@ end function IO_verifyIntValue !> @brief returns verified float value in given string !-------------------------------------------------------------------------------------------------- real(pReal) function IO_verifyFloatValue (string,validChars,myName) - - implicit none - character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! - validChars, & !< valid characters in string - myName !< name of caller function (for debugging) - - integer(pInt) :: readStatus, invalidWhere - - IO_verifyFloatValue = 0.0_pReal - - invalidWhere = verify(string,validChars) - if (invalidWhere == 0_pInt) then - read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyFloatValue ! no offending chars found - if (readStatus /= 0_pInt) & ! error during string to float conversion - call IO_warning(203_pInt,ext_msg=myName//'"'//string//'"') - else - call IO_warning(202_pInt,ext_msg=myName//'"'//string//'"') ! complain about offending characters - read(UNIT=string(1_pInt:invalidWhere-1_pInt),iostat=readStatus,FMT=*) IO_verifyFloatValue ! interpret remaining string - if (readStatus /= 0_pInt) & ! error during string to float conversion - call IO_warning(203_pInt,ext_msg=myName//'"'//string(1_pInt:invalidWhere-1_pInt)//'"') - endif - + + implicit none + character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! + validChars, & !< valid characters in string + myName !< name of caller function (for debugging) + + integer :: readStatus, invalidWhere + + IO_verifyFloatValue = 0.0_pReal + + invalidWhere = verify(string,validChars) + if (invalidWhere == 0) then + read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyFloatValue ! no offending chars found + if (readStatus /= 0) & ! error during string to float conversion + call IO_warning(203,ext_msg=myName//'"'//string//'"') + else + call IO_warning(202,ext_msg=myName//'"'//string//'"') ! complain about offending characters + read(UNIT=string(1:invalidWhere-1),iostat=readStatus,FMT=*) IO_verifyFloatValue ! interpret remaining string + if (readStatus /= 0) & ! error during string to float conversion + call IO_warning(203,ext_msg=myName//'"'//string(1:invalidWhere-1)//'"') + endif + end function IO_verifyFloatValue end module IO diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 6569347c2..b5f3e59c7 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -9,9 +9,6 @@ module damage_local implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - damage_local_sizePostResults !< cumulative size of post results - integer(pInt), dimension(:,:), allocatable, target, public :: & damage_local_sizePostResult !< size of each post result output @@ -27,7 +24,15 @@ module damage_local end enum integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & damage_local_outputID !< ID of each post result output + + type, private :: tParameters + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID + end type tParameters + type(tparameters), dimension(:), allocatable, private :: & + param + public :: & damage_local_init, & damage_local_updateState, & @@ -38,27 +43,10 @@ module damage_local contains !-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, reads information from material configuration file +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine damage_local_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - 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 +subroutine damage_local_init use material, only: & damage_type, & damage_typeInstance, & @@ -72,94 +60,65 @@ subroutine damage_local_init(fileUnit) damage, & damage_initialPhi use config, only: & - material_partHomogenization + config_homogenization implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,homog,instance,o + integer(pInt) :: maxNinstance,homog,instance,o,i integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog - character(len=65536) :: & - tag = '', & - line = '' - + integer(pInt) :: NofMyHomog, h + integer(kind(undefined_ID)) :: & + outputID + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + character(len=65536), dimension(:), allocatable :: & + outputs + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt) if (maxNinstance == 0_pInt) return - allocate(damage_local_sizePostResults(maxNinstance), source=0_pInt) allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) allocate(damage_local_output (maxval(homogenization_Noutput),maxNinstance)) damage_local_output = '' allocate(damage_local_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) allocate(damage_local_Noutput (maxNinstance), source=0_pInt) - - rewind(fileUnit) - homog = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to - line = IO_read(fileUnit) - enddo - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homog 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 homog section - homog = homog + 1_pInt ! advance homog section counter - cycle ! skip to next line - endif + allocate(param(maxNinstance)) + + do h = 1, size(damage_type) + if (damage_type(h) /= DAMAGE_LOCAL_ID) cycle + associate(prm => param(damage_typeInstance(h)), & + config => config_homogenization(h)) + - if (homog > 0_pInt ) then; if (damage_type(homog) == DAMAGE_local_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = damage_typeInstance(homog) ! which instance of my damage is present homog - 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 ('damage') - damage_local_Noutput(instance) = damage_local_Noutput(instance) + 1_pInt - damage_local_outputID(damage_local_Noutput(instance),instance) = damage_ID - damage_local_output(damage_local_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - end select - endif; endif - enddo parsingFile - - initializeInstances: do homog = 1_pInt, size(damage_type) + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) - myhomog: if (damage_type(homog) == DAMAGE_local_ID) then + do i=1, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + + case ('damage') + damage_local_output(i,damage_typeInstance(h)) = outputs(i) + damage_local_Noutput(instance) = damage_local_Noutput(instance) + 1 + damage_local_sizePostResult(i,damage_typeInstance(h)) = 1 + prm%outputID = [prm%outputID , damage_ID] + end select + + enddo + + + homog = h + NofMyHomog = count(material_homog == homog) instance = damage_typeInstance(homog) -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,damage_local_Noutput(instance) - select case(damage_local_outputID(o,instance)) - case(damage_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - damage_local_sizePostResult(o,instance) = mySize - damage_local_sizePostResults(instance) = damage_local_sizePostResults(instance) + mySize - endif - enddo outputsLoop ! allocate state arrays sizeState = 1_pInt damageState(homog)%sizeState = sizeState - damageState(homog)%sizePostResults = damage_local_sizePostResults(instance) + damageState(homog)%sizePostResults = sum(damage_local_sizePostResult(:,instance)) allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog)) allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog)) @@ -169,8 +128,8 @@ subroutine damage_local_init(fileUnit) deallocate(damage(homog)%p) damage(homog)%p => damageState(homog)%state(1,:) - endif myhomog - enddo initializeInstances + end associate + enddo end subroutine damage_local_init @@ -193,7 +152,7 @@ function damage_local_updateState(subdt, ip, el) el !< element number real(pReal), intent(in) :: & subdt - logical, dimension(2) :: & + logical, dimension(2) :: & damage_local_updateState integer(pInt) :: & homog, & @@ -303,7 +262,7 @@ function damage_local_postResults(ip,el) integer(pInt), intent(in) :: & ip, & !< integration point el !< element - real(pReal), dimension(damage_local_sizePostResults(damage_typeInstance(mappingHomogenization(2,ip,el)))) :: & + real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(mappingHomogenization(2,ip,el))))) :: & damage_local_postResults integer(pInt) :: & @@ -312,18 +271,19 @@ function damage_local_postResults(ip,el) homog = mappingHomogenization(2,ip,el) offset = damageMapping(homog)%p(ip,el) instance = damage_typeInstance(homog) - + associate(prm => param(instance)) c = 0_pInt - damage_local_postResults = 0.0_pReal - do o = 1_pInt,damage_local_Noutput(instance) - select case(damage_local_outputID(o,instance)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) case (damage_ID) damage_local_postResults(c+1_pInt) = damage(homog)%p(offset) c = c + 1 end select - enddo + enddo outputsLoop + + end associate end function damage_local_postResults end module damage_local diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index eab808266..c702d1a03 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -10,9 +10,6 @@ module damage_nonlocal implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - damage_nonlocal_sizePostResults !< cumulative size of post results - integer(pInt), dimension(:,:), allocatable, target, public :: & damage_nonlocal_sizePostResult !< size of each post result output @@ -26,9 +23,14 @@ module damage_nonlocal enumerator :: undefined_ID, & damage_ID end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - damage_nonlocal_outputID !< ID of each post result output + type, private :: tParameters + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID + end type tParameters + + type(tparameters), dimension(:), allocatable, private :: & + param public :: & damage_nonlocal_init, & @@ -40,30 +42,11 @@ module damage_nonlocal contains - !-------------------------------------------------------------------------------------------------- !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine damage_nonlocal_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - 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 +subroutine damage_nonlocal_init use material, only: & damage_type, & damage_typeInstance, & @@ -77,105 +60,75 @@ subroutine damage_nonlocal_init(fileUnit) damage, & damage_initialPhi use config, only: & - material_partHomogenization + config_homogenization implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o + integer(pInt) :: maxNinstance,homog,instance,o,i integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog - character(len=65536) :: & - tag = '', & - line = '' + integer(pInt) :: NofMyHomog, h + integer(kind(undefined_ID)) :: & + outputID + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + character(len=65536), dimension(:), allocatable :: & + outputs write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt) if (maxNinstance == 0_pInt) return - allocate(damage_nonlocal_sizePostResults(maxNinstance), source=0_pInt) allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance)) damage_nonlocal_output = '' - allocate(damage_nonlocal_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) allocate(damage_nonlocal_Noutput (maxNinstance), source=0_pInt) - rewind(fileUnit) - section = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homog 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 homog section - section = section + 1_pInt ! advance homog section counter - cycle ! skip to next line - endif + allocate(param(maxNinstance)) + + do h = 1, size(damage_type) + if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle + associate(prm => param(damage_typeInstance(h)), & + config => config_homogenization(h)) + - if (section > 0_pInt ) then; if (damage_type(section) == DAMAGE_nonlocal_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = damage_typeInstance(section) ! which instance of my damage is present homog - 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))) + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + + do i=1, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case ('damage') - damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1_pInt - damage_nonlocal_outputID(damage_nonlocal_Noutput(instance),instance) = damage_ID - damage_nonlocal_output(damage_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + damage_nonlocal_output(i,damage_typeInstance(h)) = outputs(i) + damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1 + damage_nonlocal_sizePostResult(i,damage_typeInstance(h)) = 1 + prm%outputID = [prm%outputID , damage_ID] end select + + enddo - end select - endif; endif - enddo parsingFile - - initializeInstances: do section = 1_pInt, size(damage_type) - if (damage_type(section) == DAMAGE_nonlocal_ID) then - NofMyHomog=count(material_homog==section) - instance = damage_typeInstance(section) -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,damage_nonlocal_Noutput(instance) - select case(damage_nonlocal_outputID(o,instance)) - case(damage_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - damage_nonlocal_sizePostResult(o,instance) = mySize - damage_nonlocal_sizePostResults(instance) = damage_nonlocal_sizePostResults(instance) + mySize - endif - enddo outputsLoop + homog = h + + NofMyHomog = count(material_homog == homog) + instance = damage_typeInstance(homog) + ! allocate state arrays - sizeState = 0_pInt - damageState(section)%sizeState = sizeState - damageState(section)%sizePostResults = damage_nonlocal_sizePostResults(instance) - allocate(damageState(section)%state0 (sizeState,NofMyHomog)) - allocate(damageState(section)%subState0(sizeState,NofMyHomog)) - allocate(damageState(section)%state (sizeState,NofMyHomog)) + sizeState = 1_pInt + damageState(homog)%sizeState = sizeState + damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance)) + allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) + allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog)) + allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog)) - nullify(damageMapping(section)%p) - damageMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(damage(section)%p) - allocate(damage(section)%p(NofMyHomog), source=damage_initialPhi(section)) + nullify(damageMapping(homog)%p) + damageMapping(homog)%p => mappingHomogenization(1,:,:) + deallocate(damage(homog)%p) + damage(homog)%p => damageState(homog)%state(1,:) - endif - - enddo initializeInstances + end associate + enddo end subroutine damage_nonlocal_init !-------------------------------------------------------------------------------------------------- @@ -221,7 +174,7 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el)) phase = phaseAt(grain,ip,el) constituent = phasememberAt(grain,ip,el) - do source = 1_pInt, phase_Nsources(phase) + do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_damage_isoBrittle_ID) call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) @@ -349,33 +302,35 @@ function damage_nonlocal_postResults(ip,el) use material, only: & mappingHomogenization, & damage_typeInstance, & + damageMapping, & damage implicit none integer(pInt), intent(in) :: & ip, & !< integration point el !< element - real(pReal), dimension(damage_nonlocal_sizePostResults(damage_typeInstance(mappingHomogenization(2,ip,el)))) :: & + real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(mappingHomogenization(2,ip,el))))) :: & damage_nonlocal_postResults integer(pInt) :: & instance, homog, offset, o, c homog = mappingHomogenization(2,ip,el) - offset = mappingHomogenization(1,ip,el) + offset = damageMapping(homog)%p(ip,el) instance = damage_typeInstance(homog) - + associate(prm => param(instance)) c = 0_pInt - damage_nonlocal_postResults = 0.0_pReal - do o = 1_pInt,damage_nonlocal_Noutput(instance) - select case(damage_nonlocal_outputID(o,instance)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) case (damage_ID) damage_nonlocal_postResults(c+1_pInt) = damage(homog)%p(offset) c = c + 1 end select - enddo + enddo outputsLoop + + end associate end function damage_nonlocal_postResults end module damage_nonlocal diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 94acf8c82..7e16dd41f 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -57,11 +57,6 @@ contains !> @brief module initialization !-------------------------------------------------------------------------------------------------- subroutine homogenization_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use math, only: & math_I3 use debug, only: & @@ -79,8 +74,6 @@ subroutine homogenization_init use crystallite, only: & crystallite_maxSizePostResults use config, only: & - material_configFile, & - material_localFileExt, & config_deallocate, & config_homogenization, & homogenization_name @@ -116,16 +109,9 @@ subroutine homogenization_init if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init -!-------------------------------------------------------------------------------------------------- -! open material.config - if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... - call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file - if (any(damage_type == DAMAGE_none_ID)) & - call damage_none_init() - if (any(damage_type == DAMAGE_local_ID)) & - call damage_local_init(FILEUNIT) - if (any(damage_type == DAMAGE_nonlocal_ID)) & - call damage_nonlocal_init(FILEUNIT) + if (any(damage_type == DAMAGE_none_ID)) call damage_none_init + if (any(damage_type == DAMAGE_local_ID)) call damage_local_init + if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init !-------------------------------------------------------------------------------------------------- ! write description file for homogenization output @@ -265,8 +251,6 @@ subroutine homogenization_init allocate(materialpoint_results(materialpoint_sizeResults,theMesh%elem%nIPs,theMesh%nElems)) write(6,'(/,a)') ' <<<+- homogenization init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then #ifdef TODO diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 index 13ddf0e74..1b741ee2d 100644 --- a/src/spectral_damage.f90 +++ b/src/spectral_damage.f90 @@ -57,15 +57,8 @@ contains !> @brief allocates all neccessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine spectral_damage_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use IO, only: & - IO_intOut, & - IO_read_realFile, & - IO_timeStamp + IO_intOut use spectral_utilities, only: & wgt use mesh, only: & @@ -87,8 +80,6 @@ subroutine spectral_damage_init() write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press, ' write(6,'(a,/)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index 003c9820d..9508b6f0a 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -73,16 +73,10 @@ contains !> @brief allocates all necessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine basic_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use IO, only: & IO_intOut, & IO_error, & - IO_read_realFile, & - IO_timeStamp + IO_open_jobFile_binary use debug, only: & debug_level, & debug_spectral, & @@ -115,14 +109,12 @@ subroutine basic_init PetscErrorCode :: ierr PetscScalar, pointer, dimension(:,:,:,:) :: F PetscInt, dimension(:), allocatable :: localK - integer(pInt) :: proc + integer :: proc, fileUnit character(len=1024) :: rankStr write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasic init -+>>>' write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015' write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" !-------------------------------------------------------------------------------------------------- ! allocate global fields @@ -134,7 +126,7 @@ subroutine basic_init call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize + do proc = 1, worldsize !ToDo: there are smarter options in MPI call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) enddo call DMDACreate3d(PETSC_COMM_WORLD, & @@ -166,13 +158,17 @@ subroutine basic_init 'reading values of increment ', restartInc, ' from file' flush(6) endif + + fileUnit = IO_open_jobFile_binary('F_aimDot') + read(fileUnit) F_aimDot; close(fileUnit) + write(rankStr,'(a1,i0)')'_',worldrank - call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F)) - read (777,rec=1) F; close (777) - call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc)) - read (777,rec=1) F_lastInc; close (777) - call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot)) - read (777,rec=1) F_aimDot; close (777) + + fileUnit = IO_open_jobFile_binary('F'//trim(rankStr)) + read(fileUnit) F; close (fileUnit) + fileUnit = IO_open_jobFile_binary('F_lastInc'//trim(rankStr)) + read(fileUnit) F_lastInc; close (fileUnit) + F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F call MPI_Allreduce(MPI_IN_PLACE,F_aim,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim') @@ -198,12 +194,12 @@ subroutine basic_init write(6,'(/,a,'//IO_intOut(restartInc)//',a)') & 'reading more values of increment ', restartInc, ' from file' flush(6) - call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) - read (777,rec=1) C_volAvg; close (777) - call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) - read (777,rec=1) C_volAvgLastInc; close (777) - call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg)) - read (777,rec=1) C_minMaxAvg; close (777) + fileUnit = IO_open_jobFile_binary('C_volAvg') + read(fileUnit) C_volAvg; close(fileUnit) + fileUnit = IO_open_jobFile_binary('C_volAvgLastInv') + read(fileUnit) C_volAvgLastInc; close(fileUnit) + fileUnit = IO_open_jobFile_binary('C_ref') + read(fileUnit) C_minMaxAvg; close(fileUnit) endif restartRead call Utilities_updateGamma(C_minMaxAvg,.true.) @@ -450,7 +446,7 @@ subroutine Basic_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,s tBoundaryCondition, & cutBack use IO, only: & - IO_write_JobRealFile + IO_open_jobFile_binary use FEsolving, only: & restartWrite @@ -468,7 +464,8 @@ subroutine Basic_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,s rotation_BC PetscErrorCode :: ierr PetscScalar, dimension(:,:,:,:), pointer :: F - + + integer :: fileUnit character(len=32) :: rankStr call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) @@ -483,20 +480,20 @@ subroutine Basic_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,s write(6,'(/,a)') ' writing converged results for restart' flush(6) - if (worldrank == 0_pInt) then - call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) - write (777,rec=1) C_volAvg; close(777) - call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) - write (777,rec=1) C_volAvgLastInc; close(777) - call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) - write (777,rec=1) F_aimDot; close(777) + if (worldrank == 0) then + fileUnit = IO_open_jobFile_binary('C_volAvg','w') + write(fileUnit) C_volAvg; close(fileUnit) + fileUnit = IO_open_jobFile_binary('C_volAvgLastInv','w') + write(fileUnit) C_volAvgLastInc; close(fileUnit) + fileUnit = IO_open_jobFile_binary('F_aimDot','w') + write(fileUnit) F_aimDot; close(fileUnit) endif write(rankStr,'(a1,i0)')'_',worldrank - call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file - write (777,rec=1) F; close (777) - call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_lastInc; close (777) + fileUnit = IO_open_jobFile_binary('F'//trim(rankStr),'w') + write(fileUnit) F; close (fileUnit) + fileUnit = IO_open_jobFile_binary('F_lastInc'//trim(rankStr),'w') + write(fileUnit) F_lastInc; close (fileUnit) endif call CPFEM_age() ! age state and kinematics diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index b1da2a3f0..3b613263f 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -80,16 +80,10 @@ contains !> @brief allocates all necessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine Polarisation_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use IO, only: & IO_intOut, & IO_error, & - IO_read_realFile, & - IO_timeStamp + IO_open_jobFile_binary use debug, only: & debug_level, & debug_spectral, & @@ -125,14 +119,12 @@ subroutine Polarisation_init F, & ! specific (sub)pointer F_tau ! specific (sub)pointer PetscInt, dimension(:), allocatable :: localK - integer(pInt) :: proc + integer :: proc, fileUnit character(len=1024) :: rankStr write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015' write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" !-------------------------------------------------------------------------------------------------- ! allocate global fields @@ -146,7 +138,7 @@ subroutine Polarisation_init call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize + do proc = 1, worldsize !ToDo: there are smarter options in MPI call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) enddo call DMDACreate3d(PETSC_COMM_WORLD, & @@ -173,23 +165,28 @@ subroutine Polarisation_init call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) ! places pointer on PETSc data F => FandF_tau( 0: 8,:,:,:) F_tau => FandF_tau( 9:17,:,:,:) - restart: if (restartInc > 0_pInt) then + restart: if (restartInc > 0) then if (iand(debug_level(debug_spectral),debug_spectralRestart) /= 0) then write(6,'(/,a,'//IO_intOut(restartInc)//',a)') & 'reading values of increment ', restartInc, ' from file' flush(6) endif + + fileUnit = IO_open_jobFile_binary('F_aimDot') + read(fileUnit) F_aimDot; close(fileUnit) + write(rankStr,'(a1,i0)')'_',worldrank - call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F)) - read (777,rec=1) F; close (777) - call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc)) - read (777,rec=1) F_lastInc; close (777) - call IO_read_realFile(777,'F_tau'//trim(rankStr),trim(getSolverJobName()),size(F_tau)) - read (777,rec=1) F_tau; close (777) - call IO_read_realFile(777,'F_tau_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_tau_lastInc)) - read (777,rec=1) F_tau_lastInc; close (777) - call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot)) - read (777,rec=1) F_aimDot; close (777) + + fileUnit = IO_open_jobFile_binary('F'//trim(rankStr)) + read(fileUnit) F; close (fileUnit) + fileUnit = IO_open_jobFile_binary('F_lastInc'//trim(rankStr)) + read(fileUnit) F_lastInc; close (fileUnit) + + fileUnit = IO_open_jobFile_binary('F_tau'//trim(rankStr)) + read(fileUnit) F_tau; close (fileUnit) + fileUnit = IO_open_jobFile_binary('F_tau_lastInc'//trim(rankStr)) + read(fileUnit) F_tau_lastInc; close (fileUnit) + F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F call MPI_Allreduce(MPI_IN_PLACE,F_aim,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim') @@ -218,12 +215,12 @@ subroutine Polarisation_init write(6,'(/,a,'//IO_intOut(restartInc)//',a)') & 'reading more values of increment ', restartInc, ' from file' flush(6) - call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) - read (777,rec=1) C_volAvg; close (777) - call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) - read (777,rec=1) C_volAvgLastInc; close (777) - call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg)) - read (777,rec=1) C_minMaxAvg; close (777) + fileUnit = IO_open_jobFile_binary('C_volAvg') + read(fileUnit) C_volAvg; close(fileUnit) + fileUnit = IO_open_jobFile_binary('C_volAvgLastInv') + read(fileUnit) C_volAvgLastInc; close(fileUnit) + fileUnit = IO_open_jobFile_binary('C_ref') + read(fileUnit) C_minMaxAvg; close(fileUnit) endif restartRead call Utilities_updateGamma(C_minMaxAvg,.true.) @@ -552,7 +549,7 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati tBoundaryCondition, & cutBack use IO, only: & - IO_write_JobRealFile + IO_open_jobFile_binary use FEsolving, only: & restartWrite @@ -572,6 +569,8 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati PetscScalar, dimension(:,:,:,:), pointer :: FandF_tau, F, F_tau integer(pInt) :: i, j, k real(pReal), dimension(3,3) :: F_lambda33 + + integer :: fileUnit character(len=32) :: rankStr !-------------------------------------------------------------------------------------------------- @@ -590,24 +589,25 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati write(6,'(/,a)') ' writing converged results for restart' flush(6) - if (worldrank == 0_pInt) then - call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) - write (777,rec=1) C_volAvg; close(777) - call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) - write (777,rec=1) C_volAvgLastInc; close(777) - call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) - write (777,rec=1) F_aimDot; close(777) + if (worldrank == 0) then + fileUnit = IO_open_jobFile_binary('C_volAvg','w') + write(fileUnit) C_volAvg; close(fileUnit) + fileUnit = IO_open_jobFile_binary('C_volAvgLastInv','w') + write(fileUnit) C_volAvgLastInc; close(fileUnit) + fileUnit = IO_open_jobFile_binary('F_aimDot','w') + write(fileUnit) F_aimDot; close(fileUnit) endif write(rankStr,'(a1,i0)')'_',worldrank - call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file - write (777,rec=1) F; close (777) - call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_lastInc; close (777) - call IO_write_jobRealFile(777,'F_tau'//trim(rankStr),size(F_tau)) ! writing deformation gradient field to file - write (777,rec=1) F_tau; close (777) - call IO_write_jobRealFile(777,'F_tau_lastInc'//trim(rankStr),size(F_tau_lastInc)) ! writing F_tau_lastInc field to file - write (777,rec=1) F_tau_lastInc; close (777) + fileUnit = IO_open_jobFile_binary('F'//trim(rankStr),'w') + write(fileUnit) F; close (fileUnit) + fileUnit = IO_open_jobFile_binary('F_lastInc'//trim(rankStr),'w') + write(fileUnit) F_lastInc; close (fileUnit) + + fileUnit = IO_open_jobFile_binary('F_tau'//trim(rankStr),'w') + write(fileUnit) F_tau; close (fileUnit) + fileUnit = IO_open_jobFile_binary('F_tau_lastInc'//trim(rankStr),'w') + write(fileUnit) F_tau_lastInc; close (fileUnit) endif call CPFEM_age() ! age state and kinematics @@ -618,6 +618,7 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati F_aimDot = merge(stress_BC%maskFloat*(F_aim-F_aim_lastInc)/timeinc_old, 0.0_pReal, guess) F_aim_lastInc = F_aim + !-------------------------------------------------------------------------------------------------- ! calculate rate for aim if (deformation_BC%myType=='l') then ! calculate F_aimDot from given L and current F diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 09bfd647a..b9d41b406 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -362,62 +362,64 @@ end subroutine utilities_init !> Also writes out the current reference stiffness for restart. !-------------------------------------------------------------------------------------------------- subroutine utilities_updateGamma(C,saveReference) - use IO, only: & - IO_write_jobRealFile - use numerics, only: & - memory_efficient, & - worldrank - use mesh, only: & - grid3Offset, & - grid3,& - grid - use math, only: & - math_det33, & - math_invert - - implicit none - real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness - logical , intent(in) :: saveReference !< save reference stiffness to file for restart - complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx - real(pReal), dimension(6,6) :: matA, matInvA - integer(pInt) :: & - i, j, k, & - l, m, n, o - logical :: err - - C_ref = C - if (saveReference) then - if (worldrank == 0_pInt) then - write(6,'(/,a)') ' writing reference stiffness to file' - flush(6) - call IO_write_jobRealFile(777,'C_ref',size(C_ref)) - write (777,rec=1) C_ref; close(777) - endif - endif - - if(.not. memory_efficient) then - gamma_hat = cmplx(0.0_pReal,0.0_pReal,pReal) ! for the singular point and any non invertible A - do k = grid3Offset+1_pInt, grid3Offset+grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid1Red - if (any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k-grid3Offset))*xi1st(m,i,j,k-grid3Offset) - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - temp33_complex(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx) - matA(1:3,1:3) = real(temp33_complex); matA(4:6,4:6) = real(temp33_complex) - matA(1:3,4:6) = aimag(temp33_complex); matA(4:6,1:3) = -aimag(temp33_complex) - if (abs(math_det33(matA(1:3,1:3))) > 1e-16) then - call math_invert(6_pInt, matA, matInvA, err) - temp33_complex = cmplx(matInvA(1:3,1:3),matInvA(1:3,4:6),pReal) - forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt) & - gamma_hat(l,m,n,o,i,j,k-grid3Offset) = temp33_complex(l,n)* & + use IO, only: & + IO_open_jobFile_binary + use numerics, only: & + memory_efficient, & + worldrank + use mesh, only: & + grid3Offset, & + grid3,& + grid + use math, only: & + math_det33, & + math_invert2 + + implicit none + real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness + logical , intent(in) :: saveReference !< save reference stiffness to file for restart + complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx + real(pReal), dimension(6,6) :: A, A_inv + integer :: & + i, j, k, & + l, m, n, o, & + fileUnit + logical :: err + + C_ref = C + if (saveReference) then + if (worldrank == 0_pInt) then + write(6,'(/,a)') ' writing reference stiffness to file' + flush(6) + fileUnit = IO_open_jobFile_binary('C_ref','w') + write(fileUnit) C_ref; close(fileUnit) + endif + endif + + if(.not. memory_efficient) then + gamma_hat = cmplx(0.0_pReal,0.0_pReal,pReal) ! for the singular point and any non invertible A + do k = grid3Offset+1, grid3Offset+grid3; do j = 1, grid(2); do i = 1, grid1Red + if (any([i,j,k] /= 1)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 + forall(l = 1:3, m = 1:3) & + xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k-grid3Offset))*xi1st(m,i,j,k-grid3Offset) + forall(l = 1:3, m = 1:3) & + temp33_complex(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx) + A(1:3,1:3) = real(temp33_complex); A(4:6,4:6) = real(temp33_complex) + A(1:3,4:6) = aimag(temp33_complex); A(4:6,1:3) = -aimag(temp33_complex) + if (abs(math_det33(A(1:3,1:3))) > 1e-16) then + call math_invert2(A_inv, err, A) + temp33_complex = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal) + forall(l=1:3, m=1:3, n=1:3, o=1:3) & + gamma_hat(l,m,n,o,i,j,k-grid3Offset) = temp33_complex(l,n)* & conjg(-xi1st(o,i,j,k-grid3Offset))*xi1st(m,i,j,k-grid3Offset) - endif - endif - enddo; enddo; enddo - endif - + endif + endif + enddo; enddo; enddo + endif + end subroutine utilities_updateGamma + !-------------------------------------------------------------------------------------------------- !> @brief forward FFT of data in field_real to field_fourier !> @details Does an unweighted filtered FFT transform from real to complex From 2621689843f9d20819bc795aa4908b699274ab6f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 08:01:20 +0100 Subject: [PATCH 27/67] correct initialization --- src/damage_nonlocal.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index c702d1a03..119a1a4e3 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -90,7 +90,7 @@ subroutine damage_nonlocal_init associate(prm => param(damage_typeInstance(h)), & config => config_homogenization(h)) - + instance = damage_typeInstance(h) outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) @@ -107,7 +107,6 @@ subroutine damage_nonlocal_init enddo - homog = h NofMyHomog = count(material_homog == homog) From ae5ea87ab1a199b39dfef205fa5d2b0a38011583 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Mar 2019 23:23:07 +0100 Subject: [PATCH 28/67] cleaning --- src/FEM_utilities.f90 | 12 ++---------- src/mesh_grid.f90 | 1 - src/spectral_utilities.f90 | 3 +-- 3 files changed, 3 insertions(+), 13 deletions(-) diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 2087054bd..82ca4c869 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -127,14 +127,6 @@ contains !> @brief allocates all neccessary fields, sets debug flags !-------------------------------------------------------------------------------------------------- subroutine utilities_init() - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) - use DAMASK_interface, only: & - getSolverJobName - use IO, only: & - IO_error, & - IO_warning, & - IO_timeStamp, & - IO_open_file use numerics, only: & structOrder, & integrationOrder, & @@ -167,8 +159,6 @@ subroutine utilities_init() PetscErrorCode :: ierr write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" !-------------------------------------------------------------------------------------------------- ! set debugging parameters @@ -287,6 +277,7 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) end subroutine utilities_constitutiveResponse + !-------------------------------------------------------------------------------------------------- !> @brief Create index sets of boundary dofs (in local and global numbering) !-------------------------------------------------------------------------------------------------- @@ -377,6 +368,7 @@ subroutine utilities_indexBoundaryDofs(dm_local,nFaceSets,numFields,local2global end subroutine utilities_indexBoundaryDofs + !-------------------------------------------------------------------------------------------------- !> @brief Project BC values to local vector !-------------------------------------------------------------------------------------------------- diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 6235e4c1d..84acba931 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -175,7 +175,6 @@ subroutine mesh_init(ip,el) use DAMASK_interface use IO, only: & - IO_open_file, & IO_error use debug, only: & debug_e, & diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index b9d41b406..972083d59 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -152,8 +152,7 @@ contains subroutine utilities_init() use IO, only: & IO_error, & - IO_warning, & - IO_open_file + IO_warning use numerics, only: & spectral_derivative, & fftw_planner_flag, & From 02c7b1056aafb23ec4ce034068cba9611d18cc91 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 00:07:57 +0100 Subject: [PATCH 29/67] use central functionality IO function reads numerics.config and debug.config --- src/IO.f90 | 185 ++++++++++++++++++++++------------------------- src/debug.f90 | 42 ++++------- src/numerics.f90 | 35 ++++----- 3 files changed, 116 insertions(+), 146 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 9f9c71ae4..99c92e038 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -21,9 +21,8 @@ module IO '────────────' public :: & IO_init, & - IO_read, & + IO_read_ASCII, & IO_recursiveRead, & - IO_open_file_stat, & IO_open_file, & IO_open_jobFile_binary, & IO_write_jobFile, & @@ -66,87 +65,95 @@ contains ! ToDo: needed? !-------------------------------------------------------------------------------------------------- subroutine IO_init - - implicit none - - write(6,'(/,a)') ' <<<+- IO init -+>>>' - + + implicit none + + write(6,'(/,a)') ' <<<+- IO init -+>>>' + end subroutine IO_init !-------------------------------------------------------------------------------------------------- -!> @brief recursively reads a line from a text file. -!! Recursion is triggered by "{path/to/inputfile}" in a line -!> @details unstable and buggy +!> @brief reads a line from a text file. !-------------------------------------------------------------------------------------------------- -recursive function IO_read(fileUnit,reset) result(line) -!ToDo: remove recursion once material.config handling is done fully via config module - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - logical, intent(in), optional :: reset - - integer(pInt), dimension(10) :: unitOn = 0_pInt ! save the stack of recursive file units - integer(pInt) :: stack = 1_pInt ! current stack position - character(len=8192), dimension(10) :: pathOn = '' - character(len=512) :: path,input - integer(pInt) :: myStat - character(len=65536) :: line - - character(len=*), parameter :: SEP = achar(47)//achar(92) ! forward and backward slash ("/", "\") - -!-------------------------------------------------------------------------------------------------- -! reset case - if(present(reset)) then; if (reset) then ! do not short circuit here - do while (stack > 1_pInt) ! can go back to former file - close(unitOn(stack)) - stack = stack-1_pInt - enddo - return - endif; endif +function IO_read(fileUnit) result(line) + use prec, only: & + pStringLen + + implicit none + integer, intent(in) :: fileUnit !< file unit + + character(len=pStringLen) :: line + + + read(fileUnit,'(a256)',END=100) line + +100 end function IO_read !-------------------------------------------------------------------------------------------------- -! read from file - unitOn(1) = fileUnit +!> @brief reads an entire ASCII file into an array +!-------------------------------------------------------------------------------------------------- +function IO_read_ASCII(fileName) result(fileContent) + use prec, only: & + pStringLen + implicit none + character(len=*), intent(in) :: fileName - read(unitOn(stack),'(a65536)',END=100) line - - input = IO_getTag(line,'{','}') + character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines + character(len=pStringLen) :: line + character(len=:), allocatable :: rawData + integer :: & + fileLength, & + fileUnit, & + startPos, endPos, & + myTotalLines, & !< # lines read from file + l, & + myStat + logical :: warned + +!-------------------------------------------------------------------------------------------------- +! read data as stream + inquire(file = fileName, size=fileLength) + open(newunit=fileUnit, file=fileName, access='stream',& + status='old', position='rewind', action='read',iostat=myStat) + if(myStat /= 0) call IO_error(100,ext_msg=trim(fileName)) + allocate(character(len=fileLength)::rawData) + read(fileUnit) rawData + close(fileUnit) !-------------------------------------------------------------------------------------------------- -! normal case - if (input == '') return ! regular line +! count lines to allocate string array + myTotalLines = 1 + do l=1, len(rawData) + if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1 + enddo + allocate(fileContent(myTotalLines)) !-------------------------------------------------------------------------------------------------- -! recursion case - if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached +! split raw data at end of line + warned = .false. + startPos = 1 + l = 1 + do while (l <= myTotalLines) + endPos = merge(startPos + scan(rawData(startPos:),new_line('')) - 2,len(rawData),l /= myTotalLines) + if (endPos - startPos > pStringLen-1) then + line = rawData(startPos:startPos+pStringLen-1) + if (.not. warned) then + call IO_warning(207,ext_msg=trim(fileName),el=l) + warned = .true. + endif + else + line = rawData(startPos:endpos) + endif + startPos = endPos + 2 ! jump to next line start - inquire(UNIT=unitOn(stack),NAME=path) ! path of current file - stack = stack+1_pInt - if(scan(input,SEP) == 1) then ! absolut path given (UNIX only) - pathOn(stack) = input - else - pathOn(stack) = path(1:scan(path,SEP,.true.))//input ! glue include to current file's dir - endif + fileContent(l) = line + l = l + 1 - open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read',status='old',position='rewind') ! open included file - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack)) + enddo - line = IO_read(fileUnit) - - return - -!-------------------------------------------------------------------------------------------------- -! end of file case -100 if (stack > 1_pInt) then ! can go back to former file - close(unitOn(stack)) - stack = stack-1_pInt - line = IO_read(fileUnit) - else ! top-most file reached - line = IO_EOF - endif - -end function IO_read +end function IO_read_ASCII !-------------------------------------------------------------------------------------------------- @@ -227,23 +234,22 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent) end function IO_recursiveRead + !-------------------------------------------------------------------------------------------------- !> @brief opens existing file for reading to given unit. Path to file is relative to working !! directory -!> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return -!! value !-------------------------------------------------------------------------------------------------- subroutine IO_open_file(fileUnit,path) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: path !< relative path from working directory - - integer(pInt) :: myStat - - open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + + implicit none + integer, intent(in) :: fileUnit !< file unit + character(len=*), intent(in) :: path !< relative path from working directory + + integer :: myStat + + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) + end subroutine IO_open_file @@ -302,27 +308,6 @@ integer function IO_open_binary(fileName,mode) end function IO_open_binary -!-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. Path to file is relative to working -!! directory -!> @details Like IO_open_file, but error is handled via return value and not via call to IO_error -!-------------------------------------------------------------------------------------------------- -logical function IO_open_file_stat(fileUnit,path) -!ToDo: DEPRECATED once material.config handling is done fully via config module - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: path !< relative path from working directory - - integer(pInt) :: myStat - - open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') - if (myStat /= 0_pInt) close(fileUnit) - IO_open_file_stat = (myStat == 0_pInt) - -end function IO_open_file_stat - - - #if defined(Marc4DAMASK) || defined(Abaqus) !-------------------------------------------------------------------------------------------------- !> @brief opens FEM input file for reading located in current working directory to given unit diff --git a/src/debug.f90 b/src/debug.f90 index 7dcc018d3..4f9566c05 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -63,9 +63,6 @@ module debug debug_jacobianMax = -huge(1.0_pReal), & debug_jacobianMin = huge(1.0_pReal) - character(len=64), parameter, private :: & - debug_CONFIGFILE = 'debug.config' !< name of configuration file - #ifdef PETSc character(len=1024), parameter, public :: & PETSCDEBUG = ' -snes_view -snes_monitor ' @@ -81,46 +78,38 @@ contains !> @brief reads in parameters from debug.config and allocates arrays !-------------------------------------------------------------------------------------------------- subroutine debug_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - + use prec, only: & + pStringLen use IO, only: & - IO_read, & + IO_read_ASCII, & IO_error, & - IO_open_file_stat, & IO_isBlank, & IO_stringPos, & IO_stringValue, & IO_lc, & IO_floatValue, & - IO_intValue, & - IO_timeStamp, & - IO_EOF + IO_intValue implicit none - integer(pInt), parameter :: FILEUNIT = 330_pInt + character(len=pStringLen), dimension(:), allocatable :: fileContent - integer(pInt) :: i, what - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: tag, line + integer :: i, what, j + integer, allocatable, dimension(:) :: chunkPos + character(len=pStringLen) :: tag, line + logical :: fexist write(6,'(/,a)') ' <<<+- debug init -+>>>' #ifdef DEBUG write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m' #endif - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" -!-------------------------------------------------------------------------------------------------- -! try to open the config file - line = '' - fileExists: if(IO_open_file_stat(FILEUNIT,debug_configFile)) then - do while (trim(line) /= IO_EOF) ! read thru sections of phase part - line = IO_read(FILEUNIT) + inquire(file='debug.config', exist=fexist) + + fileExists: if (fexist) then + fileContent = IO_read_ASCII('debug.config') + do j=1, size(fileContent) + line = fileContent(j) if (IO_isBlank(line)) cycle ! skip empty lines chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key @@ -189,7 +178,6 @@ subroutine debug_init enddo endif enddo - close(FILEUNIT) do i = 1_pInt, debug_maxNtype if (debug_level(i) == 0) & diff --git a/src/numerics.f90 b/src/numerics.f90 index 1d0102cd9..bbe4f856c 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -10,8 +10,6 @@ module numerics implicit none private - character(len=64), parameter, private :: & - numerics_CONFIGFILE = 'numerics.config' !< name of configuration file integer(pInt), protected, public :: & iJacoStiffness = 1_pInt, & !< frequency of stiffness update @@ -143,32 +141,32 @@ contains ! a sanity check !-------------------------------------------------------------------------------------------------- subroutine numerics_init + use prec, only: & + pStringLen use IO, only: & - IO_read, & + IO_read_ASCII, & IO_error, & - IO_open_file_stat, & IO_isBlank, & IO_stringPos, & IO_stringValue, & IO_lc, & IO_floatValue, & IO_intValue, & - IO_warning, & - IO_timeStamp, & - IO_EOF + IO_warning #ifdef PETSc #include use petscsys #endif !$ use OMP_LIB, only: omp_set_num_threads implicit none - integer(pInt), parameter :: FILEUNIT = 300_pInt !$ integer :: gotDAMASK_NUM_THREADS = 1 - integer :: i, ierr ! no pInt + integer :: i,j, ierr ! no pInt integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: & + character(len=pStringLen), dimension(:), allocatable :: fileContent + character(len=pStringLen) :: & tag ,& line + logical :: fexist !$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS #ifdef PETSc @@ -186,18 +184,18 @@ subroutine numerics_init !$ if (DAMASK_NumThreadsInt < 1_4) DAMASK_NumThreadsInt = 1_4 ! in case of string conversion fails, set it to one !$ endif !$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution - -!-------------------------------------------------------------------------------------------------- -! try to open the config file - fileExists: if(IO_open_file_stat(FILEUNIT,numerics_configFile)) then + + inquire(file='numerics.config', exist=fexist) + + fileExists: if (fexist) then write(6,'(a,/)') ' using values from config file' flush(6) - + fileContent = IO_read_ASCII('numerics.config') + do j=1, size(fileContent) + !-------------------------------------------------------------------------------------------------- ! read variables from config file and overwrite default parameters if keyword is present - line = '' - do while (trim(line) /= IO_EOF) ! read thru sections of phase part - line = IO_read(FILEUNIT) + line = fileContent(j) do i=1,len(line) if(line(i:i) == '=') line(i:i) = ' ' ! also allow keyword = value version enddo @@ -385,7 +383,6 @@ subroutine numerics_init call IO_error(300_pInt,ext_msg=tag) end select enddo - close(FILEUNIT) else fileExists write(6,'(a,/)') ' using standard values' From 2394880741bc66f190f5987e01283226fe97041e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 00:33:11 +0100 Subject: [PATCH 30/67] Tstar renamed to S (following the DAMASK paper) --- src/CPFEM.f90 | 18 ++++---- src/CPFEM2.f90 | 13 +++--- src/crystallite.f90 | 84 ++++++++++++++------------------------ src/homogenization.f90 | 18 ++++---- src/thermal_adiabatic.f90 | 6 +-- src/thermal_conduction.f90 | 6 +-- 6 files changed, 58 insertions(+), 87 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index ebbf705aa..42c41c50c 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -142,7 +142,7 @@ subroutine CPFEM_init crystallite_Lp0, & crystallite_Fi0, & crystallite_Li0, & - crystallite_Tstar0_v + crystallite_S0 implicit none integer :: k,l,m,ph,homog @@ -300,8 +300,8 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt crystallite_Li0, & crystallite_Li, & crystallite_dPdF, & - crystallite_Tstar0_v, & - crystallite_Tstar_v + crystallite_S0, & + crystallite_S use homogenization, only: & materialpoint_F, & materialpoint_F0, & @@ -363,12 +363,12 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt !*** age results and write restart data if requested if (iand(mode, CPFEM_AGERESULTS) /= 0_pInt) then - crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...) - crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation - crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity - crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation - crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity - crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress + crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...) + crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation + crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity + crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation + crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity + crystallite_S0 = crystallite_S ! crystallite 2nd Piola Kirchhoff stress forall ( i = 1:size(plasticState )) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array do i = 1, size(sourceState) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index e44822089..9e4628e0e 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -114,7 +114,7 @@ subroutine CPFEM_init crystallite_Lp0, & crystallite_Fi0, & crystallite_Li0, & - crystallite_Tstar0_v + crystallite_S0 use hdf5 use HDF5_utilities, only: & HDF5_openFile, & @@ -150,7 +150,7 @@ subroutine CPFEM_init call HDF5_read(fileHandle,crystallite_Fi0, 'convergedFi') call HDF5_read(fileHandle,crystallite_Lp0, 'convergedLp') call HDF5_read(fileHandle,crystallite_Li0, 'convergedLi') - call HDF5_read(fileHandle,crystallite_Tstar0_v,'convergedTstar') + call HDF5_read(fileHandle,crystallite_S0, 'convergedS') groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases') do ph = 1_pInt,size(phase_plasticity) @@ -213,9 +213,8 @@ subroutine CPFEM_age() crystallite_Lp, & crystallite_Li0, & crystallite_Li, & - crystallite_dPdF, & - crystallite_Tstar0_v, & - crystallite_Tstar_v + crystallite_S0, & + crystallite_S use HDF5_utilities, only: & HDF5_openFile, & HDF5_closeFile, & @@ -239,7 +238,7 @@ subroutine CPFEM_age() crystallite_Lp0 = crystallite_Lp crystallite_Fi0 = crystallite_Fi crystallite_Li0 = crystallite_Li - crystallite_Tstar0_v = crystallite_Tstar_v + crystallite_S0 = crystallite_S forall (i = 1:size(plasticState)) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array @@ -267,7 +266,7 @@ subroutine CPFEM_age() call HDF5_write(fileHandle,crystallite_Fi0, 'convergedFi') call HDF5_write(fileHandle,crystallite_Lp0, 'convergedLp') call HDF5_write(fileHandle,crystallite_Li0, 'convergedLi') - call HDF5_write(fileHandle,crystallite_Tstar0_v,'convergedTstar') + call HDF5_write(fileHandle,crystallite_S0, 'convergedS') groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases') do ph = 1_pInt,size(phase_plasticity) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index dbb3484d8..5cbd692db 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -38,17 +38,16 @@ module crystallite crystallite_subdt, & !< substepped time increment of each grain crystallite_subFrac, & !< already calculated fraction of increment crystallite_subStep !< size of next integration step - real(pReal), dimension(:,:,:,:), allocatable, public :: & - crystallite_Tstar_v, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) ToDo: Should be called S, 3x3 - crystallite_Tstar0_v, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc ToDo: Should be called S, 3x3 - crystallite_partionedTstar0_v !< 2nd Piola-Kirchhoff stress vector at start of homog inc ToDo: Should be called S, 3x3 - type(rotation), dimension(:,:,:), allocatable, private :: & + type(rotation), dimension(:,:,:), allocatable, private :: & crystallite_orientation, & !< orientation crystallite_orientation0 !< initial orientation real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & crystallite_Fe, & !< current "elastic" def grad (end of converged time step) crystallite_P !< 1st Piola-Kirchhoff stress per grain real(pReal), dimension(:,:,:,:,:), allocatable, public :: & + crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) + crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc + crystallite_partionedS0, & !< 2nd Piola-Kirchhoff stress vector at start of homog inc crystallite_Fp, & !< current plastic def grad (end of converged time step) crystallite_Fp0, & !< plastic def grad at start of FE inc crystallite_partionedFp0,& !< plastic def grad at start of homog inc @@ -130,11 +129,6 @@ contains !> @brief allocates and initialize per grain variables !-------------------------------------------------------------------------------------------------- subroutine crystallite_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif #ifdef DEBUG use debug, only: & debug_info, & @@ -156,7 +150,6 @@ subroutine crystallite_init theMesh, & mesh_element use IO, only: & - IO_timeStamp, & IO_stringValue, & IO_write_jobFile, & IO_error @@ -188,20 +181,14 @@ subroutine crystallite_init character(len=65536), dimension(:), allocatable :: str write(6,'(/,a)') ' <<<+- crystallite init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" cMax = homogenization_maxNgrains iMax = theMesh%elem%nIPs eMax = theMesh%nElems -! --------------------------------------------------------------------------- -! ToDo (when working on homogenization): should be 3x3 tensor called S - allocate(crystallite_Tstar0_v(6,cMax,iMax,eMax), source=0.0_pReal) - allocate(crystallite_partionedTstar0_v(6,cMax,iMax,eMax), source=0.0_pReal) - allocate(crystallite_Tstar_v(6,cMax,iMax,eMax), source=0.0_pReal) -! --------------------------------------------------------------------------- - + allocate(crystallite_S0(3,3,cMax,iMax,eMax), source=0.0_pReal) + allocate(crystallite_partionedS0(3,3,cMax,iMax,eMax), source=0.0_pReal) + allocate(crystallite_S(3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_subS0(3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_P(3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_F0(3,3,cMax,iMax,eMax), source=0.0_pReal) @@ -295,7 +282,7 @@ subroutine crystallite_init crystallite_outputID(o,c) = lp_ID case ('li') outputName crystallite_outputID(o,c) = li_ID - case ('p','firstpiola','1stpiola') outputName + case ('p','firstpiola','1stpiola') outputName ! ToDo: no alias (p only) crystallite_outputID(o,c) = p_ID case ('s','tstar','secondpiola','2ndpiola') outputName ! ToDo: no alias (s only) crystallite_outputID(o,c) = s_ID @@ -444,9 +431,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) IO_error use math, only: & math_inv33, & - math_mul33x33, & - math_6toSym33, & - math_sym33to6 + math_mul33x33 use mesh, only: & theMesh, & mesh_element @@ -511,7 +496,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_partionedFi0(1:3,1:3,c,i,e) crystallite_subLi0(1:3,1:3,c,i,e) = crystallite_partionedLi0(1:3,1:3,c,i,e) crystallite_subF0(1:3,1:3,c,i,e) = crystallite_partionedF0(1:3,1:3,c,i,e) - crystallite_subS0(1:3,1:3,c,i,e) = math_6toSym33(crystallite_partionedTstar0_v(1:6,c,i,e)) + crystallite_subS0(1:3,1:3,c,i,e) = crystallite_partionedS0(1:3,1:3,c,i,e) crystallite_subFrac(c,i,e) = 0.0_pReal crystallite_subStep(c,i,e) = 1.0_pReal/subStepSizeCryst crystallite_todo(c,i,e) = .true. @@ -557,7 +542,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) crystallite_subLi0(1:3,1:3,c,i,e) = crystallite_Li (1:3,1:3,c,i,e) crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_Fi (1:3,1:3,c,i,e) - crystallite_subS0 (1:3,1:3,c,i,e) = math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)) + crystallite_subS0 (1:3,1:3,c,i,e) = crystallite_S (1:3,1:3,c,i,e) !if abbrevation, make c and p private in omp plasticState( phaseAt(c,i,e))%subState0(:,phasememberAt(c,i,e)) & = plasticState(phaseAt(c,i,e))%state( :,phasememberAt(c,i,e)) @@ -583,7 +568,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) crystallite_invFp(1:3,1:3,c,i,e) = math_inv33(crystallite_Fp (1:3,1:3,c,i,e)) crystallite_Fi (1:3,1:3,c,i,e) = crystallite_subFi0(1:3,1:3,c,i,e) crystallite_invFi(1:3,1:3,c,i,e) = math_inv33(crystallite_Fi (1:3,1:3,c,i,e)) - crystallite_Tstar_v(1:6,c,i,e) = math_sym33to6(crystallite_subS0(1:3,1:3,c,i,e)) + crystallite_S (1:3,1:3,c,i,e) = crystallite_S0 (1:3,1:3,c,i,e) if (crystallite_subStep(c,i,e) < 1.0_pReal) then ! actual (not initial) cutback crystallite_Lp (1:3,1:3,c,i,e) = crystallite_subLp0(1:3,1:3,c,i,e) crystallite_Li (1:3,1:3,c,i,e) = crystallite_subLi0(1:3,1:3,c,i,e) @@ -707,7 +692,6 @@ subroutine crystallite_stressTangent() math_inv33, & math_identity2nd, & math_mul33x33, & - math_6toSym33, & math_3333to99, & math_99to3333, & math_I3, & @@ -758,7 +742,7 @@ subroutine crystallite_stressTangent() crystallite_Fe(1:3,1:3,c,i,e), & crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate elastic stress tangent call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & - math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & + crystallite_S (1:3,1:3,c,i,e), & crystallite_Fi(1:3,1:3,c,i,e), & c,i,e) ! call constitutive law to calculate Li tangent in lattice configuration @@ -787,7 +771,7 @@ subroutine crystallite_stressTangent() endif call constitutive_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & + crystallite_S (1:3,1:3,c,i,e), & crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS @@ -832,15 +816,15 @@ subroutine crystallite_stressTangent() !-------------------------------------------------------------------------------------------------- ! assemble dPdF temp_33_1 = math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), & - math_mul33x33(math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & + math_mul33x33(crystallite_S(1:3,1:3,c,i,e), & transpose(crystallite_invFp(1:3,1:3,c,i,e)))) - temp_33_2 = math_mul33x33(math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & + temp_33_2 = math_mul33x33(crystallite_S(1:3,1:3,c,i,e), & transpose(crystallite_invFp(1:3,1:3,c,i,e))) temp_33_3 = math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), & crystallite_invFp(1:3,1:3,c,i,e)) temp_33_4 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), & crystallite_invFp(1:3,1:3,c,i,e)), & - math_6toSym33(crystallite_Tstar_v(1:6,c,i,e))) + crystallite_S(1:3,1:3,c,i,e)) crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal do p=1_pInt, 3_pInt @@ -943,8 +927,7 @@ function crystallite_postResults(ipc, ip, el) math_mul33x33, & math_det33, & math_I3, & - inDeg, & - math_6toSym33 + inDeg use mesh, only: & theMesh, & mesh_element, & @@ -1048,7 +1031,7 @@ function crystallite_postResults(ipc, ip, el) case (s_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & - reshape(math_6toSym33(crystallite_Tstar_v(1:6,ipc,ip,el)),[mySize]) + reshape(crystallite_S(1:3,1:3,ipc,ip,el),[mySize]) case (elasmatrix_ID) mySize = 36_pInt crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize]) @@ -1070,7 +1053,7 @@ function crystallite_postResults(ipc, ip, el) c = c + 1_pInt if (size(crystallite_postResults)-c > 0_pInt) & crystallite_postResults(c+1:size(crystallite_postResults)) = & - constitutive_postResults(math_6toSym33(crystallite_Tstar_v(1:6,ipc,ip,el)), crystallite_Fi(1:3,1:3,ipc,ip,el), & + constitutive_postResults(crystallite_S(1:3,1:3,ipc,ip,el), crystallite_Fi(1:3,1:3,ipc,ip,el), & ipc, ip, el) end function crystallite_postResults @@ -1117,7 +1100,6 @@ logical function integrateStress(& math_det33, & math_I3, & math_identity2nd, & - math_sym33to6, & math_3333to99, & math_33to9, & math_9to33 @@ -1487,7 +1469,7 @@ logical function integrateStress(& integrateStress = .true. crystallite_P (1:3,1:3,ipc,ip,el) = math_mul33x33(math_mul33x33(Fg_new,invFp_new), & math_mul33x33(S,transpose(invFp_new))) - crystallite_Tstar_v (1:6,ipc,ip,el) = math_sym33to6(S) + crystallite_S (1:3,1:3,ipc,ip,el) = S crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess crystallite_Li (1:3,1:3,ipc,ip,el) = Liguess crystallite_Fp (1:3,1:3,ipc,ip,el) = Fp_new @@ -2279,8 +2261,6 @@ end subroutine update_state subroutine update_dotState(timeFraction) use, intrinsic :: & IEEE_arithmetic - use math, only: & - math_6toSym33 !ToDo: Temporarly needed until T_star_v is called S and stored as matrix use material, only: & plasticState, & sourceState, & @@ -2313,7 +2293,7 @@ subroutine update_dotState(timeFraction) do g = 1,homogenization_Ngrains(mesh_element(3,e)) !$OMP FLUSH(nonlocalStop) if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then - call constitutive_collectDotState(math_6toSym33(crystallite_Tstar_v(1:6,g,i,e)), & + call constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & crystallite_Fe, & crystallite_Fi(1:3,1:3,g,i,e), & crystallite_Fp, & @@ -2350,8 +2330,6 @@ subroutine update_deltaState phaseAt, phasememberAt use constitutive, only: & constitutive_collectDeltaState - use math, only: & - math_6toSym33 implicit none integer(pInt) :: & e, & !< element index in element loop @@ -2374,10 +2352,10 @@ subroutine update_deltaState do g = 1,homogenization_Ngrains(mesh_element(3,e)) !$OMP FLUSH(nonlocalStop) if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then - call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,g,i,e)), & - crystallite_Fe(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e), & - g,i,e) + call constitutive_collectDeltaState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_Fe(1:3,1:3,g,i,e), & + crystallite_Fi(1:3,1:3,g,i,e), & + g,i,e) p = phaseAt(g,i,e); c = phasememberAt(g,i,e) myOffset = plasticState(p)%offsetDeltaState mySize = plasticState(p)%sizeDeltaState @@ -2440,8 +2418,6 @@ logical function stateJump(ipc,ip,el) mesh_element use constitutive, only: & constitutive_collectDeltaState - use math, only: & - math_6toSym33 implicit none integer(pInt), intent(in):: & @@ -2459,10 +2435,10 @@ logical function stateJump(ipc,ip,el) c = phasememberAt(ipc,ip,el) p = phaseAt(ipc,ip,el) - call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,ipc,ip,el)), & - crystallite_Fe(1:3,1:3,ipc,ip,el), & - crystallite_Fi(1:3,1:3,ipc,ip,el), & - ipc,ip,el) + call constitutive_collectDeltaState(crystallite_S(1:3,1:3,ipc,ip,el), & + crystallite_Fe(1:3,1:3,ipc,ip,el), & + crystallite_Fi(1:3,1:3,ipc,ip,el), & + ipc,ip,el) myOffset = plasticState(p)%offsetDeltaState mySize = plasticState(p)%sizeDeltaState diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 7e16dd41f..556663ad0 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -315,15 +315,15 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_Lp, & crystallite_Li0, & crystallite_Li, & - crystallite_Tstar0_v, & - crystallite_Tstar_v, & + crystallite_S0, & + crystallite_S, & crystallite_partionedF0, & crystallite_partionedF, & crystallite_partionedFp0, & crystallite_partionedLp0, & crystallite_partionedFi0, & crystallite_partionedLi0, & - crystallite_partionedTstar0_v, & + crystallite_partionedS0, & crystallite_dt, & crystallite_requested, & crystallite_stress, & @@ -380,8 +380,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) ! ...plastic velocity grads crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e) ! ...intermediate def grads crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e) ! ...intermediate velocity grads - crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) ! ...def grads - crystallite_partionedTstar0_v(1:6,g,i,e) = crystallite_Tstar0_v(1:6,g,i,e) ! ...2nd PK stress + crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) ! ...def grads + crystallite_partionedS0(1:3,1:3,g,i,e) = crystallite_S0(1:3,1:3,g,i,e) ! ...2nd PK stress enddo; enddo forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e)) @@ -449,8 +449,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) = & crystallite_Li(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads - crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) = & - crystallite_Tstar_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress + crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) = & + crystallite_S(1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress do g = 1,myNgrains plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & @@ -512,8 +512,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads crystallite_Li(1:3,1:3,1:myNgrains,i,e) = & crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads - crystallite_Tstar_v(1:6,1:myNgrains,i,e) = & - crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress + crystallite_S(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress do g = 1, myNgrains plasticState (phaseAt(g,i,e))%state( :,phasememberAt(g,i,e)) = & plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index c3290bdfe..0ba08de97 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -164,8 +164,6 @@ end function thermal_adiabatic_updateState !> @brief returns heat generation rate !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - use math, only: & - math_6toSym33 use material, only: & homogenization_Ngrains, & mappingHomogenization, & @@ -181,7 +179,7 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) use source_thermal_externalheat, only: & source_thermal_externalheat_getRateAndItsTangent use crystallite, only: & - crystallite_Tstar_v, & + crystallite_S, & crystallite_Lp implicit none @@ -214,7 +212,7 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) select case(phase_source(source,phase)) case (SOURCE_thermal_dissipation_ID) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - math_6toSym33(crystallite_Tstar_v(1:6,grain,ip,el)), & + crystallite_S(1:3,1:3,grain,ip,el), & crystallite_Lp(1:3,1:3,grain,ip,el), & phase) diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 88da0529b..461eae470 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -119,8 +119,6 @@ end subroutine thermal_conduction_init !> @brief returns heat generation rate !-------------------------------------------------------------------------------------------------- subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - use math, only: & - math_6toSym33 use material, only: & homogenization_Ngrains, & mappingHomogenization, & @@ -136,7 +134,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) use source_thermal_externalheat, only: & source_thermal_externalheat_getRateAndItsTangent use crystallite, only: & - crystallite_Tstar_v, & + crystallite_S, & crystallite_Lp implicit none @@ -171,7 +169,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) select case(phase_source(source,phase)) case (SOURCE_thermal_dissipation_ID) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - math_6toSym33(crystallite_Tstar_v(1:6,grain,ip,el)), & + crystallite_S(1:3,1:3,grain,ip,el), & crystallite_Lp(1:3,1:3,grain,ip,el), & phase) From 60feb96afdf62b9be069e56d4b76aa61ec704921 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 00:40:50 +0100 Subject: [PATCH 31/67] let vtk decide on the file extension --- processing/post/vtk_addGridData.py | 3 +-- processing/post/vtk_addPointCloudData.py | 3 +-- processing/post/vtk_addRectilinearGridData.py | 3 +-- 3 files changed, 3 insertions(+), 6 deletions(-) diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py index 34f01e7bf..5ed50b60e 100755 --- a/processing/post/vtk_addGridData.py +++ b/processing/post/vtk_addGridData.py @@ -67,7 +67,6 @@ elif vtk_ext == '.vtk': reader.Update() rGrid = reader.GetRectilinearGridOutput() writer = vtk.vtkXMLRectilinearGridWriter() - vtk_ext = '.vtr' elif vtk_ext == '.vtu': reader = vtk.vtkXMLUnstructuredGridReader() reader.SetFileName(options.vtk) @@ -77,7 +76,7 @@ elif vtk_ext == '.vtu': else: parser.error('Unsupported VTK file type extension.') -writer.SetFileName(vtk_file+vtk_ext) +writer.SetFileName(vtk_file+'.'+writer.GetDefaultFileExtension()) Npoints = rGrid.GetNumberOfPoints() Ncells = rGrid.GetNumberOfCells() diff --git a/processing/post/vtk_addPointCloudData.py b/processing/post/vtk_addPointCloudData.py index 0a1cb1231..f37def80a 100755 --- a/processing/post/vtk_addPointCloudData.py +++ b/processing/post/vtk_addPointCloudData.py @@ -61,7 +61,6 @@ elif vtk_ext == '.vtk': reader.SetFileName(options.vtk) reader.Update() Polydata = reader.GetPolyDataOutput() - vtk_ext = '.vtp' else: parser.error('unsupported VTK file type extension.') @@ -152,7 +151,7 @@ for name in filenames: writer = vtk.vtkXMLPolyDataWriter() writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() - writer.SetFileName(vtk_file+vtk_ext) + writer.SetFileName(vtk_file+'.'+writer.GetDefaultFileExtension()) writer.SetInputData(Polydata) writer.Write() diff --git a/processing/post/vtk_addRectilinearGridData.py b/processing/post/vtk_addRectilinearGridData.py index 868fdc387..890b28fa8 100755 --- a/processing/post/vtk_addRectilinearGridData.py +++ b/processing/post/vtk_addRectilinearGridData.py @@ -64,7 +64,6 @@ elif vtk_ext == '.vtk': reader.SetFileName(options.vtk) reader.Update() rGrid = reader.GetRectilinearGridOutput() - vtk_ext = '.vtr' else: parser.error('unsupported VTK file type extension.') @@ -161,7 +160,7 @@ for name in filenames: writer = vtk.vtkXMLRectilinearGridWriter() writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() - writer.SetFileName(vtk_file+vtk_ext) + writer.SetFileName(vtk_file+'.'+writer.GetDefaultFileExtension()) writer.SetInputData(rGrid) writer.Write() From 0d08659b2a345eea18c3ba00e07ca476170b80ce Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 01:07:26 +0100 Subject: [PATCH 32/67] general cleaning --- processing/post/sortTable.py | 2 +- src/DAMASK_interface.f90 | 4 +-- src/FEM_utilities.f90 | 12 -------- src/config.f90 | 44 +++++++++++------------------ src/plastic_disloUCLA.f90 | 11 +------- src/plastic_dislotwin.f90 | 14 ++------- src/plastic_isotropic.f90 | 15 ++-------- src/plastic_kinematichardening.f90 | 15 ++-------- src/plastic_phenopowerlaw.f90 | 17 +++-------- src/source_damage_anisoBrittle.f90 | 9 +----- src/source_damage_anisoDuctile.f90 | 13 ++------- src/source_damage_isoBrittle.f90 | 9 +----- src/source_damage_isoDuctile.f90 | 14 ++------- src/source_thermal_dissipation.f90 | 3 +- src/source_thermal_externalheat.f90 | 3 +- src/thermal_adiabatic.f90 | 2 -- src/thermal_conduction.f90 | 3 +- 17 files changed, 43 insertions(+), 147 deletions(-) diff --git a/processing/post/sortTable.py b/processing/post/sortTable.py index bf23193bb..1af1b787a 100755 --- a/processing/post/sortTable.py +++ b/processing/post/sortTable.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index b2930510b..29596d0a0 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -446,7 +446,7 @@ subroutine setSIGUSR1(signal) bind(C) integer(C_INT), value :: signal SIGUSR1 = .true. - write(6,*) 'received signal ',signal, 'set SIGUSR1' + write(6,'(a,i2.2,a)') ' received signal ',signal, ', set SIGUSR1' end subroutine setSIGUSR1 @@ -461,7 +461,7 @@ subroutine setSIGUSR2(signal) bind(C) integer(C_INT), value :: signal SIGUSR2 = .true. - write(6,*) 'received signal ',signal, 'set SIGUSR2' + write(6,'(a,i2.2,a)') ' received signal ',signal, ', set SIGUSR2' end subroutine setSIGUSR2 diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 82ca4c869..2bf1ea868 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -494,24 +494,12 @@ end subroutine utilities_indexActiveSet !> @brief cleans up !-------------------------------------------------------------------------------------------------- subroutine utilities_destroy() - !use material, only: & - ! homogenization_Ngrains !implicit none !PetscInt :: homog, cryst, grain, phase !PetscErrorCode :: ierr - !call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) !call VecDestroy(coordinatesVec,ierr); CHKERRQ(ierr) - !do homog = 1, material_Nhomogenization - ! call VecDestroy(homogenizationResultsVec(homog),ierr);CHKERRQ(ierr) - ! do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_Ngrains(homog) - ! call VecDestroy(crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr) - ! enddo; enddo - ! do phase = 1, material_Nphase; do grain = 1, homogenization_Ngrains(homog) - ! call VecDestroy(phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr) - ! enddo; enddo - !enddo !call PetscViewerDestroy(resUnit, ierr); CHKERRQ(ierr) end subroutine utilities_destroy diff --git a/src/config.f90 b/src/config.f90 index e8321d9a4..94514529d 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -59,21 +59,11 @@ module config microstructure_name, & !< name of each microstructure texture_name !< name of each texture -! ToDo: make private, no one needs to know that - character(len=*), parameter, public :: & - MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part - MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part - MATERIAL_partPhase = 'phase', & !< keyword for phase part - MATERIAL_partMicrostructure = 'microstructure' !< keyword for microstructure part - character(len=*), parameter, private :: & - MATERIAL_partTexture = 'texture' !< keyword for texture part ! ToDo: Remove, use size(config_phase) etc integer(pInt), public, protected :: & material_Nphase, & !< number of phases - material_Nhomogenization, & !< number of homogenizations - material_Nmicrostructure, & !< number of microstructures - material_Ncrystallite !< number of crystallite settings + material_Nhomogenization !< number of homogenizations public :: & config_init, & @@ -126,40 +116,38 @@ subroutine config_init() part = IO_lc(IO_getTag(line,'<','>')) select case (trim(part)) - case (trim(material_partPhase)) + case (trim('phase')) call parseFile(phase_name,config_phase,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase parsed'; flush(6) - case (trim(material_partMicrostructure)) + case (trim('microstructure')) call parseFile(microstructure_name,config_microstructure,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6) - case (trim(material_partCrystallite)) + case (trim('crystallite')) call parseFile(crystallite_name,config_crystallite,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite parsed'; flush(6) - case (trim(material_partHomogenization)) + case (trim('homogenization')) call parseFile(homogenization_name,config_homogenization,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6) - case (trim(material_partTexture)) + case (trim('texture')) call parseFile(texture_name,config_texture,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6) end select enddo material_Nhomogenization = size(config_homogenization) - material_Nmicrostructure = size(config_microstructure) - material_Ncrystallite = size(config_crystallite) material_Nphase = size(config_phase) - if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) - if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure) - if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite) - if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) - if (size(config_texture) < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) + if (material_Nhomogenization < 1) call IO_error(160_pInt,ext_msg='') + if (size(config_microstructure) < 1) call IO_error(160_pInt,ext_msg='') + if (size(config_crystallite) < 1) call IO_error(160_pInt,ext_msg='') + if (material_Nphase < 1) call IO_error(160_pInt,ext_msg='') + if (size(config_texture) < 1) call IO_error(160_pInt,ext_msg='') end subroutine config_init diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index f987ee75b..372e429d6 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -114,11 +114,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_disloUCLA_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & pStringLen use debug, only: & @@ -128,8 +123,7 @@ subroutine plastic_disloUCLA_init() use math, only: & math_expand use IO, only: & - IO_error, & - IO_timeStamp + IO_error use material, only: & phase_plasticity, & phase_plasticityInstance, & @@ -140,7 +134,6 @@ subroutine plastic_disloUCLA_init() material_phase, & plasticState use config, only: & - MATERIAL_partPhase, & config_phase use lattice @@ -167,8 +160,6 @@ subroutine plastic_disloUCLA_init() write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_DISLOUCLA_label//' init -+>>>' write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78, 2016, 242-256' write(6,'(/,a)') ' http://dx.doi.org/10.1016/j.ijplas.2015.09.002' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" Ninstance = int(count(phase_plasticity == PLASTICITY_DISLOUCLA_ID),pInt) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 7e5272dc2..cada56aca 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -182,11 +182,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & pStringLen, & dEq0, & @@ -200,9 +195,7 @@ subroutine plastic_dislotwin_init math_expand,& PI use IO, only: & - IO_warning, & - IO_error, & - IO_timeStamp + IO_error use material, only: & phase_plasticity, & phase_plasticityInstance, & @@ -213,7 +206,6 @@ subroutine plastic_dislotwin_init material_phase, & plasticState use config, only: & - MATERIAL_partPhase, & config_phase use lattice @@ -244,10 +236,8 @@ subroutine plastic_dislotwin_init write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2006.04.014' write(6,'(/,a)') ' Wong et al., Acta Materialia, 118:140–151, 2016' write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - Ninstance = int(count(phase_plasticity == PLASTICITY_DISLOTWIN_ID),pInt) + Ninstance = count(phase_plasticity == PLASTICITY_DISLOTWIN_ID) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 7fa65ff7b..e0107d3ca 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -76,12 +76,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine plastic_isotropic_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif +subroutine plastic_isotropic_init use prec, only: & pStringLen use debug, only: & @@ -95,8 +90,7 @@ subroutine plastic_isotropic_init() debug_constitutive, & debug_levelBasic use IO, only: & - IO_error, & - IO_timeStamp + IO_error use material, only: & #ifdef DEBUG phasememberAt, & @@ -110,7 +104,6 @@ subroutine plastic_isotropic_init() material_phase, & plasticState use config, only: & - MATERIAL_partPhase, & config_phase use lattice @@ -134,10 +127,8 @@ subroutine plastic_isotropic_init() write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_ISOTROPIC_label//' init -+>>>' write(6,'(/,a)') ' Maiti and Eisenlohr, Scripta Materialia, 145:37-40, 2018' write(6,'(/,a)') ' https://doi.org/10.1016/j.scriptamat.2017.09.047' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - Ninstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt) + Ninstance = count(phase_plasticity == PLASTICITY_ISOTROPIC_ID) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index be4261b03..b93da06f9 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -95,11 +95,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_kinehardening_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & dEq0, & pStringLen @@ -116,8 +111,7 @@ subroutine plastic_kinehardening_init use math, only: & math_expand use IO, only: & - IO_error, & - IO_timeStamp + IO_error use material, only: & #ifdef DEBUG phasememberAt, & @@ -131,7 +125,6 @@ subroutine plastic_kinehardening_init material_phase, & plasticState use config, only: & - MATERIAL_partPhase, & config_phase use lattice @@ -156,11 +149,9 @@ subroutine plastic_kinehardening_init outputs write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_KINEHARDENING_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - Ninstance = int(count(phase_plasticity == PLASTICITY_KINEHARDENING_ID),pInt) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + Ninstance = count(phase_plasticity == PLASTICITY_KINEHARDENING_ID) + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(plastic_kinehardening_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index fd40f12da..e7966dd7d 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -107,11 +107,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & pStringLen use debug, only: & @@ -121,8 +116,7 @@ subroutine plastic_phenopowerlaw_init use math, only: & math_expand use IO, only: & - IO_error, & - IO_timeStamp + IO_error use material, only: & phase_plasticity, & phase_plasticityInstance, & @@ -133,7 +127,6 @@ subroutine plastic_phenopowerlaw_init material_phase, & plasticState use config, only: & - MATERIAL_partPhase, & config_phase use lattice @@ -158,14 +151,12 @@ subroutine plastic_phenopowerlaw_init outputs write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - Ninstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + Ninstance = count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID) + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) allocate(plastic_phenopowerlaw_output(maxval(phase_Noutput),Ninstance)) plastic_phenopowerlaw_output = '' diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 98aec49b3..00aaeaf9c 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -63,11 +63,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoBrittle_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & pStringLen use debug, only: & @@ -89,8 +84,7 @@ subroutine source_damage_anisoBrittle_init sourceState use config, only: & config_phase, & - material_Nphase, & - MATERIAL_partPhase + material_Nphase use lattice, only: & lattice_maxNcleavageFamily @@ -109,7 +103,6 @@ subroutine source_damage_anisoBrittle_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' -#include "compilation_info.f90" Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt) if (Ninstance == 0_pInt) return diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 945688e8a..dd5b95893 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -62,11 +62,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoDuctile_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & pStringLen use debug, only: & @@ -75,7 +70,7 @@ subroutine source_damage_anisoDuctile_init debug_levelBasic use IO, only: & IO_error - use math, only: & + use math, only: & math_expand use material, only: & material_allocateSourceState, & @@ -88,8 +83,7 @@ subroutine source_damage_anisoDuctile_init sourceState use config, only: & config_phase, & - material_Nphase, & - MATERIAL_partPhase + material_Nphase use lattice, only: & lattice_maxNslipFamily @@ -109,9 +103,8 @@ subroutine source_damage_anisoDuctile_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' -#include "compilation_info.f90" - Ninstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt) + Ninstance = count(phase_source == SOURCE_damage_anisoDuctile_ID) if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index ae0f2a0d2..d6ee268a3 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -53,11 +53,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_isoBrittle_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & pStringLen use debug, only: & @@ -77,8 +72,7 @@ subroutine source_damage_isoBrittle_init sourceState use config, only: & config_phase, & - material_Nphase, & - MATERIAL_partPhase + material_Nphase implicit none @@ -94,7 +88,6 @@ subroutine source_damage_isoBrittle_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' -#include "compilation_info.f90" Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt) if (Ninstance == 0_pInt) return diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index f29d60226..8dc1b34d6 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -53,11 +53,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_isoDuctile_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & pStringLen use debug, only: & @@ -65,7 +60,6 @@ subroutine source_damage_isoDuctile_init debug_constitutive,& debug_levelBasic use IO, only: & - IO_warning, & IO_error use material, only: & material_allocateSourceState, & @@ -78,8 +72,7 @@ subroutine source_damage_isoDuctile_init sourceState use config, only: & config_phase, & - material_Nphase, & - MATERIAL_partPhase + material_Nphase implicit none @@ -95,12 +88,11 @@ subroutine source_damage_isoDuctile_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>' -#include "compilation_info.f90" - Ninstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt) + Ninstance = count(phase_source == SOURCE_damage_isoDuctile_ID) if (Ninstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_damage_isoDuctile_offset(material_Nphase), source=0_pInt) diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 7c46e64ae..bdee3f4f3 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -60,8 +60,7 @@ subroutine source_thermal_dissipation_init sourceState use config, only: & config_phase, & - material_Nphase, & - MATERIAL_partPhase + material_Nphase implicit none integer(pInt) :: Ninstance,instance,source,sourceOffset diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 2bf4cac9c..3723d6196 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -62,8 +62,7 @@ subroutine source_thermal_externalheat_init SOURCE_thermal_externalheat_ID use config, only: & config_phase, & - material_Nphase, & - MATERIAL_partPhase + material_Nphase implicit none diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 0ba08de97..4223c7971 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -57,7 +57,6 @@ subroutine thermal_adiabatic_init temperature, & temperatureRate use config, only: & - material_partHomogenization, & config_homogenization implicit none @@ -277,7 +276,6 @@ function thermal_adiabatic_getMassDensity(ip,el) lattice_massDensity use material, only: & homogenization_Ngrains, & - mappingHomogenization, & material_phase use mesh, only: & mesh_element diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 461eae470..8e836ffd1 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -58,7 +58,6 @@ subroutine thermal_conduction_init temperature, & temperatureRate use config, only: & - material_partHomogenization, & config_homogenization implicit none @@ -70,7 +69,7 @@ subroutine thermal_conduction_init write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_CONDUCTION_label//' init -+>>>' - maxNinstance = int(count(thermal_type == THERMAL_conduction_ID),pInt) + maxNinstance = count(thermal_type == THERMAL_conduction_ID) if (maxNinstance == 0_pInt) return allocate(thermal_conduction_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) From 66e6a6ec68087a2cb19dae34b727421aa152d337 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 07:47:01 +0100 Subject: [PATCH 33/67] cleaning --- src/CPFEM2.f90 | 1 - src/DAMASK_FEM.f90 | 10 +-- src/FEM_mech.f90 | 4 -- src/homogenization_isostrain.f90 | 8 --- src/homogenization_none.f90 | 92 +++++++++++-------------- src/material.f90 | 10 +-- src/spectral_utilities.f90 | 113 +++++++++++++++---------------- 7 files changed, 99 insertions(+), 139 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 9e4628e0e..678ff98cc 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -90,7 +90,6 @@ subroutine CPFEM_init use prec, only: & pInt, pReal use IO, only: & - IO_timeStamp, & IO_error use numerics, only: & worldrank diff --git a/src/DAMASK_FEM.f90 b/src/DAMASK_FEM.f90 index 87886643d..611be46e0 100644 --- a/src/DAMASK_FEM.f90 +++ b/src/DAMASK_FEM.f90 @@ -7,11 +7,6 @@ !> results !-------------------------------------------------------------------------------------------------- program DAMASK_FEM -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif #include use PetscDM use prec, only: & @@ -31,8 +26,7 @@ program DAMASK_FEM IO_error, & IO_lc, & IO_intOut, & - IO_warning, & - IO_timeStamp + IO_warning use math ! need to include the whole module for FFTW use CPFEM2, only: & CPFEM_initAll @@ -118,8 +112,6 @@ program DAMASK_FEM ! init DAMASK (all modules) call CPFEM_initAll write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" ! reading basic information from load case file and allocate data structure containing load cases call DMGetDimension(geomMesh,dimPlex,ierr)! CHKERRQ(ierr) !< dimension of mesh (2D or 3D) diff --git a/src/FEM_mech.f90 b/src/FEM_mech.f90 index 2124ac582..b6d9ac17f 100644 --- a/src/FEM_mech.f90 +++ b/src/FEM_mech.f90 @@ -66,9 +66,7 @@ contains !> @brief allocates all neccessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine FEM_mech_init(fieldBC) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) use IO, only: & - IO_timeStamp, & IO_error use DAMASK_interface, only: & getSolverJobName @@ -111,8 +109,6 @@ subroutine FEM_mech_init(fieldBC) PetscErrorCode :: ierr write(6,'(/,a)') ' <<<+- FEM_mech init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" !-------------------------------------------------------------------------------------------------- ! Setup FEM mech mesh diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index 42c0c9287..777321cee 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -36,17 +36,11 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine homogenization_isostrain_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use debug, only: & debug_HOMOGENIZATION, & debug_level, & debug_levelBasic use IO, only: & - IO_timeStamp, & IO_error use material, only: & homogenization_type, & @@ -67,8 +61,6 @@ subroutine homogenization_isostrain_init() tag = '' write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" Ninstance = int(count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID),pInt) if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index 04ea55abe..400298b89 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -6,11 +6,11 @@ !-------------------------------------------------------------------------------------------------- module homogenization_none - implicit none - private - - public :: & - homogenization_none_init + implicit none + private + + public :: & + homogenization_none_init contains @@ -18,52 +18,42 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine homogenization_none_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use prec, only: & - pInt - use debug, only: & - debug_HOMOGENIZATION, & - debug_level, & - debug_levelBasic - use IO, only: & - IO_timeStamp - - use material, only: & - homogenization_type, & - material_homog, & - homogState, & - HOMOGENIZATION_NONE_LABEL, & - HOMOGENIZATION_NONE_ID - - implicit none - integer(pInt) :: & - Ninstance, & - h, & - NofMyHomog - - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - Ninstance = int(count(homogenization_type == HOMOGENIZATION_NONE_ID),pInt) - if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - - do h = 1_pInt, size(homogenization_type) - if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle - - NofMyHomog = count(material_homog == h) - homogState(h)%sizeState = 0_pInt - homogState(h)%sizePostResults = 0_pInt - allocate(homogState(h)%state0 (0_pInt,NofMyHomog)) - allocate(homogState(h)%subState0(0_pInt,NofMyHomog)) - allocate(homogState(h)%state (0_pInt,NofMyHomog)) - - enddo + use debug, only: & + debug_HOMOGENIZATION, & + debug_level, & + debug_levelBasic + use config, only: & + config_homogenization + use material, only: & + homogenization_type, & + material_homog, & + homogState, & + HOMOGENIZATION_NONE_LABEL, & + HOMOGENIZATION_NONE_ID + + implicit none + integer :: & + Ninstance, & + h, & + NofMyHomog + + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' + + Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID) + if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) & + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + + do h = 1, size(homogenization_type) + if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle + + NofMyHomog = count(material_homog == h) + homogState(h)%sizeState = 0 + homogState(h)%sizePostResults = 0 + allocate(homogState(h)%state0 (0,NofMyHomog)) + allocate(homogState(h)%subState0(0,NofMyHomog)) + allocate(homogState(h)%state (0,NofMyHomog)) + + enddo end subroutine homogenization_none_init diff --git a/src/material.f90 b/src/material.f90 index edee30d20..c4acfe466 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -280,14 +280,8 @@ contains !> material.config !-------------------------------------------------------------------------------------------------- subroutine material_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use IO, only: & - IO_error, & - IO_timeStamp + IO_error use debug, only: & debug_level, & debug_material, & @@ -321,8 +315,6 @@ subroutine material_init() myDebug = debug_level(debug_material) write(6,'(/,a)') ' <<<+- material init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" call material_parsePhase() if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 972083d59..a17ad713f 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -503,64 +503,63 @@ end subroutine utilities_FFTvectorBackward !> @brief doing convolution gamma_hat * field_real, ensuring that average value = fieldAim !-------------------------------------------------------------------------------------------------- subroutine utilities_fourierGammaConvolution(fieldAim) - use numerics, only: & - memory_efficient - use math, only: & - math_det33, & - math_invert - use mesh, only: & - grid3, & - grid, & - grid3Offset - - implicit none - real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution - complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx - real(pReal) :: matA(6,6), matInvA(6,6) - - integer(pInt) :: & - i, j, k, & - l, m, n, o - logical :: err - - - write(6,'(/,a)') ' ... doing gamma convolution ...............................................' - flush(6) + use numerics, only: & + memory_efficient + use math, only: & + math_det33, & + math_invert2 + use mesh, only: & + grid3, & + grid, & + grid3Offset + + implicit none + real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution + complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx + real(pReal), dimension(6,6) :: A, A_inv + + integer :: & + i, j, k, & + l, m, n, o + logical :: err + + + write(6,'(/,a)') ' ... doing gamma convolution ...............................................' + flush(6) !-------------------------------------------------------------------------------------------------- ! do the actual spectral method calculation (mechanical equilibrium) - memoryEfficient: if(memory_efficient) then - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid1Red - if (any([i,j,k+grid3Offset] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k))*xi1st(m,i,j,k) - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - temp33_complex(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx) - matA(1:3,1:3) = real(temp33_complex); matA(4:6,4:6) = real(temp33_complex) - matA(1:3,4:6) = aimag(temp33_complex); matA(4:6,1:3) = -aimag(temp33_complex) - if (abs(math_det33(matA(1:3,1:3))) > 1e-16) then - call math_invert(6_pInt, matA, matInvA, err) - temp33_complex = cmplx(matInvA(1:3,1:3),matInvA(1:3,4:6),pReal) - forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt) & - gamma_hat(l,m,n,o,1,1,1) = temp33_complex(l,n)*conjg(-xi1st(o,i,j,k))*xi1st(m,i,j,k) - else - gamma_hat(1:3,1:3,1:3,1:3,1,1,1) = cmplx(0.0_pReal,0.0_pReal,pReal) - endif - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3,1,1,1)*tensorField_fourier(1:3,1:3,i,j,k)) - tensorField_fourier(1:3,1:3,i,j,k) = temp33_Complex - endif - enddo; enddo; enddo - else memoryEfficient - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid1Red - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3,i,j,k) * tensorField_fourier(1:3,1:3,i,j,k)) - tensorField_fourier(1:3,1:3,i,j,k) = temp33_Complex - enddo; enddo; enddo - endif memoryEfficient - - if (grid3Offset == 0_pInt) & - tensorField_fourier(1:3,1:3,1,1,1) = cmplx(fieldAim/wgt,0.0_pReal,pReal) + memoryEfficient: if(memory_efficient) then + do k = 1, grid3; do j = 1, grid(2); do i = 1, grid1Red + if (any([i,j,k+grid3Offset] /= 1)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 + forall(l = 1:3, m = 1:3) & + xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k))*xi1st(m,i,j,k) + forall(l = 1:3, m = 1:3) & + temp33_complex(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx) + A(1:3,1:3) = real(temp33_complex); A(4:6,4:6) = real(temp33_complex) + A(1:3,4:6) = aimag(temp33_complex); A(4:6,1:3) = -aimag(temp33_complex) + if (abs(math_det33(A(1:3,1:3))) > 1e-16) then + call math_invert2(A_inv, err, A) + temp33_complex = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal) + forall(l=1:3, m=1:3, n=1:3, o=1:3) & + gamma_hat(l,m,n,o,1,1,1) = temp33_complex(l,n)*conjg(-xi1st(o,i,j,k))*xi1st(m,i,j,k) + else + gamma_hat(1:3,1:3,1:3,1:3,1,1,1) = cmplx(0.0_pReal,0.0_pReal,pReal) + endif + forall(l = 1:3, m = 1:3) & + temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3,1,1,1)*tensorField_fourier(1:3,1:3,i,j,k)) + tensorField_fourier(1:3,1:3,i,j,k) = temp33_Complex + endif + enddo; enddo; enddo + else memoryEfficient + do k = 1, grid3; do j = 1, grid(2); do i = 1,grid1Red + forall(l = 1:3, m = 1:3) & + temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3,i,j,k) * tensorField_fourier(1:3,1:3,i,j,k)) + tensorField_fourier(1:3,1:3,i,j,k) = temp33_Complex + enddo; enddo; enddo + endif memoryEfficient + + if (grid3Offset == 0) tensorField_fourier(1:3,1:3,1,1,1) = cmplx(fieldAim/wgt,0.0_pReal,pReal) end subroutine utilities_fourierGammaConvolution @@ -725,7 +724,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) math_99to3333, & math_rotate_forward3333, & math_rotate_forward33, & - math_invert + math_invert2 implicit none real(pReal), dimension(3,3,3,3) :: utilities_maskedCompliance !< masked compliance @@ -768,7 +767,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) c_reduced(k,j) = temp99_Real(n,m) endif; enddo; endif; enddo - call math_invert(size_reduced, c_reduced, s_reduced, errmatinv) ! invert reduced stiffness + call math_invert2(s_reduced, errmatinv, c_reduced) ! invert reduced stiffness if (any(IEEE_is_NaN(s_reduced))) errmatinv = .true. if (errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') temp99_Real = 0.0_pReal ! fill up compliance with zeros From a5dad0ca5c0858c58bc71fea541034e457b48f90 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 08:12:56 +0100 Subject: [PATCH 34/67] performing compilation tests in parallel --- .gitlab-ci.yml | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index de2fa3906..bbd15df75 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -3,8 +3,7 @@ stages: - prepareAll - preprocessing - postprocessing - - compilePETScIntel - - compilePETScGNU + - compilePETSc - prepareSpectral - spectral - compileMarc @@ -216,38 +215,41 @@ Post_OrientationConversion: ################################################################################################### Compile_Spectral_Intel: - stage: compilePETScIntel + stage: compilePETSc script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel - - SpectralAll_compile/test.py + - cp -r SpectralAll_compile SpectralAll_compile_Intel + - SpectralAll_compile_Intel/test.py except: - master - release Compile_FEM_Intel: - stage: compilePETScIntel + stage: compilePETSc script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel - - FEM_compile/test.py + - cp -r FEM_compile FEM_compile_Intel + - FEM_compile_Intel/test.py except: - master - release -################################################################################################### Compile_Spectral_GNU: - stage: compilePETScGNU + stage: compilePETSc script: - module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU - - SpectralAll_compile/test.py + - cp -r SpectralAll_compile SpectralAll_compile_GNU + - SpectralAll_GNU/test.py except: - master - release Compile_FEM_GNU: - stage: compilePETScGNU + stage: compilePETSc script: - module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU - - FEM_compile/test.py + - cp -r FEM_compile FEM_compile_GNU + - FEM_compile_GNU/test.py except: - master - release From 6f3771f6c44b49f5404fd32d2166a8c0698f5c96 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 09:54:33 +0100 Subject: [PATCH 35/67] Allreduce better suited than Bcast --- src/spectral_damage.f90 | 277 ++++++++++++------------- src/spectral_mech_Basic.f90 | 11 +- src/spectral_mech_Polarisation.f90 | 11 +- src/spectral_thermal.f90 | 322 ++++++++++++++--------------- 4 files changed, 296 insertions(+), 325 deletions(-) diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 index 1b741ee2d..4c581350e 100644 --- a/src/spectral_damage.f90 +++ b/src/spectral_damage.f90 @@ -11,14 +11,9 @@ module spectral_damage use prec, only: & pInt, & pReal - use math, only: & - math_I3 use spectral_utilities, only: & tSolutionState, & tSolutionParams - use numerics, only: & - worldrank, & - worldsize implicit none private @@ -42,7 +37,7 @@ module spectral_damage !-------------------------------------------------------------------------------------------------- ! reference diffusion tensor, mobility etc. - integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment + integer(pInt), private :: totalIter = 0 !< total iteration in current increment real(pReal), dimension(3,3), private :: D_ref real(pReal), private :: mobility_ref @@ -57,93 +52,94 @@ contains !> @brief allocates all neccessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine spectral_damage_init() - use IO, only: & - IO_intOut - use spectral_utilities, only: & - wgt - use mesh, only: & - grid, & - grid3 - use damage_nonlocal, only: & - damage_nonlocal_getDiffusion33, & - damage_nonlocal_getMobility - - implicit none - PetscInt, dimension(:), allocatable :: localK - integer(pInt) :: proc - integer(pInt) :: i, j, k, cell - DM :: damage_grid - Vec :: uBound, lBound - PetscErrorCode :: ierr - character(len=100) :: snes_type - - write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' - write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press, ' - write(6,'(a,/)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' + use IO, only: & + IO_intOut + use spectral_utilities, only: & + wgt + use mesh, only: & + grid, & + grid3 + use damage_nonlocal, only: & + damage_nonlocal_getDiffusion33, & + damage_nonlocal_getMobility + use numerics, only: & + worldrank, & + worldsize + + implicit none + PetscInt, dimension(worldsize) :: localK + integer :: i, j, k, cell + DM :: damage_grid + Vec :: uBound, lBound + PetscErrorCode :: ierr + character(len=100) :: snes_type + + write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' + write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press, ' + write(6,'(a,/)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc - call SNESCreate(PETSC_COMM_WORLD,damage_snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(damage_snes,'damage_',ierr);CHKERRQ(ierr) - allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize - call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) - enddo - 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 - 1, 1, worldsize, & - 1, 0, & !< #dof (damage phase field), ghost boundary width (domain overlap) - [grid(1)],[grid(2)],localK, & !< local grid - damage_grid,ierr) !< handle, error - CHKERRQ(ierr) - call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da - 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 - 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) - if (trim(snes_type) == 'vinewtonrsls' .or. & - trim(snes_type) == 'vinewtonssls') then - call DMGetGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr) - call DMGetGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr) - call VecSet(lBound,0.0_pReal,ierr); CHKERRQ(ierr) - call VecSet(uBound,1.0_pReal,ierr); CHKERRQ(ierr) - call SNESVISetVariableBounds(damage_snes,lBound,uBound,ierr) !< variable bounds for variational inequalities like contact mechanics, damage etc. - call DMRestoreGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr) - call DMRestoreGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr) - endif + call SNESCreate(PETSC_COMM_WORLD,damage_snes,ierr); CHKERRQ(ierr) + call SNESSetOptionsPrefix(damage_snes,'damage_',ierr);CHKERRQ(ierr) + localK = 0 + localK(worldrank+1) = grid3 + call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr) + 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 + 1, 1, worldsize, & + 1, 0, & !< #dof (damage phase field), ghost boundary width (domain overlap) + [grid(1)],[grid(2)],localK, & !< local grid + damage_grid,ierr) !< handle, error + CHKERRQ(ierr) + call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da + 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 + 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) + if (trim(snes_type) == 'vinewtonrsls' .or. & + trim(snes_type) == 'vinewtonssls') then + call DMGetGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr) + call DMGetGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr) + call VecSet(lBound,0.0_pReal,ierr); CHKERRQ(ierr) + call VecSet(uBound,1.0_pReal,ierr); CHKERRQ(ierr) + call SNESVISetVariableBounds(damage_snes,lBound,uBound,ierr) !< variable bounds for variational inequalities like contact mechanics, damage etc. + call DMRestoreGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr) + call DMRestoreGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr) + endif !-------------------------------------------------------------------------------------------------- ! init fields - call DMDAGetCorners(damage_grid,xstart,ystart,zstart,xend,yend,zend,ierr) - CHKERRQ(ierr) - xend = xstart + xend - 1 - yend = ystart + yend - 1 - zend = zstart + zend - 1 - call VecSet(solution,1.0_pReal,ierr); CHKERRQ(ierr) - allocate(damage_current(grid(1),grid(2),grid3), source=1.0_pReal) - allocate(damage_lastInc(grid(1),grid(2),grid3), source=1.0_pReal) - allocate(damage_stagInc(grid(1),grid(2),grid3), source=1.0_pReal) + call DMDAGetCorners(damage_grid,xstart,ystart,zstart,xend,yend,zend,ierr) + CHKERRQ(ierr) + xend = xstart + xend - 1 + yend = ystart + yend - 1 + zend = zstart + zend - 1 + call VecSet(solution,1.0_pReal,ierr); CHKERRQ(ierr) + allocate(damage_current(grid(1),grid(2),grid3), source=1.0_pReal) + allocate(damage_lastInc(grid(1),grid(2),grid3), source=1.0_pReal) + allocate(damage_stagInc(grid(1),grid(2),grid3), source=1.0_pReal) !-------------------------------------------------------------------------------------------------- ! damage reference diffusion update - cell = 0_pInt - D_ref = 0.0_pReal - mobility_ref = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - D_ref = D_ref + damage_nonlocal_getDiffusion33(1,cell) - mobility_ref = mobility_ref + damage_nonlocal_getMobility(1,cell) - enddo; enddo; enddo - D_ref = D_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - mobility_ref = mobility_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + cell = 0_pInt + D_ref = 0.0_pReal + mobility_ref = 0.0_pReal + do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) + cell = cell + 1 + D_ref = D_ref + damage_nonlocal_getDiffusion33(1,cell) + mobility_ref = mobility_ref + damage_nonlocal_getMobility(1,cell) + enddo; enddo; enddo + D_ref = D_ref*wgt + call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + mobility_ref = mobility_ref*wgt + call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) end subroutine spectral_damage_init @@ -151,74 +147,69 @@ end subroutine spectral_damage_init !> @brief solution for the spectral damage scheme with internal iterations !-------------------------------------------------------------------------------------------------- type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadCaseTime) - use numerics, only: & - itmax, & - err_damage_tolAbs, & - err_damage_tolRel - use mesh, only: & - grid, & - grid3 - use damage_nonlocal, only: & - damage_nonlocal_putNonLocalDamage + use numerics, only: & + itmax, & + err_damage_tolAbs, & + err_damage_tolRel + use mesh, only: & + grid, & + grid3 + use damage_nonlocal, only: & + damage_nonlocal_putNonLocalDamage + + implicit none + real(pReal), intent(in) :: & + timeinc, & !< increment in time for current solution + timeinc_old, & !< increment in time of last increment + loadCaseTime !< remaining time of current load case - implicit none - -!-------------------------------------------------------------------------------------------------- -! input data for solution - real(pReal), intent(in) :: & - timeinc, & !< increment in time for current solution - timeinc_old, & !< increment in time of last increment - loadCaseTime !< remaining time of current load case - integer(pInt) :: i, j, k, cell - PetscInt ::position - PetscReal :: minDamage, maxDamage, stagNorm, solnNorm - -!-------------------------------------------------------------------------------------------------- -! PETSc Data - PetscErrorCode :: ierr - SNESConvergedReason :: reason + integer :: i, j, k, cell + PetscInt ::position + PetscReal :: minDamage, maxDamage, stagNorm, solnNorm + PetscErrorCode :: ierr + SNESConvergedReason :: reason spectral_damage_solution%converged =.false. !-------------------------------------------------------------------------------------------------- ! set module wide availabe data - params%timeinc = timeinc - params%timeincOld = timeinc_old - - call SNESSolve(damage_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) - call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr) - - if (reason < 1) then - spectral_damage_solution%converged = .false. - spectral_damage_solution%iterationsNeeded = itmax - else - spectral_damage_solution%converged = .true. - spectral_damage_solution%iterationsNeeded = totalIter - endif - stagNorm = maxval(abs(damage_current - damage_stagInc)) - solnNorm = maxval(abs(damage_current)) - call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - call MPI_Allreduce(MPI_IN_PLACE,solnNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - damage_stagInc = damage_current - spectral_damage_solution%stagConverged = stagNorm < err_damage_tolAbs & - .or. stagNorm < err_damage_tolRel*solnNorm + params%timeinc = timeinc + params%timeincOld = timeinc_old + + call SNESSolve(damage_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) + call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr) + + if (reason < 1) then + spectral_damage_solution%converged = .false. + spectral_damage_solution%iterationsNeeded = itmax + else + spectral_damage_solution%converged = .true. + spectral_damage_solution%iterationsNeeded = totalIter + endif + stagNorm = maxval(abs(damage_current - damage_stagInc)) + solnNorm = maxval(abs(damage_current)) + call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) + call MPI_Allreduce(MPI_IN_PLACE,solnNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) + damage_stagInc = damage_current + spectral_damage_solution%stagConverged = stagNorm < err_damage_tolAbs & + .or. stagNorm < err_damage_tolRel*solnNorm !-------------------------------------------------------------------------------------------------- ! updating damage state - cell = 0_pInt !< material point = 0 - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt !< material point increase - call damage_nonlocal_putNonLocalDamage(damage_current(i,j,k),1,cell) - enddo; enddo; enddo - - call VecMin(solution,position,minDamage,ierr); CHKERRQ(ierr) - call VecMax(solution,position,maxDamage,ierr); CHKERRQ(ierr) - if (spectral_damage_solution%converged) & - write(6,'(/,a)') ' ... nonlocal damage converged .....................................' - write(6,'(/,a,f8.6,2x,f8.6,2x,f8.6,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',& - minDamage, maxDamage, stagNorm - write(6,'(/,a)') ' ===========================================================================' - flush(6) + cell = 0 + do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) + cell = cell + 1 + call damage_nonlocal_putNonLocalDamage(damage_current(i,j,k),1,cell) + enddo; enddo; enddo + + call VecMin(solution,position,minDamage,ierr); CHKERRQ(ierr) + call VecMax(solution,position,maxDamage,ierr); CHKERRQ(ierr) + if (spectral_damage_solution%converged) & + write(6,'(/,a)') ' ... nonlocal damage converged .....................................' + write(6,'(/,a,f8.6,2x,f8.6,2x,f8.6,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',& + minDamage, maxDamage, stagNorm + write(6,'(/,a)') ' ===========================================================================' + flush(6) end function spectral_damage_solution diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index 9508b6f0a..ee7116486 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -108,8 +108,8 @@ subroutine basic_init PetscErrorCode :: ierr PetscScalar, pointer, dimension(:,:,:,:) :: F - PetscInt, dimension(:), allocatable :: localK - integer :: proc, fileUnit + PetscInt, dimension(worldsize) :: localK + integer :: fileUnit character(len=1024) :: rankStr write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasic init -+>>>' @@ -125,10 +125,9 @@ subroutine basic_init ! initialize solver specific parts of PETSc call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) - allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize !ToDo: there are smarter options in MPI - call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) - enddo + localK = 0 + localK(worldrank+1) = grid3 + call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr) 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 diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index 3b613263f..c36f2b716 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -118,8 +118,8 @@ subroutine Polarisation_init FandF_tau, & ! overall pointer to solution data F, & ! specific (sub)pointer F_tau ! specific (sub)pointer - PetscInt, dimension(:), allocatable :: localK - integer :: proc, fileUnit + PetscInt, dimension(worldsize) :: localK + integer :: fileUnit character(len=1024) :: rankStr write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' @@ -137,10 +137,9 @@ subroutine Polarisation_init ! initialize solver specific parts of PETSc call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) - allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize !ToDo: there are smarter options in MPI - call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) - enddo + localK = 0 + localK(worldrank+1) = grid3 + call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr) 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 diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index 2ad5c4eab..cb73d73ec 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -9,16 +9,10 @@ module spectral_thermal use PETScdmda use PETScsnes use prec, only: & - pInt, & pReal - use math, only: & - math_I3 use spectral_utilities, only: & tSolutionState, & tSolutionParams - use numerics, only: & - worldrank, & - worldsize implicit none private @@ -42,7 +36,7 @@ module spectral_thermal !-------------------------------------------------------------------------------------------------- ! reference diffusion tensor, mobility etc. - integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment + integer, private :: totalIter = 0 !< total iteration in current increment real(pReal), dimension(3,3), private :: D_ref real(pReal), private :: mobility_ref @@ -57,104 +51,96 @@ contains !> @brief allocates all neccessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine spectral_thermal_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use IO, only: & - IO_timeStamp - use spectral_utilities, only: & - wgt - use mesh, only: & - grid, & - grid3 - use thermal_conduction, only: & - thermal_conduction_getConductivity33, & - thermal_conduction_getMassDensity, & - thermal_conduction_getSpecificHeat - use material, only: & - mappingHomogenization, & - temperature, & - 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 + use spectral_utilities, only: & + wgt + use mesh, only: & + grid, & + grid3 + use thermal_conduction, only: & + thermal_conduction_getConductivity33, & + thermal_conduction_getMassDensity, & + thermal_conduction_getSpecificHeat + use material, only: & + mappingHomogenization, & + temperature, & + thermalMapping + use numerics, only: & + worldrank, & + worldsize - write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' - write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press,' - write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" + implicit none + integer, dimension(worldsize) :: localK + integer :: i, j, k, cell + DM :: thermal_grid + PetscScalar, dimension(:,:,:), pointer :: x_scal + PetscErrorCode :: ierr + + write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' + write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press,' + write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018' !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc - call SNESCreate(PETSC_COMM_WORLD,thermal_snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(thermal_snes,'thermal_',ierr);CHKERRQ(ierr) - allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize - call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) - enddo - 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 - 1, 1, worldsize, & - 1, 0, & !< #dof (thermal phase field), ghost boundary width (domain overlap) - [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 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 - CHKERRQ(ierr) - call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional CLI arguments + call SNESCreate(PETSC_COMM_WORLD,thermal_snes,ierr); CHKERRQ(ierr) + call SNESSetOptionsPrefix(thermal_snes,'thermal_',ierr);CHKERRQ(ierr) + localK = 0 + localK(worldrank+1) = grid3 + call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr) + 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 + 1, 1, worldsize, & + 1, 0, & !< #dof (thermal phase field), ghost boundary width (domain overlap) + [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 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 + CHKERRQ(ierr) + 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) - CHKERRQ(ierr) - xend = xstart + xend - 1 - yend = ystart + yend - 1 - zend = zstart + zend - 1 - allocate(temperature_current(grid(1),grid(2),grid3), source=0.0_pReal) - allocate(temperature_lastInc(grid(1),grid(2),grid3), source=0.0_pReal) - allocate(temperature_stagInc(grid(1),grid(2),grid3), source=0.0_pReal) - cell = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - temperature_current(i,j,k) = temperature(mappingHomogenization(2,1,cell))% & - p(thermalMapping(mappingHomogenization(2,1,cell))%p(1,cell)) - 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 - x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current - call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) + call DMDAGetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) + CHKERRQ(ierr) + xend = xstart + xend - 1 + yend = ystart + yend - 1 + zend = zstart + zend - 1 + allocate(temperature_current(grid(1),grid(2),grid3), source=0.0_pReal) + allocate(temperature_lastInc(grid(1),grid(2),grid3), source=0.0_pReal) + allocate(temperature_stagInc(grid(1),grid(2),grid3), source=0.0_pReal) + cell = 0 + do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) + cell = cell + 1 + temperature_current(i,j,k) = temperature(mappingHomogenization(2,1,cell))% & + p(thermalMapping(mappingHomogenization(2,1,cell))%p(1,cell)) + 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 + x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current + call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !-------------------------------------------------------------------------------------------------- ! thermal reference diffusion update - cell = 0_pInt - D_ref = 0.0_pReal - mobility_ref = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - D_ref = D_ref + thermal_conduction_getConductivity33(1,cell) - mobility_ref = mobility_ref + thermal_conduction_getMassDensity(1,cell)* & - thermal_conduction_getSpecificHeat(1,cell) - enddo; enddo; enddo - D_ref = D_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - mobility_ref = mobility_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + cell = 0 + D_ref = 0.0_pReal + mobility_ref = 0.0_pReal + do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) + cell = cell + 1 + D_ref = D_ref + thermal_conduction_getConductivity33(1,cell) + mobility_ref = mobility_ref + thermal_conduction_getMassDensity(1,cell)* & + thermal_conduction_getSpecificHeat(1,cell) + enddo; enddo; enddo + D_ref = D_ref*wgt + call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + mobility_ref = mobility_ref*wgt + call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) end subroutine spectral_thermal_init @@ -162,76 +148,72 @@ end subroutine spectral_thermal_init !> @brief solution for the spectral thermal scheme with internal iterations !-------------------------------------------------------------------------------------------------- type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,loadCaseTime) - use numerics, only: & - itmax, & - err_thermal_tolAbs, & - err_thermal_tolRel - use mesh, only: & - grid, & - grid3 - use thermal_conduction, only: & - thermal_conduction_putTemperatureAndItsRate + use numerics, only: & + itmax, & + err_thermal_tolAbs, & + err_thermal_tolRel + use mesh, only: & + grid, & + grid3 + use thermal_conduction, only: & + thermal_conduction_putTemperatureAndItsRate + + implicit none - implicit none + real(pReal), intent(in) :: & + timeinc, & !< increment in time for current solution + timeinc_old, & !< increment in time of last increment + loadCaseTime !< remaining time of current load case + integer :: i, j, k, cell + PetscInt :: position + PetscReal :: minTemperature, maxTemperature, stagNorm, solnNorm -!-------------------------------------------------------------------------------------------------- -! input data for solution - real(pReal), intent(in) :: & - timeinc, & !< increment in time for current solution - timeinc_old, & !< increment in time of last increment - loadCaseTime !< remaining time of current load case - integer(pInt) :: i, j, k, cell - PetscInt :: position - PetscReal :: minTemperature, maxTemperature, stagNorm, solnNorm + PetscErrorCode :: ierr + SNESConvergedReason :: reason -!-------------------------------------------------------------------------------------------------- -! PETSc Data - PetscErrorCode :: ierr - SNESConvergedReason :: reason - - spectral_thermal_solution%converged =.false. + spectral_thermal_solution%converged =.false. !-------------------------------------------------------------------------------------------------- ! set module wide availabe data - params%timeinc = timeinc - params%timeincOld = timeinc_old + params%timeinc = timeinc + params%timeincOld = timeinc_old - call SNESSolve(thermal_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) - call SNESGetConvergedReason(thermal_snes,reason,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 - spectral_thermal_solution%converged = .false. - spectral_thermal_solution%iterationsNeeded = itmax - else - spectral_thermal_solution%converged = .true. - spectral_thermal_solution%iterationsNeeded = totalIter - endif - stagNorm = maxval(abs(temperature_current - temperature_stagInc)) - solnNorm = maxval(abs(temperature_current)) - call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - call MPI_Allreduce(MPI_IN_PLACE,solnNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - temperature_stagInc = temperature_current - spectral_thermal_solution%stagConverged = stagNorm < err_thermal_tolAbs & - .or. stagNorm < err_thermal_tolRel*solnNorm + if (reason < 1) then + spectral_thermal_solution%converged = .false. + spectral_thermal_solution%iterationsNeeded = itmax + else + spectral_thermal_solution%converged = .true. + spectral_thermal_solution%iterationsNeeded = totalIter + endif + stagNorm = maxval(abs(temperature_current - temperature_stagInc)) + solnNorm = maxval(abs(temperature_current)) + call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) + call MPI_Allreduce(MPI_IN_PLACE,solnNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) + temperature_stagInc = temperature_current + spectral_thermal_solution%stagConverged = stagNorm < err_thermal_tolAbs & + .or. stagNorm < err_thermal_tolRel*solnNorm !-------------------------------------------------------------------------------------------------- ! updating thermal state - cell = 0_pInt !< material point = 0 - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt !< material point increase - call thermal_conduction_putTemperatureAndItsRate(temperature_current(i,j,k), & - (temperature_current(i,j,k)-temperature_lastInc(i,j,k))/params%timeinc, & - 1,cell) - enddo; enddo; enddo + cell = 0 + do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) + cell = cell + 1 + call thermal_conduction_putTemperatureAndItsRate(temperature_current(i,j,k), & + (temperature_current(i,j,k)-temperature_lastInc(i,j,k))/params%timeinc, & + 1,cell) + enddo; enddo; enddo - call VecMin(solution,position,minTemperature,ierr); CHKERRQ(ierr) - call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr) - 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) + call VecMin(solution,position,minTemperature,ierr); CHKERRQ(ierr) + call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr) + 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 @@ -272,7 +254,7 @@ subroutine spectral_thermal_formResidual(in,x_scal,f_scal,dummy,ierr) f_scal PetscObject :: dummy PetscErrorCode :: ierr - integer(pInt) :: i, j, k, cell + integer :: i, j, k, cell real(pReal) :: Tdot, dTdot_dT temperature_current = x_scal @@ -283,18 +265,18 @@ subroutine spectral_thermal_formResidual(in,x_scal,f_scal,dummy,ierr) call utilities_FFTscalarForward() call utilities_fourierScalarGradient() !< calculate gradient of damage field call utilities_FFTvectorBackward() - cell = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt + cell = 0 + do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) + cell = cell + 1 vectorField_real(1:3,i,j,k) = math_mul33x3(thermal_conduction_getConductivity33(1,cell) - D_ref, & vectorField_real(1:3,i,j,k)) enddo; enddo; enddo call utilities_FFTvectorForward() call utilities_fourierVectorDivergence() !< calculate damage divergence in fourier field call utilities_FFTscalarBackward() - cell = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt + cell = 0 + do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) + cell = cell + 1 call thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, temperature_current(i,j,k), 1, cell) scalarField_real(i,j,k) = params%timeinc*scalarField_real(i,j,k) + & params%timeinc*Tdot + & @@ -333,10 +315,10 @@ subroutine spectral_thermal_forward() thermal_conduction_getSpecificHeat implicit none - integer(pInt) :: i, j, k, cell - DM :: dm_local - PetscScalar, dimension(:,:,:), pointer :: x_scal - PetscErrorCode :: ierr + integer :: i, j, k, cell + DM :: dm_local + PetscScalar, dimension(:,:,:), pointer :: x_scal + PetscErrorCode :: ierr if (cutBack) then temperature_current = temperature_lastInc @@ -344,13 +326,13 @@ subroutine spectral_thermal_forward() !-------------------------------------------------------------------------------------------------- ! reverting thermal field state - cell = 0_pInt !< material point = 0 + cell = 0 call SNESGetDM(thermal_snes,dm_local,ierr); CHKERRQ(ierr) call DMDAVecGetArrayF90(dm_local,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(dm_local,solution,x_scal,ierr); CHKERRQ(ierr) - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt !< material point increase + do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) + cell = cell + 1 call thermal_conduction_putTemperatureAndItsRate(temperature_current(i,j,k), & (temperature_current(i,j,k) - & temperature_lastInc(i,j,k))/params%timeinc, & @@ -360,11 +342,11 @@ subroutine spectral_thermal_forward() !-------------------------------------------------------------------------------------------------- ! update rate and forward last inc temperature_lastInc = temperature_current - cell = 0_pInt + cell = 0 D_ref = 0.0_pReal mobility_ref = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt + do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) + cell = cell + 1 D_ref = D_ref + thermal_conduction_getConductivity33(1,cell) mobility_ref = mobility_ref + thermal_conduction_getMassDensity(1,cell)* & thermal_conduction_getSpecificHeat(1,cell) From 1ba27cf62d8ae99eeb7cefca0cc36a353002c363 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 10:49:56 +0100 Subject: [PATCH 36/67] same reporting style, more error checks --- src/DAMASK_abaqus.f | 29 +++++++++--------- src/DAMASK_interface.f90 | 66 +++++++++++++++++++++++++++------------- src/DAMASK_marc.f90 | 31 ++++++++++--------- 3 files changed, 75 insertions(+), 51 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index 95f843ff7..4a5b3f698 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -43,30 +43,31 @@ subroutine DAMASK_interface_init implicit none integer, dimension(8) :: & - dateAndTime ! type default integer + dateAndTime integer :: lenOutDir,ierr character(len=256) :: wd - call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' - write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + write(6,'(/,a)') ' <<<+- DAMASK_abaqus init -+>>>' - write(6,'(a,/)') ' Version: '//DAMASKVERSION + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018.' + write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(/,a)') ' Version: '//DAMASKVERSION ! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md #if __INTEL_COMPILER >= 1800 - write(6,*) 'Compiled with: ', compiler_version() - write(6,*) 'Compiler options: ', compiler_options() + write(6,'(/,a)') 'Compiled with: '//compiler_version() + write(6,'(a)') 'Compiler options: '//compiler_options() #else - write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& - ', build date :', __INTEL_COMPILER_BUILD_DATE + write(6,'(/,a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE #endif - write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + write(6,'(/,a)') ' Compiled on: '//__DATE__//' at '//__TIME__ - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) + call date_and_time(values = dateAndTime) + write(6,'(/,a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) call getoutdir(wd, lenOutDir) ierr = CHDIR(wd) @@ -75,8 +76,6 @@ subroutine DAMASK_interface_init call quit(1) endif -#include "compilation_info.f90" - end subroutine DAMASK_interface_init diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index 29596d0a0..16e7108f3 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -45,6 +45,8 @@ subroutine DAMASK_interface_init() use, intrinsic :: & iso_c_binding use PETScSys + use prec, only: & + pReal use system_routines, only: & signalusr1_C, & signalusr2_C, & @@ -101,12 +103,14 @@ subroutine DAMASK_interface_init() threadLevel, & #endif worldrank = 0, & - worldsize = 0 + worldsize = 0, & + typeSize integer, allocatable, dimension(:) :: & chunkPos integer, dimension(8) :: & dateAndTime - PetscErrorCode :: ierr + integer :: mpi_err + PetscErrorCode :: petsc_err external :: & quit @@ -117,16 +121,21 @@ subroutine DAMASK_interface_init() #ifdef _OPENMP ! If openMP is enabled, check if the MPI libary supports it and initialize accordingly. ! Otherwise, the first call to PETSc will do the initialization. - call MPI_Init_Thread(MPI_THREAD_FUNNELED,threadLevel,ierr);CHKERRQ(ierr) + call MPI_Init_Thread(MPI_THREAD_FUNNELED,threadLevel,mpi_err) + if (mpi_err /= 0) call quit(1) if (threadLevel>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' - write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' - write(6,'(a,/)') ' Version: '//DAMASKVERSION + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018.' + write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(/,a)') ' Version: '//DAMASKVERSION ! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - write(6,*) 'Compiled with: ', compiler_version() - write(6,*) 'Compiler options: ', compiler_options() + write(6,'(/,a)') 'Compiled with: '//compiler_version() + write(6,'(a)') 'Compiler options: '//compiler_options() #elif defined(__INTEL_COMPILER) - write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& - ', build date :', __INTEL_COMPILER_BUILD_DATE + write(6,'(/,a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE #elif defined(__PGI) - write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version :', __PGIC__,& - '.', __PGIC_MINOR__ + write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version :', __PGIC__,& + '.', __PGIC_MINOR__ #endif - write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + write(6,'(/,a)') ' Compiled on: '//__DATE__//' at '//__TIME__ - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) + call date_and_time(values = dateAndTime) + write(6,'(/,a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) + + call MPI_Type_size(MPI_INTEGER,typeSize,mpi_err) + if (mpi_err /= 0) call quit(1) + if (typeSize*8 /= bit_size(0)) then + write(6,'(a)') ' Mismatch between MPI and DAMASK integer' + call quit(1) + endif + + call MPI_Type_size(MPI_DOUBLE,typeSize,mpi_err) + if (mpi_err /= 0) call quit(1) + if (typeSize*8 /= storage_size(0.0_pReal)) then + write(6,'(a)') ' Mismatch between MPI and DAMASK real' + call quit(1) + endif call get_command(commandLine) chunkPos = IIO_stringPos(commandLine) @@ -369,7 +393,7 @@ end function getLoadCaseFile function rectifyPath(path) implicit none - character(len=*) :: path + character(len=*) :: path character(len=1024) :: rectifyPath integer :: i,j,k,l diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index f7317c664..7cd1e2e47 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -54,32 +54,33 @@ subroutine DAMASK_interface_init implicit none integer, dimension(8) :: & - dateAndTime ! type default integer + dateAndTime integer :: ierr character(len=1024) :: wd - call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' - write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + write(6,'(/,a)') ' <<<+- DAMASK_marc init -+>>>' - write(6,'(a,/)') ' Version: '//DAMASKVERSION + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018.' + write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' -! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md + write(6,'(/,a)') ' Version: '//DAMASKVERSION + + ! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md #if __INTEL_COMPILER >= 1800 - write(6,*) 'Compiled with: ', compiler_version() - write(6,*) 'Compiler options: ', compiler_options() + write(6,'(/,a)') 'Compiled with: '//compiler_version() + write(6,'(a)') 'Compiler options: '//compiler_options() #else - write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& - ', build date :', __INTEL_COMPILER_BUILD_DATE + write(6,'(/,a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE #endif - write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + write(6,'(/,a)') ' Compiled on: '//__DATE__//' at '//__TIME__ - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) + call date_and_time(values = dateAndTime) + write(6,'(/,a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) - inquire(5, name=wd) ! determine inputputfile + inquire(5, name=wd) wd = wd(1:scan(wd,'/',back=.true.)) ierr = CHDIR(wd) if (ierr /= 0) then From 383e1befd51d8b2268824bed0b6517ffafc4532e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 11:02:12 +0100 Subject: [PATCH 37/67] polishing and extending citations --- src/DAMASK_abaqus.f | 2 +- src/DAMASK_interface.f90 | 2 +- src/DAMASK_marc.f90 | 2 +- src/damage_none.f90 | 74 ++++++++++++++---------------- src/homogenization_RGC.f90 | 10 ++-- src/plastic_disloUCLA.f90 | 5 +- src/plastic_dislotwin.f90 | 9 ++-- src/plastic_isotropic.f90 | 5 +- src/plastic_nonlocal.f90 | 10 +++- src/results.f90 | 45 +++++++++--------- src/spectral_damage.f90 | 5 +- src/spectral_mech_Basic.f90 | 8 +++- src/spectral_mech_Polarisation.f90 | 5 +- src/spectral_thermal.f90 | 5 +- src/spectral_utilities.f90 | 11 ++++- 15 files changed, 111 insertions(+), 87 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index 4a5b3f698..74f1a292f 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -49,7 +49,7 @@ subroutine DAMASK_interface_init write(6,'(/,a)') ' <<<+- DAMASK_abaqus init -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018.' + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018' write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' write(6,'(/,a)') ' Version: '//DAMASKVERSION diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index 16e7108f3..d0c5c426c 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -152,7 +152,7 @@ subroutine DAMASK_interface_init() write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018.' + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018' write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' write(6,'(/,a)') ' Version: '//DAMASKVERSION diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 7cd1e2e47..b447690bf 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -60,7 +60,7 @@ subroutine DAMASK_interface_init write(6,'(/,a)') ' <<<+- DAMASK_marc init -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018.' + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018' write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' write(6,'(/,a)') ' Version: '//DAMASKVERSION diff --git a/src/damage_none.f90 b/src/damage_none.f90 index 90b1acc72..b4fe1d4a8 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -4,11 +4,11 @@ !-------------------------------------------------------------------------------------------------- module damage_none - implicit none - private - - public :: & - damage_none_init + implicit none + private + + public :: & + damage_none_init contains @@ -16,43 +16,39 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine damage_none_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use prec, only: & - pInt - use IO, only: & - IO_timeStamp - use material - use config + use config, only: & + config_homogenization + use material, only: & + damage_initialPhi, & + damage, & + damage_type, & + material_homog, & + damageState, & + DAMAGE_NONE_LABEL, & + DAMAGE_NONE_ID - implicit none - integer(pInt) :: & - homog, & - NofMyHomog + implicit none + integer :: & + homog, & + NofMyHomog - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - initializeInstances: do homog = 1_pInt, material_Nhomogenization - - myhomog: if (damage_type(homog) == DAMAGE_none_ID) then - NofMyHomog = count(material_homog == homog) - damageState(homog)%sizeState = 0_pInt - damageState(homog)%sizePostResults = 0_pInt - allocate(damageState(homog)%state0 (0_pInt,NofMyHomog)) - allocate(damageState(homog)%subState0(0_pInt,NofMyHomog)) - allocate(damageState(homog)%state (0_pInt,NofMyHomog)) - - deallocate(damage(homog)%p) - allocate (damage(homog)%p(1), source=damage_initialPhi(homog)) - - endif myhomog - enddo initializeInstances + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_NONE_LABEL//' init -+>>>' + initializeInstances: do homog = 1, size(config_homogenization) + + myhomog: if (damage_type(homog) == DAMAGE_NONE_ID) then + NofMyHomog = count(material_homog == homog) + damageState(homog)%sizeState = 0 + damageState(homog)%sizePostResults = 0 + allocate(damageState(homog)%state0 (0,NofMyHomog)) + allocate(damageState(homog)%subState0(0,NofMyHomog)) + allocate(damageState(homog)%state (0,NofMyHomog)) + + deallocate(damage(homog)%p) + allocate (damage(homog)%p(1), source=damage_initialPhi(homog)) + + endif myhomog + enddo initializeInstances end subroutine damage_none_init diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 64558beaa..1d73b687c 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -137,13 +137,15 @@ subroutine homogenization_RGC_init() outputs write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' - write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming, 2(1):939–942, 2009' + + write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming 2(1):939–942, 2009' write(6,'(a)') ' https://doi.org/10.1007/s12289-009-0619-1' - write(6,'(/,a)') ' Tjahjanto et al., Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010' + + write(6,'(/,a)') ' Tjahjanto et al., Modelling and Simulation in Materials Science and Engineering 18:015006, 2010' write(6,'(a)') ' https://doi.org/10.1088/0965-0393/18/1/015006' - Ninstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) - if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & + Ninstance = count(homogenization_type == HOMOGENIZATION_RGC_ID) + if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(param(Ninstance)) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 372e429d6..836dab38e 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -158,8 +158,9 @@ subroutine plastic_disloUCLA_init() outputs write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_DISLOUCLA_label//' init -+>>>' - write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78, 2016, 242-256' - write(6,'(/,a)') ' http://dx.doi.org/10.1016/j.ijplas.2015.09.002' + + write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78:242–256, 2016' + write(6,'(a)') ' https://dx.doi.org/10.1016/j.ijplas.2015.09.002' Ninstance = int(count(phase_plasticity == PLASTICITY_DISLOUCLA_ID),pInt) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index cada56aca..41e01fbf4 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -230,11 +230,14 @@ subroutine plastic_dislotwin_init outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_label//' init -+>>>' - write(6,'(/,a)') ' A. Ma and F. Roters, Acta Materialia, 52(12):3603–3612, 2004' + + write(6,'(/,a)') ' Ma and Roters, Acta Materialia 52(12):3603–3612, 2004' write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2004.04.012' - write(6,'(/,a)') ' F.Roters et al., Computational Materials Science, 39:91–95, 2007' + + write(6,'(/,a)') ' Roters et al., Computational Materials Science 39:91–95, 2007' write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2006.04.014' - write(6,'(/,a)') ' Wong et al., Acta Materialia, 118:140–151, 2016' + + write(6,'(/,a)') ' Wong et al., Acta Materialia 118:140–151, 2016' write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032' Ninstance = count(phase_plasticity == PLASTICITY_DISLOTWIN_ID) diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index e0107d3ca..b86c9321d 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -125,8 +125,9 @@ subroutine plastic_isotropic_init outputs write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_ISOTROPIC_label//' init -+>>>' - write(6,'(/,a)') ' Maiti and Eisenlohr, Scripta Materialia, 145:37-40, 2018' - write(6,'(/,a)') ' https://doi.org/10.1016/j.scriptamat.2017.09.047' + + write(6,'(/,a)') ' Maiti and Eisenlohr, Scripta Materialia 145:37–40, 2018' + write(6,'(a)') ' https://doi.org/10.1016/j.scriptamat.2017.09.047' Ninstance = count(phase_plasticity == PLASTICITY_ISOTROPIC_ID) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index a92f1bbfd..1e87604b5 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -290,8 +290,14 @@ subroutine plastic_nonlocal_init write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_label//' init -+>>>' - maxNinstances = int(count(phase_plasticity == PLASTICITY_NONLOCAL_ID),pInt) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(/,a)') ' Reuber et al., Acta Materialia 71:333–348, 2014' + write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2014.03.012' + + write(6,'(/,a)') ' Kords, Dissertation RWTH Aachen, 2014' + write(6,'(a)') ' http://publications.rwth-aachen.de/record/229993' + + maxNinstances = count(phase_plasticity == PLASTICITY_NONLOCAL_ID) + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances diff --git a/src/results.f90 b/src/results.f90 index d38178993..f70e124f8 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -13,35 +13,36 @@ module results use PETSC #endif - implicit none - private - integer(HID_T), public, protected :: tempCoordinates, tempResults - integer(HID_T), private :: resultsFile, currentIncID, plist_id + implicit none + private + integer(HID_T), public, protected :: tempCoordinates, tempResults + integer(HID_T), private :: resultsFile, currentIncID, plist_id - public :: & - results_init, & - results_openJobFile, & - results_closeJobFile, & - results_addIncrement, & - results_addGroup, & - results_openGroup, & - results_writeVectorDataset, & - results_setLink, & - results_removeLink + public :: & + results_init, & + results_openJobFile, & + results_closeJobFile, & + results_addIncrement, & + results_addGroup, & + results_openGroup, & + results_writeVectorDataset, & + results_setLink, & + results_removeLink contains subroutine results_init - use, intrinsic :: & - iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) - use DAMASK_interface, only: & - getSolverJobName - implicit none + use DAMASK_interface, only: & + getSolverJobName - write(6,'(/,a)') ' <<<+- results init -+>>>' -#include "compilation_info.f90" + implicit none - call HDF5_closeFile(HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.)) + write(6,'(/,a)') ' <<<+- results init -+>>>' + + write(6,'(/,a)') ' Diehl et al., Integrating Materials and Manufacturing Innovation 6(1):83–91, 2017' + write(6,'(a)') ' https://doi.org/10.1007/s40192-018-0118-7' + + call HDF5_closeFile(HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.)) end subroutine results_init diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 index 4c581350e..212d36938 100644 --- a/src/spectral_damage.f90 +++ b/src/spectral_damage.f90 @@ -75,8 +75,9 @@ subroutine spectral_damage_init() character(len=100) :: snes_type write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' - write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press, ' - write(6,'(a,/)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' + + write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, 2019' + write(6,'(a)') ' https://doi.org/10.1007/978-981-10-6855-3_80' !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index ee7116486..4f32b098d 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -113,8 +113,12 @@ subroutine basic_init character(len=1024) :: rankStr write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasic init -+>>>' - write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015' - write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' + + write(6,'(/,a)') ' Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013' + write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2012.09.012' + + write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015' + write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' !-------------------------------------------------------------------------------------------------- ! allocate global fields diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index c36f2b716..d6e297c72 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -123,8 +123,9 @@ subroutine Polarisation_init character(len=1024) :: rankStr write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' - write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015' - write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' + + write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015' + write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' !-------------------------------------------------------------------------------------------------- ! allocate global fields diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index cb73d73ec..62b03d11f 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -76,8 +76,9 @@ subroutine spectral_thermal_init PetscErrorCode :: ierr write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' - write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press,' - write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018' + + write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, 2019' + write(6,'(a)') ' https://doi.org/10.1007/978-981-10-6855-3_80' !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index a17ad713f..8c79eabe2 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -194,8 +194,15 @@ subroutine utilities_init() tensorSize = 9_C_INTPTR_T write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' - write(6,'(/,a)') ' Eisenlohr et al., International Journal of Plasticity, 46:37–53, 2013' - write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2012.09.012' + + write(6,'(/,a)') ' Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013' + write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2012.09.012' + + write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015' + write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' + + write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, 2019' + write(6,'(a)') ' https://doi.org/10.1007/978-981-10-6855-3_80' !-------------------------------------------------------------------------------------------------- ! set debugging parameters From c3b7ff3a052ba1a5b72b4376e17dc650f714d816 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 12:10:19 +0100 Subject: [PATCH 38/67] typo --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index bbd15df75..ee3c35af0 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -239,7 +239,7 @@ Compile_Spectral_GNU: script: - module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU - cp -r SpectralAll_compile SpectralAll_compile_GNU - - SpectralAll_GNU/test.py + - SpectralAll_compile_GNU/test.py except: - master - release From 7bfd7a42eaf96c9595a34e4d2ece56ffd5a95c41 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 13:38:58 +0100 Subject: [PATCH 39/67] empty file needs special case for Ifort --- src/IO.f90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/IO.f90 b/src/IO.f90 index 99c92e038..983465caa 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -115,6 +115,10 @@ function IO_read_ASCII(fileName) result(fileContent) !-------------------------------------------------------------------------------------------------- ! read data as stream inquire(file = fileName, size=fileLength) + if (fileLength == 0) then + allocate(fileContent(0)) + return + endif open(newunit=fileUnit, file=fileName, access='stream',& status='old', position='rewind', action='read',iostat=myStat) if(myStat /= 0) call IO_error(100,ext_msg=trim(fileName)) @@ -186,6 +190,10 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent) !-------------------------------------------------------------------------------------------------- ! read data as stream inquire(file = fileName, size=fileLength) + if (fileLength == 0) then + allocate(fileContent(0)) + return + endif open(newunit=fileUnit, file=fileName, access='stream',& status='old', position='rewind', action='read',iostat=myStat) if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(fileName)) From f0d03a41bab8da5d8708c78041946115d0ed9ae4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 12:48:01 +0100 Subject: [PATCH 40/67] fracture modes are calculated differently --- src/lattice.f90 | 89 ++++++++++++------------------------------------- 1 file changed, 22 insertions(+), 67 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index c3cb9d489..1d3b5e502 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -511,19 +511,6 @@ module lattice module procedure slipProjection_direction end interface lattice_forestProjection_screw - interface lattice_slipProjection_modeI - module procedure slipProjection_normal - end interface lattice_slipProjection_modeI - - interface lattice_slipProjection_modeII - module procedure slipProjection_direction - end interface lattice_slipProjection_modeII - - interface lattice_slipProjection_modeIII - module procedure slipProjection_transverse - end interface lattice_slipProjection_modeIII - - public :: & lattice_init, & lattice_qDisorientation, & @@ -548,9 +535,6 @@ module lattice lattice_forestProjection, & lattice_forestProjection_edge, & lattice_forestProjection_screw, & - lattice_slipProjection_modeI, & - lattice_slipProjection_modeII, & - lattice_slipProjection_modeIII, & lattice_slip_normal, & lattice_slip_direction, & lattice_slip_transverse @@ -689,7 +673,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA) math_mul33x33, & math_sym3333to66, & math_Voigt66to3333, & - math_crossproduct + math_cross use IO, only: & IO_error @@ -830,7 +814,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA) do i = 1_pInt,myNslip ! store slip system vectors and Schmid matrix for my structure lattice_sd(1:3,i,myPhase) = sd(1:3,i)/norm2(sd(1:3,i)) ! make unit vector lattice_sn(1:3,i,myPhase) = sn(1:3,i)/norm2(sn(1:3,i)) ! make unit vector - lattice_st(1:3,i,myPhase) = math_crossproduct(lattice_sd(1:3,i,myPhase),lattice_sn(1:3,i,myPhase)) + lattice_st(1:3,i,myPhase) = math_cross(lattice_sd(1:3,i,myPhase),lattice_sn(1:3,i,myPhase)) enddo end subroutine lattice_initializeStructure @@ -1172,7 +1156,7 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA) use IO, only: & IO_error use math, only: & - INRAD, & + PI, & math_axisAngleToR, & math_sym3333to66, & math_66toSym3333, & @@ -1208,7 +1192,7 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA) end select do i = 1, sum(Ntwin) - R = math_axisAngleToR(coordinateSystem(1:3,2,i), 180.0_pReal * INRAD) ! ToDo: Why always 180 deg? + R = math_axisAngleToR(coordinateSystem(1:3,2,i), PI) ! ToDo: Why always 180 deg? lattice_C66_twin(1:6,1:6,i) = math_sym3333to66(math_rotate_forward3333(math_66toSym3333(C66),R)) enddo end function lattice_C66_twin @@ -1231,9 +1215,7 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_target, & math_sym3333to66, & math_66toSym3333, & math_rotate_forward3333, & - math_mul33x33, & - math_tensorproduct33, & - math_crossproduct + math_mul33x33 implicit none integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family @@ -1299,8 +1281,8 @@ function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSc IO_error use math, only: & INRAD, & - math_tensorproduct33, & - math_crossproduct, & + math_outer, & + math_cross, & math_mul33x3, & math_axisAngleToR implicit none @@ -1326,18 +1308,18 @@ function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSc normal = coordinateSystem(1:3,2,i) np = math_mul33x3(math_axisAngleToR(direction,60.0_pReal*INRAD), normal) if (size(nonSchmidCoefficients)>0) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(1) * math_tensorproduct33(direction, np) + + nonSchmidCoefficients(1) * math_outer(direction, np) if (size(nonSchmidCoefficients)>1) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(2) * math_tensorproduct33(math_crossproduct(normal, direction), normal) + + nonSchmidCoefficients(2) * math_outer(math_cross(normal, direction), normal) if (size(nonSchmidCoefficients)>2) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(3) * math_tensorproduct33(math_crossproduct(np, direction), np) + + nonSchmidCoefficients(3) * math_outer(math_cross(np, direction), np) if (size(nonSchmidCoefficients)>3) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(4) * math_tensorproduct33(normal, normal) + + nonSchmidCoefficients(4) * math_outer(normal, normal) if (size(nonSchmidCoefficients)>4) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(5) * math_tensorproduct33(math_crossproduct(normal, direction), & - math_crossproduct(normal, direction)) + + nonSchmidCoefficients(5) * math_outer(math_cross(normal, direction), & + math_cross(normal, direction)) if (size(nonSchmidCoefficients)>5) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(6) * math_tensorproduct33(direction, direction) + + nonSchmidCoefficients(6) * math_outer(direction, direction) enddo end function lattice_nonSchmidMatrix @@ -2274,8 +2256,7 @@ end function lattice_slip_transverse !-------------------------------------------------------------------------------------------------- !> @brief Projection of the transverse direction onto the slip plane -!> @details: This projection is used to calculate forest hardening for edge dislocations and for -! mode III failure (ToDo: MD I am not 100% sure about mode III) +!> @details: This projection is used to calculate forest hardening for edge dislocations !-------------------------------------------------------------------------------------------------- function slipProjection_transverse(Nslip,structure,cOverA) result(projection) use math, only: & @@ -2301,8 +2282,7 @@ end function slipProjection_transverse !-------------------------------------------------------------------------------------------------- !> @brief Projection of the slip direction onto the slip plane -!> @details: This projection is used to calculate forest hardening for screw dislocations and for -! mode II failure (ToDo: MD I am not 100% sure about mode II) +!> @details: This projection is used to calculate forest hardening for screw dislocations !-------------------------------------------------------------------------------------------------- function slipProjection_direction(Nslip,structure,cOverA) result(projection) use math, only: & @@ -2326,32 +2306,6 @@ function slipProjection_direction(Nslip,structure,cOverA) result(projection) end function slipProjection_direction -!-------------------------------------------------------------------------------------------------- -!> @brief Projection of the slip plane onto itself -!> @details: This projection is used for mode I failure -!-------------------------------------------------------------------------------------------------- -function slipProjection_normal(Nslip,structure,cOverA) result(projection) - use math, only: & - math_mul3x3 - - implicit none - integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection - - real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - integer(pInt) :: i, j - - coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) - - do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) - projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,j))) - enddo; enddo - -end function slipProjection_normal - - !-------------------------------------------------------------------------------------------------- !> @brief build a local coordinate system on slip systems !> @details Order: Direction, plane (normal), and common perpendicular @@ -2406,6 +2360,7 @@ end function coordinateSystem_slip function buildInteraction(activeA,activeB,maxA,maxB,values,matrix) use IO, only: & IO_error + implicit none integer(pInt), dimension(:), intent(in) :: & activeA, & !< number of active systems as specified in material.config @@ -2446,7 +2401,7 @@ function buildCoordinateSystem(active,complete,system,structure,cOverA) use IO, only: & IO_error use math, only: & - math_crossproduct + math_cross implicit none integer(pInt), dimension(:), intent(in) :: & @@ -2503,8 +2458,8 @@ function buildCoordinateSystem(active,complete,system,structure,cOverA) buildCoordinateSystem(1:3,1,a) = direction/norm2(direction) buildCoordinateSystem(1:3,2,a) = normal/norm2(normal) - buildCoordinateSystem(1:3,3,a) = math_crossproduct(buildCoordinateSystem(1:3,1,a),& - buildCoordinateSystem(1:3,2,a)) + buildCoordinateSystem(1:3,3,a) = math_cross(buildCoordinateSystem(1:3,1,a),& + buildCoordinateSystem(1:3,2,a)) enddo activeSystems enddo activeFamilies @@ -2522,7 +2477,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) use prec, only: & dEq0 use math, only: & - math_crossproduct, & + math_cross, & math_tensorproduct33, & math_mul33x33, & math_mul33x3, & @@ -2643,7 +2598,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) do i = 1_pInt,sum(Ntrans) x = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) z = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) - y = -math_crossproduct(x,z) + y = -math_cross(x,z) Q(1:3,1,i) = x Q(1:3,2,i) = y Q(1:3,3,i) = z From eba763cf385e61dc1d798a739350c2201df80add Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 12:48:43 +0100 Subject: [PATCH 41/67] not needed anymore --- src/plastic_nonlocal.f90 | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 1e87604b5..ec3dfd9bf 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -32,12 +32,6 @@ module plastic_nonlocal integer(pInt), dimension(:), allocatable, public, protected :: & totalNslip !< total number of active slip systems for each instance - integer(pInt), dimension(:,:), allocatable, private :: & - Nslip, & !< number of active slip systems - slipFamily !< lookup table relating active slip system to slip family for each instance - - - real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & compatibility !< slip system compatibility between me and my neighbors @@ -312,8 +306,6 @@ subroutine plastic_nonlocal_init allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) plastic_nonlocal_output = '' allocate(plastic_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID) - allocate(Nslip(lattice_maxNslipFamily,maxNinstances), source=0_pInt) - allocate(slipFamily(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(totalNslip(maxNinstances), source=0_pInt) @@ -604,8 +596,7 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' plasticState(p)%offsetDeltaState = 0_pInt ! ToDo: state structure does not follow convention plasticState(p)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,phase_plasticityInstance(p))) - Nslip(1:size(prm%Nslip),phase_plasticityInstance(p)) = prm%Nslip ! ToDo: DEPRECATED - totalNslip(phase_plasticityInstance(p)) = sum(Nslip(1:size(prm%Nslip),phase_plasticityInstance(p))) ! ToDo: DEPRECATED + totalNslip(phase_plasticityInstance(p)) = prm%totalNslip ! ToDo: Not really sure if this large number of mostly overlapping pointers is useful stt%rho => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) @@ -1868,7 +1859,7 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then endif - !*** be aware of the definition of lattice_st = lattice_sd x lattice_sn !!! + !*** be aware of the definition of slip_transverse = slip_direction x slip_normal !!! !*** opposite sign to our p vector in the (s,p,n) triplet !!! m(1:3,1:ns,1) = prm%slip_direction @@ -2154,8 +2145,7 @@ use rotations, only: rotation use material, only: material_phase, & material_texture, & phase_localPlasticity, & - phase_plasticityInstance, & - homogenization_maxNgrains + phase_plasticityInstance use mesh, only: mesh_ipNeighborhood, & theMesh use lattice, only: lattice_qDisorientation From 1bf31598c55242513159337fae780f887e329a22 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 12:50:05 +0100 Subject: [PATCH 42/67] avoid usage of lattice variables --- src/kinematics_slipplane_opening.f90 | 164 +++++++++++---------------- src/source_damage_anisoDuctile.f90 | 42 +++---- 2 files changed, 77 insertions(+), 129 deletions(-) diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 86be20c9d..0fa80ece8 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -22,26 +22,14 @@ module kinematics_slipplane_opening sdot0, & n real(pReal), dimension(:), allocatable :: & - critDisp, & - critPlasticStrain - end type + critLoad + real(pReal), dimension(:,:), allocatable :: & + slip_direction, & + slip_normal, & + slip_transverse + end type tParameters -! Begin Deprecated - integer(pInt), dimension(:), allocatable, private :: & - kinematics_slipplane_opening_totalNslip !< total number of slip systems - - integer(pInt), dimension(:,:), allocatable, private :: & - kinematics_slipplane_opening_Nslip !< number of slip systems per family - - real(pReal), dimension(:), allocatable, private :: & - kinematics_slipplane_opening_sdot_0, & - kinematics_slipplane_opening_N - - real(pReal), dimension(:,:), allocatable, private :: & - kinematics_slipplane_opening_critPlasticStrain, & - kinematics_slipplane_opening_critLoad -! End Deprecated - + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) public :: & kinematics_slipplane_opening_init, & kinematics_slipplane_opening_LiAndItsTangent @@ -54,11 +42,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine kinematics_slipplane_opening_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use debug, only: & debug_level,& debug_constitutive,& @@ -66,29 +49,23 @@ subroutine kinematics_slipplane_opening_init() use config, only: & config_phase use IO, only: & - IO_warning, & - IO_error, & - IO_timeStamp + IO_error + use math, only: & + math_expand use material, only: & phase_kinematics, & KINEMATICS_slipplane_opening_label, & KINEMATICS_slipplane_opening_ID - use lattice, only: & - lattice_maxNslipFamily, & - lattice_NslipSystem + use lattice implicit none - integer(pInt), allocatable, dimension(:) :: tempInt - real(pReal), allocatable, dimension(:) :: tempFloat integer(pInt) :: maxNinstance,p,instance,kinematics write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - maxNinstance = int(count(phase_kinematics == KINEMATICS_slipplane_opening_ID),pInt) - if (maxNinstance == 0_pInt) return + maxNinstance = count(phase_kinematics == KINEMATICS_slipplane_opening_ID) + if (maxNinstance == 0) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance @@ -97,38 +74,38 @@ subroutine kinematics_slipplane_opening_init() do p = 1_pInt, size(config_phase) kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct? enddo - - allocate(kinematics_slipplane_opening_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(kinematics_slipplane_opening_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(kinematics_slipplane_opening_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(kinematics_slipplane_opening_totalNslip(maxNinstance), source=0_pInt) - allocate(kinematics_slipplane_opening_N(maxNinstance), source=0.0_pReal) - allocate(kinematics_slipplane_opening_sdot_0(maxNinstance), source=0.0_pReal) - + + allocate(param(maxNinstance)) + do p = 1_pInt, size(config_phase) if (all(phase_kinematics(:,p) /= KINEMATICS_slipplane_opening_ID)) cycle + associate(prm => param(kinematics_slipplane_opening_instance(p)), & + config => config_phase(p)) instance = kinematics_slipplane_opening_instance(p) - kinematics_slipplane_opening_sdot_0(instance) = config_phase(p)%getFloat('anisoductile_sdot0') - kinematics_slipplane_opening_N(instance) = config_phase(p)%getFloat('anisoductile_ratesensitivity') - tempInt = config_phase(p)%getInts('ncleavage') - kinematics_slipplane_opening_Nslip(1:size(tempInt),instance) = tempInt + prm%sdot0 = config_phase(p)%getFloat('anisoductile_sdot0') + prm%n = config_phase(p)%getFloat('anisoductile_ratesensitivity') + + prm%Nslip = config%getInts('nslip') - tempFloat = config_phase(p)%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(tempInt)) - kinematics_slipplane_opening_critPlasticStrain(1:size(tempInt),instance) = tempFloat + prm%critLoad = config_phase(p)%getFloats('anisoductile_criticalload',requiredSize=size(prm%Nslip )) - tempFloat = config_phase(p)%getFloats('anisoductile_criticalload',requiredSize=size(tempInt)) - kinematics_slipplane_opening_critLoad(1:size(tempInt),instance) = tempFloat + prm%critLoad = math_expand(prm%critLoad, prm%Nslip) + +prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) - kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance) = & - min(lattice_NslipSystem(1:lattice_maxNslipFamily,p),& ! limit active cleavage systems per family to min of available and requested - kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance)) - kinematics_slipplane_opening_totalNslip(instance) = sum(kinematics_slipplane_opening_Nslip(:,instance)) - if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')') - if (any(kinematics_slipplane_opening_critPlasticStrain(:,instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')') - if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')') + ! if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')') + ! if (any(kinematics_slipplane_opening_critPlasticStrain(:,instance) < 0.0_pReal)) & + ! call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')') + ! if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')') + + end associate enddo end subroutine kinematics_slipplane_opening_init @@ -140,23 +117,16 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, use prec, only: & tol_math_check use math, only: & - math_mul33xx33 - use lattice, only: & - lattice_maxNslipFamily, & - lattice_NslipSystem, & - lattice_sd, & - lattice_st, & - lattice_sn + math_mul33xx33, & + math_outer use material, only: & material_phase, & material_homog, & damage, & damageMapping - use math, only: & - math_tensorproduct33 - + implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< grain number ip, & !< integration point number el !< element number @@ -168,10 +138,10 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) real(pReal), dimension(3,3) :: & projection_d, projection_t, projection_n !< projection modes 3x3 tensor - integer(pInt) :: & + integer :: & instance, phase, & homog, damageOffset, & - f, i, index_myFamily, k, l, m, n + i, k, l, m, n real(pReal) :: & traction_d, traction_t, traction_n, traction_crit, & udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt @@ -181,66 +151,60 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, homog = material_homog(ip,el) damageOffset = damageMapping(homog)%p(ip,el) + associate(prm => param(instance)) Ld = 0.0_pReal dLd_dTstar = 0.0_pReal - do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,kinematics_slipplane_opening_Nslip(f,instance) ! process each (active) slip system in family - projection_d = math_tensorproduct33(lattice_sd(1:3,index_myFamily+i,phase),& - lattice_sn(1:3,index_myFamily+i,phase)) - projection_t = math_tensorproduct33(lattice_st(1:3,index_myFamily+i,phase),& - lattice_sn(1:3,index_myFamily+i,phase)) - projection_n = math_tensorproduct33(lattice_sn(1:3,index_myFamily+i,phase),& - lattice_sn(1:3,index_myFamily+i,phase)) + do i = 1, prm%totalNslip + projection_d = math_outer(prm%slip_direction(1:3,i),prm%slip_normal(1:3,i)) + projection_t = math_outer(prm%slip_transverse(1:3,i),prm%slip_normal(1:3,i)) + projection_n = math_outer(prm%slip_normal(1:3,i),prm%slip_normal(1:3,i)) traction_d = math_mul33xx33(S,projection_d) traction_t = math_mul33xx33(S,projection_t) traction_n = math_mul33xx33(S,projection_n) - traction_crit = kinematics_slipplane_opening_critLoad(f,instance)* & - damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage + traction_crit = prm%critLoad(i)* damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage - udotd = & - sign(1.0_pReal,traction_d)* & - kinematics_slipplane_opening_sdot_0(instance)* & + udotd = sign(1.0_pReal,traction_d)* & + prm%sdot0* & (abs(traction_d)/traction_crit - & - abs(traction_d)/kinematics_slipplane_opening_critLoad(f,instance))**kinematics_slipplane_opening_N(instance) + abs(traction_d)/prm%critLoad(i))**prm%n if (abs(udotd) > tol_math_check) then Ld = Ld + udotd*projection_d - dudotd_dt = udotd*kinematics_slipplane_opening_N(instance)/traction_d + dudotd_dt = udotd*prm%n/traction_d forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotd_dt*projection_d(k,l)*projection_d(m,n) endif - udott = & - sign(1.0_pReal,traction_t)* & - kinematics_slipplane_opening_sdot_0(instance)* & + udott = sign(1.0_pReal,traction_t)* & + prm%sdot0* & (abs(traction_t)/traction_crit - & - abs(traction_t)/kinematics_slipplane_opening_critLoad(f,instance))**kinematics_slipplane_opening_N(instance) + abs(traction_t)/prm%critLoad(i))**prm%n if (abs(udott) > tol_math_check) then Ld = Ld + udott*projection_t - dudott_dt = udott*kinematics_slipplane_opening_N(instance)/traction_t + dudott_dt = udott*prm%n/traction_t forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudott_dt*projection_t(k,l)*projection_t(m,n) endif udotn = & - kinematics_slipplane_opening_sdot_0(instance)* & + prm%sdot0* & (max(0.0_pReal,traction_n)/traction_crit - & - max(0.0_pReal,traction_n)/kinematics_slipplane_opening_critLoad(f,instance))**kinematics_slipplane_opening_N(instance) + max(0.0_pReal,traction_n)/prm%critLoad(i))**prm%n if (abs(udotn) > tol_math_check) then Ld = Ld + udotn*projection_n - dudotn_dt = udotn*kinematics_slipplane_opening_N(instance)/traction_n + dudotn_dt = udotn*prm%n/traction_n forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotn_dt*projection_n(k,l)*projection_n(m,n) endif - enddo enddo +end associate + end subroutine kinematics_slipplane_opening_LiAndItsTangent end module kinematics_slipplane_opening diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index dd5b95893..07f8e5e58 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -22,9 +22,6 @@ module source_damage_anisoDuctile source_damage_anisoDuctile_output !< name of each post result output - integer(pInt), dimension(:,:), allocatable, private :: & - source_damage_anisoDuctile_Nslip !< number of slip systems per family - enum, bind(c) enumerator :: undefined_ID, & damage_drivingforce_ID @@ -37,9 +34,9 @@ module source_damage_anisoDuctile N real(pReal), dimension(:), allocatable :: & critPlasticStrain - integer(pInt) :: & + integer :: & totalNslip - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & Nslip integer(kind(undefined_ID)), allocatable, dimension(:) :: & outputID @@ -82,13 +79,10 @@ subroutine source_damage_anisoDuctile_init material_phase, & sourceState use config, only: & - config_phase, & - material_Nphase - use lattice, only: & - lattice_maxNslipFamily + config_phase + implicit none - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset integer(pInt) :: NofMyPhase,p ,i @@ -110,9 +104,9 @@ subroutine source_damage_anisoDuctile_init if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(source_damage_anisoDuctile_offset(material_Nphase), source=0_pInt) - allocate(source_damage_anisoDuctile_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase + allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0_pInt) + allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0_pInt) + do phase = 1, size(config_phase) source_damage_anisoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoDuctile_ID) do source = 1, phase_Nsources(phase) if (phase_source(source,phase) == source_damage_anisoDuctile_ID) & @@ -124,7 +118,6 @@ subroutine source_damage_anisoDuctile_init allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoDuctile_output = '' - allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -136,7 +129,7 @@ subroutine source_damage_anisoDuctile_init prm%aTol = config%getFloat('anisoductile_atol',defaultVal = 1.0e-3_pReal) prm%N = config%getFloat('anisoductile_ratesensitivity') - + prm%totalNslip = sum(prm%Nslip) ! sanity checks if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_atol' @@ -185,8 +178,6 @@ subroutine source_damage_anisoDuctile_init sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - source_damage_anisoDuctile_Nslip(1:size(param(instance)%Nslip),instance) = param(instance)%Nslip - enddo end subroutine source_damage_anisoDuctile_init @@ -202,8 +193,6 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) material_homog, & damage, & damageMapping - use lattice, only: & - lattice_maxNslipFamily implicit none integer(pInt), intent(in) :: & @@ -216,7 +205,7 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) sourceOffset, & homog, damageOffset, & instance, & - index, f, i + f, i phase = phaseAt(ipc,ip,el) constituent = phasememberAt(ipc,ip,el) @@ -225,17 +214,12 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) homog = material_homog(ip,el) damageOffset = damageMapping(homog)%p(ip,el) - index = 1_pInt - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal - do f = 1_pInt,lattice_maxNslipFamily - do i = 1_pInt,source_damage_anisoDuctile_Nslip(f,instance) ! process each (active) slip system in family + + do i = 1, param(instance)%totalNslip sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & - plasticState(phase)%slipRate(index,constituent)/ & - ((damage(homog)%p(damageOffset))**param(instance)%N)/param(instance)%critPlasticStrain(index) - - index = index + 1_pInt - enddo + plasticState(phase)%slipRate(i,constituent)/ & + ((damage(homog)%p(damageOffset))**param(instance)%N)/param(instance)%critPlasticStrain(i) enddo end subroutine source_damage_anisoDuctile_dotState From c74f4534866c3b63f101af50386d8609d7d252f9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 13:03:33 +0100 Subject: [PATCH 43/67] public variables not needed anymore --- src/lattice.f90 | 85 ++++++------------------------------------------- 1 file changed, 10 insertions(+), 75 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 1d3b5e502..db95bca3e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -16,27 +16,20 @@ module lattice ! BEGIN DEPRECATED integer(pInt), parameter, public :: & - LATTICE_maxNslipFamily = 13_pInt, & !< max # of slip system families over lattice structures LATTICE_maxNcleavageFamily = 3_pInt !< max # of transformation system families over lattice structures integer(pInt), allocatable, dimension(:,:), protected, public :: & - lattice_NslipSystem, & !< total # of slip systems in each family lattice_NcleavageSystem !< total # of transformation systems in each family real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: & lattice_Scleavage !< Schmid matrices for cleavage systems - - real(pReal), allocatable, dimension(:,:,:), protected, public :: & - lattice_sn, & !< normal direction of slip system - lattice_st, & !< sd x sn - lattice_sd !< slip direction of slip system ! END DEPRECATED !-------------------------------------------------------------------------------------------------- ! face centered cubic - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: & - LATTICE_FCC_NSLIPSYSTEM = int([12, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for fcc + integer(pInt), dimension(2), parameter, private :: & + LATTICE_FCC_NSLIPSYSTEM = int([12, 6],pInt) !< # of slip systems per family for fcc integer(pInt), dimension(1), parameter, private :: & LATTICE_FCC_NTWINSYSTEM = int([12],pInt) !< # of twin systems per family for fcc @@ -131,8 +124,8 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered cubic - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: & - LATTICE_BCC_NSLIPSYSTEM = int([ 12, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], pInt) !< # of slip systems per family for bcc + integer(pInt), dimension(2), parameter, private :: & + LATTICE_BCC_NSLIPSYSTEM = int([12, 12], pInt) !< # of slip systems per family for bcc integer(pInt), dimension(1), parameter, private :: & LATTICE_BCC_NTWINSYSTEM = int([12], pInt) !< # of twin systems per family for bcc @@ -216,8 +209,8 @@ module lattice !-------------------------------------------------------------------------------------------------- ! hexagonal - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: & - LATTICE_HEX_NSLIPSYSTEM = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex + integer(pInt), dimension(6), parameter, private :: & + LATTICE_HEX_NSLIPSYSTEM = int([ 3, 3, 3, 6, 12, 6],pInt) !< # of slip systems per family for hex integer(pInt), dimension(4), parameter, private :: & LATTICE_HEX_NTWINSYSTEM = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex @@ -331,7 +324,7 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered tetragonal - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: & + integer(pInt), dimension(13), parameter, private :: & LATTICE_bct_NslipSystem = int([2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ],pInt) !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009 integer(pInt), parameter, private :: & @@ -458,8 +451,6 @@ module lattice ! BEGIN DEPRECATED integer(pInt), parameter, public :: & - LATTICE_maxNslip = max(LATTICE_FCC_NSLIP,LATTICE_BCC_NSLIP,LATTICE_HEX_NSLIP, & - LATTICE_bct_Nslip), & !< max # of slip systems over lattice structures LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & LATTICE_hex_Ncleavage, & LATTICE_iso_Ncleavage,LATTICE_ort_Ncleavage) !< max # of cleavage systems over lattice structures @@ -581,18 +572,12 @@ subroutine lattice_init allocate(lattice_mu(Nphases), source=0.0_pReal) allocate(lattice_nu(Nphases), source=0.0_pReal) - allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt) - allocate(lattice_Scleavage(3,3,3,lattice_maxNslip,Nphases),source=0.0_pReal) + allocate(lattice_Scleavage(3,3,3,lattice_maxNcleavage,Nphases),source=0.0_pReal) allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0_pInt) allocate(CoverA(Nphases),source=0.0_pReal) - allocate(lattice_sd(3,lattice_maxNslip,Nphases),source=0.0_pReal) - allocate(lattice_st(3,lattice_maxNslip,Nphases),source=0.0_pReal) - allocate(lattice_sn(3,lattice_maxNslip,Nphases),source=0.0_pReal) - - do p = 1, size(config_phase) tag = config_phase(p)%getString('lattice_structure') select case(trim(tag)) @@ -682,11 +667,9 @@ subroutine lattice_initializeStructure(myPhase,CoverA) real(pReal), intent(in) :: & CoverA - real(pReal), dimension(3,lattice_maxNslip) :: & - sd, sn integer(pInt) :: & i, & - myNslip, myNcleavage + myNcleavage lattice_C66(1:6,1:6,myPhase) = lattice_symmetrizeC66(lattice_structure(myPhase),& lattice_C66(1:6,1:6,myPhase)) @@ -715,77 +698,36 @@ subroutine lattice_initializeStructure(myPhase,CoverA) lattice_thermalConductivity33 (1:3,1:3,myPhase)) lattice_DamageDiffusion33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& lattice_DamageDiffusion33 (1:3,1:3,myPhase)) - myNslip = 0_pInt myNcleavage = 0_pInt select case(lattice_structure(myPhase)) !-------------------------------------------------------------------------------------------------- ! fcc case (LATTICE_fcc_ID) - myNslip = LATTICE_FCC_NSLIP myNcleavage = lattice_fcc_Ncleavage - lattice_NslipSystem (1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & lattice_SchmidMatrix_cleavage(lattice_fcc_ncleavageSystem,'fcc',covera) - do i = 1_pInt,myNslip - sd(1:3,i) = lattice_fcc_systemSlip(1:3,i) - sn(1:3,i) = lattice_fcc_systemSlip(4:6,i) - enddo - - !-------------------------------------------------------------------------------------------------- ! bcc case (LATTICE_bcc_ID) - myNslip = LATTICE_BCC_NSLIP myNcleavage = lattice_bcc_Ncleavage - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bcc_NslipSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bcc_NcleavageSystem lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & lattice_SchmidMatrix_cleavage(lattice_bcc_ncleavagesystem,'bcc',covera) - - do i = 1_pInt,myNslip - sd(1:3,i) = lattice_bcc_systemSlip(1:3,i) - sn(1:3,i) = lattice_bcc_systemSlip(4:6,i) - enddo - + !-------------------------------------------------------------------------------------------------- ! hex (including conversion from miller-bravais (a1=a2=a3=c) to miller (a, b, c) indices) case (LATTICE_hex_ID) - myNslip = LATTICE_HEX_NSLIP myNcleavage = lattice_hex_Ncleavage - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = LATTICE_HEX_NSLIPSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_hex_NcleavageSystem lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & lattice_SchmidMatrix_cleavage(lattice_hex_ncleavagesystem,'hex',covera) - do i = 1_pInt,myNslip ! assign slip system vectors - sd(1,i) = lattice_hex_systemSlip(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] - sd(2,i) = (lattice_hex_systemSlip(1,i)+2.0_pReal*lattice_hex_systemSlip(2,i))*& - 0.5_pReal*sqrt(3.0_pReal) - sd(3,i) = lattice_hex_systemSlip(4,i)*CoverA - sn(1,i) = lattice_hex_systemSlip(5,i) ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) - sn(2,i) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))/sqrt(3.0_pReal) - sn(3,i) = lattice_hex_systemSlip(8,i)/CoverA - enddo - -!-------------------------------------------------------------------------------------------------- -! bct - case (LATTICE_bct_ID) - myNslip = lattice_bct_Nslip - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bct_NslipSystem - - do i = 1_pInt,myNslip ! assign slip system vectors - sd(1:2,i) = lattice_bct_systemSlip(1:2,i) - sd(3,i) = lattice_bct_systemSlip(3,i)*CoverA - sn(1:2,i) = lattice_bct_systemSlip(4:5,i) - sn(3,i) = lattice_bct_systemSlip(6,i)/CoverA - enddo - !-------------------------------------------------------------------------------------------------- ! orthorhombic (no crystal plasticity) case (LATTICE_ort_ID) @@ -810,13 +752,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA) call IO_error(130_pInt,ext_msg='lattice_initializeStructure') end select - - do i = 1_pInt,myNslip ! store slip system vectors and Schmid matrix for my structure - lattice_sd(1:3,i,myPhase) = sd(1:3,i)/norm2(sd(1:3,i)) ! make unit vector - lattice_sn(1:3,i,myPhase) = sn(1:3,i)/norm2(sn(1:3,i)) ! make unit vector - lattice_st(1:3,i,myPhase) = math_cross(lattice_sd(1:3,i,myPhase),lattice_sn(1:3,i,myPhase)) - enddo - end subroutine lattice_initializeStructure From 22a3596561a8f65fa70ce2179914c0c0cb32bbe6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 13:20:17 +0100 Subject: [PATCH 44/67] simplified, trying to get rid of all public variables --- PRIVATE | 2 +- src/lattice.f90 | 71 +++++++++++++++++++++---------------------------- 2 files changed, 32 insertions(+), 41 deletions(-) diff --git a/PRIVATE b/PRIVATE index 219fe1741..53a382817 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 219fe1741a801b4af02616b9eed7eb5d70a6b8ed +Subproject commit 53a38281786257ebb96e7bdde577ac45a90c2054 diff --git a/src/lattice.f90 b/src/lattice.f90 index db95bca3e..cacc3ea08 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -37,8 +37,8 @@ module lattice integer(pInt), dimension(1), parameter, private :: & LATTICE_FCC_NTRANSSYSTEM = int([12],pInt) !< # of transformation systems per family for fcc - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: & - LATTICE_FCC_NCLEAVAGESYSTEM = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc + integer(pInt), dimension(2), parameter, private :: & + LATTICE_FCC_NCLEAVAGESYSTEM = int([3, 4 ],pInt) !< # of cleavage systems per family for fcc integer(pInt), parameter, private :: & LATTICE_FCC_NSLIP = sum(LATTICE_FCC_NSLIPSYSTEM), & !< total # of slip systems for fcc @@ -111,7 +111,7 @@ module lattice ],pInt),shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR)) real(pReal), dimension(3+3,LATTICE_fcc_Ncleavage), parameter, private :: & - LATTICE_fcc_systemCleavage = reshape(real([& + LATTICE_FCC_SYSTEMCLEAVAGE = reshape(real([& ! Cleavage direction Plane normal 0, 1, 0, 1, 0, 0, & 0, 0, 1, 0, 1, 0, & @@ -130,16 +130,16 @@ module lattice integer(pInt), dimension(1), parameter, private :: & LATTICE_BCC_NTWINSYSTEM = int([12], pInt) !< # of twin systems per family for bcc - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: & - LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc + integer(pInt), dimension(2), parameter, private :: & + LATTICE_BCC_NCLEAVAGESYSTEM = int([3, 6],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & LATTICE_BCC_NSLIP = sum(LATTICE_BCC_NSLIPSYSTEM), & !< total # of slip systems for bcc LATTICE_BCC_NTWIN = sum(LATTICE_BCC_NTWINSYSTEM), & !< total # of twin systems for bcc - LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc + LATTICE_BCC_NCLEAVAGE = sum(LATTICE_BCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for bcc real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: & - LATTICE_bcc_systemSlip = reshape(real([& + LATTICE_BCC_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! Slip system <111>{110} 1,-1, 1, 0, 1, 1, & @@ -174,7 +174,7 @@ module lattice '<1 -1 1>{2 1 1}'] real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter, private :: & - LATTICE_bcc_systemTwin = reshape(real([& + LATTICE_BCC_SYSTEMTWIN = reshape(real([& ! Twin system <111>{112} -1, 1, 1, 2, 1, 1, & 1, 1, 1, -2, 1, 1, & @@ -194,7 +194,7 @@ module lattice ['<1 1 1>{2 1 1}'] real(pReal), dimension(3+3,LATTICE_bcc_Ncleavage), parameter, private :: & - LATTICE_bcc_systemCleavage = reshape(real([& + LATTICE_BCC_SYSTEMCLEAVAGE = reshape(real([& ! Cleavage direction Plane normal 0, 1, 0, 1, 0, 0, & 0, 0, 1, 0, 1, 0, & @@ -215,16 +215,16 @@ module lattice integer(pInt), dimension(4), parameter, private :: & LATTICE_HEX_NTWINSYSTEM = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: & - LATTICE_hex_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for hex + integer(pInt), dimension(1), parameter, private :: & + LATTICE_HEX_NCLEAVAGESYSTEM = int([3],pInt) !< # of cleavage systems per family for hex integer(pInt), parameter, private :: & LATTICE_HEX_NSLIP = sum(LATTICE_HEX_NSLIPSystem), & !< total # of slip systems for hex LATTICE_HEX_NTWIN = sum(LATTICE_HEX_NTWINSYSTEM), & !< total # of twin systems for hex - LATTICE_hex_Ncleavage = sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex + LATTICE_HEX_NCLEAVAGE = sum(LATTICE_HEX_NCLEAVAGESYSTEM) !< total # of cleavage systems for hex real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter, private :: & - LATTICE_hex_systemSlip = reshape(real([& + LATTICE_HEX_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! Basal systems <11.0>{00.1} (independent of c/a-ratio, Bravais notation (4 coordinate base)) 2, -1, -1, 0, 0, 0, 0, 1, & @@ -275,8 +275,8 @@ module lattice '<1 1 . 3>{-1 0 . 1} ', & '<1 1 . 3>{-1 -1 . 2}'] - real(pReal), dimension(4+4,LATTICE_hex_Ntwin), parameter, private :: & - LATTICE_hex_systemTwin = reshape(real([& + real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter, private :: & + LATTICE_HEX_SYSTEMTWIN = reshape(real([& ! Compression or Tension =f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981) 1, -1, 0, 1, -1, 1, 0, 2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a) -1, 0, 1, 1, 1, 0, -1, 2, & @@ -313,8 +313,8 @@ module lattice '<1 0 . -2>{1 0 . 1} ', & '<1 1 . -3>{1 1 . 2} '] - real(pReal), dimension(4+4,LATTICE_hex_Ncleavage), parameter, private :: & - LATTICE_hex_systemCleavage = reshape(real([& + real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter, private :: & + LATTICE_HEX_SYSTEMCLEAVAGE = reshape(real([& ! Cleavage direction Plane normal 2,-1,-1, 0, 0, 0, 0, 1, & 0, 0, 0, 1, 2,-1,-1, 0, & @@ -325,13 +325,13 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered tetragonal integer(pInt), dimension(13), parameter, private :: & - LATTICE_bct_NslipSystem = int([2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ],pInt) !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009 + LATTICE_BCT_NSLIPSYSTEM = int([2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ],pInt) !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009 integer(pInt), parameter, private :: & - LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem) !< total # of slip systems for bct + LATTICE_BCT_NSLIP = sum(LATTICE_BCT_NSLIPSYSTEM) !< total # of slip systems for bct - real(pReal), dimension(3+3,LATTICE_bct_Nslip), parameter, private :: & - LATTICE_bct_systemSlip = reshape(real([& + real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter, private :: & + LATTICE_BCT_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! Slip family 1 {100)<001] (Bravais notation {hkl) Date: Sat, 9 Mar 2019 15:57:11 +0100 Subject: [PATCH 45/67] not needed anymore --- .../mods_MarcMentat/2018.1/Marc_tools/include_linux64 | 8 ++++---- .../mods_MarcMentat/2018/Marc_tools/include_linux64 | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/installation/mods_MarcMentat/2018.1/Marc_tools/include_linux64 b/installation/mods_MarcMentat/2018.1/Marc_tools/include_linux64 index 53eef9d83..661d3aaca 100644 --- a/installation/mods_MarcMentat/2018.1/Marc_tools/include_linux64 +++ b/installation/mods_MarcMentat/2018.1/Marc_tools/include_linux64 @@ -400,12 +400,12 @@ MARCCODEPROF= #MARCCODEPROF="ON" if test "$MARC_INTEGER_SIZE" = "i4" ; then - I8FFLAGS="-real-size 64 -integer-size 32" - I8DEFINES="-DFLOAT=8 -DINT=4" + I8FFLAGS= + I8DEFINES= I8CDEFINES= else - I8FFLAGS="-i8 -real-size 64 -integer-size 64" - I8DEFINES="-DI64 -DFLOAT=8 -DINT=8" + I8FFLAGS="-i8 -integer-size 64" + I8DEFINES="-DI64 -DINT=8" I8CDEFINES="-U_DOUBLE -D_SINGLE" fi diff --git a/installation/mods_MarcMentat/2018/Marc_tools/include_linux64 b/installation/mods_MarcMentat/2018/Marc_tools/include_linux64 index 62d09ee8e..270184af2 100644 --- a/installation/mods_MarcMentat/2018/Marc_tools/include_linux64 +++ b/installation/mods_MarcMentat/2018/Marc_tools/include_linux64 @@ -391,12 +391,12 @@ MARCCODEPROF= #MARCCODEPROF="ON" if test "$MARC_INTEGER_SIZE" = "i4" ; then - I8FFLAGS="-real-size 64 -integer-size 32" - I8DEFINES="-DFLOAT=8 -DINT=4" + I8FFLAGS= + I8DEFINES= I8CDEFINES= else - I8FFLAGS="-i8 -real-size 64 -integer-size 64" - I8DEFINES="-DI64 -DFLOAT=8 -DINT=8" + I8FFLAGS="-i8 -integer-size 64" + I8DEFINES="-DI64 -DINT=8" I8CDEFINES="-U_DOUBLE -D_SINGLE" fi From 121bafd98918ab3a0a34581a338a85594817fbb5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 15:51:50 +0000 Subject: [PATCH 46/67] required for HDF5 output --- src/HDF5_utilities.f90 | 94 ++++++++++++++++++---------------- src/commercialFEM_fileList.f90 | 1 + 2 files changed, 50 insertions(+), 45 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index afb4be5dd..a81aaee0e 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -14,8 +14,6 @@ module HDF5_utilities implicit none public - integer(pInt), parameter, private :: & - HDF5_ERR_TYPE = 4_pInt !< kind of the integer return in the HDF5 library !-------------------------------------------------------------------------------------------------- !> @brief reads pInt or pReal data of defined shape from file ! ToDo: order of arguments wrong @@ -91,7 +89,7 @@ contains subroutine HDF5_utilities_init implicit none - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(SIZE_T) :: typeSize write(6,'(/,a)') ' <<<+- HDF5_Utilities init -+>>>' @@ -126,7 +124,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel) ! ToDo: simply "op character :: m integer(HID_T) :: plist_id - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr if (present(mode)) then m = mode @@ -171,7 +169,7 @@ subroutine HDF5_closeFile(fileHandle) implicit none integer(HID_T), intent(in) :: fileHandle - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr call h5fclose_f(fileHandle,hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_closeFile: h5fclose_f') @@ -188,7 +186,7 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName) integer(HID_T), intent(in) :: fileHandle character(len=*), intent(in) :: groupName - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: aplist_id !------------------------------------------------------------------------------------------------- @@ -198,8 +196,10 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName) !------------------------------------------------------------------------------------------------- ! setting I/O mode to collective +#ifdef PETSc call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')') +#endif !------------------------------------------------------------------------------------------------- ! Create group @@ -219,7 +219,7 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName) character(len=*), intent(in) :: groupName - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: aplist_id logical :: is_collective @@ -231,8 +231,10 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName) !------------------------------------------------------------------------------------------------- ! setting I/O mode to collective +#ifdef PETSc call h5pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')') +#endif !------------------------------------------------------------------------------------------------- ! opening the group @@ -249,7 +251,7 @@ subroutine HDF5_closeGroup(group_id) implicit none integer(HID_T), intent(in) :: group_id - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr call h5gclose_f(group_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(group_id,pInt)) @@ -265,7 +267,7 @@ logical function HDF5_objectExists(loc_id,path) implicit none integer(HID_T), intent(in) :: loc_id character(len=*), intent(in), optional :: path - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr character(len=256) :: p if (present(path)) then @@ -294,7 +296,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) integer(HID_T), intent(in) :: loc_id character(len=*), intent(in) :: attrLabel, attrValue character(len=*), intent(in), optional :: path - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: attr_id, space_id, type_id logical :: attrExists character(len=256) :: p @@ -341,7 +343,7 @@ subroutine HDF5_addAttribute_pInt(loc_id,attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel integer(pInt), intent(in) :: attrValue character(len=*), intent(in), optional :: path - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: attr_id, space_id, type_id logical :: attrExists character(len=256) :: p @@ -388,7 +390,7 @@ subroutine HDF5_addAttribute_pReal(loc_id,attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel real(pReal), intent(in) :: attrValue character(len=*), intent(in), optional :: path - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: attr_id, space_id, type_id logical :: attrExists character(len=256) :: p @@ -434,7 +436,7 @@ subroutine HDF5_setLink(loc_id,target_name,link_name) implicit none character(len=*), intent(in) :: target_name, link_name integer(HID_T), intent(in) :: loc_id - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr logical :: linkExists call h5lexists_f(loc_id, link_name,linkExists, hdferr) @@ -465,7 +467,7 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -506,7 +508,7 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -547,7 +549,7 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -588,7 +590,7 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -629,7 +631,7 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -670,7 +672,7 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -711,7 +713,7 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -753,7 +755,7 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -794,7 +796,7 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -835,7 +837,7 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -876,7 +878,7 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -917,7 +919,7 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -958,7 +960,7 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -999,7 +1001,7 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset @@ -1037,7 +1039,7 @@ subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1077,7 +1079,7 @@ subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1117,7 +1119,7 @@ subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1157,7 +1159,7 @@ subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1198,7 +1200,7 @@ subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1238,7 +1240,7 @@ subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1278,7 +1280,7 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1319,7 +1321,7 @@ subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1359,7 +1361,7 @@ subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1399,7 +1401,7 @@ subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1439,7 +1441,7 @@ subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1479,7 +1481,7 @@ subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1519,7 +1521,7 @@ subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1559,7 +1561,7 @@ subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & @@ -1612,7 +1614,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ integer(pInt), dimension(worldsize) :: & readSize !< contribution of all processes integer :: ierr - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties (is collective for MPI) @@ -1643,8 +1645,10 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ ! creating a property list for IO and set it to collective call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f') +#ifdef PETSc call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f') +#endif !-------------------------------------------------------------------------------------------------- ! open the dataset in the file and get the space ID @@ -1668,7 +1672,7 @@ subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id implicit none integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr call h5pclose_f(plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: plist_id') @@ -1707,7 +1711,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & integer(pInt), dimension(worldsize) :: & writeSize !< contribution of all processes integer :: ierr - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -1758,7 +1762,7 @@ subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id) implicit none integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id - integer(HDF5_ERR_TYPE) :: hdferr + integer :: hdferr call h5pclose_f(plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: plist_id') diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 1ef68b3cd..39e9269f4 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -9,6 +9,7 @@ #include "config.f90" #ifdef DAMASKHDF5 #include "HDF5_utilities.f90" +#include "results.f90" #endif #include "math.f90" #include "quaternions.f90" From 55d55a156b91cb970ffde1f8f01c81612bfb064e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 15:58:59 +0000 Subject: [PATCH 47/67] following numpy syntax --- src/lattice.f90 | 39 ++++++++++++++++----------------------- src/math.f90 | 8 -------- src/plastic_dislotwin.f90 | 6 +++--- 3 files changed, 19 insertions(+), 34 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index cacc3ea08..4f9523186 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1920,7 +1920,7 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) IO_error use math, only: & math_trace33, & - math_tensorproduct33 + math_outer implicit none integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family @@ -1961,7 +1961,7 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) do i = 1, sum(Nslip) - SchmidMatrix(1:3,1:3,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & call IO_error(0_pInt,i,ext_msg = 'dilatational Schmid matrix for slip') enddo @@ -1980,7 +1980,7 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) IO_error use math, only: & math_trace33, & - math_tensorproduct33 + math_outer implicit none integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family @@ -2018,7 +2018,7 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) coordinateSystem = buildCoordinateSystem(Ntwin,NtwinMax,twinSystems,structure,cOverA) do i = 1, sum(Ntwin) - SchmidMatrix(1:3,1:3,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & call IO_error(0_pInt,i,ext_msg = 'dilatational Schmid matrix for twin') enddo @@ -2031,13 +2031,8 @@ end function lattice_SchmidMatrix_twin !> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) result(SchmidMatrix) - use prec, only: & - tol_math_check use IO, only: & IO_error - use math, only: & - math_trace33, & - math_tensorproduct33 implicit none integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family @@ -2068,7 +2063,7 @@ function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix) use math, only: & - math_tensorproduct33 + math_outer use IO, only: & IO_error @@ -2114,9 +2109,9 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid coordinateSystem = buildCoordinateSystem(Ncleavage,NcleavageMax,cleavageSystems,structure,cOverA) do i = 1, sum(Ncleavage) - SchmidMatrix(1:3,1:3,1,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) - SchmidMatrix(1:3,1:3,2,i) = math_tensorproduct33(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) - SchmidMatrix(1:3,1:3,3,i) = math_tensorproduct33(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,1,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,2,i) = math_outer(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,3,i) = math_outer(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) enddo end function lattice_SchmidMatrix_cleavage @@ -2186,7 +2181,7 @@ end function lattice_slip_transverse !-------------------------------------------------------------------------------------------------- function slipProjection_transverse(Nslip,structure,cOverA) result(projection) use math, only: & - math_mul3x3 + math_inner implicit none integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family @@ -2200,7 +2195,7 @@ function slipProjection_transverse(Nslip,structure,cOverA) result(projection) coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) - projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j))) + projection(i,j) = abs(math_inner(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j))) enddo; enddo end function slipProjection_transverse @@ -2212,7 +2207,7 @@ end function slipProjection_transverse !-------------------------------------------------------------------------------------------------- function slipProjection_direction(Nslip,structure,cOverA) result(projection) use math, only: & - math_mul3x3 + math_inner implicit none integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family @@ -2226,7 +2221,7 @@ function slipProjection_direction(Nslip,structure,cOverA) result(projection) coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) - projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,1,j))) + projection(i,j) = abs(math_inner(coordinateSystem(1:3,2,i),coordinateSystem(1:3,1,j))) enddo; enddo end function slipProjection_direction @@ -2237,8 +2232,6 @@ end function slipProjection_direction !> @details Order: Direction, plane (normal), and common perpendicular !-------------------------------------------------------------------------------------------------- function coordinateSystem_slip(Nslip,structure,cOverA) result(coordinateSystem) - use math, only: & - math_mul3x3 use IO, only: & IO_error @@ -2404,7 +2397,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) dEq0 use math, only: & math_cross, & - math_tensorproduct33, & + math_outer, & math_mul33x33, & math_mul33x3, & math_axisAngleToR, & @@ -2508,9 +2501,9 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) - U = (a_bcc/a_fcc)*math_tensorproduct33(x,x) & - + (a_bcc/a_fcc)*math_tensorproduct33(y,y) * sqrt(2.0_pReal) & - + (a_bcc/a_fcc)*math_tensorproduct33(z,z) * sqrt(2.0_pReal) + U = (a_bcc/a_fcc)*math_outer(x,x) & + + (a_bcc/a_fcc)*math_outer(y,y) * sqrt(2.0_pReal) & + + (a_bcc/a_fcc)*math_outer(z,z) * sqrt(2.0_pReal) Q(1:3,1:3,i) = math_mul33x33(R,B) S(1:3,1:3,i) = math_mul33x33(R,U) - MATH_I3 enddo diff --git a/src/math.f90 b/src/math.f90 index 43e78c477..660f76190 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -72,19 +72,11 @@ module math interface math_crossproduct module procedure math_cross end interface math_crossproduct - interface math_tensorproduct - module procedure math_outer - end interface math_tensorproduct - interface math_tensorproduct33 - module procedure math_outer - end interface math_tensorproduct33 interface math_mul3x3 module procedure math_inner end interface math_mul3x3 public :: & math_mul3x3, & - math_tensorproduct33, & - math_tensorproduct, & math_crossproduct !--------------------------------------------------------------------------------------------------- diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 41e01fbf4..7799c197b 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -674,7 +674,7 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, dNeq0 use math, only: & math_eigenValuesVectorsSym, & - math_tensorproduct33, & + math_outer, & math_symmetric33, & math_mul33xx33, & math_mul33x3 @@ -748,8 +748,8 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, call math_eigenValuesVectorsSym(Mp,eigValues,eigVectors,error) do i = 1_pInt,6_pInt - Schmid_shearBand = 0.5_pReal * math_tensorproduct33(math_mul33x3(eigVectors,sb_sComposition(1:3,i)),& - math_mul33x3(eigVectors,sb_mComposition(1:3,i))) + Schmid_shearBand = 0.5_pReal * math_outer(math_mul33x3(eigVectors,sb_sComposition(1:3,i)),& + math_mul33x3(eigVectors,sb_mComposition(1:3,i))) tau = math_mul33xx33(Mp,Schmid_shearBand) significantShearBandStress: if (abs(tau) > tol_math_check) then From 7643d66654543df3ef9378f2a302b19bbaec87f4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 16:22:57 +0000 Subject: [PATCH 48/67] bugfix, avoid error --- src/lattice.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/lattice.f90 b/src/lattice.f90 index 4f9523186..37286d802 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -723,6 +723,8 @@ subroutine lattice_initializeStructure(myPhase,CoverA) lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & lattice_SchmidMatrix_cleavage(lattice_hex_ncleavagesystem,'hex',covera) + case (LATTICE_bct_ID) + case (LATTICE_ort_ID) myNcleavage = lattice_ort_Ncleavage lattice_NcleavageSystem(1:3,myPhase) = lattice_ort_NcleavageSystem From 8bc6a64bf93de4e9953b93989935740b0a8c488d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 17:30:29 +0100 Subject: [PATCH 49/67] compiling MSC.Marc with HDF5 wrapper --- .gitlab-ci.yml | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ee3c35af0..792fb915b 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -49,7 +49,7 @@ variables: # =============================================================================================== # Names of module files to load # =============================================================================================== - # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ + # ++++++++++++ Compiler +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016" IntelCompiler17_8: "Compiler/Intel/17.8 Libraries/IMKL/2017" IntelCompiler18_4: "Compiler/Intel/18.4 Libraries/IMKL/2018" @@ -57,19 +57,19 @@ variables: # ------------ Defaults ---------------------------------------------- IntelCompiler: "$IntelCompiler18_4" GNUCompiler: "$GNUCompiler8_2" - # ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++ + # ++++++++++++ MPI ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ IMPI2018Intel18_4: "MPI/Intel/18.4/IntelMPI/2018" MPICH3_3GNU8_2: "MPI/GNU/8.2/MPICH/3.3" # ------------ Defaults ---------------------------------------------- MPICH_Intel: "$IMPI2018Intel18_4" MPICH_GNU: "$MPICH3_3GNU8_2" - # ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++ + # ++++++++++++ PETSc ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ PETSc3_10_3IMPI2018Intel18_4: "Libraries/PETSc/3.10.3/Intel-18.4-IntelMPI-2018" PETSc3_10_3MPICH3_3GNU8_2: "Libraries/PETSc/3.10.3/GNU-8.2-MPICH-3.3" # ------------ Defaults ---------------------------------------------- PETSc_MPICH_Intel: "$PETSc3_10_3IMPI2018Intel18_4" PETSc_MPICH_GNU: "$PETSc3_10_3MPICH3_3GNU8_2" - # ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++ + # ++++++++++++ commercial FEM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Abaqus2019: "FEM/Abaqus/2019" MSC2018_1: "FEM/MSC/2018.1" # ------------ Defaults ---------------------------------------------- @@ -77,7 +77,8 @@ variables: MSC: "$MSC2018_1" IntelMarc: "$IntelCompiler17_8" IntelAbaqus: "$IntelCompiler16_4" - # ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++ + HDF5Marc: "HDF5/1.10.4/Intel-17.8" + # ++++++++++++ Documentation ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Doxygen1_8_15: "Documentation/Doxygen/1.8.15" # ------------ Defaults ---------------------------------------------- Doxygen: "$Doxygen1_8_15" @@ -394,7 +395,8 @@ TextureComponents: Marc_compileIfort2018_1: stage: compileMarc script: - - module load $IntelMarc $MSC + - module load $IntelMarc $HDF5Marc $MSC + - export DAMASK_HDF5=ON - Marc_compileIfort/test.py -m 2018.1 except: - master @@ -405,7 +407,7 @@ Marc_compileIfort2018_1: Hex_elastic: stage: marc script: - - module load $IntelMarc $MSC + - module load $IntelMarc $HDF5Marc $MSC - Hex_elastic/test.py except: - master @@ -414,7 +416,7 @@ Hex_elastic: CubicFCC_elastic: stage: marc script: - - module load $IntelMarc $MSC + - module load $IntelMarc $HDF5Marc $MSC - CubicFCC_elastic/test.py except: - master @@ -423,7 +425,7 @@ CubicFCC_elastic: CubicBCC_elastic: stage: marc script: - - module load $IntelMarc $MSC + - module load $IntelMarc $HDF5Marc $MSC - CubicBCC_elastic/test.py except: - master @@ -432,7 +434,7 @@ CubicBCC_elastic: J2_plasticBehavior: stage: marc script: - - module load $IntelMarc $MSC + - module load $IntelMarc $HDF5Marc $MSC - J2_plasticBehavior/test.py except: - master From 433281f71d812cc19bd3b90e5359cbcb55f1fb12 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 19:58:17 +0100 Subject: [PATCH 50/67] following Rowenhorst convention --- processing/post/addOrientations.py | 14 ++++++-------- processing/post/rotateData.py | 7 +++---- 2 files changed, 9 insertions(+), 12 deletions(-) diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index 436a2df6a..47c30c132 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -43,12 +43,12 @@ parser.add_option('-R', '--labrotation', dest='labrotation', type = 'float', nargs = 4, metavar = ' '.join(['float']*4), - help = 'angle and axis of additional lab frame rotation [%default]') + help = 'axis and angle of additional lab frame rotation [%default]') parser.add_option('-r', '--crystalrotation', dest='crystalrotation', type = 'float', nargs = 4, metavar = ' '.join(['float']*4), - help = 'angle and axis of additional crystal frame rotation [%default]') + help = 'axis and angle of additional crystal frame rotation [%default]') parser.add_option('--eulers', dest = 'eulers', metavar = 'string', @@ -79,8 +79,8 @@ parser.add_option('-z', help = 'label of lab z vector (expressed in crystal coords)') parser.set_defaults(output = [], - labrotation = (0.,1.,0.,0.), # no rotation about 1,0,0 - crystalrotation = (0.,1.,0.,0.), # no rotation about 1,0,0 + labrotation = (1.,1.,1.,0.), # no rotation about (1,1,1) + crystalrotation = (1.,1.,1.,0.), # no rotation about (1,1,1) ) (options, filenames) = parser.parse_args() @@ -107,10 +107,8 @@ if np.sum(input) != 1: parser.error('needs exactly one input format.') (options.quaternion,representations['quaternion'][1],'quaternion'), ][np.where(input)[0][0]] # select input label that was requested -crystalrotation = np.array(options.crystalrotation[1:4] + (options.crystalrotation[0],)) # Compatibility hack -labrotation = np.array(options.labrotation[1:4] + (options.labrotation[0],)) # Compatibility hack -r = damask.Rotation.fromAxisAngle(crystalrotation,options.degrees) # crystal frame rotation -R = damask.Rotation.fromAxisAngle(labrotation,options.degrees) # lab frame rotation +r = damask.Rotation.fromAxisAngle(np.array(options.crystalrotation),options.degrees,normalise=True) +R = damask.Rotation.fromAxisAngle(np.array(options.labrotation),options.degrees,normalise=True) # --- loop over input files ------------------------------------------------------------------------ diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index ae42cb54a..84e796450 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -25,13 +25,13 @@ parser.add_option('-d', '--data', parser.add_option('-r', '--rotation', dest = 'rotation', type = 'float', nargs = 4, metavar = ' '.join(['float']*4), - help = 'angle and axis to rotate data [%default]') + help = 'axis and angle to rotate data [%default]') parser.add_option('--degrees', dest = 'degrees', action = 'store_true', help = 'angles are given in degrees') -parser.set_defaults(rotation = (0.,1.,1.,1.), # no rotation about 1,1,1 +parser.set_defaults(rotation = (1.,1.,1.,0), # no rotation about (1,1,1) degrees = False, ) @@ -40,8 +40,7 @@ parser.set_defaults(rotation = (0.,1.,1.,1.), if options.data is None: parser.error('no data column specified.') -rotation = np.array(options.rotation[1:4]+(options.rotation[0],)) # Compatibility hack -r = damask.Rotation.fromAxisAngle(rotation,options.degrees,normalise=True) +r = damask.Rotation.fromAxisAngle(np.array(options.rotation),options.degrees,normalise=True) # --- loop over input files ------------------------------------------------------------------------- From 67619fa92a1a5a0bb07fca6bdcb915de4b613170 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 20:18:28 +0100 Subject: [PATCH 51/67] consistent definition of axis angle --- processing/pre/geom_addPrimitive.py | 32 ++++++++++++++++++----------- 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/processing/pre/geom_addPrimitive.py b/processing/pre/geom_addPrimitive.py index 0b3356083..dde55ae31 100755 --- a/processing/pre/geom_addPrimitive.py +++ b/processing/pre/geom_addPrimitive.py @@ -31,25 +31,34 @@ Depending on the sign of the dimension parameters, these objects can be boxes, c """, version = scriptID) -parser.add_option('-c', '--center', dest='center', type='float', nargs = 3, metavar=' '.join(['float']*3), +parser.add_option('-c', '--center', dest='center', + type='float', nargs = 3, metavar=' '.join(['float']*3), help='a,b,c origin of primitive %default') -parser.add_option('-d', '--dimension', dest='dimension', type='float', nargs = 3, metavar=' '.join(['float']*3), +parser.add_option('-d', '--dimension', dest='dimension', + type='float', nargs = 3, metavar=' '.join(['float']*3), help='a,b,c extension of hexahedral box; negative values are diameters') -parser.add_option('-e', '--exponent', dest='exponent', type='float', nargs = 3, metavar=' '.join(['float']*3), +parser.add_option('-e', '--exponent', dest='exponent', + type='float', nargs = 3, metavar=' '.join(['float']*3), help='i,j,k exponents for axes - 0 gives octahedron (|x|^(2^0) + |y|^(2^0) + |z|^(2^0) < 1), \ 1 gives a sphere (|x|^(2^1) + |y|^(2^1) + |z|^(2^1) < 1), \ large values produce boxes, negative turns concave.') -parser.add_option('-f', '--fill', dest='fill', type='int', metavar = 'int', +parser.add_option('-f', '--fill', dest='fill', + type='int', metavar = 'int', help='grain index to fill primitive. "0" selects maximum microstructure index + 1 [%default]') -parser.add_option('-q', '--quaternion', dest='quaternion', type='float', nargs = 4, metavar=' '.join(['float']*4), +parser.add_option('-q', '--quaternion', dest='quaternion', + type='float', nargs = 4, metavar=' '.join(['float']*4), help = 'rotation of primitive as quaternion') -parser.add_option('-a', '--angleaxis', dest='angleaxis', nargs = 4, metavar=' '.join(['float']*4), type=float, - help = 'angle,x,y,z clockwise rotation of primitive about axis by angle') -parser.add_option( '--degrees', dest='degrees', action='store_true', +parser.add_option('-a', '--angleaxis', dest='angleaxis', type=float, + nargs = 4, metavar=' '.join(['float']*4), + help = 'axis and angle to rotate primitive') +parser.add_option( '--degrees', dest='degrees', + action='store_true', help = 'angle is given in degrees [%default]') -parser.add_option( '--nonperiodic', dest='periodic', action='store_false', +parser.add_option( '--nonperiodic', dest='periodic', + action='store_false', help = 'wrap around edges [%default]') -parser.add_option( '--realspace', dest='realspace', action='store_true', +parser.add_option( '--realspace', dest='realspace', + action='store_true', help = '-c and -d span [origin,origin+size] instead of [0,grid] coordinates') parser.set_defaults(center = (.0,.0,.0), fill = 0, @@ -63,8 +72,7 @@ parser.set_defaults(center = (.0,.0,.0), if options.dimension is None: parser.error('no dimension specified.') if options.angleaxis is not None: - ax = np.array(options.angleaxis[1:4] + (options.angleaxis[0],)) # Compatibility hack - rotation = damask.Rotation.fromAxisAngle(ax,options.degrees,normalise=True) + rotation = damask.Rotation.fromAxisAngle(np(options.angleaxis),options.degrees,normalise=True) elif options.quaternion is not None: rotation = damask.Rotation.fromQuaternion(options.quaternion) else: From 8f736f2843ceb4e07b62027ff449af0a176589a5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 20:43:02 +0100 Subject: [PATCH 52/67] prevent test from failing --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 53a382817..f7fc61684 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 53a38281786257ebb96e7bdde577ac45a90c2054 +Subproject commit f7fc61684a8bc7773fef4ffa129b6788f5b10f83 From 34660599a17803bf0d508add17a113486840cbff Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Mar 2019 20:43:31 +0100 Subject: [PATCH 53/67] dummy HDF5 output for all plasticity laws --- src/constitutive.f90 | 81 +++++++++++++++++++++--------- src/plastic_disloUCLA.f90 | 29 ++++++++++- src/plastic_dislotwin.f90 | 29 ++++++++++- src/plastic_isotropic.f90 | 29 ++++++++++- src/plastic_kinematichardening.f90 | 29 ++++++++++- src/plastic_nonlocal.f90 | 29 ++++++++++- src/plastic_phenopowerlaw.f90 | 6 +-- 7 files changed, 199 insertions(+), 33 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 086ee1327..b05b3e3d5 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1102,33 +1102,64 @@ end function constitutive_postResults !> @brief writes constitutive results to HDF5 output file !-------------------------------------------------------------------------------------------------- subroutine constitutive_results() - use material, only: & - PLASTICITY_ISOTROPIC_ID, & - PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_KINEHARDENING_ID, & - PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOUCLA_ID, & - PLASTICITY_NONLOCAL_ID + use material, only: & + PLASTICITY_ISOTROPIC_ID, & + PLASTICITY_PHENOPOWERLAW_ID, & + PLASTICITY_KINEHARDENING_ID, & + PLASTICITY_DISLOTWIN_ID, & + PLASTICITY_DISLOUCLA_ID, & + PLASTICITY_NONLOCAL_ID #if defined(PETSc) || defined(DAMASKHDF5) - use results - use HDF5_utilities - use config, only: & - config_name_phase => phase_name ! anticipate logical name + use results + use HDF5_utilities + use config, only: & + config_name_phase => phase_name ! anticipate logical name - use material, only: & - phase_plasticityInstance, & - material_phase_plasticity_type => phase_plasticity - use plastic_phenopowerlaw, only: & - plastic_phenopowerlaw_results - - implicit none - integer(pInt) :: p - call HDF5_closeGroup(results_addGroup('current/phase')) - do p=1,size(config_name_phase) - call HDF5_closeGroup(results_addGroup('current/phase/'//trim(config_name_phase(p)))) - if (material_phase_plasticity_type(p) == PLASTICITY_PHENOPOWERLAW_ID) then - call plastic_phenopowerlaw_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p))) - endif + use material, only: & + phase_plasticityInstance, & + material_phase_plasticity_type => phase_plasticity + + use plastic_isotropic, only: & + plastic_isotropic_results + use plastic_phenopowerlaw, only: & + plastic_phenopowerlaw_results + use plastic_kinehardening, only: & + plastic_kinehardening_results + use plastic_dislotwin, only: & + plastic_dislotwin_results + use plastic_disloUCLA, only: & + plastic_disloUCLA_results + use plastic_nonlocal, only: & + plastic_nonlocal_results + + implicit none + integer :: p + call HDF5_closeGroup(results_addGroup('current/phase')) + do p=1,size(config_name_phase) + call HDF5_closeGroup(results_addGroup('current/phase/'//trim(config_name_phase(p)))) + + select case(material_phase_plasticity_type(p)) + + case(PLASTICITY_ISOTROPIC_ID) + call plastic_isotropic_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p))) + + case(PLASTICITY_PHENOPOWERLAW_ID) + call plastic_phenopowerlaw_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p))) + + case(PLASTICITY_KINEHARDENING_ID) + call plastic_kinehardening_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p))) + + case(PLASTICITY_DISLOTWIN_ID) + call plastic_dislotwin_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p))) + + case(PLASTICITY_DISLOUCLA_ID) + call plastic_disloUCLA_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p))) + + case(PLASTICITY_NONLOCAL_ID) + call plastic_nonlocal_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p))) + + end select + enddo #endif diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 836dab38e..e32c707e9 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -102,7 +102,8 @@ module plastic_disloUCLA plastic_disloUCLA_dependentState, & plastic_disloUCLA_LpAndItsTangent, & plastic_disloUCLA_dotState, & - plastic_disloUCLA_postResults + plastic_disloUCLA_postResults, & + plastic_disloUCLA_results private :: & kinetics @@ -561,6 +562,32 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe end function plastic_disloUCLA_postResults +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine plastic_disloUCLA_results(instance,group) +#if defined(PETSc) || defined(DAMASKHDF5) + use results + + implicit none + integer, intent(in) :: instance + character(len=*) :: group + integer :: o + + associate(prm => param(instance), stt => state(instance)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) + end select + enddo outputsLoop + end associate +#else + integer, intent(in) :: instance + character(len=*) :: group +#endif + +end subroutine plastic_disloUCLA_results + + !-------------------------------------------------------------------------------------------------- !> @brief Shear rates on slip systems, their derivatives with respect to resolved stress and the ! resolved stresss diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 7799c197b..6976e2096 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -168,7 +168,8 @@ module plastic_dislotwin plastic_dislotwin_dependentState, & plastic_dislotwin_LpAndItsTangent, & plastic_dislotwin_dotState, & - plastic_dislotwin_postResults + plastic_dislotwin_postResults, & + plastic_dislotwin_results private :: & kinetics_slip, & kinetics_twin, & @@ -1088,6 +1089,32 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe end function plastic_dislotwin_postResults +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine plastic_dislotwin_results(instance,group) +#if defined(PETSc) || defined(DAMASKHDF5) + use results + + implicit none + integer, intent(in) :: instance + character(len=*) :: group + integer :: o + + associate(prm => param(instance), stt => state(instance)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) + end select + enddo outputsLoop + end associate +#else + integer, intent(in) :: instance + character(len=*) :: group +#endif + +end subroutine plastic_dislotwin_results + + !-------------------------------------------------------------------------------------------------- !> @brief Shear rates on slip systems, their derivatives with respect to resolved stress and the ! resolved stresss diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index b86c9321d..3c53037d6 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -68,7 +68,8 @@ module plastic_isotropic plastic_isotropic_LpAndItsTangent, & plastic_isotropic_LiAndItsTangent, & plastic_isotropic_dotState, & - plastic_isotropic_postResults + plastic_isotropic_postResults, & + plastic_isotropic_results contains @@ -482,4 +483,30 @@ function plastic_isotropic_postResults(Mp,instance,of) result(postResults) end function plastic_isotropic_postResults +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine plastic_isotropic_results(instance,group) +#if defined(PETSc) || defined(DAMASKHDF5) + use results + + implicit none + integer, intent(in) :: instance + character(len=*) :: group + integer :: o + + associate(prm => param(instance), stt => state(instance)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) + end select + enddo outputsLoop + end associate +#else + integer, intent(in) :: instance + character(len=*) :: group +#endif + +end subroutine plastic_isotropic_results + + end module plastic_isotropic diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index b93da06f9..5b29fd799 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -83,7 +83,8 @@ module plastic_kinehardening plastic_kinehardening_LpAndItsTangent, & plastic_kinehardening_dotState, & plastic_kinehardening_deltaState, & - plastic_kinehardening_postResults + plastic_kinehardening_postResults, & + plastic_kinehardening_results private :: & kinetics @@ -548,6 +549,32 @@ function plastic_kinehardening_postResults(Mp,instance,of) result(postResults) end function plastic_kinehardening_postResults +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine plastic_kinehardening_results(instance,group) +#if defined(PETSc) || defined(DAMASKHDF5) + use results + + implicit none + integer, intent(in) :: instance + character(len=*) :: group + integer :: o + + associate(prm => param(instance), stt => state(instance)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) + end select + enddo outputsLoop + end associate +#else + integer, intent(in) :: instance + character(len=*) :: group +#endif + +end subroutine plastic_kinehardening_results + + !-------------------------------------------------------------------------------------------------- !> @brief calculates shear rates on slip systems and derivatives with respect to resolved stress !> @details: Shear rates are calculated only optionally. diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index ec3dfd9bf..2a3b7f294 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -222,7 +222,8 @@ module plastic_nonlocal plastic_nonlocal_dotState, & plastic_nonlocal_deltaState, & plastic_nonlocal_updateCompatibility, & - plastic_nonlocal_postResults + plastic_nonlocal_postResults, & + plastic_nonlocal_results private :: & plastic_nonlocal_kinetics @@ -2558,4 +2559,30 @@ enddo outputsLoop end associate end function plastic_nonlocal_postResults + +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine plastic_nonlocal_results(instance,group) +#if defined(PETSc) || defined(DAMASKHDF5) + use results + + implicit none + integer, intent(in) :: instance + character(len=*) :: group + integer :: o + + associate(prm => param(instance), stt => state(instance)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) + end select + enddo outputsLoop + end associate +#else + integer, intent(in) :: instance + character(len=*) :: group +#endif + +end subroutine plastic_nonlocal_results + end module plastic_nonlocal diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index e7966dd7d..d7df5cd40 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -575,9 +575,9 @@ subroutine plastic_phenopowerlaw_results(instance,group) use results implicit none - integer(pInt), intent(in) :: instance + integer, intent(in) :: instance character(len=*) :: group - integer(pInt) :: o + integer :: o associate(prm => param(instance), stt => state(instance)) outputsLoop: do o = 1_pInt,size(prm%outputID) @@ -590,7 +590,7 @@ subroutine plastic_phenopowerlaw_results(instance,group) enddo outputsLoop end associate #else - integer(pInt), intent(in) :: instance + integer, intent(in) :: instance character(len=*) :: group #endif end subroutine plastic_phenopowerlaw_results From ed7423a3d630e9db148f624f54344b7f35d0879a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 08:16:01 +0100 Subject: [PATCH 54/67] bug fixes --- PRIVATE | 2 +- processing/pre/geom_addPrimitive.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index f7fc61684..c79dc5f1b 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit f7fc61684a8bc7773fef4ffa129b6788f5b10f83 +Subproject commit c79dc5f1be75f90b0638c230d56c962bfd3b2474 diff --git a/processing/pre/geom_addPrimitive.py b/processing/pre/geom_addPrimitive.py index dde55ae31..7fcfdbc5c 100755 --- a/processing/pre/geom_addPrimitive.py +++ b/processing/pre/geom_addPrimitive.py @@ -72,7 +72,7 @@ parser.set_defaults(center = (.0,.0,.0), if options.dimension is None: parser.error('no dimension specified.') if options.angleaxis is not None: - rotation = damask.Rotation.fromAxisAngle(np(options.angleaxis),options.degrees,normalise=True) + rotation = damask.Rotation.fromAxisAngle(np.array(options.angleaxis),options.degrees,normalise=True) elif options.quaternion is not None: rotation = damask.Rotation.fromQuaternion(options.quaternion) else: From 96c4599dc791172872fcbd78958d739ec8eed76a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 08:42:50 +0100 Subject: [PATCH 55/67] norm2 is (yet) not available in PGI --- src/plastic_nonlocal.f90 | 4 ++++ src/quaternions.f90 | 12 ++++++++++++ src/rotations.f90 | 20 ++++++++++++++++++++ 3 files changed, 36 insertions(+) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 2a3b7f294..a76295fa1 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -1624,6 +1624,10 @@ use debug, only: debug_level, & debug_e #endif use math, only: math_mul3x3, & +#ifdef __PGI + norm2, & +#endif + math_mul33x3, & math_mul33xx33, & math_mul33x33, & diff --git a/src/quaternions.f90 b/src/quaternions.f90 index 39dc1d3cd..5fc35352c 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -354,6 +354,10 @@ end function pow_quat__ !> ToDo: Lacks any check for invalid operations !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function exp__(self) +#ifdef __PGI + use math, only: & + norm2 +#endif implicit none class(quaternion), intent(in) :: self @@ -374,6 +378,10 @@ end function exp__ !> ToDo: Lacks any check for invalid operations !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function log__(self) +#ifdef __PGI + use math, only: & + norm2 +#endif implicit none class(quaternion), intent(in) :: self @@ -393,6 +401,10 @@ end function log__ !> norm of a quaternion !--------------------------------------------------------------------------------------------------- real(pReal) elemental function abs__(a) +#ifdef __PGI + use math, only: & + norm2 +#endif implicit none class(quaternion), intent(in) :: a diff --git a/src/rotations.f90 b/src/rotations.f90 index 3f6778e1a..55602b557 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -157,6 +157,10 @@ end subroutine function rotVector(self,v,active) use prec, only: & dEq +#ifdef __PGI + use math, only: & + norm2 +#endif implicit none real(pReal), dimension(3) :: rotVector @@ -573,6 +577,9 @@ pure function ro2ax(ro) result(ax) use prec, only: & dEq0 use math, only: & +#ifdef __PGI + norm2, & +#endif PI implicit none @@ -662,6 +669,9 @@ pure function ro2ho(ro) result(ho) use prec, only: & dEq0 use math, only: & +#ifdef __PGI + norm2, & +#endif PI implicit none @@ -718,6 +728,10 @@ end function qu2om function om2qu(om) result(qu) use prec, only: & dEq +#ifdef __PGI + use math, only: & + norm2 +#endif implicit none real(pReal), intent(in), dimension(3,3) :: om @@ -791,6 +805,9 @@ pure function qu2ro(qu) result(ro) use prec, only: & dEq0 use math, only: & +#ifdef __PGI + norm2, & +#endif math_clip type(quaternion), intent(in) :: qu @@ -819,6 +836,9 @@ pure function qu2ho(qu) result(ho) use prec, only: & dEq0 use math, only: & +#ifdef __PGI + norm2, & +#endif math_clip implicit none From 0118fefe6e22226c2e0c3964fa724965482ce396 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 08:43:36 +0100 Subject: [PATCH 56/67] wrong type --- src/plastic_dislotwin.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 6976e2096..d353e3e0e 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -1147,7 +1147,7 @@ pure subroutine kinetics_slip(Mp,Temperature,instance,of, & real(pReal), dimension(param(instance)%totalNslip) :: & dgdot_dtau - real, dimension(param(instance)%totalNslip) :: & + real(pReal), dimension(param(instance)%totalNslip) :: & tau, & stressRatio, & StressRatio_p, & From 388e66143332077015eef9e1a2b4057c39474611 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 09:07:33 +0100 Subject: [PATCH 57/67] use explicitly pReal --- src/Lambert.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Lambert.f90 b/src/Lambert.f90 index 86c019688..dc2626296 100644 --- a/src/Lambert.f90 +++ b/src/Lambert.f90 @@ -164,19 +164,19 @@ pure function LambertBallToCube(xyz) result(cube) qxy = sum(xyz2**2) special: if (dEq0(qxy)) then - Tinv = 0.0 + Tinv = 0.0_pReal else special q2 = qxy + maxval(abs(xyz2))**2 sq2 = sqrt(q2) q = (beta/R2/R1) * sqrt(q2*qxy/(q2-maxval(abs(xyz2))*sq2)) tt = (minval(abs(xyz2))**2+maxval(abs(xyz2))*sq2)/R2/qxy - Tinv = q * sign(1.0,xyz2) * merge([ 1.0_pReal, acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12], & - [ acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12, 1.0_pReal], & - abs(xyz2(2)) <= abs(xyz2(1))) + Tinv = q * sign(1.0_pReal,xyz2) * merge([ 1.0_pReal, acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12], & + [ acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12, 1.0_pReal], & + abs(xyz2(2)) <= abs(xyz2(1))) endif special ! inverse M_1 - xyz1 = [ Tinv(1), Tinv(2), sign(1.0,xyz3(3)) * rs / pref ] /sc + xyz1 = [ Tinv(1), Tinv(2), sign(1.0_pReal,xyz3(3)) * rs / pref ] /sc ! reverst the coordinates back to the regular order according to the original pyramid number cube = xyz1(p) From 714c9b1ecb87d4745cc932e164220f65a861b534 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 09:08:06 +0100 Subject: [PATCH 58/67] PGI does not no "do concurrent" (yet) --- src/constitutive.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index b05b3e3d5..9a39aa6d2 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -478,7 +478,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & end select plasticityType -#ifdef __INTEL_COMPILER +#if defined(__INTEL_COMPILER) || defined(__PGI) forall(i = 1_pInt:3_pInt, j = 1_pInt:3_pInt) #else do concurrent(i = 1_pInt:3_pInt, j = 1_pInt:3_pInt) @@ -486,7 +486,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & dLp_dFi(i,j,1:3,1:3) = math_mul33x33(math_mul33x33(Fi,S),transpose(dLp_dMp(i,j,1:3,1:3))) + & math_mul33x33(math_mul33x33(Fi,dLp_dMp(i,j,1:3,1:3)),S) dLp_dS(i,j,1:3,1:3) = math_mul33x33(math_mul33x33(transpose(Fi),Fi),dLp_dMp(i,j,1:3,1:3)) ! ToDo: @PS: why not: dLp_dMp:(FiT Fi) -#ifdef __INTEL_COMPILER +#if defined(__INTEL_COMPILER) || defined(__PGI) end forall #else enddo @@ -1167,4 +1167,5 @@ subroutine constitutive_results() end subroutine constitutive_results + end module constitutive From 05b4dd1973b092357a619cd0e02dd2709920e833 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 09:08:54 +0100 Subject: [PATCH 59/67] correct type casting --- src/spectral_utilities.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 8c79eabe2..647886cc1 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -1148,7 +1148,7 @@ subroutine utilities_updateIPcoords(F) call utilities_fourierTensorDivergence() do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid1Red - if (any(cNeq(xi1st(1:3,i,j,k),cmplx(0.0_pReal,0.0_pReal)))) & + if (any(cNeq(xi1st(1:3,i,j,k),cmplx(0.0,0.0,pReal)))) & vectorField_fourier(1:3,i,j,k) = vectorField_fourier(1:3,i,j,k)/ & sum(conjg(-xi1st(1:3,i,j,k))*xi1st(1:3,i,j,k)) enddo; enddo; enddo From 60f4f9f39c88ec59e310557c0a84ec4f3c2df2a6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 09:09:23 +0100 Subject: [PATCH 60/67] norm2 for PGI --- src/crystallite.f90 | 3 +++ src/mesh_grid.f90 | 3 +++ 2 files changed, 6 insertions(+) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 5cbd692db..55cc553ea 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1094,6 +1094,9 @@ logical function integrateStress(& constitutive_LiAndItsTangents, & constitutive_SandItsTangents use math, only: math_mul33x33, & +#ifdef __PGI + norm2, & +#endif math_mul33xx33, & math_mul3333xx3333, & math_inv33, & diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 84acba931..6e9e37834 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -902,6 +902,9 @@ end function mesh_cellCenterCoordinates !-------------------------------------------------------------------------------------------------- subroutine mesh_build_ipAreas use math, only: & +#ifdef __PGI + norm2, & +#endif math_crossproduct implicit none From 11662033c394eb65c118b03d34d4d640fe1969c7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 09:13:25 +0100 Subject: [PATCH 61/67] seems to cause problems with PGI as well --- src/material.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index c4acfe466..f1e227b21 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -687,7 +687,7 @@ subroutine material_parsePhase allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(config_phase)), & source=STIFFNESS_DEGRADATION_undefined_ID) do p=1_pInt, size(config_phase) -#if defined(__GFORTRAN__) +#if defined(__GFORTRAN__) || defined(__PGI) str = ['GfortranBug86277'] str = config_phase(p)%getStrings('(source)',defaultVal=str) if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] @@ -711,7 +711,7 @@ subroutine material_parsePhase end select enddo -#if defined(__GFORTRAN__) +#if defined(__GFORTRAN__) || defined(__PGI) str = ['GfortranBug86277'] str = config_phase(p)%getStrings('(kinematics)',defaultVal=str) if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] @@ -728,7 +728,7 @@ subroutine material_parsePhase phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID end select enddo -#if defined(__GFORTRAN__) +#if defined(__GFORTRAN__) || defined(__PGI) str = ['GfortranBug86277'] str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=str) if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] From 8661d6e82fffe5cbf275b86d3ebc794936c90550 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 09:40:20 +0100 Subject: [PATCH 62/67] PGI complaines, forall is deprecated anyway --- src/CPFEM2.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 678ff98cc..13d7f06c4 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -238,14 +238,14 @@ subroutine CPFEM_age() crystallite_Fi0 = crystallite_Fi crystallite_Li0 = crystallite_Li crystallite_S0 = crystallite_S - - forall (i = 1:size(plasticState)) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array - + + do i = 1, size(plasticState) + plasticState(i)%state0 = plasticState(i)%state + enddo do i = 1, size(sourceState) do mySource = 1,phase_Nsources(i) - sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array + sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state enddo; enddo - do homog = 1_pInt, material_Nhomogenization homogState (homog)%state0 = homogState (homog)%state thermalState (homog)%state0 = thermalState (homog)%state From 927f947c2af3a92cc54eb3979a95193f8f630d72 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 09:42:21 +0100 Subject: [PATCH 63/67] better readable --- src/spectral_utilities.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 647886cc1..ea145bcca 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -224,11 +224,11 @@ subroutine utilities_init() call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr) CHKERRQ(ierr) - grid1Red = grid(1)/2_pInt + 1_pInt + grid1Red = grid(1)/2 + 1 wgt = 1.0/real(product(grid),pReal) - write(6,'(a,3(i12 ))') ' grid a b c: ', grid - write(6,'(a,3(es12.5))') ' size x y z: ', geomSize + write(6,'(/,a,3(i12 ))') ' grid a b c: ', grid + write(6,'(a,3(es12.5))') ' size x y z: ', geomSize select case (spectral_derivative) case ('continuous') From c8f426a8755ddba26a9a796cfb6d707bff93eaca Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 10:36:50 +0100 Subject: [PATCH 64/67] use variables from mesh object --- src/material.f90 | 26 +++++++++++--------------- src/mesh_FEM.f90 | 14 +++----------- src/mesh_abaqus.f90 | 9 ++------- src/mesh_grid.f90 | 8 ++++---- src/mesh_marc.f90 | 11 ++--------- 5 files changed, 22 insertions(+), 46 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index f1e227b21..3c69c844e 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -298,7 +298,6 @@ subroutine material_init() phase_name, & texture_name use mesh, only: & - mesh_homogenizationAt, & theMesh implicit none @@ -395,13 +394,13 @@ subroutine material_init() allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1_pInt) ! END DEPRECATED - allocate(material_homogenizationAt,source=mesh_homogenizationAt) + allocate(material_homogenizationAt,source=theMesh%homogenizationAt) allocate(CounterPhase (size(config_phase)), source=0_pInt) allocate(CounterHomogenization(size(config_homogenization)),source=0_pInt) ! BEGIN DEPRECATED do e = 1_pInt,theMesh%Nelems - myHomog = mesh_homogenizationAt(e) + myHomog = theMesh%homogenizationAt(e) do i = 1_pInt, theMesh%elem%nIPs CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),myHomog] @@ -435,7 +434,7 @@ subroutine material_parseHomogenization use config, only : & config_homogenization use mesh, only: & - mesh_homogenizationAt + theMesh use IO, only: & IO_error @@ -456,7 +455,7 @@ subroutine material_parseHomogenization allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal) forall (h = 1_pInt:size(config_homogenization)) & - homogenization_active(h) = any(mesh_homogenizationAt == h) + homogenization_active(h) = any(theMesh%homogenizationAt == h) do h=1_pInt, size(config_homogenization) @@ -542,7 +541,6 @@ subroutine material_parseMicrostructure config_microstructure, & microstructure_name use mesh, only: & - mesh_microstructureAt, & theMesh implicit none @@ -558,11 +556,11 @@ subroutine material_parseMicrostructure allocate(microstructure_active(size(config_microstructure)), source=.false.) allocate(microstructure_elemhomo(size(config_microstructure)), source=.false.) - if(any(mesh_microstructureAt > size(config_microstructure))) & + if(any(theMesh%microstructureAt > size(config_microstructure))) & call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') forall (e = 1_pInt:theMesh%Nelems) & - microstructure_active(mesh_microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements + microstructure_active(theMesh%microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements do m=1_pInt, size(config_microstructure) microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)') @@ -1013,8 +1011,6 @@ subroutine material_populateGrains math_sampleFiberOri, & math_symmetricEulers use mesh, only: & - mesh_homogenizationAt, & - mesh_microstructureAt, & theMesh, & mesh_ipVolume use config, only: & @@ -1064,14 +1060,14 @@ subroutine material_populateGrains ! populating homogenization schemes in each !-------------------------------------------------------------------------------------------------- do e = 1_pInt, theMesh%Nelems - material_homog(1_pInt:theMesh%elem%nIPs,e) = mesh_homogenizationAt(e) + material_homog(1_pInt:theMesh%elem%nIPs,e) = theMesh%homogenizationAt(e) enddo !-------------------------------------------------------------------------------------------------- ! precounting of elements for each homog/micro pair do e = 1_pInt, theMesh%Nelems - homog = mesh_homogenizationAt(e) - micro = mesh_microstructureAt(e) + homog = theMesh%homogenizationAt(e) + micro = theMesh%microstructureAt(e) Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt enddo allocate(elemsOfHomogMicro(size(config_homogenization),size(config_microstructure))) @@ -1088,8 +1084,8 @@ subroutine material_populateGrains ! identify maximum grain count per IP (from element) and find grains per homog/micro pair Nelems = 0_pInt ! reuse as counter elementLooping: do e = 1_pInt,theMesh%Nelems - homog = mesh_homogenizationAt(e) - micro = mesh_microstructureAt(e) + homog = theMesh%homogenizationAt(e) + micro = theMesh%microstructureAt(e) if (homog < 1_pInt .or. homog > size(config_homogenization)) & ! out of bounds call IO_error(154_pInt,e,0_pInt,0_pInt) if (micro < 1_pInt .or. micro > size(config_microstructure)) & ! out of bounds diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index 4df5840c7..29f0bc682 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -33,10 +33,6 @@ use PETScis mesh_maxNips !< max number of IPs in any CP element !!!! BEGIN DEPRECATED !!!!! - integer(pInt), dimension(:), allocatable, public, protected :: & - mesh_homogenizationAt, & !< homogenization ID of each element - mesh_microstructureAt !< microstructure ID of each element - integer(pInt), dimension(:,:), allocatable, public, protected :: & mesh_element !DEPRECATED @@ -264,16 +260,12 @@ subroutine mesh_init() allocate(FEsolving_execIP(2_pInt,mesh_NcpElems)); FEsolving_execIP = 1_pInt ! parallel loop bounds set to comprise from first IP... forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element -!!!! COMPATIBILITY HACK !!!! -! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. -! hence, xxPerElem instead of maxXX -! better name - mesh_homogenizationAt = mesh_element(3,:) - mesh_microstructureAt = mesh_element(4,:) -!!!!!!!!!!!!!!!!!!!!!!!! allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) call theMesh%init(dimplex,integrationOrder,mesh_node0) call theMesh%setNelems(mesh_NcpElems) + + theMesh%homogenizationAt = mesh_element(3,:) + theMesh%microstructureAt = mesh_element(4,:) end subroutine mesh_init diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index d871203af..adcaa8513 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -25,10 +25,6 @@ module mesh mesh_maxNcellnodes !< max number of cell nodes in any CP element !!!! BEGIN DEPRECATED !!!!! - integer(pInt), dimension(:), allocatable, public, protected :: & - mesh_homogenizationAt, & !< homogenization ID of each element - mesh_microstructureAt !< microstructure ID of each element - integer(pInt), dimension(:,:), allocatable, public, protected :: & mesh_element, & !DEPRECATED mesh_sharedElem, & !< entryCount and list of elements containing node @@ -520,9 +516,8 @@ subroutine mesh_init(ip,el) ! better name - mesh_homogenizationAt = mesh_element(3,:) - mesh_microstructureAt = mesh_element(4,:) - + theMesh%homogenizationAt = mesh_element(3,:) + theMesh%microstructureAt = mesh_element(4,:) contains diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 6e9e37834..38abad1aa 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -22,9 +22,8 @@ module mesh integer(pInt), dimension(:), allocatable, private :: & microGlobal - integer(pInt), dimension(:), allocatable, public, protected :: & - mesh_homogenizationAt, & !< homogenization ID of each element - mesh_microstructureAt !< microstructure ID of each element + integer(pInt), dimension(:), allocatable, private :: & + mesh_homogenizationAt integer(pInt), dimension(:,:), allocatable, public, protected :: & mesh_element !< entryCount and list of elements containing node @@ -268,7 +267,8 @@ subroutine mesh_init(ip,el) ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX ! better name - mesh_microstructureAt = mesh_element(4,:) + theMesh%homogenizationAt = mesh_element(3,:) + theMesh%microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! deallocate(mesh_cell) end subroutine mesh_init diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 0bb54ffb8..c999e32d5 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -18,10 +18,6 @@ module mesh mesh_Ncells, & !< total number of cells in mesh mesh_maxNsharedElems !< max number of CP elements sharing a node - integer(pInt), dimension(:), allocatable, public, protected :: & - mesh_homogenizationAt, & !< homogenization ID of each element - mesh_microstructureAt !< microstructure ID of each element - integer(pInt), dimension(:,:), allocatable, public, protected :: & mesh_element, & !DEPRECATED mesh_sharedElem, & !< entryCount and list of elements containing node @@ -408,11 +404,8 @@ subroutine mesh_init(ip,el) calcMode = .false. ! pretend to have collected what first call is asking (F = I) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" -!!!! COMPATIBILITY HACK !!!! -! better name - mesh_homogenizationAt = mesh_element(3,:) - mesh_microstructureAt = mesh_element(4,:) -!!!!!!!!!!!!!!!!!!!!!!!! + theMesh%homogenizationAt = mesh_element(3,:) + theMesh%microstructureAt = mesh_element(4,:) end subroutine mesh_init From 550b6510a5ce2fe3fd8ba4375fd6e6a09848925d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 11:02:32 +0100 Subject: [PATCH 65/67] better name --- src/constitutive.f90 | 4 ++-- src/damage_local.f90 | 4 ++-- src/damage_none.f90 | 4 ++-- src/damage_nonlocal.f90 | 8 ++++---- src/homogenization.f90 | 2 +- src/homogenization_RGC.f90 | 5 ++--- src/homogenization_isostrain.f90 | 4 ++-- src/homogenization_none.f90 | 4 ++-- src/kinematics_cleavage_opening.f90 | 15 +++------------ src/kinematics_slipplane_opening.f90 | 4 ++-- src/kinematics_thermal_expansion.f90 | 4 ++-- src/material.f90 | 14 ++------------ src/source_damage_anisoBrittle.f90 | 4 ++-- src/source_damage_anisoDuctile.f90 | 4 ++-- src/source_damage_isoDuctile.f90 | 4 ++-- src/thermal_adiabatic.f90 | 7 ++++--- src/thermal_conduction.f90 | 4 ++-- src/thermal_isothermal.f90 | 28 +++++++++------------------- 18 files changed, 47 insertions(+), 76 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9a39aa6d2..407b3b684 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -613,7 +613,7 @@ pure function constitutive_initialFi(ipc, ip, el) math_I3 use material, only: & material_phase, & - material_homog, & + material_homogenizationAt, & thermalMapping, & phase_kinematics, & phase_Nkinematics, & @@ -641,7 +641,7 @@ pure function constitutive_initialFi(ipc, ip, el) KinematicsLoop: do k = 1_pInt, phase_Nkinematics(phase) !< Warning: small initial strain assumption kinematicsType: select case (phase_kinematics(k,phase)) case (KINEMATICS_thermal_expansion_ID) kinematicsType - homog = material_homog(ip,el) + homog = material_homogenizationAt(el) offset = thermalMapping(homog)%p(ip,el) constitutive_initialFi = & constitutive_initialFi + kinematics_thermal_expansion_initialStrain(homog,phase,offset) diff --git a/src/damage_local.f90 b/src/damage_local.f90 index b5f3e59c7..05d83d029 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -53,7 +53,7 @@ subroutine damage_local_init homogenization_Noutput, & DAMAGE_local_label, & DAMAGE_local_ID, & - material_homog, & + material_homogenizationAt, & mappingHomogenization, & damageState, & damageMapping, & @@ -111,7 +111,7 @@ subroutine damage_local_init homog = h - NofMyHomog = count(material_homog == homog) + NofMyHomog = count(material_homogenizationAt == homog) instance = damage_typeInstance(homog) diff --git a/src/damage_none.f90 b/src/damage_none.f90 index b4fe1d4a8..ffe6cd9a1 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -22,7 +22,7 @@ subroutine damage_none_init() damage_initialPhi, & damage, & damage_type, & - material_homog, & + material_homogenizationAt, & damageState, & DAMAGE_NONE_LABEL, & DAMAGE_NONE_ID @@ -37,7 +37,7 @@ subroutine damage_none_init() initializeInstances: do homog = 1, size(config_homogenization) myhomog: if (damage_type(homog) == DAMAGE_NONE_ID) then - NofMyHomog = count(material_homog == homog) + NofMyHomog = count(material_homogenizationAt == homog) damageState(homog)%sizeState = 0 damageState(homog)%sizePostResults = 0 allocate(damageState(homog)%state0 (0,NofMyHomog)) diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 119a1a4e3..3bb227e3f 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -53,7 +53,7 @@ subroutine damage_nonlocal_init homogenization_Noutput, & DAMAGE_nonlocal_label, & DAMAGE_nonlocal_ID, & - material_homog, & + material_homogenizationAt, & mappingHomogenization, & damageState, & damageMapping, & @@ -109,7 +109,7 @@ subroutine damage_nonlocal_init homog = h - NofMyHomog = count(material_homog == homog) + NofMyHomog = count(material_homogenizationAt == homog) instance = damage_typeInstance(homog) @@ -274,7 +274,7 @@ end function damage_nonlocal_getMobility !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) use material, only: & - material_homog, & + material_homogenizationAt, & damageMapping, & damage @@ -288,7 +288,7 @@ subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) homog, & offset - homog = material_homog(ip,el) + homog = material_homogenizationAt(el) offset = damageMapping(homog)%p(ip,el) damage(homog)%p(offset) = phi diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 556663ad0..6d1ffe3e2 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -118,7 +118,7 @@ subroutine homogenization_init mainProcess2: if (worldrank == 0) then call IO_write_jobFile(FILEUNIT,'outputHomogenization') do p = 1,size(config_homogenization) - if (any(material_homog == p)) then + if (any(material_homogenizationAt == p)) then i = homogenization_typeInstance(p) ! which instance of this homogenization type valid = .true. ! assume valid select case(homogenization_type(p)) ! split per homogenization type diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 1d73b687c..1a170c66c 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -107,11 +107,10 @@ subroutine homogenization_RGC_init() IO_error use material, only: & #ifdef DEBUG - material_homogenizationAt, & mappingHomogenization, & #endif homogenization_type, & - material_homog, & + material_homogenizationAt, & homogState, & HOMOGENIZATION_RGC_ID, & HOMOGENIZATION_RGC_LABEL, & @@ -217,7 +216,7 @@ subroutine homogenization_RGC_init() enddo - NofMyHomog = count(material_homog == h) + NofMyHomog = count(material_homogenizationAt == h) nIntFaceTot = 3_pInt*( (prm%Nconstituents(1)-1_pInt)*prm%Nconstituents(2)*prm%Nconstituents(3) & + prm%Nconstituents(1)*(prm%Nconstituents(2)-1_pInt)*prm%Nconstituents(3) & + prm%Nconstituents(1)*prm%Nconstituents(2)*(prm%Nconstituents(3)-1_pInt)) diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index 777321cee..366d76b59 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -44,7 +44,7 @@ subroutine homogenization_isostrain_init() IO_error use material, only: & homogenization_type, & - material_homog, & + material_homogenizationAt, & homogState, & HOMOGENIZATION_ISOSTRAIN_ID, & HOMOGENIZATION_ISOSTRAIN_LABEL, & @@ -85,7 +85,7 @@ subroutine homogenization_isostrain_init() call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_isostrain_label//')') end select - NofMyHomog = count(material_homog == h) + NofMyHomog = count(material_homogenizationAt == h) homogState(h)%sizeState = 0_pInt homogState(h)%sizePostResults = 0_pInt allocate(homogState(h)%state0 (0_pInt,NofMyHomog)) diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index 400298b89..cbbfa4cac 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -26,7 +26,7 @@ subroutine homogenization_none_init() config_homogenization use material, only: & homogenization_type, & - material_homog, & + material_homogenizationAt, & homogState, & HOMOGENIZATION_NONE_LABEL, & HOMOGENIZATION_NONE_ID @@ -46,7 +46,7 @@ subroutine homogenization_none_init() do h = 1, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle - NofMyHomog = count(material_homog == h) + NofMyHomog = count(material_homogenizationAt == h) homogState(h)%sizeState = 0 homogState(h)%sizePostResults = 0 allocate(homogState(h)%state0 (0,NofMyHomog)) diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 7a3677ec1..379327981 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -54,11 +54,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine kinematics_cleavage_opening_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use debug, only: & debug_level,& debug_constitutive,& @@ -66,9 +61,7 @@ subroutine kinematics_cleavage_opening_init() use config, only: & config_phase use IO, only: & - IO_warning, & - IO_error, & - IO_timeStamp + IO_error use material, only: & phase_kinematics, & KINEMATICS_cleavage_opening_label, & @@ -84,8 +77,6 @@ subroutine kinematics_cleavage_opening_init() integer(pInt) :: maxNinstance,p,instance,kinematics write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt) if (maxNinstance == 0_pInt) return @@ -145,7 +136,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i math_mul33xx33 use material, only: & material_phase, & - material_homog, & + material_homogenizationAt, & damage, & damageMapping use lattice, only: & @@ -174,7 +165,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i phase = material_phase(ipc,ip,el) instance = kinematics_cleavage_opening_instance(phase) - homog = material_homog(ip,el) + homog = material_homogenizationAt(el) damageOffset = damageMapping(homog)%p(ip,el) Ld = 0.0_pReal diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 0fa80ece8..880df3dcc 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -121,7 +121,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, math_outer use material, only: & material_phase, & - material_homog, & + material_homogenizationAt, & damage, & damageMapping @@ -148,7 +148,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, phase = material_phase(ipc,ip,el) instance = kinematics_slipplane_opening_instance(phase) - homog = material_homog(ip,el) + homog = material_homogenizationAt(el) damageOffset = damageMapping(homog)%p(ip,el) associate(prm => param(instance)) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 56caa6e4b..c6e29e346 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -112,7 +112,7 @@ end function kinematics_thermal_expansion_initialStrain subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el) use material, only: & material_phase, & - material_homog, & + material_homogenizationAt, & temperature, & temperatureRate, & thermalMapping @@ -136,7 +136,7 @@ subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, T, TRef, TDot phase = material_phase(ipc,ip,el) - homog = material_homog(ip,el) + homog = material_homogenizationAt(el) offset = thermalMapping(homog)%p(ip,el) T = temperature(homog)%p(offset) TDot = temperatureRate(homog)%p(offset) diff --git a/src/material.f90 b/src/material.f90 index 3c69c844e..9b2bf0f80 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -162,10 +162,6 @@ module material ! DEPRECATED: use material_phaseAt integer(pInt), dimension(:,:,:), allocatable, public :: & material_phase !< phase (index) of each grain,IP,element -! DEPRECATED: use material_homogenizationAt - integer(pInt), dimension(:,:), allocatable, public :: & - material_homog !< homogenization (index) of each IP,element -! END DEPRECATED type(tPlasticState), allocatable, dimension(:), public :: & plasticState @@ -1043,25 +1039,19 @@ subroutine material_populateGrains phaseID,textureID,dGrains,myNgrains,myNorientations,myNconstituents, & grain,constituentGrain,ipGrain,symExtension, ip real(pReal) :: deviation,extreme,rnd - integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array - type(group_int), dimension (:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array + integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array + type(group_int), dimension (:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array myDebug = debug_level(debug_material) allocate(material_volume(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0.0_pReal) allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) - allocate(material_homog(theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal) allocate(Ngrains(size(config_homogenization),size(config_microstructure)), source=0_pInt) allocate(Nelems (size(config_homogenization),size(config_microstructure)), source=0_pInt) -! populating homogenization schemes in each -!-------------------------------------------------------------------------------------------------- - do e = 1_pInt, theMesh%Nelems - material_homog(1_pInt:theMesh%elem%nIPs,e) = theMesh%homogenizationAt(e) - enddo !-------------------------------------------------------------------------------------------------- ! precounting of elements for each homog/micro pair diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 00aaeaf9c..cc4991da8 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -205,7 +205,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) use material, only: & phaseAt, phasememberAt, & sourceState, & - material_homog, & + material_homogenizationAt, & damage, & damageMapping use lattice, only: & @@ -235,7 +235,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) constituent = phasememberAt(ipc,ip,el) instance = source_damage_anisoBrittle_instance(phase) sourceOffset = source_damage_anisoBrittle_offset(phase) - homog = material_homog(ip,el) + homog = material_homogenizationAt(el) damageOffset = damageMapping(homog)%p(ip,el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 07f8e5e58..f0774df62 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -190,7 +190,7 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) phaseAt, phasememberAt, & plasticState, & sourceState, & - material_homog, & + material_homogenizationAt, & damage, & damageMapping @@ -211,7 +211,7 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) constituent = phasememberAt(ipc,ip,el) instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) - homog = material_homog(ip,el) + homog = material_homogenizationAt(el) damageOffset = damageMapping(homog)%p(ip,el) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 8dc1b34d6..279d436c9 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -173,7 +173,7 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el) phaseAt, phasememberAt, & plasticState, & sourceState, & - material_homog, & + material_homogenizationAt, & damage, & damageMapping @@ -189,7 +189,7 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el) constituent = phasememberAt(ipc,ip,el) instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) - homog = material_homog(ip,el) + homog = material_homogenizationAt(el) damageOffset = damageMapping(homog)%p(ip,el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 4223c7971..003398a90 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -49,7 +49,7 @@ subroutine thermal_adiabatic_init homogenization_Noutput, & THERMAL_ADIABATIC_label, & THERMAL_adiabatic_ID, & - material_homog, & + material_homogenizationAt, & mappingHomogenization, & thermalState, & thermalMapping, & @@ -80,7 +80,7 @@ subroutine thermal_adiabatic_init initializeInstances: do section = 1_pInt, size(thermal_type) if (thermal_type(section) /= THERMAL_adiabatic_ID) cycle - NofMyHomog=count(material_homog==section) + NofMyHomog=count(material_homogenizationAt==section) instance = thermal_typeInstance(section) outputs = config_homogenization(section)%getStrings('(output)',defaultVal=emptyStringArray) do i=1_pInt, size(outputs) @@ -120,6 +120,7 @@ function thermal_adiabatic_updateState(subdt, ip, el) err_thermal_tolAbs, & err_thermal_tolRel use material, only: & + material_homogenizationAt, & mappingHomogenization, & thermalState, & temperature, & @@ -140,7 +141,7 @@ function thermal_adiabatic_updateState(subdt, ip, el) real(pReal) :: & T, Tdot, dTdot_dT - homog = mappingHomogenization(2,ip,el) + homog = material_homogenizationAt(el) offset = mappingHomogenization(1,ip,el) T = thermalState(homog)%subState0(1,offset) diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 8e836ffd1..2611d33b1 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -50,7 +50,7 @@ subroutine thermal_conduction_init homogenization_Noutput, & THERMAL_conduction_label, & THERMAL_conduction_ID, & - material_homog, & + material_homogenizationAt, & mappingHomogenization, & thermalState, & thermalMapping, & @@ -81,7 +81,7 @@ subroutine thermal_conduction_init initializeInstances: do section = 1_pInt, size(thermal_type) if (thermal_type(section) /= THERMAL_conduction_ID) cycle - NofMyHomog=count(material_homog==section) + NofMyHomog=count(material_homogenizationAt==section) instance = thermal_typeInstance(section) outputs = config_homogenization(section)%getStrings('(output)',defaultVal=emptyStringArray) do i=1_pInt, size(outputs) diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index 7485cd34f..a161094e7 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -16,38 +16,28 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine thermal_isothermal_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & - pReal, & - pInt - use IO, only: & - IO_timeStamp + pReal use config, only: & material_Nhomogenization use material implicit none - integer(pInt) :: & + integer :: & homog, & NofMyHomog write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - initializeInstances: do homog = 1_pInt, material_Nhomogenization + initializeInstances: do homog = 1, material_Nhomogenization if (thermal_type(homog) /= THERMAL_isothermal_ID) cycle - NofMyHomog = count(material_homog == homog) - thermalState(homog)%sizeState = 0_pInt - thermalState(homog)%sizePostResults = 0_pInt - allocate(thermalState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) - allocate(thermalState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) - allocate(thermalState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal) + NofMyHomog = count(material_homogenizationAt == homog) + thermalState(homog)%sizeState = 0 + thermalState(homog)%sizePostResults = 0 + allocate(thermalState(homog)%state0 (0,NofMyHomog), source=0.0_pReal) + allocate(thermalState(homog)%subState0(0,NofMyHomog), source=0.0_pReal) + allocate(thermalState(homog)%state (0,NofMyHomog), source=0.0_pReal) deallocate(temperature (homog)%p) allocate (temperature (homog)%p(1), source=thermal_initialT(homog)) From 340617ab6585af778e7618b2629f806657b9beb6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 11:23:39 +0100 Subject: [PATCH 66/67] unifying notation --- src/damage_local.f90 | 17 ++++---- src/damage_nonlocal.f90 | 18 ++++----- src/homogenization.f90 | 79 +++++++++++++++++++------------------- src/material.f90 | 4 +- src/spectral_thermal.f90 | 6 +-- src/thermal_adiabatic.f90 | 3 +- src/thermal_conduction.f90 | 7 ++-- 7 files changed, 70 insertions(+), 64 deletions(-) diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 05d83d029..1c4928fac 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -143,6 +143,7 @@ function damage_local_updateState(subdt, ip, el) err_damage_tolAbs, & err_damage_tolRel use material, only: & + material_homogenizationAt, & mappingHomogenization, & damageState @@ -160,7 +161,7 @@ function damage_local_updateState(subdt, ip, el) real(pReal) :: & phi, phiDot, dPhiDot_dPhi - homog = mappingHomogenization(2,ip,el) + homog = material_homogenizationAt(el) offset = mappingHomogenization(1,ip,el) phi = damageState(homog)%subState0(1,offset) call damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) @@ -182,7 +183,7 @@ end function damage_local_updateState subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) use material, only: & homogenization_Ngrains, & - mappingHomogenization, & + material_homogenizationAt, & phaseAt, & phasememberAt, & phase_source, & @@ -216,7 +217,7 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el phiDot = 0.0_pReal dPhiDot_dPhi = 0.0_pReal - do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el)) + do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) phase = phaseAt(grain,ip,el) constituent = phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) @@ -243,8 +244,8 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el enddo enddo - phiDot = phiDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal) - dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal) + phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) + dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) end subroutine damage_local_getSourceAndItsTangent @@ -253,7 +254,7 @@ end subroutine damage_local_getSourceAndItsTangent !-------------------------------------------------------------------------------------------------- function damage_local_postResults(ip,el) use material, only: & - mappingHomogenization, & + material_homogenizationAt, & damage_typeInstance, & damageMapping, & damage @@ -262,13 +263,13 @@ function damage_local_postResults(ip,el) integer(pInt), intent(in) :: & ip, & !< integration point el !< element - real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(mappingHomogenization(2,ip,el))))) :: & + real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & damage_local_postResults integer(pInt) :: & instance, homog, offset, o, c - homog = mappingHomogenization(2,ip,el) + homog = material_homogenizationAt(el) offset = damageMapping(homog)%p(ip,el) instance = damage_typeInstance(homog) associate(prm => param(instance)) diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 3bb227e3f..3a2080e84 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -136,7 +136,7 @@ end subroutine damage_nonlocal_init subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) use material, only: & homogenization_Ngrains, & - mappingHomogenization, & + material_homogenizationAt, & phaseAt, & phasememberAt, & phase_source, & @@ -170,7 +170,7 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, phiDot = 0.0_pReal dPhiDot_dPhi = 0.0_pReal - do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el)) + do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) phase = phaseAt(grain,ip,el) constituent = phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) @@ -197,8 +197,8 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, enddo enddo - phiDot = phiDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal) - dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal) + phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) + dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) end subroutine damage_nonlocal_getSourceAndItsTangent @@ -213,7 +213,7 @@ function damage_nonlocal_getDiffusion33(ip,el) use material, only: & homogenization_Ngrains, & material_phase, & - mappingHomogenization + material_homogenizationAt use crystallite, only: & crystallite_push33ToRef @@ -227,7 +227,7 @@ function damage_nonlocal_getDiffusion33(ip,el) homog, & grain - homog = mappingHomogenization(2,ip,el) + homog = material_homogenizationAt(el) damage_nonlocal_getDiffusion33 = 0.0_pReal do grain = 1, homogenization_Ngrains(homog) damage_nonlocal_getDiffusion33 = damage_nonlocal_getDiffusion33 + & @@ -299,7 +299,7 @@ end subroutine damage_nonlocal_putNonLocalDamage !-------------------------------------------------------------------------------------------------- function damage_nonlocal_postResults(ip,el) use material, only: & - mappingHomogenization, & + material_homogenizationAt, & damage_typeInstance, & damageMapping, & damage @@ -308,13 +308,13 @@ function damage_nonlocal_postResults(ip,el) integer(pInt), intent(in) :: & ip, & !< integration point el !< element - real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(mappingHomogenization(2,ip,el))))) :: & + real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & damage_nonlocal_postResults integer(pInt) :: & instance, homog, offset, o, c - homog = mappingHomogenization(2,ip,el) + homog = material_homogenizationAt(el) offset = damageMapping(homog)%p(ip,el) instance = damage_typeInstance(homog) associate(prm => param(instance)) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 6d1ffe3e2..06c8bd44c 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -302,6 +302,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) thermalState, & damageState, & phase_Nsources, & + material_homogenizationAt, & mappingHomogenization, & phaseAt, phasememberAt, & homogenization_Ngrains @@ -392,17 +393,17 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) materialpoint_requested(i,e) = .true. ! everybody requires calculation endforall forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - homogState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - homogState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - homogState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state + homogState(material_homogenizationAt(e))%sizeState > 0_pInt) & + homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + homogState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - thermalState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - thermalState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - thermalState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state + thermalState(material_homogenizationAt(e))%sizeState > 0_pInt) & + thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + thermalState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - damageState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state + damageState(material_homogenizationAt(e))%sizeState > 0_pInt) & + damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + damageState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state enddo NiterationHomog = 0_pInt @@ -462,17 +463,17 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) enddo forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - homogState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - homogState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - homogState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state + homogState(material_homogenizationAt(e))%sizeState > 0_pInt) & + homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + homogState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - thermalState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - thermalState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - thermalState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal thermal state + thermalState(material_homogenizationAt(e))%sizeState > 0_pInt) & + thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + thermalState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) ! ...internal thermal state forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - damageState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal damage state + damageState(material_homogenizationAt(e))%sizeState > 0_pInt) & + damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + damageState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) ! ...internal damage state materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad endif steppingNeeded @@ -523,17 +524,17 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) enddo enddo forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - homogState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - homogState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & - homogState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal homogenization state + homogState(material_homogenizationAt(e))%sizeState > 0_pInt) & + homogState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & + homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal homogenization state forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - thermalState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - thermalState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & - thermalState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal thermal state + thermalState(material_homogenizationAt(e))%sizeState > 0_pInt) & + thermalState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & + thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal thermal state forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - damageState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & - damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal damage state + damageState(material_homogenizationAt(e))%sizeState > 0_pInt) & + damageState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & + damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal damage state endif endif converged @@ -637,7 +638,7 @@ subroutine materialpoint_postResults use mesh, only: & mesh_element use material, only: & - mappingHomogenization, & + material_homogenizationAt, & homogState, & thermalState, & damageState, & @@ -667,9 +668,9 @@ subroutine materialpoint_postResults IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) thePos = 0_pInt - theSize = homogState (mappingHomogenization(2,i,e))%sizePostResults & - + thermalState (mappingHomogenization(2,i,e))%sizePostResults & - + damageState (mappingHomogenization(2,i,e))%sizePostResults + theSize = homogState (material_homogenizationAt(e))%sizePostResults & + + thermalState (material_homogenizationAt(e))%sizePostResults & + + damageState (material_homogenizationAt(e))%sizePostResults materialpoint_results(thePos+1,i,e) = real(theSize,pReal) ! tell size of homogenization results thePos = thePos + 1_pInt @@ -902,9 +903,9 @@ function postResults(ip,el) integer(pInt), intent(in) :: & ip, & !< integration point el !< element number - real(pReal), dimension( homogState (mappingHomogenization(2,ip,el))%sizePostResults & - + thermalState (mappingHomogenization(2,ip,el))%sizePostResults & - + damageState (mappingHomogenization(2,ip,el))%sizePostResults) :: & + real(pReal), dimension( homogState (material_homogenizationAt(el))%sizePostResults & + + thermalState (material_homogenizationAt(el))%sizePostResults & + + damageState (material_homogenizationAt(el))%sizePostResults) :: & postResults integer(pInt) :: & startPos, endPos ,& @@ -913,7 +914,7 @@ function postResults(ip,el) postResults = 0.0_pReal startPos = 1_pInt - endPos = homogState(mappingHomogenization(2,ip,el))%sizePostResults + endPos = homogState(material_homogenizationAt(el))%sizePostResults chosenHomogenization: select case (homogenization_type(mesh_element(3,el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization @@ -924,22 +925,22 @@ function postResults(ip,el) end select chosenHomogenization startPos = endPos + 1_pInt - endPos = endPos + thermalState(mappingHomogenization(2,ip,el))%sizePostResults + endPos = endPos + thermalState(material_homogenizationAt(el))%sizePostResults chosenThermal: select case (thermal_type(mesh_element(3,el))) case (THERMAL_adiabatic_ID) chosenThermal - homog = mappingHomogenization(2,ip,el) + homog = material_homogenizationAt(el) postResults(startPos:endPos) = & thermal_adiabatic_postResults(homog,thermal_typeInstance(homog),thermalMapping(homog)%p(ip,el)) case (THERMAL_conduction_ID) chosenThermal - homog = mappingHomogenization(2,ip,el) + homog = material_homogenizationAt(el) postResults(startPos:endPos) = & thermal_conduction_postResults(homog,thermal_typeInstance(homog),thermalMapping(homog)%p(ip,el)) end select chosenThermal startPos = endPos + 1_pInt - endPos = endPos + damageState(mappingHomogenization(2,ip,el))%sizePostResults + endPos = endPos + damageState(material_homogenizationAt(el))%sizePostResults chosenDamage: select case (damage_type(mesh_element(3,el))) case (DAMAGE_local_ID) chosenDamage diff --git a/src/material.f90 b/src/material.f90 index 9b2bf0f80..d35cfebd4 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -391,6 +391,8 @@ subroutine material_init() ! END DEPRECATED allocate(material_homogenizationAt,source=theMesh%homogenizationAt) + allocate(material_AggregateAt, source=theMesh%homogenizationAt) + allocate(CounterPhase (size(config_phase)), source=0_pInt) allocate(CounterHomogenization(size(config_homogenization)),source=0_pInt) @@ -399,7 +401,7 @@ subroutine material_init() myHomog = theMesh%homogenizationAt(e) do i = 1_pInt, theMesh%elem%nIPs CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt - mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),myHomog] + mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)] do g = 1_pInt,homogenization_Ngrains(myHomog) myPhase = material_phase(g,i,e) CounterPhase(myPhase) = CounterPhase(myPhase)+1_pInt ! not distinguishing between instances of same phase diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index 62b03d11f..3e2a4b1f9 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -61,7 +61,7 @@ subroutine spectral_thermal_init thermal_conduction_getMassDensity, & thermal_conduction_getSpecificHeat use material, only: & - mappingHomogenization, & + material_homogenizationAt, & temperature, & thermalMapping use numerics, only: & @@ -118,8 +118,8 @@ subroutine spectral_thermal_init cell = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) cell = cell + 1 - temperature_current(i,j,k) = temperature(mappingHomogenization(2,1,cell))% & - p(thermalMapping(mappingHomogenization(2,1,cell))%p(1,cell)) + temperature_current(i,j,k) = temperature(material_homogenizationAt(cell))% & + p(thermalMapping(material_homogenizationAt(cell))%p(1,cell)) temperature_lastInc(i,j,k) = temperature_current(i,j,k) temperature_stagInc(i,j,k) = temperature_current(i,j,k) enddo; enddo; enddo diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 003398a90..ce6656188 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -166,6 +166,7 @@ end function thermal_adiabatic_updateState subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) use material, only: & homogenization_Ngrains, & + material_homogenizationAt, & mappingHomogenization, & phaseAt, & phasememberAt, & @@ -200,7 +201,7 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) source, & constituent - homog = mappingHomogenization(2,ip,el) + homog = material_homogenizationAt(el) instance = thermal_typeInstance(homog) Tdot = 0.0_pReal diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 2611d33b1..20e8bb6a6 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -119,6 +119,7 @@ end subroutine thermal_conduction_init !-------------------------------------------------------------------------------------------------- subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) use material, only: & + material_homogenizationAt, & homogenization_Ngrains, & mappingHomogenization, & phaseAt, & @@ -155,7 +156,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) source, & constituent - homog = mappingHomogenization(2,ip,el) + homog = material_homogenizationAt(el) offset = mappingHomogenization(1,ip,el) instance = thermal_typeInstance(homog) @@ -302,7 +303,7 @@ end function thermal_conduction_getMassDensity !-------------------------------------------------------------------------------------------------- subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el) use material, only: & - mappingHomogenization, & + material_homogenizationAt, & temperature, & temperatureRate, & thermalMapping @@ -318,7 +319,7 @@ subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el) homog, & offset - homog = mappingHomogenization(2,ip,el) + homog = material_homogenizationAt(el) offset = thermalMapping(homog)%p(ip,el) temperature (homog)%p(offset) = T temperatureRate(homog)%p(offset) = Tdot From f203add8993f580ac348a6ca6f85e2298b0e29c6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Mar 2019 12:58:07 +0100 Subject: [PATCH 67/67] not needed --- src/FEM_utilities.f90 | 21 --------------------- 1 file changed, 21 deletions(-) diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 2bf1ea868..c0e37001e 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -147,14 +147,11 @@ subroutine utilities_init() mesh_NcpElemsGlobal, & mesh_maxNips, & geomMesh - use material, only: & - material_homog implicit none character(len=1024) :: petsc_optionsPhysics integer(pInt) :: dimPlex - PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:) PetscInt :: dim PetscErrorCode :: ierr @@ -184,24 +181,6 @@ subroutine utilities_init() wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal) call DMGetDimension(geomMesh,dimPlex,ierr); CHKERRQ(ierr) - allocate(nEntities(dimPlex+1), source=0) - allocate(nOutputNodes(worldsize), source = 0) - allocate(nOutputCells(worldsize), source = 0) - do dim = 0, dimPlex - call DMGetStratumSize(geomMesh,'depth',dim,nEntities(dim+1),ierr) - CHKERRQ(ierr) - enddo - select case (integrationOrder) - case(1_pInt) - nOutputNodes(worldrank+1) = nEntities(1) - case(2_pInt) - nOutputNodes(worldrank+1) = sum(nEntities) - case default - nOutputNodes(worldrank+1) = mesh_maxNips*nEntities(dimPlex+1) - end select - nOutputCells(worldrank+1) = count(material_homog > 0_pInt) - call MPI_Allreduce(MPI_IN_PLACE,nOutputNodes,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) - call MPI_Allreduce(MPI_IN_PLACE,nOutputCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) end subroutine utilities_init